diff --git a/changelog b/changelog index 3cd38c2..1331fd9 100644 --- a/changelog +++ b/changelog @@ -1,4 +1,22 @@ 20110122 tpd src/axiom-website/patches.html 20110122.01.tpd.patch +20110122 tpd src/interp/vmlisp.lisp move to lisp tangle +20110122 tpd src/interp/util.lisp move to lisp tangle +20110122 tpd src/interp/topics.lisp move to lisp tangle +20110122 tpd src/interp/termrw.lisp move to lisp tangle +20110122 tpd src/interp/template.lisp move to lisp tangle +20110122 tpd src/interp/sys-pkg.lisp move to lisp tangle +20110122 tpd src/interp/sockio.lisp move to lisp tangle +20110122 tpd src/interp/slam.lisp move to lisp tangle +20110122 tpd src/interp/simpbool.lisp move to lisp tangle +20110122 tpd src/interp/sfsfun.lisp move to lisp tangle +20110122 tpd src/interp/sfsfun-l.lisp move to lisp tangle +20110122 tpd src/interp/server.lisp move to lisp tangle +20110122 tpd src/interp/rulesets.lisp move to lisp tangle +20110122 tpd src/interp/posit.lisp move to lisp tangle +20110122 tpd src/interp/patches.lisp move to lisp tangle +20110122 tpd src/interp/parsing.lisp move to lisp tangle +20110122 tpd src/interp/Makefile move to lisp tangle +20110122 tpd src/axiom-website/patches.html 20110122.01.tpd.patch 20110122 tpd src/input/derivefail.input fix failing test 20110118 tpd src/axiom-website/patches.html 20110118.03.tpd.patch 20110118 tpd src/interp/Makefile move to lisp tangle diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index e014424..98a2195 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3355,5 +3355,7 @@ src/input/fname.input fix failing test
src/interp/*.lisp move to lisp tangle
20110122.01.tpd.patch src/input/derivefail.input fix failing test
+20110122.02.tpd.patch +src/interp/*.lisp move to lisp tangle
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index fac27f9..9f93637 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -765,23 +765,6 @@ ${MID}/cfuns.lisp: ${IN}/cfuns.lisp.pamphlet @ -\subsection{construc.lisp \cite{12}} -<>= -${OUT}/construc.${O}: ${MID}/construc.lisp - @ echo 30 making ${OUT}/construc.${O} from ${MID}/construc.lisp - @ ( cd ${MID} ; \ - echo '(progn (compile-file "${MID}/construc.lisp"' \ - ':output-file "${OUT}/construc.${O}") (${BYE}))' | ${DEPSYS} ) - -@ -<>= -${MID}/construc.lisp: ${IN}/construc.lisp.pamphlet - @ echo 31 making ${MID}/construc.lisp from ${IN}/construc.lisp.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/construc.lisp.pamphlet >construc.lisp ) - -@ - \subsection{debugsys.lisp \cite{14}} The {\bf debugsys.lisp} file is used to create a {\bf debugsys} runnable image. This image contains almost all of the lisp code that make up the axiom @@ -900,7 +883,8 @@ ${OUT}/parsing.${LISP}: ${MID}/parsing.lisp ${MID}/parsing.lisp: ${IN}/parsing.lisp.pamphlet @ echo 97 making ${MID}/parsing.lisp from ${IN}/parsing.lisp.pamphlet @ ( cd ${MID} ; \ - ${TANGLE} ${IN}/parsing.lisp.pamphlet >parsing.lisp ) + echo '(tangle "${IN}/parsing.lisp.pamphlet" "*" "parsing.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -923,7 +907,8 @@ ${OUT}/patches.${O}: ${MID}/patches.lisp ${MID}/patches.lisp: ${IN}/patches.lisp.pamphlet @ echo 100 making ${MID}/patches.lisp from ${IN}/patches.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/patches.lisp.pamphlet >patches.lisp ) + echo '(tangle "${IN}/patches.lisp.pamphlet" "*" "patches.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -946,7 +931,8 @@ ${OUT}/sockio.${O}: ${MID}/sockio.lisp ${MID}/sockio.lisp: ${IN}/sockio.lisp.pamphlet @ echo 118 making ${MID}/sockio.lisp from ${IN}/sockio.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/sockio.lisp.pamphlet >sockio.lisp ) + echo '(tangle "${IN}/sockio.lisp.pamphlet" "*" "sockio.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -961,7 +947,8 @@ ${OUT}/sys-pkg.${LISP}: ${MID}/sys-pkg.lisp ${MID}/sys-pkg.lisp: ${IN}/sys-pkg.lisp.pamphlet @ echo 127 making ${MID}/sys-pkg.lisp from ${IN}/sys-pkg.lisp.pamphlet @ ( cd ${MID} ; \ - ${TANGLE} ${IN}/sys-pkg.lisp.pamphlet >sys-pkg.lisp ) + echo '(tangle "${IN}/sys-pkg.lisp.pamphlet" "*" "sys-pkg.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -990,7 +977,8 @@ ${OUT}/util.${LISP}: ${MID}/util.lisp ${MID}/util.lisp: ${IN}/util.lisp.pamphlet @ echo 134 making ${MID}/util.lisp from ${IN}/util.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/util.lisp.pamphlet >util.lisp ) + echo '(tangle "${IN}/util.lisp.pamphlet" "*" "util.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -1013,7 +1001,8 @@ ${OUT}/vmlisp.${O}: ${MID}/vmlisp.lisp ${MID}/vmlisp.lisp: ${IN}/vmlisp.lisp.pamphlet @ echo 137 making ${MID}/vmlisp.lisp from ${IN}/vmlisp.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/vmlisp.lisp.pamphlet >vmlisp.lisp ) + echo '(tangle "${IN}/vmlisp.lisp.pamphlet" "*" "vmlisp.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -1671,7 +1660,6 @@ ${MID}/profile.lisp: ${IN}/profile.lisp.pamphlet @ (cd ${MID} ; \ echo '(tangle "${IN}/profile.lisp.pamphlet" "*" "profile.lisp")' \ | ${OBJ}/${SYS}/bin/lisp ) -# ${TANGLE} ${IN}/profile.lisp.pamphlet >profile.lisp ) @ @@ -2184,7 +2172,8 @@ ${OUT}/bookvol9.${LISP}: ${MID}/bookvol9.${LISP} ${MID}/bookvol9.${LISP}: ${IN}/bookvol9.pamphlet @ echo 298 making ${MID}/bookvol9.${LISP} from ${IN}/bookvol9.pamphlet @ (cd ${MID} ; \ - ${TANGLE} -RCompiler ${IN}/bookvol9.pamphlet >bookvol9.${LISP} ) + echo '(tangle "${IN}/bookvol9.pamphlet" "Compiler" "bookvol9.${LISP}")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ \subsection{bookvol10.5.lsp} @@ -2755,7 +2744,8 @@ ${MID}/rulesets.lisp: ${IN}/rulesets.lisp.pamphlet @ echo 137 making ${MID}/rulesets.lisp from \ ${IN}/rulesets.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/rulesets.lisp.pamphlet >rulesets.lisp ) + echo '(tangle "${IN}/rulesets.lisp.pamphlet" "*" "rulesets.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -2778,7 +2768,8 @@ ${OUT}/server.${O}: ${MID}/server.lisp ${MID}/server.lisp: ${IN}/server.lisp.pamphlet @ echo 137 making ${MID}/server.lisp from ${IN}/server.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/server.lisp.pamphlet >server.lisp ) + echo '(tangle "${IN}/server.lisp.pamphlet" "*" "server.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -2802,7 +2793,8 @@ ${MID}/simpbool.lisp: ${IN}/simpbool.lisp.pamphlet @ echo 137 making ${MID}/simpbool.lisp from \ ${IN}/simpbool.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/simpbool.lisp.pamphlet >simpbool.lisp ) + echo '(tangle "${IN}/simpbool.lisp.pamphlet" "*" "simpbool.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -2825,7 +2817,8 @@ ${MID}/slam.lisp: ${IN}/slam.lisp.pamphlet @ echo 104 making ${MID}/slam.lisp \ from ${IN}/slam.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/slam.lisp.pamphlet >slam.lisp ) + echo '(tangle "${IN}/slam.lisp.pamphlet" "*" "slam.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -2849,7 +2842,8 @@ ${MID}/template.lisp: ${IN}/template.lisp.pamphlet @ echo 137 making ${MID}/template.lisp from \ ${IN}/template.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/template.lisp.pamphlet >template.lisp ) + echo '(tangle "${IN}/template.lisp.pamphlet" "*" "template.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -2872,7 +2866,8 @@ ${OUT}/termrw.${O}: ${MID}/termrw.lisp ${MID}/termrw.lisp: ${IN}/termrw.lisp.pamphlet @ echo 137 making ${MID}/termrw.lisp from ${IN}/termrw.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/termrw.lisp.pamphlet >termrw.lisp ) + echo '(tangle "${IN}/termrw.lisp.pamphlet" "*" "termrw.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -3097,7 +3092,8 @@ ${OUT}/topics.${O}: ${MID}/topics.lisp ${MID}/topics.lisp: ${IN}/topics.lisp.pamphlet @ echo 137 making ${MID}/topics.lisp from ${IN}/topics.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/topics.lisp.pamphlet >topics.lisp ) + echo '(tangle "${IN}/topics.lisp.pamphlet" "*" "topics.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -3120,7 +3116,8 @@ ${OUT}/posit.${O}: ${MID}/posit.lisp ${MID}/posit.lisp: ${IN}/posit.lisp.pamphlet @ echo 137 making ${MID}/posit.lisp from ${IN}/posit.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/posit.lisp.pamphlet >posit.lisp ) + echo '(tangle "${IN}/posit.lisp.pamphlet" "*" "posit.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -3166,7 +3163,8 @@ ${MID}/sfsfun-l.lisp: ${IN}/sfsfun-l.lisp.pamphlet @ echo 562 making ${MID}/sfsfun-l.lisp \ from ${IN}/sfsfun-l.lisp.pamphlet @(cd ${MID} ; \ - ${TANGLE} ${IN}/sfsfun-l.lisp.pamphlet >sfsfun-l.lisp ) + echo '(tangle "${IN}/sfsfun-l.lisp.pamphlet" "*" "sfsfun-l.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -3188,8 +3186,9 @@ ${OUT}/sfsfun.${O}: ${MID}/sfsfun.lisp <>= ${MID}/sfsfun.lisp: ${IN}/sfsfun.lisp.pamphlet @ echo 137 making ${MID}/sfsfun.lisp from ${IN}/sfsfun.lisp.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/sfsfun.lisp.pamphlet >sfsfun.lisp ) + @(cd ${MID} ; \ + echo '(tangle "${IN}/sfsfun.lisp.pamphlet" "*" "sfsfun.lisp")' \ + | ${OBJ}/${SYS}/bin/lisp ) @ @@ -3390,9 +3389,6 @@ clean: <> <> -<> -<> - <> <> <> @@ -3667,23 +3663,26 @@ clean: <> <> -<> +<> +<> -${OUT}/%.o: ${MID}/%.lisp - @ echo generic making ${OUT}/$*.o from ${MID}/$*.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "vmlisp.lisp"' \ - ':output-file "${OUT}/$*.o") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "vmlisp.lisp"' \ - ':output-file "${OUT}/$I.o") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) +<> -${MID}/%.lisp: ${IN}/%.lisp.pamphlet - @ echo 137 making ${MID}/$*.lisp from ${IN}/$*.lisp.pamphlet - @ (cd ${MID} ; ${TANGLE} ${IN}/$*.lisp.pamphlet >$*.lisp ) +#${OUT}/%.o: ${MID}/%.lisp +# @ echo generic making ${OUT}/$*.o from ${MID}/$*.lisp +# @ ( cd ${MID} ; \ +# if [ -z "${NOISE}" ] ; then \ +# echo '(progn (compile-file "vmlisp.lisp"' \ +# ':output-file "${OUT}/$*.o") (${BYE}))' | ${DEPSYS} ; \ +# else \ +# echo '(progn (compile-file "vmlisp.lisp"' \ +# ':output-file "${OUT}/$I.o") (${BYE}))' | ${DEPSYS} \ +# >${TMP}/trace ; \ +# fi ) +# +#${MID}/%.lisp: ${IN}/%.lisp.pamphlet +# @ echo 137 making ${MID}/$*.lisp from ${IN}/$*.lisp.pamphlet +# @ (cd ${MID} ; ${TANGLE} ${IN}/$*.lisp.pamphlet >$*.lisp ) @ \eject diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index b75f201..8afaf84 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -10,13 +10,13 @@ \tableofcontents \eject -<<*>>= +\begin{chunk}{*} (in-package "BOOT") -@ +\end{chunk} \chapter{META/LISP Parser Generator and Lexical Analysis Utilities (Parsing)} \section{Current I/O Stream definition} -<<*>>= +\begin{chunk}{*} (defun IOStreams-Show () (format t "~&Input is coming from ~A, and output is going to ~A.~%" (or (streamp in-stream) "the keyboard") @@ -33,9 +33,9 @@ (setq File-Closed nil) (IOStreams-Set ,in ,out))) -@ +\end{chunk} \section{Data structure declarations (defstructs) for parsing objects} -<<*>>= +\begin{chunk}{*} (defstruct Line "Line of input file to parse." (Buffer (make-string 0) :type string) @@ -79,9 +79,9 @@ "Tests if line is empty or positioned past the last character." (>= (line-current-index line) (line-last-index line))) -@ +\end{chunk} \subsection{Stack} -<<*>>= +\begin{chunk}{*} (defstruct Stack "A stack" (Store nil) ; contents of the stack (Size 0) ; number of elements in Store @@ -118,9 +118,9 @@ (if (stack-/-empty stack) (car (stack-store stack)))) y)) -@ +\end{chunk} \subsection{Token} -<<*>>= +\begin{chunk}{*} (defstruct Token "A token is a Symbol with a Type. The type is either NUMBER, IDENTIFIER or SPECIAL-CHAR. @@ -149,20 +149,18 @@ (format out-stream "(token (symbol ~S) (type ~S))~%" (Token-Symbol token) (Token-Type token))) -@ +\end{chunk} \subsection{Reduction} -<<*>>= +\begin{chunk}{*} (defstruct (Reduction (:type list)) "A reduction of a rule is any S-Expression the rule chooses to stack." (Rule nil) ; Name of rule (Value nil)) -@ +\end{chunk} \section{Recursive descent parsing support routines} -<<*>>= -@ \subsection{Stacking and retrieving reductions of rules.} -<<*>>= +\begin{chunk}{*} (defparameter Reduce-Stack (make-stack) "Stack of results of reduced productions.") (defun reduce-stack-show () @@ -207,25 +205,22 @@ (defmacro nth-stack (x) `(reduction-value (nth (1- ,x) (stack-store Reduce-Stack)))) -@ - -<<*>>= (defmacro sequence (subrules &optional (actions nil)) `(and ,(pop subrules) . ,(append (mapcar #'(lambda (x) (list 'must x)) subrules) (if actions `((progn . ,(append actions '(t)))))))) -@ +\end{chunk} \section{Routines for handling lexical scanning} Lexical scanning of tokens is performed off of the current line. No token can span more than 1 line. All real I/O is handled in a line-oriented fashion (in a slight paradox) below the character level. All character routines implicitly assume the parameter Current-Line. We do not make Current-Line an explicit optional parameter for reasons of efficiency. -<<*>>= +\begin{chunk}{*} (defparameter Current-Line (make-line) "Current input line.") -@ +\end{chunk} \subsection{Manipulating the token stack and reading tokens} This section is broken up into 3 levels: \begin{itemize} @@ -236,8 +231,8 @@ This section is broken up into 3 levels: \item Random Stuff \end{itemize} \subsubsection{String grabbing} -<<*>>= -@ +\begin{chunk}{*} +\end{chunk} \subsubsection{Token handling} Tokens are acquired from a stream of characters. Lexical analysis is performed by the functiond Get Token. One-token lookahead is maintained in variables @@ -245,7 +240,7 @@ Current-Token and Next-Token by procedures Current Token, Next Token, and Advance Token. The functions Match Current Token and Match Next Token recognize classes of tokens, by type, or by type and symbol. The current and next tokens can be shoved back on the input stream (to the current line) with Unget-Tokens. -<<*>>= +\begin{chunk}{*} (defmacro Defun-Parse-Token (token) `(defun ,(intern (concatenate 'string "PARSE-" (string token))) () (let* ((tok (match-current-token ',token)) @@ -277,9 +272,9 @@ can be shoved back on the input stream (to the current line) with Unget-Tokens. (token-install nil nil next-token nil) (token-install nil nil prior-token nil))) -@ +\end{chunk} \subsubsection{Character handling} -<<*>>= +\begin{chunk}{*} (defun Advance-Char () "Advances IN-STREAM, invoking Next Line if necessary." (loop @@ -290,9 +285,9 @@ can be shoved back on the input stream (to the current line) with Unget-Tokens. (return (current-char))) ((return nil))))) -@ +\end{chunk} \subsubsection{Line handling} -<<*>>= +\begin{chunk}{*} (defparameter Printer-Line-Stack (make-stack) "Stack of output listing lines waiting to print. [local to PRINT-NEW-LINE]") @@ -310,10 +305,10 @@ can be shoved back on the input stream (to the current line) with Unget-Tokens. (stack-clear Printer-Line-Stack) (format strm "~&; ~A~%" string)))) -@ +\end{chunk} \subsection{Error handling} -<<*>>= +\begin{chunk}{*} (defparameter errcol nil) (defparameter line nil) @@ -353,9 +348,9 @@ top (defparameter Meta_Errors_Occurred nil "Did any errors occur") -@ +\end{chunk} \subsection{Constructing parsing procedures} -<<*>>= +\begin{chunk}{*} ; (MAKEPROP 'PROGN 'NARY T) ; Setting for Make-Parse-Function (eval-when (eval load) (setf (get 'progn 'nary) t)) @@ -497,9 +492,9 @@ top (nconc /gensymlist `(,(intern (format nil "G~D" (1+ m)))))) (return (nth (1- n) /gensymlist)))))) -@ +\end{chunk} \subsection{Managing rule sets} -<<*>>= +\begin{chunk}{*} (defparameter bac nil) (defparameter keyfn nil) @@ -528,9 +523,9 @@ top pfx-funlist))) (if unpfx-funlist (list pfx-funlist unpfx-funlist)))) -@ +\end{chunk} \section{Tracing routines} -<<*>>= +\begin{chunk}{*} (defparameter debugmode 'yes "Can be either YES or NO") (defun reduction-print (y rule) @@ -582,7 +577,7 @@ top (defun trblanks (n) (do ((i 1 (1+ i))) ((> i n)) (princ " "))) -@ +\end{chunk} \section{Routines for inspecting and resetting total I/O system state} The package largely assumes that: \begin{itemize} @@ -593,7 +588,7 @@ The package largely assumes that: \end{itemize} This state may be examined and reset with the procedures IOSTAT and IOCLEAR. -<<*>>= +\begin{chunk}{*} (defun IOStat () "Tell me what the current state of the parsing world is." ;(IOStreams-show) @@ -616,15 +611,11 @@ This state may be examined and reset with the procedures IOSTAT and IOCLEAR. (if (or $BOOT $SPAD) (next-lines-clear)) nil) -@ - -<<*>>= - ;; auxiliary functions needed by the parser -@ +\end{chunk} bootlex -<<*>>= +\begin{chunk}{*} (defun Next-Lines-Show () (and Boot-Line-Stack (format t "Currently preparsed lines are:~%~%")) @@ -945,9 +936,6 @@ or the chracters ?, !, ' or %" (SETELT $SPAD_ERRORS INDEX (1+ (ELT $SPAD_ERRORS INDEX)))))) -@ -<<*>>= - ; NAME: Def ; PURPOSE: Defines BOOT code @@ -1138,9 +1126,9 @@ foo defined inside of fum gets renamed as fum,foo.") (defun |newConstruct| (l) (if (ATOM l) l `(CONS ,(CAR l) ,(|newConstruct| (CDR l))))) -@ +\end{chunk} metalex -<<*>>= +\begin{chunk}{*} ; NAME: MetaLex.lisp ; PURPOSE: Parsing support routines for Meta code @@ -1384,9 +1372,9 @@ special character be the atom whose print name is the character itself." (setq Meta_Errors_Occurred t))) nil) -@ +\end{chunk} preparse -<<*>>= +\begin{chunk}{*} ; Global storage (defparameter $preparseReportIfTrue NIL "Should we print listings?") @@ -1433,9 +1421,9 @@ preparse (RETURN (SKIP-IFBLOCK X)) ) ) -@ +\end{chunk} parse -<<*>>= +\begin{chunk}{*} ;parseUpArrow u == parseTran ["**",:u] ;;; *** |parseUpArrow| REDEFINED @@ -2053,7 +2041,7 @@ parse (DEFUN |isPackageType| (|x|) (NULL (CONTAINED (QUOTE $) |x|))) ;--% APL TRANSFORMATION OF INPUT -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet index 05d2107..0ea6786 100644 --- a/src/interp/patches.lisp.pamphlet +++ b/src/interp/patches.lisp.pamphlet @@ -18,13 +18,13 @@ For some unknown reason toplevel was redefined to incorrectly call lisp::unwind whereas it is defined (in this file) to be interned in the boot package. We've returned toplevel to its previous definition. -<>= +\begin{chunk}{toplevel} (defun toplevel (&rest foo) (throw '|top_level| '|restart|)) ;;(defun toplevel (&rest foo) (lisp::unwind)) -@ +\end{chunk} \section{License} -<>= +\begin{verbatim} ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -56,9 +56,9 @@ previous definition. ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> +\end{verbatim} +\begin{chunk}{*} + (in-package "BOOT") ;;patches for now @@ -80,8 +80,8 @@ previous definition. (defun |mkAutoLoad| (fn cname) (function (lambda (&rest args) - (|autoLoad| fn cname) - (apply cname args)))) + (|autoLoad| fn cname) + (apply cname args)))) (setq |$printTimeIfTrue| nil) @@ -94,7 +94,7 @@ previous definition. (let ((|$displaySetValue| nil)) (declare (special |$displaySetValue| |$saveHighlight| |$saveSpecialchars|)) (setq |$saveHighlight| |$highlightAllowed| - |$highlightAllowed| nil) + |$highlightAllowed| nil) (setq |$saveSpecialchars| |$specialCharacters|) (|setOutputCharacters| '(|plain|)))) @@ -104,16 +104,16 @@ previous definition. (defun |spool| (filename) (cond ((null filename) - (dribble) (TERPRI) - (reset-highlight)) - ((probe-file (car filename)) - (error (format nil "file ~a already exists" (car filename)))) - (t (dribble (car filename)) - (TERPRI) - (clear-highlight)) + (dribble) (TERPRI) + (reset-highlight)) + ((probe-file (car filename)) + (error (format nil "file ~a already exists" (car filename)))) + (t (dribble (car filename)) + (TERPRI) + (clear-highlight)) )) -@ +\end{chunk} We need to repatch this for GCL-2.6.8pre2. There appears to be an issue about the proper handling of directory names. The pathname returned by truename does not appear to be a string so we need to call namestring. @@ -136,7 +136,7 @@ It used to read: (setq *default-pathname-defaults* (pathname $current-directory)) (|sayKeyedMsg| 'S2IZ0070 (list (namestring $current-directory)))) \end{verbatim} -<<*>>= +\begin{chunk}{*} (defun |cd| (args) (cond ((null args) @@ -155,12 +155,12 @@ It used to read: (setq *default-pathname-defaults* (pathname $current-directory)) (|sayKeyedMsg| 'S2IZ0070 (list (namestring $current-directory)))) -<> +\getchunk{toplevel} (define-function 'top-level #'toplevel) (define-function 'unwind #'|spadThrow|) (define-function 'resume #'|spadThrow|) -(DEFUN BUMPCOMPERRORCOUNT () ()) +(DEFUN BUMPCOMPERRORCOUNT () ) (define-function '|isBpiOrLambda| #'FBOUNDP) ;;(defun |isSharpVar| (x) (and (identp x) (char= (elt (pname x) 0) #\#))) @@ -189,8 +189,8 @@ It used to read: (setq |$algebraOutputStream| (setq |$fortranOutputStream| (setq |$texOutputStream| - (setq |$formulaOutputStream| - (setq |conOutStream| (make-synonym-stream '*terminal-io*)))))) + (setq |$formulaOutputStream| + (setq |conOutStream| (make-synonym-stream '*terminal-io*)))))) (defun AKCL-VERSION () system::*akcl-version*) (defun SHAREDITEMS (x) T) ;;checked in history code @@ -218,7 +218,7 @@ It used to read: (setq |$sourceFiles| ()) ;; set in readSpad2Cmd -(setq |$localVars| ()) ;checked by isType +(setq |$localVars| ()) ;checked by isType (setq |$highlightFontOn| (concat " " $BOLDSTRING)) (setq |$highlightFontOff| (concat $NORMALSTRING " ")) @@ -243,12 +243,12 @@ It used to read: (UNTRACE) (|untrace| NIL) (|clearClams|) - ;; bind output to nulloutstream + ;; bind output to nulloutstream (let ((*standard-output* (make-broadcast-stream))) - (|resetWorkspaceVariables|)) + (|resetWorkspaceVariables|)) (setq |$specialCharacters| |$plainRTspecialCharacters|) - (load (make-absolute-filename "lib/interp/obey")) + (load (make-absolute-filename "lib/interp/obey")) (system:disksave filename :restart-function restart-hook :full-gc t)) #+:Lucid (define-function 'user::save-system #'boot::save-system) (defun |undoINITIALIZE| () ()) @@ -294,16 +294,16 @@ It used to read: (defun |setViewportProcess| () (setq |$ViewportProcessToWatch| (stringimage (CDR - (|processInteractive| '(|key| (|%%| -2)) NIL) )))) + (|processInteractive| '(|key| (|%%| -2)) NIL) )))) (defun |waitForViewport| () (progn (do () ((not (zerop (obey - (concat - "ps " - |$ViewportProcessToWatch| - " > /dev/null"))))) + (concat + "ps " + |$ViewportProcessToWatch| + " > /dev/null"))))) ()) (|sockSendInt| |$MenuServer| 1) (|setIOindex| (- |$IOindex| 3)) @@ -321,7 +321,7 @@ It used to read: (defun print-xdr-stream (x y z) (format y "XDR:~A" (xdr-stream-name x))) #+:akcl (defstruct (xdr-stream - (:print-function print-xdr-stream)) + (:print-function print-xdr-stream)) "A structure to hold XDR streams. The stream is printed out." (handle ) ;; this is what is used for xdr-open xdr-read xdr-write (name )) ;; this is used for printing @@ -367,7 +367,7 @@ It used to read: (setq echo-meta nil) (defun /versioncheck (n) (unless (= n /MAJOR-VERSION) (throw 'versioncheck -1))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} CMUCL {\bf src/interp/util.lisp.pamphlet} diff --git a/src/interp/posit.lisp.pamphlet b/src/interp/posit.lisp.pamphlet index b9e7444..2c99b12 100644 --- a/src/interp/posit.lisp.pamphlet +++ b/src/interp/posit.lisp.pamphlet @@ -9,7 +9,7 @@ \eject \tableofcontents \eject -<<*>>= +\begin{chunk}{*} (IN-PACKAGE "BOOT") ;pfSourceText pf == @@ -173,7 +173,7 @@ (SETQ |bfVar#2| (CDR |bfVar#2|)))) |lines| NIL))))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/rulesets.lisp.pamphlet b/src/interp/rulesets.lisp.pamphlet index 2b2c6d5..a42b398 100644 --- a/src/interp/rulesets.lisp.pamphlet +++ b/src/interp/rulesets.lisp.pamphlet @@ -9,7 +9,7 @@ \eject \tableofcontents \eject -<<*>>= +\begin{chunk}{*} (IN-PACKAGE "BOOT" ) @@ -565,7 +565,7 @@ (SPADLET |$ruleSetsInitialized| 'T) 'T)))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/server.lisp.pamphlet b/src/interp/server.lisp.pamphlet index 2e45370..17c93d1 100644 --- a/src/interp/server.lisp.pamphlet +++ b/src/interp/server.lisp.pamphlet @@ -9,7 +9,7 @@ \eject \tableofcontents \eject -<<*>>= +\begin{chunk}{*} (IN-PACKAGE "BOOT" ) @@ -274,7 +274,7 @@ (|doSystemCommand| (SUBSEQ |string| 1))) ('T (|processInteractive| (|ncParseFromString| |string|) NIL)))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/sfsfun-l.lisp.pamphlet b/src/interp/sfsfun-l.lisp.pamphlet index c7c992e..8a86b46 100644 --- a/src/interp/sfsfun-l.lisp.pamphlet +++ b/src/interp/sfsfun-l.lisp.pamphlet @@ -10,7 +10,7 @@ \tableofcontents \eject \section{License} -<>= +\begin{verbatim} ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -42,8 +42,8 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= +\end{verbatim} +\begin{chunk}{*} <> (in-package "BOOT") @@ -62,8 +62,8 @@ (defun c-to-r (c) (let ((r (realpart c)) (i (imagpart c))) (if (or (zerop i) (< (abs i) (* 1.0E-10 (abs r)))) - r - (|error| "Result is not real.")) )) + r + (|error| "Result is not real.")) )) ;; Wrappers for functions in the special function package (defun rlngamma (x) (|lnrgamma| x) ) @@ -83,7 +83,7 @@ (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)) )) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/sfsfun.lisp.pamphlet b/src/interp/sfsfun.lisp.pamphlet index 41ef2fe..51b82f4 100644 --- a/src/interp/sfsfun.lisp.pamphlet +++ b/src/interp/sfsfun.lisp.pamphlet @@ -43,7 +43,7 @@ SMW June 25, 1991 More fixes to BesselJ, T. Tsikas 24 Feb, 1995. \end{verbatim} -<<*>>= +\begin{chunk}{*} (IN-PACKAGE "BOOT") @@ -128,7 +128,7 @@ More fixes to BesselJ, T. Tsikas 24 Feb, 1995. ;rgamma (x) == ; if COMPLEXP(x) then FloatError('"Gamma not implemented for complex value ~D",x) -; ZEROP (x-1.0) => 1.0 +; ZEROP (x-1.0) => 1.0 ; if x>20 then gammaStirling(x) else gammaRatapprox(x) (DEFUN |rgamma| (|x|) @@ -1600,12 +1600,12 @@ More fixes to BesselJ, T. Tsikas 24 Feb, 1995. ; n := 50 --- number of terms in Chebychev series. ; --- tests for negative integer order ; (FLOATP(v) and ZEROP fracpart(v) and (v<0)) or (COMPLEXP(v) and ZEROP IMAGPART(v) and ZEROP fracpart(REALPART(v)) and REALPART(v)<0.0) => -; --- odd or even according to v (9.1.5 A&S) -; --- $J_{-n}(z)=(-1)^{n} J_{n}(z)$ +; --- odd or even according to v (9.1.5 A&S) +; --- $J_{-n}(z)=(-1)^{n} J_{n}(z)$ ; BesselJ(-v,z)*EXPT(-1.0,v) ; (FLOATP(z) and (z<0)) or (COMPLEXP(z) and REALPART(z)<0.0) => ; --- negative argument (9.1.35 A&S) -; --- $J_{\nu}(z e^{m \pi i}) = e^{m \nu \pi i} J_{\nu}(z)$ +; --- $J_{\nu}(z e^{m \pi i}) = e^{m \nu \pi i} J_{\nu}(z)$ ; BesselJ(v,-z)*EXPT(-1.0,v) ; ZEROP z and ((FLOATP(v) and (v>=0.0)) or (COMPLEXP(v) and ; ZEROP IMAGPART(v) and REALPART(v)>=0.0)) => --- zero arg, pos. real order @@ -1622,11 +1622,11 @@ More fixes to BesselJ, T. Tsikas 24 Feb, 1995. ; w := 2.0*arg ; vp1 := v+1.0 ; [sum,arr] := chebf01coefmake(vp1,w,n) -; ---if we get NaNs then half n -; while not _=(sum,sum) repeat -; n:=FLOOR(n/2) +; ---if we get NaNs then half n +; while not _=(sum,sum) repeat +; n:=FLOOR(n/2) ; [sum,arr] := chebf01coefmake(vp1,w,n) -; ---now n is safe, can we increase it (we know that 2*n is bad)? +; ---now n is safe, can we increase it (we know that 2*n is bad)? ; chebstarevalarr(arr,arg/w,n)/cgamma(vp1)*EXPT(z/2.0,v) ; true => BesselJRecur(v,z) ; FloatError('"BesselJ not implemented for ~S", [v,z]) @@ -1690,19 +1690,19 @@ More fixes to BesselJ, T. Tsikas 24 Feb, 1995. (LIST |v| |z|))))))))))) ;BesselJRecur(v,z) == -; -- boost order +; -- boost order ; --Numerical.Recipes. suggest so:=v+sqrt(n.s.f.^2*v) -; so:=15.0*z -; -- reduce order until non-zero +; so:=15.0*z +; -- reduce order until non-zero ; while ZEROP ABS(BesselJAsymptOrder(so,z)) repeat so:=so/2.0 -; if ABS(so)>= +\begin{chunk}{*} (IN-PACKAGE "BOOT" ) @@ -713,7 +713,7 @@ (|pp| "==========>") (|pp| |y|))))))))))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/slam.lisp.pamphlet b/src/interp/slam.lisp.pamphlet index 596ffcd..f39b4b6 100644 --- a/src/interp/slam.lisp.pamphlet +++ b/src/interp/slam.lisp.pamphlet @@ -9,7 +9,7 @@ \eject \tableofcontents \eject -<<*>>= +\begin{chunk}{*} (IN-PACKAGE "BOOT" ) @@ -1287,7 +1287,7 @@ (DSETQ G166535 G166536) (CONS '|clearSlam,LAM| (WRAP (CDR G166535) '(QUOTE)))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/sockio.lisp.pamphlet b/src/interp/sockio.lisp.pamphlet index d132abf..aff6848 100644 --- a/src/interp/sockio.lisp.pamphlet +++ b/src/interp/sockio.lisp.pamphlet @@ -10,7 +10,7 @@ \tableofcontents \eject \section{License} -<>= +\begin{verbatim} ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -42,9 +42,9 @@ ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> +\end{verbatim} +\begin{chunk}{*} + ;; load C socket functions @@ -69,7 +69,7 @@ (system:define-foreign-function :c 'NANQ :single) ) -@ +\end{chunk} This was changed as of GCL-2.6.8pre2. It used to read: \begin{verbatim} (defentry sock_get_float (int) (float "sock_get_float")) @@ -79,17 +79,17 @@ Yet another version of GCL requires another change. It used to read: \begin{verbatim} (defentry sock_send_float (int float) (int "sock_send_float")) \end{verbatim} -<<*>>= +\begin{chunk}{*} #+KCL (progn (clines "extern double plus_infinity(), minus_infinity(), NANQ();") (clines "extern double sock_get_float();") -@ +\end{chunk} GCL may pass strings by value. [[sock_get_string_buf]] should fill string with data read from connection, therefore needs address of actual string buffer. We use [[sock_get_string_buf_wrapper]] to resolve the problem -<<*>>= +\begin{chunk}{*} (clines "int sock_get_string_buf_wrapper(int i, object x, int j)" "{ if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x);" " if (x->st.st_fillp>= +\begin{chunk}{GCL.GETENV} #+:GCL SYSTEM:GETENV -@ +\end{chunk} \subsubsection{DEFINE-MACRO} -<>= +\begin{chunk}{GCL.DEFINE-MACRO} #+:GCL SYSTEM:DEFINE-MACRO -@ +\end{chunk} \subsubsection{PNAME} -<>= +\begin{chunk}{GCL.PNAME} #+:GCL SYSTEM:PNAME -@ +\end{chunk} \section{New Common Lisp Changes} \subsection{in-package change} Common lisp has changed in-package to require a string-designator which is a character, string, or symbol. Further, if the package does not exist then in-package will throw an error. We fix this by using defpackage. We create all of the known packages here. -<<*>>= -<> -@ The spad compiler package. Although I believe this is a dead package at this point. All of the symbols from this package have been moved into the boot package. -<<*>>= +\begin{chunk}{*} (make-package "SCRATCHPAD_COMPILER") -@ +\end{chunk} The special functions package. There was originally lisp code to support hardcoded knowledge of special functions like gamma. This is also a dead package as the functions have been lifted to the algebra level. -<<*>>= +\begin{chunk}{*} (make-package "SPECFNSF") -@ +\end{chunk} This is the package that originally contained the VMLisp macros but in fact contains macros to support several other lisps. It is essentially the place where most of the macros to support idioms from prior ports (like rdefiostream and fileactq) -<<*>>= +\begin{chunk}{*} (make-package "VMLISP") (in-package "VMLISP") (lisp::use-package '("USER" "SYSTEM" "LISP")) -@ +\end{chunk} This is the boot to lisp compiler package which contains the src/boot files. Tt is the boot translator package. -<<*>>= +\begin{chunk}{*} (make-package "BOOTTRAN") (in-package "BOOTTRAN") (lisp::use-package '("LISP")) -@ +\end{chunk} Everything in axiom that the user references eventually shows up here. The interpreter and the algebra are run after switching to the boot package (in-package "BOOT") so any symbol that the interpreter or algebra uses has to (cough, cough) appear here. -<<*>>= +\begin{chunk}{*} (make-package "BOOT") (in-package "BOOT") (lisp::use-package '("VMLISP" "LISP")) -@ +\end{chunk} FOAM is the intermediate language for the aldor compiler. FOAM means "first order abstract machine" and functions similar to RTL for the GCC compiler. It is a "machine" that is used as the target for meta-assembler level statments. These are eventually expanded for the real target machine (or interpreted directly) -<<*>>= +\begin{chunk}{*} (make-package "FOAM") (in-package "FOAM") (lisp::use-package '("LISP")) -@ +\end{chunk} FOAM-USER is the package containing foam statements and macros that get inserted into user code versus the foam package which provides support for compiler code. -<<*>>= +\begin{chunk}{*} (make-package "FOAM-USER") (in-package "FOAM-USER") (lisp::use-package '("LISP" "FOAM")) @@ -103,355 +100,355 @@ provides support for compiler code. (lisp:import '(VMLISP::ERROROUTSTREAM LISP::COUNT VMLISP::NE VMLISP::FLUID - LISP:SEQUENCE VMLISP::OBEY LISP:NUMBER VMLISP::|union| - LISP:STEP VMLISP::OPTIONLIST VMLISP::EXIT VMLISP::throw-protect -<> + LISP:SEQUENCE VMLISP::OBEY LISP:NUMBER VMLISP::|union| + LISP:STEP VMLISP::OPTIONLIST VMLISP::EXIT VMLISP::throw-protect +\getchunk{GCL.GETENV} VMLISP::GET-CURRENT-DIRECTORY VMLISP::AXIOM-PROBE-FILE VMLISP::*INDEX-FILENAME*)) (lisp:export '(BOOT::|$FormalMapVariableList| BOOT::|$userModemaps| - boot::restart boot::$IEEE - BOOT::|directoryp| boot::help boot::|version| boot::|pp| - BOOT::POP-STACK-4 BOOT::|$BasicDomains| BOOT::|$DomainFrame| - BOOT::|$SideEffectFreeFunctionList| - BOOT::ATOM2STRING BOOT::|$DoubleQuote| BOOT::|$genSDVar| - BOOT::GETCHARN BOOT::DROP VMLISP::ERROROUTSTREAM - BOOT::MATCH-STRING BOOT::|$fromSpadTrace| - BOOT::|$UserSynonyms| BOOT::%L BOOT::FLUIDVARS - BOOT::/EMBEDREPLY BOOT::|$LocalFrame| BOOT::|$streamIndexing| - BOOT::APPLYR BOOT::NEXTINPUTLINE BOOT::$NORMALSTRING - BOOT::|$InteractiveTimingStatsIfTrue| BOOT::|$leaveLevelStack| - BOOT::|$xyMin| BOOT::|lcm| BOOT::STRINGSUFFIX - BOOT::|Category| BOOT::ESCAPE-CHARACTER - LISP:COUNT BOOT::|break| BOOT::$DIRECTORY - BOOT::CONVERSATION BOOT::|fillerSpaces| - BOOT::$REVERSEVIDEOSTRING BOOT::|$DomainsInScope| - BOOT::|$gauss01| BOOT::|$mostRecentOpAlist| BOOT::SUBLISLIS - BOOT::QUITFILE BOOT::|PrintBox| BOOT::POP-REDUCTION - BOOT::META-SYNTAX-ERROR BOOT::|$constructorInfoTable| - BOOT::|$currentLine| BOOT::|$Float| BOOT::|$slamFlag| - BOOT::|$SmallIntegerOpt| BOOT::$SPAD BOOT::|$timerOn| - BOOT::$TRACELETFLAG VMLISP::NE BOOT::ADJCURMAXINDEX - BOOT::STREAM-BUFFER BOOT::SPADSLAM BOOT::$EM - BOOT::|$PositiveIntegerOpt| BOOT::THETA BOOT::READ-QUIETLY - BOOT::RS BOOT::|$compUniquelyIfTrue| - BOOT::|$insideExpressionIfTrue| BOOT::LE BOOT::KAR BOOT::ELEM - BOOT::LASTATOM BOOT::IN-STREAM BOOT::$DELAY - BOOT::QSEXPT BOOT::|$quadSymbol| BOOT::|$streamAlist| - BOOT::|$SymbolOpt| BOOT::TAKE BOOT::CONSOLEINPUTP - BOOT::|$hasYield| BOOT::DEBUGMODE BOOT::|$DummyFunctorNames| - BOOT::|$PositiveInteger| BOOT::%D VMLISP::FLUID BOOT::TLINE - BOOT::|$abbreviationTable| BOOT::|$FontTable| - BOOT::|$PatternVariableList| BOOT::|$returnMode| BOOT::NEQUAL - BOOT::GE BOOT::|MakeSymbol| BOOT::|$insideWhereIfTrue| - BOOT::|$mapSubNameAlist| BOOT::GETCHAR BOOT::|Gaussian| - BOOT::IDENTIFIER BOOT::|$LastCxArg| BOOT::|$systemCommands| - BOOT::|$true| BOOT::SETANDFILE BOOT::PUSH-REDUCTION - BOOT::|$BigFloat| BOOT::|$brightenCommentsFlag| - BOOT::|$cacheCount| BOOT::|$exitModeStack| BOOT::|$noEnv| - BOOT::|$NonPositiveIntegerOpt| BOOT::PUTGCEXIT - BOOT::|$readingFile| - BOOT::IS BOOT::KDR BOOT::|$quadSym| BOOT::|$BreakMode| - BOOT::$TOKSTACK BOOT::DEFSTREAM BOOT::LOCVARS BOOT::NTH-STACK - BOOT::$UNDERLINESTRING BOOT::|$compCount| - BOOT::|$lisplibModemapAlist| BOOT::COMP BOOT::LINE - BOOT::GETGENSYM BOOT::$FUNNAME BOOT::|$SystemSynonyms| - BOOT::|$spadOpList| BOOT::GENERAL BOOT::|$fortranOutputStream| - BOOT::META_PREFIX BOOT::|$InteractiveMode| BOOT::|strconc| - BOOT::TAILFN BOOT::RPLACW BOOT::|PositiveInteger| - BOOT::|$inactiveLisplibs| BOOT::|$NonPositiveInteger| - BOOT::|$reportCoerceIfTrue| - BOOT::|sayBrightlyNT| BOOT::NEXT-CHAR boot::|sayString| - BOOT::META_ERRORS_OCCURRED BOOT::|$resolveFlag| - BOOT::|$StringOpt| BOOT::|UnivariatePoly| BOOT::MATCH-TOKEN - BOOT::|$createUpdateFiles| BOOT::|$noParseCommands| - BOOT::FLAGP BOOT::ECHO-META BOOT::|initializeSetVariables| - BOOT::|$CategoryNames| BOOT::?ORDER - BOOT::$FILELINENUMBER BOOT::|$timerTicksPerSecond| - BOOT::|bootUnionPrint| BOOT::|$consistencyCheck| - BOOT::|$oldTime| BOOT::$NEWSPAD BOOT::NUMOFNODES - BOOT::|$ResMode| BOOT::S* BOOT::$BOXSTRING - BOOT::|$BasicPredicates| BOOT::|$eltIfNil| BOOT::$FUNNAME_TAIL - BOOT::|$QuickCode| BOOT::GENVAR BOOT::|$TypeEqui| - BOOT::TOKEN-TYPE BOOT::|updateSourceFiles| BOOT::|$BFtag| - BOOT::|$reportBottomUpFlag| BOOT::|$SmallInteger| - BOOT::|$TypeEQ| BOOT::|Boolean| BOOT::|RationalNumber| - BOOT::MAKENEWOP BOOT::|$EmptyList| BOOT::|$leaveMode| - BOOT::MKQ BOOT::ON BOOT::CONTAINED BOOT::|conOutStream| - BOOT::POINTW BOOT::REDUCTION-POP-ELT BOOT::TOKEN-SYMBOL - BOOT::ERRCOL BOOT::|$domainTraceNameAssoc| BOOT::SUBSTEQ - BOOT::DELASSOS BOOT::|Size| BOOT::|$form| - BOOT::|$insideCategoryIfTrue| BOOT::SUCHTHAT BOOT::|One| - BOOT::ACTION BOOT::MDEFTRACE BOOT::|$BooleanOpt| - BOOT::|$xyStack| BOOT::ASSOCLEFT BOOT::|sayALGEBRA| - BOOT::|Coord| BOOT::IDENTIFIER-TOKEN BOOT::ADVANCE-CHAR - BOOT::|$InitialDomainsInScope| BOOT::|$StringCategory| - BOOT::S- BOOT::NEWLINE BOOT::|$optimizableDomainNames| - BOOT::IN BOOT::COLLECTV BOOT::|$Lisp| - BOOT::|$lisplibOperationAlist| BOOT::|$reportExitModeStack| - BOOT::|$updateCatTableIfTrue| BOOT::NREVERSE0 BOOT::%M - BOOT::|sayFORTRAN| BOOT::NEWLINECHR BOOT::|$EmptyMode| - BOOT::|$Zero| BOOT::CARCDREXPAND BOOT::|IS_#GENVAR| - BOOT::LISTOFATOMS BOOT::|$algebraOutputStream| - BOOT::|$highlightAllowed| BOOT::|NonNegativeInteger| - BOOT::/EMBED-1 - BOOT::|$constructorsNotInDatabase| BOOT::|$ConstructorNames| - BOOT::|$Integer| BOOT::|$systemModemapsInCore| BOOT::KADDR - BOOT::STAR BOOT::|$reportCompilation| - BOOT::|$traceNoisely| BOOT::SPADDIFFERENCE BOOT::%B - BOOT::COMMENT-CHARACTER BOOT::|$PrettyPrint| BOOT::SPADLET - BOOT::|$ModemapFrame| BOOT::|$QuickLet| BOOT::SPADDO - BOOT::PREDECESSOR BOOT::*EOF* BOOT::POP-STACK-1 BOOT::BANG - BOOT::|$ConstructorCache| BOOT::|$printConStats| - BOOT::|$RationalNumberOpt| BOOT::RESET - BOOT::NLIST BOOT::NSTRCONC BOOT::TAIL BOOT::GETRULEFUNLISTS - BOOT::|$IntegerOpt| BOOT::$NEWLINSTACK BOOT::|$QuietIfNil| - BOOT::$SPAD_ERRORS BOOT::|$useDCQnotLET| BOOT::|$xCount| - BOOT::$BOOT BOOT::POINT BOOT::OPTIONAL BOOT::PARSE-IDENTIFIER - BOOT::BSTRING-TOKEN BOOT::LASTELEM BOOT::STREAM-EOF - BOOT::|sayBrightly| BOOT::|$formulaOutputStream| - BOOT::|BigFloat| BOOT::SLAM BOOT::$DISPLAY - BOOT::|$NonMentionableDomainNames| BOOT::$OLDLINE BOOT::$TYPE - BOOT::STATUS BOOT::KEYFN BOOT::|$NonNegativeIntegerOpt| - BOOT::|$userConstructors| BOOT::BOOT-NEQUAL BOOT::RPLAC - BOOT::GETTAIL BOOT::|QuotientField| BOOT::CURRENT-TOKEN - BOOT::|$suffix| BOOT::|$VariableCount| BOOT::COMPARE - LISP:SEQUENCE BOOT::|$Exit| BOOT::BOOT-EQUAL BOOT::LT - VMLISP::OBEY BOOT::|UnSizedBox| BOOT::|Integer| BOOT::|Nud| - BOOT::IOCLEAR BOOT::|$BigFloatOpt| BOOT::|$EmptyEnvironment| - BOOT::|$forceDatabaseUpdate| BOOT::$LINESTACK BOOT::ULCASEFG - BOOT::|$Boolean| BOOT::|$clamList| BOOT::COLLECT - BOOT::IOSTREAMS-SET BOOT::MUST BOOT::|$FloatOpt| - BOOT::|$NonNegativeInteger| - BOOT::FLAG BOOT::TL BOOT::BLANKS BOOT::|$report3| - BOOT::|$reportFlag| BOOT::|$xeditIsConsole| BOOT::PAIR - BOOT::|$evalDomain| BOOT::|$traceletFunctions| BOOT::|$Void| - BOOT::GT BOOT::MATCH-ADVANCE-STRING - BOOT::|$scanModeFlag| BOOT::SUBLISNQ BOOT::LASSQ BOOT::NOTE - BOOT::ILAM BOOT::CURRENT-SYMBOL - BOOT::|$SetFunctions| BOOT::|$sourceFileTypes| BOOT::|String| - BOOT::NUMBER-TOKEN BOOT::$LINENUMBER BOOT::$NUM_OF_META_ERRORS - BOOT::|$Polvar| BOOT::|$domainsWithUnderDomains| - BOOT::SPADCALL BOOT::DELASC BOOT::FAIL BOOT::$COMPILE - BOOT::|$lastUntraced| BOOT::|$lisplibKind| - BOOT::|$tracedModemap| BOOT::|$inputPromptType| BOOT::LASSOC - LISP:NUMBER BOOT::|$prefix| BOOT::|$TranslateOnly| BOOT::SAY - BOOT::|$CategoryFrame| BOOT::|$croakIfTrue| BOOT::|$exitMode| - BOOT::|$lisplibDependentCategories| BOOT::|$NoValue| - BOOT::MOAN BOOT::POP-STACK-2 BOOT::BAC - BOOT::|$InitialModemapFrame| BOOT::$MAXLINENUMBER - BOOT::$ESCAPESTRING BOOT::|$bootStrapMode| - BOOT::|$compileMapFlag| BOOT::|$currentFunction| - BOOT::|$DomainNames| BOOT::|$PolyMode| BOOT::|$tripleCache| - BOOT::SUCHTHATCLAUSE BOOT::WHILE BOOT::S+ BOOT::|Expression| - BOOT::PARSE-NUMBER BOOT::|$Index| BOOT::$NBOOT - BOOT::|$PrintCompilerMessagesIfTrue| BOOT::$PROMPT - BOOT::MAKE-PARSE-FUNCTION BOOT::/METAOPTION BOOT::|$topOp| - BOOT::|$xyInitial| BOOT::MKPF BOOT::STRM - BOOT::MATCH-NEXT-TOKEN BOOT::|pathname| BOOT::|$cacheAlist| - BOOT::$FUNCTION BOOT::|$reportSpadTrace| - BOOT::|$tempCategoryTable| BOOT::|$underDomainAlist| - BOOT::|$whereList| BOOT::|append| BOOT::|function| - BOOT::CURINPUTLINE BOOT::|sayFORMULA| - BOOT::/GENVARLST BOOT::|$Category| BOOT::|$SpecialDomainNames| - VMLISP::|union| BOOT::ASSOCRIGHT BOOT::CURSTRMLINE - BOOT::REDUCTION BOOT::|$lisplibDomainDependents| - BOOT::|OptionList| BOOT::|$postStack| BOOT::|$traceDomains| - BOOT::BRIGHTPRINT BOOT::|$instantRecord| - BOOT::|$NETail| BOOT::UNTIL BOOT::GET-TOKEN - BOOT::|$Expression| BOOT::$LASTPREFIX BOOT::|$mathTraceList| - BOOT::|$PrintOnly| BOOT::ELEMN BOOT::NILADIC - BOOT::PARSE-BSTRING BOOT::/DEPTH BOOT::|$spadLibFT| - BOOT::|$xyMax| BOOT::|$IOindex| BOOT::SPADCONST - BOOT::|sayBrightlyI| BOOT::|SquareMatrix| - BOOT::LASTTAIL - BOOT::|UnboundBox| BOOT::NEXT-TOKEN - BOOT::|$OutsideStringIfTrue| BOOT::|$String| BOOT::TRIMLZ - BOOT::KADR BOOT::STRMBLANKLINE BOOT::STRMSKIPTOBLANK - BOOT::IOSTAT BOOT::|$insideCoerceInteractiveHardIfTrue| - BOOT::|$lisplibSignatureAlist| BOOT::REMFLAG BOOT::SPADREDUCE - BOOT::QLASSQ BOOT::NEXTSTRMLINE BOOT::|FontTable| BOOT::|Led| - BOOT::UNGET-TOKENS BOOT::|$operationNameList| - BOOT::|$tokenCommands| BOOT::IS_GENVAR BOOT::INIT-RULES - BOOT::|PrintItem| BOOT::$LISPLIB BOOT::|$optionAlist| - BOOT::|$previousTime| BOOT::|$StreamIndex| - BOOT::|$systemLisplibsWithModemapsInCore| - BOOT::|$tracedSpadModemap| BOOT::ISTEP BOOT::|$warningStack| - BOOT::|and| BOOT::OUT-STREAM BOOT::TOKEN - BOOT::|$ConstructorDependencyAlist| - BOOT::|$lisplibVariableAlist| BOOT::INTERNL BOOT::IEQUAL - BOOT::|$algebraList| BOOT::|$brightenCommentsIfTrue| - BOOT::|$failure| BOOT::|$Mode| BOOT::|$opFilter| - BOOT::|$TraceFlag| BOOT::|Float| BOOT::POP-STACK-3 - BOOT::|$EmptyString| BOOT::$TOP_STACK BOOT::|$mpolyTTrules| - BOOT::|$mpolyTMrules| BOOT::|$InteractiveFrame| - BOOT::|$InteractiveModemapFrame| BOOT::|$letAssoc| - BOOT::|$lisp2lispRenameAssoc| BOOT::|$RationalNumber| - BOOT::|$ThrowAwayMode| BOOT::*PROMPT* BOOT::NUMOFARGS - BOOT::|$semanticErrorStack| BOOT::|$spadSystemDisks| - BOOT::$TOP_LEVEL BOOT::BUMPCOMPERRORCOUNT - BOOT::|delete| BOOT::STREQ BOOT::STRING-TOKEN BOOT::XNAME - BOOT::|$ExpressionOpt| BOOT::|$systemCreation| BOOT::$GENNO - BOOT::CROAK BOOT::PARSE-STRING BOOT::|$genFVar| - BOOT::|$lisplibModemap| BOOT::|$NoValueMode| BOOT::|$PrintBox| - BOOT::ADVANCE-TOKEN BOOT::|$NegativeIntegerOpt| - BOOT::|$polyDefaultAssoc| BOOT::|$PrimitiveDomainNames| - LISP:STEP BOOT::|rassoc| BOOT::|$Res| - BOOT::MATCH-CURRENT-TOKEN BOOT::/GENSYMLIST BOOT::|$false| - BOOT::|$ignoreCommentsIfTrue| BOOT::|$ModeVariableList| - BOOT::|$useBFasDefault| BOOT::|$CommonDomains| - BOOT::|$printLoadMsgs| BOOT::|dataCoerce| BOOT::|$inLispVM| - BOOT::|$streamCount| - BOOT::|$Symbol| BOOT::|$updateIfTrue| BOOT::REMDUP - BOOT::ADDASSOC BOOT::|PrintList| - BOOT::SPECIAL-CHAR BOOT::XCAPE BOOT::|$EmptyVector| - BOOT::REPEAT BOOT::|$NegativeInteger| - BOOT::LENGTHENVEC BOOT::CURMAXINDEX BOOT::|$hasCategoryTable| - BOOT::|$leftPren| BOOT::|$lisplibForm| BOOT::|$OneCoef| - BOOT::|$reportCoerce| VMLISP::OPTIONLIST BOOT::META - BOOT::|$insideCapsuleFunctionIfTrue| - BOOT::|$insideConstructIfTrue| BOOT::$BOLDSTRING - BOOT::|breaklet| BOOT::|$insideCompTypeOf| - BOOT::|$rightPren| - BOOT::|$systemLastChanged| BOOT::|$xyCurrent| BOOT::|Zero| - BOOT::YIELD BOOT::|Polynomial| BOOT::|$Domain| BOOT::STRINGPAD - BOOT::TRUNCLIST BOOT::|SmallInteger| BOOT::|$libFile| - BOOT::|$mathTrace| BOOT::|$PolyDomains| BOOT::|or| - BOOT::|$DomainVariableList| BOOT::|$insideFunctorIfTrue| - BOOT::|$One| VMLISP::EXIT BOOT::CURRENT-CHAR BOOT::NBLNK - BOOT::$DALYMODE)) + boot::restart boot::$IEEE + BOOT::|directoryp| boot::help boot::|version| boot::|pp| + BOOT::POP-STACK-4 BOOT::|$BasicDomains| BOOT::|$DomainFrame| + BOOT::|$SideEffectFreeFunctionList| + BOOT::ATOM2STRING BOOT::|$DoubleQuote| BOOT::|$genSDVar| + BOOT::GETCHARN BOOT::DROP VMLISP::ERROROUTSTREAM + BOOT::MATCH-STRING BOOT::|$fromSpadTrace| + BOOT::|$UserSynonyms| BOOT::%L BOOT::FLUIDVARS + BOOT::/EMBEDREPLY BOOT::|$LocalFrame| BOOT::|$streamIndexing| + BOOT::APPLYR BOOT::NEXTINPUTLINE BOOT::$NORMALSTRING + BOOT::|$InteractiveTimingStatsIfTrue| BOOT::|$leaveLevelStack| + BOOT::|$xyMin| BOOT::|lcm| BOOT::STRINGSUFFIX + BOOT::|Category| BOOT::ESCAPE-CHARACTER + LISP:COUNT BOOT::|break| BOOT::$DIRECTORY + BOOT::CONVERSATION BOOT::|fillerSpaces| + BOOT::$REVERSEVIDEOSTRING BOOT::|$DomainsInScope| + BOOT::|$gauss01| BOOT::|$mostRecentOpAlist| BOOT::SUBLISLIS + BOOT::QUITFILE BOOT::|PrintBox| BOOT::POP-REDUCTION + BOOT::META-SYNTAX-ERROR BOOT::|$constructorInfoTable| + BOOT::|$currentLine| BOOT::|$Float| BOOT::|$slamFlag| + BOOT::|$SmallIntegerOpt| BOOT::$SPAD BOOT::|$timerOn| + BOOT::$TRACELETFLAG VMLISP::NE BOOT::ADJCURMAXINDEX + BOOT::STREAM-BUFFER BOOT::SPADSLAM BOOT::$EM + BOOT::|$PositiveIntegerOpt| BOOT::THETA BOOT::READ-QUIETLY + BOOT::RS BOOT::|$compUniquelyIfTrue| + BOOT::|$insideExpressionIfTrue| BOOT::LE BOOT::KAR BOOT::ELEM + BOOT::LASTATOM BOOT::IN-STREAM BOOT::$DELAY + BOOT::QSEXPT BOOT::|$quadSymbol| BOOT::|$streamAlist| + BOOT::|$SymbolOpt| BOOT::TAKE BOOT::CONSOLEINPUTP + BOOT::|$hasYield| BOOT::DEBUGMODE BOOT::|$DummyFunctorNames| + BOOT::|$PositiveInteger| BOOT::%D VMLISP::FLUID BOOT::TLINE + BOOT::|$abbreviationTable| BOOT::|$FontTable| + BOOT::|$PatternVariableList| BOOT::|$returnMode| BOOT::NEQUAL + BOOT::GE BOOT::|MakeSymbol| BOOT::|$insideWhereIfTrue| + BOOT::|$mapSubNameAlist| BOOT::GETCHAR BOOT::|Gaussian| + BOOT::IDENTIFIER BOOT::|$LastCxArg| BOOT::|$systemCommands| + BOOT::|$true| BOOT::SETANDFILE BOOT::PUSH-REDUCTION + BOOT::|$BigFloat| BOOT::|$brightenCommentsFlag| + BOOT::|$cacheCount| BOOT::|$exitModeStack| BOOT::|$noEnv| + BOOT::|$NonPositiveIntegerOpt| BOOT::PUTGCEXIT + BOOT::|$readingFile| + BOOT::IS BOOT::KDR BOOT::|$quadSym| BOOT::|$BreakMode| + BOOT::$TOKSTACK BOOT::DEFSTREAM BOOT::LOCVARS BOOT::NTH-STACK + BOOT::$UNDERLINESTRING BOOT::|$compCount| + BOOT::|$lisplibModemapAlist| BOOT::COMP BOOT::LINE + BOOT::GETGENSYM BOOT::$FUNNAME BOOT::|$SystemSynonyms| + BOOT::|$spadOpList| BOOT::GENERAL BOOT::|$fortranOutputStream| + BOOT::META_PREFIX BOOT::|$InteractiveMode| BOOT::|strconc| + BOOT::TAILFN BOOT::RPLACW BOOT::|PositiveInteger| + BOOT::|$inactiveLisplibs| BOOT::|$NonPositiveInteger| + BOOT::|$reportCoerceIfTrue| + BOOT::|sayBrightlyNT| BOOT::NEXT-CHAR boot::|sayString| + BOOT::META_ERRORS_OCCURRED BOOT::|$resolveFlag| + BOOT::|$StringOpt| BOOT::|UnivariatePoly| BOOT::MATCH-TOKEN + BOOT::|$createUpdateFiles| BOOT::|$noParseCommands| + BOOT::FLAGP BOOT::ECHO-META BOOT::|initializeSetVariables| + BOOT::|$CategoryNames| BOOT::?ORDER + BOOT::$FILELINENUMBER BOOT::|$timerTicksPerSecond| + BOOT::|bootUnionPrint| BOOT::|$consistencyCheck| + BOOT::|$oldTime| BOOT::$NEWSPAD BOOT::NUMOFNODES + BOOT::|$ResMode| BOOT::S* BOOT::$BOXSTRING + BOOT::|$BasicPredicates| BOOT::|$eltIfNil| BOOT::$FUNNAME_TAIL + BOOT::|$QuickCode| BOOT::GENVAR BOOT::|$TypeEqui| + BOOT::TOKEN-TYPE BOOT::|updateSourceFiles| BOOT::|$BFtag| + BOOT::|$reportBottomUpFlag| BOOT::|$SmallInteger| + BOOT::|$TypeEQ| BOOT::|Boolean| BOOT::|RationalNumber| + BOOT::MAKENEWOP BOOT::|$EmptyList| BOOT::|$leaveMode| + BOOT::MKQ BOOT::ON BOOT::CONTAINED BOOT::|conOutStream| + BOOT::POINTW BOOT::REDUCTION-POP-ELT BOOT::TOKEN-SYMBOL + BOOT::ERRCOL BOOT::|$domainTraceNameAssoc| BOOT::SUBSTEQ + BOOT::DELASSOS BOOT::|Size| BOOT::|$form| + BOOT::|$insideCategoryIfTrue| BOOT::SUCHTHAT BOOT::|One| + BOOT::ACTION BOOT::MDEFTRACE BOOT::|$BooleanOpt| + BOOT::|$xyStack| BOOT::ASSOCLEFT BOOT::|sayALGEBRA| + BOOT::|Coord| BOOT::IDENTIFIER-TOKEN BOOT::ADVANCE-CHAR + BOOT::|$InitialDomainsInScope| BOOT::|$StringCategory| + BOOT::S- BOOT::NEWLINE BOOT::|$optimizableDomainNames| + BOOT::IN BOOT::COLLECTV BOOT::|$Lisp| + BOOT::|$lisplibOperationAlist| BOOT::|$reportExitModeStack| + BOOT::|$updateCatTableIfTrue| BOOT::NREVERSE0 BOOT::%M + BOOT::|sayFORTRAN| BOOT::NEWLINECHR BOOT::|$EmptyMode| + BOOT::|$Zero| BOOT::CARCDREXPAND BOOT::|IS_#GENVAR| + BOOT::LISTOFATOMS BOOT::|$algebraOutputStream| + BOOT::|$highlightAllowed| BOOT::|NonNegativeInteger| + BOOT::/EMBED-1 + BOOT::|$constructorsNotInDatabase| BOOT::|$ConstructorNames| + BOOT::|$Integer| BOOT::|$systemModemapsInCore| BOOT::KADDR + BOOT::STAR BOOT::|$reportCompilation| + BOOT::|$traceNoisely| BOOT::SPADDIFFERENCE BOOT::%B + BOOT::COMMENT-CHARACTER BOOT::|$PrettyPrint| BOOT::SPADLET + BOOT::|$ModemapFrame| BOOT::|$QuickLet| BOOT::SPADDO + BOOT::PREDECESSOR BOOT::*EOF* BOOT::POP-STACK-1 BOOT::BANG + BOOT::|$ConstructorCache| BOOT::|$printConStats| + BOOT::|$RationalNumberOpt| BOOT::RESET + BOOT::NLIST BOOT::NSTRCONC BOOT::TAIL BOOT::GETRULEFUNLISTS + BOOT::|$IntegerOpt| BOOT::$NEWLINSTACK BOOT::|$QuietIfNil| + BOOT::$SPAD_ERRORS BOOT::|$useDCQnotLET| BOOT::|$xCount| + BOOT::$BOOT BOOT::POINT BOOT::OPTIONAL BOOT::PARSE-IDENTIFIER + BOOT::BSTRING-TOKEN BOOT::LASTELEM BOOT::STREAM-EOF + BOOT::|sayBrightly| BOOT::|$formulaOutputStream| + BOOT::|BigFloat| BOOT::SLAM BOOT::$DISPLAY + BOOT::|$NonMentionableDomainNames| BOOT::$OLDLINE BOOT::$TYPE + BOOT::STATUS BOOT::KEYFN BOOT::|$NonNegativeIntegerOpt| + BOOT::|$userConstructors| BOOT::BOOT-NEQUAL BOOT::RPLAC + BOOT::GETTAIL BOOT::|QuotientField| BOOT::CURRENT-TOKEN + BOOT::|$suffix| BOOT::|$VariableCount| BOOT::COMPARE + LISP:SEQUENCE BOOT::|$Exit| BOOT::BOOT-EQUAL BOOT::LT + VMLISP::OBEY BOOT::|UnSizedBox| BOOT::|Integer| BOOT::|Nud| + BOOT::IOCLEAR BOOT::|$BigFloatOpt| BOOT::|$EmptyEnvironment| + BOOT::|$forceDatabaseUpdate| BOOT::$LINESTACK BOOT::ULCASEFG + BOOT::|$Boolean| BOOT::|$clamList| BOOT::COLLECT + BOOT::IOSTREAMS-SET BOOT::MUST BOOT::|$FloatOpt| + BOOT::|$NonNegativeInteger| + BOOT::FLAG BOOT::TL BOOT::BLANKS BOOT::|$report3| + BOOT::|$reportFlag| BOOT::|$xeditIsConsole| BOOT::PAIR + BOOT::|$evalDomain| BOOT::|$traceletFunctions| BOOT::|$Void| + BOOT::GT BOOT::MATCH-ADVANCE-STRING + BOOT::|$scanModeFlag| BOOT::SUBLISNQ BOOT::LASSQ BOOT::NOTE + BOOT::ILAM BOOT::CURRENT-SYMBOL + BOOT::|$SetFunctions| BOOT::|$sourceFileTypes| BOOT::|String| + BOOT::NUMBER-TOKEN BOOT::$LINENUMBER BOOT::$NUM_OF_META_ERRORS + BOOT::|$Polvar| BOOT::|$domainsWithUnderDomains| + BOOT::SPADCALL BOOT::DELASC BOOT::FAIL BOOT::$COMPILE + BOOT::|$lastUntraced| BOOT::|$lisplibKind| + BOOT::|$tracedModemap| BOOT::|$inputPromptType| BOOT::LASSOC + LISP:NUMBER BOOT::|$prefix| BOOT::|$TranslateOnly| BOOT::SAY + BOOT::|$CategoryFrame| BOOT::|$croakIfTrue| BOOT::|$exitMode| + BOOT::|$lisplibDependentCategories| BOOT::|$NoValue| + BOOT::MOAN BOOT::POP-STACK-2 BOOT::BAC + BOOT::|$InitialModemapFrame| BOOT::$MAXLINENUMBER + BOOT::$ESCAPESTRING BOOT::|$bootStrapMode| + BOOT::|$compileMapFlag| BOOT::|$currentFunction| + BOOT::|$DomainNames| BOOT::|$PolyMode| BOOT::|$tripleCache| + BOOT::SUCHTHATCLAUSE BOOT::WHILE BOOT::S+ BOOT::|Expression| + BOOT::PARSE-NUMBER BOOT::|$Index| BOOT::$NBOOT + BOOT::|$PrintCompilerMessagesIfTrue| BOOT::$PROMPT + BOOT::MAKE-PARSE-FUNCTION BOOT::/METAOPTION BOOT::|$topOp| + BOOT::|$xyInitial| BOOT::MKPF BOOT::STRM + BOOT::MATCH-NEXT-TOKEN BOOT::|pathname| BOOT::|$cacheAlist| + BOOT::$FUNCTION BOOT::|$reportSpadTrace| + BOOT::|$tempCategoryTable| BOOT::|$underDomainAlist| + BOOT::|$whereList| BOOT::|append| BOOT::|function| + BOOT::CURINPUTLINE BOOT::|sayFORMULA| + BOOT::/GENVARLST BOOT::|$Category| BOOT::|$SpecialDomainNames| + VMLISP::|union| BOOT::ASSOCRIGHT BOOT::CURSTRMLINE + BOOT::REDUCTION BOOT::|$lisplibDomainDependents| + BOOT::|OptionList| BOOT::|$postStack| BOOT::|$traceDomains| + BOOT::BRIGHTPRINT BOOT::|$instantRecord| + BOOT::|$NETail| BOOT::UNTIL BOOT::GET-TOKEN + BOOT::|$Expression| BOOT::$LASTPREFIX BOOT::|$mathTraceList| + BOOT::|$PrintOnly| BOOT::ELEMN BOOT::NILADIC + BOOT::PARSE-BSTRING BOOT::/DEPTH BOOT::|$spadLibFT| + BOOT::|$xyMax| BOOT::|$IOindex| BOOT::SPADCONST + BOOT::|sayBrightlyI| BOOT::|SquareMatrix| + BOOT::LASTTAIL + BOOT::|UnboundBox| BOOT::NEXT-TOKEN + BOOT::|$OutsideStringIfTrue| BOOT::|$String| BOOT::TRIMLZ + BOOT::KADR BOOT::STRMBLANKLINE BOOT::STRMSKIPTOBLANK + BOOT::IOSTAT BOOT::|$insideCoerceInteractiveHardIfTrue| + BOOT::|$lisplibSignatureAlist| BOOT::REMFLAG BOOT::SPADREDUCE + BOOT::QLASSQ BOOT::NEXTSTRMLINE BOOT::|FontTable| BOOT::|Led| + BOOT::UNGET-TOKENS BOOT::|$operationNameList| + BOOT::|$tokenCommands| BOOT::IS_GENVAR BOOT::INIT-RULES + BOOT::|PrintItem| BOOT::$LISPLIB BOOT::|$optionAlist| + BOOT::|$previousTime| BOOT::|$StreamIndex| + BOOT::|$systemLisplibsWithModemapsInCore| + BOOT::|$tracedSpadModemap| BOOT::ISTEP BOOT::|$warningStack| + BOOT::|and| BOOT::OUT-STREAM BOOT::TOKEN + BOOT::|$ConstructorDependencyAlist| + BOOT::|$lisplibVariableAlist| BOOT::INTERNL BOOT::IEQUAL + BOOT::|$algebraList| BOOT::|$brightenCommentsIfTrue| + BOOT::|$failure| BOOT::|$Mode| BOOT::|$opFilter| + BOOT::|$TraceFlag| BOOT::|Float| BOOT::POP-STACK-3 + BOOT::|$EmptyString| BOOT::$TOP_STACK BOOT::|$mpolyTTrules| + BOOT::|$mpolyTMrules| BOOT::|$InteractiveFrame| + BOOT::|$InteractiveModemapFrame| BOOT::|$letAssoc| + BOOT::|$lisp2lispRenameAssoc| BOOT::|$RationalNumber| + BOOT::|$ThrowAwayMode| BOOT::*PROMPT* BOOT::NUMOFARGS + BOOT::|$semanticErrorStack| BOOT::|$spadSystemDisks| + BOOT::$TOP_LEVEL BOOT::BUMPCOMPERRORCOUNT + BOOT::|delete| BOOT::STREQ BOOT::STRING-TOKEN BOOT::XNAME + BOOT::|$ExpressionOpt| BOOT::|$systemCreation| BOOT::$GENNO + BOOT::CROAK BOOT::PARSE-STRING BOOT::|$genFVar| + BOOT::|$lisplibModemap| BOOT::|$NoValueMode| BOOT::|$PrintBox| + BOOT::ADVANCE-TOKEN BOOT::|$NegativeIntegerOpt| + BOOT::|$polyDefaultAssoc| BOOT::|$PrimitiveDomainNames| + LISP:STEP BOOT::|rassoc| BOOT::|$Res| + BOOT::MATCH-CURRENT-TOKEN BOOT::/GENSYMLIST BOOT::|$false| + BOOT::|$ignoreCommentsIfTrue| BOOT::|$ModeVariableList| + BOOT::|$useBFasDefault| BOOT::|$CommonDomains| + BOOT::|$printLoadMsgs| BOOT::|dataCoerce| BOOT::|$inLispVM| + BOOT::|$streamCount| + BOOT::|$Symbol| BOOT::|$updateIfTrue| BOOT::REMDUP + BOOT::ADDASSOC BOOT::|PrintList| + BOOT::SPECIAL-CHAR BOOT::XCAPE BOOT::|$EmptyVector| + BOOT::REPEAT BOOT::|$NegativeInteger| + BOOT::LENGTHENVEC BOOT::CURMAXINDEX BOOT::|$hasCategoryTable| + BOOT::|$leftPren| BOOT::|$lisplibForm| BOOT::|$OneCoef| + BOOT::|$reportCoerce| VMLISP::OPTIONLIST BOOT::META + BOOT::|$insideCapsuleFunctionIfTrue| + BOOT::|$insideConstructIfTrue| BOOT::$BOLDSTRING + BOOT::|breaklet| BOOT::|$insideCompTypeOf| + BOOT::|$rightPren| + BOOT::|$systemLastChanged| BOOT::|$xyCurrent| BOOT::|Zero| + BOOT::YIELD BOOT::|Polynomial| BOOT::|$Domain| BOOT::STRINGPAD + BOOT::TRUNCLIST BOOT::|SmallInteger| BOOT::|$libFile| + BOOT::|$mathTrace| BOOT::|$PolyDomains| BOOT::|or| + BOOT::|$DomainVariableList| BOOT::|$insideFunctorIfTrue| + BOOT::|$One| VMLISP::EXIT BOOT::CURRENT-CHAR BOOT::NBLNK + BOOT::$DALYMODE)) ;;; Definitions for package VMLISP of type EXPORT (lisp:in-package "VMLISP") (lisp:import '( -<> -<> - BOOT:|directoryp|)) +\getchunk{GCL.DEFINE-MACRO} +\getchunk{GCL.PNAME} + BOOT:|directoryp|)) (lisp:export '(VMLISP::SINTP VMLISP::$FCOPY -<> -<> +\getchunk{GCL.DEFINE-MACRO} +\getchunk{GCL.PNAME} VMLISP::PUT VMLISP::DIGITS-BY-RADIX - VMLISP::QVELT-1 VMLISP::QSETVELT-1 vmlisp::throw-protect - VMLISP::|directoryp| VMLISP::EQCAR - VMLISP::DEFIOSTREAM VMLISP::RDEFIOSTREAM VMLISP::MLAMBDA - VMLISP::QSLESSP VMLISP::QSDIFFERENCE VMLISP::QSQUOTIENT - VMLISP::ERROROUTSTREAM VMLISP::CREATE-SBC VMLISP::LASTPAIR - VMLISP::EQSUBSTLIST VMLISP::QCAAAR VMLISP::$TOTAL-ELAPSED-TIME - VMLISP::QUOTIENT VMLISP::SORTGREATERP - VMLISP::QSETREFV VMLISP::QSTRINGLENGTH VMLISP::EVALFUN - VMLISP::QCDAR VMLISP::TEMPUS-FUGIT VMLISP::QSPLUS VMLISP::QSABSVAL - VMLISP::QSZEROP VMLISP::QSMIN VMLISP::QSLEFTSHIFT - VMLISP::SETDIFFERENCE VMLISP::RPLQ VMLISP::CATCHALL - VMLISP::RECOMPILE-DIRECTORY VMLISP::MDEF VMLISP::LINTP - VMLISP::NILFN VMLISP::TAB VMLISP::QCDDR VMLISP::IOSTATE - VMLISP::SFP VMLISP::NE VMLISP::STRGREATERP - VMLISP::USE-VMLISP-SYNTAX VMLISP::RCLASS - VMLISP::SEQ VMLISP::FIXP VMLISP::MAKE-CVEC - VMLISP::|F,PRINT-ONE| VMLISP::HASHUEQUAL VMLISP::$OUTFILEP - VMLISP::TIMES VMLISP::DIFFERENCE VMLISP::MSUBST VMLISP::DIVIDE - VMLISP::|remove| VMLISP::GETL VMLISP::QCADAR VMLISP::QCAAAAR - VMLISP::RECLAIM VMLISP::ORADDTEMPDEFS VMLISP::NAMEDERRSET - VMLISP::TRIMSTRING VMLISP::CURRINDEX VMLISP::EVALANDFILEACTQ - VMLISP::LISPLIB VMLISP::FLUID VMLISP::MDEFX VMLISP::COMP370 - VMLISP::NEQ VMLISP::GETREFV VMLISP::|log| VMLISP::QVSIZE - VMLISP::MBPIP VMLISP::RPLNODE VMLISP::QSORT - VMLISP::PLACEP VMLISP::RREAD VMLISP::BINTP VMLISP::QSODDP - VMLISP::O VMLISP::RVECP VMLISP::CHAR2NUM VMLISP::POPP - VMLISP::QCDAADR VMLISP::HKEYS VMLISP::HASHCVEC VMLISP::HASHID - VMLISP::REMOVEQ VMLISP::LISTOFFUNCTIONS - VMLISP::QCADAAR VMLISP::ABSVAL VMLISP::VMPRINT - VMLISP::MAKE-APPENDSTREAM - VMLISP::MAKE-INSTREAM VMLISP::HASHTABLEP VMLISP::UPCASE - VMLISP::LOADCOND VMLISP::STRPOSL VMLISP::STATEP VMLISP::QCDADR - VMLISP::HREMPROP VMLISP::LAM VMLISP::FBPIP VMLISP::NCONC2 - VMLISP::GETFULLSTR VMLISP::I VMLISP::HREM - VMLISP::*LISP-BIN-FILETYPE* VMLISP::INT2RNUM VMLISP::EBCDIC - VMLISP::$INFILEP VMLISP::BFP VMLISP::NUMP VMLISP::UNEMBED - VMLISP::PAIRP VMLISP::BOOLEANP VMLISP::FIX VMLISP::REMAINDER - VMLISP::RE-ENABLE-INT VMLISP::QCAADDR VMLISP::QCDDADR - VMLISP::$LISTFILE VMLISP::IVECP VMLISP::LIST2VEC - VMLISP::|LAM,FILEACTQ| VMLISP::LISTOFQUOTES - VMLISP::$ERASE VMLISP::QSDEC1 - VMLISP::QSSUB1 VMLISP::QCAR VMLISP::EVA1FUN VMLISP::IS-CONSOLE - VMLISP::MAKESTRING VMLISP::CUROUTSTREAM VMLISP::QCDDDR - VMLISP::QCDADAR VMLISP::MAKE-ABSOLUTE-FILENAME VMLISP::SUFFIX - VMLISP::FUNARGP VMLISP::VM/ VMLISP::QRPLACA VMLISP::GGREATERP - VMLISP::CGREATERP VMLISP::RNUMP VMLISP::RESETQ VMLISP::QRPLACD - VMLISP::SORTBY VMLISP::CVECP VMLISP::SETELT VMLISP::HGET - VMLISP::$DIRECTORY-LIST VMLISP::LN VMLISP::|member| - VMLISP::$LIBRARY-DIRECTORY-LIST - VMLISP::QCSIZE VMLISP::QCADDDR VMLISP::RWRITE VMLISP::SUBLOAD - VMLISP::STRINGIMAGE VMLISP::$CLEAR VMLISP::|read-line| - VMLISP::PROPLIST VMLISP::INTP VMLISP::OUTPUT VMLISP::CONSOLE - VMLISP::QCDDDAR VMLISP::ADDOPTIONS VMLISP::$FILETYPE-TABLE - VMLISP::QSMINUSP VMLISP::|assoc| VMLISP::SETSIZE VMLISP::QCDR - VMLISP::EFFACE VMLISP::COPY VMLISP::DOWNCASE VMLISP::LC2UC - VMLISP::EMBED VMLISP::SETANDFILEQ VMLISP::QSMAX - VMLISP::LIST2REFVEC VMLISP::MACRO-INVALIDARGS VMLISP::EMBEDDED - VMLISP::REFVECP VMLISP::CLOSEDFN VMLISP::MAKE-HASHTABLE - VMLISP::MAKE-FILENAME VMLISP::|$defaultMsgDatabaseName| - VMLISP::LEXGREATERP - VMLISP::IDENTP VMLISP::QSINC1 VMLISP::QESET VMLISP::MRP - VMLISP::LESSP VMLISP::RPLPAIR VMLISP::QVELT VMLISP::QRPLQ - VMLISP::MACERR VMLISP::*FILEACTQ-APPLY* VMLISP::HPUT* - VMLISP::$FILEP VMLISP::MAKE-FULL-CVEC VMLISP::HCLEAR - VMLISP::ERRORINSTREAM VMLISP::HPUTPROP - VMLISP::STRING2ID-N VMLISP::CALLBELOW VMLISP::BPINAME - VMLISP::CHANGELENGTH VMLISP::ECQ VMLISP::OBEY VMLISP::QASSQ - VMLISP::DCQ VMLISP::SHUT VMLISP::FILE VMLISP::HPUT - VMLISP::MAKEPROP VMLISP::GREATERP - VMLISP::REROOT VMLISP::DIG2FIX VMLISP::L-CASE - VMLISP::TEREAD VMLISP::QSREMAINDER VMLISP::$FINDFILE - VMLISP::EQQ VMLISP::PRETTYPRINT VMLISP::HASHEQ VMLISP::LOG2 - VMLISP::U-CASE VMLISP::NREMOVE VMLISP::QREFELT VMLISP::SIZE - VMLISP::EOFP VMLISP::QCDAAR VMLISP::RSHUT VMLISP::ADD1 - VMLISP::SUBSTRING VMLISP::LOADVOL - VMLISP::QSTIMES VMLISP::STRINGLENGTH VMLISP::NEXT - VMLISP::DEVICE VMLISP::MAPELT VMLISP::LENGTHOFBPI - VMLISP::DIGITP VMLISP::QLENGTH VMLISP::QCAAADR VMLISP::CVEC - VMLISP::VEC2LIST VMLISP::MODE VMLISP::MAKE-VEC VMLISP::GCMSG - VMLISP::CONCAT VMLISP::$SHOWLINE VMLISP::QCAADR VMLISP::QCDDAR - VMLISP::QCDAAAR VMLISP::RDROPITEMS VMLISP::VECP - VMLISP::|union| VMLISP::ONE-OF VMLISP::NULLOUTSTREAM - VMLISP::QSGREATERP VMLISP::MINUS VMLISP::MAXINDEX - VMLISP::GETSTR VMLISP::QCADADR VMLISP::PRIN2CVEC - VMLISP::CURRENTTIME VMLISP::$REPLACE VMLISP::UNIONQ - VMLISP::NREMOVEQ VMLISP::CURINSTREAM VMLISP::MAKE-OUTSTREAM - VMLISP::APPLX VMLISP::LASTNODE VMLISP::SUBSTQ VMLISP::TRUEFN - VMLISP::|last| VMLISP::RPLACSTR VMLISP::SETQP VMLISP::QCADDR - VMLISP::QCAADAR VMLISP::QCDDAAR VMLISP::|intersection| - VMLISP::HASHTABLE-CLASS VMLISP::$CURRENT-DIRECTORY - VMLISP::*COMP370-APPLY* VMLISP::QSETVELT VMLISP::MOVEVEC - VMLISP::ID VMLISP::DEFINE-FUNCTION VMLISP::MSUBSTQ VMLISP::|nsubst| - VMLISP::LISTOFFLUIDS VMLISP::SUB1 VMLISP::NUMBEROFARGS - VMLISP::VMREAD VMLISP::SMINTP VMLISP::$SCREENSIZE - VMLISP::LISTOFFREES VMLISP::QCDADDR VMLISP::COMPRREAD - VMLISP::GENSYMP VMLISP::IFCAR VMLISP::QSETQ - VMLISP::QCADDAR VMLISP::*LISP-SOURCE-FILETYPE* VMLISP::KOMPILE - VMLISP::INPUT VMLISP::PAPPP VMLISP::UEQUAL VMLISP::COMPRWRITE - VMLISP::SUBRP VMLISP::ASSEMBLE VMLISP::|LAM,EVALANDFILEACTQ| - VMLISP::|$msgDatabaseName| VMLISP::IFCDR VMLISP::QVMAXINDEX - VMLISP::$SPADROOT VMLISP::PRIN0 VMLISP::PRETTYPRIN0 - VMLISP::STACKLIFO VMLISP::ASSQ VMLISP::PRINTEXP - VMLISP::QCDDDDR VMLISP::QSADD1 - VMLISP::SETDIFFERENCEQ VMLISP::STRPOS VMLISP::CONSTANT - VMLISP::QCAAR VMLISP::HCOUNT VMLISP::RCOPYITEMS - VMLISP::QSMINUS VMLISP::EVA1 VMLISP::OPTIONLIST - VMLISP::NUM2CHAR VMLISP::QENUM VMLISP::QEQQ - VMLISP::$TOTAL-GC-TIME VMLISP::CHARP VMLISP::QCADR - VMLISP::INTERSECTIONQ VMLISP::DSETQ VMLISP::FETCHCHAR - VMLISP::STRCONC VMLISP::MACRO-MISSINGARGS VMLISP::RPACKFILE - VMLISP::EXIT VMLISP::PLUS VMLISP::RKEYIDS - VMLISP::COMPILE-LIB-FILE VMLISP::RECOMPILE-LIB-FILE-IF-NECESSARY)) + VMLISP::QVELT-1 VMLISP::QSETVELT-1 vmlisp::throw-protect + VMLISP::|directoryp| VMLISP::EQCAR + VMLISP::DEFIOSTREAM VMLISP::RDEFIOSTREAM VMLISP::MLAMBDA + VMLISP::QSLESSP VMLISP::QSDIFFERENCE VMLISP::QSQUOTIENT + VMLISP::ERROROUTSTREAM VMLISP::CREATE-SBC VMLISP::LASTPAIR + VMLISP::EQSUBSTLIST VMLISP::QCAAAR VMLISP::$TOTAL-ELAPSED-TIME + VMLISP::QUOTIENT VMLISP::SORTGREATERP + VMLISP::QSETREFV VMLISP::QSTRINGLENGTH VMLISP::EVALFUN + VMLISP::QCDAR VMLISP::TEMPUS-FUGIT VMLISP::QSPLUS VMLISP::QSABSVAL + VMLISP::QSZEROP VMLISP::QSMIN VMLISP::QSLEFTSHIFT + VMLISP::SETDIFFERENCE VMLISP::RPLQ VMLISP::CATCHALL + VMLISP::RECOMPILE-DIRECTORY VMLISP::MDEF VMLISP::LINTP + VMLISP::NILFN VMLISP::TAB VMLISP::QCDDR VMLISP::IOSTATE + VMLISP::SFP VMLISP::NE VMLISP::STRGREATERP + VMLISP::USE-VMLISP-SYNTAX VMLISP::RCLASS + VMLISP::SEQ VMLISP::FIXP VMLISP::MAKE-CVEC + VMLISP::|F,PRINT-ONE| VMLISP::HASHUEQUAL VMLISP::$OUTFILEP + VMLISP::TIMES VMLISP::DIFFERENCE VMLISP::MSUBST VMLISP::DIVIDE + VMLISP::|remove| VMLISP::GETL VMLISP::QCADAR VMLISP::QCAAAAR + VMLISP::RECLAIM VMLISP::ORADDTEMPDEFS VMLISP::NAMEDERRSET + VMLISP::TRIMSTRING VMLISP::CURRINDEX VMLISP::EVALANDFILEACTQ + VMLISP::LISPLIB VMLISP::FLUID VMLISP::MDEFX VMLISP::COMP370 + VMLISP::NEQ VMLISP::GETREFV VMLISP::|log| VMLISP::QVSIZE + VMLISP::MBPIP VMLISP::RPLNODE VMLISP::QSORT + VMLISP::PLACEP VMLISP::RREAD VMLISP::BINTP VMLISP::QSODDP + VMLISP::O VMLISP::RVECP VMLISP::CHAR2NUM VMLISP::POPP + VMLISP::QCDAADR VMLISP::HKEYS VMLISP::HASHCVEC VMLISP::HASHID + VMLISP::REMOVEQ VMLISP::LISTOFFUNCTIONS + VMLISP::QCADAAR VMLISP::ABSVAL VMLISP::VMPRINT + VMLISP::MAKE-APPENDSTREAM + VMLISP::MAKE-INSTREAM VMLISP::HASHTABLEP VMLISP::UPCASE + VMLISP::LOADCOND VMLISP::STRPOSL VMLISP::STATEP VMLISP::QCDADR + VMLISP::HREMPROP VMLISP::LAM VMLISP::FBPIP VMLISP::NCONC2 + VMLISP::GETFULLSTR VMLISP::I VMLISP::HREM + VMLISP::*LISP-BIN-FILETYPE* VMLISP::INT2RNUM VMLISP::EBCDIC + VMLISP::$INFILEP VMLISP::BFP VMLISP::NUMP VMLISP::UNEMBED + VMLISP::PAIRP VMLISP::BOOLEANP VMLISP::FIX VMLISP::REMAINDER + VMLISP::RE-ENABLE-INT VMLISP::QCAADDR VMLISP::QCDDADR + VMLISP::$LISTFILE VMLISP::IVECP VMLISP::LIST2VEC + VMLISP::|LAM,FILEACTQ| VMLISP::LISTOFQUOTES + VMLISP::$ERASE VMLISP::QSDEC1 + VMLISP::QSSUB1 VMLISP::QCAR VMLISP::EVA1FUN VMLISP::IS-CONSOLE + VMLISP::MAKESTRING VMLISP::CUROUTSTREAM VMLISP::QCDDDR + VMLISP::QCDADAR VMLISP::MAKE-ABSOLUTE-FILENAME VMLISP::SUFFIX + VMLISP::FUNARGP VMLISP::VM/ VMLISP::QRPLACA VMLISP::GGREATERP + VMLISP::CGREATERP VMLISP::RNUMP VMLISP::RESETQ VMLISP::QRPLACD + VMLISP::SORTBY VMLISP::CVECP VMLISP::SETELT VMLISP::HGET + VMLISP::$DIRECTORY-LIST VMLISP::LN VMLISP::|member| + VMLISP::$LIBRARY-DIRECTORY-LIST + VMLISP::QCSIZE VMLISP::QCADDDR VMLISP::RWRITE VMLISP::SUBLOAD + VMLISP::STRINGIMAGE VMLISP::$CLEAR VMLISP::|read-line| + VMLISP::PROPLIST VMLISP::INTP VMLISP::OUTPUT VMLISP::CONSOLE + VMLISP::QCDDDAR VMLISP::ADDOPTIONS VMLISP::$FILETYPE-TABLE + VMLISP::QSMINUSP VMLISP::|assoc| VMLISP::SETSIZE VMLISP::QCDR + VMLISP::EFFACE VMLISP::COPY VMLISP::DOWNCASE VMLISP::LC2UC + VMLISP::EMBED VMLISP::SETANDFILEQ VMLISP::QSMAX + VMLISP::LIST2REFVEC VMLISP::MACRO-INVALIDARGS VMLISP::EMBEDDED + VMLISP::REFVECP VMLISP::CLOSEDFN VMLISP::MAKE-HASHTABLE + VMLISP::MAKE-FILENAME VMLISP::|$defaultMsgDatabaseName| + VMLISP::LEXGREATERP + VMLISP::IDENTP VMLISP::QSINC1 VMLISP::QESET VMLISP::MRP + VMLISP::LESSP VMLISP::RPLPAIR VMLISP::QVELT VMLISP::QRPLQ + VMLISP::MACERR VMLISP::*FILEACTQ-APPLY* VMLISP::HPUT* + VMLISP::$FILEP VMLISP::MAKE-FULL-CVEC VMLISP::HCLEAR + VMLISP::ERRORINSTREAM VMLISP::HPUTPROP + VMLISP::STRING2ID-N VMLISP::CALLBELOW VMLISP::BPINAME + VMLISP::CHANGELENGTH VMLISP::ECQ VMLISP::OBEY VMLISP::QASSQ + VMLISP::DCQ VMLISP::SHUT VMLISP::FILE VMLISP::HPUT + VMLISP::MAKEPROP VMLISP::GREATERP + VMLISP::REROOT VMLISP::DIG2FIX VMLISP::L-CASE + VMLISP::TEREAD VMLISP::QSREMAINDER VMLISP::$FINDFILE + VMLISP::EQQ VMLISP::PRETTYPRINT VMLISP::HASHEQ VMLISP::LOG2 + VMLISP::U-CASE VMLISP::NREMOVE VMLISP::QREFELT VMLISP::SIZE + VMLISP::EOFP VMLISP::QCDAAR VMLISP::RSHUT VMLISP::ADD1 + VMLISP::SUBSTRING VMLISP::LOADVOL + VMLISP::QSTIMES VMLISP::STRINGLENGTH VMLISP::NEXT + VMLISP::DEVICE VMLISP::MAPELT VMLISP::LENGTHOFBPI + VMLISP::DIGITP VMLISP::QLENGTH VMLISP::QCAAADR VMLISP::CVEC + VMLISP::VEC2LIST VMLISP::MODE VMLISP::MAKE-VEC VMLISP::GCMSG + VMLISP::CONCAT VMLISP::$SHOWLINE VMLISP::QCAADR VMLISP::QCDDAR + VMLISP::QCDAAAR VMLISP::RDROPITEMS VMLISP::VECP + VMLISP::|union| VMLISP::ONE-OF VMLISP::NULLOUTSTREAM + VMLISP::QSGREATERP VMLISP::MINUS VMLISP::MAXINDEX + VMLISP::GETSTR VMLISP::QCADADR VMLISP::PRIN2CVEC + VMLISP::CURRENTTIME VMLISP::$REPLACE VMLISP::UNIONQ + VMLISP::NREMOVEQ VMLISP::CURINSTREAM VMLISP::MAKE-OUTSTREAM + VMLISP::APPLX VMLISP::LASTNODE VMLISP::SUBSTQ VMLISP::TRUEFN + VMLISP::|last| VMLISP::RPLACSTR VMLISP::SETQP VMLISP::QCADDR + VMLISP::QCAADAR VMLISP::QCDDAAR VMLISP::|intersection| + VMLISP::HASHTABLE-CLASS VMLISP::$CURRENT-DIRECTORY + VMLISP::*COMP370-APPLY* VMLISP::QSETVELT VMLISP::MOVEVEC + VMLISP::ID VMLISP::DEFINE-FUNCTION VMLISP::MSUBSTQ VMLISP::|nsubst| + VMLISP::LISTOFFLUIDS VMLISP::SUB1 VMLISP::NUMBEROFARGS + VMLISP::VMREAD VMLISP::SMINTP VMLISP::$SCREENSIZE + VMLISP::LISTOFFREES VMLISP::QCDADDR VMLISP::COMPRREAD + VMLISP::GENSYMP VMLISP::IFCAR VMLISP::QSETQ + VMLISP::QCADDAR VMLISP::*LISP-SOURCE-FILETYPE* VMLISP::KOMPILE + VMLISP::INPUT VMLISP::PAPPP VMLISP::UEQUAL VMLISP::COMPRWRITE + VMLISP::SUBRP VMLISP::ASSEMBLE VMLISP::|LAM,EVALANDFILEACTQ| + VMLISP::|$msgDatabaseName| VMLISP::IFCDR VMLISP::QVMAXINDEX + VMLISP::$SPADROOT VMLISP::PRIN0 VMLISP::PRETTYPRIN0 + VMLISP::STACKLIFO VMLISP::ASSQ VMLISP::PRINTEXP + VMLISP::QCDDDDR VMLISP::QSADD1 + VMLISP::SETDIFFERENCEQ VMLISP::STRPOS VMLISP::CONSTANT + VMLISP::QCAAR VMLISP::HCOUNT VMLISP::RCOPYITEMS + VMLISP::QSMINUS VMLISP::EVA1 VMLISP::OPTIONLIST + VMLISP::NUM2CHAR VMLISP::QENUM VMLISP::QEQQ + VMLISP::$TOTAL-GC-TIME VMLISP::CHARP VMLISP::QCADR + VMLISP::INTERSECTIONQ VMLISP::DSETQ VMLISP::FETCHCHAR + VMLISP::STRCONC VMLISP::MACRO-MISSINGARGS VMLISP::RPACKFILE + VMLISP::EXIT VMLISP::PLUS VMLISP::RKEYIDS + VMLISP::COMPILE-LIB-FILE VMLISP::RECOMPILE-LIB-FILE-IF-NECESSARY)) ;;; Definitions for package BOOT of type SHADOW (lisp:in-package "BOOT") (lisp:shadow '(BOOT::MAP)) (lisp:import '(VMLISP::ERROROUTSTREAM LISP:COUNT VMLISP::NE VMLISP::FLUID - LISP:SEQUENCE VMLISP::OBEY LISP::NUMBER VMLISP::|union| - LISP:STEP VMLISP::OPTIONLIST VMLISP::EXIT VMLISP::LEXGREATERP)) + LISP:SEQUENCE VMLISP::OBEY LISP::NUMBER VMLISP::|union| + LISP:STEP VMLISP::OPTIONLIST VMLISP::EXIT VMLISP::LEXGREATERP)) (lisp:import '(vmlisp::make-input-filename)) (lisp:import '(vmlisp::libstream-dirname)) (lisp:import '(user::spad-save)) @@ -467,131 +464,131 @@ provides support for compiler code. (in-package "BOOT") ;; Used to be "UNCOMMON" (export '( - ;; !! ;;; Passed on from the Lisp package - ;; !! + * - + ;; !! ;;; Passed on from the Lisp package + ;; !! + * - - ;;;; Operating system interface - |OsRunProgram| |OsRunProgramToStream| |OsProcessNumber| - |OsEnvGet| |OsEnvVarCharacter| |OsExpandString| + ;;;; Operating system interface + |OsRunProgram| |OsRunProgramToStream| |OsProcessNumber| + |OsEnvGet| |OsEnvVarCharacter| |OsExpandString| - ;;;; Time - |TimeStampString| + ;;;; Time + |TimeStampString| - ;;;; Lisp Interface - |LispKeyword| - |LispReadFromString| |LispEval| - |LispCompile| |LispCompileFile| |LispCompileFileQuietlyToObject| - |LispLoadFile| |LispLoadFileQuietly| + ;;;; Lisp Interface + |LispKeyword| + |LispReadFromString| |LispEval| + |LispCompile| |LispCompileFile| |LispCompileFileQuietlyToObject| + |LispLoadFile| |LispLoadFileQuietly| - ;;; Control - |funcall| |Catch| |Throw| |UnwindProtect| |CatchAsCan| + ;;; Control + |funcall| |Catch| |Throw| |UnwindProtect| |CatchAsCan| - ;;; General - |Eq| |Nil| |DeepCopy| |Sort| |SortInPlace| + ;;; General + |Eq| |Nil| |DeepCopy| |Sort| |SortInPlace| - |genRemoveDuplicates| |genMember| - |gobSharedExcluding| |gobSharedParts| |gobAlwaysShared?| - |gobPretty| |gobSexpr| + |genRemoveDuplicates| |genMember| + |gobSharedExcluding| |gobSharedParts| |gobAlwaysShared?| + |gobPretty| |gobSexpr| - ;;; Streams - |Prompt| |PlainError| |PrettyPrint| |PlainPrint| |PlainPrintOn| - |WithOpenStream| - |WriteLispExpr| |WriteByte| |WriteChar| |WriteLine| |WriteString| - |ReadLispExpr| |ReadByte| |ReadChar| |ReadLine| - |ByteFileWriteLine| |ByteFileReadLine| - |ReadLineIntoString| |ByteFileReadLineIntoString| |ReadBytesIntoVector| - |StreamCopyChars| |StreamCopyBytes| - |InputStream?| |OutputStream?| - |StreamSize| |StreamGetPosition| |StreamSetPosition| - |StreamEnd?| |StreamFlush| |StreamClose| + ;;; Streams + |Prompt| |PlainError| |PrettyPrint| |PlainPrint| |PlainPrintOn| + |WithOpenStream| + |WriteLispExpr| |WriteByte| |WriteChar| |WriteLine| |WriteString| + |ReadLispExpr| |ReadByte| |ReadChar| |ReadLine| + |ByteFileWriteLine| |ByteFileReadLine| + |ReadLineIntoString| |ByteFileReadLineIntoString| |ReadBytesIntoVector| + |StreamCopyChars| |StreamCopyBytes| + |InputStream?| |OutputStream?| + |StreamSize| |StreamGetPosition| |StreamSetPosition| + |StreamEnd?| |StreamFlush| |StreamClose| - |FileLine| |StreamLine| + |FileLine| |StreamLine| - ;;; Pathnames - |TempFileDirectory| |LispFileType| |FaslFileType| - |ToPathname| |Pathname| |NewPathname| |SessionPathname| - |PathnameDirectory| |PathnameName| |PathnameType| - |PathnameString| |PathnameAbsolute?| - |PathnameWithType| |PathnameWithDirectory| - |PathnameWithoutType| |PathnameWithoutDirectory| + ;;; Pathnames + |TempFileDirectory| |LispFileType| |FaslFileType| + |ToPathname| |Pathname| |NewPathname| |SessionPathname| + |PathnameDirectory| |PathnameName| |PathnameType| + |PathnameString| |PathnameAbsolute?| + |PathnameWithType| |PathnameWithDirectory| + |PathnameWithoutType| |PathnameWithoutDirectory| - |PathnameToUsualCase| |PathnameWithinDirectory| - |PathnameDirectoryOfDirectoryPathname| |PathnameWithinOsEnvVar| + |PathnameToUsualCase| |PathnameWithinDirectory| + |PathnameDirectoryOfDirectoryPathname| |PathnameWithinOsEnvVar| - ;;; Symbols - |MakeSymbol| |Symbol?| |SymbolString| + ;;; Symbols + |MakeSymbol| |Symbol?| |SymbolString| - ;;; Bits - |Bit| |Bit?| |TrueBit| |FalseBit| |BitOn?| |BitOr| + ;;; Bits + |Bit| |Bit?| |TrueBit| |FalseBit| |BitOn?| |BitOr| - ;;; General Sequences - ;; !! ;;; Passed on from the Lisp package - ;; !! ELT SETELT - ;; SIZE + ;;; General Sequences + ;; !! ;;; Passed on from the Lisp package + ;; !! ELT SETELT + ;; SIZE - ;;; Vectors - |FullVector| |Vector?| + ;;; Vectors + |FullVector| |Vector?| - ;;; Bit Vectors - |FullBvec| + ;;; Bit Vectors + |FullBvec| - ;;; Characters - |char| |Char| |Char?| - |CharCode| |CharGreater?| |CharDigit?| - |SpaceChar| |NewlineChar| + ;;; Characters + |char| |Char| |Char?| + |CharCode| |CharGreater?| |CharDigit?| + |SpaceChar| |NewlineChar| - ;;; Character Sets - |Cset| |CsetMember?| - |CsetUnion| |CsetComplement| |CsetString| - |NumericCset| |LowerCaseCset| |UpperCaseCset| |WhiteSpaceCset| - |AlphaCset| |AlphaNumericCset| + ;;; Character Sets + |Cset| |CsetMember?| + |CsetUnion| |CsetComplement| |CsetString| + |NumericCset| |LowerCaseCset| |UpperCaseCset| |WhiteSpaceCset| + |AlphaCset| |AlphaNumericCset| - ;;; Character Strings - |FullString| |ToString| |StringImage| |String?| - |StringGetCode| |StringConcat| - |StringLength| |StringFromTo| |StringFromToEnd| |StringFromLong| - |StringGreater?| |StringPrefix?| |StringUpperCase| |StringLowerCase| - |StringToInteger| |StringToFloat| - |StringWords| |StringTrim| - |StringPositionOf| |StringPositionOfNot| - |UnescapeString| |ExpandVariablesInString| + ;;; Character Strings + |FullString| |ToString| |StringImage| |String?| + |StringGetCode| |StringConcat| + |StringLength| |StringFromTo| |StringFromToEnd| |StringFromLong| + |StringGreater?| |StringPrefix?| |StringUpperCase| |StringLowerCase| + |StringToInteger| |StringToFloat| + |StringWords| |StringTrim| + |StringPositionOf| |StringPositionOfNot| + |UnescapeString| |ExpandVariablesInString| - ;;; Numbers - |Number?| |Integer?| |SmallInteger?| |Float?| |DoublePrecision| - |Odd?| |Remainder| - |Abs| |Min| |Max| - |Exp| |Ln| |Log10| - |Sin| |Cos| |Tan| |Cotan| |Arctan| + ;;; Numbers + |Number?| |Integer?| |SmallInteger?| |Float?| |DoublePrecision| + |Odd?| |Remainder| + |Abs| |Min| |Max| + |Exp| |Ln| |Log10| + |Sin| |Cos| |Tan| |Cotan| |Arctan| - ;;; Pairs - |Pair?| + ;;; Pairs + |Pair?| - |car| |cdr| - |caar| |cadr| |cdar| |cddr| - |caaar| |caadr| |cadar| |caddr| - |cdaar| |cdadr| |cddar| |cdddr| - |FastCar| |FastCdr| - |FastCaar| |FastCadr| |FastCdar| |FastCddr| - |FastCaaar| |FastCaadr| |FastCadar| |FastCaddr| - |FastCdaar| |FastCdadr| |FastCddar| |FastCdddr| - |IfCar| |IfCdr| - |EqCar| |EqCdr| + |car| |cdr| + |caar| |cadr| |cdar| |cddr| + |caaar| |caadr| |cadar| |caddr| + |cdaar| |cdadr| |cddar| |cdddr| + |FastCar| |FastCdr| + |FastCaar| |FastCadr| |FastCdar| |FastCddr| + |FastCaaar| |FastCaadr| |FastCadar| |FastCaddr| + |FastCdaar| |FastCdadr| |FastCddar| |FastCdddr| + |IfCar| |IfCdr| + |EqCar| |EqCdr| - ;;; Lists - |length1?| |second| + ;;; Lists + |length1?| |second| - |ListIsLength?| |ListMemberQ?| |ListMember?| - |ListRemoveQ| |ListNRemoveQ| |ListRemoveDuplicatesQ| |ListNReverse| - |ListUnion| |ListUnionQ| |ListIntersection| |ListIntersectionQ| - |ListAdjoin| |ListAdjoinQ| + |ListIsLength?| |ListMemberQ?| |ListMember?| + |ListRemoveQ| |ListNRemoveQ| |ListRemoveDuplicatesQ| |ListNReverse| + |ListUnion| |ListUnionQ| |ListIntersection| |ListIntersectionQ| + |ListAdjoin| |ListAdjoinQ| - ;;; Association lists - |AlistAssoc| |AlistRemove| - |AlistAssocQ| |AlistRemoveQ| |AlistAdjoinQ| |AlistUnionQ| + ;;; Association lists + |AlistAssoc| |AlistRemove| + |AlistAssocQ| |AlistRemoveQ| |AlistAdjoinQ| |AlistUnionQ| - ;;; Tables - |Table?| - |TableCount| |TableGet| |TableSet| |TableUnset| |TableKeys| + ;;; Tables + |Table?| + |TableCount| |TableGet| |TableSet| |TableUnset| |TableKeys| )) (in-package "BOOT") @@ -1034,9 +1031,9 @@ FOAM::|BIntSIPower| FOAM::|BIntTimesPlus| FOAM::|BIntNext| )) -@ +\end{chunk} \section{License} -<>= +\begin{verbatim} ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -1068,7 +1065,7 @@ FOAM::|BIntNext| ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ +\end{verbatim} \newpage \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/template.lisp.pamphlet b/src/interp/template.lisp.pamphlet index f8b1051..c4a79fe 100644 --- a/src/interp/template.lisp.pamphlet +++ b/src/interp/template.lisp.pamphlet @@ -9,7 +9,7 @@ \eject \tableofcontents \eject -<<*>>= +\begin{chunk}{*} (IN-PACKAGE "BOOT" ) @@ -1214,7 +1214,7 @@ (RPLACD |u| |val|) |val|)))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/termrw.lisp.pamphlet b/src/interp/termrw.lisp.pamphlet index 7e5db2b..f72dabb 100644 --- a/src/interp/termrw.lisp.pamphlet +++ b/src/interp/termrw.lisp.pamphlet @@ -31,7 +31,7 @@ in both cases copying is only done if necessary to avoid destruction this means, EQ can be used to check whether something was done \end{verbatim} -<<*>>= +\begin{chunk}{*} (IN-PACKAGE "BOOT" ) @@ -350,7 +350,7 @@ this means, EQ can be used to check whether something was done ((AND |t2| (SPADLET |t0| (|deepSubCopyOrNil| |t2| SL))) (CONS |t| (CONS |t1| (CDR |t0|)))))))))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/topics.lisp.pamphlet b/src/interp/topics.lisp.pamphlet index db0b0a3..8333ca5 100644 --- a/src/interp/topics.lisp.pamphlet +++ b/src/interp/topics.lisp.pamphlet @@ -9,7 +9,7 @@ \eject \tableofcontents \eject -<<*>>= +\begin{chunk}{*} (IN-PACKAGE "BOOT" ) @@ -806,7 +806,7 @@ (SETQ G166591 (CONS |key| G166591))))))))))))))) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet index ce58c70..0763d33 100644 --- a/src/interp/util.lisp.pamphlet +++ b/src/interp/util.lisp.pamphlet @@ -37,7 +37,7 @@ the necessary functions and macros to compile any file. The {\bf depsys} image is almost the same as an {\bf interpsys} image but it does not have any autoload triggers or databases loaded. -<>= +\begin{chunk}{build-depsys} (defun build-depsys (load-files spad lsp src int obj mnt sys) #+:CCL (setq *package* (find-package "BOOT")) @@ -49,13 +49,13 @@ loaded. (initroot spad) #+:AKCL (init-memory-config :cons 1000 :fixnum 400 :symbol 1000 :package 16 - :array 800 :string 1000 :cfun 200 :cpages 2000 - :rpages 2000 :hole 4000) ) + :array 800 :string 1000 :cfun 200 :cpages 2000 + :rpages 2000 :hole 4000) ) ;; (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8 -;; :array 400 :string 500 :cfun 100 :cpages 1000 -;; :rpages 1000 :hole 2000) ) +;; :array 400 :string 500 :cfun 100 :cpages 1000 +;; :rpages 1000 :hole 2000) ) -@ +\end{chunk} \subsubsection{make-depsys} When we are building a {\bf depsys} image for AKCL (now GCL) we need need to initialize some optimization routines. Each time a file is @@ -73,7 +73,7 @@ into the image. It used to read: (load collectfn) (compiler::emit-fn t) \end{verbatim} -<>= +\begin{chunk}{make-depsys} (defun make-depsys (lsp src int obj mnt sys) ;; perform system initializations for building a starter system (init-memory-config) @@ -89,7 +89,7 @@ into the image. It used to read: (load (concatenate 'string obj "/" sys "/interp/proclaims.lisp"))) ) -@ +\end{chunk} \subsection{Building Interpsys (build-interpsys)} \begin{verbatim} ;############################################################################ @@ -99,15 +99,15 @@ into the image. It used to read: ;# information is useful: ;# there are 2 cases: ;# 1) adding files to currently autoloaded parts -;# (as of 2/92: browser old parser and old compiler) +;# (as of 2/92: browser old parser and old compiler) ;# 2) adding new files ;# case 1: ;# a) you have to add the file to the list of files currently there -;# (e.g. see BROBJS above) +;# (e.g. see BROBJS above) ;# b) add an autolaod rule -;# (e.g. ${AUTO}/parsing.${O}: ${OUT}/parsing.${O}) +;# (e.g. ${AUTO}/parsing.${O}: ${OUT}/parsing.${O}) ;# c) edit util.lisp to add the 'external' function (those that -;# should trigger the autoload +;# should trigger the autoload ;# case 2: ;# build-interpsys (in util.lisp) needs an extra argument for the ;# new autoload things and several functions in util.lisp need hacking. @@ -126,17 +126,17 @@ it sets up the lisp system memory (at present only for AKCL/GCL). Next it loads all of the named files, resets a few global state variables, loads the databases, sets up autoload triggers and clears out hash tables. After this function is called the image is clean and can be saved. -<>= +\begin{chunk}{build-interpsys} (defun build-interpsys (load-files parse-files comp-files browse-files - translate-files nagbr-files asauto-files + translate-files nagbr-files asauto-files spad lsp src int obj mnt sys) (push :oldboot *features*) (initroot spad) #+:AKCL (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8 - :array 400 :string 500 :cfun 100 :cpages 1000 - :rpages 1000 :hole 2000) - <> + :array 400 :string 500 :cfun 100 :cpages 1000 + :rpages 1000 :hole 2000) +\getchunk{compiler-notes} (mapcar #'load load-files) (|resetWorkspaceVariables|) (|initHist|) @@ -157,7 +157,7 @@ After this function is called the image is clean and can be saved. (resethashtables) ; the databases into core, then close the streams ) -@ +\end{chunk} ;start(:l) == ; -- The function start begins the interpreter process, reading in @@ -204,7 +204,7 @@ After this function is called the image is clean and can be saved. ; if null l then runspad() ; 'EndOfSpad -<>= +\begin{chunk}{defun start} (DEFUN |start| (&REST G166080 &AUX |l|) (DSETQ |l| G166080) (PROG (|$PrintCompilerMessageIfTrue|) @@ -282,7 +282,7 @@ After this function is called the image is clean and can be saved. '|EndOfSpad|)))) -@ +\end{chunk} \begin{verbatim} ;--% Top level system command ;-- (mapcar #'car $systemCommands) @@ -294,7 +294,7 @@ After this function is called the image is clean and can be saved. ; l := CDR l ; $SYSCOMMANDS := NREVERSE $SYSCOMMANDS \end{verbatim} -<>= +\begin{chunk}{defun initializeSystemCommands} (DEFUN |initializeSystemCommands| () (PROG (|l|) (declare (special $SYSCOMMANDS |$systemCommands|)) @@ -309,7 +309,7 @@ After this function is called the image is clean and can be saved. (SPADLET |l| (CDR |l|)))))) (SPADLET $SYSCOMMANDS (NREVERSE $SYSCOMMANDS))))))) -@ +\end{chunk} \subsubsection{GCL porting changes} GCL likes to output lines of the form: \begin{verbatim} @@ -317,15 +317,15 @@ GCL likes to output lines of the form: \end{verbatim} which is pointless and should be removed. Bill Schelter added this while he was debugging tail-recursive replacement and it never was removed. -<>= +\begin{chunk}{compiler-notes} #+:AKCL (setq compiler::*suppress-compiler-notes* t) -@ +\end{chunk} \subsection{The variables} Various lisps use different ``extensions'' on the filename to indicate that a file has been compiled. We set this variable correctly depending on the system we are using. -<>= +\begin{chunk}{bin-path} (defvar *bin-path* #+kcl "o" #+lucid "bbin" @@ -333,7 +333,7 @@ on the system we are using. #+cmulisp "fasl" #+:ccl "not done this way at all") -@ +\end{chunk} \subsection{The autoload list} There are several subsystems within {\bf AXIOM} that are not normally @@ -356,7 +356,7 @@ list. In this way we will automatically load a whole subsystem if we touch any function in that subsystem. We call a helper function called {\bf setBootAutoLoadProperty} to set up the autoload trigger. This helper function is listed below. -<>= +\begin{chunk}{setBootAutloadProperties} (defun |setBootAutloadProperties| (fun-list file-list) #+:AKCL (mapc #'(lambda (fun) (|setBootAutoLoadProperty| fun file-list)) fun-list) @@ -364,16 +364,16 @@ This helper function is listed below. (mapc #'(lambda (fun) (lisp::set-autoload fun file-list)) fun-list) ) -@ +\end{chunk} \subsubsection{setBootAutoLoadProperty} This is a helper function to set up the autoload trigger. It sets the function cell of each symbol to {\bf mkBootAutoLoad} which is listed below. -<>= +\begin{chunk}{setBootAutoLoadProperty} (defun |setBootAutoLoadProperty| (func file-list) (setf (symbol-function func) (|mkBootAutoLoad| func file-list)) ) -@ +\end{chunk} \subsubsection{mkBootAutoLoad} This is how the autoload magic happens. Every function named in the autoload lists is actually just another name for this function. When @@ -382,33 +382,33 @@ files in the subsystem. This overwrites all of the autoload triggers. We then look up the new (real) function definition and call it again with the real arguments. Thus the subsystem loads and the original call succeeds. -<>= +\begin{chunk}{mkBootAutoLoad} (defun |mkBootAutoLoad| (fn file-list) (function (lambda (&rest args) - (mapc #'boot-load file-list) - (unless (string= (subseq (string fn) 0 4) "LOAD") - (apply (symbol-function fn) args))))) + (mapc #'boot-load file-list) + (unless (string= (subseq (string fn) 0 4) "LOAD") + (apply (symbol-function fn) args))))) -@ +\end{chunk} \subsubsection{boot-load} This function knows where the {\bf autoload} subdirectory lives. It is called by {\bf mkBootAutoLoad} above to find the necessary files. -<>= +\begin{chunk}{boot-load} (defun boot-load (file) (let ((name (concat $SPADROOT "/autoload/" (pathname-name file)))) (if |$printLoadMsgs| - (format t " Loading ~A.~%" name)) + (format t " Loading ~A.~%" name)) (load name))) -@ +\end{chunk} \subsubsection{setNAGBootAutloadProperties} This is a further refinement of the autoload scheme. Since the Numerical Algorithms Group (NAG) fortran library contains many functions we subdivide the NAG library subsystem into chapters. We use a different helper function {\bf get-NAG-chapter} to decide which files to load. -<>= +\begin{chunk}{setNAGBootAutloadProperties} (defun |setNAGBootAutloadProperties| (function-list file-list) (mapcar #'(lambda (f) @@ -417,7 +417,7 @@ which files to load. (nag-files f file-list))) file-list)) -@ +\end{chunk} \subsubsection{get-NAG-chapter} This function is used to find the names of the files to load. On solaris 9 under GCL the original implementation will fail because @@ -433,7 +433,7 @@ problem. It originally read: function-list))) \end{verbatim} -<>= +\begin{chunk}{get-NAG-chapter} (defun get-NAG-chapter (chapter function-list) (let ((l (length chapter)) r) (dolist (f function-list) @@ -441,22 +441,22 @@ problem. It originally read: (push f r))) (nreverse r))) -@ +\end{chunk} \subsubsection{nag-files} We analyze the function names to decide which chapter we are in. We load files based on the chapter. -<>= +\begin{chunk}{nag-files} (defun nag-files (filename filelist) (apply 'append (mapcar #'(lambda (f) (cond ((equalp (chapter-name filename) (chapter-name f)) (list f))) ) filelist))) -@ +\end{chunk} \subsubsection{chapter-name} The library names follow a convention that allows us to extract the chapter name. -<>= +\begin{chunk}{chapter-name} (defun chapter-name (f) #+:AKCL (apply @@ -467,50 +467,50 @@ the chapter name. (subseq (string-downcase (string f)) 4 (length (string f))) ) -@ +\end{chunk} \subsubsection{parse-functions} This is the {\bf boot parser} subsystem. It is only needed by developers who translate boot code to Common Lisp. -<>= +\begin{chunk}{parse-functions} ;(setq parse-functions ; '( ;;; loadparser -; |oldParserAutoloadOnceTrigger| -; |PARSE-Expression| -; boot-parse-1 -; BOOT -; SPAD -; init-boot/spad-reader)) - -@ +; |oldParserAutoloadOnceTrigger| +; |PARSE-Expression| +; boot-parse-1 +; BOOT +; SPAD +; init-boot/spad-reader)) + +\end{chunk} \subsubsection{comp-functions} This is the {\bf spad compiler} subsystem. It is only needed by developers who write or modify algebra code. -<>= +\begin{chunk}{comp-functions} ;(setq comp-functions ; '( ;;; loadcompiler -; |oldCompilerAutoloadOnceTrigger| -;;; |compileSpad2Cmd| -; |convertSpadToAsFile| -; |compilerDoit| -; |compilerDoitWithScreenedLisplib| -; |mkCategory| -; |cons5| -; |sublisV|)) - -@ +; |oldCompilerAutoloadOnceTrigger| +;;; |compileSpad2Cmd| +; |convertSpadToAsFile| +; |compilerDoit| +; |compilerDoitWithScreenedLisplib| +; |mkCategory| +; |cons5| +; |sublisV|)) + +\end{chunk} \subsubsection{browse-functions} This is the {\bf browser} subsystem. It will get autoloaded only if you use the browse function of the {\bf hypertex} system. -<>= +\begin{chunk}{browse-functions} (setq browse-functions '( - |browserAutoloadOnceTrigger| - |parentsOf| ;interop.boot - |getParentsFor| ;old compiler - |folks| ;for astran - |extendLocalLibdb| ;)lib needs this + |browserAutoloadOnceTrigger| + |parentsOf| ;interop.boot + |getParentsFor| ;old compiler + |folks| ;for astran + |extendLocalLibdb| ;)lib needs this |oSearch| |aokSearch| |kSearch| @@ -519,197 +519,197 @@ if you use the browse function of the {\bf hypertex} system. |docSearch| |abSearch| |detailedSearch| - |ancestorsOf| - |domainsOf| - |aPage| - |dbGetOrigin| - |dbGetParams| - |dbGetKindString| - |dbGetOrigin| - |dbComments| - |grepConstruct| - |buildLibdb| - |bcDefiniteIntegrate| - |bcDifferentiate| - |bcDraw| - |bcExpand| - |bcIndefiniteIntegrate| - |bcLimit| - |bcMatrix| - |bcProduct| - |bcSeries| - |bcSolve| - |bcSum| - |cSearch| - |conPage| - |dbName| - |dbPart| + |ancestorsOf| + |domainsOf| + |aPage| + |dbGetOrigin| + |dbGetParams| + |dbGetKindString| + |dbGetOrigin| + |dbComments| + |grepConstruct| + |buildLibdb| + |bcDefiniteIntegrate| + |bcDifferentiate| + |bcDraw| + |bcExpand| + |bcIndefiniteIntegrate| + |bcLimit| + |bcMatrix| + |bcProduct| + |bcSeries| + |bcSolve| + |bcSum| + |cSearch| + |conPage| + |dbName| + |dbPart| |extendLocalLibdb| - |form2HtString| - |htGloss| - |htGreekSearch| - |htHistory| - |htSystemCommands| - |htSystemVariables| - |htTextSearch| - |htTutorialSearch| - |htUserVariables| - |htsv| - |oPage| - |oPageFrom| - |spadSys| - |spadType| - |syscomPage|)) - -@ + |form2HtString| + |htGloss| + |htGreekSearch| + |htHistory| + |htSystemCommands| + |htSystemVariables| + |htTextSearch| + |htTutorialSearch| + |htUserVariables| + |htsv| + |oPage| + |oPageFrom| + |spadSys| + |spadType| + |syscomPage|)) + +\end{chunk} \subsubsection{translate-functions} This is a little used subsystem to generate {\bf ALDOR} code from {\bf Spad} code. Frankly, I'd be amazed if it worked. -<>= +\begin{chunk}{translate-functions} (setq translate-functions '( ;; .spad to .as translator, in particular -;; loadtranslate - |spad2AsTranslatorAutoloadOnceTrigger| - )) +;; loadtranslate + |spad2AsTranslatorAutoloadOnceTrigger| + )) -@ +\end{chunk} \subsubsection{asauto-functions} This is part of the {\bf ALDOR subsystem}. These will be loaded if you compile a {\bf .as} file rather than a {\bf .spad} file. {\bf ALDOR} is an external compiler that gets automatically called if the file extension is {\bf .as}. -<>= +\begin{chunk}{asauto-functions} (setq asauto-functions '( - loadas -;; |as| ;; now in as.boot -;; |astran| ;; now in as.boot - |spad2AxTranslatorAutoloadOnceTrigger| - |sourceFilesToAxcliqueAxFile| - |sourceFilesToAxFile| - |setExtendedDomains| - |makeAxFile| + loadas +;; |as| ;; now in as.boot +;; |astran| ;; now in as.boot + |spad2AxTranslatorAutoloadOnceTrigger| + |sourceFilesToAxcliqueAxFile| + |sourceFilesToAxFile| + |setExtendedDomains| + |makeAxFile| |makeAxcliqueAxFile| |nrlibsToAxFile| |attributesToAxFile| )) -@ +\end{chunk} \subsubsection{debug-functions} These are some {\bf debugging} functions that I use. I can't imagine why you might autoload them but they don't need to be in a running system. -<>= +\begin{chunk}{debug-functions} (setq debug-functions '( - loaddebug - |showSummary| - |showPredicates| - |showAttributes| - |showFrom| - |showImp|)) - -@ + loaddebug + |showSummary| + |showPredicates| + |showAttributes| + |showFrom| + |showImp|)) + +\end{chunk} \subsubsection{anna-functions} The {\bf ANNA} subsystem, invoked thru {\bf hypertex}, is an expert system that understands the Numerical Algorithms Group (NAG) fortran library. -<>= +\begin{chunk}{anna-functions} (setq anna-functions '( - |annaInt| - |annaMInt| - |annaOde| - |annaOpt| - |annaOpt2| - |annaPDESolve| - |annaOptDefaultSolve1| - |annaOptDefaultSolve2| - |annaOptDefaultSolve3| - |annaOptDefaultSolve4| - |annaOptDefaultSolve5| - |annaOpt2DefaultSolve| - |annaFoo| - |annaBar| - |annaJoe| - |annaSue| - |annaAnn| - |annaBab| - |annaFnar| - |annaDan| - |annaBlah| - |annaTub| - |annaRats| - |annaMInt| - |annaOdeDefaultSolve1| - |annaOdeDefaultSolve2|)) - -@ + |annaInt| + |annaMInt| + |annaOde| + |annaOpt| + |annaOpt2| + |annaPDESolve| + |annaOptDefaultSolve1| + |annaOptDefaultSolve2| + |annaOptDefaultSolve3| + |annaOptDefaultSolve4| + |annaOptDefaultSolve5| + |annaOpt2DefaultSolve| + |annaFoo| + |annaBar| + |annaJoe| + |annaSue| + |annaAnn| + |annaBab| + |annaFnar| + |annaDan| + |annaBlah| + |annaTub| + |annaRats| + |annaMInt| + |annaOdeDefaultSolve1| + |annaOdeDefaultSolve2|)) + +\end{chunk} \subsubsection{nagbr-functions} The Numerical Algorithms Group (NAG) fortran library has a set of cover functions. These functions need to be loaded if you use the NAG library. -<>= +\begin{chunk}{nagbr-functions} (setq nagbr-functions '( loadnag |c02aff| |c02agf| |c05adf| |c05nbf| |c05pbf| |c06eaf| |c06ebf| |c06ecf| |c06ekf| |c06fpf| |c06fqf| |c06frf| - |c06fuf| |c06gbf| |c06gcf| |c06gqf| |c06gsf| + |c06fuf| |c06gbf| |c06gcf| |c06gqf| |c06gsf| |d01ajf| |d01akf| |d01alf| |d01amf| |d01anf| |d01apf| |d01aqf| - |d01asf| |d01bbf| |d01fcf| |d01gaf| |d01gbf| + |d01asf| |d01bbf| |d01fcf| |d01gaf| |d01gbf| |d02bbf| |d02bhf| |d02cjf| |d02ejf| |d02gaf| |d02gbf| |d02kef| - |d02raf| + |d02raf| |d03edf| |d03eef| |d03faf| |e01baf| |e01bef| |e01bff| |e01bgf| |e01bhf| |e01daf| |e01saf| - |e01sbf| |e01sef| + |e01sbf| |e01sef| |e02adf| |e02aef| |e02agf| |e02ahf| |e02ajf| |e02akf| |e02baf| - |e02bbf| |e02bcf| |e02bdf| |e02bef| |e02daf| |e02dcf| - |e02ddf| |e02def| |e02dff| |e02gaf| |e02zaf| + |e02bbf| |e02bcf| |e02bdf| |e02bef| |e02daf| |e02dcf| + |e02ddf| |e02def| |e02dff| |e02gaf| |e02zaf| |e04dgf| |e04fdf| |e04gcf| |e04jaf| |e04mbf| |e04naf| |e04ucf| - |e04ycf| + |e04ycf| |f01brf| |f01bsf| |f01maf| |f01mcf| |f01qcf| |f01qdf| |f01qef| - |f01rcf| |f01rdf| |f01ref| + |f01rcf| |f01rdf| |f01ref| |f02aaf| |f02abf| |f02adf| |f02aef| |f02aff| |f02agf| |f02ajf| - |f02akf| |f02awf| |f02axf| |f02bbf| |f02bjf| |f02fjf| - |f02wef| |f02xef| + |f02akf| |f02awf| |f02axf| |f02bbf| |f02bjf| |f02fjf| + |f02wef| |f02xef| |f04adf| |f04arf| |f04asf| |f04atf| |f04axf| |f04faf| |f04jgf| - |f04maf| |f04mbf| |f04mcf| |f04qaf| + |f04maf| |f04mbf| |f04mcf| |f04qaf| |f07adf| |f07aef| |f07fdf| |f07fef| |s01eaf| |s13aaf| |s13acf| |s13adf| |s14aaf| |s14abf| |s14baf| - |s15adf| |s15aef| |s17acf| |s17adf| |s17aef| |s17aff| - |s17agf| |s17ahf| |s17ajf| |s17akf| |s17dcf| |s17def| - |s17dgf| |s17dhf| |s17dlf| |s18acf| |s18adf| |s18aef| - |s18aff| |s18dcf| |s18def| |s19aaf| |s19abf| |s19acf| - |s19adf| |s20acf| |s20adf| |s21baf| |s21bbf| |s21bcf| - |s21bdf| + |s15adf| |s15aef| |s17acf| |s17adf| |s17aef| |s17aff| + |s17agf| |s17ahf| |s17ajf| |s17akf| |s17dcf| |s17def| + |s17dgf| |s17dhf| |s17dlf| |s18acf| |s18adf| |s18aef| + |s18aff| |s18dcf| |s18def| |s19aaf| |s19abf| |s19acf| + |s19adf| |s20acf| |s20adf| |s21baf| |s21bbf| |s21bcf| + |s21bdf| )) -@ +\end{chunk} \subsection{The command-line build functions} \subsubsection{translist} Translate a list of boot files to common lisp. -<>= +\begin{chunk}{translist} (defun translist (fns) (mapcar #'(lambda (f) (format t "translating ~a~%" (concat f ".boot")) - (translate f)) - fns)) + (translate f)) + fns)) -@ +\end{chunk} \subsubsection{translate} Translate a single boot file to common lisp -<>= +\begin{chunk}{translate} (defun translate (file) ;; translates a single boot file #+:CCL (setq *package* (find-package "BOOT")) #+:AKCL (in-package "BOOT") (let (*print-level* *print-length* (fn (pathname-name file)) - (bootfile (merge-pathnames file (concat $spadroot "nboot/.boot")))) + (bootfile (merge-pathnames file (concat $spadroot "nboot/.boot")))) (declare (special *print-level* *print-length*)) (boot bootfile (make-pathname :type "lisp" :defaults bootfile)))) -@ +\end{chunk} \subsubsection{compile-boot-file} Translate a single boot file to common lisp, compile it and load it. -<>= +\begin{chunk}{compile-boot-file} (defun compile-boot-file (file) "compile and load a boot file" (boot (concat file ".boot") (concat file ".lisp")) @@ -721,206 +721,206 @@ and load it. (load (concat file ".lisp")) ) -@ +\end{chunk} \subsubsection{retranslate-file-if-necessary} Retranslate a single boot file if it has been changed. -<>= +\begin{chunk}{retranslate-file-if-necessary} (defun retranslate-file-if-necessary (bootfile) (let* ((lfile (make-pathname :type "lisp" :defaults bootfile)) - (ldate (our-write-date lfile)) - (binfile (make-pathname :type *bin-path* :defaults bootfile)) - (bindate (our-write-date binfile)) - (bootdate (our-write-date bootfile))) + (ldate (our-write-date lfile)) + (binfile (make-pathname :type *bin-path* :defaults bootfile)) + (bindate (our-write-date binfile)) + (bootdate (our-write-date bootfile))) (if (and ldate bootdate (> ldate bootdate)) nil - (if (and bindate bootdate (> bindate bootdate)) nil - (progn (format t "translating ~a~%" bootfile) - (boot bootfile lfile) (list bootfile)))))) + (if (and bindate bootdate (> bindate bootdate)) nil + (progn (format t "translating ~a~%" bootfile) + (boot bootfile lfile) (list bootfile)))))) -@ +\end{chunk} \subsubsection{retranslate-directory} Translate a directory of boot code to common lisp if the boot code is newer. -<>= +\begin{chunk}{retranslate-directory} (defun retranslate-directory (dir) (let* ((direc (make-directory dir)) - (pattern (make-pathname :directory (pathname-directory direc) - :name :wild :type "boot")) - (files (directory pattern))) + (pattern (make-pathname :directory (pathname-directory direc) + :name :wild :type "boot")) + (files (directory pattern))) (mapcan #'retranslate-file-if-necessary files))) -@ +\end{chunk} \subsubsection{recompile-nrlib-if-necessary} Recompile a single library's lisp file if it is out of date. The {\bf recompile-lib-file-if-necessary} is defined in nlib.lisp. -<>= +\begin{chunk}{recompile-nrlib-if-necessary} (defun recompile-nrlib-if-necessary (lib) (recompile-lib-file-if-necessary (concat (namestring lib) "/code.lsp")) (lift-nrlib-name (namestring lib))) -@ +\end{chunk} \subsubsection{lift-nrlib-name} We used to use FOO.nrlib/code.o files for algebra. However there was no need for this additional level of indirection since the rest of the information in an nrlib is now kept in the daase files. Thus we lift the FOO.nrlib/code.o to FOO.o in the final system. -<>= +\begin{chunk}{lift-nrlib-name} (defun lift-nrlib-name (f) (obey (concat "cp " f "/code.o " (subseq f 0 (position #\. f)) ".o")) nil) -@ +\end{chunk} \subsubsection{recompile-lib-directory} Recompile library lisp code if necessary. -<>= +\begin{chunk}{recompile-lib-directory} (defun recompile-lib-directory (dir) (let* ((direc (make-directory dir)) - (pattern (make-pathname :directory (pathname-directory direc) - :name :wild :type "nrlib")) - (files (directory pattern))) + (pattern (make-pathname :directory (pathname-directory direc) + :name :wild :type "nrlib")) + (files (directory pattern))) (mapcan #'recompile-nrlib-if-necessary files))) -@ +\end{chunk} \subsubsection{recompile-all-files} Force recompilation of all lisp files in a directory. -<>= +\begin{chunk}{recompile-all-files} (defun recompile-all-files (dir) (let* ((direc (make-directory dir)) - (pattern (make-pathname :directory (pathname-directory direc) - :name :wild :type "lisp")) - (files (directory pattern))) + (pattern (make-pathname :directory (pathname-directory direc) + :name :wild :type "lisp")) + (files (directory pattern))) (mapcar #'compile-file files))) -@ +\end{chunk} \subsubsection{recompile-directory} This function will compile any lisp code that has changed in a directory. -<>= +\begin{chunk}{recompile-directory} (defun recompile-directory (dir) (let* ((direc (make-directory dir)) - (pattern (make-pathname :directory (pathname-directory direc) - :name :wild :type "lisp")) - (files (directory pattern))) + (pattern (make-pathname :directory (pathname-directory direc) + :name :wild :type "lisp")) + (files (directory pattern))) (mapcan #'recompile-file-if-necessary files))) -@ +\end{chunk} \subsubsection{recompile-file-if-necessary} This is a helper function that checks the time stamp between the given file and its compiled binary. If the file has changed since it was last compiled this function will recompile it. -<>= +\begin{chunk}{recompile-file-if-necessary} (defun recompile-file-if-necessary (lfile) (let* ((bfile (make-pathname :type *bin-path* :defaults lfile)) - (bdate (our-write-date bfile)) - (ldate (our-write-date lfile))) + (bdate (our-write-date bfile)) + (ldate (our-write-date lfile))) (if (and bdate ldate (> bdate ldate)) nil - (progn - (format t "compiling ~a~%" lfile) - (compile-file lfile) - (list bfile))))) + (progn + (format t "compiling ~a~%" lfile) + (compile-file lfile) + (list bfile))))) -@ +\end{chunk} \subsubsection{our-write-date} Get the write date of a file. In GCL we need to check that it exists first. This is a simple helper function. -<>= +\begin{chunk}{our-write-date} (defun our-write-date (file) (and #+kcl (probe-file file) - (file-write-date file))) + (file-write-date file))) -@ +\end{chunk} \subsubsection{fe} I'm unsure what this does but I believe it is related to an interpreter command. Invoking ``)fe'' in the interpreter tries to get at the src/interp/TAGS file. -<>= +\begin{chunk}{fe} (defun fe (function file &optional (compflag nil) &aux (fn (pathname-name file))) (let ((tbootfile (concat "/tmp/" fn ".boot")) - (tlispfile (concat "/tmp/" fn ".lisp"))) + (tlispfile (concat "/tmp/" fn ".lisp"))) (system::run-aix-program "fc" - :arguments (list (string function) - (namestring - (merge-pathnames file (concat $SPADROOT "nboot/.boot")))) - :if-output-exists :supersede :output tbootfile) + :arguments (list (string function) + (namestring + (merge-pathnames file (concat $SPADROOT "nboot/.boot")))) + :if-output-exists :supersede :output tbootfile) (boot tbootfile tlispfile) (if compflag (progn (compile-file tlispfile) - (load (make-pathname :type *bin-path* :defaults tlispfile))) + (load (make-pathname :type *bin-path* :defaults tlispfile))) (load tlispfile)))) -@ +\end{chunk} \subsubsection{fc} I'm unsure what this does but I believe it is related to an interpreter command. Invoking ``)fc'' in the interpreter tries to get at the src/interp/TAGS file. -<>= +\begin{chunk}{fc} (defun fc (function file) (fe function file t)) -@ +\end{chunk} \subsubsection{compspadfiles} The {\bf compspadfiles} function will recompile a list of {\bf spad} files. The filelist should be a file containing names of files to compile. -<>= +\begin{chunk}{compspadfiles} (defun compspadfiles (filelist ;; should be a file containing files to compile - &optional (*default-pathname-defaults* - (pathname (concat $SPADROOT "nalgebra/")))) + &optional (*default-pathname-defaults* + (pathname (concat $SPADROOT "nalgebra/")))) (with-open-file (stream filelist) - (do ((fname (read-line stream nil nil) (read-line stream nil nil))) - ((null fname) 'done) - (setq fname (string-right-trim " *" fname)) - (when (not (equal (elt fname 0) #\*)) - (spad fname (concat (pathname-name fname) ".out")))))) + (do ((fname (read-line stream nil nil) (read-line stream nil nil))) + ((null fname) 'done) + (setq fname (string-right-trim " *" fname)) + (when (not (equal (elt fname 0) #\*)) + (spad fname (concat (pathname-name fname) ".out")))))) -@ +\end{chunk} \subsubsection{load-directory} Load a whole subdirectory of compiled files -<>= +\begin{chunk}{load-directory} (defun load-directory (dir) (let* ((direc (make-directory dir)) - (pattern (make-pathname :directory (pathname-directory direc) - :name :wild :type *bin-path*)) - (files (directory pattern))) + (pattern (make-pathname :directory (pathname-directory direc) + :name :wild :type *bin-path*)) + (files (directory pattern))) (mapcar #'load files))) -@ +\end{chunk} \subsubsection{interp-make-directory} This is used by the ")cd" system command. -<>= +\begin{chunk}{interp-make-directory} (defun interp-make-directory (direc) (setq direc (namestring direc)) (if (string= direc "") $current-directory (if (or (member :unix *features*) - (member 'unix *features*)) + (member 'unix *features*)) (progn (if (char/= (char $current-directory (1-(length $current-directory))) #\/) - (setq $current-directory (concat $current-directory "/"))) + (setq $current-directory (concat $current-directory "/"))) (if (char/= (char direc 0) #\/) - (setq direc (concat $current-directory direc))) + (setq direc (concat $current-directory direc))) (if (char/= (char direc (1- (length direc))) #\/) - (setq direc (concat direc "/"))) + (setq direc (concat direc "/"))) direc) (progn ;; Assume Windows conventions (if (not (or (char= (char $current-directory (1- (length $current-directory))) #\/) (char= (char $current-directory (1- (length $current-directory))) #\\ ))) - (setq $current-directory (concat $current-directory "\\"))) + (setq $current-directory (concat $current-directory "\\"))) (if (not (or (char= (char direc 0) #\/) (char= (char direc 0) #\\) (find #\: direc))) (setq direc (concat $current-directory direc))) (if (not (or (char= (char direc (1- (length direc))) #\/) (char= (char direc (1- (length direc))) #\\ ))) - (setq direc (concat direc "\\"))) + (setq direc (concat direc "\\"))) direc)))) -@ +\end{chunk} \subsubsection{make-directory} Make a directory relative to the {\bf \$spadroot} variable. -<>= +\begin{chunk}{make-directory} (defun make-directory (direc) (setq direc (namestring direc)) (if (string= direc "") $SPADROOT (if (or (member :unix *features*) - (member 'unix *features*)) + (member 'unix *features*)) (progn (if (char/= (char direc 0) #\/) - (setq direc (concat $SPADROOT "/" direc))) + (setq direc (concat $SPADROOT "/" direc))) (if (char/= (char direc (1- (length direc))) #\/) - (setq direc (concat direc "/"))) + (setq direc (concat direc "/"))) direc) (progn ;; Assume Windows conventions (if (not (or (char= (char direc 0) #\/) @@ -929,10 +929,10 @@ Make a directory relative to the {\bf \$spadroot} variable. (setq direc (concat $SPADROOT "\\" direc))) (if (not (or (char= (char direc (1- (length direc))) #\/) (char= (char direc (1- (length direc))) #\\ ))) - (setq direc (concat direc "\\"))) + (setq direc (concat direc "\\"))) direc)))) -@ +\end{chunk} \subsubsection{recompile-all-libs} Occasionally it will be necessary to iterate over all of the nrlib directories and compile each of the code.lsp files in every nrlib. @@ -942,17 +942,17 @@ This function will do that. A correct call looks like: (recompile-all-libs "/spad/mnt/${SYS}/algebra") \end{verbatim} where the [[${SYS}]] variable is same as the one set at build time. -<>= +\begin{chunk}{recompile-all-libs} (defun recompile-all-libs (dir) (let* ((direc (make-directory dir)) - (pattern (make-pathname :directory (pathname-directory direc) - :name :wild :type "nrlib")) - (files (directory pattern))) + (pattern (make-pathname :directory (pathname-directory direc) + :name :wild :type "nrlib")) + (files (directory pattern))) (mapcar #'(lambda (lib) (compile-lib-file (concat (namestring lib) "/code.lsp"))) files))) -@ +\end{chunk} \subsubsection{recompile-all-algebra-files} We occasionally need to completely rebuild the algebra from the spad files. This function will iterate across a directory containing all @@ -973,24 +973,24 @@ then the wildcard expands to /spad/mnt/${SYS}/nalg/*.spad \end{verbatim} and all of the matching files would be recompiled. -<>= +\begin{chunk}{recompile-all-algebra-files} (defun recompile-all-algebra-files (dir) ;; a desperation measure (let* ((direc (make-directory dir)) - (pattern (make-pathname :directory (pathname-directory direc) - :name :wild :type "spad")) - (files (directory pattern)) - (*default-pathname-defaults* (pathname direc))) + (pattern (make-pathname :directory (pathname-directory direc) + :name :wild :type "spad")) + (files (directory pattern)) + (*default-pathname-defaults* (pathname direc))) (mapcar #'(lambda (fname) (spad fname (concat (pathname-name fname) ".out"))) files))) -@ +\end{chunk} \subsubsection{boottocl} The {\bf boottocl} function is the workhorse function that translates {\bf .boot} files to {\bf Common Lisp}. It basically wraps the actual {\bf boot} function call to ensure that we don't truncate lines because of {\bf *print-level*} or {\bf *print-length*}. -<>= +\begin{chunk}{boottocl} (in-package "BOOTTRAN") #+:oldboot @@ -1004,11 +1004,11 @@ because of {\bf *print-level*} or {\bf *print-length*}. (boot::boot file (make-pathname - :name (pathname-name file) - :defaults (concatenate 'string boot::$spadroot - "/../../int/interp/foo.clisp"))))) + :name (pathname-name file) + :defaults (concatenate 'string boot::$spadroot + "/../../int/interp/foo.clisp"))))) -@ +\end{chunk} \subsubsection{yearweek} We need a way of distinguishing different versions of the system. There used to be a way to touch the src/timestamp file whenever @@ -1021,28 +1021,28 @@ The result of this function is a string that is printed as a banner when Axiom starts. The actual printing is done by the function [[spadStartUpMsgs]] in [[src/interp/msgdb.boot]]. It uses a format string from the file [[src/doc/msgs/s2-us.msgs]]. -<>= +\begin{chunk}{yearweek} (defun yearweek () "set *yearweek* to the current time string for the version banner" (declare (special timestamp) (special *yearweek*)) (if (and (boundp 'timestamp) (probe-file timestamp)) (let (sec min hour date month year day dayvec monvec) - (setq dayvec '("Monday" "Tuesday" "Wednesday" "Thursday" - "Friday" "Saturday" "Sunday")) - (setq monvec '("January" "February" "March" "April" "May" "June" - "July" "August" "September" "October" "November" - "December")) - (multiple-value-setq (sec min hour date month year day) - (decode-universal-time - (file-write-date timestamp))) - (setq *yearweek* - (copy-seq - (format nil "~a ~a ~d, ~d at ~2,'0d:~2,'0d:~2,'0d " - (elt dayvec day) - (elt monvec (1- month)) date year hour min sec)))) + (setq dayvec '("Monday" "Tuesday" "Wednesday" "Thursday" + "Friday" "Saturday" "Sunday")) + (setq monvec '("January" "February" "March" "April" "May" "June" + "July" "August" "September" "October" "November" + "December")) + (multiple-value-setq (sec min hour date month year day) + (decode-universal-time + (file-write-date timestamp))) + (setq *yearweek* + (copy-seq + (format nil "~a ~a ~d, ~d at ~2,'0d:~2,'0d:~2,'0d " + (elt dayvec day) + (elt monvec (1- month)) date year hour min sec)))) (setq *yearweek* "no timestamp"))) -@ +\end{chunk} \subsubsection{makelib} Make will not compare dates across directories. Rather than copy all of the code.lsp files to the MNT directory @@ -1051,7 +1051,7 @@ this function assumes that the shell variables INT and MNT are set. Also of note: on the rt some files (those in the nooptimize list) need to be compiled without optimize due to compiler bugs -<>= +\begin{chunk}{makelib} (defun makelib (mid out stype btype) "iterate over the nrlibs, compiling ones that are out of date. mid is the directory containing code.lsp @@ -1059,8 +1059,8 @@ need to be compiled without optimize due to compiler bugs (let (libs lspdate odate nooptimize (alphabet #\space)) #+(and :akcl :rt) (setq nooptimize '("FFCAT-.nrlib" "CHVAR.nrlib" "PFO.nrlib" "SUP.nrlib" - "INTG0.nrlib" "FSPRMELT.nrlib" "VECTOR.nrlib" - "EUCDOM-.nrlib")) + "INTG0.nrlib" "FSPRMELT.nrlib" "VECTOR.nrlib" + "EUCDOM-.nrlib")) (if (and mid out) (format t "doing directory on ~s...~%" (concatenate 'string mid "/*")) (error "makelib:MID=~a OUT=~a~% these are not set properly~%" mid out)) @@ -1111,7 +1111,7 @@ need to be compiled without optimize due to compiler bugs (setq compiler::*speed* 3)) (compile-lib-file dotlsp :output-file doto))))))) -@ +\end{chunk} \subsubsection{makespad} Make will not compare dates across directories. In particular, it cannot compare the algebra files because there @@ -1125,7 +1125,7 @@ Note that the file /tmp/compile.input is not currently used as algebra source recompiles are not necessarily something we want done automatically. Nevertheless, in the quest for quality we check anyway. -<>= +\begin{chunk}{makespad} (defun makespad (src mid stype) "iterate over the spad files, compiling ones that are out of date. src is the directory containing .spad @@ -1187,7 +1187,7 @@ quality we check anyway. (format t "~a is out of date~%" spad) (format tmp ")co ~a~%" spad)))))) -@ +\end{chunk} \subsection{Constructing TAGS} TAGS are useful for finding functions if you run Emacs. We have a set of functions that construct TAGS files for Axiom. @@ -1195,7 +1195,7 @@ set of functions that construct TAGS files for Axiom. Run the etags command on all of the lisp code. Then run the {\bf spadtags-from-directory} function on the boot code. The final TAGS file is constructed in the {\bf tmp} directory. -<>= +\begin{chunk}{make-tags-file} (defun make-tags-file () #+:gcl (system:chdir "/tmp") #-:gcl (vmlisp::obey (concatenate 'string "cd " "/tmp")) @@ -1203,79 +1203,79 @@ final TAGS file is constructed in the {\bf tmp} directory. (spadtags-from-directory "../../src/interp" "boot") (obey "cat /tmp/boot.TAGS >> /tmp/TAGS")) -@ +\end{chunk} \subsubsection{spadtags-from-directory} This function will walk across a directory and call {\bf spadtags-from-file} on each file. -<>= +\begin{chunk}{spadtags-from-directory} (defun spadtags-from-directory (dir type) (let* ((direc (make-directory dir)) - (pattern (make-pathname :directory (pathname-directory direc) - :name :wild :type type)) - (files (directory pattern))) + (pattern (make-pathname :directory (pathname-directory direc) + :name :wild :type type)) + (files (directory pattern))) (with-open-file (tagstream (concatenate 'string "/tmp/" type ".TAGS") :direction :output - :if-exists :supersede :if-does-not-exist :create) + :if-exists :supersede :if-does-not-exist :create) (dolist (file files (namestring tagstream)) - (print (list "processing:" file)) - (write-char #\page tagstream) - (terpri tagstream) - (write-string (namestring file) tagstream) - (write-char #\, tagstream) - (princ (spadtags-from-file file) tagstream) - (terpri tagstream) - (with-open-file (stream "/tmp/*TAGS") - (do ((line (read-line stream nil nil) - (read-line stream nil nil))) - ((null line) nil) - (write-line line tagstream))))))) - -@ + (print (list "processing:" file)) + (write-char #\page tagstream) + (terpri tagstream) + (write-string (namestring file) tagstream) + (write-char #\, tagstream) + (princ (spadtags-from-file file) tagstream) + (terpri tagstream) + (with-open-file (stream "/tmp/*TAGS") + (do ((line (read-line stream nil nil) + (read-line stream nil nil))) + ((null line) nil) + (write-line line tagstream))))))) + +\end{chunk} \subsubsection{spadtags-from-file} This function knows how to find function names in {\bf boot} code so we can add them to the TAGS file using standard etags format. -<>= +\begin{chunk}{spadtags-from-file} (defun spadtags-from-file (spadfile) (with-open-file (tagstream "/tmp/*TAGS" :direction :output - :if-exists :supersede :if-does-not-exist :create) + :if-exists :supersede :if-does-not-exist :create) (with-open-file (stream spadfile) (do ((char-count 0 (file-position stream)) - (line (read-line stream nil nil) (read-line stream nil nil)) - (line-count 1 (1+ line-count))) - ((null line) (file-length tagstream)) - (if (/= (length line) 0) - (let ((firstchar (elt line 0)) (end nil) - (len (length line))) - (cond ((member firstchar '(#\space #\{ #\} #\tab ) - :test #'char= ) "skip") - ((string= line ")abb" :end1 (min 4 len)) - (setq end (position #\space line :from-end t - :test-not #'eql) - end (and end (position #\space line :from-end t - :end end))) - (write-tag-line line tagstream end - line-count char-count)) - ((char= firstchar #\)) "skip") - ((and (> len 1) (string= line "--" :end1 2)) "skip") - ((and (> len 1) (string= line "++" :end1 2)) "skip") - ((search "==>" line) "skip") - ((and (setq end (position #\space line) - end (or (position #\( line :end end) end) - end (or (position #\: line :end end) end) - end (or (position #\[ line :end end) end)) - (equal end 0)) "skip") - ((position #\] line :end end) "skip") - ((string= line "SETANDFILEQ" :end1 end) "skip") - ((string= line "EVALANDFILEACTQ" :end1 end) "skip") - (t (write-tag-line line tagstream - (if (numberp end) (+ end 1) end) - line-count char-count)) ))))))) - -@ + (line (read-line stream nil nil) (read-line stream nil nil)) + (line-count 1 (1+ line-count))) + ((null line) (file-length tagstream)) + (if (/= (length line) 0) + (let ((firstchar (elt line 0)) (end nil) + (len (length line))) + (cond ((member firstchar '(#\space #\{ #\} #\tab ) + :test #'char= ) "skip") + ((string= line ")abb" :end1 (min 4 len)) + (setq end (position #\space line :from-end t + :test-not #'eql) + end (and end (position #\space line :from-end t + :end end))) + (write-tag-line line tagstream end + line-count char-count)) + ((char= firstchar #\)) "skip") + ((and (> len 1) (string= line "--" :end1 2)) "skip") + ((and (> len 1) (string= line "++" :end1 2)) "skip") + ((search "==>" line) "skip") + ((and (setq end (position #\space line) + end (or (position #\( line :end end) end) + end (or (position #\: line :end end) end) + end (or (position #\[ line :end end) end)) + (equal end 0)) "skip") + ((position #\] line :end end) "skip") + ((string= line "SETANDFILEQ" :end1 end) "skip") + ((string= line "EVALANDFILEACTQ" :end1 end) "skip") + (t (write-tag-line line tagstream + (if (numberp end) (+ end 1) end) + line-count char-count)) ))))))) + +\end{chunk} \subsubsection{write-tag-line} This function knows how to write a single line into a TAGS file using the etags file format. -<>= +\begin{chunk}{write-tag-line} (defun write-tag-line (line tagstream endcol line-count char-count) (write-string line tagstream :end endcol) (write-char #\rubout tagstream) @@ -1284,83 +1284,83 @@ using the etags file format. (princ char-count tagstream) (terpri tagstream)) -@ +\end{chunk} \subsubsection{blankcharp} This is a trivial predicate for calls to {\bf position-if-not} in the {\bf findtag} function. -<>= +\begin{chunk}{blankcharp} (defun blankcharp (c) (char= c #\Space)) -@ +\end{chunk} \subsubsection{findtag} The {\bf findtag} function is a user-level function to figure out which file contains a given tag. This is sometimes useful if Emacs is not around or TAGS are not loaded. -<>= +\begin{chunk}{findtag} (defun findtag (tag &optional (tagfile (concat $spadroot "/../../src/interp/TAGS")) ) ;; tag is an identifier (with-open-file (tagstream tagfile) - (do ((tagline (read-line tagstream nil nil) - (read-line tagstream nil nil)) - (*package* (symbol-package tag)) - (sourcefile) - (stringtag (string tag)) - (pos) - (tpos) - (type)) - ((null tagline) ()) - (cond ((char= (char tagline 0) #\Page) - (setq tagline (read-line tagstream nil nil)) - (setq sourcefile (subseq tagline 0 - (position #\, tagline))) - (setq type (pathname-type sourcefile))) - ((string= type "lisp") - (if (match-lisp-tag tag tagline) - (return (cons sourcefile tagline)))) - ((> (mismatch ")abb" tagline) 3) - (setq pos (position #\Space tagline :start 3)) - (setq pos (position-if-not #'blankcharp tagline - :start pos)) - (setq pos (position #\Space tagline :start pos)) - (setq pos (position-if-not #'blankcharp tagline - :start pos)) - (setq tpos (mismatch stringtag tagline :start2 pos)) - (if (and (= tpos (length (string tag))) - (member (char tagline (+ pos tpos)) '(#\Space #\Rubout))) - (return (cons sourcefile tagline)))) - ((setq pos (mismatch stringtag tagline)) - (if (and (= pos (length stringtag)) - (> (length tagline) pos) - (member (char tagline pos) - '( #\Space #\( #\:) )) - (return (cons sourcefile tagline)))))))) - -@ + (do ((tagline (read-line tagstream nil nil) + (read-line tagstream nil nil)) + (*package* (symbol-package tag)) + (sourcefile) + (stringtag (string tag)) + (pos) + (tpos) + (type)) + ((null tagline) ()) + (cond ((char= (char tagline 0) #\Page) + (setq tagline (read-line tagstream nil nil)) + (setq sourcefile (subseq tagline 0 + (position #\, tagline))) + (setq type (pathname-type sourcefile))) + ((string= type "lisp") + (if (match-lisp-tag tag tagline) + (return (cons sourcefile tagline)))) + ((> (mismatch ")abb" tagline) 3) + (setq pos (position #\Space tagline :start 3)) + (setq pos (position-if-not #'blankcharp tagline + :start pos)) + (setq pos (position #\Space tagline :start pos)) + (setq pos (position-if-not #'blankcharp tagline + :start pos)) + (setq tpos (mismatch stringtag tagline :start2 pos)) + (if (and (= tpos (length (string tag))) + (member (char tagline (+ pos tpos)) '(#\Space #\Rubout))) + (return (cons sourcefile tagline)))) + ((setq pos (mismatch stringtag tagline)) + (if (and (= pos (length stringtag)) + (> (length tagline) pos) + (member (char tagline pos) + '( #\Space #\( #\:) )) + (return (cons sourcefile tagline)))))))) + +\end{chunk} \subsubsection{match-lisp-tag} The {\bf match-lisp-tag} function is used by {\bf findtag}. This function assumes that \\ can only appear as first character of name. -<>= +\begin{chunk}{match-lisp-tag} (defun match-lisp-tag (tag tagline &optional (prefix nil) - &aux (stringtag (string tag)) pos tpos) + &aux (stringtag (string tag)) pos tpos) (when (and (if prefix - (= (mismatch prefix tagline :test #'char-equal) - (length prefix)) - t) - (numberp (setq pos (position #\Space tagline))) - (numberp (setq pos (position-if-not #'blankcharp tagline - :start pos)))) - (if (char= (char tagline pos) #\') (incf pos)) - (if (member (char tagline pos) '( #\\ #\|)) - (setq tpos (1+ pos)) - (setq tpos pos)) - (and (= (mismatch stringtag tagline :start2 tpos :test #'char-equal) - (length stringtag)) - (eq tag (read-from-string tagline nil nil :start pos))) )) - -@ + (= (mismatch prefix tagline :test #'char-equal) + (length prefix)) + t) + (numberp (setq pos (position #\Space tagline))) + (numberp (setq pos (position-if-not #'blankcharp tagline + :start pos)))) + (if (char= (char tagline pos) #\') (incf pos)) + (if (member (char tagline pos) '( #\\ #\|)) + (setq tpos (1+ pos)) + (setq tpos pos)) + (and (= (mismatch stringtag tagline :start2 tpos :test #'char-equal) + (length stringtag)) + (eq tag (read-from-string tagline nil nil :start pos))) )) + +\end{chunk} \subsection{Translated Boot functions} \subsubsection{string2BootTree} -<>= +\begin{chunk}{string2BootTree} (DEFUN |string2BootTree| (S) (init-boot/spad-reader) (LET* ((BOOT-LINE-STACK (LIST (CONS 1 S))) @@ -1372,9 +1372,9 @@ function assumes that \\ can only appear as first character of name. (DECLARE (SPECIAL BOOT-LINE-STACK $BOOT $SPAD XTOKENREADER LINE-HANDLER)) (DEF-RENAME (|new2OldLisp| PARSEOUT)))) -@ +\end{chunk} \subsubsection{string2SpadTree} -<>= +\begin{chunk}{string2SpadTree} (DEFUN |string2SpadTree| (LINE) (DECLARE (SPECIAL LINE)) (if (and (> (LENGTH LINE) 0) (EQ (CHAR LINE 0) #\) )) @@ -1389,9 +1389,9 @@ function assumes that \\ can only appear as first character of name. (DECLARE (SPECIAL BOOT-LINE-STACK $BOOT $SPAD XTOKENREADER LINE-HANDLER)) PARSEOUT)) -@ +\end{chunk} \section{License} -<>= +\begin{verbatim} ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. ;; @@ -1423,70 +1423,69 @@ function assumes that \\ can only appear as first character of name. ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<> +\end{verbatim} +\begin{chunk}{*} + (in-package "BOOT") (export '($spadroot $directory-list $current-directory reroot - make-absolute-filename |$msgDatabaseName| |$defaultMsgDatabaseName|)) - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> + make-absolute-filename |$msgDatabaseName| |$defaultMsgDatabaseName|)) + +\getchunk{our-write-date} +\getchunk{make-directory} +\getchunk{interp-make-directory} +\getchunk{bin-path} +\getchunk{load-directory} +\getchunk{compspadfiles} +\getchunk{recompile-all-algebra-files} +\getchunk{fe} +\getchunk{fc} +\getchunk{recompile-directory} +\getchunk{recompile-file-if-necessary} +\getchunk{recompile-all-files} +\getchunk{recompile-lib-directory} +\getchunk{recompile-all-libs} +\getchunk{recompile-nrlib-if-necessary} +\getchunk{lift-nrlib-name} +\getchunk{retranslate-directory} +\getchunk{retranslate-file-if-necessary} +\getchunk{make-tags-file} +\getchunk{spadtags-from-directory} +\getchunk{spadtags-from-file} +\getchunk{write-tag-line} +\getchunk{blankcharp} +\getchunk{findtag} +\getchunk{match-lisp-tag} +\getchunk{compile-boot-file} +\getchunk{translate} +\getchunk{translist} +\getchunk{make-depsys} +\getchunk{boottocl} (in-package "BOOT") -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> - -<> -<> +\getchunk{parse-functions} +\getchunk{comp-functions} +\getchunk{browse-functions} +\getchunk{translate-functions} +\getchunk{asauto-functions} +\getchunk{debug-functions} +\getchunk{anna-functions} +\getchunk{nagbr-functions} +\getchunk{setBootAutloadProperties} +\getchunk{boot-load} +\getchunk{setBootAutoLoadProperty} +\getchunk{mkBootAutoLoad} +\getchunk{build-interpsys} +\getchunk{defun start} +\getchunk{defun initializeSystemCommands} +\getchunk{setNAGBootAutloadProperties} +\getchunk{get-NAG-chapter} +\getchunk{nag-files} +\getchunk{chapter-name} +\getchunk{build-depsys} +\getchunk{string2BootTree} +\getchunk{string2SpadTree} ;; the following are for conditional reading #+:ieee-floating-point (setq $ieee t) @@ -1496,7 +1495,7 @@ function assumes that \\ can only appear as first character of name. ; spad-clear-input patches around fact that akcl clear-input leaves newlines chars (defun spad-clear-input (st) (clear-input st) (if (listen st) (read-char st))) -<> +\getchunk{yearweek} (defun sourcepath (f) "find the sourcefile in the system directories" (let (axiom algebra naglink) @@ -1521,7 +1520,7 @@ function assumes that \\ can only appear as first character of name. (setq point (position #\space expr :from-end t :test #'char=)) (push (subseq expr (1+ point)) longnames) (setq expr (string-right-trim '(#\space #\tab) - (subseq expr 0 point))) + (subseq expr 0 point))) (setq mark (position #\space expr :from-end t)) (push (subseq expr (1+ mark)) names))))) (values longnames names))) @@ -1546,10 +1545,10 @@ function assumes that \\ can only appear as first character of name. (|spad2AsTranslatorAutoloadOnceTrigger|) (|convertSpadFile| fn) ) -<> -<> +\getchunk{makelib} +\getchunk{makespad} -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 81fbd65..2ba7a71 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -9,7 +9,7 @@ documentclass{article} \eject \tableofcontents -<<*>>= +\begin{chunk}{*} ; VM LISP EMULATION PACKAGE @@ -29,7 +29,7 @@ documentclass{article} (export '(MAKE-HASHTABLE HPUT* HREM HREMPROP CVEC UEQUAL ID HPUTPROP - HASHTABLE-CLASS)) + HASHTABLE-CLASS)) (import '(BOOT::QENUM )) (import '(BOOT::STRPOSL )) (import '(BOOT::STRPOS )) @@ -84,8 +84,8 @@ documentclass{article} (let ((test (cond ((equable y) 'eq) - ((integerp y) 'i=) - ('eql)))) + ((integerp y) 'i=) + ('eql)))) (if (atom x) `(and (consp ,x) (,test (qcar ,x) ,y)) (let ((xx (gensym))) @@ -107,27 +107,27 @@ documentclass{article} (defmacro i= (x y) ;; integer equality (if (typep y 'fixnum) (let ((gx (gensym))) - `(let ((,gx ,x)) - (and (typep ,gx 'fixnum) (eql (the fixnum ,gx) ,y)))) + `(let ((,gx ,x)) + (and (typep ,gx 'fixnum) (eql (the fixnum ,gx) ,y)))) (let ((gx (gensym)) (gy (gensym))) `(let ((,gx ,x) (,gy ,y)) - (cond ((and (typep ,gx 'fixnum) (typep ,gy 'fixnum)) - (eql (the fixnum ,gx) (the fixnum ,gy))) - ((eql (the integer ,gx) (the integer,gy)))))))) + (cond ((and (typep ,gx 'fixnum) (typep ,gy 'fixnum)) + (eql (the fixnum ,gx) (the fixnum ,gy))) + ((eql (the integer ,gx) (the integer,gy)))))))) (defmacro ifcar (x) (if (atom x) `(and (consp ,x) (qcar ,x)) (let ((xx (gensym))) `(let ((,xx ,x)) - (and (consp ,xx) (qcar ,xx)))))) + (and (consp ,xx) (qcar ,xx)))))) (defmacro ifcdr (x) (if (atom x) `(and (consp ,x) (qcdr ,x)) (let ((xx (gensym))) `(let ((,xx ,x)) - (and (consp ,xx) (qcdr ,xx)))))) + (and (consp ,xx) (qcdr ,xx)))))) (defmacro lam (&rest body) (list 'quote (*lam (copy-tree body)))) @@ -166,7 +166,7 @@ documentclass{article} `(if (atom ,x) ,x (nreverse ,x)) (let ((xx (gensym))) `(let ((,xx ,x)) - (if (atom ,xx) ,xx (nreverse ,xx)))))) + (if (atom ,xx) ,xx (nreverse ,xx)))))) (defmacro nump (n) `(numberp ,n)) @@ -176,7 +176,7 @@ documentclass{article} `(if (consp ,x) (qcar ,x) ,x) (let ((xx (gensym))) `(let ((,xx ,x)) - (if (consp ,xx) (qcar ,xx) ,xx))))) + (if (consp ,xx) (qcar ,xx) ,xx))))) (defmacro pairp (x) `(consp ,x)) @@ -458,7 +458,7 @@ documentclass{article} (setq lamda (eval lamda) ltype (car lamda) body (cddr lamda)))) (let ((dectest (car body))) (if (and (eqcar dectest 'declare) (eqcar (cadr dectest) 'special)) - (setq *decl* (cdr (cadr dectest)) body (cdr body)))) + (setq *decl* (cdr (cadr dectest)) body (cdr body)))) (setq args (remove-fluids (cadr lamda))) (cond ((and (eq ltype 'lambda) (simple-arglist args)) (setq nargs args)) (t (setq nargs (gensym)) @@ -506,9 +506,9 @@ documentclass{article} (compiled-function-p (macro-function item)))) (defun FBPIP (item) (or (compiled-function-p item) - (and (symbolp item) (fboundp item) - (not (macro-function item)) - (compiled-function-p (symbol-function item))))) + (and (symbolp item) (fboundp item) + (not (macro-function item)) + (compiled-function-p (symbol-function item))))) ; 9.5 Identifiers @@ -617,26 +617,26 @@ documentclass{article} ; ignores non-nil list terminators ; ignores non-pair a-list entries (cond ((symbolp X) - (PROG NIL - A (COND ((ATOM Y) (RETURN NIL)) - ((NOT (consp (CAR Y))) ) - ((EQ (CAAR Y) X) (RETURN (CAR Y))) ) - (SETQ Y (CDR Y)) - (GO A))) - ((or (numberp x) (characterp x)) - (PROG NIL - A (COND ((ATOM Y) (RETURN NIL)) - ((NOT (consp (CAR Y))) ) - ((EQL (CAAR Y) X) (RETURN (CAR Y))) ) - (SETQ Y (CDR Y)) - (GO A))) - (t - (PROG NIL - A (COND ((ATOM Y) (RETURN NIL)) - ((NOT (consp (CAR Y))) ) - ((EQUAL (CAAR Y) X) (RETURN (CAR Y))) ) - (SETQ Y (CDR Y)) - (GO A))))) + (PROG NIL + A (COND ((ATOM Y) (RETURN NIL)) + ((NOT (consp (CAR Y))) ) + ((EQ (CAAR Y) X) (RETURN (CAR Y))) ) + (SETQ Y (CDR Y)) + (GO A))) + ((or (numberp x) (characterp x)) + (PROG NIL + A (COND ((ATOM Y) (RETURN NIL)) + ((NOT (consp (CAR Y))) ) + ((EQL (CAAR Y) X) (RETURN (CAR Y))) ) + (SETQ Y (CDR Y)) + (GO A))) + (t + (PROG NIL + A (COND ((ATOM Y) (RETURN NIL)) + ((NOT (consp (CAR Y))) ) + ((EQUAL (CAAR Y) X) (RETURN (CAR Y))) ) + (SETQ Y (CDR Y)) + (GO A))))) ; 14.5 Updating (defun NREMOVE (list item &optional (count 1)) @@ -669,7 +669,7 @@ documentclass{article} (define-function 'GETREFV #'make-array) -@ +\end{chunk} Waldek Hebisch points out that, in the expression: \begin{verbatim} reduce(+,[1.0/i for i in 1..20000]) @@ -682,7 +682,7 @@ releases. If it is fixed then the original definition, which was (defun LIST2VEC (list) (coerce list 'vector)) \end{verbatim} can be restored. -<<*>>= +\begin{chunk}{*} (defun LIST2VEC (list) (if (consp list) (let* ((len (length list)) @@ -749,14 +749,14 @@ can be restored. changing CVEC." (unless (characterp id) (setq id (elt (string id) 0))) (cond ((array-has-fill-pointer-p cvec) - (vector-push-extend id cvec) - cvec) - ((adjustable-array-p cvec) - (let ((l (length cvec))) - (adjust-array cvec (1+ l)) - (setf (elt cvec l) id) - cvec)) - (t (concat cvec id)))) + (vector-push-extend id cvec) + cvec) + ((adjustable-array-p cvec) + (let ((l (length cvec))) + (adjust-array cvec (1+ l)) + (setf (elt cvec l) id) + cvec)) + (t (concat cvec id)))) (defun setsize (vector size) (adjust-array vector size)) @@ -1109,7 +1109,7 @@ can be restored. ; 24.0 Printing -@ +\end{chunk} \section{The StringImage Fix} In GCL 2.5 there is a bug in the write-to-string function. It should respect *print-escape* but it does not. That is, @@ -1128,7 +1128,7 @@ The form2LispString function uses stringimage and fails. The princ-to-string function assumes *print-escape* is nil and works properly. -<<*>>= +\begin{chunk}{*} (define-function 'stringimage #'princ-to-string) (define-function 'printexp #'princ) (define-function 'prin0 #'prin1) @@ -1254,7 +1254,7 @@ and works properly. (defun CurrentTime () (multiple-value-bind (sec min hour day month year) (get-decoded-time) (format nil "~2,'0D/~2,'0D/~2,'0D~2,'0D:~2,'0D:~2,'0D" - month day (rem year 100) hour min sec))) + month day (rem year 100) hour min sec))) (defun $screensize () '(24 80)) ; You tell me!! @@ -1365,11 +1365,11 @@ and works properly. (defun BPINAME (func) (if (functionp func) (cond ((symbolp func) func) - ((and (consp func) (eq (car func) 'LAMBDA-BLOCK)) - (cadr func)) - ((compiled-function-p func) - (system:compiled-function-name func)) - ('t func)))) + ((and (consp func) (eq (car func) 'LAMBDA-BLOCK)) + (cadr func)) + ((compiled-function-p func) + (system:compiled-function-name func)) + ('t func)))) (defun LISTOFQUOTES (bpi) (declare (ignore bpi)) @@ -1439,11 +1439,11 @@ and works properly. ('else t))) ((numberp COMPERAND-2) NIL) ((CHARACTERP COMPERAND-1) - (COND + (COND ((CHARACTERP COMPERAND-2) - (CHAR-GREATERP COMPERAND-1 COMPERAND-2) ) - ('else t))) - ((CHARACTERP COMPERAND-2) NIL ) + (CHAR-GREATERP COMPERAND-1 COMPERAND-2) ) + ('else t))) + ((CHARACTERP COMPERAND-2) NIL ) ((FBPIP COMPERAND-1) (COND ((FBPIP COMPERAND-2) @@ -1523,11 +1523,11 @@ and works properly. ('else t))) ((numberp COMPERAND-2) NIL) ((CHARACTERP COMPERAND-1) - (COND + (COND ((CHARACTERP COMPERAND-2) - (CHAR> COMPERAND-1 COMPERAND-2) ) - ('else t))) - ((CHARACTERP COMPERAND-2) NIL ) + (CHAR> COMPERAND-1 COMPERAND-2) ) + ('else t))) + ((CHARACTERP COMPERAND-2) NIL ) ((FBPIP COMPERAND-1) (COND ((FBPIP COMPERAND-2) @@ -1569,24 +1569,24 @@ and works properly. (defun MAKE-HASHTABLE (id1 &optional (id2 nil)) (declare (ignore id2)) (let ((test (case id1 - ((EQ ID) #'eq) - (CVEC #'equal) - (EQL #'eql) - ((UEQUAL EQUAL) #'equal) - (otherwise (error "bad arg to make-hashtable"))))) + ((EQ ID) #'eq) + (CVEC #'equal) + (EQL #'eql) + ((UEQUAL EQUAL) #'equal) + (otherwise (error "bad arg to make-hashtable"))))) (make-hash-table :test test))) ;17.2 Accessing -@ +\end{chunk} The static declaration causes a problem as of GCL-2.6.8pre. Camm issued a fix. This used to read: \begin{verbatim} #+AKCL (clines "static int mem_value(x ,i)object x;int i; { return ((short *)x)[i];}") \end{verbatim} -<<*>>= +\begin{chunk}{*} (clines "int mem_value(x ,i)object x;int i; { return ((short *)x)[i];}") (defentry memory-value-short(object int) (int "mem_value")) @@ -1595,10 +1595,10 @@ Camm issued a fix. This used to read: ;depending on whether the test is eq,eql or equal. (defun HASHTABLE-CLASS (table) (case (memory-value-short table 12) - (0 'EQ) - (1 'EQL) - (2 'EQUAL) - (t "error unknown hash table class"))) + (0 'EQ) + (1 'EQL) + (2 'EQUAL) + (t "error unknown hash table class"))) ;17.4 Searching and Updating @@ -1763,33 +1763,33 @@ Camm issued a fix. This used to read: ;; (RDEFIOSTREAM ((MODE . IO) (FILE fn ft dir))) IO is I,O,INPUT,OUTPUT (defun rdefiostream (options &optional (missing-file-error-flag t)) (let ((mode (cdr (assoc 'mode options))) - (file (assoc 'file options)) - (stream nil) - (fullname nil) - (indextable nil)) + (file (assoc 'file options)) + (stream nil) + (fullname nil) + (indextable nil)) (cond ((equal (elt (string mode) 0) #\I) - (setq fullname (boot::makeInputFilename (cdr file) nil)) - (setq stream (get-input-index-stream fullname)) + (setq fullname (boot::makeInputFilename (cdr file) nil)) + (setq stream (get-input-index-stream fullname)) (if (null stream) - (if missing-file-error-flag - (ERROR (format nil "Library ~s doesn't exist" - ;;(make-filename (cdr file) 'LISPLIB)) - (make-filename (cdr file) 'NIL))) - NIL) + (if missing-file-error-flag + (ERROR (format nil "Library ~s doesn't exist" + ;;(make-filename (cdr file) 'LISPLIB)) + (make-filename (cdr file) 'NIL))) + NIL) (make-libstream :mode 'input :dirname fullname :indextable (get-index-table-from-stream stream) - :indexstream stream))) + :indexstream stream))) ((equal (elt (string mode) 0) #\O) - ;;(setq fullname (boot::makeFullNamestring (cdr file) 'LISPLIB)) - (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))) - (otherwise)) - (multiple-value-setq (stream indextable) (get-io-index-stream fullname)) - (make-libstream :mode 'output :dirname fullname - :indextable indextable - :indexstream stream )) + ;;(setq fullname (boot::makeFullNamestring (cdr file) 'LISPLIB)) + (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))) + (otherwise)) + (multiple-value-setq (stream indextable) (get-io-index-stream fullname)) + (make-libstream :mode 'output :dirname fullname + :indextable indextable + :indexstream stream )) ('t (ERROR "Unknown MODE"))))) (defvar *index-filename* "index.kaf") @@ -1810,23 +1810,23 @@ Camm issued a fix. This used to read: (defun get-index-table-from-stream (stream) (let ((pos (read stream))) (cond ((numberp pos) - (file-position stream pos) - (read stream)) - (t pos)))) + (file-position stream pos) + (read stream)) + (t pos)))) (defun get-io-index-stream (dirname) (let* ((index-file (concat dirname "/" *index-filename*)) - (stream (open index-file :direction :io :if-exists :overwrite - :if-does-not-exist :create)) - (indextable ()) - (pos (read stream nil nil))) + (stream (open index-file :direction :io :if-exists :overwrite + :if-does-not-exist :create)) + (indextable ()) + (pos (read stream nil nil))) (cond ((numberp pos) - (file-position stream pos) - (setq indextable (read stream)) - (file-position stream pos)) - (t (file-position stream 0) - (princ " " stream) - (setq indextable pos))) + (file-position stream pos) + (setq indextable (read stream)) + (file-position stream pos)) + (t (file-position stream 0) + (princ " " stream) + (setq indextable pos))) (values stream indextable))) ;substitute indextable in dirname @@ -1855,46 +1855,46 @@ Camm issued a fix. This used to read: (defun rread (key rstream &optional (error-val nil error-val-p)) (if (equal (libstream-mode rstream) 'output) (error "not input stream")) (let* ((entry - (and (stringp key) - (assoc key (libstream-indextable rstream) :test #'string=))) - (file-or-pos (and entry (caddr entry)))) + (and (stringp key) + (assoc key (libstream-indextable rstream) :test #'string=))) + (file-or-pos (and entry (caddr entry)))) (cond ((null entry) - (if error-val-p error-val (error (format nil "key ~a not found" key)))) - ((null (caddr entry)) (cdddr entry)) ;; for small items - ((numberp file-or-pos) - (file-position (libstream-indexstream rstream) file-or-pos) - (read (libstream-indexstream rstream))) - (t - (with-open-file - (stream (concat (libstream-dirname rstream) "/" file-or-pos)) - (read stream))) ))) + (if error-val-p error-val (error (format nil "key ~a not found" key)))) + ((null (caddr entry)) (cdddr entry)) ;; for small items + ((numberp file-or-pos) + (file-position (libstream-indexstream rstream) file-or-pos) + (read (libstream-indexstream rstream))) + (t + (with-open-file + (stream (concat (libstream-dirname rstream) "/" file-or-pos)) + (read stream))) ))) (defvar *lib-var*) ;; (RKEYIDS filearg) -- interned version of keys (defun rkeyids (&rest filearg) (mapcar #'intern (mapcar #'car (getindextable - (boot::makeInputFilename filearg 'NIL))))) + (boot::makeInputFilename filearg 'NIL))))) ;; (RWRITE cvec item rstream) (defun rwrite (key item rstream) (if (equal (libstream-mode rstream) 'input) (error "not output stream")) (let ((stream (libstream-indexstream rstream)) - (pos (if item (cons (file-position (libstream-indexstream rstream)) nil) - (cons nil item)))) ;; for small items + (pos (if item (cons (file-position (libstream-indexstream rstream)) nil) + (cons nil item)))) ;; for small items (make-entry (string key) rstream pos) (when (numberp (car pos)) - (write item :stream stream :level nil :length nil - :circle t :array t :escape t) - (terpri stream)))) + (write item :stream stream :level nil :length nil + :circle t :array t :escape t) + (terpri stream)))) (defun make-entry (key rstream value-or-pos) (let ((entry (assoc key (libstream-indextable rstream) :test #'equal))) (if (null entry) - (push (setq entry (cons key (cons 0 value-or-pos))) - (libstream-indextable rstream)) + (push (setq entry (cons key (cons 0 value-or-pos))) + (libstream-indextable rstream)) (progn - (if (stringp (caddr entry)) ($erase (caddr entry))) - (setf (cddr entry) value-or-pos))) + (if (stringp (caddr entry)) ($erase (caddr entry))) + (setf (cddr entry) value-or-pos))) entry)) ;;(defun rshut (rstream) @@ -1914,7 +1914,7 @@ Camm issued a fix. This used to read: (write-indextable (libstream-indextable rstream) (libstream-indexstream rstream))) (close (libstream-indexstream rstream))) -@ +\end{chunk} \section{GCL code.lsp name change} When we compile an algebra file we create an nrlib directory which contains several files. One of the files is named code.lsp. @@ -1925,7 +1925,7 @@ Since all of the code.lsp files have the same name all of the init blocks have the same name. At link time this causes the names to collide. Here we rename the file before we compile, do the compile, and then rename the result back to code.o. -<<*>>= +\begin{chunk}{*} ;; filespec is id or list of 1, 2 or 3 ids ;; filearg is filespec or 1, 2 or 3 ids ;; (RPACKFILE filearg) -- compiles code files and converts to compressed format @@ -1943,21 +1943,21 @@ do the compile, and then rename the result back to code.o. (namestring (merge-pathnames o code))))) ;; only pack non libraries to avoid lucid file handling problems (let* ((rstream (rdefiostream (list (cons 'file filespec) (cons 'mode 'input)))) - (nstream nil) - (nindextable nil) - (nrstream nil) - (index-file-name (concat (truename filespec) "/" *index-filename*)) - (temp-index-file-name (make-pathname :name "oldindex" - :defaults index-file-name))) + (nstream nil) + (nindextable nil) + (nrstream nil) + (index-file-name (concat (truename filespec) "/" *index-filename*)) + (temp-index-file-name (make-pathname :name "oldindex" + :defaults index-file-name))) (rename-file index-file-name temp-index-file-name ) ;; stays until closed (multiple-value-setq (nstream nindextable) (get-io-index-stream filespec)) (setq nrstream (make-libstream :mode 'output :dirname filespec - :indextable nindextable - :indexstream nstream )) + :indextable nindextable + :indexstream nstream )) (dolist (entry (libstream-indextable rstream)) - (rwrite (car entry) (rread (car entry) rstream) nrstream) - (if (stringp (caddr entry)) - (delete-file (concat filespec "/" (caddr entry))))) + (rwrite (car entry) (rread (car entry) rstream) nrstream) + (if (stringp (caddr entry)) + (delete-file (concat filespec "/" (caddr entry))))) (close (libstream-indexstream rstream)) (delete-file temp-index-file-name) (rshut nrstream))) @@ -1966,9 +1966,9 @@ do the compile, and then rename the result back to code.o. (defun spad-fixed-arg (fname ) (and (equal (symbol-package fname) (find-package "BOOT")) (not (get fname 'compiler::spad-var-arg)) - (search ";" (symbol-name fname)) + (search ";" (symbol-name fname)) (or (get fname 'compiler::fixed-args) - (setf (get fname 'compiler::fixed-args) t))) + (setf (get fname 'compiler::fixed-args) t))) nil) ;; (RDROPITEMS filearg keys) don't delete, used in files.spad @@ -1981,37 +1981,37 @@ 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 (and filetype (symbolp filetype)) - (symbol-name filetype) - filetype))) + (symbol-name filetype) + filetype))) (cond ((pathnamep filearg) (cond ((pathname-type filearg) (namestring filearg)) - (t (namestring + (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) (stringp filetype) - (pathname-type filearg) - (string-equal (pathname-type filearg) filetype)) + (pathname-type filearg) + (string-equal (pathname-type filearg) filetype)) filearg) ((consp filearg) (make-filename (car filearg) (or (cadr filearg) filetype))) (t (if (stringp filetype) (setq filetype (intern filetype "BOOT"))) - (let ((ft (or (cdr (assoc filetype $filetype-table)) filetype))) - (if ft - (concatenate 'string (string filearg) "." (string ft)) - (string filearg))))))) + (let ((ft (or (cdr (assoc filetype $filetype-table)) filetype))) + (if ft + (concatenate 'string (string filearg) "." (string ft)) + (string filearg))))))) (defun $FILEP (&rest filearg) (boot::makeFullNamestring filearg)) (define-function '$OUTFILEP #'$FILEP) ;;temporary bogus def (defun $findfile (filespec filetypelist) (let ((file-name (if (consp filespec) (car filespec) filespec)) - (file-type (if (consp filespec) (cadr filespec) nil))) + (file-type (if (consp filespec) (cadr filespec) nil))) (if file-type (push file-type filetypelist)) (some #'(lambda (ft) (boot::makeInputFilename file-name ft)) - filetypelist))) + filetypelist))) ;; ($ERASE filearg) -> 0 if succeeds else 1 (defun $erase (&rest filearg) @@ -2020,10 +2020,10 @@ do the compile, and then rename the result back to code.o. (defun $FCOPY (filespec1 filespec2) (let ((name1 (boot::makeFullNamestring filespec1)) - (name2 (boot::makeFullNamestring filespec2))) + (name2 (boot::makeFullNamestring filespec2))) (if (library-file name1) - (copy-lib-directory name1 name2) - (copy-file name1 name2)))) + (copy-lib-directory name1 name2) + (copy-file name1 name2)))) (defun copy-lib-directory (name1 name2) @@ -2075,10 +2075,10 @@ do the compile, and then rename the result back to code.o. (defun |insertString| (s1 s2 i1) (replace s2 s1 :start1 i1 :end1 (1+ i1) :end2 (size s1))) -; NAME: Boot Package +; NAME: Boot Package ; PURPOSE: Provide forward references to Boot Code for functions to be at -; defined at the boot level, but which must be accessible -; not defined at lower levels. +; defined at the boot level, but which must be accessible +; not defined at lower levels. (in-package "BOOT") (use-package '("LISP" "VMLISP")) @@ -2117,97 +2117,97 @@ do the compile, and then rename the result back to code.o. (def-boot-val $underlineString (concatenate 'string $escapeString "[4m") "switch into underline mode") (def-boot-val $COMPILE t "checked in COMP-2 to skip compilation") -(def-boot-var |$abbreviationTable| "???") +(def-boot-var |$abbreviationTable| "???") (def-boot-val |$algebraList| - '(|QuotientField| |Polynomial| - |UnivariatePoly| - |MultivariatePolynomial| - |DistributedMultivariatePolynomial| - |HomogeneousDistributedMultivariatePolynomial| - |Gaussian| |SquareMatrix| - |RectangularMatrix|) "???") + '(|QuotientField| |Polynomial| + |UnivariatePoly| + |MultivariatePolynomial| + |DistributedMultivariatePolynomial| + |HomogeneousDistributedMultivariatePolynomial| + |Gaussian| |SquareMatrix| + |RectangularMatrix|) "???") (def-boot-val |$BasicDomains| - '(|Integer| |Float| |Symbol| - |Boolean| |String|) "???") + '(|Integer| |Float| |Symbol| + |Boolean| |String|) "???") (def-boot-val |$BasicPredicates| - '(INTEGERP STRINGP FLOATP) "???") -(def-boot-val |$BFtag| '-BF- "big float marker") -(def-boot-val |$BigFloat| '(|Float|) "???") + '(INTEGERP STRINGP FLOATP) "???") +(def-boot-val |$BFtag| '-BF- "big float marker") +(def-boot-val |$BigFloat| '(|Float|) "???") (def-boot-val |$BigFloatOpt| '(|BigFloat| . OPT) "???") -(def-boot-val |$Boolean| '(|Boolean|) "???") -(def-boot-val |$BooleanOpt| '(|Boolean| . OPT) "???") +(def-boot-val |$Boolean| '(|Boolean|) "???") +(def-boot-val |$BooleanOpt| '(|Boolean| . OPT) "???") (def-boot-val |$bootStrapMode| () "if T compCapsule skips body") -(def-boot-fun |bootUnionPrint| (x s tt) "Interpreter>Coerce.boot") -(def-boot-fun |break| (msg) "Interpreter>Trace.boot") -(def-boot-fun |breaklet| (fn vars) "Interpreter>Trace.boot") -(def-boot-var |$brightenCommentsFlag| "???") -(def-boot-var |$brightenCommentsIfTrue| "???") -(def-boot-val |$BreakMode| '|query| "error.boot") -(def-boot-var |$cacheAlist| "Interpreter>System.boot") -(def-boot-val |$cacheCount| 0 "???") -(def-boot-val |$Category| '(|Category|) "???") +(def-boot-fun |bootUnionPrint| (x s tt) "Interpreter>Coerce.boot") +(def-boot-fun |break| (msg) "Interpreter>Trace.boot") +(def-boot-fun |breaklet| (fn vars) "Interpreter>Trace.boot") +(def-boot-var |$brightenCommentsFlag| "???") +(def-boot-var |$brightenCommentsIfTrue| "???") +(def-boot-val |$BreakMode| '|query| "error.boot") +(def-boot-var |$cacheAlist| "Interpreter>System.boot") +(def-boot-val |$cacheCount| 0 "???") +(def-boot-val |$Category| '(|Category|) "???") ; modemap:== ( (p e) (p e) ... (p e) ) ; modemaplist:= ( modemap ... ) (def-boot-val |$CategoryFrame| - '((((|Category| . ((|modemap| (((|Category|) (|Category|)) (T *))))) - (|Join| . ((|modemap| + '((((|Category| . ((|modemap| (((|Category|) (|Category|)) (T *))))) + (|Join| . ((|modemap| (((|Category|) (|Category|) (|Category|) (|Category|)) (T *)) (((|Category|) (|Category|) (|List| |Category|)) (|Category|)) (T *)) - ))))) - "Compiler>CUtil.boot") + ))))) + "Compiler>CUtil.boot") (def-boot-val |$CategoryNames| - '(|Category| |CATEGORY| |RecordCategory| |Join| - |StringCategory| |SubsetCategory| |UnionCategory|) - "???") + '(|Category| |CATEGORY| |RecordCategory| |Join| + |StringCategory| |SubsetCategory| |UnionCategory|) + "???") (def-boot-val |$clamList| - '((|getModemapsFromDatabase| |hash| UEQUAL |count|) - (|getOperationAlistFromLisplib| |hash| UEQUAL |count|) - (|getFileProperty| |hash| UEQUAL |count|) - (|canCoerceFrom| |hash| UEQUAL |count|) - (|selectMms1| |hash| UEQUAL |count|) - (|coerceMmSelection| |hash| UEQUAL |count|) - (|isValidType| |hash| UEQUAL |count|)) - "Interpreter>Clammed.boot") + '((|getModemapsFromDatabase| |hash| UEQUAL |count|) + (|getOperationAlistFromLisplib| |hash| UEQUAL |count|) + (|getFileProperty| |hash| UEQUAL |count|) + (|canCoerceFrom| |hash| UEQUAL |count|) + (|selectMms1| |hash| UEQUAL |count|) + (|coerceMmSelection| |hash| UEQUAL |count|) + (|isValidType| |hash| UEQUAL |count|)) + "Interpreter>Clammed.boot") (def-boot-val |$CommonDomains| - '(|Record| |Union| |List| |Vector| - |String| |Float| |Integer| - |NonNegativeInteger| |Expression| - |NonPositiveInteger| - |PositiveInteger| |SmallInteger| - |Boolean|) "???") - -(def-boot-var |$compCount| "???") -(def-boot-var |$compileMapFlag| "Interpreter>SetVars.boot") -(def-boot-var |$compUniquelyIfTrue| "Compiler>Compiler.boot") -(def-boot-val |$consistencyCheck| nil "Interpreter>Consis.boot") -(def-boot-val |$ConstructorCache| (MAKE-HASHTABLE 'ID) "???") -(def-boot-var |$constructorsNotInDatabase| "Interpreter>Database.boot") -(def-boot-var |$createUpdateFiles| "Interpreter>SetVarT.boot") -(def-boot-var |$croakIfTrue| "See moan in U.") -(def-boot-var |$currentFunction| "???") -(def-boot-val |$currentLine| "" "current input line for history") -(def-boot-val $delay 0 "???") -(def-boot-var $Directory "???") -(def-boot-val |$Domain| '(|Domain|) "???") -(def-boot-var |$DomainFrame| "???") + '(|Record| |Union| |List| |Vector| + |String| |Float| |Integer| + |NonNegativeInteger| |Expression| + |NonPositiveInteger| + |PositiveInteger| |SmallInteger| + |Boolean|) "???") + +(def-boot-var |$compCount| "???") +(def-boot-var |$compileMapFlag| "Interpreter>SetVars.boot") +(def-boot-var |$compUniquelyIfTrue| "Compiler>Compiler.boot") +(def-boot-val |$consistencyCheck| nil "Interpreter>Consis.boot") +(def-boot-val |$ConstructorCache| (MAKE-HASHTABLE 'ID) "???") +(def-boot-var |$constructorsNotInDatabase| "Interpreter>Database.boot") +(def-boot-var |$createUpdateFiles| "Interpreter>SetVarT.boot") +(def-boot-var |$croakIfTrue| "See moan in U.") +(def-boot-var |$currentFunction| "???") +(def-boot-val |$currentLine| "" "current input line for history") +(def-boot-val $delay 0 "???") +(def-boot-var $Directory "???") +(def-boot-val |$Domain| '(|Domain|) "???") +(def-boot-var |$DomainFrame| "???") (def-boot-val |$DomainNames| - '(|Integer| |Float| |Symbol| |Boolean| - |String| |Expression| - |Mapping| |SubDomain| |List| |Union| - |Record| |Vector|) "???") -(def-boot-val |$DomainsInScope| '(NIL) "???") + '(|Integer| |Float| |Symbol| |Boolean| + |String| |Expression| + |Mapping| |SubDomain| |List| |Union| + |Record| |Vector|) "???") +(def-boot-val |$DomainsInScope| '(NIL) "???") (def-boot-val |$domainTraceNameAssoc| () "association list of trace domains") (def-boot-val |$DomainVariableList| '($1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11 - $12 $13 $14 $15) "???") + $12 $13 $14 $15) "???") (def-boot-val |$DoubleQuote| "\"" "???") (def-boot-val |$DummyFunctorNames| - '(|Boolean| |Mapping|) "???") -(def-boot-var |$eltIfNil| "SpecialFunctions>PSpad.boot") -(def-boot-val |$EmptyEnvironment| '((NIL)) "???") -(def-boot-val |$EmptyList| () "???") -@ + '(|Boolean| |Mapping|) "???") +(def-boot-var |$eltIfNil| "SpecialFunctions>PSpad.boot") +(def-boot-val |$EmptyEnvironment| '((NIL)) "???") +(def-boot-val |$EmptyList| () "???") +\end{chunk} \verb|$EmptyMode| is a contant whose value is \verb|$EmptyMode|. It is used by isPartialMode (in i-funsel.boot) to decide if a modemap is partially constructed. If the \verb|$EmptyMode| @@ -2215,249 +2215,249 @@ constant occurs anywhere in the modemap structure at any depth then the modemap is still incomplete. To find this constant the isPartialMode function calls CONTAINED \verb|$EmptyMode| Y which will walk the structure $Y$ looking for this constant. -<<*>>= +\begin{chunk}{*} (def-boot-val |$EmptyMode| '|$EmptyMode| "compiler constant") -(def-boot-val |$EM| |$EmptyMode| "???") +(def-boot-val |$EM| |$EmptyMode| "???") (def-boot-val |$EmptyString| "" "???") -(def-boot-val |$EmptyVector| '#() "???") -(def-boot-val |$Expression| '(|Expression|) "???") +(def-boot-val |$EmptyVector| '#() "???") +(def-boot-val |$Expression| '(|Expression|) "???") (def-boot-val |$ExpressionOpt| - '(|Expression| . OPT) "???") -(def-boot-var |$evalDomain| "???") -(def-boot-val |$Exit| '(Exit) "compiler constant") -(def-boot-var |$exitMode| "???") -(def-boot-var |$exitModeStack| "???") -(def-boot-val |$failure| (GENSYM) "Symbol denoting a failed operation.") -(def-boot-val |$false| NIL "???") -(def-boot-val |$Float| '(|Float|) "???") -(def-boot-val |$FloatOpt| '(|Float| . OPT) "???") -(def-boot-val |$FontTable| '(|FontTable|) "???") -(def-boot-var |$forceDatabaseUpdate| "See load function.") -(def-boot-var |$form| "???") + '(|Expression| . OPT) "???") +(def-boot-var |$evalDomain| "???") +(def-boot-val |$Exit| '(Exit) "compiler constant") +(def-boot-var |$exitMode| "???") +(def-boot-var |$exitModeStack| "???") +(def-boot-val |$failure| (GENSYM) "Symbol denoting a failed operation.") +(def-boot-val |$false| NIL "???") +(def-boot-val |$Float| '(|Float|) "???") +(def-boot-val |$FloatOpt| '(|Float| . OPT) "???") +(def-boot-val |$FontTable| '(|FontTable|) "???") +(def-boot-var |$forceDatabaseUpdate| "See load function.") +(def-boot-var |$form| "???") (def-boot-val |$FormalMapVariableList| '(\#1 \#2 \#3 \#4 \#5 \#6 \#7 \#8 \#9 - \#10 \#11 \#12 \#13 \#14 \#15) "???") + \#10 \#11 \#12 \#13 \#14 \#15) "???") (def-boot-val |$FormalMapVariableList2| '(\#\#1 \#\#2 \#\#3 \#\#4 \#\#5 \#\#6 \#\#7 \#\#8 \#\#9 - \#\#10 \#\#11 \#\#12 \#\#13 \#\#14 \#\#15) "???") -(def-boot-var |$fromSpadTrace| "Interpreter>Trace.boot") -(def-boot-var $function "Interpreter>System.boot") -(def-boot-var $FunName "???") -(def-boot-var $FunnameTail "???") + \#\#10 \#\#11 \#\#12 \#\#13 \#\#14 \#\#15) "???") +(def-boot-var |$fromSpadTrace| "Interpreter>Trace.boot") +(def-boot-var $function "Interpreter>System.boot") +(def-boot-var $FunName "???") +(def-boot-var $FunnameTail "???") (def-boot-val |$ConstructorNames| - '(|SubDomain| |List| |Union| |Record| |Vector|) - "Used in isFunctor test, and compDefine.") -(def-boot-val |$gauss01| '(|gauss| 0 1) "???") -(def-boot-var |$genFVar| "???") -(def-boot-val |$genSDVar| 0 "counter for genSomeVariable" ) + '(|SubDomain| |List| |Union| |Record| |Vector|) + "Used in isFunctor test, and compDefine.") +(def-boot-val |$gauss01| '(|gauss| 0 1) "???") +(def-boot-var |$genFVar| "???") +(def-boot-val |$genSDVar| 0 "counter for genSomeVariable" ) (def-boot-val |$hasCategoryTable| (MAKE-HASHTABLE 'UEQUAL) "???") -(def-boot-var |$hasYield| "???") -(def-boot-var |$ignoreCommentsIfTrue| "???") -(def-boot-var |$Index| "???") +(def-boot-var |$hasYield| "???") +(def-boot-var |$ignoreCommentsIfTrue| "???") +(def-boot-var |$Index| "???") (def-boot-val |$InitialDomainsInScope| - '((|Boolean|) |$EmptyMode| |$NoValueMode|) - "???") -(def-boot-var |$insideCapsuleFunctionIfTrue| "???") -(def-boot-var |$insideCategoryIfTrue| "???") + '((|Boolean|) |$EmptyMode| |$NoValueMode|) + "???") +(def-boot-var |$insideCapsuleFunctionIfTrue| "???") +(def-boot-var |$insideCategoryIfTrue| "???") (def-boot-var |$insideCoerceInteractiveHardIfTrue| "???") (def-boot-val |$insideCompTypeOf| NIL "checked in comp3") (def-boot-val |$insideConstructIfTrue| NIL "checked in parse.boot") -(def-boot-var |$insideExpressionIfTrue| "???") -(def-boot-var |$insideFunctorIfTrue| "???") -(def-boot-var |$insideWhereIfTrue| "???") +(def-boot-var |$insideExpressionIfTrue| "???") +(def-boot-var |$insideFunctorIfTrue| "???") +(def-boot-var |$insideWhereIfTrue| "???") (def-boot-val |$instantRecord| (MAKE-HASHTABLE 'ID) "???") -(def-boot-val |$Integer| '(|Integer|) "???") -(def-boot-val |$IntegerOpt| '(|Integer| . OPT) "???") -(def-boot-val |$InteractiveFrame| '((NIL)) "top level environment") -(def-boot-var |$InteractiveMode| "Interactive>System.boot") +(def-boot-val |$Integer| '(|Integer|) "???") +(def-boot-val |$IntegerOpt| '(|Integer| . OPT) "???") +(def-boot-val |$InteractiveFrame| '((NIL)) "top level environment") +(def-boot-var |$InteractiveMode| "Interactive>System.boot") (def-boot-val |$InteractiveModemapFrame| '((NIL)) "???") -(def-boot-var |$InteractiveTimingStatsIfTrue| "???") -(def-boot-var |$LastCxArg| "???") +(def-boot-var |$InteractiveTimingStatsIfTrue| "???") +(def-boot-var |$LastCxArg| "???") (def-boot-val |$lastUntraced| NIL "Used for )restore option of )trace.") -(def-boot-var |$leaveLevelStack| "???") -(def-boot-var |$leaveMode| "???") -(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 |$lisplibForm| "Compiler>LispLib.boot") -(def-boot-var |$lisplibKind| "Compiler>LispLib.boot") -(def-boot-var |$lisplibModemapAlist| "Compiler>LispLib.boot") -(def-boot-var |$lisplibModemap| "Compiler>LispLib.boot") -(def-boot-var |$lisplibOperationAlist| "Compiler>LispLib.boot") -(def-boot-var |$lisplibSignatureAlist| "Compiler>LispLib.boot") -(def-boot-var |$lisplibVariableAlist| "Compiler>LispLib.boot") -(def-boot-val |$LocalFrame| '((NIL)) "???") -(def-boot-var |$mapSubNameAlist| "Interpreter>Trace.boot") -(def-boot-var |$mathTrace| "Interpreter>Trace.boot") -(def-boot-var |$mathTraceList| "Controls mathprint output for )trace.") -(def-boot-var $maxlinenumber "???") -(def-boot-val |$Mode| '(Mode) "compiler constant") -(def-boot-var |$ModemapFrame| "???") +(def-boot-var |$leaveLevelStack| "???") +(def-boot-var |$leaveMode| "???") +(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 |$lisplibForm| "Compiler>LispLib.boot") +(def-boot-var |$lisplibKind| "Compiler>LispLib.boot") +(def-boot-var |$lisplibModemapAlist| "Compiler>LispLib.boot") +(def-boot-var |$lisplibModemap| "Compiler>LispLib.boot") +(def-boot-var |$lisplibOperationAlist| "Compiler>LispLib.boot") +(def-boot-var |$lisplibSignatureAlist| "Compiler>LispLib.boot") +(def-boot-var |$lisplibVariableAlist| "Compiler>LispLib.boot") +(def-boot-val |$LocalFrame| '((NIL)) "???") +(def-boot-var |$mapSubNameAlist| "Interpreter>Trace.boot") +(def-boot-var |$mathTrace| "Interpreter>Trace.boot") +(def-boot-var |$mathTraceList| "Controls mathprint output for )trace.") +(def-boot-var $maxlinenumber "???") +(def-boot-val |$Mode| '(Mode) "compiler constant") +(def-boot-var |$ModemapFrame| "???") (def-boot-val |$ModeVariableList| '(&1 &2 &3 &4 &5 &6 &7 &8 &9 &10 &11 - &12 &13 &14 &15) "???") -(def-boot-var |$mostRecentOpAlist| "???") + &12 &13 &14 &15) "???") +(def-boot-var |$mostRecentOpAlist| "???") (def-boot-val |$NegativeIntegerOpt| '(|NegativeInteger| . OPT) "???") (def-boot-val |$NegativeInteger| '(|NegativeInteger|) "???") (def-boot-val |$NETail| (CONS |$EmptyEnvironment| NIL) "???") -(def-boot-var $NEWLINSTACK "???") -(def-boot-var |$noEnv| "???") +(def-boot-var $NEWLINSTACK "???") +(def-boot-var |$noEnv| "???") (def-boot-val |$NonMentionableDomainNames| '($ |Rep| |Mapping|) "???") (def-boot-val |$NonNegativeIntegerOpt| '(|NonNegativeInteger| . OPT) "???") (def-boot-val |$NonNegativeInteger| '(|NonNegativeInteger|) "???") (def-boot-val |$NonPositiveIntegerOpt| '(|NonPositiveInteger| . OPT) "???") (def-boot-val |$NonPositiveInteger| '(|NonPositiveInteger|) "???") -(def-boot-var |$noParseCommands| "???") +(def-boot-var |$noParseCommands| "???") (def-boot-val |$NoValueMode| '|$NoValueMode| "compiler literal") (def-boot-val |$NoValue| '|$NoValue| "compiler literal") -(def-boot-val $num_of_meta_errors 0 "Number of errors seen so far") -(def-boot-var $OLDLINE "Used to output command lines.") -(def-boot-val |$oldTime| 0 "???") -(def-boot-val |$One| '(|One|) "???") -(def-boot-val |$OneCoef| '(1 1 . 1) "???") -(def-boot-val |$operationNameList| NIL "op names for apropos") -(def-boot-var |$opFilter| "Used to /s a function") -(def-boot-var |OptionList| "???") +(def-boot-val $num_of_meta_errors 0 "Number of errors seen so far") +(def-boot-var $OLDLINE "Used to output command lines.") +(def-boot-val |$oldTime| 0 "???") +(def-boot-val |$One| '(|One|) "???") +(def-boot-val |$OneCoef| '(1 1 . 1) "???") +(def-boot-val |$operationNameList| NIL "op names for apropos") +(def-boot-var |$opFilter| "Used to /s a function") +(def-boot-var |OptionList| "???") (def-boot-val |$optionAlist| nil "info for trace boot") -(def-boot-var |$OutsideStringIfTrue| "???") +(def-boot-var |$OutsideStringIfTrue| "???") (def-boot-val |$PatternVariableList| '(*1 *2 *3 *4 *5 *6 *7 *8 *9 *10 *11 - *12 *13 *14 *15) "???") -(def-boot-var |$PolyMode| "???") -(def-boot-val |$Polvar| '(WRAPPED . ((1 . 1))) "???") -(def-boot-var |$polyDefaultAssoc| "???") + *12 *13 *14 *15) "???") +(def-boot-var |$PolyMode| "???") +(def-boot-val |$Polvar| '(WRAPPED . ((1 . 1))) "???") +(def-boot-var |$polyDefaultAssoc| "???") (def-boot-val |$PolyDomains| - '(|Polynomial| |MultivariatePolynomial| - |UnivariatePoly| - |DistributedMultivariatePolynomial| - |HomogeneousDistributedMultivariatePolynomial|) - "???") + '(|Polynomial| |MultivariatePolynomial| + |UnivariatePoly| + |DistributedMultivariatePolynomial| + |HomogeneousDistributedMultivariatePolynomial|) + "???") (def-boot-val |$PositiveIntegerOpt| '(|PositiveInteger| . OPT) "???") (def-boot-val |$PositiveInteger| '(|PositiveInteger|) "???") -(def-boot-var |$postStack| "???") -(def-boot-var |$prefix| "???") +(def-boot-var |$postStack| "???") +(def-boot-var |$prefix| "???") (def-boot-val |$PrettyPrint| nil "if t generated code is prettyprinted") -(def-boot-var |$previousTime| "???") +(def-boot-var |$previousTime| "???") (def-boot-val |$PrimitiveDomainNames| nil "Used in mkCategory to avoid generating vector slot -for primitive domains. Also used by putInLocalDomainReferences and optCal.") +for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-val |$optimizableDomainNames| '(|FactoredForm| |List| |Vector| - |Integer| |NonNegativeInteger| |PositiveInteger| - |SmallInteger| |String| |Boolean| |Symbol| |BooleanFunctions|) + |Integer| |NonNegativeInteger| |PositiveInteger| + |SmallInteger| |String| |Boolean| |Symbol| |BooleanFunctions|) "used in optCall to decide which domains can be optimized") -(def-boot-val |$PrintBox| '(|PrintBox|) "???") -(def-boot-var |$PrintCompilerMessagesIfTrue| "???") +(def-boot-val |$PrintBox| '(|PrintBox|) "???") +(def-boot-var |$PrintCompilerMessagesIfTrue| "???") (def-boot-val |$printConStats| nil "display constructor cache totals") -(def-boot-val |$printLoadMsgs| 't "Interpreter>SetVarT.boot") -(def-boot-var |$PrintOnly| "Compiler>LispLib.boot") +(def-boot-val |$printLoadMsgs| 't "Interpreter>SetVarT.boot") +(def-boot-var |$PrintOnly| "Compiler>LispLib.boot") (def-boot-val |$UserSynonyms| () "list of user defined synonyms") (def-boot-val |$SystemSynonyms| () "list of system defined synonyms") -(def-boot-val |$QuickCode| NIL "Controls generation of QREFELT, etc.") -(def-boot-val |$QuickLet| NIL "Set to T for no LET tracing.") -(def-boot-var |$QuietIfNil| "???") +(def-boot-val |$QuickCode| NIL "Controls generation of QREFELT, etc.") +(def-boot-val |$QuickLet| NIL "Set to T for no LET tracing.") +(def-boot-var |$QuietIfNil| "???") (def-boot-val |$RationalNumberOpt| '(|RationalNumber| . OPT) "???") (def-boot-val |$RationalNumber| '(|RationalNumber|) "???") -(def-boot-var |$readingFile| "???") -(def-boot-val |$report3| nil "addMap report info") -(def-boot-var |$reportBottomUpFlag| "Interpreter>SetVarT.boot") -(def-boot-var |$reportCoerce| "???") -(def-boot-var |$reportCoerceIfTrue| "???") -(def-boot-var |$reportCompilation| "???") -(def-boot-var |$reportExitModeStack| "???") -(def-boot-var |$reportFlag| "Interpreter>SetVars.boot") +(def-boot-var |$readingFile| "???") +(def-boot-val |$report3| nil "addMap report info") +(def-boot-var |$reportBottomUpFlag| "Interpreter>SetVarT.boot") +(def-boot-var |$reportCoerce| "???") +(def-boot-var |$reportCoerceIfTrue| "???") +(def-boot-var |$reportCompilation| "???") +(def-boot-var |$reportExitModeStack| "???") +(def-boot-var |$reportFlag| "Interpreter>SetVars.boot") (def-boot-val |$reportSpadTrace| () "report list of traced functions") -(def-boot-var |$resolveFlag| "Interpreter>SetVars.boot") -(def-boot-var |$returnMode| "???") -(def-boot-var |$scanModeFlag| "???") -(def-boot-var |$semanticErrorStack| "???") +(def-boot-var |$resolveFlag| "Interpreter>SetVars.boot") +(def-boot-var |$returnMode| "???") +(def-boot-var |$scanModeFlag| "???") +(def-boot-var |$semanticErrorStack| "???") (def-boot-val |$SetFunctions| nil "checked in SetFunctionSlots") (def-boot-val |$SideEffectFreeFunctionList| '(|null| |case| |Zero| |One| \: \:\: |has| |Mapping| |elt| = \> \>= \< \<= MEMBER |is| |isnt| ATOM - $= $\> $\>= $\< $\<= $^= $MEMBER) "???") -(def-boot-var |$slamFlag| "Interpreter>SetVars.boot") -(def-boot-val |$SmallInteger| '(|SmallInteger|) "???") + $= $\> $\>= $\< $\<= $^= $MEMBER) "???") +(def-boot-var |$slamFlag| "Interpreter>SetVars.boot") +(def-boot-val |$SmallInteger| '(|SmallInteger|) "???") (def-boot-val |$SmallIntegerOpt| '(|SmallInteger| . OPT) "???") (def-boot-val |$sourceFileTypes| - '(INPUT SPAD BOOT LISP LISP370 META) - "Interpreter>System.boot") -(def-boot-val $SPAD nil "Is this Spad code?") -(def-boot-var $SPAD_ERRORS "???") -(def-boot-val |$spadLibFT| 'LISPLIB "???") + '(INPUT SPAD BOOT LISP LISP370 META) + "Interpreter>System.boot") +(def-boot-val $SPAD nil "Is this Spad code?") +(def-boot-var $SPAD_ERRORS "???") +(def-boot-val |$spadLibFT| 'LISPLIB "???") (def-boot-val |$SpecialDomainNames| '(|add| |CAPSULE| |SubDomain| |List| |Union| |Record| |Vector|) "Used in isDomainForm, addEmptyCapsuleIfnecessary.") -(def-boot-val |$streamCount| 0 "???") -(def-boot-var |$streamIndexing| "???") -(def-boot-val |$StreamIndex| 0 "???") +(def-boot-val |$streamCount| 0 "???") +(def-boot-var |$streamIndexing| "???") +(def-boot-val |$StreamIndex| 0 "???") (def-boot-val |$StringCategory| '(|StringCategory|) "???") -(def-boot-val |$StringOpt| '(|String| . OPT) "???") -(def-boot-val |$String| '(|String|) "???") -(def-boot-var |$suffix| "???") -(def-boot-val |$Symbol| '(|Symbol|) "???") -(def-boot-val |$SymbolOpt| '(|Symbol| . OPT) "???") +(def-boot-val |$StringOpt| '(|String| . OPT) "???") +(def-boot-val |$String| '(|String|) "???") +(def-boot-var |$suffix| "???") +(def-boot-val |$Symbol| '(|Symbol|) "???") +(def-boot-val |$SymbolOpt| '(|Symbol| . OPT) "???") (def-boot-val |$tempCategoryTable| (MAKE-HASHTABLE 'UEQUAL) "???") (def-boot-val |$ThrowAwayMode| '|$ThrowAwayMode| "interp constant") -(def-boot-val |$timerOn| t "???") -(def-boot-var |$topOp| "See displayPreCompilationErrors") -(def-boot-var |$tokenCommands| "???") -(def-boot-var $TOKSTACK "???") -(def-boot-val $TOP_LEVEL t "???") -(def-boot-var $top_stack "???") -(def-boot-var |$tracedModemap| "Interpreter>Trace.boot") -(def-boot-val |$traceDomains| t "enables domain tracing") -(def-boot-val |$TraceFlag| t "???") -(def-boot-var |$tracedSpadModemap| "Interpreter>Trace.boot") -(def-boot-var |$traceletFunctions| "???") -(def-boot-var |$traceNoisely| "Interpreter>Trace.boot") -(def-boot-var |$TranslateOnly| "???") -(def-boot-var |$tripleCache| "Compiler>Compiler.boot") -(def-boot-val |$true| ''T "???") -(def-boot-var $Type "???") +(def-boot-val |$timerOn| t "???") +(def-boot-var |$topOp| "See displayPreCompilationErrors") +(def-boot-var |$tokenCommands| "???") +(def-boot-var $TOKSTACK "???") +(def-boot-val $TOP_LEVEL t "???") +(def-boot-var $top_stack "???") +(def-boot-var |$tracedModemap| "Interpreter>Trace.boot") +(def-boot-val |$traceDomains| t "enables domain tracing") +(def-boot-val |$TraceFlag| t "???") +(def-boot-var |$tracedSpadModemap| "Interpreter>Trace.boot") +(def-boot-var |$traceletFunctions| "???") +(def-boot-var |$traceNoisely| "Interpreter>Trace.boot") +(def-boot-var |$TranslateOnly| "???") +(def-boot-var |$tripleCache| "Compiler>Compiler.boot") +(def-boot-val |$true| ''T "???") +(def-boot-var $Type "???") (def-boot-val |$underDomainAlist| - '((|DistributedMultivariatePolynomial| . 2) - (|FactoredForm| . 1) - (|FactoredRing| . 1) - (|Gaussian| . 1) - (|List| . 1) - (|Matrix| . 1) - (|MultivariatePolynomial| . 2) - (|HomogeneousDistributedMultivariatePolynomial| . 2) - (|Polynomial| . 1) - (|QuotientField| . 1) - (|RectangularMatrix| . 3) - (|SquareMatrix| . 2) - (|UnivariatePoly| . 2) - (|Vector| . 1) - (|VVectorSpace| . 2)) "???") - -(def-boot-val |$updateCatTableIfTrue| T "update category table on load") + '((|DistributedMultivariatePolynomial| . 2) + (|FactoredForm| . 1) + (|FactoredRing| . 1) + (|Gaussian| . 1) + (|List| . 1) + (|Matrix| . 1) + (|MultivariatePolynomial| . 2) + (|HomogeneousDistributedMultivariatePolynomial| . 2) + (|Polynomial| . 1) + (|QuotientField| . 1) + (|RectangularMatrix| . 3) + (|SquareMatrix| . 2) + (|UnivariatePoly| . 2) + (|Vector| . 1) + (|VVectorSpace| . 2)) "???") + +(def-boot-val |$updateCatTableIfTrue| T "update category table on load") (def-boot-var |$updateIfTrue| - "Should SPAD databases be updated&squeezed?") + "Should SPAD databases be updated&squeezed?") (def-boot-val |$useBFasDefault| T - "Determines whether to use BF as default floating point type.") + "Determines whether to use BF as default floating point type.") (def-boot-val |$useDCQnotLET| () "checked in DEF-LET for use of DCQ") -(def-boot-fun BUMPCOMPERRORCOUNT () "errorSupervisor1") -(def-boot-var |$VariableCount| "???") +(def-boot-fun BUMPCOMPERRORCOUNT () "errorSupervisor1") +(def-boot-var |$VariableCount| "???") (def-boot-val |$Void| '(|Void|) "compiler constant") -(def-boot-var |$warningStack| "???") +(def-boot-var |$warningStack| "???") (def-boot-val |$whereList| () "referenced in format boot formDecl2String") -(def-boot-var |$xCount| "???") -(def-boot-var |$xyCurrent| "???") -(def-boot-var |$xyInitial| "???") -(def-boot-var |$xyMax| "???") -(def-boot-var |$xyMin| "???") -(def-boot-var |$xyStack| "???") -(def-boot-val |$Zero| '(|Zero|) "???") +(def-boot-var |$xCount| "???") +(def-boot-var |$xyCurrent| "???") +(def-boot-var |$xyInitial| "???") +(def-boot-var |$xyMax| "???") +(def-boot-var |$xyMin| "???") +(def-boot-var |$xyStack| "???") +(def-boot-val |$Zero| '(|Zero|) "???") (def-boot-val |$domainsWithUnderDomains| - (mapcar #'car |$underDomainAlist|) "???") + (mapcar #'car |$underDomainAlist|) "???") (def-boot-val |$inputPromptType| '|step| "checked in MKPROMPT") -(def-boot-val |$IOindex| 0 "step counter") +(def-boot-val |$IOindex| 0 "step counter") (defvar |$compilingMap| ()) (defvar |$definingMap| nil) @@ -2528,17 +2528,17 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (defmacro boot-equal (a b) (cond ((ident-char-lit a) `(or (eql ,a ,b) (eql (character ,a) ,b))) - ((ident-char-lit b) + ((ident-char-lit b) `(or (eql ,a ,b) (eql ,a (character ,b)))) - (t `(eqqual ,a ,b)))) + (t `(eqqual ,a ,b)))) (defun ident-char-lit (x) (and (eqcar x 'quote) (identp (cadr x)) (= (length (pname (cadr x))) 1))) (defmacro EQQUAL (a b) (cond ((OR (EQUABLE a) (EQUABLE b)) `(eq ,a ,b)) - ((OR (numberp a) (numberp b)) `(eql ,a ,b)) - (t `(equal ,a ,b)))) + ((OR (numberp a) (numberp b)) `(eql ,a ,b)) + (t `(equal ,a ,b)))) (defmacro NEQUAL (a b) `(not (BOOT-EQUAL ,a ,b))) @@ -2767,13 +2767,13 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (COND ((SETQ tll (CDR tll)) (SETQ fun? (CAR tll)) (SETQ funIdent (CAR (SETQ tll (QCDR tll)))))) - (IF (NOT (ATOM (SETQ inc (CADDR U)) )) - (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL)) - (SETQ final (CADDDR U)) + (IF (NOT (ATOM (SETQ inc (CADDR U)) )) + (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL)) + (SETQ final (CADDDR U)) (COND (final - (COND ((ATOM final)) + (COND ((ATOM final)) ((PUSH (LIST (SETQ final (GENSYM)) (CADDDR U)) IL))) - ; If CADDDR U is not an atom, only compute the value once + ; If CADDDR U is not an atom, only compute the value once (PUSH (if fun? (if (FUNCALL fun? INC) @@ -2785,40 +2785,40 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (LIST 'FUNCALL funGT FINAL (CAR U)))) (LIST 'FUNCALL funGT (CAR U) final)) XCL))) - (PUSH (LIST (CAR U) (CADR U) (LIST 'FUNCALL funPLUS (CAR U) INC)) IL)) + (PUSH (LIST (CAR U) (CADR U) (LIST 'FUNCALL funPLUS (CAR U) INC)) IL)) (STEP - (IF (NOT (ATOM (SETQ inc (CADDR U)) )) - (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL)) - (COND ((CDDDR U) - (COND ((ATOM (SETQ final (CADDDR U)) )) - ((PUSH (LIST (SETQ final (GENSYM)) (CADDDR U)) IL))) - ; If CADDDR U is not an atom, only compute the value once - (PUSH - (if (INTEGERP INC) - (LIST (if (MINUSP INC) '< '>) (CAR U) FINAL) - `(if (MINUSP ,INC) - (< ,(CAR U) ,FINAL) - (> ,(CAR U) ,FINAL))) - XCL))) - (PUSH (LIST (CAR U) (CADR U) (LIST '+ (CAR U) INC)) IL)) + (IF (NOT (ATOM (SETQ inc (CADDR U)) )) + (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL)) + (COND ((CDDDR U) + (COND ((ATOM (SETQ final (CADDDR U)) )) + ((PUSH (LIST (SETQ final (GENSYM)) (CADDDR U)) IL))) + ; If CADDDR U is not an atom, only compute the value once + (PUSH + (if (INTEGERP INC) + (LIST (if (MINUSP INC) '< '>) (CAR U) FINAL) + `(if (MINUSP ,INC) + (< ,(CAR U) ,FINAL) + (> ,(CAR U) ,FINAL))) + XCL))) + (PUSH (LIST (CAR U) (CADR U) (LIST '+ (CAR U) INC)) IL)) (ISTEP - (IF (NOT (ATOM (SETQ inc (CADDR U)) )) - (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL)) + (IF (NOT (ATOM (SETQ inc (CADDR U)) )) + (PUSH (LIST (SETQ inc (GENSYM)) (CADDR U)) IL)) (COND ((CDDDR U) (COND ((ATOM (SETQ final (CADDDR U)) )) ((PUSH (LIST (SETQ final (GENSYM)) (CADDDR U)) IL))) ; If CADDDR U is not an atom, only compute the value once (PUSH - (if (INTEGERP INC) - (LIST (if (QSMINUSP INC) 'QSLESSP 'QSGREATERP) - (CAR U) FINAL) - `(if (QSMINUSP ,INC) - (QSLESSP ,(CAR U) ,FINAL) - (QSGREATERP ,(CAR U) ,FINAL))) + (if (INTEGERP INC) + (LIST (if (QSMINUSP INC) 'QSLESSP 'QSGREATERP) + (CAR U) FINAL) + `(if (QSMINUSP ,INC) + (QSLESSP ,(CAR U) ,FINAL) + (QSGREATERP ,(CAR U) ,FINAL))) XCL))) (PUSH (LIST (CAR U) (CADR U) (COND ((|member| INC '(1 (|One|))) - (MKQSADD1 (CAR U))) + (MKQSADD1 (CAR U))) ((LIST 'QSPLUS (CAR U) INC)) )) IL)) (ON (PUSH (LIST 'ATOM (CAR U)) XCL) @@ -2968,7 +2968,7 @@ LP (COND ((NULL X) (GO LP)) ((member (CAR Y) '(STEP ISTEP) :test #'eq) (if (AND (EQL (CADDR Y) 0) (EQL (CADDDR Y) 1)) - (SETQ COUNTER (CADR Y)) ) + (SETQ COUNTER (CADR Y)) ) (COND ((CDDDDR Y) ; there may not be a limit (SETQ CONDS (CONS (COND ((EQL 1 (CADDDR Y)) @@ -2987,7 +2987,7 @@ LP (COND ((NULL X) (defun MKQSADD1 (X) (COND ((ATOM X) `(QSADD1 ,X)) ((AND (member (CAR X) '(-DIFFERENCE QSDIFFERENCE -) :test #'eq) - (EQL 1 (CADDR X))) + (EQL 1 (CADDR X))) (CADR X)) (`(QSADD1 ,X)))) @@ -3068,7 +3068,7 @@ LP (COND ((NULL X) (defmacro qsaddmod (x y z) `(let* ((sum (qsplus ,x ,y)) - (rsum (qsdifference sum ,z))) + (rsum (qsdifference sum ,z))) (if (qsminusp rsum) sum rsum))) (defmacro qsdifmod (x y z) @@ -3130,8 +3130,8 @@ LP (COND ((NULL X) (defun |delete| (item sequence) (cond ((symbolp item) (remove item sequence :test #'eq)) - ((and (atom item) (not (arrayp item))) (remove item sequence)) - (T (remove item sequence :test #'equalp)))) + ((and (atom item) (not (arrayp item))) (remove item sequence)) + (T (remove item sequence :test #'equalp)))) (MAPC #'(LAMBDA (J) (MAKEPROP (CAR J) 'UNMACRO (CADR J))) '( (AND AND2) (OR OR2))) @@ -3333,7 +3333,7 @@ LP (COND ((NULL X) "Returns a list of the first N elements of list X." (COND ((EQL N 0) NIL) ((> N 0) (CONS (CAR X) (TAKE (1- N) (CDR X)))) - ((>= (setq m (+ (length x) N)) 0) (drop m x)) + ((>= (setq m (+ (length x) N)) 0) (drop m x)) ((CROAK (list "Bad args to DROP" N X))))) (DEFUN NUMOFNODES (X) (if (ATOM X) 0 (+ 1 (NUMOFNODES (CAR X)) (NUMOFNODES (CDR X))))) @@ -3385,7 +3385,7 @@ LP (COND ((NULL X) ; 15.5 Using Lists as Sets -@ +\end{chunk} \section{DEFUN CONTAINED} The CONTAINED predicate is used to walk internal structures such as modemaps to see if the $X$ object occurs within $Y$. One @@ -3394,7 +3394,7 @@ i-funsel.boot) to decide if a modemap is only partially complete. If this is true then the modemap will contain the constant \verb|$EmptyMode|. So the call ends up being CONTAINED \verb|$EmptyMode| Y. -<<*>>= +\begin{chunk}{*} (DEFUN CONTAINED (X Y) (if (symbolp x) (contained\,eq X Y) @@ -3500,7 +3500,7 @@ ends up being CONTAINED \verb|$EmptyMode| Y. ; 17.6 Changing the Dimensions of an Array -@ +\end{chunk} \section{Performance change} Camm has identified a performace problem during compiles. There is a loop that continually adds one element to a vector. This causes @@ -3522,8 +3522,8 @@ The original code was: (replace (make-array n) v))) \end{verbatim} -@ -<<*>>= +\end{chunk} +\begin{chunk}{*} (defun lengthenvec (v n) (if (and (array-has-fill-pointer-p v) (adjustable-array-p v)) @@ -3611,7 +3611,7 @@ The original code was: (defun |sayBrightly| (x &optional (out-stream *standard-output*)) (COND ((NULL X) NIL) - (|$sayBrightlyStream| (sayBrightly1 X |$sayBrightlyStream|)) + (|$sayBrightlyStream| (sayBrightly1 X |$sayBrightlyStream|)) ((IS-CONSOLE out-stream) (sayBrightly1 X out-stream)) ((sayBrightly1 X out-stream) (sayBrightly1 X *terminal-io*)))) @@ -3621,7 +3621,7 @@ The original code was: (defun |sayBrightlyNT| (x &optional (S *standard-output*)) (COND ((NULL X) NIL) - (|$sayBrightlyStream| (sayBrightlyNT1 X |$sayBrightlyStream|)) + (|$sayBrightlyStream| (sayBrightlyNT1 X |$sayBrightlyStream|)) ((IS-CONSOLE S) (sayBrightlyNT1 X S)) ((sayBrightly1 X S) (sayBrightlyNT1 X *terminal-io*)))) @@ -3658,7 +3658,7 @@ The original code was: (DEFUN BLANKS (N &optional (stream *standard-output*)) "Print N blanks." (do ((i 1 (the fixnum(1+ i)))) - ((> i N))(declare (fixnum i n)) (princ " " stream))) + ((> i N))(declare (fixnum i n)) (princ " " stream))) ; 23 FILE SYSTEM INTERFACE @@ -3666,8 +3666,8 @@ The original code was: (DEFUN DEFSTREAM (file MODE) (if (member mode '(i input)) - (MAKE-INSTREAM file) - (MAKE-OUTSTREAM file))) + (MAKE-INSTREAM file) + (MAKE-OUTSTREAM file))) ; 23.3 Renaming, Deleting and Other File Operations @@ -3719,8 +3719,8 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defun coerce-failure-msg (val mode) (STRCONC (MAKE-REASONABLE (STRINGIMAGE val)) - " cannot be coerced to mode " - (STRINGIMAGE (|devaluate| mode)))) + " cannot be coerced to mode " + (STRINGIMAGE (|devaluate| mode)))) (defmacro |check-subtype| (pred submode val) `(|assert| ,pred (coerce-failure-msg ,val ,submode))) @@ -3741,8 +3741,8 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defmacro |char| (arg) (cond ((stringp arg) (character arg)) ((integerp arg) (code-char arg)) - ((and (consp arg) (eq (car arg) 'quote)) (character (cadr arg))) - (t `(character ,arg)))) + ((and (consp arg) (eq (car arg) 'quote)) (character (cadr arg))) + (t `(character ,arg)))) ; # Gives the number of elements of a list, 0 for atoms. ; If we quote it, then an interpreter trip is necessary every time @@ -3793,7 +3793,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ((and (symbolp (car sexpr)) (macro-function (car sexpr))) (do () ((not (and (consp sexpr) (symbolp (car sexpr)) - (macro-function (car sexpr))))) + (macro-function (car sexpr))))) (setq sexpr (macroexpand sexpr))) (if (consp sexpr) (let ((a (car sexpr)) (b (caadr sexpr))) @@ -3801,7 +3801,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (cons a (list (cons b (mapcar #'macroexpandall (cdadr sexpr))))) (mapcar #'macroexpandall sexpr))) sexpr)) - ('else + ('else (mapcar #'macroexpandall sexpr)))) @@ -3883,10 +3883,10 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ;;(defun expand-tabs (str) ;; (let ((bpos (nonblankloc str)) -;; (tpos (indent-pos str))) +;; (tpos (indent-pos str))) ;; (if (eql bpos tpos) str ;; (concatenate 'string (make-string tpos :initial-element #\space) -;; (subseq str bpos))))) +;; (subseq str bpos))))) (defun expand-tabs (str) (if (and (stringp str) (> (length str) 0)) (let ((bpos (nonblankloc str)) @@ -3909,16 +3909,16 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ;; returns the cons of applying func to args and a string produced ;; from standard-output while executing. (let* ((*standard-output* (make-string-output-stream)) - (curoutstream *standard-output*) - (*terminal-io* *standard-output*) - (|$algebraOutputStream| *standard-output*) + (curoutstream *standard-output*) + (*terminal-io* *standard-output*) + (|$algebraOutputStream| *standard-output*) (erroroutstream *standard-output*) - val) + val) (declare (special *standard-output* curoutstream - *terminal-io* |$algebraOutputStream|)) + *terminal-io* |$algebraOutputStream|)) (setq val (catch 'spad_reader - (catch 'TOP_LEVEL - (apply (symbol-function func) args)))) + (catch 'TOP_LEVEL + (apply (symbol-function func) args)))) (cons val (get-output-stream-string *standard-output*)))) (defun |breakIntoLines| (str) @@ -3927,7 +3927,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (setq eol (position #\Newline str :start bol)) (if (null eol) (return)) (if (> eol bol) - (setq line-list (cons (subseq str bol eol) line-list))) + (setq line-list (cons (subseq str bol eol) line-list))) (setq bol (+ eol 1))) (nreverse line-list))) @@ -3939,8 +3939,8 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defmacro |try| (X) `(LET ((|$autoLine|)) - (declare (special |$autoLine|)) - (|tryToFit| (|saveState|) ,X))) + (declare (special |$autoLine|)) + (|tryToFit| (|saveState|) ,X))) (defmacro |embrace| (X) `(|wrapBraces| (|saveC|) ,X (|restoreC|))) (defmacro |indentNB| (X) `(|wrapBraces| (|saveD|) ,X (|restoreD|))) @@ -3955,7 +3955,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (setq state (|saveState| 't)) (or (LET ((|$autoLine|)) - (declare (special |$autoLine|)) + (declare (special |$autoLine|)) (and ,a (|formatRight| '|formatPreferPile| ,b ,c ,d))) (|restoreState| state) (and (eqcar ,b (quote seq)) @@ -3979,7 +3979,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (or (markhash ,b 0) (LET ((|$autoLine|)) - (declare (special |$autoLine|)) + (declare (special |$autoLine|)) (and ,a (|formatRight| '|formatPreferPile| ,b ,c ,d))) (|restoreState| state) (markhash ,b 1) @@ -4037,13 +4037,13 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defun |compQuietly| (fn) (let ((*comp370-apply* - (if |$InteractiveMode| - (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun) - #'print-defun)) + (if |$InteractiveMode| + (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun) + #'print-defun)) ;; following creates a null outputstream if $InteractiveMode - (*standard-output* - (if |$InteractiveMode| (make-broadcast-stream) - *standard-output*))) + (*standard-output* + (if |$InteractiveMode| (make-broadcast-stream) + *standard-output*))) (COMP fn))) ;; The following are used mainly in setvars.boot @@ -4066,26 +4066,26 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defun |compileQuietly| (fn) (let ((*comp370-apply* - (if |$InteractiveMode| - (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun) - #'print-defun)) + (if |$InteractiveMode| + (if |$compileDontDefineFunctions| #'compile-defun #'eval-defun) + #'print-defun)) ;; following creates a null outputstream if $InteractiveMode - (*standard-output* - (if |$InteractiveMode| (make-broadcast-stream) - *standard-output*))) + (*standard-output* + (if |$InteractiveMode| (make-broadcast-stream) + *standard-output*))) (COMP370 fn))) (defun COMP-1 (X) (let* ((FNAME (car X)) - ($FUNNAME FNAME) + ($FUNNAME FNAME) ($FUNNAMETAIL (LIST FNAME)) - (LAMEX (second X)) - ($closedfns nil)) + (LAMEX (second X)) + ($closedfns nil)) (declare (special $FUNNAME $FUNNAMETAIL $CLOSEDFNS)) (setq LAMEX (COMP-TRAN LAMEX)) (COMP-NEWNAM LAMEX) (if (fboundp FNAME) - (format t "~&~%;;; *** ~S REDEFINED~%" FNAME)) + (format t "~&~%;;; *** ~S REDEFINED~%" FNAME)) (CONS (LIST FNAME LAMEX) $CLOSEDFNS))) (defun Comp-2 (args &aux name type argl bodyl junk) @@ -4185,11 +4185,11 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ((ATOM (setq Y (CAR X))) ;; (AND (IDENTP Y) (setq U (GET Y 'NEWNAM)) (RPLACA X U)) (AND (NOT (eq Y 'QUOTE)) (COMP-NEWNAM (CDR X))) - (WHEN (and (EQ Y 'CLOSEDFN) (boundp '$closedfns)) - (SETQ U (MAKE-CLOSEDFN-NAME)) - (PUSH (list U (CADR X)) $closedfns) - (rplaca x 'FUNCTION) - (rplaca (cdr x) u))) + (WHEN (and (EQ Y 'CLOSEDFN) (boundp '$closedfns)) + (SETQ U (MAKE-CLOSEDFN-NAME)) + (PUSH (list U (CADR X)) $closedfns) + (rplaca x 'FUNCTION) + (rplaca (cdr x) u))) (t (COMP-NEWNAM (CAR X)) (COMP-NEWNAM (CDR X)))))) (defun make-closedfn-name () @@ -4203,7 +4203,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (if (and (null (cdddr x)) (or (atom (third x)) (eq (car (third x)) 'SEQ) - (not (contained 'EXIT (third x))))) + (not (contained 'EXIT (third x))))) (caddr x) (cons 'SEQ (cddr x))))) ;catch naked EXITs (let* ((FluidVars (REMDUP (NREVERSE FLUIDVARS))) @@ -4217,9 +4217,9 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (prog ,lvars (declare (special . ,fluids)) (return ,(third x)))) (list (first x) (second x) - (if (or lvars (contained 'RETURN (third x))) - `(prog ,lvars (return ,(third x))) - (third x)) ))))) + (if (or lvars (contained 'RETURN (third x))) + `(prog ,lvars (return ,(third x))) + (third x)) ))))) (let ((fluids (S+ (comp-fluidize (second x)) SpecialVars))) (if fluids `(,(first x) ,(second x) (declare (special . ,fluids)) . ,(cddr x)) @@ -4230,7 +4230,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (DEFUN COMP-FLUIDIZE (X) (COND ((AND (symbolp X) (NE X '$) - (NE X '$$) + (NE X '$$) (char= #\$ (ELT (PNAME X) 0)) (NOT (DIGITP (ELT (PNAME X) 1)))) x) @@ -4260,7 +4260,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defparameter $COMP-MACROLIST '(COLLECT REPEAT SUCHTHATCLAUSE THETA COLLECTV COLLECTVEC - THETA1 SPADREDUCE SPADDO) + THETA1 SPADREDUCE SPADDO) "???") (DEFUN COMP-EXPAND (X) @@ -4345,8 +4345,8 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (defmacro |trapNumericErrors| (form) `(let ((|$oldBreakMode| |$BreakMode|) - (|$BreakMode| '|trapNumerics|) - (val)) + (|$BreakMode| '|trapNumerics|) + (val)) (setq val (catch '|trapNumerics| ,form)) (if (eq val |$numericFailure|) val (cons 0 val)))) @@ -4388,7 +4388,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size -;;; @(#)debug.lisp 2.5 90/02/15 10:27:33 +;;; @(#)debug.lisp 2.5 90/02/15 10:27:33 ; NAME: Debugging Package ; PURPOSE: Debugging hooks for Boot code @@ -4413,7 +4413,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (MAKEPROP 'SPAD '/READFUN '|New,LEXPR|) (defmacro |/C,LIB| (&rest L &aux optionlist /editfile - ($prettyprint 't) ($reportCompilation 't)) + ($prettyprint 't) ($reportCompilation 't)) (declare (special optionlist /editfile $prettyprint $reportComilation)) `',(|compileConstructorLib| L (/COMP) NIL NIL)) @@ -4440,7 +4440,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (SETQ OUTSTREAM (if TO (DEFSTREAM TO 'OUTPUT) CUROUTSTREAM)) (RETURN (mapcar #'(lambda (fn) (/D-2 FN INFILE OUTSTREAM OP EFLG TFLG)) - (or fnl (list /fn))))))) + (or fnl (list /fn))))))) (DEFUN |/D,2,LIB| (FN INFILE CUROUTSTREAM OP EDITFLAG TRACEFLAG) (declare (special CUROUTSTREAM)) @@ -4450,38 +4450,38 @@ 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 - SINGLINEMODE 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 SINGLINEMODE XTOKENREADER INPUTSTREAM - SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK /SOURCEFILES - METAKEYLST DEFINITION-NAME |$sourceFileTypes| - $FUNCTION $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK - |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE)) + SINGLINEMODE 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 SINGLINEMODE XTOKENREADER INPUTSTREAM + SPADERRORSTREAM ISID NBLNK COMMENTCHR $TOKSTACK /SOURCEFILES + METAKEYLST DEFINITION-NAME |$sourceFileTypes| + $FUNCTION $BOOT $NEWSPAD $LINESTACK $LINENUMBER STACK STACKX BACK OK + |$InteractiveMode| TOK COUNT ERRCOL COLUMN *QUERY CHR LINE)) (if (PAIRP FN) (SETQ FN (QCAR FN))) (SETQ INFILE (OR INFILE (|getFunctionSourceFile| FN))) - ;; $FUNCTION is freely set in getFunctionSourceFile - (IF (PAIRP $FUNCTION) (SETQ $FUNCTION (QCAR $FUNCTION))) + ;; $FUNCTION is freely set in getFunctionSourceFile + (IF (PAIRP $FUNCTION) (SETQ $FUNCTION (QCAR $FUNCTION))) (SETQ FN $FUNCTION) (SETQ /FN $FUNCTION) LOOP (SETQ SOURCEFILES (cond ( INFILE - (SETQ /SOURCEFILES (CONS INFILE (REMOVE INFILE /SOURCEFILES))) - (LIST INFILE)) - ( /EDITFILE - (|insert| (|pathname| /EDITFILE) /SOURCEFILES)) - ( 't /SOURCEFILES))) + (SETQ /SOURCEFILES (CONS INFILE (REMOVE INFILE /SOURCEFILES))) + (LIST INFILE)) + ( /EDITFILE + (|insert| (|pathname| /EDITFILE) /SOURCEFILES)) + ( 't /SOURCEFILES))) (SETQ RECNO (dolist (file sourcefiles) (SETQ INPUTSTREAM (DEFSTREAM FILE 'INPUT)) ;;?(REMFLAG S-SPADKEY 'KEY) ; hack !! - (SETQ FT (|pathnameType| FILE)) - (SETQ oft (|object2Identifier| (UPCASE FT))) - (SETQ XCAPE #\_) + (SETQ FT (|pathnameType| FILE)) + (SETQ oft (|object2Identifier| (UPCASE FT))) + (SETQ XCAPE #\_) (SETQ COMMENTCHR (GET oft '/COMMENTCHR)) (SETQ XTOKENREADER (OR (GET oft '/NXTTOK) 'METATOK)) (SETQ DEFINITION-NAME FN) @@ -4494,7 +4494,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (PNAME FN))) (SETQ SFN (GET oFT '/READFUN)) (SETQ RECNO (/LOCATE FN KEY FILE 0)) - (SHUT INPUTSTREAM) + (SHUT INPUTSTREAM) (cond ((NUMBERP RECNO) (SETQ /SOURCEFILES (CONS FILE (REMOVE FILE /SOURCEFILES))) (SETQ INFILE FILE) @@ -4503,9 +4503,9 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (if (SETQ INFILE (/MKINFILENAM '(NIL))) (GO LOOP) (UNWIND))) (TERPRI) (TERPRI) - (SETQ INFILE (|pathname| INFILE)) - (COND - ( EDITFLAG + (SETQ INFILE (|pathname| INFILE)) + (COND + ( EDITFLAG ;;%% next form is used because $FINDFILE seems to screw up ;;%% sometimes. The stream is opened and closed several times ;;%% in case the filemode has changed during editing. @@ -4521,78 +4521,78 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (STRINGIMAGE $LINENUMBER))) (SHUT INPUTSTREAM) ;(COND - ; ( (EQ (READ ERRORINSTREAM) 'ABORTPROCESS) - ; (RETURN 'ABORT) ) ) + ; ( (EQ (READ ERRORINSTREAM) 'ABORTPROCESS) + ; (RETURN 'ABORT) ) ) ;;%% next is done in case the diskmode changed ;;(SETQ INFILE (|pathname| (IFCAR - ;; (QSORT ($LISTFILE INFILE))))) + ;; (QSORT ($LISTFILE INFILE))))) (SETQ INPUTSTREAM (DEFSTREAM INFILE 'INPUT)) (SETQ RECNO (/LOCATE FN KEY INFILE RECNO)) - - (COND ((NOT RECNO) - (|sayBrightly| (LIST " Warning: function" "%b" /FN "%d" - "was not found in the file" "%l" " " "%b" - (|namestring| INFILE) "%d" "after editing.")) - (RETURN NIL))) - ;; next is done in case the diskmode changed - (SHUT INPUTSTREAM) )) - ;;(SETQ INFILE (|pathname| (IFCAR ($LISTFILE INFILE)))) - (SETQ INFILE (boot::makeInputFilename INFILE)) - (MAKEPROP /FN 'DEFLOC - (CONS RECNO INFILE)) - (SETQ oft (|object2Identifier| (UPCASE (|pathnameType| INFILE)))) - (COND - ( (NULL OP) - (RETURN /FN) ) ) - (COND - ( (EQ TRACEFLAG 'TRACELET) - (RETURN (/TRACELET-1 (LIST FN) NIL)) ) ) - (SETQ INPUTSTREAM (DEFSTREAM INFILE 'INPUT)) - (|sayBrightly| - (LIST " Reading file" '|%b| (|namestring| INFILE) '|%d|)) - (TERPRI) - (SETQ $BOOT (EQ oft 'BOOT)) - (SETQ $NEWSPAD (OR $BOOT (EQ oft 'SPAD))) - (SETQ DEF - (COND - ( SFN - ;(+VOL 'METABASE) - (POINT RECNO INPUTSTREAM) - ;(SETQ CHR (CAR INPUTSTREAM)) - ;(SETQ ERRCOL 0) - ;(SETQ COUNT 0) - ;(SETQ COLUMN 0) - (SETQ OK 'T) - ;(NXTTOK) - ;(SETQ LINE (CURINPUTLINE)) - ;(SETQ SPADERRORSTREAM CUROUTSTREAM) - ;(SFN) - (SETQ DEF (BOOT-PARSE-1 INPUTSTREAM)) - (SETQ DEBUGMODE 'YES) - (COND - ( (NULL OK) - (FUNCALL (GET oft 'SYNTAX_ERROR)) - NIL ) - ( 'T - DEF ) ) ) - ( 'T - (let* ((mode-line (read-line inputstream)) - (pacpos (search "package:" mode-line :test #'equalp)) - (endpos (search "-*-" mode-line :from-end t)) - (*package* *package*) - (newpac nil)) - (when pacpos - (setq newpac (read-from-string mode-line nil nil - :start (+ pacpos 8) - :end endpos)) - (setq *package* - (cond ((find-package newpac)) - (t *package*)))) - (POINT RECNO INPUTSTREAM) - (READ INPUTSTREAM))))) - (COND - ( (SETQ U (GET oft '/TRAN)) - (SETQ DEF (FUNCALL U DEF)) ) ) + + (COND ((NOT RECNO) + (|sayBrightly| (LIST " Warning: function" "%b" /FN "%d" + "was not found in the file" "%l" " " "%b" + (|namestring| INFILE) "%d" "after editing.")) + (RETURN NIL))) + ;; next is done in case the diskmode changed + (SHUT INPUTSTREAM) )) + ;;(SETQ INFILE (|pathname| (IFCAR ($LISTFILE INFILE)))) + (SETQ INFILE (boot::makeInputFilename INFILE)) + (MAKEPROP /FN 'DEFLOC + (CONS RECNO INFILE)) + (SETQ oft (|object2Identifier| (UPCASE (|pathnameType| INFILE)))) + (COND + ( (NULL OP) + (RETURN /FN) ) ) + (COND + ( (EQ TRACEFLAG 'TRACELET) + (RETURN (/TRACELET-1 (LIST FN) NIL)) ) ) + (SETQ INPUTSTREAM (DEFSTREAM INFILE 'INPUT)) + (|sayBrightly| + (LIST " Reading file" '|%b| (|namestring| INFILE) '|%d|)) + (TERPRI) + (SETQ $BOOT (EQ oft 'BOOT)) + (SETQ $NEWSPAD (OR $BOOT (EQ oft 'SPAD))) + (SETQ DEF + (COND + ( SFN + ;(+VOL 'METABASE) + (POINT RECNO INPUTSTREAM) + ;(SETQ CHR (CAR INPUTSTREAM)) + ;(SETQ ERRCOL 0) + ;(SETQ COUNT 0) + ;(SETQ COLUMN 0) + (SETQ OK 'T) + ;(NXTTOK) + ;(SETQ LINE (CURINPUTLINE)) + ;(SETQ SPADERRORSTREAM CUROUTSTREAM) + ;(SFN) + (SETQ DEF (BOOT-PARSE-1 INPUTSTREAM)) + (SETQ DEBUGMODE 'YES) + (COND + ( (NULL OK) + (FUNCALL (GET oft 'SYNTAX_ERROR)) + NIL ) + ( 'T + DEF ) ) ) + ( 'T + (let* ((mode-line (read-line inputstream)) + (pacpos (search "package:" mode-line :test #'equalp)) + (endpos (search "-*-" mode-line :from-end t)) + (*package* *package*) + (newpac nil)) + (when pacpos + (setq newpac (read-from-string mode-line nil nil + :start (+ pacpos 8) + :end endpos)) + (setq *package* + (cond ((find-package newpac)) + (t *package*)))) + (POINT RECNO INPUTSTREAM) + (READ INPUTSTREAM))))) + (COND + ( (SETQ U (GET oft '/TRAN)) + (SETQ DEF (FUNCALL U DEF)) ) ) (/WRITEUPDATE /FN (|pathnameName| INFILE) @@ -4605,8 +4605,8 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (PRETTYPRINT DEF OUTPUTSTREAM) ) ) (COND ( (EQ oft 'LISP) - (if (EQ OP 'DEFINE) (EVAL DEF) - (compile (EVAL DEF)))) + (if (EQ OP 'DEFINE) (EVAL DEF) + (compile (EVAL DEF)))) ( DEF (FUNCALL OP (LIST DEF)) ) ) (COND @@ -4626,37 +4626,37 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (if (AND (NOT (eq 'FROMWRITEUPDATE (|pathnameName| INFILE))) (NOT (boot::makeInputFilename INFILE))) (RETURN NIL)) - (SETQ FT (UPCASE (|object2Identifier| (|pathnameType| INFILE)))) + (SETQ FT (UPCASE (|object2Identifier| (|pathnameType| INFILE)))) (SETQ KEYLENGTH (STRINGLENGTH KEY)) - (WHEN (> INITRECNO 1) ;; we think we know where it is - (POINT INITRECNO INPUTSTREAM) - (SETQ LN (READ-LINE INPUTSTREAM NIL NIL)) - (IF (AND LN (MATCH-FUNCTION-DEF FN KEY KEYLENGTH LN FT)) - (RETURN INITRECNO))) - (SETQ $LINENUMBER 0) - (POINT 0 INPUTSTREAM) + (WHEN (> INITRECNO 1) ;; we think we know where it is + (POINT INITRECNO INPUTSTREAM) + (SETQ LN (READ-LINE INPUTSTREAM NIL NIL)) + (IF (AND LN (MATCH-FUNCTION-DEF FN KEY KEYLENGTH LN FT)) + (RETURN INITRECNO))) + (SETQ $LINENUMBER 0) + (POINT 0 INPUTSTREAM) EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) - (SETQ LN (READ-LINE INPUTSTREAM NIL NIL)) - (INCF $LINENUMBER) - (if (NULL LN) (RETURN NIL)) - (IF (MATCH-FUNCTION-DEF FN KEY KEYLENGTH LN FT) - (RETURN RECNO)) + (SETQ LN (READ-LINE INPUTSTREAM NIL NIL)) + (INCF $LINENUMBER) + (if (NULL LN) (RETURN NIL)) + (IF (MATCH-FUNCTION-DEF FN KEY KEYLENGTH LN FT) + (RETURN RECNO)) (GO EXAMINE))) (DEFUN MATCH-FUNCTION-DEF (fn key keylength line type) (if (eq type 'LISP) (match-lisp-tag fn line "(def") - (let ((n (mismatch key line))) - (and (= n keylength) - (or (= n (length line)) - (member (elt line n) - (or (get type '/termchr) '(#\space )))))))) + (let ((n (mismatch key line))) + (and (= n keylength) + (or (= n (length line)) + (member (elt line n) + (or (get type '/termchr) '(#\space )))))))) (define-function '|/D,1| #'/D-1) (DEFUN /INITUPDATES (/VERSION) (SETQ FILENAME (STRINGIMAGE /VERSION)) (SETQ /UPDATESTREAM (open (strconc "/tmp/update." FILENAME) :direction :output - :if-exists :append :if-does-not-exist :create)) + :if-exists :append :if-does-not-exist :create)) (PRINTEXP " Function Name Filename Date Time" /UPDATESTREAM) @@ -4668,7 +4668,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (defun /UPDATE (&rest ARGS) (LET (( FILENAME (OR (KAR ARGS) - (strconc "/tmp/update." (STRINGIMAGE /VERSION)))) + (strconc "/tmp/update." (STRINGIMAGE /VERSION)))) (|$createUpdateFiles| NIL)) (DECLARE (SPECIAL |$createUpdateFiles|)) (CATCH 'FILENAM (/UPDATE-1 FILENAME '(/COMP))) @@ -4676,7 +4676,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (defun /DUPDATE (&rest ARGS) (LET (( FILENAME (OR (KAR ARGS) - (strconc "/tmp/update." (STRINGIMAGE /VERSION)))) + (strconc "/tmp/update." (STRINGIMAGE /VERSION)))) (|$createUpdateFiles| NIL)) (DECLARE (SPECIAL |$createUpdateFiles|)) (CATCH 'FILENAM (/UPDATE-1 FILENAME 'DEFINE)) @@ -4715,7 +4715,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) ; ((SAY "A disk is not read-write. Update file not modified") ; (RETURN NIL))) (if (OR (NOT (BOUNDP '/UPDATESTREAM)) - (NOT (STREAMP /UPDATESTREAM))) + (NOT (STREAMP /UPDATESTREAM))) (/INITUPDATES /VERSION)) ; (SETQ IFT (INTERN (STRINGIMAGE /VERSION))) ; (SETQ INPUTSTREAM (open (strconc IFT /WSNAME) :direction :input)) @@ -4733,32 +4733,32 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) ; (COND ((NUMBERP RECNO) ; (SETQ ORECNO (NOTE /UPDATESTREAM)) ; (POINTW RECNO /UPDATESTREAM) )) - (SETQ DATETIME (|getDateAndTime|)) - (SETQ DATE (CAR DATETIME)) - (SETQ TIME (CDR DATETIME)) + (SETQ DATETIME (|getDateAndTime|)) + (SETQ DATE (CAR DATETIME)) + (SETQ TIME (CDR DATETIME)) (PRINTEXP (STRCONC (COND ((NOT FUN) " QUAD ") ((STRINGPAD (PNAME FUN) 28))) " " - (STRINGIMAGE FM) - (STRINGIMAGE FN) "." (STRINGIMAGE FT) + (STRINGIMAGE FM) + (STRINGIMAGE FN) "." (STRINGIMAGE FT) " " DATE " " TIME) /UPDATESTREAM) (TERPRI /UPDATESTREAM) ; (if (NUMBERP RECNO) (POINTW ORECNO /UPDATESTREAM)) - )) + )) (defun |getDateAndTime| () (MULTIPLE-VALUE-BIND (sec min hour day mon year) (get-decoded-time) (CONS (STRCONC (LENGTH2STR mon) "/" - (LENGTH2STR day) "/" - (LENGTH2STR year) ) - (STRCONC (LENGTH2STR hour) ":" - (LENGTH2STR min))))) + (LENGTH2STR day) "/" + (LENGTH2STR year) ) + (STRCONC (LENGTH2STR hour) ":" + (LENGTH2STR min))))) (DEFUN LENGTH2STR (X &aux XLEN) (cond ( (= 1 (SETQ XLEN (LENGTH (SETQ X (STRINGIMAGE X))))) (STRCONC "0" X)) - ( (= 2 XLEN) X) - ( (subseq x (- XLEN 2))))) + ( (= 2 XLEN) X) + ( (subseq x (- XLEN 2))))) (defmacro /T (&rest L) (CONS '/TRACE (OR L (LIST /FN)))) @@ -4819,8 +4819,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (T (|sayBrightly| (format nil "~A is not a function" FN)))) (RETURN NIL))) (if (and (symbolp fn) (boundp FN) - (|isDomainOrPackage| (SETQ FNVAL (EVAL FN)))) - (RETURN (|spadTrace| FNVAL OPTIONS))) + (|isDomainOrPackage| (SETQ FNVAL (EVAL FN)))) + (RETURN (|spadTrace| FNVAL OPTIONS))) (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'MASK=)) (MAKEPROP FN '/TRANSFORM (CADR U))) (SETQ /TRACENAMES @@ -4871,7 +4871,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (SETQ COUNT_CONDITION (COND ((SETQ U (/GETTRACEOPTIONS OPTIONS 'COUNT)) (SETQ /COUNTLIST (adjoin TRACENAME /COUNTLIST - :test 'equal)) + :test 'equal)) (if (AND (CDR U) (integerp (CADR U))) `(cond ((<= ,COUNTNAM ,(CADR U)) t) (t (/UNTRACE-2 ,(MKQ FN) NIL) NIL)) @@ -4883,8 +4883,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (SETQ DEPTH_CONDITION (if (SETQ U (/GETTRACEOPTIONS OPTIONS 'DEPTH)) (if (AND (CDR U) (integerp (CADR U))) - (LIST 'LE 'FUNDEPTH (CADR U)) - (TRACE_OPTION_ERROR 'DEPTH)) + (LIST 'LE 'FUNDEPTH (CADR U)) + (TRACE_OPTION_ERROR 'DEPTH)) T)) (SETQ CONDITION (MKPF @@ -4977,17 +4977,17 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (|untraceDomainConstructor| X)) ((OR (|isDomainOrPackage| (SETQ U X)) (and (symbolp X) (boundp X) - (|isDomain| (SETQ U (EVAL X))))) + (|isDomain| (SETQ U (EVAL X))))) (|spadUntrace| U OPTIONS)) ((EQCAR OPTIONS 'ALIAS) (if |$traceNoisely| (|sayBrightly| (LIST '|%b| (CADR OPTIONS) '|%d| '**untraced))) (SETQ /TIMERLIST - (REMOVE (STRINGIMAGE (CADR OPTIONS)) /TIMERLIST :test 'equal)) + (REMOVE (STRINGIMAGE (CADR OPTIONS)) /TIMERLIST :test 'equal)) (SETQ /COUNTLIST - (REMOVE (STRINGIMAGE (CADR OPTIONS)) /COUNTLIST :test 'equal)) + (REMOVE (STRINGIMAGE (CADR OPTIONS)) /COUNTLIST :test 'equal)) (SETQ |$mathTraceList| - (REMOVE (CADR OPTIONS) |$mathTraceList| :test 'equal)) + (REMOVE (CADR OPTIONS) |$mathTraceList| :test 'equal)) (UNEMBED X)) ((AND (NOT (MEMBER X /TRACENAMES)) (NOT (|isSubForRedundantMapName| X))) @@ -5020,16 +5020,16 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (COND ((setq U (GET NAME '/TRANSFORM)) (COND ((EQCAR U '&) - (PRINC "//" CURSTRM) (PRIN1 VAL CURSTRM) (TERPRI CURSTRM)) - (T (PRINC "! " CURSTRM) - (PRIN1 (EVAL (SUBST (MKQ VAL) '* (CAR U))) CURSTRM) - (TERPRI CURSTRM)) )) + (PRINC "//" CURSTRM) (PRIN1 VAL CURSTRM) (TERPRI CURSTRM)) + (T (PRINC "! " CURSTRM) + (PRIN1 (EVAL (SUBST (MKQ VAL) '* (CAR U))) CURSTRM) + (TERPRI CURSTRM)) )) (T - (PRINC ": " CURSTRM) + (PRINC ": " CURSTRM) (COND ((NOT (SMALL-ENOUGH VAL)) (|F,PRINT-ONE| VAL CURSTRM)) (/PRETTY (PRETTYPRINT VAL CURSTRM)) (T (COND (|$mathTrace| (TERPRI))) - (PRINMATHOR0 VAL CURSTRM))))))) + (PRINMATHOR0 VAL CURSTRM))))))) (DEFUN MONITOR-BLANKS (N) (PRINC (MAKE-FULL-CVEC N " ") CURSTRM)) @@ -5080,7 +5080,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (mapcar #'(lambda (x y) (COND ((EQ Y '*) - (PRINC "\\ " CURSTRM) + (PRINC "\\ " CURSTRM) (MONITOR-PRINT X CURSTRM)) ((EQ Y '&) (PRINC "\\\\" CURSTRM) @@ -5088,18 +5088,18 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (PRINT X CURSTRM)) ((NOT Y) (PRINC "! " CURSTRM)) (T - (PRINC "! " CURSTRM) + (PRINC "! " CURSTRM) (MONITOR-PRINT (EVAL (SUBST (MKQ X) '* Y)) CURSTRM)))) - L (cdr /transform))) - (T (PRINC ": " CURSTRM) + L (cdr /transform))) + (T (PRINC ": " CURSTRM) (COND ((NOT (ATOM L)) (if |$mathTrace| (TERPRI CURSTRM)) (MONITOR-PRINT (CAR L) CURSTRM) (SETQ L (CDR L)))) (mapcar #'monitor-printrest L)))) ((do ((istep 2 (+ istep 1)) (k (maxindex code))) - ((> istep k) nil) + ((> istep k) nil) (when (not (= 0 (SETQ N (digit-char-p (elt CODE ISTEP))))) (PRINC "\\" CURSTRM) (PRINMATHOR0 N CURSTRM) @@ -5279,9 +5279,9 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (/DEPTH (if (and (BOUNDP '/DEPTH) (numberp /depth)) (1+ /DEPTH) 1)) (|depthAlist| (if (BOUNDP '|depthAlist|) (COPY-TREE |depthAlist|) NIL)) FUNDEPTH NAMEID YES (|$tracedSpadModemap| TRACEDMODEMAP) (|$mathTrace| NIL) - /caller /name /value /breakcondition curdepth) + /caller /name /value /breakcondition curdepth) (declare (special curstrm /depth fundepth |$tracedSpadModemap| |$mathTrace| - /caller /name /value /breakcondition |depthAlist|)) + /caller /name /value /breakcondition |depthAlist|)) (SETQ /NAME NAME) (SETQ NAME1 (PNAME (|rassocSub| (INTERN NAME) |$mapSubNameAlist|))) (SETQ /BREAKCONDITION BREAKCONDITION) @@ -5435,15 +5435,15 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM)) (defun lisp-break-from-axiom (&rest ignore) (boot::|handleLispBreakLoop| boot::|$BreakMode|)) -@ +\end{chunk} \subsection{interrupt} A "resumable" break loop for use in trace etc. Unfortunately this only works for CCL. We need to define a Common Lisp version. For now the function is defined but does nothing. -<<*>>= +\begin{chunk}{*} (defun interrupt (&rest ignore)) -; NAME: Scratchpad Package +; NAME: Scratchpad Package ; PURPOSE: This is an initialization and system-building file for Scratchpad. ;;; Common Block @@ -5510,7 +5510,7 @@ now the function is defined but does nothing. (defvar |New-LEXPR|) ;************************************************************************ -; SYSTEM COMMANDS +; SYSTEM COMMANDS ;************************************************************************ (defmacro |DomainSubstitutionMacro| (&rest L) @@ -5529,14 +5529,14 @@ now the function is defined but does nothing. (defun |process| (x) (COND ((NOT (EQ TOK 'END_UNIT)) - (SETQ DEBUGMODE 'NO) - (SPAD-SYNTAX-ERROR) - (if |$InteractiveMode| (|spadThrow|)) - (S-PROCESS x)))) + (SETQ DEBUGMODE 'NO) + (SPAD-SYNTAX-ERROR) + (if |$InteractiveMode| (|spadThrow|)) + (S-PROCESS x)))) -@ -<<*>>= +\end{chunk} +\begin{chunk}{*} (setq *PROMPT* 'LISP) @@ -5546,8 +5546,8 @@ now the function is defined but does nothing. (defmacro try (X) `(LET ((|$autoLine|)) - (declare (special |$autoLine|)) - (|tryToFit| (|saveState|) ,X))) + (declare (special |$autoLine|)) + (|tryToFit| (|saveState|) ,X))) (defun GLESSEQP (X Y) (NOT (GGREATERP X Y))) @@ -5558,18 +5558,18 @@ now the function is defined but does nothing. (cond ((EQCAR (SETQ A (CAR L)) 'ELT) (COND ((AND (INTEGERP (SETQ B (CADDR A))) (>= B 0)) - (SETQ S "CA") - (do ((i 1 (1+ i))) ((> i b)) (SETQ S (STRCONC S "D"))) - (LIST 'RPLAC (LIST (INTERN (STRCONC S "R")) (CADR A)) (CADR L))) - ((ERROR "rplac")))) + (SETQ S "CA") + (do ((i 1 (1+ i))) ((> i b)) (SETQ S (STRCONC S "D"))) + (LIST 'RPLAC (LIST (INTERN (STRCONC S "R")) (CADR A)) (CADR L))) + ((ERROR "rplac")))) ((PROGN - (SETQ A (CARCDREXPAND (CAR L) NIL)) - (SETQ B (CADR L)) - (COND - ((CDDR L) (ERROR 'RPLAC)) - ((EQCAR A 'CAR) (LIST 'RPLACA (CADR A) B)) - ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B)) - ((ERROR 'RPLAC)))))))) + (SETQ A (CARCDREXPAND (CAR L) NIL)) + (SETQ B (CADR L)) + (COND + ((CDDR L) (ERROR 'RPLAC)) + ((EQCAR A 'CAR) (LIST 'RPLACA (CADR A) B)) + ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B)) + ((ERROR 'RPLAC)))))))) ; **** X. Random tables @@ -5615,7 +5615,7 @@ now the function is defined but does nothing. (SETQ |$compileOnlyCertainItems| NIL) (SETQ |$devaluateList| NIL) (SETQ |$doNotCompressHashTableIfTrue| NIL) -(SETQ |$mutableDomains| NIL) ; checked in DEFINE BOOT +(SETQ |$mutableDomains| NIL) ; checked in DEFINE BOOT (SETQ |$maxSignatureLineNumber| 0) (SETQ |$functionLocations| NIL) (SETQ |$functorLocalParameters| NIL) ; used in compSymbol @@ -5635,12 +5635,12 @@ now the function is defined but does nothing. (SETQ |$useCoerceOrCroak| T) ; this is always true everywhere (SETQ |$InterpreterMacroAlist| '((|%i| . (|complex| 0 1)) - (|%e| . (|exp| 1)) - (|%pi| . (|pi|)) - (|SF| . (|DoubleFloat|)) - (|%infinity| . (|infinity|)) - (|%plusInfinity| . (|plusInfinity|)) - (|%minusInfinity| . (|minusInfinity|)))) + (|%e| . (|exp| 1)) + (|%pi| . (|pi|)) + (|SF| . (|DoubleFloat|)) + (|%infinity| . (|infinity|)) + (|%plusInfinity| . (|plusInfinity|)) + (|%minusInfinity| . (|minusInfinity|)))) ;; These are for the output routines in OUT BOOT @@ -5670,7 +5670,7 @@ now the function is defined but does nothing. (SETQ $LISPLIB NIL) -(SETQ |$dependeeClosureAlist| NIL) +(SETQ |$dependeeClosureAlist| NIL) (SETQ |$userModemaps| NIL) (SETQ |$forceDatabaseUpdate| NIL) ;; see "load" function (SETQ |$functorForm| NIL) @@ -5695,7 +5695,7 @@ now the function is defined but does nothing. (|hasFileProperty| |hash| UEQUAL |count|) (|isLegitimateMode| |hash| UEQUAL |count|) (|isValidType| |hash| UEQUAL |count|) - (|resolveTT| |hash| UEQUAL |count|) + (|resolveTT| |hash| UEQUAL |count|) (|selectMms1| |hash| UEQUAL |count|) (|underDomainOf| |hash| UEQUAL |count|) )) @@ -5737,32 +5737,32 @@ now the function is defined but does nothing. CAPSULE |Union| |Record| |SubDomain| |Mapping| |Enumeration| |Domain| |Mode|)) (SETQ |$letAssoc| NIL) - ;" used for trace of assignments in SPAD code -- see macro LETT" + ;" used for trace of assignments in SPAD code -- see macro LETT" (SETQ |$QuickCode| T) - ;" controls generation of QREFELT etc." + ;" controls generation of QREFELT etc." (SETQ |$QuickLet| T) - ;" controls generation of LET tracing." + ;" controls generation of LET tracing." (SETQ |$lastUntraced| NIL) ;" used for )restore option of )trace." (SETQ |$mathTraceList| NIL) - ;" controls mathprint output for )trace." + ;" controls mathprint output for )trace." (SETQ |$domainTraceNameAssoc| NIL) - ;"alist of traced domains" + ;"alist of traced domains" (SETQ |$tracedMapSignatures| ()) (SETQ |$highlightAllowed| 'T) - ;" used in BRIGHTPRINT and is a )set variable" + ;" used in BRIGHTPRINT and is a )set variable" (SETQ |$abbreviationTable| NIL) (SETQ |$ConstructorNames| '( |SubDomain| |List| |Union| |Record| |Vector| )) - ;" Used in isFunctor test, and compDefine " + ;" Used in isFunctor test, and compDefine " (SETQ |$SpecialDomainNames| '( |add| CAPSULE |SubDomain| |List| |Union| |Record| |Vector| )) - ;" Used in isDomainForm, addEmptyCapsuleIfnecessary" + ;" Used in isDomainForm, addEmptyCapsuleIfnecessary" (SETQ |$DomainNames| '( |Integer| |Float| |Symbol| |Boolean| |String| |Expression| @@ -5781,7 +5781,7 @@ now the function is defined but does nothing. (SETQ |$mostRecentOpAlist| NIL) (SETQ |$noEnv| NIL) (SETQ |$croakIfTrue| NIL) ;" see moan in UT" -(SETQ |$opFilter| NIL) ;" used to |/s a function " +(SETQ |$opFilter| NIL) ;" used to |/s a function " (SETQ |$evalDomain| NIL) (SETQ |$SideEffectFreeFunctionList| '( @@ -5807,7 +5807,7 @@ now the function is defined but does nothing. (SETQ |$FontTable| '(|FontTable|)) (SETQ |$Integer| '(|Integer|)) (SETQ |$ComplexInteger| (LIST '|Complex| |$Integer|)) -(SETQ |$Mode| '(|Mode|)) +(SETQ |$Mode| '(|Mode|)) (SETQ |$NegativeInteger| '(|NegativeInteger|)) (SETQ |$NonNegativeInteger| '(|NonNegativeInteger|)) (SETQ |$NonPositiveInteger| '(|NonPositiveInteger|)) @@ -5875,7 +5875,7 @@ now the function is defined but does nothing. *41 *42 *43 *44 *45 *46 *47 *48 *49 *50)) (SETQ |$ModeVariableList| '(dv$1 dv$2 dv$3 dv$4 dv$5 dv$6 dv$7 dv$8 dv$9 dv$10 dv$11 dv$12 dv$13 dv$14 dv$15 - dv$16 dv$17 dv$18 dv$19 dv$20)) + dv$16 dv$17 dv$18 dv$19 dv$20)) (SETQ |$DomainVariableList| '($1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11 $12 $13 $14 $15 $16 $17 $18 $19 $20)) (SETQ |$TriangleVariableList| @@ -5887,14 +5887,14 @@ now the function is defined but does nothing. (SETQ |$PrimitiveDomainNames| '(|List| |Integer| |NonNegativeInteger| |PositiveInteger| - |SingleInteger| |String| |Boolean|)) - ;" used in mkCategory to avoid generating vector slots" - ;" for primitive domains " - ;" also used by putInLocalDomainReferences and optCall" + |SingleInteger| |String| |Boolean|)) + ;" used in mkCategory to avoid generating vector slots" + ;" for primitive domains " + ;" also used by putInLocalDomainReferences and optCall" (SETQ |$optimizableConstructorNames| '(|List| |Integer| |PositiveInteger| |NonNegativeInteger| |SingleInteger| |String| |Boolean| |Symbol| |DoubleFloat| |PrimitiveArray| |Vector|)) - ;" used by optCallSpecially" + ;" used by optCallSpecially" (SETQ |$Zero| '(|Zero|)) (SETQ |$One| '(|One|)) (SETQ |$NonMentionableDomainNames| @@ -5906,12 +5906,12 @@ now the function is defined but does nothing. (|Category| . ((|modemap| ( ((|Category|) (|Category|)) (T *) ) - ))) + ))) (|Join| . ((|modemap| ( ((|Category|) (|Category|) (|Category|) (|Category|)) (|T| *) ) ( ((|Category|) (|Category|) (|List| (|Category|)) (|Category|)) (T *) ) - ))) + ))) )))) (SETQ |$InitialDomainsInScope| @@ -5934,44 +5934,44 @@ now the function is defined but does nothing. ;; Following were originally in EXPLORE BOOT -(SETQ |$xdatabase| NIL) +(SETQ |$xdatabase| NIL) (SETQ |$CatOfCatDatabase| NIL) (SETQ |$DomOfCatDatabase| NIL) (SETQ |$JoinOfDomDatabase| NIL) (SETQ |$JoinOfCatDatabase| NIL) -(SETQ |$attributeDb| NIL) +(SETQ |$attributeDb| NIL) (SETQ |$abbreviateIfTrue| NIL) -(SETQ |$deltax| 0) -(SETQ |$deltay| 0) -(SETQ |$displayDomains| 'T) -(SETQ |$displayTowardAncestors| NIL) -(SETQ |$focus| NIL) +(SETQ |$deltax| 0) +(SETQ |$deltay| 0) +(SETQ |$displayDomains| 'T) +(SETQ |$displayTowardAncestors| NIL) +(SETQ |$focus| NIL) (SETQ |$focusAccessPath| NIL) (SETQ |$minimumSeparation| 3) -(SETQ |$origMaxColumn| 80) +(SETQ |$origMaxColumn| 80) (SETQ |$origMaxRow| 20) -(SETQ |$origMinColumn| 1) +(SETQ |$origMinColumn| 1) (SETQ |$origMinRow| 1) ;; ---- start of initial settings for variables used in test.boot (SETQ |$testOutputLineFlag| NIL) ;; referenced by charyTop, prnd - ;; to stash lines + ;; to stash lines (SETQ |$testOutputLineStack| NIL) ;; saves lines to be printed - ;; (needed to convert lines for use - ;; in hypertex) -(SETQ |$runTestFlag| NIL) ;; referenced by maPrin to stash - ;; output by recordAndPrint to not - ;; print type/time -(SETQ |$mkTestFlag| NIL) ;; referenced by READLN to stash input - ;; by maPrin to stash output - ;; by recordAndPrint to write i/o - ;; onto $testStream -(SETQ |$mkTestInputStack| NIL) ;; saves input for $testStream - ;; (see READLN) -(SETQ |$mkTestOutputStack| NIL) ;; saves output for $testStream - ;; (see maPrin) + ;; (needed to convert lines for use + ;; in hypertex) +(SETQ |$runTestFlag| NIL) ;; referenced by maPrin to stash + ;; output by recordAndPrint to not + ;; print type/time +(SETQ |$mkTestFlag| NIL) ;; referenced by READLN to stash input + ;; by maPrin to stash output + ;; by recordAndPrint to write i/o + ;; onto $testStream +(SETQ |$mkTestInputStack| NIL) ;; saves input for $testStream + ;; (see READLN) +(SETQ |$mkTestOutputStack| NIL) ;; saves output for $testStream + ;; (see maPrin) ;; ---- end of initial settings for variables used in test.boot @@ -6005,7 +6005,7 @@ now the function is defined but does nothing. (setq |$profileCompiler| nil) -@ +\end{chunk} \begin{verbatim} This file contains most of the code that puts properties on identifiers in the Scratchpad II system. If it was not possible @@ -6021,7 +6021,7 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" properties on some special handlers. \end{verbatim} -<<*>>= +\begin{chunk}{*} (MAKEPROP 'END_UNIT 'KEY 'T) @@ -6103,10 +6103,10 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" (|binom| SUBSPAN |binomSub|) (|binom| SUPERSPAN |binomSuper|) (|binom| WIDTH |binomWidth|) - (ALTSUPERSUB APP |altSuperSubApp|) - (ALTSUPERSUB SUBSPAN |altSuperSubSub|) + (ALTSUPERSUB APP |altSuperSubApp|) + (ALTSUPERSUB SUBSPAN |altSuperSubSub|) (ALTSUPERSUB SUPERSPAN |altSuperSubSuper|) - (ALTSUPERSUB WIDTH |altSuperSubWidth|) + (ALTSUPERSUB WIDTH |altSuperSubWidth|) (BOX APP |boxApp|) (BOX SUBSPAN |boxSub|) (BOX SUPERSPAN |boxSuper|) @@ -6123,7 +6123,7 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" (MATRIX SUBSPAN |matSub|) (MATRIX SUPERSPAN |matSuper|) (MATRIX WIDTH |matWidth|) - (NOTHING APP |nothingApp|) + (NOTHING APP |nothingApp|) (NOTHING SUPERSPAN |nothingSuper|) (NOTHING SUBSPAN |nothingSub|) (NOTHING WIDTH |nothingWidth|) @@ -6141,10 +6141,10 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" (PAREN SUBSPAN |qTSub|) (PAREN SUPERSPAN |qTSuper|) (PAREN WIDTH |qTWidth|) - (ROOT APP |rootApp|) - (ROOT SUBSPAN |rootSub|) + (ROOT APP |rootApp|) + (ROOT SUBSPAN |rootSub|) (ROOT SUPERSPAN |rootSuper|) - (ROOT WIDTH |rootWidth|) + (ROOT WIDTH |rootWidth|) (ROW WIDTH |eq0|) (SC APP |appsc|) (SC SUBSPAN |agggsub|) @@ -6152,10 +6152,10 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" (SC WIDTH |widthSC|) (SETQ APP |appsetq|) (SETQ WIDTH |letWidth|) - (SLASH APP |slashApp|) + (SLASH APP |slashApp|) (SLASH SUBSPAN |slashSub|) (SLASH SUPERSPAN |slashSuper|) - (SLASH WIDTH |slashWidth|) + (SLASH WIDTH |slashWidth|) (SUB APP |appsub|) (SUB SUBSPAN |subSub|) (SUB SUPERSPAN |subSuper|) @@ -6413,7 +6413,7 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" (LET |compSetqInteractive|) )) (MAKEPROP (CAR X) 'INTERACTIVE (CADR X))) -@ +\end{chunk} ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -7011,7 +7011,7 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" (defmacro |cdr| (x) `(cdr ,x)) -@ +\end{chunk} \eject \begin{thebibliography}{99} \bibitem{1} nothing