diff options
author | dos-reis <gdr@axiomatics.org> | 2008-08-13 14:55:53 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-08-13 14:55:53 +0000 |
commit | cd4b966f39550403099a0abf1e993af1e7e79139 (patch) | |
tree | 84fbcdcedeecd1915b000131e6d5ae8ea9f2bdbd /src | |
parent | 5f7f460c22d03c5c1b2e318e97971518465c4197 (diff) | |
download | open-axiom-cd4b966f39550403099a0abf1e993af1e7e79139.tar.gz |
(|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.
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 21 | ||||
-rw-r--r-- | src/interp/cattable.boot | 6 | ||||
-rw-r--r-- | src/interp/g-util.boot | 20 | ||||
-rw-r--r-- | src/interp/lisplib.boot | 2 | ||||
-rw-r--r-- | src/interp/patches.lisp | 59 | ||||
-rw-r--r-- | src/interp/sys-driver.boot | 10 | ||||
-rw-r--r-- | src/interp/sys-macros.lisp | 2 | ||||
-rw-r--r-- | src/interp/trace.boot | 2 |
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 == |