diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index 9974eba..d509cbe 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -51643,107 +51643,72 @@ ey."Fitch" := 1984 --S 5 of 20 ey."Char" --R ---R ---RDaly Bug ---R >> Error detected within library code: ---R File is not readable ---R "editor.year" ---R ---R Continuing to read the file... --R +--R (5) 1986 +--R Type: PositiveInteger --E 5 --S 6 of 20 ey("Char") --R ---R ---RDaly Bug ---R >> Error detected within library code: ---R File is not readable ---R "editor.year" ---R ---R Continuing to read the file... --R +--R (6) 1986 +--R Type: PositiveInteger --E 6 --S 7 of 20 ey "Char" --R ---R ---RDaly Bug ---R >> Error detected within library code: ---R File is not readable ---R "editor.year" ---R ---R Continuing to read the file... --R +--R (7) 1986 +--R Type: PositiveInteger --E 7 --S 8 of 20 search("Char", ey) --R ---R ---RDaly Bug ---R >> System error: ---R Cannot create the file NIL/index.kaf. ---R ---R Continuing to read the file... --R +--R (8) 1986 +--R Type: Union(Integer,...) --E 8 --S 9 of 20 search("Smith", ey) --R ---R ---RDaly Bug ---R >> System error: ---R Cannot create the file NIL/index.kaf. ---R ---R Continuing to read the file... --R +--R (9) "failed" +--R Type: Union("failed",...) --E 9 --S 10 of 20 remove!("Char", ey) --R ---R ---RDaly Bug ---R >> System error: ---R Cannot create the file NIL/index.kaf. ---R ---R Continuing to read the file... --R +--R (10) 1986 +--R Type: Union(Integer,...) --E 10 --S 11 of 20 keys ey --R ---R ---RDaly Bug ---R >> System error: ---R Cannot create the file NIL/index.kaf. ---R ---R Continuing to read the file... --R +--R (11) ["Fitch","Caviness"] +--R Type: List String --E 11 --S 12 of 20 #ey --R ---R ---RDaly Bug ---R >> System error: ---R Cannot create the file NIL/index.kaf. ---R ---R Continuing to read the file... --R +--R (12) 2 +--R Type: PositiveInteger --E 12 --S 13 of 20 KE := Record(key: String, entry: Integer) --R --R ---R (5) Record(key: String,entry: Integer) +--R (13) Record(key: String,entry: Integer) --R Type: Domain --E 13 @@ -51751,7 +51716,7 @@ KE := Record(key: String, entry: Integer) reopen!(ey, "output") --R --R ---R (6) "editor.year" +--R (14) "editor.year" --R Type: KeyedAccessFile Integer --E 14 @@ -51759,7 +51724,7 @@ reopen!(ey, "output") write!(ey, ["van Hulzen", 1983]$KE) --R --R ---R (7) [key= "van Hulzen",entry= 1983] +--R (15) [key= "van Hulzen",entry= 1983] --R Type: Record(key: String,entry: Integer) --E 15 @@ -51767,7 +51732,7 @@ write!(ey, ["van Hulzen", 1983]$KE) write!(ey, ["Calmet", 1982]$KE) --R --R ---R (8) [key= "Calmet",entry= 1982] +--R (16) [key= "Calmet",entry= 1982] --R Type: Record(key: String,entry: Integer) --E 16 @@ -51775,7 +51740,7 @@ write!(ey, ["Calmet", 1982]$KE) write!(ey, ["Wang", 1981]$KE) --R --R ---R (9) [key= "Wang",entry= 1981] +--R (17) [key= "Wang",entry= 1981] --R Type: Record(key: String,entry: Integer) --E 17 @@ -51783,35 +51748,28 @@ write!(ey, ["Wang", 1981]$KE) close! ey --R --R ---R (10) "editor.year" +--R (18) "editor.year" --R Type: KeyedAccessFile Integer --E 18 --S 19 of 20 keys ey --R ---R ---RDaly Bug ---R >> System error: ---R Cannot create the file NIL/index.kaf. ---R ---R Continuing to read the file... --R +--R (19) ["Wang","Calmet","van Hulzen","Fitch","Caviness"] +--R Type: List String --E 19 --S 20 of 20 members ey --R ---R ---RDaly Bug ---R >> System error: ---R Cannot create the file NIL/index.kaf. ---R ---R Continuing to read the file... --R +--R (20) [1981,1982,1983,1984,1985] +--R Type: List Integer --E 20 )system rm -r editor.year + )spool )lisp (bye) @ @@ -52004,7 +51962,14 @@ o )show KeyedAccessFile ++ References: ++ Description: ++ This domain allows a random access file to be viewed both as a table -++ and as a file object. +++ and as a file object. The KeyedAccessFile format is a directory +++ containing a single file called ``index.kaf''. This file is a random +++ access file. The first thing in the file is an integer which is the +++ byte offset of an association list (the dictionary) at the end of +++ the file. The association list is of the form +++ ((key . byteoffset) (key . byteoffset)...) +++ where the byte offset is the number of bytes from the beginning of +++ the file. This offset contains an s-expression for the value of the key. KeyedAccessFile(Entry): KAFcategory == KAFcapsule where Name ==> FileName @@ -52032,12 +51997,13 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where fileIOmode: IOMode) defstream(fn: Name, mode: IOMode): FileState == + kafstring:=concat(fn::String,"/index.kaf")::FileName mode = "input" => - not readable? fn => error ["File is not readable", fn] - RDEFINSTREAM(fn::String)$Lisp + not readable? kafstring => error ["File is not readable", fn] + RDEFINSTREAM(fn)$Lisp mode = "output" => not writable? fn => error ["File is not writable", fn] - RDEFOUTSTREAM(fn::String)$Lisp + RDEFOUTSTREAM(fn)$Lisp error ["IO mode must be input or output", mode] ---- From Set ---- @@ -52367,101 +52333,62 @@ LaurentPolynomial(R, UP): Exports == Implementation where --S 1 of 7 stuff := library "Neat.stuff" --R ---R ---RDaly Bug ---R >> Error detected within library code: ---R File is not readable ---R "Neat.stuff" ---R ---R Continuing to read the file... --R +--R (1) "Neat.stuff" +--R Type: Library --E 1 --S 2 of 7 stuff.int := 32**2 --R ---R ---RDaly Bug ---R The form on the left hand side of an assignment must be a single ---R variable, a Tuple of variables or a reference to an entry in an ---R object supporting the setelt operation. +--R +--R (2) 1024 +--R Type: PositiveInteger --E 2 --S 3 of 7 stuff."poly" := x**2 + 1 --R ---R ---RDaly Bug ---R The form on the left hand side of an assignment must be a single ---R variable, a Tuple of variables or a reference to an entry in an ---R object supporting the setelt operation. +--R +--R 2 +--R (3) x + 1 +--R Type: Polynomial Integer --E 3 --S 4 of 7 stuff.str := "Hello" --R ---R ---RDaly Bug ---R The form on the left hand side of an assignment must be a single ---R variable, a Tuple of variables or a reference to an entry in an ---R object supporting the setelt operation. +--R +--R (4) "Hello" +--R Type: String --E 4 --S 5 of 7 keys stuff --R ---R There are 3 exposed and 0 unexposed library operations named keys ---R having 1 argument(s) but none was determined to be applicable. ---R Use HyperDoc Browse, or issue ---R )display op keys ---R to learn more about the available operations. Perhaps ---R package-calling the operation or using coercions on the arguments ---R will allow you to apply the operation. ---R ---RDaly Bug ---R Cannot find a definition or applicable library operation named keys ---R with argument type(s) ---R Variable stuff ---R ---R Perhaps you should use "@" to indicate the required return type, ---R or "$" to specify which version of the function you need. +--R +--R (5) ["str","poly","int"] +--R Type: List String --E 5 --S 6 of 7 stuff.poly --R ---R There are no library operations named stuff ---R Use HyperDoc Browse or issue ---R )what op stuff ---R to learn if there is any operation containing " stuff " in its ---R name. ---R ---RDaly Bug ---R Cannot find a definition or applicable library operation named stuff ---R with argument type(s) ---R Variable poly ---R ---R Perhaps you should use "@" to indicate the required return type, ---R or "$" to specify which version of the function you need. +--R +--R 2 +--R (6) x + 1 +--R Type: Polynomial Integer --E 6 --S 7 of 7 stuff("poly") --R ---R There are no library operations named stuff ---R Use HyperDoc Browse or issue ---R )what op stuff ---R to learn if there is any operation containing " stuff " in its ---R name. ---R ---RDaly Bug ---R Cannot find a definition or applicable library operation named stuff ---R with argument type(s) ---R String ---R ---R Perhaps you should use "@" to indicate the required return type, ---R or "$" to specify which version of the function you need. +--R +--R 2 +--R (7) x + 1 +--R Type: Polynomial Integer --E 7 + )system rm -rf Neat.stuff )spool )lisp (bye) diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet index e1264cb..c748eda 100644 --- a/books/bookvol10.4.pamphlet +++ b/books/bookvol10.4.pamphlet @@ -3734,7 +3734,8 @@ credits() --RPietro Iglio --RAlejandro Jakubi Richard Jenks --RKai Kaminski Grant Keady Tony Kennedy ---RPaul Kosinski Klaus Kusche Bernhard Kutzler +--RTed Kosan Paul Kosinski Klaus Kusche +--RBernhard Kutzler --RTim Lahey Larry Lambe Franz Lehner --RFrederic Lehobey Michel Levaud Howard Levy --RLiu Xiaojun Rudiger Loos Michael Lucks diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 89d9dab..9fea960 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -373,7 +373,8 @@ of effort. We would like to acknowledge and thank the following people: "Pietro Iglio" "Alejandro Jakubi Richard Jenks" "Kai Kaminski Grant Keady Tony Kennedy" -"Paul Kosinski Klaus Kusche Bernhard Kutzler" +"Ted Kosan Paul Kosinski Klaus Kusche" +"Bernhard Kutzler" "Tim Lahey Larry Lambe Franz Lehner" "Frederic Lehobey Michel Levaud Howard Levy" "Liu Xiaojun Rudiger Loos Michael Lucks" @@ -874,14 +875,12 @@ information is initialized. \calls{spad}{setOutputAlgebra} \calls{spad}{runspad} \usesdollar{spad}{PrintCompilerMessageIfTrue} -\usesdollar{spad}{inLispVM} <>= (defun |spad| () "Starts the interpreter but do not read in profiles" - (let (|$PrintCompilerMessageIfTrue| |$inLispVM|) - (declare (special |$PrintCompilerMessageIfTrue| |$inLispVM|)) + (let (|$PrintCompilerMessageIfTrue|) + (declare (special |$PrintCompilerMessageIfTrue|)) (setq |$PrintCompilerMessageIfTrue| nil) - (setq |$inLispVM| nil) (|setOutputAlgebra| '|%initialize%|) (|runspad|) '|EndOfSpad|)) @@ -976,6 +975,12 @@ While not using the ``dollar'' convention this variable is still ``global''. @ +\defdollar{boot} +<>= +(defvar $boot nil) + +@ + \defunsec{ncTopLevel}{Top-level read-parse-eval-print loop} Top-level read-parse-eval-print loop for the interpreter. Uses the Bill Burge's parser. @@ -1084,6 +1089,12 @@ does nothing but print the argument value. @ +\defdollar{newcompMode} +<>= +(defvar |$newcompMode| nil) + +@ + \calls{SpadInterpretStream}{mkprompt} \calls{SpadInterpretStream}{intloopReadConsole} \calls{SpadInterpretStream}{intloopInclude} @@ -1865,6 +1876,12 @@ a top level command @ +\defdollar{useNewParser} +<>= +(defvar |$useNewParser| nil) + +@ + \defun{parseAndInterpret}{parseAndInterpret} \calls{parseAndInterpret}{ncParseAndInterpretString} \calls{parseAndInterpret}{oldParseAndInterpret} @@ -1903,6 +1920,24 @@ a top level command @ +\defdollar{interpOnly} +<>= +(defvar |$interpOnly| nil) + +@ + +\defdollar{minivectorNames} +<>= +(defvar |$minivectorNames| nil) + +@ + +\defdollar{domPvar} +<>= +(defvar |$domPvar| nil) + +@ + \defun{processInteractive}{processInteractive} Parser Output {\tt -->} Interpreter @@ -12228,12 +12263,10 @@ to fill the table, otherwise we do a key lookup in the hash table. \calls{sayMSG2File}{defiostream} \calls{sayMSG2File}{sayBrightly1} \calls{sayMSG2File}{shut} -\usesdollar{sayMSG2File}{listingDirectory} <>= (defun |sayMSG2File| (msg) (let (file str) - (declare (special |$listingDirectory|)) - (setq file (|makePathname| '|spadmsg| '|listing| |$listingDirectory|)) + (setq file (|makePathname| '|spadmsg| '|listing| 'a)) (setq str (defiostream `((mode . output) (file . ,file)) 255 0)) (sayBrightly1 msg str) (shut str))) @@ -15779,6 +15812,12 @@ valid for this level. @ +\defdollar{oldline} +<>= +(defvar $oldline nil "used to output command lines") + +@ + \defun{commandErrorMessage}{No command/option begins with this string} \calls{commandErrorMessage}{commandAmbiguityError} \calls{commandErrorMessage}{sayKeyedMsg} @@ -17614,6 +17653,12 @@ o )undo @ +\defdollar{clearExcept} +<>= +(defvar |$clearExcept| nil) + +@ + \defun{clearSpad2Cmd}{clearSpad2Cmd} TPDHERE: Note that this function also seems to parse out )except )completely and )scaches which don't seem to be documented. @@ -17698,6 +17743,12 @@ TPDHERE: Note that this function also seems to parse out )except @ +\defdollar{functionTable} +<>= +(defvar |$functionTable| nil) + +@ + \defun{clearCmdCompletely}{clearCmdCompletely} \calls{clearCmdCompletely}{clearCmdAll} \calls{clearCmdCompletely}{sayKeyedMsg} @@ -18273,6 +18324,14 @@ o )library \fnref{library}} \section{Functions} + +\defvar{/editfile} +<>= +(defvar /editfile nil) + +@ + + \defun{compiler}{compiler} \calls{compiler}{helpSpad2Cmd} \calls{compiler}{selectOptionLC} @@ -21945,6 +22004,18 @@ back. @ +\defdollar{NonNullStream} +<>= +(defvar |$NonNullStream| "NonNullStream") + +@ + +\defdollar{NullStream} +<>= +(defvar |$NullStream| "NullStream") + +@ + \defun{dewritify,dewritifyInner}{dewritify,dewritifyInner} \calls{dewritify,dewritifyInner}{seq} \calls{dewritify,dewritifyInner}{exit} @@ -23752,9 +23823,9 @@ The input-libraries variable is now maintained as a list of truenames. NOTE: If you add new algebra you must also update this list otherwise the new algebra won't be loaded by the interpreter when needed. -<>= -(eval-when (eval load) - (setq |$globalExposureGroupAlist| +\defdollar{globalExposureGroupAlist} +<>= +(defvar |$globalExposureGroupAlist| '( ;;define the groups |basic| |naglink| |anna| |categories| |Hidden| |defaults| (|basic| @@ -24965,26 +25036,26 @@ otherwise the new algebra won't be loaded by the interpreter when needed. (|UnivariateSkewPolynomialCategory&| . OREPCAT-) (|UnivariateTaylorSeriesCategory&| . UTSCAT-) (|VectorCategory&| . VECTCAT-) - (|VectorSpace&| . VSPACE-))))) + (|VectorSpace&| . VSPACE-)))) @ -<>= -(eval-when (eval load) - (setq |$localExposureDataDefault| +\defdollar{localExposureDataDefault} +<>= +(defvar |$localExposureDataDefault| (vector ;;These groups will be exposed (list '|basic| '|categories| '|naglink| '|anna|) ;;These constructors will be explicitly exposed (list ) ;;These constructors will be explicitly hidden - (list )))) + (list ))) @ -<>= -(eval-when (eval load) - (setq |$localExposureData| (copy-seq |$localExposureDataDefault|))) +\defdollar{localExposureData} +<>= +(defvar |$localExposureData| (copy-seq |$localExposureDataDefault|)) @ @@ -28171,11 +28242,19 @@ The current setting is: Off:CONSOLE 10 to 245 inclusive. The current setting is 77 \end{verbatim} + +\defdollar{margin} +<>= +(defvar $margin 3) + +@ + \defdollar{linelength} <>= (defvar $linelength 77 "line length of output displays") @ + <>= (|length| "line length of output displays" @@ -29733,12 +29812,11 @@ o )what \calls{reportOpsFromLisplib1}{editFile} \usesdollar{reportOpsFromLisplib1}{sayBrightlyStream} \usesdollar{reportOpsFromLisplib1}{erase} -\usesdollar{reportOpsFromLisplib1}{listingDirectory} <>= (defun |reportOpsFromLisplib1| (unitForm u) (let (|$sayBrightlyStream| showFile) - (declare (special |$sayBrightlyStream| $erase |$listingDirectory|)) - (setq showFile (|pathname| (list 'show 'listing |$listingDirectory|))) + (declare (special |$sayBrightlyStream| $erase)) + (setq showFile (|pathname| (list 'show 'listing 'a))) ($erase showFile) (setq |$sayBrightlyStream| (defiostream `((file ,showFile) (mode . output)) 255 0)) @@ -30009,12 +30087,11 @@ o )what \calls{reportOpsFromUnitDirectly1}{editFile} \usesdollar{reportOpsFromUnitDirectly1}{sayBrightlyStream} \usesdollar{reportOpsFromUnitDirectly1}{erase} -\usesdollar{reportOpsFromUnitDirectly1}{listingDirectory} <>= (defun |reportOpsFromUnitDirectly1| (D) (let (|$sayBrightlyStream| showFile) - (declare (special |$sayBrightlyStream| $erase |$listingDirectory|)) - (setq showFile (|pathname| (list 'show 'listing |$listingDirectory|))) + (declare (special |$sayBrightlyStream| $erase)) + (setq showFile (|pathname| (list 'show 'listing 'a))) ($erase showFile) (setq |$sayBrightlyStream| (defiostream `((file ,showFile) (mode . output)) 255 0)) @@ -32773,6 +32850,12 @@ to convert the data into type "Expression" @ +\defdollar{constructors} +<>= +(defvar |$constructors| nil) + +@ + \defun{traceReply}{traceReply} \calls{traceReply}{sayMessage} \calls{traceReply}{sayBrightly} @@ -34570,6 +34653,12 @@ o )library @ +\defdollar{noSubsumption} +<>= +(defvar |$noSubsumption| t) + +@ + \defun{spad}{spad} \catches{spad}{spad-reader} \calls{spad}{addBinding} @@ -34796,15 +34885,27 @@ searchCurrentEnv(x,currentEnv) == @ +\defdollar{spad-errors} +<>= +(defvar $spad_errors (vector 0 0 0)) + +@ + +\defvar{xtokenreader} +<>= +(defvar xtokenreader 'spadtok) + +@ + \defun{init-boot/spad-reader}{Initialize the spad reader} \calls{init-boot/spad-reader}{next-lines-clear} \calls{init-boot/spad-reader}{ioclear} -%\usesdollar{init-boot/spad-reader}{spad\_errors} +\usesdollar{init-boot/spad-reader}{spad-errors} \uses{init-boot/spad-reader}{spaderrorstream} \uses{init-boot/spad-reader}{*standard-output* } \uses{init-boot/spad-reader}{xtokenreader} \uses{init-boot/spad-reader}{line-handler} -%\uses{init-boot/spad-reader}{meta\_error\_handler} +\uses{init-boot/spad-reader}{meta-error-handler} \uses{init-boot/spad-reader}{file-closed} \uses{init-boot/spad-reader}{boot-line-stack} <>= @@ -35167,9 +35268,15 @@ gets the index into the EBCDIC table, and returns the appropriate character. @ \defun{probeName}{probeName} +Sometimes we are given a file and sometimes we are given the name of +an Axiom KAF (Keyed-Access File). KAF files are actually directories +with a single file called ``index.kaf''. We check for the latter case +and return the directory name as the filename, per Axiom convention. <>= (defun probeName (file) - (if (probe-file file) (namestring file) nil)) + (when (or (probe-file file) + (probe-file (concatenate 'string (namestring file) "/index.kaf"))) + (namestring file))) @ @@ -39379,6 +39486,10 @@ This needs to work off the internal exposure list, not the file. \chapter{The Interpreter} <>= +(setq *print-array* nil) +(setq *print-circle* nil) +(setq *print-pretty* nil) + (in-package "BOOT") <> @@ -40841,7 +40952,6 @@ curoutstream & ncIntLoop & \\ \$historyDirectory & & makeHistFileName \\ & & makeHistFileName \\ \$historyFileType & initvars & histInputFileName \\ -\$inLispVM & spad & \\ \$InteractiveFrame & restart & ncTopLevel \\ & undo & recordFrame \\ & undoSteps & undoSteps \\ @@ -41004,12 +41114,6 @@ move around the ring. The \verb|$interpreterFrameRing| is set to a pair whose car is set to the result of emptyInterpreterFrame -\subsection{\$inLispVM} -The \verb|$inLispVM| is set to NIL in spad. LispVM is a -non-common lisp that runs on IBM/370 mainframes. This is probably dead -code. It appears that this list has the same structure as an argument -to the LispVM rdefiostream function. - \subsection{\$InteractiveFrame} The \verb|$InteractiveFrame| is set in restart to the value of the call to the makeInitialModemapFrame function. This function simply diff --git a/changelog b/changelog index 0025175..05f3faa 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,17 @@ +20100306 tpd src/axiom-website/patches.html 2010306.01.tzk.patch +20100306 tpd src/interp/vmlisp.lisp treeshake +20100306 tpd src/interp/util.lisp treeshake +20100306 tpd src/interp/patches.lisp treeshake +20100306 tpd src/interp/parsing.lisp treeshake +20100306 tpd src/interp/nrunfast.lisp treeshake +20100306 tpd src/interp/newaux.lisp treeshake +20100306 tpd src/interp/lisplib.lisp treeshake +20100306 tpd src/interp/format.lisp treeshake +20100306 tpd src/input/Makefile remove redundant kafile.input +20100306 tpd src/input/kafile.input redundant with KAFILE test, removed +20100306 tpd books/bookvol5 treeshake vmlisp +20100306 tpd books/bookvol10.4 add Ted Kosan to credits +20100306 tpd books/bookvol10.3 defstream function and KAFILE test bug fixed 20100304 tpd src/axiom-website/patches.html 2010304.01.tzk.patch 20100304 tpd readme add Ted Kosan to credits 20100304 tpd books/bookvol5 add Ted Kosan to credits diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 2114af9..4dbae87 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2509,5 +2509,7 @@ src/interp/*.lisp.pamphlet remove MAKESTRING macro
books/bookvol10.3 fix IndexedBits range error
20100304.01.tzk.patch src/axiom-website/download.html git-clone to git clone
+20100306.01.tpd.patch +books/bookvol5 treeshake vmlisp, bookvol10.3 defstream bug fix
diff --git a/src/input/Makefile.pamphlet b/src/input/Makefile.pamphlet index 9bb11f9..1e253f4 100644 --- a/src/input/Makefile.pamphlet +++ b/src/input/Makefile.pamphlet @@ -337,7 +337,7 @@ REGRES= ackermann.regress \ intef2.regress intef.regress intg0.regress intheory.regress \ intmix2.regress intmix.regress int.regress intrf.regress \ iprntpk.regress \ - ipftest.regress is.regress isprime.regress kafile.regress \ + ipftest.regress is.regress isprime.regress \ kamke0.regress kamke1.regress kamke2.regress kamke3.regress \ kamke4.regress kamke5.regress kamke6.regress kamke7.regress \ kernel.regress knot2.regress kovacic.regress kuipers.regress \ @@ -628,7 +628,7 @@ FILES= ${OUT}/ackermann.input \ ${OUT}/intg0.input ${OUT}/intheory.input ${OUT}/int.input \ ${OUT}/intlf.input ${OUT}/intmix.input ${OUT}/intrf.input \ ${OUT}/ipftest.input ${OUT}/is.input ${OUT}/isprime.input \ - ${OUT}/kafile.input ${OUT}/kamke0.input ${OUT}/kamke1.input \ + ${OUT}/kamke0.input ${OUT}/kamke1.input \ ${OUT}/kamke2.input ${OUT}/kamke3.input ${OUT}/kamke4.input \ ${OUT}/kamke5.input ${OUT}/kamke6.input ${OUT}/kamke7.input \ ${OUT}/kernel.input ${OUT}/knot.input \ @@ -947,7 +947,7 @@ DOCFILES= \ ${DOC}/intlf.input.dvi ${DOC}/intmix2.input.dvi \ ${DOC}/intmix.input.dvi ${DOC}/intrf.input.dvi \ ${DOC}/ipftest.input.dvi ${DOC}/is.input.dvi \ - ${DOC}/isprime.input.dvi ${DOC}/kafile.input.dvi \ + ${DOC}/isprime.input.dvi \ ${DOC}/kamke0.input.dvi ${DOC}/kamke1.input.dvi \ ${DOC}/kamke2.input.dvi ${DOC}/kamke3.input.dvi \ ${DOC}/kamke4.input.dvi ${DOC}/kamke5.input.dvi \ diff --git a/src/input/kafile.input.pamphlet b/src/input/kafile.input.pamphlet deleted file mode 100644 index d718957..0000000 --- a/src/input/kafile.input.pamphlet +++ /dev/null @@ -1,75 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/input kafile.input} -\author{Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -\begin{chunk}{license} ---Copyright The Numerical Algorithms Group Limited 1991. -\end{chunk} -\begin{chunk}{*} -)set break resume -)spool kafile.output -)set message test on -)set message auto off -)clear all ---S 1 of 5 -ey: KeyedAccessFile(Integer) := open("/tmp/editor.year", "output") ---R ---R ---R (1) "/tmp/editor.year" ---R Type: KeyedAccessFile Integer ---E 1 - ---S 2 of 5 -ey."Char" := 1986 ---R ---R ---R (2) 1986 ---R Type: PositiveInteger ---E 2 - ---S 3 of 5 -ey."Caviness" := 1985 ---R ---R ---R (3) 1985 ---R Type: PositiveInteger ---E 3 - ---S 4 of 5 -ey."Fitch" := 1984 ---R ---R ---R (4) 1984 ---R Type: PositiveInteger ---E 4 - ---S 5 of 5 -ey."Char" ---R ---R ---RDaly Bug ---R >> Error detected within library code: ---R File is not readable ---R "/tmp/editor.year" ---R ---R Continuing to read the file... ---R ---E 5 -)spool -)lisp (bye) - -\end{chunk} -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} - diff --git a/src/interp/format.lisp.pamphlet b/src/interp/format.lisp.pamphlet index ad17955..4126a18 100644 --- a/src/interp/format.lisp.pamphlet +++ b/src/interp/format.lisp.pamphlet @@ -1598,7 +1598,6 @@ ;formJoin1(op,u) == ; if op = 'Join then [:argl,last] := u else (argl := nil; last := [op,:u]) ; last is [id,.,:r] and id in '(mkCategory CATEGORY) => -; $abbreviateJoin = true => concat(formJoin2 argl,'%b,'"with",'%d,'"...") ; $permitWhere = true => ; opList:= formatJoinKey(r,id) ; $whereList:= concat($whereList,"%l",$declVar,": ", @@ -1611,8 +1610,7 @@ (DEFUN |formJoin1| (|op| |u|) (PROG (|LETTMP#1| |argl| |last| |id| |ISTMP#1| |r| |opList| |suffix|) - (DECLARE (SPECIAL |$declVar| |$whereList| |$permitWhere| - |$abbreviateJoin|)) + (DECLARE (SPECIAL |$declVar| |$whereList| |$permitWhere|)) (RETURN (PROGN (COND @@ -1629,9 +1627,6 @@ (PROGN (SPADLET |r| (QCDR |ISTMP#1|)) 'T))) (|member| |id| '(|mkCategory| CATEGORY))) (COND - ((BOOT-EQUAL |$abbreviateJoin| 'T) - (|concat| (|formJoin2| |argl|) '|%b| "with" - '|%d| "...")) ((BOOT-EQUAL |$permitWhere| 'T) (SPADLET |opList| (|formatJoinKey| |r| |id|)) (SPADLET |$whereList| diff --git a/src/interp/lisplib.lisp.pamphlet b/src/interp/lisplib.lisp.pamphlet index a807429..348fdb2 100644 --- a/src/interp/lisplib.lisp.pamphlet +++ b/src/interp/lisplib.lisp.pamphlet @@ -890,8 +890,8 @@ ; throwKeyedMsg("S2IL0004",[fun]) ; SETQ(_/EDITFILE,infile) ; outfile := outfileOrNil or -; [libName,'OUTPUT,$listingDirectory] --always QUIET -; _$ERASE(libName,'OUTPUT,$listingDirectory) +; [libName,'OUTPUT,'a] --always QUIET +; _$ERASE(libName,'OUTPUT,'a) ; outstream:= DEFSTREAM(outfile,'OUTPUT) ; val:= _/D_,2_,LIB(fun,infile,outstream,auxOp,editFlag,traceFlag) ; val @@ -917,7 +917,7 @@ |$lisplibOperationAlist| |$lisplibOpAlist| |$lisplibSuperDomain| |$libFile| |$lisplibVariableAlist| |$lisplibSignatureAlist| - |$listingDirectory| $ERASE /EDITFILE)) + $ERASE /EDITFILE)) (RETURN (PROGN (SPADLET $PRETTYPRINT 'T) @@ -951,8 +951,8 @@ (OR |outfileOrNil| (CONS |libName| (CONS 'OUTPUT - (CONS |$listingDirectory| NIL))))) - ($ERASE |libName| 'OUTPUT |$listingDirectory|) + (CONS 'a NIL))))) + ($ERASE |libName| 'OUTPUT 'a) (SPADLET |outstream| (DEFSTREAM |outfile| 'OUTPUT)) (SPADLET |val| (|/D,2,LIB| |fun| |infile| |outstream| |auxOp| @@ -1003,7 +1003,7 @@ ; ok := true), ; RSHUT $libFile) ; if ok then lisplibDoRename(libName) -; filearg := $FILEP(libName,$spadLibFT,$libraryDirectory) +; filearg := $FILEP(libName,$spadLibFT,'a) ; RPACKFILE filearg ; FRESH_-LINE $algebraOutputStream ; sayMSG fillerSpaces(72,'"-") @@ -1032,8 +1032,7 @@ |$lisplibModemapAlist| |$lisplibSlot1| |$lisplibOperationAlist| |$lisplibSuperDomain| |$libFile| |$lisplibVariableAlist| - |$lisplibCategory| |$libraryDirectory| - |$compileDocumentation|)) + |$lisplibCategory| |$compileDocumentation|)) (RETURN (PROGN (COND ((EQ (CAR |df|) 'DEF) (CAR |df|))) @@ -1086,7 +1085,7 @@ (RSHUT |$libFile|)) (COND (|ok| (|lisplibDoRename| |libName|))) (SPADLET |filearg| - ($FILEP |libName| |$spadLibFT| |$libraryDirectory|)) + ($FILEP |libName| |$spadLibFT| 'a)) (RPACKFILE |filearg|) (FRESH-LINE |$algebraOutputStream|) (|sayMSG| (|fillerSpaces| 72 "-")) (|unloadOneConstructor| |op| |libName|) @@ -1153,9 +1152,9 @@ |version|)))) ;initializeLisplib libName == -; _$ERASE(libName,'ERRORLIB,$libraryDirectory) +; _$ERASE(libName,'ERRORLIB,'a) ; SETQ(ERRORS,0) -- ERRORS is a fluid variable for the compiler -; $libFile:= writeLib1(libName,'ERRORLIB,$libraryDirectory) +; $libFile:= writeLib1(libName,'ERRORLIB,'a) ; ADDOPTIONS('FILE,$libFile) ; $lisplibForm := nil --defining form for lisplib ; $lisplibModemap := nil --modemap for constructor form @@ -1173,17 +1172,17 @@ ; then LAM_,FILEACTQ('VERSION,['_/VERSIONCHECK,_/MAJOR_-VERSION]) (DEFUN |initializeLisplib| (|libName|) - (declare (special $ERASE |$libraryDirectory| |$libFile| |$lisplibForm| + (declare (special $ERASE |$libFile| |$lisplibForm| |$lisplibModemap| |$lisplibKind| |$lisplibModemapAlist| |$lisplibAbbreviation| |$lisplibAncestors| |$lisplibOpAlist| |$lisplibOperationAlist| |$lisplibSuperDomain| |$lisplibVariableAlist| |$lisplibSignatureAlist| /EDITFILE /MAJOR-VERSION ERRORS)) (PROGN - ($ERASE |libName| 'ERRORLIB |$libraryDirectory|) + ($ERASE |libName| 'ERRORLIB 'a) (SETQ ERRORS 0) (SPADLET |$libFile| - (|writeLib1| |libName| 'ERRORLIB |$libraryDirectory|)) + (|writeLib1| |libName| 'ERRORLIB 'a)) (ADDOPTIONS 'FILE |$libFile|) (SPADLET |$lisplibForm| NIL) (SPADLET |$lisplibModemap| NIL) @@ -1341,15 +1340,15 @@ (|bright| |libName|))))))))))))) ;lisplibDoRename(libName) == -; _$REPLACE([libName,$spadLibFT,$libraryDirectory], -; [libName,'ERRORLIB,$libraryDirectory]) +; _$REPLACE([libName,$spadLibFT,'a], +; [libName,'ERRORLIB,'a]) (DEFUN |lisplibDoRename| (|libName|) - (declare (special |$libraryDirectory| |$spadLibFT|)) + (declare (special |$spadLibFT|)) (replaceFile (CONS |libName| - (CONS |$spadLibFT| (CONS |$libraryDirectory| NIL))) - (CONS |libName| (CONS 'ERRORLIB (CONS |$libraryDirectory| NIL))))) + (CONS |$spadLibFT| (CONS 'a NIL))) + (CONS |libName| (CONS 'ERRORLIB (CONS 'a NIL))))) ;lisplibError(cname,fname,type,cn,fn,typ,error) == ; sayMSG bright ['" Illegal ",$spadLibFT] diff --git a/src/interp/newaux.lisp.pamphlet b/src/interp/newaux.lisp.pamphlet index 700f4db..bb1c50a 100644 --- a/src/interp/newaux.lisp.pamphlet +++ b/src/interp/newaux.lisp.pamphlet @@ -65,9 +65,6 @@ <>= ; ** TABLE CREATION -(defparameter OpAssoc nil - "Information used by OUT BOOT operator pretty printing routines") - (defun MAKENEWOP (X Y) (MAKEOP X Y '|PARSE-NewKEY|)) (defun MAKEOP (X Y KEYNAME) @@ -77,7 +74,6 @@ (NOT (MEMBER (FIRST X) (EVAL KEYNAME)))) (SET KEYNAME (CONS (FIRST X) (EVAL KEYNAME)))) (MAKEPROP (FIRST X) Y X) - (SETQ OPASSOC (ADDASSOC Y (CONS (CONS X X) (LASSOC Y OPASSOC)) OPASSOC)) (SECOND X)) (setq |PARSE-NewKEY| nil) ;;list of keywords diff --git a/src/interp/nrunfast.lisp.pamphlet b/src/interp/nrunfast.lisp.pamphlet index c65ebd5..d85ae8c 100644 --- a/src/interp/nrunfast.lisp.pamphlet +++ b/src/interp/nrunfast.lisp.pamphlet @@ -21,7 +21,6 @@ ; $NRTvec := true ; $NRTmakeCompactDirect := true ; $NRTquick := true -; $NRTmakeShortDirect := true ; $newWorld := true ; $monitorNewWorld := false ; $consistencyCheck := false @@ -31,19 +30,14 @@ ; $doNotCompressHashTableIfTrue := true (DEFUN |initNewWorld| () - (declare (special |$NRTflag| |$NRTvec| |$NRTmakeCompactDirect| |$NRTquick| - |$NRTmakeShortDirect| |$newWorld| |$monitorNewWorld| - |$consistencyCheck| |$spadLibFT| |$NRTmonitorIfTrue| + (declare (special |$NRTflag| |$NRTvec| |$NRTmakeCompactDirect| + |$monitorNewWorld| |$spadLibFT| |$NRTmonitorIfTrue| |$updateCatTableIfTrue| |$doNotCompressHashTableIfTrue|)) (PROGN (SPADLET |$NRTflag| 'T) (SPADLET |$NRTvec| 'T) (SPADLET |$NRTmakeCompactDirect| 'T) - (SPADLET |$NRTquick| 'T) - (SPADLET |$NRTmakeShortDirect| 'T) - (SPADLET |$newWorld| 'T) (SPADLET |$monitorNewWorld| NIL) - (SPADLET |$consistencyCheck| NIL) (SPADLET |$spadLibFT| '|nrlib|) (SPADLET |$NRTmonitorIfTrue| NIL) (SPADLET |$updateCatTableIfTrue| NIL) diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index 6b18675..59723bd 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -875,61 +875,8 @@ Symbolics read-line returns embedded newlines in a c-m-Y.") (reduction-print :do-it ',rule)))) rules))) -#+Symbolics -(defmacro runtrace () `(zl:unadvise)) - -(defmacro tracemeta (&rest l) `(trmeta ',l)) - (defparameter /depth 0 "Used in Debug.lisp.") -(defun trmeta (l) (setq /depth 0) (mapc #'trmeta1 l)) - -(defun trmeta1 (x) - (let (y) - (if (not (fboundp x)) - (if (fboundp (setq y (internl $lastprefix (pname x)))) - (moan (format nil "********* ~S RENAMED AS ~S" x (setq x y))) - (croak (format nil "********* ~S MUST BE GIVEN PREFIX" x)))) - (/embed-1 x - (sublislis - (list (pname x) x (gensym)) - '(nam* fun* argl*) - '(lambda (&rest argl*) - (prog (v tok) - (terpri) - (trblanks (* 2 /depth)) (setq /depth (+ 1 /depth)) - (princ (stringimage /depth)) (princ "<") - (princ nam*) (trargprint argl*) (princ "/") - (princ "chr= ") (prin1 (Current-Char)) - (princ "/tok= ") (prin1 (setq tok (current-symbol))) - (princ "/col= ") (prin1 (line-current-index current-line)) - ;; (princ "/icol= ") (prin1 initcolumn) - (cond ( (not nonblank) (go a1))) (princ "/nblnk= T") - a1 ;;(cond (ok (go b1))) (princ "/ok= NIL") - b1 ;;(cond ( (not stackx) (go c1))) (princ "/stackx= ") - ;;(prin1 stackx) - c1 (cond ( (not (identp tok)) (go d1))) - (princ "/isid= ") - ;; (princ (cond (isid "T") (t "NIL"))) - d1 (princ "/stack= ") (prin1 (stack-store reduce-stack)) - (setq v (apply fun* argl*)) (setq /depth (- /depth 1)) - (terpri) - (trblanks (* 2 /depth)) (princ (stringimage (\1+ /depth))) - (princ ">") (princ nam*) - (princ "/chr= ") (prin1 (Current-Char)) - (princ "/tok= ") (prin1 (setq tok (current-symbol))) - (princ "/col= ") (prin1 (line-current-index current-line)) - (if (not nonblank) (go a2)) (princ "/nblnk= ") - (princ (if nonblank "T" "NIL")) - a2 ;;(if ok (go b2)) (princ "/ok= ") (prin1 ok) - b2 ;;(if (not stackx) (go c2)) (princ "/stackx1= ") (prin1 stackx) - c2 (if (not (identp tok)) (go d2)) - (princ "/isid= ") - ;; (princ (if isid "T" "NIL")) - d2 (princ "/stack= ") (prin1 (stack-store reduce-stack)) - (princ "/value= ") (prin1 v) - (return v))))))) - (defun /embed-1 (x y) (princ (strconc (pname x) " embedded")) (terpri) @@ -1325,7 +1272,7 @@ or the chracters ?, !, ' or %" (defun-parse-token KEYWORD) (defun-parse-token ARGUMENT-DESIGNATOR) -(defun |boot-LEXPR| () (SETQ $NBOOT T) (New-LEXPR1)) +(defun |boot-LEXPR| () (New-LEXPR1)) (defun TRANSLABEL (X AL) (TRANSLABEL1 X AL) X) @@ -1683,27 +1630,7 @@ foo defined inside of fum gets renamed as fum,foo.") ('T (RETURN (LIST 'PROGN F1 F2)) )) ) ((EQCAR FORM 'ELT) (RETURN (DEFTRAN (LIST 'SETELT (CADR FORM) (CADDR FORM) RHS)) ))) - (RETURN - (COND (|$useDCQnotLET| (|defLETdcq| FORM (DEFTRAN RHS))) - ('T (|defLET| FORM (DEFTRAN RHS))))))) - -(defun |defLETdcq| (FORM RHS &AUX G NAME) - ;; see defLET in G-BOOT BOOT - (COND - ((IDENTP FORM) (LIST 'SPADLET FORM RHS)) - ((IDENTP RHS) - (LIST 'COND (LIST (DEFTRAN (LIST 'IS RHS FORM)) RHS) - (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING - (MK_LEFORM FORM)) RHS)))) - ((AND (EQ (CAR RHS) 'SPADLET) (IDENTP (SETQ NAME (CADR RHS)) )) - (LIST 'COND (LIST (SUBST RHS ' (DEFTRAN (LIST 'IS ' FORM))) NAME) - (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING - (MK_LEFORM FORM)) NAME)))) - ('T (SPADLET G (GENSYM)) - (LIST 'COND (LIST (SUBST (LIST 'SPADLET G RHS) G - (DEFTRAN (LIST 'IS G FORM))) G) - (LIST ''T (LIST 'LET_ERROR (LIST 'MAKESTRING - (MK_LEFORM FORM)) G)) ) ))) + (RETURN (|defLET| FORM (DEFTRAN RHS))))) (defun MK_LEFORM (U) (COND ((IDENTP U) (PNAME U)) @@ -3805,12 +3732,26 @@ parse ;parseType x == ; x := substitute($EmptyMode,$quadSymbol,x) ; x is ['typeOf,val] => ['typeOf,parseTran val] -; $oldParserExpandAbbrs => parseTypeEvaluate unabbrevAndLoad x ; x ;;; *** |parseType| REDEFINED -(DEFUN |parseType| (|x|) (PROG (|ISTMP#1| |val|) (RETURN (PROGN (SPADLET |x| (MSUBST |$EmptyMode| |$quadSymbol| |x|)) (COND ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE |typeOf|)) (PROGN (SPADLET |ISTMP#1| (QCDR |x|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |val| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE |typeOf|) (CONS (|parseTran| |val|) NIL))) (|$oldParserExpandAbbrs| (|parseTypeEvaluate| (|unabbrevAndLoad| |x|))) ((QUOTE T) |x|)))))) +(defun |parseType| (x) + (let (tmp1 val) + (setq x (msubst |$EmptyMode| |$quadSymbol| x)) + (cond + ((and (pairp x) + (eq (qcar x) '|typeOf|) + (progn + (setq tmp1 (qcdr x)) + (and (pairp tmp1) + (eq (qcdr tmp1) nil) + (progn + (spadlet val (qcar tmp1)) + t)))) + (cons '|typeOf| (cons (|parseTran| val) nil))) + (t x)))) + ; ;parseTypeEvaluate form == ; form is [op,:argl] => diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet index 1ee8443..47a7196 100644 --- a/src/interp/patches.lisp.pamphlet +++ b/src/interp/patches.lisp.pamphlet @@ -269,13 +269,7 @@ It used to read: (define-function '|isLowerCaseLetter| #'LOWER-CASE-P) (define-function '|isUpperCaseLetter| #'UPPER-CASE-P) (define-function '|isLetter| #'ALPHA-CHAR-P) -;; reset from /spad/lisp/setq.lisp -(setq |$consistencyCheck| ()) ;; prevents wasting time checking consistency - -#+(or :CCL (and :lucid :ibm/370)) -(setq vmlisp::$current-directory (truename ".")) -#-(or :CCL (and :lucid :ibm/370)) (setq vmlisp::$current-directory (make-directory *default-pathname-defaults*)) #+:AKCL (proclaim '(ftype (function (t) t) identity)) diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet index 5cf9a88..2c90e14 100644 --- a/src/interp/util.lisp.pamphlet +++ b/src/interp/util.lisp.pamphlet @@ -163,7 +163,6 @@ After this function is called the image is clean and can be saved. ; -- The function start begins the interpreter process, reading in ; -- the profile and printing start-up messages. ; $PrintCompilerMessageIfTrue: local := nil -; $inLispVM : local := nil ; if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"interpreter"]) ; initializeTimedNames($interpreterTimedNames,$interpreterTimedClasses) ; statisticsInitialization() @@ -208,8 +207,8 @@ After this function is called the image is clean and can be saved. <>= (DEFUN |start| (&REST G166080 &AUX |l|) (DSETQ |l| G166080) - (PROG (|$PrintCompilerMessageIfTrue| |$inLispVM|) - (DECLARE (SPECIAL |$PrintCompilerMessageIfTrue| |$inLispVM| |$superHash| + (PROG (|$PrintCompilerMessageIfTrue|) + (DECLARE (SPECIAL |$PrintCompilerMessageIfTrue| |$superHash| $OLDLINE $LINELENGTH |$displayStartMsgs| $CURRENT-DIRECTORY *DEFAULT-PATHNAME-DEFAULTS* $SPADROOT |$IOindex| |$ruleSetsInitialized| @@ -218,7 +217,6 @@ After this function is called the image is clean and can be saved. (RETURN (PROGN (SPADLET |$PrintCompilerMessageIfTrue| NIL) - (SPADLET |$inLispVM| NIL) (COND (|$displayStartMsgs| (|sayKeyedMsg| 'S2IZ0053 diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index ed9e1b6..9fed12e 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -1930,7 +1930,7 @@ Camm issued a fix. This used to read: (fullname nil) (indextable nil)) (cond ((equal (elt (string mode) 0) #\I) - (setq fullname (boot::makeInputFilename (cdr file) 'NIL)) + (setq fullname (boot::makeInputFilename (cdr file) nil)) (setq stream (get-input-index-stream fullname)) (if (null stream) (if missing-file-error-flag @@ -1943,7 +1943,7 @@ Camm issued a fix. This used to read: :indexstream stream))) ((equal (elt (string mode) 0) #\O) ;;(setq fullname (boot::makeFullNamestring (cdr file) 'LISPLIB)) - (setq fullname (boot::makeFullNamestring (cdr file) 'NIL)) + (setq fullname (boot::makeFullNamestring (cdr file) nil)) (case (directory? fullname) (-1 (makedir fullname)) (0 (error (format nil "~s is an existing file, not a library" fullname))) @@ -2161,21 +2161,17 @@ do the compile, and then rename the result back to code.o. ;; cms file operations (defun make-filename (filearg &optional (filetype nil)) - (let ((filetype (if (symbolp filetype) + (let ((filetype (if (and filetype (symbolp filetype)) (symbol-name filetype) filetype))) (cond ((pathnamep filearg) (cond ((pathname-type filearg) (namestring filearg)) - (t (namestring (make-pathname :directory (pathname-directory filearg) - :name (pathname-name filearg) - :type filetype))))) - ;; Previously, given a filename containing "." and - ;; an extension this function would return filearg. MCD 23-8-95. + (t (namestring + (make-pathname :directory (pathname-directory filearg) + :name (pathname-name filearg) + :type filetype))))) ((and (stringp filearg) (pathname-type filearg) (null filetype)) filearg) - ;; ((and (stringp filearg) - ;; (or (pathname-type filearg) (null filetype))) - ;; filearg) ((and (stringp filearg) (stringp filetype) (pathname-type filearg) (string-equal (pathname-type filearg) filetype)) @@ -2382,7 +2378,6 @@ do the compile, and then rename the result back to code.o. (def-boot-val |$currentLine| "" "current input line for history") (def-boot-val $delay 0 "???") (def-boot-var $Directory "???") -(def-boot-var $DISPLAY "???") (def-boot-val |$Domain| '(|Domain|) "???") (def-boot-var |$DomainFrame| "???") (def-boot-val |$DomainNames| @@ -2451,7 +2446,6 @@ which will walk the structure $Y$ looking for this constant. (def-boot-val |$InitialDomainsInScope| '((|Boolean|) |$EmptyMode| |$NoValueMode|) "???") -(def-boot-var |$inLispVM| "Interpreter>Eval.boot") (def-boot-var |$insideCapsuleFunctionIfTrue| "???") (def-boot-var |$insideCategoryIfTrue| "???") (def-boot-var |$insideCoerceInteractiveHardIfTrue| "???") @@ -2468,19 +2462,15 @@ which will walk the structure $Y$ looking for this constant. (def-boot-val |$InteractiveModemapFrame| '((NIL)) "???") (def-boot-var |$InteractiveTimingStatsIfTrue| "???") (def-boot-var |$LastCxArg| "???") -(def-boot-val $lastprefix "S-" "???") (def-boot-val |$lastUntraced| NIL "Used for )restore option of )trace.") (def-boot-var |$leaveLevelStack| "???") (def-boot-var |$leaveMode| "???") -(def-boot-val |$leftPren| "(" "For use in SAY expressions.") (def-boot-val |$letAssoc| NIL "Used for trace of assignments in SPAD code.") (def-boot-var |$libFile| "Compiler>LispLib.boot") (def-boot-var $LINENUMBER "???") (def-boot-var $linestack "???") (def-boot-val |$Lisp| '(|Lisp|) "???") (def-boot-val $LISPLIB nil "whether to produce a lisplib or not") -(def-boot-var |$lisplibDependentCategories| "Compiler>LispLib.boot") -(def-boot-var |$lisplibDomainDependents| "Compiler>LispLib.boot") (def-boot-var |$lisplibForm| "Compiler>LispLib.boot") (def-boot-var |$lisplibKind| "Compiler>LispLib.boot") (def-boot-var |$lisplibModemapAlist| "Compiler>LispLib.boot") @@ -2488,7 +2478,6 @@ which will walk the structure $Y$ looking for this constant. (def-boot-var |$lisplibOperationAlist| "Compiler>LispLib.boot") (def-boot-var |$lisplibSignatureAlist| "Compiler>LispLib.boot") (def-boot-var |$lisplibVariableAlist| "Compiler>LispLib.boot") -(def-boot-var |$lisp2lispRenameAssoc| "???") (def-boot-val |$LocalFrame| '((NIL)) "???") (def-boot-var |$mapSubNameAlist| "Interpreter>Trace.boot") (def-boot-var |$mathTrace| "Interpreter>Trace.boot") @@ -2500,7 +2489,6 @@ which will walk the structure $Y$ looking for this constant. '(&1 &2 &3 &4 &5 &6 &7 &8 &9 &10 &11 &12 &13 &14 &15) "???") (def-boot-var |$mostRecentOpAlist| "???") -(def-boot-var $NBOOT "???") (def-boot-val |$NegativeIntegerOpt| '(|NegativeInteger| . OPT) "???") (def-boot-val |$NegativeInteger| '(|NegativeInteger|) "???") (def-boot-val |$NETail| (CONS |$EmptyEnvironment| NIL) "???") @@ -2573,7 +2561,6 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-val |$reportSpadTrace| () "report list of traced functions") (def-boot-var |$resolveFlag| "Interpreter>SetVars.boot") (def-boot-var |$returnMode| "???") -(def-boot-val |$rightPren| ")" "???") (def-boot-var |$scanModeFlag| "???") (def-boot-var |$semanticErrorStack| "???") (def-boot-val |$SetFunctions| nil "checked in SetFunctionSlots") @@ -2590,12 +2577,9 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-val $SPAD nil "Is this Spad code?") (def-boot-var $SPAD_ERRORS "???") (def-boot-val |$spadLibFT| 'LISPLIB "???") -(def-boot-var |$spadOpList| "???") -(def-boot-var |$spadSystemDisks| "Interpreter>Database.boot") (def-boot-val |$SpecialDomainNames| '(|add| |CAPSULE| |SubDomain| |List| |Union| |Record| |Vector|) "Used in isDomainForm, addEmptyCapsuleIfnecessary.") -(def-boot-var |$streamAlist| "???") (def-boot-val |$streamCount| 0 "???") (def-boot-var |$streamIndexing| "???") (def-boot-val |$StreamIndex| 0 "???") @@ -2605,9 +2589,6 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-var |$suffix| "???") (def-boot-val |$Symbol| '(|Symbol|) "???") (def-boot-val |$SymbolOpt| '(|Symbol| . OPT) "???") -(def-boot-val |$systemCreation| (currenttime) "???") -(def-boot-val |$systemLastChanged| - |$systemCreation| "???") (def-boot-val |$tempCategoryTable| (MAKE-HASHTABLE 'UEQUAL) "???") (def-boot-val |$ThrowAwayMode| '|$ThrowAwayMode| "interp constant") (def-boot-val |$timerOn| t "???") @@ -2655,7 +2636,6 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-var |$warningStack| "???") (def-boot-val |$whereList| () "referenced in format boot formDecl2String") (def-boot-var |$xCount| "???") -(def-boot-var |$xeditIsConsole| "???") (def-boot-var |$xyCurrent| "???") (def-boot-var |$xyInitial| "???") (def-boot-var |$xyMax| "???") @@ -4600,24 +4580,6 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (block nil (setq |$NeedToSignalSessionManager| T) - (if (and (boundp '|$inLispVM|) (boundp '|$BreakMode|)) - (cond - ((eq |$BreakMode| '|validate|) - (|systemError| (error-format error-string args))) - ((and (eq |$BreakMode| '|trapNumerics|) (eq type :ERROR)) - (setq |$BreakMode| nil) - (throw '|trapNumerics| |$numericFailure|)) - ((and (eq |$BreakMode| '|trapNumerics|) (boundp '|$oldBreakMode|) - (setq |$BreakMode| |$oldBreakMode|) - nil)) ;; resets error handler - ((and (null |$inLispVM|) - (memq |$BreakMode| '(|nobreak| |query| |resume| |quit|))) - (let ((|$inLispVM| T)) ;; turn off handler - (return - (|systemError| (error-format error-string args))))) - ((eq |$BreakMode| '|letPrint2|) - (setq |$BreakMode| nil) - (throw '|letPrint2| nil)))) (apply system:universal-error-handler type correctable? op continue-string error-string args ))))) @@ -4690,13 +4652,13 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (DEFUN /D-2 (FN INFILE OUTPUTSTREAM OP EDITFLAG TRACEFLAG) (declare (special OUTPUTSTREAM)) (PROG (FT oft SFN X EDINFILE FILE DEF KEY RECNO U W SOURCEFILES - ECHOMETA SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM SPADERRORSTREAM + SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK (/SOURCEFILES |$sourceFiles|) METAKEYLST DEFINITION_NAME (|$sourceFileTypes| '(|spad| |boot| |lisp| |lsp| |meta|)) ($FUNCTION FN) $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE (*COMP370-APPLY* (if (eq op 'define) #'eval-defun #'compile-defun))) - (declare (special ECHOMETA SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM + (declare (special SINGLINEMODE XCAPE XTOKENREADER INPUTSTREAM SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK /SOURCEFILES METAKEYLST DEFINITION_NAME |$sourceFileTypes| $FUNCTION $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK @@ -4806,7 +4768,6 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ;(NXTTOK) ;(SETQ LINE (CURINPUTLINE)) ;(SETQ SPADERRORSTREAM CUROUTSTREAM) - ;(AND /ECHO (SETQ ECHOMETA 'T) (PRINTEXP LINE) (TERPRI)) ;(SFN) (SETQ DEF (BOOT-PARSE-1 INPUTSTREAM)) (SETQ DEBUGMODE 'YES) @@ -5737,53 +5698,18 @@ now the function is defined but does nothing. (defvar /EDIT-FM 'A1) (defvar /EDIT-FT 'SPAD) (defvar /rp '/RP) -(defvar APLMODE NIL) (defvar error-print) (defvar ind) -(defvar INITCOLUMN 0) (defvar JUNKTOKLIST '(FOR IN AS INTO OF TO)) -(defvar LCTRUE '|true|) (defvar m-chrbuffer) (defvar m-chrindex) (defvar MARG 0 "Margin for testing by ?OP") -(defvar NewFlag) (defvar ParseMode) -(defvar RLGENSYMFG NIL) -(defvar RLGENSYMLST NIL) -(defvar S-SPADTOK 'SPADSYSTOK) -(defvar sortpred) -(defvar SPADSYSKEY '(EOI EOL)) -(defvar STAKCOLUMN -1) (setq XTOKENREADER 'SPADTOK) (defvar xtrans '|boot-new|) (defvar |$IOAlist| '((|%i| . (|gauss| 0 1)))) (setq |$useBFasDefault| T) (defvar |New-LEXPR|) -(defvar |NewFLAG| t) -(defvar |uc| 'UC) -(setq |$lisp2lispRenameAssoc| '((RETURN . |return|) - (EXIT . |exit|) - (AND . |and|) - (OR . |or|) - (NOT . |not|) - (IS . |is|) - (CAR . |first|) - (CDR . |rest|) - (EQUAL . =) - (NEQUAL . ^=) - (PLUS . +) - (TIMES . *) - (QUOTIENT . /) - (EXPT . **) - (SUBST . |substitute|) - (NULL . ^) - (ATOM . |atom|) - (NULL . |null|) - )) - -(setq |$spadOpList| - '(\.\. - = * / ** + - \< \> \<= \>= ^= \# \' ^ - \: \:\: \. =\> == ==\> \| \:=)) (DEFUN INTEGER-BIT (N I) (LOGBITP I N)) @@ -5841,7 +5767,7 @@ now the function is defined but does nothing. (defun BOOT-LEXPR () (SETQ $BOOT 'T) (SPAD-LEXPR1)) -(defun NBOOT-LEXPR () (SETQ $NBOOT 'T) (SPAD-LEXPR1)) +(defun NBOOT-LEXPR () (SPAD-LEXPR1)) (defun UNCONS (X) (COND ((ATOM X) X) @@ -6036,7 +5962,7 @@ special. (setq *PROMPT* 'LISP) (defun |New,ENTRY,1| () - (let (ZZ str N RLGENSYMFG RLGENSYMLST |NewFLAG| XCAPE *PROMPT* + (let (ZZ str N XCAPE *PROMPT* SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT) $NEWLINSTACK $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM XTRANS XTOKENREADER STACK STACKX) @@ -6050,7 +5976,6 @@ special. (SETQ COMMENTCHR 'IGNORE) (SETQ COLUMN 0) (SETQ SINGLINEMODE T) ; SEE NewSYSTOK - (SETQ NewFLAG T) (SETQ ULCASEFG T) (setq STR (|New,ENTRY,2| '|PARSE-NewEXPR| '|process| curinstream)) (if (/= 0 (setq N (NOTE STR))) @@ -6141,9 +6066,6 @@ special. ; **** X. Random tables (defvar MATBORCH "*") -(defvar $MARGIN 3) -(defvar $LINELENGTH 71) -(defvar TEMPGENSYMLIST '(|s| |r| |q| |p|)) (defvar ALPHLIST '(|a| |b| |c| |d| |e| |f| |g|)) (defvar LITTLEIN " in ") (defvar INITALPHLIST ALPHLIST) @@ -6152,25 +6074,9 @@ special. (defvar INITPARLST '(|x| |y| |z| |u| |v| |w| |r| |s| |t|)) (defvar LITTLEA '|a|) (defvar LITTLEI '|i|) -(defvar *TALLPAR NIL) -(defvar ALLSTAR NIL) -(defvar BLANK " ") -(defvar PLUSS "+") -(defvar PERIOD ".") -(defvar SLASH "/") -(defvar COMMA ",") -(defvar LPAR "(") -(defvar RPAR ")") -(defvar EQSIGN "=") -(defvar DASH "-") -(defvar STAR "*") -(defvar DOLLAR "$") -(defvar COLON ":") ; (SETQ |boot-NewKEY| (S- |boot-NewKEY| '(|cp| |cms| |lisp| |boot|))) -(FLAG TEMPGENSYMLIST 'IS-GENSYM) - (MAKEPROP 'COND '|Nud| '(|if| |if| 130 0)) (MAKEPROP 'CONS '|Led| '(CONS CONS 1000 1000)) (MAKEPROP 'APPEND '|Led| '(APPEND APPEND 1000 1000)) @@ -6212,94 +6118,35 @@ special. ;; These were originally in SPAD LISP -(SETQ $BOOT NIL) -(SETQ $NBOOT NIL) -(setq |$interpOnly| nil) -(SETQ |$testingSystem| NIL) -(SETQ |$publicSystem| NIL) -(SETQ |$newcompMode| NIL) +;====================================================================== +;TPDHERE START + (SETQ |$newComp| NIL) (SETQ |$newCompCompare| NIL) (SETQ |$permitWhere| NIL) (SETQ |$newSystem| T) -(SETQ |$noSubsumption| T) ;; was T in a running axiom, from xruncomp (SETQ |$bootStrapMode| NIL) ;; if true skip functor bodies -(SETQ |$compileDontDefineFunctions| 'T) (SETQ |$compileOnlyCertainItems| NIL) (SETQ |$devaluateList| NIL) (SETQ |$doNotCompressHashTableIfTrue| NIL) -(SETQ |$mutableChecking| NIL) ; used in DEFINE BOOT (SETQ |$mutableDomains| NIL) ; checked in DEFINE BOOT (SETQ |$maxSignatureLineNumber| 0) (SETQ |$functionLocations| NIL) (SETQ |$functorLocalParameters| NIL) ; used in compSymbol (SETQ |$insideCategoryPackageIfTrue| NIL) (SETQ |$insideCompileBodyIfTrue| NIL) -(SETQ |$globalExposureGroupAlist| NIL) -(SETQ |$localExposureDataDefault| - (VECTOR (LIST '|basic| '|categories| '|naglink| '|anna| ) NIL NIL)) -(SETQ |$localExposureData| - (VECTOR (LIST '|basic| '|categories| '|naglink| '|anna| ) NIL NIL)) (SETQ |$compilingInputFile| NIL) -(SETQ |$minivectorNames| NIL) (setq |$ReadingFile| NIL) -(setq |$NonNullStream| "NonNullStream") -(setq |$NullStream| "NullStream") -(setq |$domPvar| nil) (setq |$Newline| #\Newline) - - (setq |$createUpdateFiles| nil) - (SETQ $FUNNAME NIL) ;; this and next used in COMP,TRAN,1 (SETQ $FUNNAME_TAIL '(())) -(SETQ $LASTPREFIX "S:") ;"default setting" -(SETQ |$inLispVM| 'T) -(SETQ $SPAD_ERRORS (VECTOR 0 0 0)) -(SETQ STAKCOLUMN -1) -(SETQ ECHOMETA NIL) -(SETQ |$checkParseIfTrue| 'NIL) -(SETQ |$oldParserExpandAbbrs| NIL) -(SETQ $DISPLAY NIL) -(SETQ |S:SPADKEY| NIL) ;" this is augmented by MAKESPADOP" -(SETQ $OLDLINE NIL) ;"used to output command lines" -(SETQ |/EDIT,FT| 'SPAD) -(SETQ |/EDIT,FM| 'A) -(SETQ /EDITFILE NIL) -(SETQ INITCOLUMN 0) -(SETQ |$functionTable| NIL) -(SETQ |$spaddefs| NIL) -(SETQ |$xeditIsConsole| NIL) -(SETQ |$echoInputLines| NIL) ;; This is in SETVART also (SETQ |$Slot1DataBase| (MAKE-HASHTABLE 'ID)) ;; See NRUNTIME BOOT -(SETQ |$pfKeysForBrowse| NIL) -(SETQ MARG 0) - ;" Margin for testing by ?OP" -(SETQ LCTRUE '|true|) -(SETQ |$displayParserOutput| 'T) - -(SETQ |$insideReadRulesIfTrue| NIL) -(SETQ |$consistencyCheck| 'T) -(SETQ |$useUndo| NIL) (SETQ |$ruleSetsInitialized| NIL) - -;; tell the system not to use the new parser -(SETQ |$useNewParser| NIL) - -(SETQ |$htPrecedenceTable| NIL) - (SETQ |$NRTmakeCompactDirect| NIL) -(SETQ |$NRTquick| NIL) -(SETQ |$NRTmakeShortDirect| NIL) -(SETQ |$newWorld| NIL) -(SETQ |$returnNowhereFromGoGet| NIL) - +(SETQ |$returnNowhereFromGoGet| NIL) ; this is not set true anywhere (SETQ |$insideCanCoerceFrom| NIL) - -(SETQ |$useCoerceOrCroak| T) - -(SETQ |$abbreviateJoin| NIL) - +(SETQ |$useCoerceOrCroak| T) ; this is always true everywhere (SETQ |$InterpreterMacroAlist| '((|%i| . (|complex| 0 1)) (|%e| . (|exp| 1)) @@ -6309,37 +6156,9 @@ special. (|%plusInfinity| . (|plusInfinity|)) (|%minusInfinity| . (|minusInfinity|)))) -;; variables controlling companion pages (see copage.boot) -(SETQ |$HTCompanionWindowID| nil) -(SETQ |$HTPreviousDomain| nil) -(SETQ |$HTOperationError| nil) - -;; Common lisp control variables -;;(setq *load-verbose* nil) -(setq *print-array* nil) -(setq *print-pretty* nil) -(setq *print-circle* nil) - -(SETQ |S:SPADTOK| 'SPADSYSTOK) -(SETQ APLMODE NIL) -(SETQ RLGENSYMFG NIL) -(SETQ RLGENSYMLST NIL) -(SETQ XTOKENREADER 'SPADTOK) -(SETQ |$delimiterTokenList| - '(| | |)| |(| |{| |}| |[| |]| ENDOFLINECHR EOI EOL |END_LINE|)) -(SETQ |$generalTokenIfTrue| NIL) -(SETQ OPASSOC NIL) -(SETQ SPADSYSKEY '(EOI EOL)) - -(SETQ $cacheAlist NIL) -(SETQ $streamAlist NIL) - ;; These are for the output routines in OUT BOOT -(SETQ $LINELENGTH 77) -(SETQ $MARGIN 3) -(SETQ *TALLPAR NIL) -(SETQ ALLSTAR NIL) +(SETQ *TALLPAR NIL) ; never set to true (SETQ BLANK " ") (SETQ COLON ":") (SETQ COMMA ",") @@ -6353,20 +6172,21 @@ special. (SETQ RPAR ")") (SETQ SLASH "/") (SETQ STAR "*") -(SETQ |$fortranArrayStartingIndex| 0) -;; These were originally in INIT LISP +;====================================================================== +;TPDHERE END + + + + + + -(SETQ |$systemCreation| - (STRCONC (SUBSTRING (CURRENTTIME) 0 8) " at " - (SUBSTRING (CURRENTTIME) 8 5))) -(SETQ |$systemLastChanged| |$systemCreation|) (SETQ $LISPLIB NIL) (SETQ |$dependeeClosureAlist| NIL) (SETQ |$userModemaps| NIL) (SETQ |$forceDatabaseUpdate| NIL) ;; see "load" function -(SETQ |$spadSystemDisks| '(I J K L)) (SETQ |$functorForm| NIL) (SETQ |$spadLibFT| 'LISPLIB) @@ -6381,24 +6201,17 @@ special. (SETQ |$useIntegerSubdomain| 'T) (SETQ |$useNewFloat| 'T) -;; Directories/disks on which to place various kinds of files -(SETQ |$libraryDirectory| 'A) -(SETQ |$listingDirectory| 'A) - ;; See CLAMMED BOOT for defs of following functions (SETQ |$clamList| '( (|canCoerce| |hash| UEQUAL |count|) (|canCoerceFrom| |hash| UEQUAL |count|) (|coerceConvertMmSelection| |hash| UEQUAL |count|) -; (|getModemapsFromDatabase| |hash| UEQUAL |count|) -; (|getOperationAlistFromLisplib| |hash| UEQUAL |count|) (|hasFileProperty| |hash| UEQUAL |count|) (|isLegitimateMode| |hash| UEQUAL |count|) (|isValidType| |hash| UEQUAL |count|) (|resolveTT| |hash| UEQUAL |count|) (|selectMms1| |hash| UEQUAL |count|) (|underDomainOf| |hash| UEQUAL |count|) -; (|isSubDomain| |hash| UEQUAL |count|) )) ;; following is symbol denoting a failed operation @@ -6439,7 +6252,6 @@ special. (SETQ |$letAssoc| NIL) ;" used for trace of assignments in SPAD code -- see macro LETT" -(SETQ |$useDCQnotLET| NIL) ;; use DCQs for destructuring := patterns (SETQ |$QuickCode| T) ;" controls generation of QREFELT etc." (SETQ |$QuickLet| T) @@ -6454,9 +6266,6 @@ special. (SETQ |$highlightAllowed| 'T) ;" used in BRIGHTPRINT and is a )set variable" -(SETQ |$leftPren| "(") ;;[for use in SAY expressions] -(SETQ |$rightPren| ")") - (SETQ |$abbreviationTable| NIL) (SETQ |$ConstructorNames| '(