diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 9b361d3..a3dd676 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -2385,11 +2385,10 @@ sameUnionBranch(uArg, m) == (|ncPutQ| cc '|lines| lines) (setq |$ncMsgList| nil) (setq result - (|CatchAsCan| |flung| - (|Catch| '|SpadCompileItem| + (catch '|SpadCompileItem| (catch |$intCoerceFailure| (catch |$intSpadReader| - (|intloopSpadProcess,interp| cc ptree interactive?)))))) + (|intloopSpadProcess,interp| cc ptree interactive?))))) (setq |$NeedToSignalSessionManager| t) (setq |$prevCarrier| |$currentCarrier|) (cond @@ -23069,6 +23068,12 @@ input controls libraries from which to load compiled code @ +\defvar{output-library} +<>= +(defvar output-library nil) + +@ + \defunsec{openOutputLibrary}{Open the output library} The input-libraries and output-library are now truename based. \calls{openOutputLibrary}{dropInputLibrary} @@ -23169,7 +23174,7 @@ The input-libraries is now maintained as a list of truenames. \defunsec{addInputLibrary}{Add the input library to the list} The input-libraries variable is now maintained as a list of truenames. \calls{addInputLibrary}{dropInputLibrary} -\usesdollar{addInputLibrary}{input-libraries} +\uses{addInputLibrary}{input-libraries} <>= (defun |addInputLibrary| (lib) "Add the input library to the list" @@ -23179,8 +23184,14 @@ The input-libraries variable is now maintained as a list of truenames. @ +\defvar{input-libraries} +<>= +(defvar input-libraries nil) + +@ + \defunsec{dropInputLibrary}{Drop an input library from the list} -\usesdollar{dropInputLibrary}{input-libraries} +\uses{dropInputLibrary}{input-libraries} <>= (defun |dropInputLibrary| (lib) "Drop an input library from the list" @@ -37310,6 +37321,13 @@ but the Axiom semantics are not the same. Because Axiom was originally written in Maclisp, then VMLisp, and then Common Lisp some of these old semantics survive. +\section{Boolean} +\defun{BooleanEquality}{The Boolean = function support} +<>= +(defun |BooleanEquality| (x y) (if x y (null y))) + +@ + \section{IndexedBits} \defmacro{truth-to-bit}{IndexedBits new function support} <>= @@ -37696,6 +37714,15 @@ a call to this code. The Integer domain contains the line: @ +\defun{random}{Integer random function support} +This is used for calls to random with no arguments. +If an argument is supplied to random then the common lisp random +function is called directly. This could be lifted up into the spad code. +<>= +(defun |random| () (random (expt 2 26))) + +@ + \section{IndexCard} \defun{alqlGetOrigin}{IndexCard origin function support} \calls{alqlGetOrigin}{dbPart} @@ -38344,6 +38371,25 @@ See Steele Common Lisp 1990 pp305-307 @ +\chapter{NRLIB code.lisp support code} + +\defun{makeByteWordVec2}{makeByteWordVec2} +<>= +(defun |makeByteWordVec2| (maxelement initialvalue) + (let ((n (cond ((null initialvalue) 7) ('t maxelement)))) + (make-array (length initialvalue) + :element-type (list 'mod (1+ n)) + :initial-contents initialvalue))) + +@ + +\defmacro{spadConstant} +<>= +(defmacro |spadConstant| (dollar n) + `(spadcall (svref ,dollar (the fixnum ,n)))) + +@ + \chapter{Monitoring execution} \begin{verbatim} MONITOR @@ -39368,6 +39414,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -39383,6 +39430,7 @@ This needs to work off the internal exposure list, not the file. <> <> +<> <> <> <> @@ -39498,6 +39546,7 @@ This needs to work off the internal exposure list, not the file. <> <> <> +<> <> <> <> @@ -39621,6 +39670,7 @@ This needs to work off the internal exposure list, not the file. <> <> +<> <> <> <> diff --git a/changelog b/changelog index 9666820..cc5f075 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +20101217 tpd src/axiom-website/patches.html 20101217.01.tpd.patch +20101217 tpd books/bookvol5 cleaning vmlisp +20101217 tpd src/interp/i-coerce.lisp cleaning vmlisp +20101217 tpd src/interp/i-output.lisp cleaning vmlisp +20101217 tpd src/interp/parsing.lisp cleaning vmlisp +20101217 tpd src/interp/vmlisp.lisp cleaning vmlisp 20101216 tpd src/axiom-website/patches.html 20101216.01.tpd.patch 20101216 tpd src/interp/vmlisp.lisp treeshake compiler 20101216 tpd src/interp/parsing.lisp treeshake compiler diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index e85faed..75f51a6 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3319,5 +3319,7 @@ books/bookvolbib add [Flo63] Floyd
books/bookvol9 treeshake compiler
20101216.01.tpd.patch books/bookvol9 treeshake compiler
+20101217.01.tpd.patch +src/interp/vmlisp.lisp cleaning vmlisp
diff --git a/src/interp/i-coerce.lisp.pamphlet b/src/interp/i-coerce.lisp.pamphlet index ff6a552..c3faaf2 100644 --- a/src/interp/i-coerce.lisp.pamphlet +++ b/src/interp/i-coerce.lisp.pamphlet @@ -3369,6 +3369,10 @@ Interpreter Coercion Query Functions ; predicate is ['EQCAR,.,p] => objNewWrap(CDR val',targetType) ; objNew(objVal object,targetType) +(defun |evalSharpOne| (x |#1|) + (declare (special |#1|)) + (eval `(let() (declare (special |#1|)) ,x))) + (DEFUN |coerceUnion2Branch| (|object|) (PROG (|LETTMP#1| |unionDoms| |predList| |doms| |val'| |predicate| |targetType| |ISTMP#1| |ISTMP#2| |p|) diff --git a/src/interp/i-output.lisp.pamphlet b/src/interp/i-output.lisp.pamphlet index e3f6db8..c857b15 100644 --- a/src/interp/i-output.lisp.pamphlet +++ b/src/interp/i-output.lisp.pamphlet @@ -14,6 +14,8 @@ (SPADLET |$collectOutput| NIL) +(defvar MATBORCH "*") + ;specialChar(symbol) == ; null (code := IFCDR ASSQ(symbol,$specialCharacterAlist)) => '"?" ; ELT($specialCharacters,code) @@ -6533,6 +6535,11 @@ NIL ; u := nextu ; null u => return(nil) +(DEFUN ASSOCIATER (FN LST) + (COND ((NULL LST) NIL) + ((NULL (CDR LST)) (CAR LST)) + ((LIST FN (CAR LST) (ASSOCIATER FN (CDR LST)))))) + (DEFUN |bracketagglist| (|u| |start| |linelength| |tchr| |open| |close|) (PROG (|lastx| |s| |nextu| |x| |ichr|) (declare (special |$algebraOutputStream| |$collectOutput|)) diff --git a/src/interp/parsing.lisp.pamphlet b/src/interp/parsing.lisp.pamphlet index fe50711..83ed03a 100644 --- a/src/interp/parsing.lisp.pamphlet +++ b/src/interp/parsing.lisp.pamphlet @@ -719,37 +719,6 @@ bootlex (IOClear in-stream out-stream))) T) -(defun READ-BOOT (FN FM TO) - (let (($boot t)) (READ-SPAD1 FN 'BOOT FM TO))) - -(defun READ-SPAD1 (FN FT FM TO) - (LET ((STRM IN-STREAM)) - (SETQ $MAXLINENUMBER 0) - (SETQ $SPAD_ERRORS (VECTOR 0 0 0)) - (SETQ IN-STREAM (open (strconc fm ">" fn "." ft) :direction :input)) - ($ERASE (LIST FN 'ERROR 'A)) - (SETQ OUT-STREAM (if TO (open to :direction :output) OUT-STREAM)) - (SETQ SPADERRORSTREAM (open (strconc "a>" fn ".error") :direction :output)) - (|New,ENTRY,1|) - (close SPADERRORSTREAM) - (SETQ IN-STREAM STRM) - (OR (EQUAL #(0 0 0) $SPAD_ERRORS) - (|sayBrightly| (LIST '|%b| (ELT $SPAD_ERRORS 0) '|%d| '|syntax errors| - '|%l| '|%b| (ELT $SPAD_ERRORS 1) '|%d| '|precompilation errors| - '|%l| '|%b| (ELT $SPAD_ERRORS 2) '|%d| '|semantic errors| '|%l|))) - (+ (ELT $SPAD_ERRORS 0) (ELT $SPAD_ERRORS 1) (ELT $SPAD_ERRORS 2)))) - -(defun READBOOT () - (let (form expr ($BOOT 'T)) - (declare (special $BOOT)) - (ADVANCE-TOKEN) - (|PARSE-Expression|) - ;; (|pp| (setq form (|postTransform| (FIRST STACK)))) - (|pp| (setq form (|postTransform| (pop-STACK-1)))) - (setq EXPR (DEF-RENAME form)) - (DEF-PROCESS EXPR) - (TERSYSCOMMAND))) - ; *** 2. BOOT Line Handling *** ; See the file PREPARSE.LISP for the hard parts of BOOT line processing. @@ -926,8 +895,6 @@ or the chracters ?, !, ' or %" (defun-parse-token KEYWORD) (defun-parse-token ARGUMENT-DESIGNATOR) -(defun |boot-LEXPR| () (New-LEXPR1)) - (defun TRANSLABEL (X AL) (TRANSLABEL1 X AL) X) (defun TRANSLABEL1 (X AL) diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 2bc7f8b..f9a9093 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -5676,33 +5676,18 @@ now the function is defined but does nothing. ; SYSTEM COMMANDS ;************************************************************************ -(defmacro |report| (L) - (SUBST (SECOND L) 'x - '(COND ($reportFlag (sayBrightly x)) ((QUOTE T) NIL)))) - (defmacro |DomainSubstitutionMacro| (&rest L) (|DomainSubstitutionFunction| (first L) (second L))) +; vol 10.2? (defun |sort| (seq spadfn) (sort (copy-seq seq) (function (lambda (x y) (SPADCALL X Y SPADFN))))) (defmacro |float| (x &optional (y 0.0d0)) `(float ,x ,y)) -(defun |makeSF| (mantissa exponent) - (|float| (/ mantissa (expt 2 (- exponent))))) - (define-function 'list1 #'list) (define-function '|not| #'NOT) -(defun |random| () (random (expt 2 26))) -(defun \,plus (x y) (+ x y)) -(defun \,times (x y) (* x y)) -(defun \,difference (x y) (- x y)) -(defun \,max (x y) (max x y)) -(defun \,min (x y) (min x y)) -;; This is used in the domain Boolean (BOOLEAN.nrlib/code.lsp) -(defun |BooleanEquality| (x y) (if x y (null y))) - (MAKEPROP 'END_UNIT 'KEY T) (defun |process| (x) @@ -5714,111 +5699,19 @@ now the function is defined but does nothing. @ -The evalSharpOne function needs to declare the second argument -special to reduce warning messages about variables being assumed -special. <<*>>= -(defun |evalSharpOne| (x |#1|) (declare (special |#1|)) - (EVAL `(let() (declare (special |#1|)) ,x))) - -(defun new () (|New,ENTRY|)) - -(defun newpo () (let ((|$PrintOnly| t)) (new))) - -(defun |New,ENTRY| () - (let ((|$InteractiveMode| t)(inputstream in-stream) ) - (declare (special inputstream)) - (spad))) - -(defun |New,ENTRY,SYS| () - (let (|$InteractiveMode|) - (|New,ENTRY1|))) - -(defun |New,ENTRY1| () - (let ((spaderrorstream curoutstream) $boot (curinstream curinstream) - (strm curinstream)) - (SETQ CURINSTREAM *terminal-io*) - (|New,ENTRY,1|) - (SETQ CURINSTREAM STRM) - 'END_OF_New)) (setq *PROMPT* 'LISP) -(defun |New,ENTRY,1| () - (let (ZZ str N *PROMPT* - SINGLELINEMODE OK ISID NBLNK COUNT CHR ULCASEFG ($LINESTACK 'BEGIN_UNIT) - $NEWLINSTACK $TOKSTACK COMMENTCHR TOK LINE BACK INPUTSTREAM XTRANS - XTOKENREADER STACK STACKX) - (SETQ XTRANS '|boot-New| - XTOKENREADER 'NewSYSTOK - SYNTAX_ERROR 'SPAD-SYNTAX-ERROR) - (FLAG |boot-NewKEY| 'KEY) - (SETQ *PROMPT* 'Scratchpad-II) - (PROMPT) - (SETQ XCAPE #\_) - (SETQ COMMENTCHR 'IGNORE) - (SETQ COLUMN 0) - (SETQ SINGLINEMODE T) ; SEE NewSYSTOK - (SETQ ULCASEFG T) - (setq STR (|New,ENTRY,2| '|PARSE-NewEXPR| '|process| curinstream)) - (if (/= 0 (setq N (NOTE STR))) - (progn (SETQ CURINSTREAM (POINTW N CURINSTREAM))) - ) - '|END_OF_New|)) - -(defun |New,ENTRY,2| (RULE FN INPUTSTREAM) (declare (special INPUTSTREAM)) - (let (zz) - (INITIALIZE) - (SETQ $previousTime (get-internal-run-time)) - (setq ZZ (CONVERSATION '|PARSE-NewExpr| '|process|)) - (REMFLAG |boot-NewKEY| 'KEY) - INPUTSTREAM)) - (defun INITIALIZE () (init-boot/spad-reader) (initialize-preparse INPUTSTREAM)) -(defun New-LEXPR () (New-LEXPR1)) - -(defun New-LEXPR-Interactive () (setq |$InteractiveMode| t) (New-LEXPR1)) - (setq *prompt* 'new) -(defun New-LEXPR1 () - (FLAG |boot-NewKEY| 'KEY) - (SETLINE (SUB1 (file-position INPUTSTREAM)) INPUTSTREAM) - (SETQ CHR 'ENDOFLINECHR) - (NXTTOK) - (|boot-Statement|) - (CAR STACK)) - -(defun parserState () - (PRINT (LIST 'CHR= CHR 'NBLNK= NBLNK 'TOK= TOK 'ISID= ISID - 'COUNT= COUNT 'COLUMN= COLUMN)) - (PRINT (LIST 'STACK= STACK 'STACKX= STACKX)) - (PRINT (LIST '$TOKSTACK= $TOKSTACK 'INPUTSTREAM= INPUTSTREAM))) - (defmacro try (X) `(LET ((|$autoLine|)) (declare (special |$autoLine|)) (|tryToFit| (|saveState|) ,X))) -(mapcar #'(lambda (X) (MAKEPROP (CAR X) 'format (CADR X))) - '((COMMENT |formatCOMMENT|) - (SEQ |formatSEQ|) - (DEF |formatDEF|) - (LET |formatLET|) - (\: |formatColon|) - (ELT |formatELT|) - (SEGMENT |formatSEGMENT|) - (COND |formatCOND|) - (SCOND |formatSCOND|) - (QUOTE |formatQUOTE|) - (CONS |formatCONS|) - (|where| |formatWHERE|) - (APPEND |formatAPPEND|) - (REPEAT |formatREPEAT|) - (COLLECT |formatCOLLECT|) - (REDUCE |formatREDUCE|))) - (defun GLESSEQP (X Y) (NOT (GGREATERP X Y))) (defun LEXLESSEQP (X Y) (NOT (LEXGREATERP X Y))) @@ -5841,24 +5734,10 @@ special. ((EQCAR A 'CDR) (LIST 'RPLACD (CADR A) B)) ((ERROR 'RPLAC)))))))) -(DEFUN ASSOCIATER (FN LST) - (COND ((NULL LST) NIL) - ((NULL (CDR LST)) (CAR LST)) - ((LIST FN (CAR LST) (ASSOCIATER FN (CDR LST)))))) - ; **** X. Random tables -(defvar MATBORCH "*") -(defvar ALPHLIST '(|a| |b| |c| |d| |e| |f| |g|)) -(defvar LITTLEIN " in ") -(defvar INITALPHLIST ALPHLIST) -(defvar INITXPARLST '(|i| |j| |k| |l| |m| |n| |p| |q|)) -(defvar PORDLST (COPY-tree INITXPARLST)) -(defvar INITPARLST '(|x| |y| |z| |u| |v| |w| |r| |s| |t|)) -(defvar LITTLEA '|a|) -(defvar LITTLEI '|i|) - -; (SETQ |boot-NewKEY| (S- |boot-NewKEY| '(|cp| |cms| |lisp| |boot|))) +(defun |makeSF| (mantissa exponent) + (|float| (/ mantissa (expt 2 (- exponent))))) (MAKEPROP 'COND '|Nud| '(|if| |if| 130 0)) (MAKEPROP 'CONS '|Led| '(CONS CONS 1000 1000)) @@ -5872,22 +5751,9 @@ special. ;; function to create byte and half-word vectors in new runtime system 8/90 -(defun |makeByteWordVec2| (maxelement initialvalue) - (let ((n (cond ((null initialvalue) 7) ('t maxelement)))) - (make-array (length initialvalue) - :element-type (list 'mod (1+ n)) - :initial-contents initialvalue))) - -(defmacro |spadConstant| (dollar n) - `(spadcall (svref ,dollar (the fixnum ,n)))) - (SETQ |/MAJOR-VERSION| 7) (SETQ /VERSION 0) -;; These two variables are referred to in setvars.boot. -(setq input-libraries nil) -(setq output-library nil) - ;; For the browser, used for building local databases when a user compiles ;; their own code. (SETQ |$newConstructorList| nil) @@ -6745,150 +6611,6 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" )) (MAKEPROP (CAR X) 'INTERACTIVE (CADR X))) @ -\begin{verbatim} - -Operating system interface - -The only non-common lisp functions used in this file are in this section. -The following functions are provided: - - OsRunProgram program &rest args - Run the named program with given arguments. - All I/O is to the current places. - Value returned is implementation-dependent. - - OsRunProgramToStream program &rest args - Run the named program with given arguments. - Input and error output to the current places. - Value returned is a stream of the program's standard output. - - OsEnvVarCharacter - The character which indicates OS environment variables in a string. - On Unix this is "$". - - OsEnvGet name - name is a string or a symbol - The string associated with the given name is returned. - This is from the environment on Unix. On CMS globalvars could be used. - - OsProcessNumber - Returns a unique number associated with the current session. - On Unix this is the process id. - The same workspace started a second time must give a different result. - -\end{verbatim} -<<*>>= -(defun |OsRunProgram| (program &rest args) - (kcl-os-run-program program args) - nil ) - -(defun |OsRunProgramToStream| (program &rest args) - (kcl-os-run-program-to-stream program args) - (make-string-output-stream "") ) - -(defvar |OsEnvVarCharacter| #\$) - -(defun |OsEnvGet| (sym) - (kcl-os-env-get sym) - "" ) - -(defun |OsProcessNumber| () - (kcl-os-process-number) - 42 ) - - -;;; -;;; KCL-only implementations -;;; - -(defun kcl-os-run-program (program args) - (system (format nil "~{~a ~}" (cons program args))) ) - -(defun kcl-os-run-program-to-stream (program args) - (system (format nil "~{~a ~}" (cons program args))) ) - -(defun kcl-os-env-get (sym) - (system:getenv (string sym)) ) - -(defun kcl-os-process-number () - 77 ) - -;;;; -;;;; Time -;;;; - -(defun |TimeStampString| () - (multiple-value-bind (sec min hr mody mo yr wkdy daylight zone) - (get-decoded-time) - (declare (ignore wkdy daylight zone)) - (format nil "~2,'0d/~2,'0d/~2,'0d ~2,'0d:~2,'0d:~2,'0d" - yr mo mody hr min sec) )) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; -;;;; Lisp Interface -;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun |LispReadFromString| (str &optional (startpos 0)) - (prog (ob nextpos) - (multiple-value-setq - (ob nextpos) - (read-from-string str nil nil :start startpos) ) - (return (list ob nextpos)) )) - -(defun |LispEval| (expr) - (eval expr) ) - -;;; expr must be a defun, defmacro, etc. -(defun |LispCompile| (expr) - (eval expr) - (compile (second expr)) ) - -(defun |LispCompileFileQuietlyToObject| (source object) - (compile-file source :output-file object :messages nil :warnings nil)) - -(defun |LispLoadFileQuietly| (object) - (load object :verbose nil :print nil)) - -(defun |LispCompileFile| (fname) - (compile-file fname) ) - -(defun |LispLoadFile| (fname) - (load fname) ) - -(defun |LispKeyword| (str) - (intern str 'keyword) ) - -;;; -;;; Control -;;; - - -(defmacro |funcall| (&rest args) - (cons 'funcall args) ) - -(defmacro |Catch| (tag expr) - `(catch ,tag ,expr) ) - -(defmacro |Throw| (tag expr) - `(Throw ,tag ,expr) ) - -(defmacro |UnwindProtect| (a b) - `(unwind-protect ,a ,b) ) - -;;; This macro catches as much as it can. -;;; Systems with a catchall should use it. -;;; It is legitimate to not catch anything, if there is no system support. -;;; -;;; If the result was caught, then tagvar is set to the desination tag -;;; and the thown value is returned. Otherwise, tagvar is set to nil -;;; and the first result of the expression is returned. - -(defmacro |CatchAsCan| (tagvar expr) - `(progn - (setq tagvar nil) - ,expr )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -7180,18 +6902,6 @@ The following functions are provided: ;;; System-wide unique name on each call. (defvar *new-pathname-counter* 1) -(defun |NewPathname| (&optional (prefix "t")(type nil)(dir '(:relative))) - (let ((name - (format nil "~a~a-~a" - prefix (|OsProcessNumber|) *new-pathname-counter* ))) - (setq *new-pathname-counter* (+ *new-pathname-counter* 1)) - (make-pathname :directory dir :name name :type type) )) - -;;; System-wide unique name for the current session. -(defun |SessionPathname| (&optional (prefix "t")(type nil)(dir '(:relative))) - (let ((name (format nil "~a~a" prefix (|OsProcessNumber|)))) - (make-pathname :directory dir :name name :type type) )) - (defun |PathnameDirectory| (path) (pathname-directory path) )