diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index a0b8263..6d941bb 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -867,6 +867,38 @@ character. Otherwise, it returns nil. @ +\defun{intloopProcessString}{intloopProcessString} +<>= +(defun |intloopProcessString| (s n) + (|setCurrentLine| s) + (|intloopProcess| n t + (|next| #'|ncloopParse| + (|next| #'|lineoftoks| (|incString| s))))) + +@ + +\defun{ncloopParse}{ncloopParse} +<>= +(defun |ncloopParse| (s) + (let (cudr lines stream dq t1) + (setq t1 (car s)) + (setq dq (car t1)) + (setq stream (cadr t1)) + (setq t1 (|ncloopDQlines| dq stream)) + (setq lines (car t1)) + (setq cudr (cadr t1)) + (cons (list (list lines (|npParse| (|dqToList| dq)))) (cdr s)))) + +@ + +\defun{incString}{incString} +<>= +(defun |incString| (s) + (declare (special |Top|)) + (|incRenumber| (|incLude| 0 (list s) 0 (list "strings") (list |Top|)))) + +@ + \defunsec{reclaim}{Call the garbage collector} Call the garbage collector on various platforms. <>= @@ -1099,6 +1131,315 @@ this is what the current code does so I won't change it. @ +\defun{intloopProcess}{intloopProcess} +<>= +(defun |intloopProcess| (n interactive s) + (let (ptree lines t1) + (declare (special |$systemCommandFunction|)) + (cond + ((|StreamNull| s) n) + (t + (setq t1 (car s)) + (setq lines (car t1)) + (setq ptree (cadr t1)) + (cond + ((|pfAbSynOp?| ptree '|command|) + (when interactive (|setCurrentLine| (|tokPart| ptree))) + (funcall |$systemCommandFunction| (|tokPart| ptree)) + (|intloopProcess| n interactive (cdr s))) + (t + (|intloopProcess| + (|intloopSpadProcess| n lines ptree interactive) + interactive (cdr s)))))))) + +@ + +\defun{intloopSpadProcess}{intloopSpadProcess} +<>= +(defun |intloopSpadProcess| (stepNo lines ptree interactive?) + (let (|$stepNo| result cc) + (declare (special |$stepNo| |$prevCarrier| |$intSpadReader| |flung| + |$intCoerceFailure| |$ncMsgList| |$currentCarrier|)) + (setq |$stepNo| stepNo) + (setq |$currentCarrier| (setq cc (list '|carrier|))) + (|ncPutQ| cc '|stepNumber| stepNo) + (|ncPutQ| cc '|messages| |$ncMsgList|) + (|ncPutQ| cc '|lines| lines) + (setq |$ncMsgList| nil) + (setq result + (|CatchAsCan| |flung| + (|Catch| '|SpadCompileItem| + (catch |$intCoerceFailure| + (catch |$intSpadReader| + (|intloopSpadProcess,interp| cc ptree interactive?)))))) + (|intSetNeedToSignalSessionManager|) + (setq |$prevCarrier| |$currentCarrier|) + (cond + ((eq result '|ncEnd|) stepNo) + ((eq result '|ncError|) stepNo) + ((eq result '|ncEndItem|) stepNo) + (t (+ stepNo 1))))) + +@ + +\defun{intloopSpadProcess,interp}{intloopSpadProcess,interp} +<>= +(defun |intloopSpadProcess,interp| (cc ptree interactive?) + (|ncConversationPhase| #'|phParse| (list cc ptree)) + (|ncConversationPhase| #'|phMacro| (list cc)) + (|ncConversationPhase| #'|phIntReportMsgs| (list cc interactive?)) + (|ncConversationPhase| #'|phInterpret| (list cc)) + (unless (eql (length (|ncEltQ| cc '|messages|)) 0) (|ncError|))) + +@ + +\defun{phParse}{phParse} +\begin{verbatim} +phParse: carrier[tokens,...] -> carrier[ptree, tokens,...] +\end{verbatim} +<>= +(defun |phParse| (carrier ptree) + (declare (special |$ncmParse|)) + (|phBegin| '|Parsing|) + (when |$ncmParse| (|intSayKeyedMsg| 'S2CTP003 (list (|%pform| ptree)))) + (|ncPutQ| carrier '|ptree| ptree) + 'ok) + +@ + +\defun{phMacro}{phMacro} +\begin{verbatim} +carrier[ptree,...] -> carrier[ptree, ptreePremacro,...] +\end{verbatim} +<>= +(defun |phMacro| (carrier) + (let (ptree) + (declare (special |$ncmMacro|)) + (|phBegin| '|Macroing|) + (setq ptree (|ncEltQ| carrier '|ptree|)) + (|ncPutQ| carrier '|ptreePremacro| ptree) + (setq ptree (|macroExpanded| ptree)) + (when |$ncmMacro| (|intSayKeyedMsg| 'S2CTP007 (list (|%pform| ptree)))) + (|ncPutQ| carrier '|ptree| ptree) + 'ok)) + +@ + +\defun{phIntReportMsgs}{phIntReportMsgs} +\begin{verbatim} +carrier[lines,messages,..]-> carrier[lines,messages,..] +\end{verbatim} +<>= +(defun |phIntReportMsgs| (carrier interactive?) + (let (nerr msgs lines) + (declare (special |$erMsgToss|)) + (cond + (|$erMsgToss| 'ok) + (t + (setq lines (|ncEltQ| carrier '|lines|)) + (setq msgs (|ncEltQ| carrier '|messages|)) + (setq nerr (length msgs)) + (|ncPutQ| carrier '|ok?| (eql nerr 0)) + (cond + ((eql nerr 0) 'ok) + (t + (|processMsgList| msgs lines) + (|intSayKeyedMsg| 'S2CTP010 (list nerr)) + 'ok)))))) + +@ + +\defun{phInterpret}{phInterpret} +<>= +(defun |phInterpret| (carrier) + (let (val ptree) + (setq ptree (|ncEltQ| carrier '|ptree|)) + (setq val (|intInterpretPform| ptree)) + (|ncPutQ| carrier '|value| val))) + +@ + +\defun{phBegin}{phBegin} +<>= +(defun |phBegin| (id) + (declare (special |$ncmPhase| |$convPhase|)) + (setq |$convPhase| id) + (when |$ncmPhase| (|intSayKeyedMsg| 'S2CTP021 (list id)))) + +@ + +\defun{ncConversationPhase}{ncConversationPhase} +<>= +(defun |ncConversationPhase| (fn args) + (let (|$convPhase| |$ncMsgList| carrier) + (declare (special |$convPhase| |$ncMsgList|)) + (setq carrier (car args)) + (setq |$ncMsgList| nil) + (setq |$convPhase| '|NoPhase|) + (unwind-protect + (apply fn args) + (|ncConversationPhase,wrapup| carrier)))) + +@ + +\defun{ncConversationPhase,wrapup}{ncConversationPhase,wrapup} +<>= +(defun |ncConversationPhase,wrapup| (carrier) + (declare (special |$ncMsgList|)) + ((lambda (Var5 m) + (loop + (cond + ((or (atom Var5) (progn (setq m (car Var5)) nil)) + (return nil)) + (t + (|ncPutQ| carrier '|messages| (cons m (|ncEltQ| carrier '|messages|))))) + (setq Var5 (cdr Var5)))) + |$ncMsgList| nil)) + +@ + +\defun{ncError}{ncError} +<>= +(defun |ncError| () + (throw '|SpadCompileItem| '|ncError|)) + +@ + +\defun{intloopEchoParse}{intloopEchoParse} +<>= +(defun |intloopEchoParse| (s) + (let (cudr lines stream dq t1) + (declare (special |$EchoLines| |$lines|)) + (setq t1 (car s)) + (setq dq (car t1)) + (setq stream (cadr t1)) + (setq t1 (|ncloopDQlines| dq |$lines|)) + (setq lines (car t1)) + (setq cudr (cadr t1)) + (|setCurrentLine| (|mkLineList| lines)) + (when |$EchoLines| (|ncloopPrintLines| lines)) + (setq |$lines| cudr) + (cons (list (list lines (|npParse| (|dqToList| dq)))) (cdr s)))) + +@ + +\defun{ncloopPrintLines}{ncloopPrintLines} +\begin{verbatim} +;ncloopPrintLines lines == +; for line in lines repeat WRITE_-LINE CDR line +; WRITE_-LINE '" " +\end{verbatim} +<>= +(defun |ncloopPrintLines| (lines) + ((lambda (Var4 line) + (loop + (cond + ((or (atom Var4) (progn (setq line (car Var4)) nil)) + (return nil)) + (t (write-line (cdr line)))) + (setq Var4 (cdr Var4)))) + lines nil) + (write-line " ")) + +@ + +\defun{mkLineList}{mkLineList} +\begin{verbatim} +;mkLineList lines == +; l := [CDR line for line in lines | nonBlank CDR line] +; #l = 1 => CAR l +; l +\end{verbatim} +<>= +(defun |mkLineList| (lines) + (let (l) + (setq l + ((lambda (Var2 Var1 line) + (loop + (cond + ((or (atom Var1) (progn (setq line (car Var1)) nil)) + (return (nreverse Var2))) + (t + (and (|nonBlank| (cdr line)) + (setq Var2 (cons (cdr line) Var2))))) + (setq Var1 (cdr Var1)))) + nil lines nil)) + (cond + ((eql (length l) 1) (car l)) + (t l)))))) + +@ + +\defun{nonBlank}{nonBlank} +\begin{verbatim} +;nonBlank str == +; value := false +; for i in 0..MAXINDEX str repeat +; str.i ^= char " " => +; value := true +; return value +; value +\end{verbatim} +<>= +(defun |nonBlank| (str) + (let (value) + ((lambda (Var3 i) + (loop + (cond + ((> i Var3) (return nil)) + (t + (cond + ((not (equal (elt str i) (|char| '| |))) + (identity (progn (setq value t) (return value))))))) + (setq i (+ i 1)))) + (maxindex str) 0) + value)) + +@ + +\defun{ncloopDQlines}{ncloopDQlines} +<>= +(defun |ncloopDQlines| (dq stream) + (let (b a) + (|StreamNull| stream) + (setq a (|poGlobalLinePosn| (|tokPosn| (cadr dq)))) + (setq b (|poGlobalLinePosn| (caar stream))) + (|streamChop| (+ (- a b) 1) stream))) + +@ + +\defun{streamChop}{streamChop} +<>= +(DEFUN |streamChop| (|n| |s|) + (PROG (|d| |c| |line| |b| |a| |LETTMP#1|) + (RETURN + (COND + ((|StreamNull| |s|) (LIST NIL NIL)) + ((EQL |n| 0) (LIST NIL |s|)) + ('T (SETQ |LETTMP#1| (|streamChop| (- |n| 1) (CDR |s|))) + (SETQ |a| (CAR |LETTMP#1|)) (SETQ |b| (CADR |LETTMP#1|)) + (SETQ |line| (CAR |s|)) + (SETQ |c| (|ncloopPrefix?| ")command" (CDR |line|))) + (SETQ |d| + (CONS (CAR |line|) (COND (|c| |c|) ('T (CDR |line|))))) + (LIST (CONS |d| |a|) |b|)))))) +;(defun |streamChop| (n s) +; (prog (d c line b a t1) +; (return +; (cond +; ((|StreamNull| s) (list nil nil)) +; ((eql n 0) (list nil s)) +; (t +; (setq t1 (|streamChop| (- n 1) (cdr s))) +; (setq a (car t1)) +; (setq b (cadr t1)) +; (setq line (car s)) +; (setq c (|ncloopPrefix?| ")command" (cdr line))) +; (setq d (cons (car line) (cond (c c) (t (cdr line))))) +; (list (cons d a) b)))))) + +@ + \defun{ncloopInclude0}{ncloopInclude0} <>= (defun |ncloopInclude0| (st name n) @@ -1756,8 +2097,14 @@ This is a list of commands that can be in an include file @ +<>= +(eval-when (eval load) + (setq |$pfMacros| nil)) + +@ + \defun{incClassify}{incClassify} -\being{verbatim +\being{verbatim} ;incClassify(s) == ; not incCommand? s => [false,0, '""] ; i := 1; n := #s @@ -17558,8 +17905,10 @@ $boot |$ConstructorCache| |$constructors| /countlist +|$convPhase| curinstream curoutstream +|$currentCarrier| $current-directory |$currentFrameNum| |$currentLine| @@ -17580,6 +17929,7 @@ $directory-list *eof* |$erMsgToss| |$existingFiles| +|flung| |$fn| |$formulaOutputStream| |$fortranOutputStream| @@ -17595,11 +17945,13 @@ $directory-list |$inLispVM| |$InitialModemapFrame|)) in-stream +|$intCoerceFailure| |$InteractiveFrame| |$internalHistoryTable| |$interpreterFrameName| |$interpreterFrameRing| |$intRestart| +|$intSpadReader| |$intTopLevel| |$IOindex| |$JoinOfCatDatabase| @@ -17619,6 +17971,8 @@ $library-directory-list |$msgAlist| |$msgDatabase| |$msgDatabaseName| +|$ncmParse| +|$ncmPhase| |$ncMsgList| |$newConlist| |$NonNullStream| @@ -17634,6 +17988,7 @@ $newspad |$OutputForm| |$packages| /pretty +|$prevCarrier| |$previousBindings| |$PrintCompilerMessageIfTrue| |$printLoadMsgs| @@ -17645,6 +18000,7 @@ $relative-library-directory-list |$seen| |$SessionManager| |$setOptions| +|$stepNo| |$slamFlag| /sourcefiles |$sourceFiles| @@ -17672,32 +18028,51 @@ $traceletflag \section{undefined functions} \begin{verbatim} +|char| +|Catch| +|CatchAsCan| currenttime -|%d| -- used as a function in inclmsgSay but never defined. +|dqToList| error expand-tabs |%fname| |incAppend| |%id| |insertpile| +|intInterpretPform| |intloopEchoParse| |intloopProcess| |intloopProcessString| |intnplisp| +|intSayKeyedMsg| +|intSetNeedToSignalSessionManager| |lineoftoks| |ListMemberQ?| +|lineoftoks| |lnCreate| |lnSetGlobalNum| +|macroExpanded| |MakeSymbol| +maxindex |ncBug| +|ncEltQ| +|ncPutQ| |ncloopEchoParse| |ncloopProcess| +|next| +|npParse| |%origin| +|pfAbSynOp?| +|%pform| +|poGlobalLinePosn| |porigin| +|processMsgList| |resetStackLimits| |shoeread-line| |StreamNull| stringimage +|tokPart| +|tokPosn| \end{verbatim} \chapter{The Interpreter} @@ -17858,6 +18233,7 @@ stringimage <> <> <> +<> <> <> <> @@ -17879,6 +18255,7 @@ stringimage <> <> <> +<> <> <> <> @@ -17886,10 +18263,15 @@ stringimage <> <> <> +<> <> <> <> +<> +<> <> +<> +<> <> <> <> @@ -17920,19 +18302,27 @@ stringimage <> <> <> +<> <> +<> +<> +<> <> <> +<> <> <> <> <> <> +<> <> +<> <> <> <> +<> <> <> @@ -17940,6 +18330,11 @@ stringimage <> <> +<> +<> +<> +<> +<> <> <> <> @@ -18045,6 +18440,7 @@ stringimage <> <> <> +<> <> <> <> @@ -18103,6 +18499,7 @@ stringimage <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 228151b..d1b6f15 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20091023 tpd src/axiom-website/patches.html 20091023.02.tpd.patch +20091023 tpd books/bookvol5 merge int-top.lisp +20091023 tpd src/interp/int-top.lisp removed, merged with bookvol5 20091023 tpd src/axiom-website/patches.html 20091023.01.tpd.patch 20091023 tpd src/input/dop.input fix up commented-out commands 20091019 tpd src/axiom-website/patches.html 20091019.05.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 81dda9b..6c1d59a 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2165,5 +2165,7 @@ src/input/branchcut.input added
src/boot directory and files deleted
20091023.01.tpd.patch src/input/dop.input fix up commented-out commands
+20091023.02.tpd.patch +books/bookvol5 merge and delete int-top.lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index f5cd870..a3428b7 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -196,7 +196,6 @@ OBJS= ${OUT}/vmlisp.${O} \ ${OUT}/i-spec1.${O} \ ${OUT}/i-spec2.${O} ${OUT}/i-syscmd.${O} \ ${OUT}/i-toplev.${O} ${OUT}/i-util.${O} \ - ${OUT}/int-top.${O} \ ${OUT}/intfile.${O} \ ${OUT}/lisplib.${O} ${OUT}/macex.${O} \ ${OUT}/match.${O} \ @@ -3825,29 +3824,6 @@ ${MID}/sfsfun-l.lisp: ${IN}/sfsfun-l.lisp.pamphlet @ -\subsection{int-top.lisp} -<>= -${OUT}/int-top.${O}: ${MID}/int-top.lisp - @ echo 136 making ${OUT}/int-top.${O} from ${MID}/int-top.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/int-top.lisp"' \ - ':output-file "${OUT}/int-top.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/int-top.lisp"' \ - ':output-file "${OUT}/int-top.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/int-top.lisp: ${IN}/int-top.lisp.pamphlet - @ echo 137 making ${MID}/int-top.lisp from ${IN}/int-top.lisp.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/int-top.lisp.pamphlet >int-top.lisp ) - -@ - \subsection{osyscmd.lisp} <>= ${OUT}/osyscmd.${O}: ${MID}/osyscmd.lisp @@ -4403,9 +4379,6 @@ clean: <> <> -<> -<> - <> <>