From cd4b966f39550403099a0abf1e993af1e7e79139 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 13 Aug 2008 14:55:53 +0000
Subject: 	(|COMP,TRAN|): Remove. 	(|spadHash|): Likewise. 
 (|$internalHistoryTable|): Don't define here. 	(|isBpiOrLambda|): Remove. 
 (|libraryFileLists|): Likewise. 	(|normalizeArgFileName|): Likewise. 
 (save-system) [LUCID]: Likewise. 	(|undoINITIALIZE|): Likewise. 
 (|isLowerCaseLetter|): Don't define here. 	(|isUpperCaseLetter|):
 Likewise. 	(|isLetter|): Likewise. 	(printCopyright): Remove. 
 (user-homedir-pathname): Likewise. 	(BUMPCOMPERRORCOUNT): Likewise. 
 (|cpCms|): Likewise. 	(|normalizeTimeAndStringify|): Likewise. 
 (whocalled): Likewise. 	(|compressHashTable|): Likewise. 
 (SETLETPRINTFLAG): Don't define here. 	(RESTART0): Move to sys-driver.boot 
 * interp/g-util.boot (charRangeTest): Remove.

---
 src/ChangeLog              | 21 +++++++++++++++++
 src/interp/cattable.boot   |  6 ++---
 src/interp/g-util.boot     | 20 ++++------------
 src/interp/lisplib.boot    |  2 +-
 src/interp/patches.lisp    | 59 ----------------------------------------------
 src/interp/sys-driver.boot | 10 ++++++++
 src/interp/sys-macros.lisp |  2 +-
 src/interp/trace.boot      |  2 ++
 8 files changed, 43 insertions(+), 79 deletions(-)

(limited to 'src')

diff --git a/src/ChangeLog b/src/ChangeLog
index 460dad7f..bf490f90 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -2,6 +2,27 @@
 
 	* interp/patches.lisp (RESTART0): Don't duplicate code; call
 	CREATE-INITIALIZERS. 
+	(|COMP,TRAN|): Remove.
+	(|spadHash|): Likewise.
+	(|$internalHistoryTable|): Don't define here.
+	(|isBpiOrLambda|): Remove.
+	(|libraryFileLists|): Likewise.
+	(|normalizeArgFileName|): Likewise.
+	(save-system) [LUCID]: Likewise.
+	(|undoINITIALIZE|): Likewise.
+	(|isLowerCaseLetter|): Don't define here.
+	(|isUpperCaseLetter|): Likewise.
+	(|isLetter|): Likewise.
+	(printCopyright): Remove.
+	(user-homedir-pathname): Likewise.
+	(BUMPCOMPERRORCOUNT): Likewise.
+	(|cpCms|): Likewise.
+	(|normalizeTimeAndStringify|): Likewise.
+	(whocalled): Likewise.
+	(|compressHashTable|): Likewise.
+	(SETLETPRINTFLAG): Don't define here.
+	(RESTART0): Move to sys-driver.boot
+	* interp/g-util.boot (charRangeTest): Remove.
 
 2008-08-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 29632e2c..671b4f8d 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -70,9 +70,9 @@ genCategoryTable() ==
     for [a,:b] in encodeCategoryAlist(id,entry) repeat
       HPUT(_*HASCATEGORY_-HASH_*,[id,:a],b)
   simpTempCategoryTable()
-  compressHashTable _*ANCESTORS_-HASH_*
+  -- compressHashTable _*ANCESTORS_-HASH_*
   simpCategoryTable()
-  compressHashTable _*HASCATEGORY_-HASH_*
+  -- compressHashTable _*HASCATEGORY_-HASH_*
 
 simpTempCategoryTable() ==
   for id in HKEYS _*ANCESTORS_-HASH_* repeat
@@ -478,7 +478,7 @@ updateCategoryTableForDomain(cname,category) ==
   for [a,:b] in encodeCategoryAlist(cname,domainEntry) repeat
     HPUT(_*HASCATEGORY_-HASH_*,[cname,:a],b)
   $doNotCompressHashTableIfTrue = true => _*HASCATEGORY_-HASH_*
-  compressHashTable _*HASCATEGORY_-HASH_*
+  -- compressHashTable _*HASCATEGORY_-HASH_*
 
 clearCategoryTable($cname) ==
   MAPHASH('clearCategoryTable1,_*HASCATEGORY_-HASH_*)
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 979aeff3..4c3c9801 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -338,24 +338,14 @@ flattenSexpr s ==
   ATOM f => [f,:flattenSexpr r]
   [:flattenSexpr f,:flattenSexpr r]
 
-isLowerCaseLetter c == charRangeTest CHAR2NUM c
+isLowerCaseLetter c ==
+  LOWER_-CASE_-P c
 
-isUpperCaseLetter c == charRangeTest QSDIFFERENCE(CHAR2NUM c,64)
+isUpperCaseLetter c ==
+  UPPER_-CASE_-P c
 
 isLetter c ==
-  n:= CHAR2NUM c
-  charRangeTest n or charRangeTest QSDIFFERENCE(CHAR2NUM c,64)
-
-charRangeTest n ==
-  QSLESSP(153,n) =>
-    QSLESSP(169,n) => false
-    QSLESSP(161,n) => true
-    false
-  QSLESSP(128,n) =>
-    QSLESSP(144,n) => true
-    QSLESSP(138,n) => false
-    true
-  false
+  ALPHA_-CHAR_-P c
 
 update() ==
   runCommand
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 70a35e2b..4cb029f2 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -273,7 +273,7 @@ autoLoad(abb,cname) ==
   cname in $BuiltinConstructorNames => cname
   if not GETL(cname,'LOADED) then loadLib cname
   SYMBOL_-FUNCTION cname
- 
+
 setAutoLoadProperty(name) ==
 --  abb := constructor? name
   REMPROP(name,'LOADED)
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index 7d586f75..056ac23a 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -49,9 +49,6 @@
 (defvar |$demoFlag| nil)
 
 (define-function '|construct| #'list) ;; NEEDED , SPAD-COMPILER generated Lisp code
-(define-function '|COMP,TRAN| #'comp-tran) ;called by |compWithMappingMode|
-
-(define-function '|spadHash| #'sxhash)
 
 (defun |mkAutoLoad| (fn cname)
    (function (lambda (&rest args)
@@ -76,17 +73,6 @@
 (define-function 'unwind #'|spadThrow|)
 (define-function 'resume #'|spadThrow|)
 
-(DEFUN BUMPCOMPERRORCOUNT () ())
-
-(define-function '|isBpiOrLambda| #'FBOUNDP)
-;;(defun |isSharpVar| (x) (and (identp x) (char= (elt (pname x) 0) #\#)))
-
-(defvar |$internalHistoryTable| ())
-(defun |cpCms| (prefix &optional (string (|getSystemCommandLine|)))
-  (setq string (concat prefix string))
-  (if (equal string "") (|runCommand| "sh")
-    (|runCommand| string))
-   (|terminateSystemCommand|))
 (setq *print-escape* nil) ;; so stringimage doesn't escape idents?
 #+(and :GCL :IEEE-FLOATING-POINT )
  (setq system:*print-nans* T)
@@ -129,31 +115,12 @@
 (defun /EF (&rest foo)
   (|runCommand| (concat "vi " (namestring (make-input-filename /EDITFILE)))))
 
-;; non-interactive restarts...
-(defun restart0 ()
-  (compressopen);; set up the compression tables
-  (interpopen);; open up the interpreter database
-  (operationopen);; all of the operations known to the system
-  (categoryopen);; answer hasCategory question
-  (browseopen)
-  (create-initializers))
-
 (defun SHAREDITEMS (x) T) ;;checked in history code
-(defun whocalled (n) nil) ;; no way to look n frames up the stack
-(defun setletprintflag (x) x)
-(defun |normalizeTimeAndStringify| (time)
-  (if (= time 0.0) "0" (format nil "~,1F" time)))
 
 (define-function '|eval| #'eval)
 
-(defun |libraryFileLists| () '((SPAD SPADLIBS J)))
-
-;;--------------------> NEW DEFINITION (see cattable.boot.pamphlet)
-(defun |compressHashTable| (ht) ht)
 (defun GETZEROVEC (n) (MAKE-ARRAY n :initial-element 0))
 
-(defun |normalizeArgFileName| (l) l)
-
 (defun READSPADEXPR ()
   (declare (special in-stream))
   (let* ((line (cdar (preparse in-stream))))
@@ -176,21 +143,6 @@
 (eval-when (eval load compile) (shadow 'map))
 (defmacro map (&rest args) `'(map ,@args))
 
-#+:Lucid
-(defun save-system (filename)
-      (in-package "BOOT")
-      (UNTRACE)
-      (|untrace| NIL)
-      (|clearClams|)
-        ;; bind output to nulloutstream
-      (let ((|$OutputStream| (make-broadcast-stream)))
-        (|resetWorkspaceVariables|))
-      (setq |$specialCharacters| |$plainRTspecialCharacters|)
-
-          (load (|makeAbsoluteFilename| "lib/interp/obey"))
-      (system:disksave filename :restart-function restart-hook :full-gc t))
-#+:Lucid (define-function 'user::save-system  #'boot::save-system)
-(defun |undoINITIALIZE| () ())
 ;; following are defined in spadtest.boot and stantest.boot
 (defun |installStandardTestPackages| () ())
 (defun |spadtestValueHook| (val type) ())
@@ -198,10 +150,6 @@
 (defvar |$TestOptions| ())
 ;; following in defined in word.boot
 (defun |bootFind| (word) ())
-;; following 3 are replacements for g-util.boot
-(define-function '|isLowerCaseLetter| #'LOWER-CASE-P)
-(define-function '|isUpperCaseLetter| #'UPPER-CASE-P)
-(define-function '|isLetter| #'ALPHA-CHAR-P)
 
 (defvar *msghash* nil "hash table keyed by msg number")
 
@@ -253,13 +201,6 @@
     (setq returncode 0))
    (unless (zerop returncode) (bye returncode)))))
 
-#+:dos
-(defun user-homedir-pathname ()
- (truename "."))
-
-(defun boot::|printCopyright| ()
- (format t "there is no such thing as a simple job -- ((iHy))~%"))
-
 (defvar |$ViewportProcessToWatch| nil)
 (defun |setViewportProcess| ()
   (setq |$ViewportProcessToWatch|
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 6284429d..55843345 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -129,6 +129,16 @@ initMemoryConfig() ==
   nil
 )endif
 
+--%
+
+RESTART0() ==
+  COMPRESSOPEN()
+  INTERPOPEN()
+  OPERATIONOPEN()
+  CATEGORYOPEN()
+  BROWSEOPEN()
+  CREATE_-INITIALIZERS()
+
 ++
 restart() ==
   IN_-PACKAGE '"BOOT"      -- ??? is this still necessary?
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 120d91a7..cd389841 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -427,7 +427,7 @@
                             ,var
                             (QUOTE ,(KAR L))))
 	    ('T ,var))))
-   ;; used for LETs in SPAD code --- see devious trick in COMP,TRAN,1
+   ;; used for LETs in SPAD code --- see devious trick in COMP-TRAN-1
    ((ATOM var)
     `(PROGN
       (SETQ ,var ,val)
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index fe6d00ae..c8db20e7 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -72,6 +72,8 @@ $traceOptionList == '(
 
 $lastUntraced := NIL
 
+SETLETPRINTFLAG x == x
+
 trace l == traceSpad2Cmd l
 
 traceSpad2Cmd l ==
-- 
cgit v1.2.3