From d16606080c04bdbc97c6d3d046e17564ca5a5d0c Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 19 Mar 2008 05:55:35 +0000 Subject: * interp/trace.boot (untraceDomainLocalOps): Tidy. * interp/spaderror.lisp (|$quitTag|): Define as constant. (|$numericFailure|): Likewise. * interp/spad.lisp: Import "postpar" and "debug". ($): Remove toplevel assignment. (|traceComp|): Tidy. (/FLAG): Remove. (*PROMPT*): Remove. (|New,ENTRY,1|): Don't declare it. Tidy. (|New,ENTRY,2|): Fix typo. * interp/sfsfun-l.lisp (rbesselj): Remove extraneous right parenthesis. (rbesseli): Likewise. * interp/patches.lisp: Import "sockio" instead of "debug" (|$useInternalHistoryTable|): Don't define here. (user::start): Remove. (/RF-1): Declare ECHO-META special. (READSPADEXPR): Declare IN-STREAM special. (|$ViewportProcessToWatch|): Declare. (echo-meta): Don't set here. * interp/packtran.boot (rePackageTran): Tidy. * interp/nspadaux.lisp (|$underscoreChar|): Define. (|$markChoices|): Likewise. (|$convert2NewCompiler|): Likewise. (|$AnalyzeOnly|): Likewise. (|$categoryPart|): Likewise. (|$insideCAPSULE|): Likewise. (|$insideEXPORTS|): Likewise. (|$originalSignature|): Likewise. (|$insideDEF|): Likewise. (|$insideTypeExpression|): Likewise. (|$spadTightList|): Likewise. (|$PerCentVariableList|): Likewise. * interp/nrunopt.boot (augmentPredCode): Fix typo. * interp/nlib.lisp (*LISP-BIN-FILETYPE*): Remove. (recompile-lib-file-if-necessary): Use $faslType. Unconditionally define. * interp/lisplib.boot (compDefineLisplib): Tidy. * interp/interop.boot (SExprToDName): Tidy. (oldAxiomPreCategoryDevaluate): Likewise. (hashNewLookupInCategories): Likewise. * interp/g-util.boot (get): Adjust return type. (get0): Likewise. (get1): Likewise. (get2): Likewise. * interp/foam_l.lisp: Tidy. * interp/define.boot (maybeInsertViewMorphisms): Fix typo. * interp/debug.lisp (/breakcondition): Declare. * interp/sys-utility.boot (getSystemModulePath): New. * interp/daase.lisp (|with|): Remove (|library|): Move i-syscmd.boot (initial-getdatabase): Use getSystemModulePath. (getdatabase): Likewise. (addoperations): Don't reference package LISP. (localdatabase): Likewise. (write-interpdb): Don't declare *print-prett* special. (write-browsedb): Likewise. (write-categorydb): Likewise. --- src/ChangeLog | 61 +++++++++++++++++++++++++++++++++++++ src/interp/daase.lisp | 73 +++++++-------------------------------------- src/interp/debug.lisp | 2 +- src/interp/define.boot | 2 +- src/interp/foam_l.lisp | 2 +- src/interp/g-util.boot | 8 ++--- src/interp/i-syscmd.boot | 9 ++++++ src/interp/interop.boot | 8 ++--- src/interp/lisplib.boot | 2 +- src/interp/nlib.lisp | 7 ++--- src/interp/nrunopt.boot | 2 +- src/interp/nspadaux.lisp | 26 ++++++++-------- src/interp/packtran.boot | 2 +- src/interp/patches.lisp | 11 +++---- src/interp/sfsfun-l.lisp | 6 ++-- src/interp/spad.lisp | 27 +++++------------ src/interp/spaderror.lisp | 8 ++--- src/interp/sys-utility.boot | 4 +++ src/interp/trace.boot | 1 + 19 files changed, 133 insertions(+), 128 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index e667b79d..323fc208 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,64 @@ +2008-03-18 Gabriel Dos Reis + + * interp/trace.boot (untraceDomainLocalOps): Tidy. + * interp/spaderror.lisp (|$quitTag|): Define as constant. + (|$numericFailure|): Likewise. + * interp/spad.lisp: Import "postpar" and "debug". + ($): Remove toplevel assignment. + (|traceComp|): Tidy. + (/FLAG): Remove. + (*PROMPT*): Remove. + (|New,ENTRY,1|): Don't declare it. Tidy. + (|New,ENTRY,2|): Fix typo. + * interp/sfsfun-l.lisp (rbesselj): Remove extraneous right + parenthesis. + (rbesseli): Likewise. + * interp/patches.lisp: Import "sockio" instead of "debug" + (|$useInternalHistoryTable|): Don't define here. + (user::start): Remove. + (/RF-1): Declare ECHO-META special. + (READSPADEXPR): Declare IN-STREAM special. + (|$ViewportProcessToWatch|): Declare. + (echo-meta): Don't set here. + * interp/packtran.boot (rePackageTran): Tidy. + * interp/nspadaux.lisp (|$underscoreChar|): Define. + (|$markChoices|): Likewise. + (|$convert2NewCompiler|): Likewise. + (|$AnalyzeOnly|): Likewise. + (|$categoryPart|): Likewise. + (|$insideCAPSULE|): Likewise. + (|$insideEXPORTS|): Likewise. + (|$originalSignature|): Likewise. + (|$insideDEF|): Likewise. + (|$insideTypeExpression|): Likewise. + (|$spadTightList|): Likewise. + (|$PerCentVariableList|): Likewise. + * interp/nrunopt.boot (augmentPredCode): Fix typo. + * interp/nlib.lisp (*LISP-BIN-FILETYPE*): Remove. + (recompile-lib-file-if-necessary): Use $faslType. Unconditionally + define. + * interp/lisplib.boot (compDefineLisplib): Tidy. + * interp/interop.boot (SExprToDName): Tidy. + (oldAxiomPreCategoryDevaluate): Likewise. + (hashNewLookupInCategories): Likewise. + * interp/g-util.boot (get): Adjust return type. + (get0): Likewise. + (get1): Likewise. + (get2): Likewise. + * interp/foam_l.lisp: Tidy. + * interp/define.boot (maybeInsertViewMorphisms): Fix typo. + * interp/debug.lisp (/breakcondition): Declare. + * interp/sys-utility.boot (getSystemModulePath): New. + * interp/daase.lisp (|with|): Remove + (|library|): Move i-syscmd.boot + (initial-getdatabase): Use getSystemModulePath. + (getdatabase): Likewise. + (addoperations): Don't reference package LISP. + (localdatabase): Likewise. + (write-interpdb): Don't declare *print-prett* special. + (write-browsedb): Likewise. + (write-categorydb): Likewise. + 2008-03-18 Gabriel Dos Reis * interp/sys-utility.boot: Define more type abbreviations. diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index 88f599e2..73c1c0a6 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -407,9 +407,7 @@ |OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| |PrimitiveArray| |Integer| |List| |OutputForm|)) (dolist (con constr) - (let ((c (concatenate 'string - (|systemRootDirectory|) "/algebra/" - (string (getdatabase con 'abbreviation)) ".o"))) + (let ((c (|getSystemModulePath| (string (getdatabase con 'abbreviation))))) (format t " preloading ~a.." c) (if (probe-file c) (progn @@ -559,7 +557,7 @@ (let (oldop op) (setq op (car map)) (setq oldop (getdatabase op 'operation)) - (setq oldop (lisp::delete (cdr map) oldop :test #'equal)) + (setq oldop (delete (cdr map) oldop :test #'equal)) (setf (gethash op *operation-hash*) oldop))) (dolist (map (getdatabase constructor 'modemaps)) ; in with the new (let (op newmap) @@ -784,17 +782,14 @@ (if (consp data) (setq data (if (string= (directory-namestring (car data)) "") - (concatenate 'string (|systemRootDirectory|) "algebra/" (car data) ".o") + (|getSystemModulePath| (car data)) (car data))) (when (and data (string= (directory-namestring data) "")) - (setq data (concatenate 'string (|systemRootDirectory|) "algebra/" data ".o"))))))) + (setq data (|getSystemModulePath| data))))))) data)) ; )library top level command -- soon to be obsolete -(defun |with| (args) - (|library| args)) - ;; Current directory ;; Contributed by Juergen Weiss. #+:cmu @@ -805,44 +800,6 @@ (defun get-current-directory () (namestring (truename ""))) - -; )library top level command - -(defun |library| (args) - (declare (special |$options|)) - (declare (special |$newConlist|)) - (setq original-directory (get-current-directory)) - (setq |$newConlist| nil) - (localdatabase args |$options|) -#+:CCL - (dolist (a args) (check-module-exists a)) - (|extendLocalLibdb| |$newConlist|) - (|changeDirectory| original-directory) - (tersyscommand)) - -;; check-module-exists looks to see if a module exists in one of the current -;; libraries and, if not, compiles it. If the output-library exists but has not -;; been opened then it opens it first. -#+:CCL -(defun check-module-exists (module) - (prog (|$options| mdate) - (if (and (not output-library) (filep (or |$outputLibraryName| "user.lib"))) - (seq (setq |$outputLibraryName| - (if |$outputLibraryName| (truename |$outputLibraryName|) - (make-pathname :directory (get-current-directory) - :name "user.lib"))) - (|openOutputLibrary| |$outputLibraryName|))) - (setq mdate (modulep module)) - (setq |$options| '((|nolibrary| nil) (|quiet| nil))) - (|sayMSG| (format nil " Checking for module ~s." (namestring module))) - (let* ((fn (concatenate 'string (namestring module) ".lsp")) - (fdate (filedate fn)) ) - (if (and fdate (or (null mdate) (datelessp mdate fdate))) - (|compileAsharpLispCmd| (list fn)) - (let* ((fn (concatenate 'string (namestring module) ".NRLIB")) - (fdate (filedate fn)) ) - (if (and fdate (or (null mdate) (datelessp mdate fdate))) - (|compileSpadLispCmd| (list fn)))))))) ; localdatabase tries to find files in the order of: ; NRLIB/index.KAF @@ -855,15 +812,15 @@ (processOptions (options) (let (only dir noexpose) (when (setq only (assoc '|only| options)) - (setq options (lisp::delete only options :test #'equal)) + (setq options (delete only options :test #'equal)) (setq only (cdr only))) (when (setq dir (assoc '|dir| options)) - (setq options (lisp::delete dir options :test #'equal)) + (setq options (delete dir options :test #'equal)) (setq dir (second dir)) (when (null dir) (|sayKeyedMsg| 'S2IU0002 nil) )) (when (setq noexpose (assoc '|noexpose| options)) - (setq options (lisp::delete noexpose options :test #'equal)) + (setq options (delete noexpose options :test #'equal)) (setq noexpose 't) ) (when options (format t " Ignoring unknown )library option: ~a~%" options)) @@ -876,8 +833,8 @@ (values (mapcan #'(lambda (f) (when (string-equal (pathname-type f) "NRLIB") - (list (concatenate 'string (namestring f) "/" - *index-filename*)))) allfiles) + (list (concatenate 'string (namestring f) "/" *index-filename*)))) + allfiles) (mapcan #'(lambda (f) (when (string= (pathname-type f) "asy") (push (pathname-name f) skipasos) @@ -889,12 +846,7 @@ allfiles) ;; At the moment we will only look for user.lib: others are taken care ;; of by localasy and localnrlib. -#+:CCL - (mapcan #'(lambda (f) - (when (and (string= (pathname-type f) "lib") (string= (pathname-name f) "user")) - (list (namestring f)))) - allfiles) -#-:CCL nil + nil )))) (let (thisdir nrlibs asos asys libs object only dir key (|$forceDatabaseUpdate| t) noexpose) @@ -921,8 +873,6 @@ (concatenate 'string namedir filename ".ao"))) (push (namestring file) asos)) ('else (format t " )library cannot find the file ~a.~%" filename))))) -#+:CCL - (dolist (file libs) (|addInputLibrary| (truename file))) (dolist (file (nreverse nrlibs)) (setq key (pathname-name (first (last (pathname-directory file))))) (setq object (concatenate 'string (directory-namestring file) @@ -1311,7 +1261,6 @@ (let (opalistpos modemapspos cmodemappos master masterpos obj *print-pretty* concategory categorypos kind niladic cosig abbrev defaultdomain ancestors ancestorspos out) - (declare (special *print-pretty*)) (print "building interp.daase") (setq out (open "interp.build" :direction :output)) (princ " " out) @@ -1369,7 +1318,6 @@ (defun write-browsedb () "make browse.daase from hash tables" (let (master masterpos src formpos docpos attpos predpos *print-pretty* out) - (declare (special *print-pretty*)) (print "building browse.daase") (setq out (open "browse.build" :direction :output)) (princ " " out) @@ -1404,7 +1352,6 @@ (defun write-categorydb () "make category.daase from scratch. contains the *hasCategory-hash* table" (let (out master pos *print-pretty*) - (declare (special *print-pretty*)) (print "building category.daase") (|genCategoryTable|) (setq out (open "category.build" :direction :output)) diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp index 125f352e..95d2145d 100644 --- a/src/interp/debug.lisp +++ b/src/interp/debug.lisp @@ -936,7 +936,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (|sayBrightly| (LIST '|%b| (PNAME X) '|%d| "unembeded" '|%l|)) (UNEMBED X))) )) - +(defvar /breakcondition nil) (defun /MONITOR (&rest G5) (PROG (G1 G4 TRACECODE BEFORE AFTER CONDITION diff --git a/src/interp/define.boot b/src/interp/define.boot index 9993f44a..d49edfd8 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -83,7 +83,7 @@ maybeInsertViewMorphisms body == stmt is ["DEF",["rep",:.],:.] or stmt is ["DEF",["per",:.],:.] => -- ??? We may actually want to stop processing now. - stackSemanticError(['"Cannot define",:bright per],nil) + stackSemanticError(['"Cannot define",:bright "per"],nil) -- OK, insert synthetized view morphisms g := GENSYM() diff --git a/src/interp/foam_l.lisp b/src/interp/foam_l.lisp index 45b9f2da..78a12f1c 100644 --- a/src/interp/foam_l.lisp +++ b/src/interp/foam_l.lisp @@ -73,7 +73,7 @@ (:use "FOAM")) #+:gcl (in-package "BOOT") -#+:gcl (in-package "AxiomCore") +(in-package "AxiomCore") (import-module "vmlisp") (in-package "FOAM") diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 539bf56b..97f96064 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -54,10 +54,10 @@ PPtoFile(x, fname) == ++ Query properties for an entity in a given environment. -get: (%Thing,%Symbol,%List) -> %List -get0: (%Thing,%Symbol,%List) -> %List -get1: (%Thing,%Symbol,%List) -> %List -get2: (%Thing,%Symbol,%List) -> %List +get: (%Thing,%Symbol,%List) -> %Thing +get0: (%Thing,%Symbol,%List) -> %Thing +get1: (%Thing,%Symbol,%List) -> %Thing +get2: (%Thing,%Symbol,%List) -> %Thing get(x,prop,e) == $InteractiveMode => get0(x,prop,e) diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index e51b9261..f0005946 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -2154,6 +2154,15 @@ reportCount () == SAY " " sayBrightly [:bright " stream",fillerSpaces(29,'".")," ",$streamCount] +--% )library +library args == + origDir := GET_-CURRENT_-DIRECTORY() + $newConlist := [] + LOCALDATABASE(args,$options) + extendLocalLibdb $newConlist + changeDirectory origDir + TERSYSCOMMAND() + --% )quit pquit() == pquitSpad2Cmd() diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 0854f714..994b7825 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -92,7 +92,7 @@ SExprToDName(sexpr, cosigVal) == NOT cosigVal => [DNameOtherID, :sexpr] if CAR sexpr = '_: then sexpr := CAR CDR CDR sexpr CAR sexpr = 'Mapping => - args := [ SExprToDName(sx, 'T) for sx in CDR sexpr] + args := [ SExprToDName(sx,true) for sx in CDR sexpr] [DNameApplyID, [DNameStringID,: StringToCompStr '"->"], [DNameTupleID, : CDR args], @@ -100,7 +100,7 @@ SExprToDName(sexpr, cosigVal) == name0 := [DNameStringID, : StringToCompStr SYMBOL_-NAME CAR sexpr] CAR sexpr = 'Union or CAR sexpr = 'Record => [DNameApplyID, name0, - [DNameTupleID,: [ SExprToDName(sx, 'T) for sx in CDR sexpr]]] + [DNameTupleID,: [ SExprToDName(sx,true) for sx in CDR sexpr]]] newCosig := CDR GETDATABASE(CAR sexpr, QUOTE COSIG) [DNameApplyID, name0, : MAPCAR(function SExprToDName, CDR sexpr, newCosig)] @@ -169,7 +169,7 @@ oldAxiomCategoryDefaultPackage(catform, dom) == hasDefaultPackage opOf catform oldAxiomPreCategoryDevaluate([op,:args], env) == - SExprToDName([op,:devaluateList args], T) + SExprToDName([op,:devaluateList args], true) $oldAxiomPreCategoryDispatch := VECTOR('oldAxiomPreCategory, @@ -476,7 +476,7 @@ hashNewLookupInCategories(op,sig,dom,dollar) == valueList := [MKQ val for val in valueList] nsig := MSUBST(dom.0,dollar.0,sig) for i in 0..MAXINDEX packageVec | - (entry := packageVec.i) and entry ^= 'T repeat + (entry := packageVec.i) and entry ^= true repeat package := VECP entry => if $monitorNewWorld then diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index cd3b728d..d925a847 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -370,7 +370,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) == FRESH_-LINE $algebraOutputStream sayMSG fillerSpaces(72,'"-") unloadOneConstructor(op,libName) - LOCALDATABASE(LIST GETDATABASE(op,'ABBREVIATION),NIL) + LOCALDATABASE(LIST SYMBOL_-NAME GETDATABASE(op,'ABBREVIATION),NIL) $newConlist := [op, :$newConlist] ----------> bound in function "compiler" if $lisplibKind = 'category then updateCategoryFrameForCategory op diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp index fa788f2a..289fa580 100644 --- a/src/interp/nlib.lisp +++ b/src/interp/nlib.lisp @@ -35,8 +35,6 @@ (IMPORT-MODULE "macros") (in-package "BOOT") -#+:AKCL (defvar *lisp-bin-filetype* "o") - #+:AKCL (defvar *lisp-source-filetype* "lsp") ;; definition of our stream structure @@ -268,9 +266,8 @@ (rshut nrstream))) filespec) -#+:AKCL (defun recompile-lib-file-if-necessary (lfile) - (let* ((bfile (make-pathname :type *lisp-bin-filetype* :defaults lfile)) + (let* ((bfile (make-pathname :type |$faslType| :defaults lfile)) (bdate (and (probe-file bfile) (file-write-date bfile))) (ldate (and (probe-file lfile) (file-write-date lfile)))) (if ldate @@ -318,7 +315,7 @@ :entrycond (spad-fixed-arg (caar system::arglist)))) (apply #'compile-file fn opts)) (untrace compiler::fast-link-proclaimed-type-p compiler::t1defun))) -#+:CCL +#-:GCL (define-function 'compile-lib-file #'compile-file) ;; (RDROPITEMS filearg keys) don't delete, used in files.spad diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index d4a05010..a70168d9 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -263,7 +263,7 @@ makePredicateBitVector pl == --called by NRTbuildFunctor augmentPredCode(n,lastPl) == ['LIST,:pl] := mungeAddGensyms(lastPl,$predGensymAlist) delta := 2 ** n - l := [(u := MKPF([x,['augmentPredVector,$,delta]],'AND); + l := [(u := MKPF([x,['augmentPredVector,"$",delta]],'AND); delta:=2 * delta; u) for x in pl] augmentPredVector(dollar,value) == diff --git a/src/interp/nspadaux.lisp b/src/interp/nspadaux.lisp index 30e55021..99f7dd50 100644 --- a/src/interp/nspadaux.lisp +++ b/src/interp/nspadaux.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007, Gabriel Dos Reis. +;; Copyright (C) 2007-2008, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -41,21 +41,21 @@ (defvar |$abbreviationStack| nil) (defvar |$knownAttributes| nil "cumulative list of known attributes of a file") -(setq |$underscoreChar| (|char| '_)) +(defparameter |$underscoreChar| (|char| '_)) (defvar |$back| nil) -(setq |$markChoices| '(ATOM COLON LAMBDA AUTOSUBSET AUTOHARD AUTOREP REPPER FREESI RETRACT)) -(setq |$convert2NewCompiler| 'T) -(setq |$AnalyzeOnly| NIL) -(setq |$categoryPart| 'T) -(setq |$insideCAPSULE| nil) -(setq |$insideEXPORTS| nil) -(setq |$originalSignature| nil) -(setq |$insideDEF| nil) -(setq |$insideTypeExpression| nil) -(setq |$spadTightList| '(\.\. \# \' \:\ \: \:\:)) +(defparameter |$markChoices| '(ATOM COLON LAMBDA AUTOSUBSET AUTOHARD AUTOREP REPPER FREESI RETRACT)) +(defparameter |$convert2NewCompiler| 'T) +(defparameter |$AnalyzeOnly| NIL) +(defparameter |$categoryPart| 'T) +(defparameter |$insideCAPSULE| nil) +(defparameter |$insideEXPORTS| nil) +(defparameter |$originalSignature| nil) +(defparameter |$insideDEF| nil) +(defparameter |$insideTypeExpression| nil) +(defparameter |$spadTightList| '(\.\. \# \' \:\ \: \:\:)) -(setq |$PerCentVariableList| '(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10)) +(defparameter |$PerCentVariableList| '(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10)) (mapcar #'(lambda (X) (MAKEPROP (CAR X) 'SPECIAL (CADR X))) '((PART |compPART|) diff --git a/src/interp/packtran.boot b/src/interp/packtran.boot index 9bc69888..84d5f64f 100644 --- a/src/interp/packtran.boot +++ b/src/interp/packtran.boot @@ -36,7 +36,7 @@ import '"sys-macros" )package "BOOT" rePackageTran(sex, package) == - _*PACKAGE_* : fluid := FIND_-PACKAGE STRING package + SETQ(_*PACKAGE_*,FIND_-PACKAGE STRING package) packageTran sex packageTran sex == diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp index 915efc21..cc49ba90 100644 --- a/src/interp/patches.lisp +++ b/src/interp/patches.lisp @@ -32,7 +32,7 @@ ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (import-module "macros") -(import-module "debug") +(import-module "sockio") (import-module "g-timer") (in-package "BOOT") ;;patches for now @@ -81,7 +81,6 @@ (define-function '|isBpiOrLambda| #'FBOUNDP) ;;(defun |isSharpVar| (x) (and (identp x) (char= (elt (pname x) 0) #\#))) -(setq |$useInternalHistoryTable| T) (defvar |$internalHistoryTable| ()) (defun |cpCms| (prefix &optional (string (|getSystemCommandLine|))) (setq string (concat prefix string)) @@ -106,6 +105,7 @@ (defun /RF-1 (ignore) (declare (ignore ignore)) + (declare (special echo-meta)) (let* ((input-file (make-input-filename /EDITFILE)) (lfile ()) (type (pathname-type input-file))) @@ -128,10 +128,6 @@ (defun /EF (&rest foo) (obey (concat "vi " (namestring (make-input-filename /EDITFILE))))) -#-:CCL - (defun user::start () (in-package "BOOT") (boot::|start|)) -#+:CCL - (defun user::start () (setq *package* (find-package "BOOT")) (boot::|start|)) (setq |$algebraOutputStream| (setq |$fortranOutputStream| @@ -172,6 +168,7 @@ (defun |normalizeArgFileName| (l) l) (defun READSPADEXPR () + (declare (special in-stream)) (let* ((line (cdar (preparse in-stream)))) (cond ((or (not (stringp line)) (zerop (SIZE line))) (SAY " Scratchpad -- input") @@ -283,6 +280,7 @@ (defun boot::|printCopyright| () (format t "there is no such thing as a simple job -- ((iHy))~%")) +(defvar |$ViewportProcessToWatch| nil) (defun |setViewportProcess| () (setq |$ViewportProcessToWatch| (stringimage (CDR @@ -348,6 +346,5 @@ ;; (|xdrRead| xfoo (make-array 10 :element-type 'long-float )) ;; (setq *print-array* NIL) -(setq echo-meta nil) (defun /versioncheck (n) (unless (= n /MAJOR-VERSION) (throw 'versioncheck -1))) diff --git a/src/interp/sfsfun-l.lisp b/src/interp/sfsfun-l.lisp index 89242508..810cbe21 100644 --- a/src/interp/sfsfun-l.lisp +++ b/src/interp/sfsfun-l.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007, Gabriel Dos Reis. +;; Copyright (C) 2007-2008, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -63,10 +63,10 @@ (defun rpsi (n x) (|rPsi| n x) ) (defun cpsi (n z) (c-to-s (|cPsi| n (s-to-c z)) )) -(defun rbesselj (n x) (c-to-r (|BesselJ| n x)) )) +(defun rbesselj (n x) (c-to-r (|BesselJ| n x)) ) (defun cbesselj (v z) (c-to-s (|BesselJ| (s-to-c v) (s-to-c z)) )) -(defun rbesseli (n x) (c-to-r (|BesselI| n x)) )) +(defun rbesseli (n x) (c-to-r (|BesselI| n x)) ) (defun cbesseli (v z) (c-to-s (|BesselI| (s-to-c v) (s-to-c z)) )) (defun chyper0f1 (a z) (c-to-s (|chebf01| (s-to-c a) (s-to-c z)) )) diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp index 21b3d8b8..5ef272b0 100644 --- a/src/interp/spad.lisp +++ b/src/interp/spad.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007, Gabriel Dos Reis. +;; Copyright (C) 2007-2008, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -36,6 +36,8 @@ ; PURPOSE: This is an initialization and system-building file for Scratchpad. (IMPORT-MODULE "bootlex") +(import-module "postpar") +(import-module "debug") (in-package "BOOT") ;;; Common Block @@ -53,9 +55,6 @@ (defvar |$newCompAtTopLevel| nil "if t uses new compiler") (defvar |$doNotCompileJustPrint| nil "switch for compile") (defvar |$Rep| '|$Rep| "should be bound to gensym? checked in coerce") -;; the following initialization of $ must not be a defvar -;; since that make $ special -(setq $ '$) ;; used in def of Ring which is Algebra($) (defvar |$scanIfTrue| nil "if t continue compiling after errors") (defvar |$Representation| nil "checked in compNoStacking") (defvar |$definition| nil "checked in DomainSubstitutionFunction") @@ -128,7 +127,7 @@ (LIST X " --> " Y '|%b| |yesOrNo| '|%d|))) (SETQ |$compCount| (1- |$compCount|)) (RETURN U) ))) - (|comp| $x $m $f) + (|comp| |$x| |$m| |$f|) (UNEMBED '|comp|)) (defun READ-SPAD (FN FM TO) @@ -223,11 +222,6 @@ (defun CPSAY (X) (let (n) (if (EQ 0 (setq N (OBEY X))) NIL (PRINT N)))) -(defun /FLAG (L) - (MAKEPROP (FIRST L) 'FLAGS (LET ((X (UNION (CDR L)))) (GET (FIRST L) 'FLAGS))) - (SAY (FIRST L) " has flags: " X) - (TERSYSCOMMAND)) - (defun |fin| () (SETQ *EOF* 'T) (THROW 'SPAD_READER NIL)) @@ -351,10 +345,8 @@ (defun |evalSharpOne| (x \#1) (declare (special \#1)) (EVAL x)) -(setq *PROMPT* 'LISP) - (defun |New,ENTRY,1| () - (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| XCAPE *PROMPT* + (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| XCAPE SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT) $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM XTRANS XTOKENREADER STACK STACKX TRAPFLAG) @@ -362,12 +354,11 @@ XTOKENREADER 'NewSYSTOK SYNTAX_ERROR 'SPAD_SYNTAX_ERROR) (FLAG |boot-NewKEY| 'KEY) - (SETQ *PROMPT* 'Scratchpad-II) (PROMPT) (SETQ XCAPE '_) (SETQ COMMENTCHR 'IGNORE) - (SETQ COLUMN 0) - (SETQ SINGLINEMODE T) ; SEE NewSYSTOK + (SETQ INITCOLUMN 0) + (SETQ SINGLELINEMODE T) ; SEE NewSYSTOK (SETQ NewFLAG T) (SETQ ULCASEFG T) (setq STR (|New,ENTRY,2| '|PARSE-NewEXPR| '|process| curinstream)) @@ -379,7 +370,7 @@ (defun |New,ENTRY,2| (RULE FN INPUTSTREAM) (declare (special INPUTSTREAM)) (let (zz) (INITIALIZE) - (SETQ $previousTime (TEMPUS-FUGIT)) + (SETQ |$previousTime| (TEMPUS-FUGIT)) (setq ZZ (CONVERSATION '|PARSE-NewExpr| '|process|)) (REMFLAG |boot-NewKEY| 'KEY) INPUTSTREAM)) @@ -388,8 +379,6 @@ (init-boot/spad-reader) (initialize-preparse INPUTSTREAM)) -(setq *prompt* 'new) - (defmacro try (X) `(LET ((|$autoLine|)) (declare (special |$autoLine|)) diff --git a/src/interp/spaderror.lisp b/src/interp/spaderror.lisp index 0653b75e..aedfc5f9 100644 --- a/src/interp/spaderror.lisp +++ b/src/interp/spaderror.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007, Gabriel Dos Reis. +;; Copyright (C) 2007-2008, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -44,16 +44,16 @@ ;;(defmacro |trappedSpadEval| (form) form) ;;nop for now #+:akcl -(setq |$quitTag| system::*quit-tag*) +(defconstant |$quitTag| system::*quit-tag*) #+:akcl (defun |resetStackLimits| () (system:reset-stack-limits)) #-:akcl -(setq |$quitTag| (gensym)) +(defconstant |$quitTag| (gensym)) #-:akcl (defun |resetStackLimits| () nil) ;; failed union branch -- value returned for numeric failure -(setq |$numericFailure| (cons 1 "failed")) +(defconstant |$numericFailure| (cons 1 "failed")) (defvar |$oldBreakMode|) diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index 3b119a65..d74c74ba 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -171,3 +171,7 @@ $REPLACE(filespec1,filespec2) == checkMkdir path == mkdir path = 0 => true systemError ['"cannot create directory",:bright path] + +++ return the pathname to the system module designated by `m'. +getSystemModulePath m == + CONCAT(systemRootDirectory(),'"algebra/",m,'".",$faslType) diff --git a/src/interp/trace.boot b/src/interp/trace.boot index 883717c1..d25c4506 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -504,6 +504,7 @@ traceDomainLocalOps(dom,lops,options) == -- nil untraceDomainLocalOps(dom,lops) == + abb := abbreviate dom sayMSG ['" ",:bright abb,'"has no local functions to untrace."] NIL -- lops = "all" => untraceAllDomainLocalOps(dom) -- cgit v1.2.3