aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog21
-rw-r--r--src/interp/cattable.boot6
-rw-r--r--src/interp/g-util.boot20
-rw-r--r--src/interp/lisplib.boot2
-rw-r--r--src/interp/patches.lisp59
-rw-r--r--src/interp/sys-driver.boot10
-rw-r--r--src/interp/sys-macros.lisp2
-rw-r--r--src/interp/trace.boot2
8 files changed, 43 insertions, 79 deletions
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 ==