[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Axiom-developer] 20090212.01.tpd.patch (remove unused code)
|
From: |
daly |
|
Subject: |
[Axiom-developer] 20090212.01.tpd.patch (remove unused code) |
|
Date: |
Sat, 14 Feb 2009 10:50:10 -0600 |
The focus now shifts to Book Volume 5: Axiom Interpreter
The goal is to collect, refactor, and document the interpreter.
====================================================================
diff --git a/changelog b/changelog
index ac8b7b8..5069ea7 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,11 @@
+20090212 tpd src/axiom-website/patches.html 20090212.01.tpd.patch
+20090212 tpd src/interp/interp-proclaims.lisp update proclaims for changes
+20090212 tpd src/interp/sockio.lisp remove unused code
+20090212 tpd src/interp/database.boot remove unused code
+20090212 tpd src/interp/bootlex.lisp remove unused code
+20090212 tpd src/interp/bookvol5 removed
+20090211 tpd src/axiom-website/patches.html 20090211.01.tpd.patch
+20090211 tpd books/bookvol10.4.pamphlet add exports
20090210 tpd src/axiom-website/patches.html 20090210.01.tpd.patch
20090210 tpd books/bookvol10.4.pamphlet add exports
20090209 tpd src/axiom-website/patches.html 20090209.02.tpd.patch
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 7ffc958..2fbdca2 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -939,5 +939,9 @@ bookvol10.4 add packages<br/>
bookvol10.4 add packages<br/>
<a href="patches/20090210.01.tpd.patch">20090210.01.tpd.patch</a>
bookvol10.4 add exports<br/>
+<a href="patches/20090211.01.tpd.patch">20090211.01.tpd.patch</a>
+bookvol10.4 add exports<br/>
+<a href="patches/20090212.01.tpd.patch">20090212.01.tpd.patch</a>
+remove unused code<br/>
</body>
</html>
diff --git a/src/interp/bookvol5.pamphlet b/src/interp/bookvol5.pamphlet
deleted file mode 100644
index f8fb4a2..0000000
--- a/src/interp/bookvol5.pamphlet
+++ /dev/null
@@ -1,6360 +0,0 @@
-\documentclass{book}
-\usepackage{axiom}
-\usepackage{graphicx}
-% struggle with latex figure-floating behavior
-\renewcommand\floatpagefraction{.9}
-\renewcommand\topfraction{.9}
-\renewcommand\bottomfraction{.9}
-\renewcommand\textfraction{.1}
-\setcounter{totalnumber}{50}
-\setcounter{topnumber}{50}
-\setcounter{bottomnumber}{50}
-
-\begin{document}
-\begin{titlepage}
-\center{\includegraphics{ps/axiomfront.ps}}
-\vskip 0.1in
-\includegraphics{ps/bluebayou.ps}\\
-\vskip 0.1in
-{\Huge{The 30 Year Horizon}}
-\vskip 0.1in
-$$
-\begin{array}{lll}
-Manuel\ Bronstein & William\ Burge & Timothy\ Daly \\
-James\ Davenport & Michael\ Dewar & Martin\ Dunstan \\
-Albrecht\ Fortenbacher & Patrizia\ Gianni & Johannes\ Grabmeier \\
-Jocelyn\ Guidry & Richard\ Jenks & Larry\ Lambe \\
-Michael\ Monagan & Scott\ Morrison & William\ Sit \\
-Jonathan\ Steinbach & Robert\ Sutor & Barry\ Trager \\
-Stephen\ Watt & Jim\ Wen & Clifton\ Williamson
-\end{array}
-$$
-\center{\large{VOLUME 5: THE AXIOM INTERPRETER}}
-\end{titlepage}
-\pagenumbering{roman}
-\begin{verbatim}
-The Blue Bayou image Copyright (c) 2004 Jocelyn Guidry
-
-Portions Copyright (c) 2004 Martin Dunstan
-
-Portions Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-All rights reserved.
-
-This book and the Axiom software is licensed as follows:
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are
-met:
-
- - Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
- - Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in
- the documentation and/or other materials provided with the
- distribution.
-
- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
- names of its contributors may be used to endorse or promote products
- derived from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-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}
-\tableofcontents
-\vfill
-\eject
-\setlength{\parindent}{0em}
-\setlength{\parskip}{1ex}
-{\Large{\bf New Foreword}}
-\vskip .25in
-
-On October 1, 2001 Axiom was withdrawn from the market and ended
-life as a commercial product.
-On September 3, 2002 Axiom was released under the Modified BSD
-license, including this document.
-On August 27, 2003 Axiom was released as free and open source
-software available for download from the Free Software Foundation's
-website, Savannah.
-
-Work on Axiom has had the generous support of the Center for
-Algorithms and Interactive Scientific Computation (CAISS) at
-City College of New York. Special thanks go to Dr. Gilbert
-Baumslag for his support of the long term goal.
-
-The online version of this documentation is roughly 1000 pages.
-In order to make printed versions we've broken it up into three
-volumes. The first volume is tutorial in nature. The second volume
-is for programmers. The third volume is reference material. We've
-also added a fourth volume for developers. All of these changes
-represent an experiment in print-on-demand delivery of documentation.
-Time will tell whether the experiment succeeded.
-
-Axiom has been in existence for over thirty years. It is estimated to
-contain about three hundred man-years of research and has, as of
-September 3, 2003, 143 people listed in the credits. All of these
-people have contributed directly or indirectly to making Axiom
-available. Axiom is being passed to the next generation. I'm looking
-forward to future milestones.
-
-With that in mind I've introduced the theme of the ``30 year horizon''.
-We must invent the tools that support the Computational Mathematician
-working 30 years from now. How will research be done when every bit of
-mathematical knowledge is online and instantly available? What happens
-when we scale Axiom by a factor of 100, giving us 1.1 million domains?
-How can we integrate theory with code? How will we integrate theorems
-and proofs of the mathematics with space-time complexity proofs and
-running code? What visualization tools are needed? How do we support
-the conceptual structures and semantics of mathematics in effective
-ways? How do we support results from the sciences? How do we teach
-the next generation to be effective Computational Mathematicians?
-
-The ``30 year horizon'' is much nearer than it appears.
-
-\vskip .25in
-%\noindent
-Tim Daly\\
-CAISS, City College of New York\\
-November 10, 2003 ((iHy))
-\vfill
-\eject
-\pagenumbering{arabic}
-\setcounter{chapter}{0} % Chapter 1
-\chapter{The Interpreter}
-\section{Star Global Variables}
-\begin{tabular}{lll}
-NAME & SET & USE \\
-*default-pathname-defaults* & reroot & restart \\
-*eof* & ncTopLevel & \\
-*features* & & restart \\
-*package* & & restart \\
-*standard-input* & & ncIntLoop \\
-*standard-output* & & ncIntLoop \\
-*top-level-hook* & set-restart-hook & \\
-\end{tabular}
-\subsection{*default-pathname-defaults*}
-The [[*default-pathname-defaults*]] variable is set by
-[[make-absolute-filename]] called on the empty string. This has
-the effect of setting the value to the [[AXIOM]] variable as this
-function just concatenates the [[AXIOM]] variable onto the given string.
-We pass this string to the common lisp [[pathname]] function to set it
-to a real pathname.
-
-The [[*default-pathname-defaults*]] defaults common lisp variable is
-set in [[restart]] to the current directory in most cases. If we are
-working in Lucid Common Lisp ([[:lucid]]) on an IBM/370 mainframe
-([[:ibm/370]]) then it is set to the empty string. Using Lucid on a
-mainframe seems to use the variable [[vmlisp::$current-directory]].
-
-\subsection{*eof*}
-The [[*eof*]] variable is set to [[NIL]] in [[ncTopLevel]].
-\subsection{*features*}
-The [[*features*]] variable from common lisp is tested for the presence
-of the [[:unix]] keyword. Apparently this controls the use of Saturn,
-a previous Axiom frontend. The Saturn frontend was never released as
-open source and so this test and the associated variables are probably
-not used.
-
-\subsection{*package*}
-The [[*package*]] variable, from common lisp, is set in [[restart]]
-to the [[BOOT]] package where the intepreter lives.
-\subsection{*standard-input*}
-The [[*standard-input*]] common lisp variable is used to set the
-[[curinstream]] variable in [[ncIntLoop]].
-
-This variable is an argument to [[serverReadLine]] in
-the [[intloopReadConsole]] function.
-
-\subsection{*standard-output*}
-The [[*standard-output*]] common lisp variable is used to set the
-[[curoutstream]] variable in [[ncIntLoop]].
-
-\subsection{*top-level-hook*}
-The [[*top-level-hook*]] common lisp variable contains the name of
-a function to invoke when an image is started. In our case it is
-called [[restart]]. This is the entry point to the Axiom interpreter.
-
-\section{Dollar Global Variables}
-\begin{tabular}{lll}
-NAME & SET & USE \\
-\$boot & ncTopLevel & \\
-coerceFailure & & runspad \\
-curinstream & ncIntLoop & \\
-curoutstream & ncIntLoop & \\
-vmlisp::\$current-directory & restart & \\
- & reroot & \\
-\$currentLine & restart & removeUndoLines \\
-\$dalymode & & intloopReadConsole \\
-\$defaultMsgDatabaseName & reroot & \\
-\$directory-list & reroot & \\
-\$displayStartMsgs & & restart \\
-\$e & ncTopLevel & \\
-\$erMsgToss & SpadInterpretStream & \\
-\$fn & SpadInterpretStream & \\
-\$frameRecord & initvars & \\
- & clearFrame & \\
- & undoSteps & undoSteps \\
- & recordFrame & recordFrame \\
-\$HiFiAccess & initHist & historySpad2Cmd \\
- & historySpad2Cmd & \\
- & & setHistoryCore \\
-\$HistList & initHist & \\
-\$HistListAct & initHist & \\
-\$HistListLen & initHistList & \\
-\$HistRecord & initHistList & \\
-\$historyDirectory & & makeHistFileName \\
- & & makeHistFileName \\
-\$historyFileType & initvars & histInputFileName \\
-\$inclAssertions & SpadInterpretStream & \\
-\$inLispVM & spad & \\
-\$InteractiveFrame & restart & ncTopLevel \\
- & undo & recordFrame \\
- & undoSteps & undoSteps \\
- & & reportUndo \\
-\$InteractiveMode & ncTopLevel & \\
-\$internalHistoryTable & initvars & \\
-\$interpreterFrameName & initializeInterpreterFrameRing & \\
-\$interpreterFrameRing & initializeInterpreterFrameRing & \\
-\$InitialModemapFrame & & makeInitialModemapFrame \\
-\$intRestart & & intloop \\
-\$intTopLevel & intloop & \\
-\$IOindex & restart & historySpad2Cmd \\
- & removeUndoLines & undoCount \\
-\$genValue & bookvol5 & i-toplev \\
- & & i-analy \\
- & & i-syscmd \\
- & & i-spec1 \\
- & & i-spec2 \\
- & & i-map \\
-\$lastPos & SpadInterpretStream & \\
-\$libQuiet & SpadInterpretStream & \\
-\$library-directory-list & reroot & \\
-\$msgDatabaseName & reroot * \\
-\$ncMsgList & SpadInterpretStream & \\
-\$newcompErrorCount & SpadInterpretStream & \\
-\$newcompMode & SpadInterpretStream & \\
-\$newspad & ncTopLevel & \\
-\$nopos & & SpadInterpretStream \\
-\$okToExecuteMachineCode & SpadInterpretStream & \\
-\$oldHistoryFileName & initvars & oldHistFileName \\
-\$openServerIfTrue & restart & restart \\
- & spad-save & \\
- & initvars & \\
-\$options & & history \\
- & historySpad2Cmd & historySpad2Cmd \\
- & & undo \\
-\$previousBindings & initvars & \\
- & clearFrame & \\
- & recordFrame & recordFrame \\
-\$printLoadMsgs & restart & \\
-\$PrintCompilerMessageIfTrue & spad & \\
-\$promptMsg & SpadInterpretStream & \\
-\$relative-directory-list & & reroot \\
-\$relative-library-directory-list & & reroot \\
-\$reportUndo & initvars & diffAlist \\
-\$shoeReadLineFunction & SpadInterpretStream & \\
-\$spad & ncTopLevel & \\
-\$spadroot & reroot & initroot \\
- & & make-absolute-filename \\
- & & reroot \\
-\$SpadServer & restart & \\
-\$SpadServerName & initvars & restart \\
-\$systemCommandFunction & SpadInterpretStream & \\
-top\_level & & runspad \\
-\$quitTag & & runspad \\
-\$useInternalHistoryTable & initvars & initHist \\
- & setHistoryCore & setHistoryCore \\
-\$undoFlag & initvars & recordFrame \\
-\end{tabular}
-
-\subsection{\$boot}
-The [[$boot]] variable is set to [[NIL]] in [[ncTopLevel]].
-
-\subsection{coerceFailure}
-The [[coerceFailure]] symbol is a catch tag used in [[runspad]]
-to catch an exit from [[ncTopLevel]].
-
-\subsection{curinstream}
-The [[curinstream]] variable is set to the value of the
-[[*standard-input*]] common lisp
-variable in [[ncIntLoop]]. While not using the
-``dollar'' convention this variable is still ``global''.
-
-\subsection{curinstream}
-The [[curoutstream]] variable is set to the value of the
-[[*standard-output*]] common lisp variable in [[ncIntLoop]].
-While not using the ``dollar'' convention this variable is still ``global''.
-
-\subsection{vmlisp::\$current-directory}
-When running in Lucid Common Lisp ([[:lucid]]) on an IBM/370 mainframe
-([[:ibm/370]]) this variable is used in place of the
-[[*default-pathname-defaults*]] common lisp variable.
-Otherwise this variable is
-set to the empty string in [[restart]].
-
-The [[reroot]] function sets this variable to the value of
-[[$spadroot]] which itself has the value of the argument to the
-[[reroot]] function. Since the argument to the [[reroot]] function is
-an string which represents an absolute pathname pointing to AXIOM the
-net result is that the [[$current-directory]] is set to point to the
-shell [[AXIOM]] variable.
-
-So during execute both [[$current-directory]] and [[$spadroot]] reflect
-the value of the [[AXIOM]] shell variable.
-
-\subsection{\$currentLine}
-The [[$currentLine]] line is set to [[NIL]] in [[restart]].
-It is used in [[removeUndoLines]] in the undo mechanism.
-
-\subsection{\$dalymode}
-The [[$dalymode]] variable is used in a case statement in
-[[intloopReadConsole]]. This variable can be set to any non-nil
-value. When not nil the interpreter will send any line that begins
-with an ``[[(]]'' to be sent to the underlying lisp. This is useful
-for debugging Axiom. The normal value of this variable is [[NIL]].
-
-This variable was created as an alternative to prefixing every lisp
-command with [[)lisp]]. When doing a lot of debugging this is tedious
-and error prone. This variable was created to shortcut that process.
-Clearly it breaks some semantics of the language accepted by the
-interpreter as parens are used for grouping expressions.
-
-\subsection{\$defaultMsgDatabaseName}
-The [[$defaultMsgDatabaseName]] is the absolute path to the
-[[s2-us.msgs]] file which contains all of the english language
-messages output by the system.
-
-\subsection{\$directory-list}
-The [[$directory-list]] is a list of absolute directory names.
-These names are made absolute by mapping the [[make-absolute-filename]]
-over the variable [[$relative-directory-list]].
-
-\subsection{\$displayStartMsgs}
-The [[$displayStartMsgs]] variable is used in [[restart]] but is not
-set so this is likely a bug.
-
-\subsection{\$e}
-The [[$e]] variable is set to the value of
-[[$InteractiveFrame]] which is set in [[restart]] to the value of the
-call to the [[makeInitialModemapFrame]] function. This function simply
-returns a copy of the variable [[$InitialModemapFrame]].
-
-Thus [[$e]] is a copy of the variable [[$InitialModemapFrame]].
-
-This variable is used in the undo mechanism.
-
-\subsection{\$erMsgToss}
-The [[$erMsgToss]] variable is set to [[NIL]] in [[SpadInterpretStream]].
-
-\subsection{\$fn}
-The [[$fn]] variable is set in [[SpadInterpretStream]]. It is set to
-the second argument which is a list. It appears that this list has the
-same structure as an argument to the LispVM [[rdefiostream]] function.
-
-\subsection{\$frameRecord}
-[[$frameRecord = [delta1, delta2,... ] ]] where
-[[delta(i)]] contains changes in the ``backwards'' direction.
-Each [[delta(i)]] has the form [[((var . proplist)...)]] where
-proplist denotes an ordinary proplist. For example, an entry
-of the form [[((x (value) (mode (Integer)))...)]] indicates that
-to undo 1 step, [[x]]'s value is cleared and its mode should be set
-to [[(Integer)]].
-
-A [[delta(i)]] of the form [[(systemCommand . delta)]] is a special
-delta indicating changes due to system commands executed between
-the last command and the current command. By recording these deltas
-separately, it is possible to undo to either BEFORE or AFTER
-the command. These special [[delta(i)]]s are given ONLY when a
-a system command is given which alters the environment.
-
-Note: [[recordFrame('system)]] is called before a command is executed, and
-[[recordFrame('normal)]] is called after (see processInteractive1).
-If no changes are found for former, no special entry is given.
-
-This is part of the undo mechanism.
-
-\subsection{\$genValue}
-If the [[$genValue]] variable is true then evaluate generated code,
-otherwise leave code unevaluated. If [[$genValue]] is false then we
-are compiling. This variable is only defined and used locally.
-<<initvars>>=
-(defvar |$genValue| nil "evaluate generated code if true")
-
-@
-
-\subsection{\$HiFiAccess}
-The [[$HiFiAccess]] is set by [[initHist]] to [[T]]. It is a flag
-used by the history mechanism to record whether the history function
-is currently on. It can be reset by using the axiom
-command
-\begin{verbatim}
- )history off
-\end{verbatim}
-It appears that the name means ``History File Access''.
-
-The [[$HiFiAccess]] variable is used by [[historySpad2Cmd]] to check
-whether history is turned on. [[T]] means it is, [[NIL]] means it is not.
-
-\subsection{\$HistList}
-Thie [[$HistList]] variable is set by [[initHistList]] to an initial
-value of [[NIL]] elements. The last element of the list is smashed to
-point to the first element to make the list circular.
-This is a circular list of length [[$HistListLen]].
-
-\subsection{\$HistListAct}
-The [[$HistListAct]] variable is set by [[initHistList]] to [[0]].
-This variable holds the actual number of elements in the history list.
-This is the number of ``undoable'' steps.
-
-\subsection{\$HistListLen}
-The [[$HistListLen]] variable is set by [[initHistList]] to [[20]].
-This is the length of a circular list maintained in the variable
-[[$HistList]].
-
-\subsection{\$HistRecord}
-The [[$HistRecord]] variable is set by [[initHistList]] to [[NIL]].
-[[$HistRecord]] collects the input line, all variable bindings
-and the output of a step, before it is written to the file named by
-the function [[histFileName]].
-
-\subsection{\$historyFileType}
-The [[$historyFileType]] is set at load time by a call to
-[[initvars]] to a value of ``[[axh]]''. It appears that this
-is intended to be used as a filetype extension.
-It is part of the history mechanism. It is used in [[makeHistFileName]]
-as part of the history file name.
-
-\subsection{\$inclAssertions}
-The [[$inclAssertions]] is set
-in the function [[SpadInterpretStream]] to the list [[(aix |CommonLisp|)]]
-
-\subsection{\$internalHistoryTable}
-The [[$internalHistoryTable]] variable is set at load time by a call to
-[[initvars]] to a value of [[NIL]].
-It is part of the history mechanism.
-
-\subsection{\$interpreterFrameName}
-The [[$interpreterFrameName]] variable, set in
-[[initializeInterpreterFrameRing]] to the constant
-[[initial]] to indicate that this is the initial (default) frame.
-
-Frames are structures that capture all of the variables defined in a
-session. There can be multiple frames and the user can freely switch
-between them. Frames are kept in a ring data structure so you can
-move around the ring.
-
-\subsection{\$interpreterFrameRing}
-The [[$interpreterFrameRing]] is set to a pair whose car is set to
-the result of [[emptyInterpreterFrame]]
-
-\subsection{\$InitialModemapFrame}
-This variable is copied and returned by the function
-[[makeInitialModemapFrame]]. There is no initial value so this
-is probably a bug.
-
-\subsection{\$inLispVM}
-The [[$inLispVM]] is set to [[NIL]] in [[spad]]. LispVM is a
-non-common lisp that runs on IBM/370 mainframes. This is probably dead
-code. It appears that this list has the same structure as an argument
-to the LispVM [[rdefiostream]] function.
-
-\subsection{\$InteractiveFrame}
-The [[$InteractiveFrame]] is set in [[restart]] to the value of the
-call to the [[makeInitialModemapFrame]] function. This function simply
-returns a copy of the variable [[$InitialModemapFrame]]
-
-\subsection{\$InteractiveMode}
-The [[$InteractiveMode]] is set to [[T]] in [[ncTopLevel]].
-
-\subsection{\$intRestart}
-The [[$intRestart]] variable is used in [[intloop]] but has no value.
-This is probably a bug. While the variable's value is unchanged the
-system will continually reenter the [[SpadInterpretStream]] function.
-
-\subsection{\$intTopLevel}
-The [[$intTopLevel]] is a catch tag. Throwing to this tags which is
-caught in the [[intloop]] will
-restart the [[SpadInterpretStream]] function.
-
-\subsection{\$IOindex}
-The [[$IOindex]] index variable is set to [[1]] in [[restart]].
-This variable is used in the [[historySpad2Cmd]] function in the
-history mechanism. It is set in the [[removeUndoLines]] function
-in the undo mechanism.
-
-This is used in the undo mechanism in function [[undoCount]]
-to compute the number of undos. You can't undo more actions then
-have already happened.
-
-\subsection{\$lastPos}
-The [[$lastPos]] variable is set in [[SpadInterpretStream]]
-to the value of the [[$nopos]] variable.
-Since [[$nopos]] appears to have no value
-this is likely a bug.
-
-\subsection{\$libQuiet}
-The [[$libQuiet]] variable is set to the third argument of the
-[[SpadInterpretStream]] function. This is passed from [[intloop]]
-with the value of [[T]]. This variable appears to be intended to
-control the printing of library loading messages which would need
-to be suppressed if input was coming from a file.
-
-\subsection{\$library-directory-list}
-The [[$library-directory-list]] variable is set by [[reroot]] by
-mapping the function [[make-absolute-filename]] across the
-[[$relative-library-directory-list]] variable which is not yet set so this
-is probably a bug.
-
-\subsection{\$msgDatabaseName}
-The [[$msgDatabaseName]] is set to [[NIL]] in [[reroot]].
-
-\subsection{\$ncMsgList}
-The [[$ncMsgList]] is set to [[NIL]] in [[SpadInterpretStream]].
-
-\subsection{\$newcompErrorCount}
-The [[$newcompErrorCount]] is set to [[0]] in [[SpadInterpretStream]].
-
-\subsection{\$newcompMode}
-The [[$newcompMode]] is set to [[NIL]] in [[SpadInterpretStream]].
-
-\subsection{\$newspad}
-The [[$newspad]] is set to [[T]] in [[ncTopLevel]].
-
-\subsection{\$nopos}
-The [[$nopos]] variable is used in [[SpadInterpretStream]] but does
-not appear to have a value and is likely a bug.
-
-\subsection{\$oldHistoryFileName}
-The [[$oldHistoryFileName]] is set at load time by a call to
-[[initvars]] to a value of ``[[last]]''.
-It is part of the history mechanism. It is used in the function
-[[oldHistFileName]] and [[restoreHistory]].
-
-\subsection{\$okToExecuteMachineCode}
-The [[$okToExecuteMachineCode]] is set to [[T]] in [[SpadInterpretStream]].
-
-\subsection{\$options}
-The [[$options]] variable is tested by the [[history]] function.
-If it is [[NIL]] then output the message
-\begin{verbatim}
- You have not used the correct syntax for the history command.
- Issue )help history for more information.
-\end{verbatim}
-
-The [[$options]] variable is tested in the [[historySpad2Cmd]] function.
-It appears to record the options that were given to a spad command on
-the input line. The function [[selectOptionLC]] appears to take a list
-off options to scan.
-
-This variable is not yet set and is probably a bug.
-
-\subsection{\$previousBindings}
-The [[$previousBindings]] is a copy of the
-[[CAAR $InteractiveFrame]]. This is used to
-compute the [[delta(i)]]s stored in [[$frameRecord]].
-This is part of the undo mechanism.
-
-\subsection{\$printLoadMsgs}
-The [[$printLoadMsgs]] variable is set to [[T]] in [[restart]].
-
-\subsection{\$PrintCompilerMessageIfTrue}
-The [[$PrintCompilerMessageIfTrue]] variable is set to [[NIL]] in [[spad]].
-
-\subsection{\$openServerIfTrue}
-The [[$openServerIfTrue]] is tested in [[restart]] before it has been
-set (and is thus a bug). It appears to control whether the interpreter
-will be used as an open server, probably for OpenMath use.
-
-If an open server is not requested then this variable to [[NIL]]
-
-\subsection{\$promptMsg}
-The [[$promptMsg]] variable is set to the constant [[S2CTP023]]. This
-constant points to a message in [[src/doc/msgs/s2-us.msgs]]. This message
-does nothing but print the argument value.
-
-\subsection{\$relative-directory-list}
-The [[$relative-directory-list]] is used in [[reroot]] to create
-[[$directory-list]] which is a list of absolute directory names.
-It is not yet set and is probably a bug.
-
-\subsection{\$relative-library-directory-list}
-The [[$relative-library-directory-list]] is used in [[reroot]] to create
-a list of absolute directory names from [[$library-directory-list]] (which is
-It is not yet set and is probably a bug).
-
-\subsection{\$reportUndo}
-The [[$reportUndo]] variable is used in [[diffAlist]]. It was not normally
-bound but has been set to [[T]] in [[initvars]]. If the variable is set
-to [[T]] then we call [[reportUndo]].
-
-It is part of the undo mechanism.
-
-\subsection{\$shoeReadLineFunction}
-The [[$shoeReadLineFunction]] is set in [[SpadInterpretStream]]
-to point to the
-[[serverReadLine]]
-
-\subsection{\$spadroot}
-The [[$spadroot]] variable is the internal name for the [[AXIOM]]
-shell variable.
-
-The [[$spadroot]] variable is set in [[reroot]] to the value of the
-argument. The argument is expected to be a directory name.
-
-The [[$spadroot]] variable is tested in [[initroot]].
-
-The [[$spadroot]] variable is used by the function
-[[make-absolute-filename]]. It concatenates this variable to the
-front of a relative pathname to make it absolute.
-\subsection{\$spad}
-The [[$spad]] variable is set to [[T]] in [[ncTopLevel]].
-
-\subsection{\$SpadServer}
-If an open server is not requested then this variable to [[T]].
-It has no value before this time (and is thus a bug).
-
-\subsection{\$SpadServerName}
-The [[$SpadServerName]] is passed to the [[openServer]] function, if the
-function exists.
-
-\subsection{\$systemCommandFunction}
-The [[$systemCommandFunction]] is set in [[SpadInterpretStream]]
-to point to the function
-[[InterpExecuteSpadSystemCommand]].
-
-\subsection{top\_level}
-The [[top\_level]] symbol is a catch tag used in [[runspad]]
-to catch an exit from [[ncTopLevel]].
-
-\subsection{\$quitTag}
-The [[$quitTag]] is used as a variable in a [[catch]] block.
-It appears that it can be thrown somewhere below [[ncTopLevel]].
-
-\subsection{\$useInternalHistoryTable}
-The [[$useInternalHistoryTable]] variable is set at load time by a call to
-[[initvars]] to a value of [[NIL]]. It is part of the history mechanism.
-
-\subsection{\$undoFlag}
-The [[$undoFlag]] is used in [[recordFrame]] to decide whether to do
-undo recording. It is initially set to [[T]] in [[initvars]].
-This is part of the undo mechanism.
-
-\chapter{Starting Axiom}
-Axiom starts by invoking a function value of the lisp symbol
-[[*top-level-hook*]]. The function invocation path to from this
-point until the prompt is approximates (skipping initializations):
-\begin{verbatim}
- lisp -> restart
- -> |spad|
- -> |runspad|
- -> |ncTopLevel|
- -> |ncIntLoop|
- -> |intloop|
- -> |SpadInterpretStream|
- -> |intloopReadConsole|
-\end{verbatim}
-The [[|intloopReadConsole|]] function does tail-recursive calls to
-itself (don't break this) and never exits.
-\section{Variables Used}
-\section{Data Structures}
-\section{Functions}
-\subsection{defun set-restart-hook}
-When a lisp image containing code is reloaded there is a hook to
-allow a function to be called. In our case it is the [[restart]]
-function which is the entry to the Axiom interpreter.
-<<defun set-restart-hook>>=
-(defun set-restart-hook ()
- #+KCL (setq system::*top-level-hook* 'restart)
- #+Lucid (setq boot::restart-hook 'restart)
- 'restart
- )
-
-@
-\subsection{defun restart}
-The restart function is the real root of the world. It sets up memory
-if we are working in a GCL/akcl version of the system. It sets the
-current package to be the ``BOOT'' package which is the standard
-package in which the interpreter runs. It calls initroot \cite{1}
-to set the \$spadroot variable (usually the \$AXIOM variable).
-
-The [[compiler::*compile-verbose*]] flag has been set to nil globally.
-We do not want to know about the microsteps of GCL's compile facility.
-
-The [[compiler::*suppress-compiler-warnings*]] flag has been set to t.
-We do not care that certain generated variables are not used.
-
-The [[compiler::*suppress-compiler-notes*]] flag has been set to t.
-We do not care that tail recursion occurs.
-<<defun restart>>=
-(defun restart ()
-#+:akcl
- (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8
- :array 400 :string 500 :cfun 100 :cpages 3000 :rpages 1000 :hole 2000)
-#+:akcl (setq compiler::*compile-verbose* nil)
-#+:akcl (setq compiler::*suppress-compiler-warnings* t)
-#+:akcl (setq compiler::*suppress-compiler-notes* t)
-#-:CCL
- (in-package "BOOT")
-#+:CCL
- (setq *package* (find-package "BOOT"))
-#+:CCL (setpchar "") ;; Turn off CCL read prompts
-#+(OR :akcl :CCL) (initroot)
-#+:akcl (system:gbc-time 0)
-#+:akcl
- (when (and $openServerIfTrue (fboundp '|openServer|))
- (prog (os)
- (setq os (|openServer| $SpadServerName))
- (if (zerop os)
- (progn
- (setq $openServerIfTrue nil)
- (setq |$SpadServer| t)))))
-;; We do the following test at runtime to allow us to use the same images
-;; with Saturn and Sman. MCD 30-11-95
-#+:CCL
- (when
- (and (memq :unix *features*) $openServerIfTrue (fboundp '|openServer|))
- (prog (os)
- (setq os (|openServer| $SpadServerName))
- (if (zerop os)
- (progn
- (setq $openServerIfTrue nil)
- (setq |$SpadServer| t)))))
- (setq |$IOindex| 1)
- (setq |$InteractiveFrame| (|makeInitialModemapFrame|))
- (setq |$printLoadMsgs| t)
-#+(and :lucid :ibm/370)
- (setq *default-pathname-defaults* "")
-#+:CCL
- (setq *default-pathname-defaults* (get-current-directory))
-#-(or :CCL (and :lucid :ibm/370))
- (setq *default-pathname-defaults* (probe-file "./"))
-#+(and :lucid :ibm/370)
- (setq vmlisp::$current-directory "")
-#-(and :lucid :ibm/370)
- (setq vmlisp::$current-directory
- (make-directory *default-pathname-defaults*))
- (|loadExposureGroupData|)
- (|statisticsInitialization|)
- (|initHist|)
- (|initializeInterpreterFrameRing|)
-
- (when |$displayStartMsgs|
- (|spadStartUpMsgs|))
- (setq |$currentLine| nil)
- (restart0)
- (|readSpadProfileIfThere|)
- (|spad|))
-
-@
-\subsection{defun spad}
-\begin{verbatim}
-spad() ==
- -- starts the interpreter but does not read in profiles, etc.
- $PrintCompilerMessageIfTrue: local
- $inLispVM : local := nil
- setOutputAlgebra "%initialize%"
- runspad()
- 'EndOfSpad
-\end{verbatim}
-<<defun spad>>=
-(defun |spad| ()
- (prog (|$PrintCompilerMessageIfTrue| |$inLispVM|)
- (declare (special |$PrintCompilerMessageIfTrue| |$inLispVM|))
- (return
- (progn
- (spadlet |$PrintCompilerMessageIfTrue| nil)
- (spadlet |$inLispVM| nil)
- (|setOutputAlgebra| '|%initialize%|)
- (|runspad|)
- '|EndOfSpad|))))
-
-@
-\subsection{defun runspad}
-\begin{verbatim}
-runspad() ==
- mode:='restart
- while mode='restart repeat
- resetStackLimits()
- CATCH($quitTag, CATCH('coerceFailure,
- mode:=CATCH('top__level, ncTopLevel())))
-\end{verbatim}
-<<defun runspad>>=
-(defun |runspad| ()
- (prog (mode)
- (return
- (seq
- (progn
- (spadlet mode '|restart|)
- (do ()
- ((null (boot-equal mode '|restart|)) NIL)
- (seq
- (exit
- (progn
- (|resetStackLimits|)
- (catch |$quitTag|
- (catch '|coerceFailure|
- (spadlet mode (catch '|top_level| (|ncTopLevel|))))))))))))))
-
-@
-\subsection{defun ncTopLevel}
-\begin{verbatim}
-ncTopLevel() ==
--- Top-level read-parse-eval-print loop for the interpreter. Uses
--- the Bill Burge's parser.
- IN_-STREAM: fluid := CURINSTREAM
- _*EOF_*: fluid := NIL
- $InteractiveMode :fluid := true
- $BOOT: fluid := NIL
- $NEWSPAD: fluid := true
- $SPAD: fluid := true
- $e:fluid := $InteractiveFrame
- ncIntLoop()
-\end{verbatim}
-<<defun ncTopLevel>>=
-(defun |ncTopLevel| ()
- (prog (|$e| $spad $newspad $boot |$InteractiveMode| *eof* in-stream)
- (declare (special |$e| $spad $newspad $boot |$InteractiveMode| *eof*
- in-stream |$InteractiveFrame|))
- (return
- (progn
- (setq in-stream curinstream)
- (setq *eof* nil)
- (setq |$InteractiveMode| t)
- (setq $boot nil)
- (setq $newspad t)
- (setq $spad t)
- (setq |$e| |$InteractiveFrame|)
- (|ncIntLoop|)))))
-
-@
-\subsection{defun ncIntLoop}
-<<defun ncIntLoop>>=
-(defun |ncIntLoop| ()
- (let ((curinstream *standard-output*)
- (curoutstream *standard-input*))
- (declare (special curinstream curoutstream))
- (|intloop|)))
-
-@
-\subsection{defun intloop}
-Note that the [[SpadInterpretStream]] function uses a list of
-three strings as an argument. The values in the list seem to have
-no use and can eventually be removed.
-\begin{verbatim}
-intloop () ==
- mode := $intRestart
- while mode = $intRestart repeat
- resetStackLimits()
- mode := CATCH($intTopLevel,
- SpadInterpretStream(1, ["TIM", "DALY", "?"], true))
-
-\end{verbatim}
-<<defun intloop>>=
-(defun |intloop| ()
- (prog (mode)
- (declare (special |$intTopLevel| |$intRestart|))
- (return
- (progn
- (setq mode |$intRestart|)
- ((lambda ()
- (loop
- (cond
- ((not (equal mode |$intRestart|))
- (return nil))
- (t
- (progn
- (|resetStackLimits|)
- (setq mode
- (catch |$intTopLevel|
- (|SpadInterpretStream| 1
- (list 'tim 'daly '?) t)))))))))))))
-
-@
-\subsection{defun SpadInterpretStream}
-The [[SpadInterpretStream]] function takes three arguments
-\begin{list}{}
-\item [[str]] This is passed as an argument to [[intloopReadConsole]]
-\item [[source]] This is the name of a source file but appears not
-to be used. It is set to the list [[(tim daly ?)]].
-\item [[interactive?]] If this is false then various messages are
-suppressed and input does not use piles. If this is true then the
-library loading routines might output messages and piles are expected
-on input (as from a file).
-\end{list}
-\begin{verbatim}
-SpadInterpretStream(str, source, interactive?) ==
- $fn : local := source
- pile? := not interactive?
- $libQuiet : local := not interactive?
- $newcompMode : local := false
--- following seems useless and causes ccl package problems
--- $InteractiveMode : local := false
-
- $newcompErrorCount: local := 0 -- SMW Feb 2/90.
- -- Used in highComplete, ncHardError etc.
-
- $okToExecuteMachineCode: local := true -- set false on error
- $inclAssertions: local := ["AIX", "CommonLisp"] -- Jan 28/90
-
-
- $lastPos : local := $nopos ------------>!!!
- $erMsgToss : local := false --------------->!!!
- $ncMsgList : local := nil
-
- $systemCommandFunction : local := function InterpExecuteSpadSystemCommand
- $shoeReadLineFunction : local := function serverReadLine
- $promptMsg : local := 'S2CTP023
-
- interactive? =>
- PRINC(MKPROMPT())
- intloopReadConsole('"", str)
- []
- intloopInclude (source,0)
- []
-
- -----------------------------------------------------------------
-\end{verbatim}
-<<defun SpadInterpretStream>>=
-(defun |SpadInterpretStream| (str source interactive?)
- (prog (|$promptMsg| |$shoeReadLineFunction| |$systemCommandFunction|
- |$ncMsgList| |$erMsgToss| |$lastPos| |$inclAssertions|
- |$okToExecuteMachineCode| |$newcompErrorCount| |$newcompMode|
- |$libQuiet| |$fn|)
- (declare (special |$promptMsg| |$shoeReadLineFunction|
- |$systemCommandFunction| |$ncMsgList| |$erMsgToss| |$lastPos|
- |$inclAssertions| |$okToExecuteMachineCode| |$newcompErrorCount|
- |$newcompMode| |$libQuiet| |$fn| |$nopos|))
- (return
- (progn
- (setq |$fn| source)
- (setq |$libQuiet| (null interactive?))
- (setq |$newcompMode| nil)
- (setq |$newcompErrorCount| 0)
- (setq |$okToExecuteMachineCode| t)
- (setq |$inclAssertions| (list 'aix '|CommonLisp|))
- (setq |$lastPos| |$nopos|)
- (setq |$erMsgToss| nil)
- (setq |$ncMsgList| nil)
- (setq |$systemCommandFunction| #'|InterpExecuteSpadSystemCommand|)
- (setq |$shoeReadLineFunction| #'|serverReadLine|)
- (setq |$promptMsg| 'S2CTP023)
- (cond
- (interactive?
- (progn
- (princ (mkprompt))
- (|intloopReadConsole| "" str)
- nil))
- (t
- (progn
- (|intloopInclude| source 0)
- nil)))))))
-
-@
-\section{The Read-Eval-Print Loop}
-\subsection{defun intloopReadConsole}
-Note that this function relies on the fact that lisp can do tail-recursion.
-The function recursively invokes itself.
-
-The serverReadLine function is a special readline function that handles
-communication with the session manager code, which is a separate process
-running in parallel.
-
-We read a line from standard input.
-\begin{itemize}
-\item If it is a null line then we exit Axiom.
-\item If it is a zero length line we prompt and recurse
-\item If \$dalymode and open-paren we execute lisp code, prompt and recurse
-The \$dalymode will interpret any input that begins with an open-paren
-as a lisp expression rather than Axiom input. This is useful for debugging
-purposes when most of the input lines will be lisp. Setting \$dalymode
-non-nil will certainly break user expectations and is to be used with
-caution.
-\item If it is ``)fi'' or ``)fin'' we drop into lisp. Use the (restart)
- function to return to the interpreter loop.
-\item If it starts with ``)'' we process the command, prompt, and recurse
-\item If it is a command then we remember the current line, process the
- command, prompt, and recurse.
-\item If the input has a trailing underscore (Axiom line-continuation)
- then we cut off the continuation character and pass the truncated
- string to ourselves, prompt, and recurse
-\item otherwise we process the input, prompt, and recurse.
-\end{itemize}
-Notice that all but two paths (a null input or a ``)fi'' or a ``)fin'')
-will end up as a recursive call to ourselves.
-<<defun intloopReadConsole>>=
-(defun |intloopReadConsole| (b n)
- (declare (special $dalymode))
- (let (c d pfx input)
- (setq input (|serverReadLine| *standard-input*))
- (when (null (stringp input)) (|leaveScratchpad|))
- (when (eql (length input) 0)
- (princ (mkprompt))
- (|intloopReadConsole| "" n))
- (when (and $dalymode (|intloopPrefix?| "(" input))
- (|intnplisp| input)
- (princ (mkprompt))
- (|intloopReadConsole| "" n))
- (setq pfx (|intloopPrefix?| ")fi" input))
- (when (and pfx (or (string= pfx ")fi") (string= pfx ")fin")))
- (throw '|top_level| nil))
- (when (and (equal b "") (setq d (|intloopPrefix?| ")" input)))
- (|setCurrentLine| d)
- (setq c (|ncloopCommand| d n))
- (princ (mkprompt))
- (|intloopReadConsole| "" c))
- (setq input (concat b input))
- (when (|ncloopEscaped| input)
- (|intloopReadConsole| (subseq input 0 (- (length input) 1)) n))
- (setq c (|intloopProcessString| input n))
- (princ (mkprompt))
- (|intloopReadConsole| "" c)))
-
-@
-\section{Helper Functions}
-\subsection{defun getenviron}
-<<defun getenviron>>=
-(defun getenviron (shellvar)
- #+allegro (sys::getenv (string var))
- #+clisp (ext:getenv (string var))
- #+(or cmu scl)
- (cdr
- (assoc (string var) ext:*environment-list* :test #'equalp :key #'string))
- #+(or kcl akcl gcl) (si::getenv (string var))
- #+lispworks (lw:environment-variable (string var))
- #+lucid (lcl:environment-variable (string var))
- #+mcl (ccl::getenv var)
- #+sbcl (sb-ext:posix-getenv var)
- )
-@
-
-\subsection{defun init-memory-config}
-Austin-Kyoto Common Lisp (AKCL), now known as Gnu Common Lisp (GCL)
-requires some changes to the default memory setup to run Axiom efficently.
-This function performs those setup commands.
-<<defun init-memory-config>>=
-(defun init-memory-config (&key
- (cons 500)
- (fixnum 200)
- (symbol 500)
- (package 8)
- (array 400)
- (string 500)
- (cfun 100)
- (cpages 3000)
- (rpages 1000)
- (hole 2000) )
- ;; initialize AKCL memory allocation parameters
- #+:AKCL
- (progn
- (system:allocate 'cons cons)
- (system:allocate 'fixnum fixnum)
- (system:allocate 'symbol symbol)
- (system:allocate 'package package)
- (system:allocate 'array array)
- (system:allocate 'string string)
- (system:allocate 'cfun cfun)
- (system:allocate-contiguous-pages cpages)
- (system:allocate-relocatable-pages rpages)
- (system:set-hole-size hole))
- #-:AKCL
- nil)
-
-@
-
-\subsection{defun initroot}
-Sets up the system to use the {\bf AXIOM} shell variable if we can
-and default to the {\bf \$spadroot} variable (which was the value
-of the {\bf AXIOM} shell variable at build time) if we can't.
-<<defun initroot>>=
-(defun initroot (&optional (newroot (BOOT::|getEnv| "AXIOM")))
- (reroot (or newroot $spadroot (error "setenv AXIOM or (setq $spadroot)"))))
-
-@
-
-\subsection{defun intloopPrefix?}
-If the prefix string is the same as the whole string initial characters
-(ignoring spaces in the whole string) then we return the whole string
-minus any leading spaces.
-<<defun intloopPrefix?>>=
-(defun |intloopPrefix?| (prefix whole)
- (let ((newprefix (string-left-trim '(#\space) prefix))
- (newwhole (string-left-trim '(#\space) whole)))
- (when (<= (length newprefix) (length newwhole))
- (when (string= newprefix newwhole :end2 (length prefix))
- newwhole))))
-
-@
-\subsection{defun loadExposureGroupData}
-<<defun loadExposureGroupData>>=
-#+:AKCL
-(defun |loadExposureGroupData| ()
- (cond
- ((load "./exposed" :verbose nil :if-does-not-exist nil)
- '|done|)
- ((load (concat (system:getenv "AXIOM") "/algebra/exposed")
- :verbose nil :if-does-not-exist nil)
- '|done|)
- (t '|failed|) ))
-
-#+:CCL
-(defun |loadExposureGroupData| ()
- (cond
- ((load "./exposed.lsp" :verbose NIL :if-does-not-exist NIL) '|done|)
- ((load (concat (BOOT::|getEnv| "AXIOM") "/../../src/algebra/exposed.lsp")
- :verbose nil :if-does-not-exist nil) '|done|)
- (t nil) ))
-
-@
-
-\subsection{make-absolute-filename}
-Prefix a filename with the {\bf AXIOM} shell variable.
-<<defun make-absolute-filename>>=
-(defun make-absolute-filename (name)
- (concatenate 'string $spadroot name))
-
-@
-
-\subsection{defun makeInitialModemapFrame}
-\begin{verbatim}
-makeInitialModemapFrame() == COPY $InitialModemapFrame
-\end{verbatim}
-<<defun makeInitialModemapFrame>>=
-(defun |makeInitialModemapFrame| ()
- (copy |$InitialModemapFrame|))
-
-@
-
-\subsection{defun ncloopEscaped}
-The ncloopEscaped function will return true if the last non-blank
-character of a line is an underscore, the Axiom line-continuation
-character. Otherwise, it returns nil.
-<<defun ncloopEscaped>>=
-(defun |ncloopEscaped| (x)
- (let ((l (length x)))
- (dotimes (i l)
- (when (char= (char x (- l i 1)) #\_) (return t))
- (unless (char= (char x (- l i 1)) #\space) (return nil)))))
-
-@
-
-\subsection{defun reclaim}
-Call the garbage collector on various platforms.
-<<defun reclaim>>=
-#+abcl
-(defun reclaim () (ext::gc))
-#+:allegro
-(defun reclaim () (excl::gc t))
-#+:CCL
-(defun reclaim () (gc))
-#+clisp
-(defun reclaim () (#+lisp=cl ext::gc #-lisp=cl lisp::gc))
-#+(or :cmulisp :cmu)
-(defun reclaim () (ext:gc))
-#+cormanlisp
-(defun reclaim () (cl::gc))
-#+(OR IBCL KCL GCL)
-(defun reclaim () (si::gbc t))
-#+lispworks
-(defun reclaim () (hcl::normal-gc))
-#+Lucid
-(defun reclaim () (lcl::gc))
-#+sbcl
-(defun reclaim () (sb-ext::gc))
-@
-
-\subsection{defun reroot}
-The reroot function is used to reset the important variables used by
-the system. In particular, these variables are sensitive to the
-{\bf AXIOM} shell variable. That variable is renamed internally to
-be {\bf \$spadroot}. The {\bf reroot} function will change the
-system to use a new root directory and will have the same effect
-as changing the {\bf AXIOM} shell variable and rerunning the system
-from scratch. Note that we have changed from the
-NAG distribution back to the original form. If you need the NAG
-version you can push {\bf :tpd} on the {\bf *features*} variable
-before compiling this file. A correct call looks like:
-\begin{verbatim}
-(in-package "BOOT")
-(reroot "/spad/mnt/${SYS}")
-\end{verbatim}
-where the [[${SYS}]] variable is the same one set at build time.
-<<defun reroot>>=
-(defun reroot (dir)
- (setq $spadroot dir)
- (setq $directory-list
- (mapcar #'make-absolute-filename $relative-directory-list))
- (setq $library-directory-list
- (mapcar #'make-absolute-filename $relative-library-directory-list))
- (setq |$defaultMsgDatabaseName|
- (pathname (make-absolute-filename "/doc/msgs/s2-us.msgs")))
- (setq |$msgDatabaseName| ())
- (setq *default-pathname-defaults*
- (pathname (make-absolute-filename "")))
- (setq $current-directory $spadroot))
-
-@
-
-\subsection{defun setCurrentLine}
-Remember the current line. The cases are:
-\begin{itemize}
-\item If there is no \$currentLine set it to the input
-\item Is the current line a string and the input a string?
- Make them into a list
-\item Is \$currentLine not a cons cell? Make it one.
-\item Is the input a string? Cons it on the end of the list.
-\item Otherwise stick it on the end of the list
-\end{itemize}
-Note I suspect the last two cases do not occur in practice since
-they result in a dotted pair if the input is not a cons. However,
-this is what the current code does so I won't change it.
-<<defun setCurrentLine>>=
-(defun |setCurrentLine| (s)
- (cond
- ((null |$currentLine|)
- (setq |$currentLine| s))
- ((and (stringp |$currentLine|) (stringp s))
- (setq |$currentLine| (list |$currentLine| s)))
- ((not (consp |$currentLine|))
- (setq |$currentLine| (cons |$currentLine| s)))
- ((stringp s)
- (rplacd (last |$currentLine|) (cons s nil)))
- (t
- (rplacd (last |$currentLine|) s)))
- |$currentLine|)
-
-@
-
-\subsection{defun statisticsInitialization}
-<<defun statisticsInitialization>>=
-(defun |statisticsInitialization| ()
- "initialize the garbage collection timer"
- #+:akcl (system:gbc-time 0)
- nil)
-
-@
-\chapter{System Command Handling}
-\section{Variables Used}
-\subsection{defvar \$systemCommands}
-The system commands are the top-level commands available in Axiom
-that can all be invoked by prefixing the symbol with a closed-paren.
-Thus, to see they copyright you type:
-\begin{verbatim}
- )copyright
-\end{verbatim}
-New commands need to be added to this table. The command invoked will
-be the first entry of the pair and the ``user level'' of the command
-will be the second entry.
-<<initvars>>=
-(defvar |$systemCommands| nil)
-
-(eval-when (eval load)
- (setq |$systemCommands|
- '(
- (|abbreviations| . |compiler| )
- (|boot| . |development|)
- (|browse| . |development|)
- (|cd| . |interpreter|)
- (|clear| . |interpreter|)
- (|close| . |interpreter|)
- (|compiler| . |compiler| )
- (|copyright| . |interpreter|)
- (|credits| . |interpreter|)
- (|display| . |interpreter|)
- (|edit| . |interpreter|)
- (|fin| . |development|)
- (|frame| . |interpreter|)
- (|help| . |interpreter|)
- (|history| . |interpreter|)
-;; (|input| . |interpreter|)
- (|lisp| . |development|)
- (|library| . |interpreter|)
- (|load| . |interpreter|)
- (|ltrace| . |interpreter|)
- (|pquit| . |interpreter|)
- (|quit| . |interpreter|)
- (|read| . |interpreter|)
- (|savesystem| . |interpreter|)
- (|set| . |interpreter|)
- (|show| . |interpreter|)
- (|spool| . |interpreter|)
- (|summary| . |interpreter|)
- (|synonym| . |interpreter|)
- (|system| . |interpreter|)
- (|trace| . |interpreter|)
- (|undo| . |interpreter|)
- (|what| . |interpreter|)
- (|with| . |interpreter|)
- (|workfiles| . |development|)
- (|zsystemdevelopment| . |interpreter|)
- )))
-
-@
-
-\subsection{defvar \$SYSCOMMANDS}
-This table is used to look up a symbol to see if it might be a command.
-<<initvars>>=
-(defvar $SYSCOMMANDS nil)
-(eval-when (eval load)
- (setq $SYSCOMMANDS (mapcar #'car |$systemCommands|)))
-
-@
-\subsection{defvar \$noParseCommands}
-This is a list of the commands which have their arguments passed verbatim.
-Certain functions, such as the lisp function need to be able to handle
-all kinds of input that will not be acceptable to the interpreter.
-<<initvars>>=
-(defvar |$noParseCommands| nil)
-(eval-when (eval load)
- (setq |$noParseCommands|
- '( |boot|
- |copyright|
- |credits|
- |fin|
- |lisp|
- |pquit|
- |quit|
- |suspend|
- |synonym|
- |system|
- )))
-
-@
-\subsection{defvar \$tokenCommands}
-This is a list of the commands that expect the interpreter to parse
-their arguments. Thus the history command expects that Axiom will have
-tokenized and validated the input before calling the history function.
-<<initvars>>=
-(defvar |$tokenCommands| nil)
-(eval-when (eval load)
- (setq |$tokenCommands|
- '( |abbreviations|
- |cd|
- |clear|
- |close|
- |compiler|
- |depends|
- |display|
- |edit|
- |frame|
- |frame|
- |help|
- |history|
- |input|
- |library|
- |load|
- |ltrace|
- |read|
- |savesystem|
- |set|
- |spool|
- |undo|
- |what|
- |with|
- |workfiles|
- |zsystemdevelopment|
- )))
-
-@
-
-\subsection{defvar \$InitialCommandSynonymAlist}
-Axiom can create ``synonyms'' for commands. We create an initial table
-of synonyms which are in common use.
-<<initvars>>=
-(defvar |$InitialCommandSynonymAlist| nil)
-(eval-when (eval load)
- (setq |$InitialCommandSynonymAlist|
- '(
- (|?| . "what commands")
- (|ap| . "what things")
- (|apr| . "what things")
- (|apropos| . "what things")
- (|cache| . "set functions cache")
- (|cl| . "clear")
- (|cls| . "zsystemdevelopment )cls")
- (|cms| . "system")
- (|co| . "compiler")
- (|d| . "display")
- (|dep| . "display dependents")
- (|dependents| . "display dependents")
- (|e| . "edit")
- (|expose| . "set expose add constructor")
- (|fc| . "zsystemdevelopment )c")
- (|fd| . "zsystemdevelopment )d")
- (|fdt| . "zsystemdevelopment )dt")
- (|fct| . "zsystemdevelopment )ct")
- (|fctl| . "zsystemdevelopment )ctl")
- (|fe| . "zsystemdevelopment )e")
- (|fec| . "zsystemdevelopment )ec")
- (|fect| . "zsystemdevelopment )ect")
- (|fns| . "exec spadfn")
- (|fortran| . "set output fortran")
- (|h| . "help")
- (|hd| . "system hypertex &")
- (|kclam| . "boot clearClams ( )")
- (|killcaches| . "boot clearConstructorAndLisplibCaches ( )")
- (|patch| . "zsystemdevelopment )patch")
- (|pause| . "zsystemdevelopment )pause")
- (|prompt| . "set message prompt")
- (|recurrence| . "set functions recurrence")
- (|restore| . "history )restore")
- (|save| . "history )save")
- (|startGraphics| . "system $AXIOM/lib/viewman &")
- (|startNAGLink| . "system $AXIOM/lib/nagman &")
- (|stopGraphics| . "lisp (|sockSendSignal| 2 15)")
- (|stopNAGLink| . "lisp (|sockSendSignal| 8 15)")
- (|time| . "set message time")
- (|type| . "set message type")
- (|unexpose| . "set expose drop constructor")
- (|up| . "zsystemdevelopment )update")
- (|version| . "lisp *yearweek*")
- (|w| . "what")
- (|wc| . "what categories")
- (|wd| . "what domains")
- (|who| . "lisp (pprint credits)")
- (|wp| . "what packages")
- (|ws| . "what synonyms")
-)))
-
-@
-\subsection{defvar \$CommandSynonymAlist}
-The actual list of synonyms is initialized to be the same as the
-above initial list of synonyms. The user synonyms that are added
-during a session are pushed onto this list for later lookup.
-<<initvars>>=
-(defvar |$CommandSynonymAlist| nil)
-(eval-when (eval load)
- (setq |$CommandSynonymAlist| (copy-alist |$InitialCommandSynonymAlist|)))
-
-@
-\section{Functions}
-\subsection{defun ncloopCommand}
-The \$systemCommandFunction is set in SpadInterpretStream
-to point to the function InterpExecuteSpadSystemCommand.
-<<defun ncloopCommand>>=
-(defun |ncloopCommand| (line n)
- (declare (special |$systemCommandFunction|))
- (let (a)
- (cond
- ((setq a (|ncloopPrefix?| ")include" line))
- (|ncloopInclude1| a n))
- (t
- (funcall |$systemCommandFunction| line)
- n))))
-
-@
-\subsection{defun ncloopPrefix?}
-If we find the prefix string in the whole string starting at position zero
-we return the remainder of the string without the leading prefix.
-<<defun ncloopPrefix?>>=
-(defun |ncloopPrefix?| (prefix whole)
- (when (eql (search prefix whole) 0)
- (subseq whole (length prefix))))
-
-@
-\subsection{defun ncloopInclude1}
-<<defun ncloopInclude1>>=
-(defun |ncloopInclude1| (name n)
- (let (a)
- (if (setq a (|ncloopIncFileName| name))
- (|ncloopInclude| a n)
- n)))
-
-@
-\subsection{defun ncloopIncFileName}
-Returns the first non-blank substring of the given string.
-<<defun ncloopIncFileName>>=
-(defun |ncloopIncFileName| (string)
- (let (fn)
- (unless (setq fn (|incFileName| string))
- (write-line (concat string " not found")))
- fn))
-
-@
-
-\subsection{defun ncloopInclude}
-Open the file and read it in. The ncloopInclude0 function is part
-of the parser and lives in int-top.boot.
-<<defun ncloopInclude>>=
-(defun |ncloopInclude| (name n)
- (with-open-file (st name) (|ncloopInclude0| st name n)))
-
-@
-
-\subsection{defun incFileName}
-Given a string we return the first token from the string which is
-the first non-blank substring.
-<<defun incFileName>>=
-(defun |incFileName| (x)
- (car (|incBiteOff| x)))
-
-@
-
-\subsection{defun incBiteOff}
-Takes a sequence and returns the a list of the first token and the
-remaining string characters. If there are no remaining string characters
-the second string is of length 0. Effectively it "bites off" the first
-token in the string. If the string only 0 or more blanks it returns nil.
-<<defun incBiteOff>>=
-(defun |incBiteOff| (x)
- (let (blank nonblank)
- (setq x (string x))
- (when (setq nonblank (position #\space x :test-not #'char=))
- (setq blank (position #\space x :start nonblank))
- (if blank
- (list (subseq x nonblank blank) (subseq x blank))
- (list (subseq x nonblank) "")))))
-
-@
-\chapter{The Display Command}
-\section{)display}
-\begin{verbatim}
- )display abbreviations
- )display abbreviations [obj]
- )display all
- )display macros
- )display mode all
- )display mode [obj1 [obj2 ...]]
- )display names
- )display operations opname
- )display properties
- )display properties all
- )display properties [obj1 [obj2 ...]]
- )display value all
- )display value [obj1 [obj2 ...]]
-\end{verbatim}
-
-This command is used to display the contents of the workspace and
-signatures of functions with a given name. A signature gives the
-argument and return types of a function.
-
-The command
-\begin{verbatim}
- )display abbreviations
- )display abbreviations [obj]
-\end{verbatim}
-will show all of the abbreviations in the current workspace.
-
-The command
-\begin{verbatim}
- )display all
-\end{verbatim}
-is equivalent to
-\begin{verbatim}
- )display properties
-\end{verbatim}
-
-The command
-\begin{verbatim}
- )display macros
-\end{verbatim}
-will show all of the macros in the current workspace.
-
-
-The command
-\begin{verbatim}
- )display names
-\end{verbatim}
-lists the names of all user-defined objects in the workspace. This is
-useful if you do not wish to see everything about the objects and need
-only be reminded of their names.
-
-To just show the declared mode of ``d'', issue
-\begin{verbatim}
- )display mode d
-\end{verbatim}
-
-All modemaps for a given operation may be displayed by using
-\begin{verbatim}
- )display operations
-\end{verbatim}
-
-A modemap is a collection of information about a particular reference
-to an operation. This includes the types of the arguments and the
-return value, the location of the implementation and any conditions on
-the types. The modemap may contain patterns. The following displays
-the modemaps for the operation {\bf complex}:
-\begin{verbatim}
- )d op complex
-\end{verbatim}
-
-In addition to the modemaps for an operation the request to display
-an operation will be followed by examples of the operation from each
-domain.
-
-The commands
-\begin{verbatim}
- )display all
- )display properties
- )display properties all
-\end{verbatim}
-all do the same thing: show the values and types and declared modes
-of all variables in the workspace. If you have defined functions,
-their signatures and definitions will also be displayed.
-
-To show all information about a particular variable or user functions,
-for example, something named ``d'', issue
-\begin{verbatim}
- )display properties d
-\end{verbatim}
-
-To just show the value (and the type) of ``d'', issue
-\begin{verbatim}
- )display value d
-\end{verbatim}
-\section{Variables Used}
-\subsection{defvar \$displayOptions}
-The current value of \$displayOptions is
-
-<<initvars>>=
-(defvar |$displayOptions|
- '(|abbreviations| |all| |macros| |modes| |names| |operations|
- |properties| |types| |values|))
-
-@
-
-\section{Data Structures}
-\section{Functions}
-\subsection{defun display}
-This trivial function satisfies the standard pattern of making a
-user command match the name of the function which implements the
-command. That command immediatly invokes a ``Spad2Cmd'' version.
-<<defun display>>=
-(defun |display| (l)
- (displaySpad2Cmd l))
-
-@
-
-\subsection{displaySpad2Cmd}
-We process the options to the command and call the appropriate
-display function. There are really only 4 display functions.
-All of the other options are just subcases.
-
-There is a slight mismatch between the \$displayOptions list of
-symbols and the options this command accepts so we have a cond
-branch to clean up the option variable.
-
-If we fall all the way thru we use the \$displayOptions list
-to construct a list of strings for the sayMessage function
-and tell the user what options are available.
-<<defun displaySpad2Cmd>>=
-(defun displaySpad2Cmd (l)
- (declare (special |$e|))
- (let ((|$e| |$EmptyEnvironment|) (opt (car l)) (vl (cdr l))
- option optList msg)
- (if (and (pairp l) (not (eq opt '?)))
- (progn
- (setq option (|selectOptionLC| opt |$displayOptions| '|optionError|))
- (cond
- ((eq option '|all|)
- (setq l (list '|properties|))
- (setq option '|properties|))
- ((or (eq option '|modes|) (eq option '|types|))
- (setq l (cons '|type| vl))
- (setq option '|type|))
- ((eq option '|values|)
- (setq l (cons '|value| vl))
- (setq option '|value|)))
- (cond
- ((eq option '|abbreviations|)
- (if (null vl)
- (|listConstructorAbbreviations|)
- (dolist (v vl) (|abbQuery| (|opOf| v)))))
- ((eq option '|operations|) (|displayOperations| vl))
- ((eq option '|macros|) (|displayMacros| vl))
- ((eq option '|names|) (|displayWorkspaceNames|))
- (t (|displayProperties| option l))))
- (|sayMessage|
- (append
- '(" )display keyword arguments are")
- (mapcar #'(lambda (x) (format nil "~% ~a" x)) |$displayOptions|)
- (format nil "~% or abbreviations thereof"))))))
-
-@
-\subsection{defun displayOperations}
-This function takes a list of operation names. If the list is null
-we query the user to see if they want all operations printed. Otherwise
-we print the information for the requested symbols.
-<<defun displayOperations>>=
-(defun |displayOperations| (l)
- (if l
- (dolist (op l) (|reportOpSymbol| op))
- (if (yesanswer)
- (dolist (op (|allOperations|)) (|reportOpSymbol| op))
- (|sayKeyedMsg| 's2iz0059 nil))))
-
-@
-\subsection{defun yesanswer}
-This is a trivial function to simplify the logic of displaySpad2Cmd.
-If the user didn't supply an argument to the )display op command
-we ask if they wish to have all information about all Axiom operations
-displayed. If the answer is either Y or YES we return true else nil.
-<<defun yesanswer>>=
-(defun yesanswer ()
- (memq (string2id-n (upcase (|queryUserKeyedMsg| 's2iz0058 nil)) 1) '(y yes)))
-
-@
-
-\subsection{defun displayMacros}
-;displayMacros names ==
-; imacs := getInterpMacroNames()
-; pmacs := getParserMacroNames()
-; macros :=
-; null names => APPEND (imacs, pmacs)
-; names
-; macros := REMDUP macros
-; null macros => sayBrightly '" There are no Axiom macros."
-; -- first do user defined ones
-; first := true
-; for macro in macros repeat
-; macro in pmacs =>
-; if first then
-; sayBrightly ['%l,'"User-defined macros:"]
-; first := NIL
-; displayParserMacro macro
-; macro in imacs => 'iterate
-; sayBrightly ([" ",'%b, macro, '%d, " is not a known Axiom macro."])
-; -- now system ones
-; first := true
-; for macro in macros repeat
-; macro in imacs =>
-; macro in pmacs => 'iterate
-; if first then
-; sayBrightly ['%l,'"System-defined macros:"]
-; first := NIL
-; displayMacro macro
-; macro in pmacs => 'iterate
-; NIL
-<<defun displayMacros>>=
-(defun |displayMacros| (names)
- (let (imacs pmacs macros first)
- (setq imacs (|getInterpMacroNames|))
- (setq pmacs (|getParserMacroNames|))
- (if names
- (setq macros names)
- (setq macros (append imacs pmacs)))
- (setq macros (remdup macros))
- (cond
- ((null macros) (|sayBrightly| " There are no Axiom macros."))
- (t
- (setq first t)
- (do ((t0 macros (cdr t0)) (macro nil))
- ((or (atom t0) (progn (setq macro (car t0)) nil)) nil)
- (seq
- (exit
- (cond
- ((|member| macro pmacs)
- (cond
- (first (|sayBrightly| (cons '|%l| (cons "User-defined macros:"
nil))) (setq first nil)))
- (|displayParserMacro| macro))
- ((|member| macro imacs) '|iterate|)
- (t (|sayBrightly| (cons " " (cons '|%b| (cons macro (cons '|%d|
(cons " is not a known Axiom macro." nil)))))))))))
- (setq first t)
- (do ((t1 macros (cdr t1)) (macro nil))
- ((or (atom t1) (progn (setq macro (car t1)) nil)) nil)
- (seq
- (exit
- (cond
- ((|member| macro imacs)
- (cond
- ((|member| macro pmacs) '|iterate|)
- (t
- (cond
- (first
- (|sayBrightly|
- (cons '|%l|
- (cons "System-defined macros:" nil))) (setq first nil)))
- (|displayMacro| macro))))
- ((|member| macro pmacs) '|iterate|)))))
- nil))))
-
-@
-\chapter{The History Mechanism}
-\section{)history}
-\index{ugSysCmdhistory}
-
-\index{history}
-
-
-\par\noindent{\bf User Level Required:} interpreter
-
-\par\noindent{\bf Command Syntax:}
-\begin{list}{}
-\item{\tt )history )on}
-\item{\tt )history )off}
-\item{\tt )history )write} {\it historyInputFileName}
-\item{\tt )history )show [{\it n}] [both]}
-\item{\tt )history )save} {\it savedHistoryName}
-\item{\tt )history )restore} [{\it savedHistoryName}]
-\item{\tt )history )reset}
-\item{\tt )history )change} {\it n}
-\item{\tt )history )memory}
-\item{\tt )history )file}
-\item{\tt \%}
-\item{\tt \%\%({\it n})}
-\item{\tt )set history on | off}
-\end{list}
-
-\par\noindent{\bf Command Description:}
-
-The {\it history} facility within Axiom allows you to restore your
-environment to that of another session and recall previous
-computational results.
-Additional commands allow you to review previous
-input lines and to create an {\bf .input} file of the lines typed to
-\index{file!input}
-Axiom.
-
-Axiom saves your input and output if the history facility is
-turned on (which is the default).
-This information is saved if either of
-\begin{verbatim}
-)set history on
-)history )on
-\end{verbatim}
-has been issued.
-Issuing either
-\begin{verbatim}
-)set history off
-)history )off
-\end{verbatim}
-will discontinue the recording of information.
-\index{history )on}
-\index{set history on}
-\index{set history off}
-\index{history )off}
-
-Whether the facility is disabled or not,
-the value of {\tt \%} in Axiom always
-refers to the result of the last computation.
-If you have not yet entered anything,
-{\tt \%} evaluates to an object of type
-{\tt Variable('\%)}.
-The function {\tt \%\%} may be used to refer
-to other previous results if the history facility is enabled.
-In that case,
-{\tt \%\%(n)} is the output from step {\tt n} if {\tt n > 0}.
-If {\tt n < 0}, the step is computed relative to the current step.
-Thus {\tt \%\%(-1)} is also the previous step,
-{\tt \%\%(-2)}, is the step before that, and so on.
-If an invalid step number is given, Axiom will signal an error.
-
-The {\it environment} information can either be saved in a file or entirely in
-memory (the default).
-Each frame
-(\ref{ugSysCmdframe} on page~\pageref{ugSysCmdframe})
-has its own history database.
-When it is kept in a file, some of it may also be kept in memory for
-efficiency.
-When the information is saved in a file, the name of the file is
-of the form {\bf FRAME.axh} where ``{\bf FRAME}'' is the name of the
-current frame.
-The history file is placed in the current working directory
-(see \ref{ugSysCmdcd} on page~\pageref{ugSysCmdcd}).
-Note that these history database files are not text files (in fact,
-they are directories themselves), and so are not in human-readable
-format.
-
-The options to the {\tt )history} command are as follows:
-
-\begin{description}
-\item[{\tt )change} {\it n}]
-will set the number of steps that are saved in memory to {\it n}.
-This option only has effect when the history data is maintained in a
-file.
-If you have issued {\tt )history )memory} (or not changed the default)
-there is no need to use {\tt )history )change}.
-\index{history )change}
-
-\item[{\tt )on}]
-will start the recording of information.
-If the workspace is not empty, you will be asked to confirm this
-request.
-If you do so, the workspace will be cleared and history data will begin
-being saved.
-You can also turn the facility on by issuing {\tt )set history on}.
-
-\item[{\tt )off}]
-will stop the recording of information.
-The {\tt )history )show} command will not work after issuing this
-command.
-Note that this command may be issued to save time, as there is some
-performance penalty paid for saving the environment data.
-You can also turn the facility off by issuing {\tt )set history off}.
-
-\item[{\tt )file}]
-indicates that history data should be saved in an external file on disk.
-
-\item[{\tt )memory}]
-indicates that all history data should be kept in memory rather than
-saved in a file.
-Note that if you are computing with very large objects it may not be
-practical to kept this data in memory.
-
-\item[{\tt )reset}]
-will flush the internal list of the most recent workspace calculations
-so that the data structures may be garbage collected by the underlying
-Common Lisp system.
-Like {\tt )history )change}, this option only has real effect when
-history data is being saved in a file.
-
-\item[{\tt )restore} [{\it savedHistoryName}]]
-completely clears the environment and restores it to a saved session, if
-possible.
-The {\tt )save} option below allows you to save a session to a file
-with a given name. If you had issued
-{\tt )history )save jacobi}
-the command
-{\tt )history )restore jacobi}
-would clear the current workspace and load the contents of the named
-saved session. If no saved session name is specified, the system looks
-for a file called {\bf last.axh}.
-
-\item[{\tt )save} {\it savedHistoryName}]
-is used to save a snapshot of the environment in a file.
-This file is placed in the current working directory
-(see \ref{ugSysCmdcd} on page~\pageref{ugSysCmdcd}).
-Use {\tt )history )restore} to restore the environment to the state
-preserved in the file.
-This option also creates an input file containing all the lines of input
-since you created the workspace frame (for example, by starting your
-Axiom session) or last did a {\tt )clear all} or
-{\tt )clear completely}.
-
-\item[{\tt )show} [{\it n}] [{\tt both}]]
-can show previous input lines and output results.
-{\tt )show} will display up to twenty of the last input lines
-(fewer if you haven't typed in twenty lines).
-{\tt )show} {\it n} will display up to {\it n} of the last input lines.
-{\tt )show both} will display up to five of the last input lines and
-output results.
-{\tt )show} {\it n} {\tt both} will display up to {\it n} of the last
-input lines and output results.
-
-\item[{\tt )write} {\it historyInputFile}]
-creates an {\bf .input} file with the input lines typed since the start
-of the session/frame or the last {\tt )clear all} or {\tt )clear
-completely}.
-If {\it historyInputFileName} does not contain a period (``.'') in the
filename,
-{\bf .input} is appended to it.
-For example,
-{\tt )history )write chaos}
-and
-{\tt )history )write chaos.input}
-both write the input lines to a file called {\bf chaos.input} in your
-current working directory.
-If you issued one or more {\tt )undo} commands,
-{\tt )history )write}
-eliminates all
-input lines backtracked over as a result of {\tt )undo}.
-You can edit this file and then use {\tt )read} to have Axiom process
-the contents.
-\end{description}
-
-\par\noindent{\bf Also See:}
-{\tt )frame} \index{ugSysCmdframe},
-{\tt )read} \index{ugSysCmdread},
-{\tt )set} \index{ugSysCmdset}, and
-{\tt )undo} \index{ugSysCmdundo}.
-
-
-History recording is done in two different ways:
-\begin{itemize}
-\item all changes in variable bindings (i.e. previous values) are
- written to [[$HistList]], which is a circular list
-\item all new bindings (including the binding to [[%]]) are written to a
- file called [[histFileName()]]
- one older session is accessible via the file [[$oldHistFileName()]]
-\end{itemize}
-
-\section{Variables Used}
-The following global variables are used:
-\begin{list}{}
-\item [[$HistList]], [[$HistListLen]] and [[$HistListAct]] which is the
- actual number of ``undoable'' steps)
-\item [[$HistRecord]] collects the input line, all variable bindings
- and the output of a step, before it is written to the file
- [[histFileName()]].
-\item [[$HiFiAccess]] is a flag, which is reset by [[)history )off]]
-\end{list}
-The result of step n can be accessed by [[%n]], which is translated
-into a call of [[fetchOutput(n)]]. The
-[[updateHist]] is called after every interpreter step. The
-[[putHist]] function records all changes in the environment to [[$HistList]]
- and [[$HistRecord]]
-
-\subsection{Initialized history variables}
-<<initvars>>=
-(defvar |$oldHistoryFileName| '|last| "vm/370 filename name component")
-(defvar |$historyFileType| '|axh| "vm/370 filename type component")
-(defvar |$historyDirectory| 'A "vm/370 filename disk component")
-(defvar |$HiFiAccess| t "t means turn on history mechanism")
-(defvar |$useInternalHistoryTable| t "t means keep history in core")
-
-@
-\section{Data Structures}
-\section{Functions}
-\subsection{defun makeHistFileName}
-\begin{verbatim}
-makeHistFileName(fname) ==
- makePathname(fname,$historyFileType,$historyDirectory)
-\end{verbatim}
-<<defun makeHistFileName>>=
-(defun |makeHistFileName| (fname)
- (|makePathname| fname |$historyFileType| |$historyDirectory|))
-
-@
-\subsection{defun oldHistFileName}
-\begin{verbatim}
-oldHistFileName() ==
- makeHistFileName($oldHistoryFileName)
-\end{verbatim}
-<<defun oldHistFileName>>=
-(defun |oldHistFileName| ()
- (|makeHistFileName| |$oldHistoryFileName|))
-
-@
-\subsection{defun histFileName}
-\begin{verbatim}
-histFileName() ==
- makeHistFileName($interpreterFrameName)
-\end{verbatim}
-<<defun histFileName>>=
-(defun |histFileName| ()
- (|makeHistFileName| |$interpreterFrameName|))
-
-@
-\subsection{defun histInputFileName}
-\begin{verbatim}
-histInputFileName(fn) ==
- null fn =>
- makePathname($interpreterFrameName,'INPUT,$historyDirectory)
- makePathname(fn,'INPUT,$historyDirectory)
-\end{verbatim}
-<<defun histInputFileName>>=
-(defun |histInputFileName| (fn)
- (if (null fn)
- (|makePathname| |$interpreterFrameName| 'input |$historyDirectory|)
- (|makePathname| fn 'input |$historyDirectory|)))
-@
-
-\subsection{defun initHist}
-\begin{verbatim}
-initHist() ==
- $useInternalHistoryTable => initHistList()
- oldFile := oldHistFileName()
- newFile := histFileName()
- -- see if history directory is writable
- histFileErase oldFile
- if MAKE_-INPUT_-FILENAME newFile then $REPLACE(oldFile,newFile)
- $HiFiAccess:= 'T
- initHistList()
-\end{verbatim}
-<<defun initHist>>=
-(defun |initHist| ()
- (prog (oldFile newFile)
- (return
- (cond
- (|$useInternalHistoryTable|
- (|initHistList|))
- (t
- (spadlet oldFile (|oldHistFileName|))
- (spadlet newFile (|histFileName|))
- (|histFileErase| oldFile)
- (when (make-input-filename newFile)
- ($replace oldFile newFile))
- (spadlet |$HiFiAccess| t)
- (|initHistList|))))))
-
-@
-\subsection{defun initHistList}
-\begin{verbatim}
-initHistList() ==
- -- creates $HistList as a circular list of length $HistListLen
- -- and $HistRecord
- $HistListLen:= 20
- $HistList:= LIST NIL
- li:= $HistList
- for i in 1..$HistListLen repeat li:= CONS(NIL,li)
- RPLACD($HistList,li)
- $HistListAct:= 0
- $HistRecord:= NIL
-\end{verbatim}
-<<defun initHistList>>=
-(defun |initHistList| ()
- (prog (li)
- (return
- (seq
- (progn
- (spadlet |$HistListLen| 20)
- (spadlet |$HistList| (list nil))
- (spadlet li |$HistList|)
- (do ((|i| 1 (qsadd1 |i|)))
- ((qsgreaterp |i| |$HistListLen|) nil)
- (seq
- (exit
- (spadlet li (cons nil li)))))
- (rplacd |$HistList| li)
- (spadlet |$HistListAct| 0)
- (spadlet |$HistRecord| NIL))))))
-
-@
-\subsection{defun history}
-\begin{verbatim}
-history l ==
- l or null $options => sayKeyedMsg("S2IH0006",NIL)
- historySpad2Cmd()
-\end{verbatim}
-<<defun history>>=
-(defun |history| (l)
- (cond
- ((or l (null |$options|))
- (|sayKeyedMsg| 'S2IH0006 nil)) ; syntax error
- (t
- (|historySpad2Cmd|))))
-
-@
-\subsection{defun historySpad2Cmd}
-\begin{verbatim}
-historySpad2Cmd() ==
- -- history is a system command which can call resetInCoreHist
- -- and changeHistListLen, and restore last session
- histOptions:=
- '(on off yes no change reset restore write save show file memory)
- opts:= [ [selectOptionLC(opt,histOptions,'optionError),:optargs]
- for [opt,:optargs] in $options]
- for [opt,:optargs] in opts repeat
- opt in '(on yes) =>
- $HiFiAccess => sayKeyedMsg("S2IH0007",NIL)
- $IOindex = 1 => -- haven't done anything yet
- $HiFiAccess:= 'T
- initHistList()
- sayKeyedMsg("S2IH0008",NIL)
- x := UPCASE queryUserKeyedMsg("S2IH0009",NIL)
- MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
- histFileErase histFileName()
- $HiFiAccess:= 'T
- $options := nil
- clearSpad2Cmd '(all)
- sayKeyedMsg("S2IH0008",NIL)
- initHistList()
- sayKeyedMsg("S2IH0010",NIL)
- opt in '(off no) =>
- null $HiFiAccess => sayKeyedMsg("S2IH0011",NIL)
- $HiFiAccess:= NIL
- disableHist()
- sayKeyedMsg("S2IH0012",NIL)
- opt = 'file => setHistoryCore NIL
- opt = 'memory => setHistoryCore true
- opt = 'reset => resetInCoreHist()
- opt = 'save => saveHistory optargs
- opt = 'show => showHistory optargs
- opt = 'change => changeHistListLen first optargs
- opt = 'restore => restoreHistory optargs
- opt = 'write => writeInputLines(optargs,1)
- 'done
-\end{verbatim}
-<<defun historySpad2Cmd>>=
-(defun |historySpad2Cmd| ()
- (prog (histOptions opts opt optargs x)
- (return
- (seq
- (progn
- (spadlet histOptions
- '(|on| |off| |yes| |no| |change| |reset| |restore| |write|
- |save| |show| |file| |memory|))
- (spadlet opts
- (prog (tmp1)
- (spadlet tmp1 nil)
- (return
- (do ((tmp2 |$options| (cdr tmp2)) (tmp3 NIL))
- ((or (atom tmp2)
- (progn
- (setq tmp3 (car tmp2))
- nil)
- (progn
- (progn
- (spadlet opt (car tmp3))
- (spadlet optargs (cdr tmp3))
- tmp3)
- nil))
- (nreverse0 tmp1))
- (seq
- (exit
- (setq tmp1
- (cons
- (cons
- (|selectOptionLC| opt histOptions '|optionError|)
- optargs)
- tmp1))))))))
- (do ((tmp4 opts (cdr tmp4)) (tmp5 nil))
- ((or (atom tmp4)
- (progn
- (setq tmp5 (car tmp4))
- nil)
- (progn
- (progn
- (spadlet opt (car tmp5))
- (spadlet optargs (cdr tmp5))
- tmp5)
- nil))
- nil)
- (seq
- (exit
- (cond
- ((|member| opt '(|on| |yes|))
- (cond
- (|$HiFiAccess|
- (|sayKeyedMsg| 'S2IH0007 nil)) ; history already on
- ((eql |$IOindex| 1)
- (spadlet |$HiFiAccess| t)
- (|initHistList|)
- (|sayKeyedMsg| 'S2IH0008 nil)) ; history now on
- (t
- (spadlet x ; really want to turn history on?
- (upcase (|queryUserKeyedMsg| 'S2IH0009 nil)))
- (cond
- ((memq (string2id-n x 1) '(Y YES))
- (|histFileErase| (|histFileName|))
- (spadlet |$HiFiAccess| t)
- (spadlet |$options| nil)
- (|clearSpad2Cmd| '(|all|))
- (|sayKeyedMsg| 'S2IH0008 nil) ; history now on
- (|initHistList|))
- (t
- (|sayKeyedMsg| 'S2IH0010 nil)))))) ; history still off
- ((|member| opt '(|off| |no|))
- (cond
- ((null |$HiFiAccess|)
- (|sayKeyedMsg| 'S2IH0011 nil)) ; history already off
- (t
- (spadlet |$HiFiAccess| nil)
- (|disableHist|)
- (|sayKeyedMsg| 'S2IH0012 nil)))) ; history now off
- ((boot-equal opt '|file|)
- (|setHistoryCore| nil))
- ((boot-equal opt '|memory|)
- (|setHistoryCore| t))
- ((boot-equal opt '|reset|)
- (|resetInCoreHist|))
- ((boot-equal opt '|save|)
- (|saveHistory| optargs))
- ((boot-equal opt '|show|)
- (|showHistory| optargs))
- ((boot-equal opt '|change|)
- (|changeHistListLen| (CAR optargs)))
- ((boot-equal opt '|restore|)
- (|restoreHistory| optargs))
- ((boot-equal opt '|write|)
- (|writeInputLines| optargs 1))))))
- '|done|)))))
-
-@
-\subsection{defun setHistoryCore}
-We [[case]] on the [[inCore]] argument value
-\begin{list}{}
-\item If history is already on and is kept in the same location as requested
-(file or memory) then complain.
-\item If history is not in use then start using the file or memory as
-requested. This is done by simply setting the [[$useInternalHistoryTable]]
-to the requested value, where [[T]] means use memory and [[NIL]] means
-use a file. We tell the user.
-\item If history should be in memory, that is [[inCore]] is not [[NIL]],
-and the history file already contains information we read the information
-from the file, store it in memory, and erase the history file. We modify
-[[$useInternalHistoryTable]] to [[T]] to indicate that we're maintining
-the history in memory and tell the user.
-\item Otherwise history must be on and in memory. We erase any old history
-file and then write the in-memory history to a new file
-\end{list}
-\begin{verbatim}
-setHistoryCore inCore ==
- inCore = $useInternalHistoryTable =>
- sayKeyedMsg((inCore => "S2IH0030"; "S2IH0029"),NIL)
- not $HiFiAccess =>
- $useInternalHistoryTable := inCore
- inCore => sayKeyedMsg("S2IH0032",NIL)
- sayKeyedMsg("S2IH0031",NIL)
- inCore =>
- $internalHistoryTable := NIL
- if $IOindex ^= 0 then
- -- actually put something in there
- l := LENGTH RKEYIDS histFileName()
- for i in 1..l repeat
- vec:= UNWIND_-PROTECT(readHiFi(i),disableHist())
- $internalHistoryTable := CONS([i,:vec],$internalHistoryTable)
- histFileErase histFileName()
- $useInternalHistoryTable := true
- sayKeyedMsg("S2IH0032",NIL)
- $HiFiAccess:= 'NIL
- histFileErase histFileName()
- str := RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:histFileName()]]
- for [n,:rec] in reverse $internalHistoryTable repeat
- SPADRWRITE(object2Identifier n,rec,str)
- RSHUT str
- $HiFiAccess:= 'T
- $internalHistoryTable := NIL
- $useInternalHistoryTable := NIL
- sayKeyedMsg("S2IH0031",NIL)
-\end{verbatim}
-<<defun setHistoryCore>>=
-(defun |setHistoryCore| (inCore)
- (prog (l vec str n rec)
- (cond
- ((boot-equal inCore |$useInternalHistoryTable|)
- (if inCore
- (|sayKeyedMsg| 'S2IH0030 NIL) ; memory history already in use
- (|sayKeyedMsg| 'S2IH0029 NIL))) ; file history already in use
- ((null |$HiFiAccess|)
- (spadlet |$useInternalHistoryTable| inCore)
- (if inCore
- (|sayKeyedMsg| 'S2IH0032 NIL) ; use memory history
- (|sayKeyedMsg| 'S2IH0031 NIL))) ; use file history
- (inCore
- (spadlet |$internalHistoryTable| nil)
- (cond
- ((nequal |$IOindex| 0)
- (spadlet l (length (rkeyids (|histFileName|))))
- (do ((|i| 1 (qsadd1 |i|)))
- ((qsgreaterp |i| l) NIL)
- (seq
- (exit
- (progn
- (spadlet vec (unwind-protect (|readHiFi| |i|) (|disableHist|)))
- (spadlet |$internalHistoryTable|
- (cons (cons |i| vec) |$internalHistoryTable|))))))
- (|histFileErase| (|histFileName|))))
- (spadlet |$useInternalHistoryTable| t)
- (|sayKeyedMsg| 'S2IH0032 nil)) ; use memory history
- (t
- (spadlet |$HiFiAccess| nil)
- (|histFileErase| (|histFileName|))
- (spadlet str
- (rdefiostream
- (cons
- '(mode . output)
- (cons
- (cons 'file (|histFileName|))
- nil))))
- (do ((tmp0 (reverse |$internalHistoryTable|) (cdr tmp0))
- (tmp1 NIL))
- ((or (atom tmp0)
- (progn
- (setq tmp1 (car tmp0))
- nil)
- (progn
- (progn
- (spadlet n (car tmp1))
- (spadlet rec (cdr tmp1))
- tmp1)
- nil))
- nil)
- (seq
- (exit
- (spadrwrite (|object2Identifier| n) rec str))))
- (rshut str)
- (spadlet |$HiFiAccess| t)
- (spadlet |$internalHistoryTable| nil)
- (spadlet |$useInternalHistoryTable| nil)
- (|sayKeyedMsg| 'S2IH0031 NIL))))) ; use file history
-
-@
-\subsection{defun writeInputLines}
-\begin{verbatim}
-writeInputLines(fn,initial) ==
- -- writes all input lines into file histInputFileName()
- not $HiFiAccess => sayKeyedMsg("S2IH0013",NIL) ; history not on
- null fn =>
- throwKeyedMsg("S2IH0038", nil) ; missing file name
- maxn := 72
- breakChars := [" ","+"]
- for i in initial..$IOindex - 1 repeat
- vecl := CAR readHiFi i
- if STRINGP vecl then vecl := [vecl]
- for vec in vecl repeat
- n := SIZE vec
- while n > maxn repeat
- -- search backwards for a blank
- done := nil
- for j in 1..maxn while ^done repeat
- k := 1 + maxn - j
- MEMQ(vec.k,breakChars) =>
- svec := STRCONC(SUBSTRING(vec,0,k+1),UNDERBAR)
- lineList := [svec,:lineList]
- done := true
- vec := SUBSTRING(vec,k+1,NIL)
- n := SIZE vec
- -- in case we can't find a breaking point
- if ^done then n := 0
- lineList := [vec,:lineList]
- file := histInputFileName(fn)
- histFileErase file
- inp:= DEFIOSTREAM(['(MODE . OUTPUT),['FILE,:file]],255,0)
- for x in removeUndoLines NREVERSE lineList repeat WRITE_-LINE(x,inp)
- -- see file "undo" for definition of removeUndoLines
- if fn ^= 'redo then sayKeyedMsg("S2IH0014",[namestring file])
- SHUT inp
- NIL
-\end{verbatim}
-<<defun writeInputLines>>=
-(defun |writeInputLines| (fn initial)
- (prog (maxn breakChars vecl k svec done vec n lineList file inp)
- (return
- (seq
- (cond
- ((null |$HiFiAccess|)
- (|sayKeyedMsg| 'S2IH0013 nil)) ; history is not on
- ((null fn)
- (|throwKeyedMsg| 'S2IH0038 nil)) ; missing file name
- (t
- (spadlet maxn 72)
- (spadlet breakChars (cons '| | (cons '+ nil)))
- (do ((tmp0 (spaddifference |$IOindex| 1))
- (|i| initial (+ |i| 1)))
- ((> |i| tmp0) nil)
- (seq
- (exit
- (progn
- (spadlet vecl (car (|readHiFi| |i|)))
- (cond
- ((stringp vecl) (spadlet vecl (cons vecl nil))))
- (do ((tmp1 vecl (cdr tmp1)) (vec nil))
- ((or (atom tmp1) (progn (setq vec (car tmp1)) nil)) nil)
- (seq
- (exit
- (progn
- (spadlet n (size vec))
- (do ()
- ((null (> n maxn)) nil)
- (seq
- (exit
- (progn
- (spadlet done nil)
- (do ((|j| 1 (qsadd1 |j|)))
- ((or (qsgreaterp |j| maxn) (null (null done))) nil)
- (seq
- (exit
- (progn
- (spadlet k (spaddifference (plus 1 maxn) |j|))
- (cond
- ((memq (ELT vec k) breakChars)
- (progn
- (spadlet svec (strconc
- (substring vec 0 (plus k 1)) underbar))
- (spadlet lineList (cons svec lineList))
- (spadlet done t)
- (spadlet vec (substring vec (plus k 1) nil))
- (spadlet n (size vec)))))))))
- (cond
- ((null done) (spadlet n 0))
- (t nil))))))
- (spadlet lineList (cons vec lineList))))))))))
- (spadlet file (|histInputFileName| fn))
- (|histFileErase| file)
- (spadlet inp
- (defiostream
- (cons
- '(mode . output)
- (cons (cons 'file file) nil)) 255 0))
- (do ((tmp2 (|removeUndoLines| (nreverse lineList)) (cdr tmp2))
- (x nil))
- ((or (atom tmp2)
- (progn
- (setq x (car tmp2))
- nil))
- nil)
- (seq
- (exit
- (write-line x inp))))
- (cond
- ((nequal fn '|redo|)
- (|sayKeyedMsg| 'S2IH0014 ; edit this file to see input lines
- (cons (|namestring| file) nil))))
- (shut inp)
- nil))))))
-
-@
-\subsection{defun resetInCoreHist}
-\begin{verbatim}
-resetInCoreHist() ==
- -- removes all pointers from $HistList
- $HistListAct:= 0
- for i in 1..$HistListLen repeat
- $HistList:= CDR $HistList
- RPLACA($HistList,NIL)
-\end{verbatim}
-<<defun resetInCoreHist>>=
-(defun |resetInCoreHist| ()
- (seq
- (progn
- (spadlet |$HistListAct| 0)
- (do ((|i| 1 (qsadd1 |i|)))
- ((qsgreaterp |i| |$HistListLen|) nil)
- (seq
- (exit
- (progn
- (spadlet |$HistList| (cdr |$HistList|))
- (rplaca |$HistList| nil))))))))
-
-@
-\subsection{defun changeHistListLen}
-\begin{verbatim}
-changeHistListLen(n) ==
- -- changes the length of $HistList. n must be nonnegative
- NULL INTEGERP n => sayKeyedMsg("S2IH0015",[n])
- dif:= n-$HistListLen
- $HistListLen:= n
- l:= CDR $HistList
- if dif > 0 then
- for i in 1..dif repeat l:= CONS(NIL,l)
- if dif < 0 then
- for i in 1..-dif repeat l:= CDR l
- if $HistListAct > n then $HistListAct:= n
- RPLACD($HistList,l)
- 'done
-\end{verbatim}
-<<defun changeHistListLen>>=
-(defun |changeHistListLen| (n)
- (prog (dif l)
- (return
- (seq
- (cond
- ((null (integerp n))
- (|sayKeyedMsg| 'S2IH0015 (cons n nil))) ; only positive integers
- (t
- (spadlet dif (spaddifference n |$HistListLen|))
- (spadlet |$HistListLen| n)
- (spadlet l (cdr |$HistList|))
- (cond
- ((> dif 0)
- (do ((|i| 1 (qsadd1 |i|)))
- ((qsgreaterp |i| dif) nil)
- (seq
- (exit
- (spadlet l (cons nil l)))))))
- (cond
- ((minusp dif)
- (do ((tmp0 (spaddifference dif))
- (|i| 1 (qsadd1 |i|)))
- ((qsgreaterp |i| tmp0) nil)
- (seq
- (exit
- (spadlet l (cdr l)))))
- (cond
- ((> |$HistListAct| n) (spadlet |$HistListAct| n))
- (t nil))))
- (rplacd |$HistList| l)
- '|done|))))))
-
-@
-\subsection{defun updateHist}
-\begin{verbatim}
-updateHist() ==
- -- updates the history file and calls updateInCoreHist
- null $IOindex => nil
- startTimingProcess 'history
- updateInCoreHist()
- if $HiFiAccess then
- UNWIND_-PROTECT(writeHiFi(),disableHist())
- $HistRecord:= NIL
- $IOindex:= $IOindex+1
- updateCurrentInterpreterFrame()
- $mkTestInputStack := nil
- $currentLine := nil
- stopTimingProcess 'history
-\end{verbatim}
-<<defun updateHist>>=
-(defun |updateHist| ()
- (cond
- ((null |$IOindex|) nil)
- (t
- (|startTimingProcess| '|history|)
- (|updateInCoreHist|)
- (when |$HiFiAccess|
- (unwind-protect (|writeHiFi|) (|disableHist|))
- (spadlet |$HistRecord| nil))
- (spadlet |$IOindex| (plus |$IOindex| 1))
- (|updateCurrentInterpreterFrame|)
- (spadlet |$mkTestInputStack| nil)
- (spadlet |$currentLine| nil)
- (|stopTimingProcess| '|history|))))
-
-@
-\subsection{defun updateInCoreHist}
-\begin{verbatim}
-updateInCoreHist() ==
- -- updates $HistList and $IOindex
- $HistList:= CDR($HistList)
- RPLACA($HistList,NIL)
- if $HistListAct < $HistListLen then $HistListAct:= $HistListAct+1
-\end{verbatim}
-<<defun updateInCoreHist>>=
-(defun |updateInCoreHist| ()
- (progn
- (spadlet |$HistList| (cdr |$HistList|))
- (rplaca |$HistList| nil)
- (COND
- ((> |$HistListLen| |$HistListAct|)
- (spadlet |$HistListAct| (plus |$HistListAct| 1)))
- (t nil))))
-
-@
-\subsection{defun putHist}
-\begin{verbatim}
-putHist(x,prop,val,e) ==
- -- records new value to $HistRecord and old value to $HistList
- -- then put is called with e
- if not (x='%) then recordOldValue(x,prop,get(x,prop,e))
- if $HiFiAccess then recordNewValue(x,prop,val)
- putIntSymTab(x,prop,val,e)
-\end{verbatim}
-<<defun putHist>>=
-(defun |putHist| (x prop val e)
- (progn
- (when (null (boot-equal x '%))
- (|recordOldValue| x prop (|get| x prop e)))
- (when |$HiFiAccess|
- (|recordNewValue| x prop val))
- (|putIntSymTab| x prop val e)))
-
-@
-\subsection{defun recordNewValue}
-\begin{verbatim}
-recordNewValue(x,prop,val) ==
- startTimingProcess 'history
- recordNewValue0(x,prop,val)
- stopTimingProcess 'history
-\end{verbatim}
-<<defun recordNewValue>>=
-(defun |recordNewValue| (x prop val)
- (progn
- (|startTimingProcess| '|history|)
- (|recordNewValue0| x prop val)
- (|stopTimingProcess| '|history|)))
-
-@
-\subsection{defun recordNewValue0}
-\begin{verbatim}
-recordNewValue0(x,prop,val) ==
- -- writes (prop . val) into $HistRecord
- -- updateHist writes this stuff out into the history file
- p1:= ASSQ(x,$HistRecord) =>
- p2:= ASSQ(prop,CDR p1) =>
- RPLACD(p2,val)
- RPLACD(p1,CONS(CONS(prop,val),CDR p1))
- p:= CONS(x,list CONS(prop,val))
- $HistRecord:= CONS(p,$HistRecord)
-\end{verbatim}
-<<defun recordNewValue0>>=
-(defun |recordNewValue0| (x prop val)
- (prog (p1 p2 p)
- (return
- (cond
- ((spadlet p1 (ASSQ x |$HistRecord|))
- (cond
- ((spadlet p2 (assq prop (cdr p1))) (rplacd p2 val))
- (t (rplacd p1 (cons (cons prop val) (cdr p1))))))
- (t
- (spadlet p (cons x (list (cons prop val))))
- (spadlet |$HistRecord| (cons p |$HistRecord|)))))))
-
-@
-\subsection{defun recordOldValue}
-\begin{verbatim}
-recordOldValue(x,prop,val) ==
- startTimingProcess 'history
- recordOldValue0(x,prop,val)
- stopTimingProcess 'history
-\end{verbatim}
-<<defun recordOldValue>>=
-(defun |recordOldValue| (x prop val)
- (progn
- (|startTimingProcess| '|history|)
- (|recordOldValue0| x prop val)
- (|stopTimingProcess| '|history|)))
-
-@
-\subsection{defun recordOldValue0}
-\begin{verbatim}
-recordOldValue0(x,prop,val) ==
- -- writes (prop . val) into $HistList
- p1:= ASSQ(x,CAR $HistList) =>
- not ASSQ(prop,CDR p1) =>
- RPLACD(p1,CONS(CONS(prop,val),CDR p1))
- p:= CONS(x,list CONS(prop,val))
- RPLACA($HistList,CONS(p,CAR $HistList))
-\end{verbatim}
-<<defun recordOldValue0>>=
-(defun |recordOldValue0| (x prop val)
- (prog (p1 p)
- (return
- (seq
- (when (spadlet p1 (assq x (car |$HistList|)))
- (exit
- (when (null (assq prop (cdr p1)))
- (exit
- (rplacd p1 (cons (cons prop val) (cdr p1)))))))
- (spadlet p (cons x (list (cons prop val))))
- (rplaca |$HistList| (cons p (car |$HistList|)))))))
-
-@
-\subsection{defun undoInCore}
-\begin{verbatim}
-undoInCore(n) ==
- -- undoes the last n>0 steps using $HistList
- -- resets $InteractiveFrame
- li:= $HistList
- for i in n..$HistListLen repeat li:= CDR li
- undoChanges(li)
- n:= $IOindex-n-1
- n>0 and
- $HiFiAccess =>
- vec:= CDR UNWIND_-PROTECT(readHiFi(n),disableHist())
- val:= ( p:= ASSQ('%,vec) ) and ( p1:= ASSQ('value,CDR p) ) and
- CDR p1
- sayKeyedMsg("S2IH0019",[n])
- $InteractiveFrame:= putHist('%,'value,val,$InteractiveFrame)
- updateHist()
-\end{verbatim}
-<<defun undoInCore>>=
-(defun |undoInCore| (n)
- (prog (li vec p p1 val)
- (return
- (seq
- (progn
- (spadlet li |$HistList|)
- (do ((i n (+ i 1)))
- ((> i |$HistListLen|) nil)
- (seq
- (exit
- (spadlet li (cdr li)))))
- (|undoChanges| li)
- (spadlet n (spaddifference (spaddifference |$IOindex| n) 1))
- (and
- (> n 0)
- (cond
- (|$HiFiAccess|
- (spadlet vec
- (cdr (unwind-protect (|readHiFi| n) (|disableHist|))))
- (spadlet val
- (and
- (spadlet p (assq '% vec))
- (spadlet p1 (assq '|value| (cdr p)))
- (cdr p1))))
- (t
- (|sayKeyedMsg| 'S2IH0019 (cons n nil))))) ; no history file
- (spadlet |$InteractiveFrame|
- (|putHist| '% '|value| val |$InteractiveFrame|))
- (|updateHist|))))))
-
-@
-\subsection{defun undoChanges}
-\begin{verbatim}
-undoChanges(li) ==
- -- undoes all changes of list 'li'
- if not CDR li = $HistList then undoChanges CDR li
- for p1 in CAR li repeat
- x:= CAR p1
- for p2 in CDR p1 repeat
- putHist(x,CAR p2,CDR p2,$InteractiveFrame)
-\end{verbatim}
-<<defun undoChanges>>=
-(defun |undoChanges| (li)
- (prog (x)
- (return
- (seq
- (progn
- (when (null (boot-equal (cdr li) |$HistList|))
- (|undoChanges| (cdr li)))
- (do ((tmp0 (car li) (cdr tmp0)) (p1 NIL))
- ((or (atom tmp0) (progn (setq p1 (car tmp0)) nil)) nil)
- (seq
- (exit
- (progn
- (spadlet x (car p1))
- (do ((tmp1 (cdr p1) (cdr tmp1)) (p2 nil))
- ((or (atom tmp1) (progn (setq p2 (car tmp1)) nil)) nil)
- (seq
- (exit
- (|putHist| x (car p2) (cdr p2) |$InteractiveFrame|)
- ))))))))))))
-
-@
-\subsection{defun undoFromFile}
-\begin{verbatim}
-undoFromFile(n) ==
- -- makes a clear and redoes all the assignments until step n
- for [x,:varl] in CAAR $InteractiveFrame repeat
- for p in varl repeat
- [prop,:val]:= p
- val =>
- if not (x='%) then recordOldValue(x,prop,val)
- if $HiFiAccess then recordNewValue(x,prop,val)
- RPLACD(p,NIL)
- for i in 1..n repeat
- vec:= UNWIND_-PROTECT(CDR readHiFi(i),disableHist())
- for p1 in vec repeat
- x:= CAR p1
- for p2 in CDR p1 repeat
- $InteractiveFrame:= putHist(x,CAR p2,CDR p2,$InteractiveFrame)
- val:= ( p:= ASSQ('%,vec) ) and ( p1:= ASSQ('value,CDR p) ) and CDR p1
- $InteractiveFrame:= putHist('%,'value,val,$InteractiveFrame)
- updateHist()
-\end{verbatim}
-<<defun undoFromFile>>=
-(defun |undoFromFile| (n)
- (prog (varl prop vec x p p1 val)
- (return
- (seq
- (progn
- (do ((tmp0 (caar |$InteractiveFrame|) (cdr tmp0)) (tmp1 nil))
- ((or (atom tmp0)
- (progn (setq tmp1 (car tmp0)) nil)
- (progn
- (progn
- (spadlet x (car tmp1))
- (spadlet varl (cdr tmp1))
- tmp1)
- nil))
- nil)
- (seq
- (exit
- (do ((tmp2 varl (cdr tmp2)) (p nil))
- ((or (atom tmp2) (progn (setq p (car tmp2)) nil)) nil)
- (seq
- (exit
- (progn
- (spadlet prop (car p))
- (spadlet val (cdr p))
- (when val
- (progn
- (when (null (boot-equal x '%))
- (|recordOldValue| x prop val))
- (when |$HiFiAccess|
- (|recordNewValue| x prop val))
- (rplacd p nil))))))))))
- (do ((|i| 1 (qsadd1 |i|)))
- ((qsgreaterp |i| n) nil)
- (seq
- (exit
- (progn
- (spadlet vec
- (unwind-protect (cdr (|readHiFi| |i|)) (|disableHist|)))
- (do ((tmp3 vec (cdr tmp3)) (p1 nil))
- ((or (atom tmp3) (progn (setq p1 (car tmp3)) nil)) nil)
- (seq
- (exit
- (progn
- (spadlet x (car p1))
- (do ((tmp4 (cdr p1) (cdr tmp4)) (p2 nil))
- ((or (atom tmp4) (progn (setq p2 (car tmp4)) nil)) nil)
- (seq
- (exit
- (spadlet |$InteractiveFrame|
- (|putHist| x (car p2) (CDR p2) |$InteractiveFrame|)
- ))))))))))))
- (spadlet val
- (and
- (spadlet p (assq '% vec))
- (spadlet p1 (assq '|value| (cdr p)))
- (cdr p1)))
- (spadlet |$InteractiveFrame|
- (|putHist| '% '|value| val |$InteractiveFrame|))
- (|updateHist|))))))
-
-@
-\subsection{defun saveHistory}
-\begin{verbatim}
-saveHistory(fn) ==
- $seen: local := MAKE_-HASHTABLE 'EQ
- not $HiFiAccess => sayKeyedMsg("S2IH0016",NIL)
- not $useInternalHistoryTable and
- null MAKE_-INPUT_-FILENAME histFileName() => sayKeyedMsg("S2IH0022",NIL)
- null fn =>
- throwKeyedMsg("S2IH0037", nil)
- savefile := makeHistFileName(fn)
- inputfile := histInputFileName(fn)
- writeInputLines(fn,1)
- histFileErase savefile
-
- if $useInternalHistoryTable
- then
- saveStr := RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:savefile]]
- for [n,:rec] in reverse $internalHistoryTable repeat
- val := SPADRWRITE0(object2Identifier n,rec,saveStr)
- val = 'writifyFailed =>
- sayKeyedMsg("S2IH0035", [n, inputfile]) ; unable to save step
- RSHUT saveStr
- sayKeyedMsg("S2IH0018",[namestring(savefile)]) ; saved hist file named
- nil
-\end{verbatim}
-<<defun saveHistory>>=
-(defun |saveHistory| (fn)
- (prog (|$seen| savefile inputfile saveStr n rec val)
- (declare (special |$seen|))
- (return
- (seq
- (progn
- (spadlet |$seen| (make-hashtable 'eq))
- (cond
- ((null |$HiFiAccess|)
- (|sayKeyedMsg| 'S2IH0016 nil)) ; the history file is not on
- ((and (null |$useInternalHistoryTable|)
- (null (make-input-filename (|histFileName|))))
- (|sayKeyedMsg| 'S2IH0022 nil)) ; no history saved yet
- ((null fn)
- (|throwKeyedMsg| 'S2IH0037 nil)) ; need to specify a history filename
- (t
- (spadlet savefile (|makeHistFileName| fn))
- (spadlet inputfile (|histInputFileName| fn))
- (|writeInputLines| fn 1)
- (|histFileErase| savefile)
- (when |$useInternalHistoryTable|
- (spadlet saveStr
- (rdefiostream
- (cons '(mode . output)
- (cons (cons 'file savefile) nil))))
- (do ((tmp0 (reverse |$internalHistoryTable|) (cdr tmp0))
- (tmp1 nil))
- ((or (atom tmp0)
- (progn (setq tmp1 (car tmp0)) nil)
- (progn
- (progn
- (spadlet n (car tmp1))
- (spadlet rec (cdr tmp1))
- tmp1)
- nil))
- nil)
- (seq
- (exit
- (progn
- (spadlet val
- (spadrwrite0 (|object2Identifier| n) rec saveStr))
- (when (boot-equal val '|writifyFailed|)
- (|sayKeyedMsg| 'S2IH0035 ; can't save the value of step
- (cons n (cons inputfile nil))))))))
- (rshut saveStr))
- (|sayKeyedMsg| 'S2IH0018 ; saved history file is
- (cons (|namestring| savefile) nil))
- nil)))))))
-
-@
-\subsection{defun restoreHistory}
-\begin{verbatim}
-restoreHistory(fn) ==
- -- uses fn $historyFileType to recover an old session
- -- if fn = NIL, then use $oldHistoryFileName
- if null fn then fn' := $oldHistoryFileName
- else if fn is [fn'] and IDENTP(fn') then fn' := fn'
- else throwKeyedMsg("S2IH0023",[fn'])
- restfile := makeHistFileName(fn')
- null MAKE_-INPUT_-FILENAME restfile =>
- sayKeyedMsg("S2IH0024",[namestring(restfile)]) ; no history file
-
- -- if clear is changed to be undoable, this should be a reset-clear
- $options: local := nil
- clearSpad2Cmd '(all)
-
- curfile := histFileName()
- histFileErase curfile
- _$FCOPY(restfile,curfile)
-
- l:= LENGTH RKEYIDS curfile
- $HiFiAccess:= 'T
- oldInternal := $useInternalHistoryTable
- $useInternalHistoryTable := NIL
- if oldInternal then $internalHistoryTable := NIL
- for i in 1..l repeat
- vec:= UNWIND_-PROTECT(readHiFi(i),disableHist())
- if oldInternal then $internalHistoryTable :=
- CONS([i,:vec],$internalHistoryTable)
- LINE:= CAR vec
- for p1 in CDR vec repeat
- x:= CAR p1
- for p2 in CDR p1 repeat
- $InteractiveFrame:= putHist(x,CAR p2,CDR p2,$InteractiveFrame)
- updateInCoreHist()
- $e := $InteractiveFrame
- for [a,:.] in CAAR $InteractiveFrame repeat
- get(a,'localModemap,$InteractiveFrame) =>
- rempropI(a,'localModemap)
- rempropI(a,'localVars)
- rempropI(a,'mapBody)
- $IOindex:= l+1
- $useInternalHistoryTable := oldInternal
- sayKeyedMsg("S2IH0025",[namestring(restfile)])
- clearCmdSortedCaches()
- nil
-\end{verbatim}
-<<defun restoreHistory>>=
-(defun |restoreHistory| (fn)
- (prog (|$options| fnq restfile curfile l oldInternal vec line x a)
- (declare (special |$options|))
- (return
- (seq
- (progn
- (cond
- ((null fn)
- (spadlet fnq |$oldHistoryFileName|))
- ((and (pairp fn)
- (eq (qcdr fn) nil)
- (progn
- (spadlet fnq (qcar fn))
- t)
- (identp fnq))
- (spadlet fnq fnq))
- (t (|throwKeyedMsg| 'S2IH0023 (cons fnq nil)))) ; invalid filename
- (spadlet restfile (|makeHistFileName| fnq))
- (cond
- ((null (make-input-filename restfile))
- (|sayKeyedMsg| 'S2IH0024 ; file does not exist
- (cons (|namestring| restfile) nil)))
- (t
- (spadlet |$options| NIL)
- (|clearSpad2Cmd| '(|all|))
- (spadlet curfile (|histFileName|))
- (|histFileErase| curfile)
- ($fcopy restfile curfile)
- (spadlet l (length (rkeyids curfile)))
- (spadlet |$HiFiAccess| t)
- (spadlet oldInternal |$useInternalHistoryTable|)
- (spadlet |$useInternalHistoryTable| nil)
- (when oldInternal
- (spadlet |$internalHistoryTable| nil))
- (do ((|i| 1 (qsadd1 |i|)))
- ((qsgreaterp |i| l) nil)
- (seq
- (exit
- (progn
- (spadlet vec (unwind-protect (|readHiFi| |i|) (|disableHist|)))
- (when oldInternal
- (spadlet |$internalHistoryTable|
- (cons (cons |i| vec) |$internalHistoryTable|)))
- (spadlet line (car vec))
- (do ((tmp0 (cdr vec) (cdr tmp0)) (p1 nil))
- ((or (atom tmp0) (progn (setq p1 (car tmp0)) nil)) nil)
- (seq
- (exit
- (progn
- (spadlet x (car p1))
- (do ((tmp1 (cdr p1) (cdr tmp1)) (p2 nil))
- ((or (atom tmp1) (progn (setq p2 (car tmp1)) nil)) nil)
- (seq
- (exit
- (spadlet |$InteractiveFrame|
- (|putHist| x
- (car p2) (cdr p2) |$InteractiveFrame|)))))))))
- (|updateInCoreHist|)))))
- (spadlet |$e| |$InteractiveFrame|)
- (seq
- (do ((tmp2 (caar |$InteractiveFrame|) (cdr tmp2)) (tmp3 nil))
- ((or (atom tmp2)
- (progn
- (setq tmp3 (car tmp2))
- nil)
- (progn
- (progn
- (spadlet a (car tmp3))
- tmp3)
- nil))
- nil)
- (seq
- (exit
- (when (|get| a '|localModemap| |$InteractiveFrame|)
- (exit
- (progn
- (|rempropI| a '|localModemap|)
- (|rempropI| a '|localVars|)
- (|rempropI| a '|mapBody|)))))))
- (spadlet |$IOindex| (plus l 1))
- (spadlet |$useInternalHistoryTable| oldInternal)
- (|sayKeyedMsg| 'S2IH0025 ; workspace restored
- (cons (|namestring| restfile) nil))
- (|clearCmdSortedCaches|)
- nil))))))))
-
-@
-\subsection{defun showHistory}
-\begin{verbatim}
--- the following used to be the show command when that was used to
--- show history.
-showHistory(arg) ==
- -- arg can be of form
- -- NIL show at most last 20 input lines
- -- (n) show at most last n input lines
- -- (lit) where lit is an abbreviation for 'input or 'both
- -- if 'input, same as NIL
- -- if 'both, show last 5 input and outputs
- -- (n lit) show last n input lines + last n output lines
- -- if lit expands to 'both
- $evalTimePrint: local:= 0
- $printTimeSum: local:= 0
- -- ugh!!! these are needed for timedEvaluateStream
- -- displays the last n steps, default n=20
- not $HiFiAccess => sayKeyedMsg("S2IH0026",['show])
- showInputOrBoth := 'input
- n := 20
- nset := nil
- if arg then
- arg1 := CAR arg
- if INTEGERP arg1 then
- n := arg1
- nset := true
- KDR arg => arg1 := CADR arg
- arg1 := NIL
- arg1 =>
- arg2 := selectOptionLC(arg1,'(input both),nil)
- if arg2
- then ((showInputOrBoth := arg2) = 'both) and (null nset) => n:= 5
- else sayMSG
- concat('" ",bright arg1,'"is an invalid argument.")
- if n >= $IOindex then n:= $IOindex-1
- mini:= $IOindex-n
- maxi:= $IOindex-1
- showInputOrBoth = 'both =>
- UNWIND_-PROTECT(showInOut(mini,maxi),setIOindex(maxi+1))
- showInput(mini,maxi)
-\end{verbatim}
-<<defun showHistory>>=
-(defun |showHistory| (arg)
- (prog (|$evalTimePrint| |$printTimeSum| nset arg1 arg2
- showInputOrBoth n mini maxi)
- (declare (special |$evalTimePrint| |$printTimeSum|))
- (return
- (seq
- (progn
- (spadlet |$evalTimePrint| 0)
- (spadlet |$printTimeSum| 0)
- (cond
- ((null |$HiFiAccess|)
- (|sayKeyedMsg| 'S2IH0026 (cons '|show| nil))) ; history not on
- (t
- (spadlet showInputOrBoth '|input|)
- (spadlet n 20)
- (spadlet nset nil)
- (when arg
- (spadlet arg1 (car arg))
- (when (integerp arg1)
- (spadlet n arg1)
- (spadlet nset t)
- (cond
- ((kdr arg) (spadlet arg1 (cadr arg)))
- (t (spadlet arg1 nil))))
- (when arg1
- (progn
- (spadlet arg2 (|selectOptionLC| arg1 '(|input| |both|) nil))
- (seq
- (cond
- (arg2
- (when (and (boot-equal
- (spadlet showInputOrBoth arg2) '|both|)
- (null nset))
- (exit (spadlet n 5))))
- (t
- (|sayMSG|
- (|concat|
- (makestring " ")
- (|bright| arg1)
- (makestring "is an invalid argument.")))))))))
- (when (>= n |$IOindex|)
- (spadlet n (spaddifference |$IOindex| 1)))
- (spadlet mini (spaddifference |$IOindex| n))
- (spadlet maxi (spaddifference |$IOindex| 1))
- (cond
- ((boot-equal showInputOrBoth '|both|)
- (unwind-protect
- (|showInOut| mini maxi)
- (|setIOindex| (plus maxi 1))))
- (t (|showInput| mini maxi))))))))))
-
-@
-\subsection{defun setIOindex}
-\begin{verbatim}
-setIOindex(n) ==
- -- set $IOindex to n
- $IOindex:= n
-\end{verbatim}
-<<defun setIOindex>>=
-(defun |setIOindex| (n)
- (spadlet |$IOindex| n))
-
-@
-\subsection{defun showInput}
-\begin{verbatim}
-showInput(mini,maxi) ==
- -- displays all input lines from mini to maxi
- for ind in mini..maxi repeat
- vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist())
- if ind<10 then TAB 2 else if ind<100 then TAB 1
- l := CAR vec
- STRINGP l =>
- sayMSG ['" [",ind,'"] ",CAR vec]
- sayMSG ['" [",ind,'"] " ]
- for ln in l repeat
- sayMSG ['" ", ln]
-\end{verbatim}
-<<defun showInput>>=
-(defun |showInput| (mini maxi)
- (prog (vec l)
- (return
- (seq
- (do ((|ind| mini (+ |ind| 1)))
- ((> |ind| maxi) NIL)
- (seq
- (exit
- (progn
- (spadlet vec (unwind-protect (|readHiFi| |ind|) (|disableHist|)))
- (cond
- ((> 10 |ind|) (tab 2))
- ((> 100 |ind|) (tab 1))
- (t nil))
- (spadlet l (car vec))
- (cond
- ((stringp l)
- (|sayMSG|
- (cons
- (makestring " [")
- (cons |ind|
- (cons (makestring "] ")
- (cons (car vec) nil))))))
- (t
- (|sayMSG|
- (cons (makestring " [")
- (cons |ind|
- (cons (makestring "] ") nil))))
- (do ((tmp0 l (cdr tmp0)) (|ln| nil))
- ((or (atom tmp0) (progn (setq |ln| (car tmp0)) nil)) nil)
- (seq
- (exit
- (|sayMSG|
- (cons (makestring " ") (cons |ln| nil))))))))))))))))
-
-@
-\subsection{defun showInOut}
-\begin{verbatim}
-showInOut(mini,maxi) ==
- -- displays all steps from mini to maxi
- for ind in mini..maxi repeat
- vec:= UNWIND_-PROTECT(readHiFi(ind),disableHist())
- sayMSG [CAR vec]
- Alist:= ASSQ('%,CDR vec) =>
- triple:= CDR ASSQ('value,CDR Alist)
- $IOindex:= ind
- spadPrint(objValUnwrap triple,objMode triple)
-\end{verbatim}
-<<defun showInOut>>=
-(defun |showInOut| (mini maxi)
- (prog (vec Alist triple)
- (return
- (seq
- (do ((ind mini (+ ind 1)))
- ((> ind maxi) nil)
- (seq
- (exit
- (progn
- (spadlet vec (unwind-protect (|readHiFi| ind) (|disableHist|)))
- (|sayMSG| (cons (car vec) nil))
- (cond
- ((spadlet Alist (assq '% (cdr vec)))
- (progn
- (spadlet triple (cdr (assq '|value| (cdr Alist))))
- (spadlet |$IOindex| ind)
- (|spadPrint|
- (|objValUnwrap| triple) (|objMode| triple)))))))))))))
-
-@
-\subsection{defun fetchOutput}
-\begin{verbatim}
-fetchOutput(n) ==
- -- result is the output of step n
- (n = -1) and (val := getI("%",'value)) => val
- $HiFiAccess =>
- n:=
- n < 0 => $IOindex+n
- n
- n >= $IOindex => throwKeyedMsg("S2IH0001",[n])
- n < 1 => throwKeyedMsg("S2IH0002",[n])
- vec:= UNWIND_-PROTECT(readHiFi(n),disableHist())
- Alist:= ASSQ('%,CDR vec) =>
- val:= CDR ASSQ('value,CDR Alist) => val
- throwKeyedMsg("S2IH0003",[n])
- throwKeyedMsg("S2IH0003",[n])
- throwKeyedMsg("S2IH0004",NIL)
-\end{verbatim}
-<<defun fetchOutput>>=
-(defun |fetchOutput| (n)
- (prog (vec Alist val)
- (return
- (cond
- ((and (boot-equal n (spaddifference 1))
- (spadlet val (|getI| '% '|value|)))
- val)
- (|$HiFiAccess|
- (spadlet n
- (cond
- ((minusp n) (plus |$IOindex| n))
- (t n)))
- (cond
- ((>= n |$IOindex|)
- (|throwKeyedMsg| 'S2IH0001 (cons n nil))) ; no step n yet
- ((> 1 n)
- (|throwKeyedMsg| 'S2IH0002 (cons n nil))) ; only nonzero steps
- (t
- (spadlet vec (unwind-protect (|readHiFi| n) (|disableHist|)))
- (cond
- ((spadlet Alist (assq '% (cdr vec)))
- (cond
- ((spadlet val (cdr (assq '|value| (cdr Alist))))
- val)
- (t
- (|throwKeyedMsg| 'S2IH0003 (cons n nil))))) ; no step value
- (t (|throwKeyedMsg| 'S2IH0003 (cons n nil))))))) ; no step value
- (t (|throwKeyedMsg| 'S2IH0004 nil)))))) ; history not on
-
-@
-\subsection{defun readHiFi}
-\begin{verbatim}
-readHiFi(n) ==
- -- reads the file using index n
- if $useInternalHistoryTable
- then
- pair := assoc(n,$internalHistoryTable)
- ATOM pair => keyedSystemError("S2IH0034",NIL)
- vec := QCDR pair
- else
- HiFi:= RDEFIOSTREAM ['(MODE . INPUT),['FILE,:histFileName()]]
- vec:= SPADRREAD(object2Identifier n,HiFi)
- RSHUT HiFi
- vec
-\end{verbatim}
-<<defun readHiFi>>=
-(defun |readHiFi| (n)
- (prog (pair HiFi vec)
- (return
- (progn
- (cond
- (|$useInternalHistoryTable|
- (spadlet pair (|assoc| n |$internalHistoryTable|))
- (cond
- ((atom pair)
- (|keyedSystemError| 'S2IH0034 nil)) ; missing element
- (t
- (spadlet vec (qcdr pair)))))
- (t
- (spadlet HiFi
- (rdefiostream
- (cons
- '(mode . input)
- (cons
- (cons 'file (|histFileName|)) nil))))
- (spadlet vec (spadrread (|object2Identifier| n) HiFi))
- (rshut HiFi)))
- vec))))
-
-@
-\subsection{defun writeHiFi}
-\begin{verbatim}
-writeHiFi() ==
- -- writes the information of the current step out to history file
- if $useInternalHistoryTable
- then
- $internalHistoryTable := CONS([$IOindex,$currentLine,:$HistRecord],
- $internalHistoryTable)
- else
- HiFi:= RDEFIOSTREAM ['(MODE . OUTPUT),['FILE,:histFileName()]]
- SPADRWRITE(object2Identifier $IOindex, CONS($currentLine,$HistRecord),HiFi)
- RSHUT HiFi
-\end{verbatim}
-<<defun writeHiFi>>=
-(defun |writeHiFi| ()
- (prog (HiFi)
- (return
- (cond
- (|$useInternalHistoryTable|
- (spadlet |$internalHistoryTable|
- (cons
- (cons |$IOindex|
- (cons |$currentLine| |$HistRecord|))
- |$internalHistoryTable|)))
- (t
- (spadlet HiFi
- (rdefiostream
- (cons
- '(mode . output)
- (cons (cons 'file (|histFileName|)) nil))))
- (spadrwrite (|object2Identifier| |$IOindex|)
- (cons |$currentLine| |$HistRecord|) HiFi)
- (rshut HiFi))))))
-
-@
-\subsection{defun disableHist}
-\begin{verbatim}
-disableHist() ==
- -- disables the history mechanism if an error occurred in the protected
- -- piece of code
- not $HiFiAccess => histFileErase histFileName()
- NIL
-\end{verbatim}
-<<defun disableHist>>=
-(defun |disableHist| ()
- (cond
- ((null |$HiFiAccess|)
- (|histFileErase| (|histFileName|)))
- (t nil)))
-
-@
-\subsection{defun writeHistModesAndValues}
-\begin{verbatim}
-writeHistModesAndValues() ==
- for [a,:.] in CAAR $InteractiveFrame repeat
- x := get(a,'value,$InteractiveFrame) =>
- putHist(a,'value,x,$InteractiveFrame)
- x := get(a,'mode,$InteractiveFrame) =>
- putHist(a,'mode,x,$InteractiveFrame)
- NIL
-\end{verbatim}
-<<defun writeHistModesAndValues>>=
-(defun |writeHistModesAndValues| ()
- (prog (a x)
- (return
- (seq
- (progn
- (do ((tmp0 (caar |$InteractiveFrame|) (cdr tmp0)) (tmp1 nil))
- ((or (atom tmp0)
- (progn
- (setq tmp1 (car tmp0))
- nil)
- (progn
- (progn
- (spadlet a (car tmp1))
- tmp1)
- nil))
- nil)
- (seq
- (exit
- (cond
- ((spadlet x (|get| a '|value| |$InteractiveFrame|))
- (|putHist| a '|value| x |$InteractiveFrame|))
- ((spadlet x (|get| a '|mode| |$InteractiveFrame|))
- (|putHist| a '|mode| x |$InteractiveFrame|))))))
- nil)))))
-
-@
-\section{Lisplib output transformations}
---% Lisplib output transformations
--- Some types of objects cannot be saved by LISP/VM in lisplibs.
--- These functions transform an object to a writable form and back.
--- SMW
-\subsection{defun SPADRWRITE0}
-\begin{verbatim}
-SPADRWRITE0(vec, item, stream) ==
- val := safeWritify item
- val = 'writifyFailed => val
- rwrite(vec, val, stream)
- item
-\end{verbatim}
-<<defun SPADRWRITE0>>=
-(defun spadrwrite0 (vec item stream)
- (prog (val)
- (return
- (progn
- (spadlet val (|safeWritify| item))
- (cond
- ((boot-equal val '|writifyFailed|) val)
- (t (|rwrite| vec val stream) item))))))
-
-@
-\subsection{defun SPADRWRITE}
-\begin{verbatim}
-SPADRWRITE(vec, item, stream) ==
- val := SPADRWRITE0(vec, item, stream)
- val = 'writifyFailed =>
- throwKeyedMsg("S2IH0036", nil) ; cannot save value to file
- item
-\end{verbatim}
-<<defun SPADRWRITE>>=
-(defun spadrwrite (vec item stream)
- (prog (val)
- (return
- (progn
- (spadlet val (spadrwrite0 vec item stream))
- (cond
- ((boot-equal val '|writifyFailed|)
- (|throwKeyedMsg| 'S2IH0036 nil)) ; cannot save value to file
- (t item))))))
-
-@
-\subsection{defun SPADRREAD}
-\begin{verbatim}
-SPADRREAD(vec, stream) ==
- dewritify rread(vec, stream, nil)
-\end{verbatim}
-<<defun SPADRREAD>>=
-(defun spadrread (vec stream)
- (|dewritify| (|rread| vec stream nil)))
-
-@
-\subsection{defun unwritable?}
-\begin{verbatim}
-unwritable? ob ==
- PAIRP ob or VECP ob => false -- first for speed
- COMPILED_-FUNCTION_-P ob or HASHTABLEP ob => true
- PLACEP ob or READTABLEP ob => true
- FLOATP ob => true
- false
-\end{verbatim}
-<<defun unwritable?>>=
-(defun |unwritable?| (ob)
- (cond
- ((or (pairp ob) (vecp ob)) nil)
- ((or (compiled-function-p ob) (hashtablep ob)) t)
- ((or (placep ob) (readtablep ob)) t)
- ((floatp ob) t)
- (t nil)))
-
-@
-\subsection{defun writifyComplain}
-\begin{verbatim}
--- Create a full isomorphic object which can be saved in a lisplib.
--- Note that dewritify(writify(x)) preserves UEQUALity of hashtables.
--- HASHTABLEs go both ways.
--- READTABLEs cannot presently be transformed back.
-
-writifyComplain s ==
- $writifyComplained = true => nil
- $writifyComplained := true
- sayKeyedMsg("S2IH0027",[s])
-\end{verbatim}
-<<defun writifyComplain>>=
-(defun |writifyComplain| (s)
- (cond
- ((boot-equal |$writifyComplained| t) NIL)
- (t
- (spadlet |$writifyComplained| t)
- (|sayKeyedMsg| 'S2IH0027 (cons s nil))))) ; cannot save value
-
-@
-\subsection{defun safeWritify}
-\begin{verbatim}
-safeWritify ob ==
- CATCH('writifyTag, writify ob)
-\end{verbatim}
-<<defun safeWritify>>=
-(defun |safeWritify| (ob)
- (catch '|writifyTag| (|writify| ob)))
-
-@
-\subsection{defun writify}
-\begin{verbatim}
-writify ob ==
- not ScanOrPairVec(function(unwritable?), ob) => ob
- $seen: local := MAKE_-HASHTABLE 'EQ
- $writifyComplained: local := false
-
- writifyInner ob where
- writifyInner ob ==
- null ob => nil
- (e := HGET($seen, ob)) => e
-
- PAIRP ob =>
- qcar := QCAR ob
- qcdr := QCDR ob
- (name := spadClosure? ob) =>
- d := writifyInner QCDR ob
- nob := ['WRITIFIED_!_!, 'SPADCLOSURE, d, name]
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- (ob is ['LAMBDA_-CLOSURE, ., ., x, :.]) and x =>
- THROW('writifyTag, 'writifyFailed)
- nob := CONS(qcar, qcdr)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- qcar := writifyInner qcar
- qcdr := writifyInner qcdr
- QRPLACA(nob, qcar)
- QRPLACD(nob, qcdr)
- nob
- VECP ob =>
- isDomainOrPackage ob =>
- d := mkEvalable devaluate ob
- nob := ['WRITIFIED_!_!, 'DEVALUATED, writifyInner d]
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- n := QVMAXINDEX ob
- nob := MAKE_-VEC(n+1)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- for i in 0..n repeat
- QSETVELT(nob, i, writifyInner QVELT(ob,i))
- nob
- ob = 'WRITIFIED_!_! =>
- ['WRITIFIED_!_!, 'SELF]
- -- In CCL constructors are also compiled functions, so we
- -- need this line:
- constructor? ob => ob
- COMPILED_-FUNCTION_-P ob =>
- THROW('writifyTag, 'writifyFailed)
- HASHTABLEP ob =>
- nob := ['WRITIFIED_!_!]
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- keys := HKEYS ob
- QRPLACD(nob,
- ['HASHTABLE,
- HASHTABLE_-CLASS ob,
- writifyInner keys,
- [writifyInner HGET(ob,k) for k in keys]])
- nob
- PLACEP ob =>
- nob := ['WRITIFIED_!_!, 'PLACE]
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- -- The next three types cause an error on de-writifying.
- -- Create an object of the right shape, nonetheless.
- READTABLEP ob =>
- THROW('writifyTag, 'writifyFailed)
- -- Default case: return the object itself.
- STRINGP ob =>
- EQ(ob, $NullStream) => ['WRITIFIED_!_!, 'NULLSTREAM]
- EQ(ob, $NonNullStream) => ['WRITIFIED_!_!, 'NONNULLSTREAM]
- ob
- FLOATP ob =>
- ob = READ_-FROM_-STRING STRINGIMAGE ob => ob
- ['WRITIFIED_!_!, 'FLOAT, ob,:
- MULTIPLE_-VALUE_-LIST INTEGER_-DECODE_-FLOAT ob]
- ob
-\end{verbatim}
-<<defun writify,writifyInner>>=
-(defun |writify,writifyInner| (ob)
- (prog (e name tmp1 tmp2 tmp3 x qcar qcdr d n keys nob)
- (return
- (seq
- (when (null ob)
- (exit nil))
- (when (spadlet e (hget |$seen| ob))
- (exit e))
- (when (pairp ob)
- (exit
- (seq
- (spadlet qcar (qcar ob))
- (spadlet qcdr (qcdr ob))
- (when (spadlet name (|spadClosure?| ob))
- (exit
- (seq
- (spadlet d (|writify,writifyInner| (qcdr ob)))
- (spadlet nob
- (cons 'writified!!
- (cons 'spadclosure
- (cons d (cons name nil)))))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (exit nob))))
- (when
- (and
- (and (pairp ob)
- (eq (qcar ob) 'lambda-closure)
- (progn
- (spadlet tmp1 (qcdr ob))
- (and (pairp tmp1)
- (progn
- (spadlet tmp2 (qcdr tmp1))
- (and
- (pairp tmp2)
- (progn
- (spadlet tmp3 (qcdr tmp2))
- (and (pairp tmp3)
- (progn
- (spadlet x (qcar tmp3))
- t)))))))) x)
- (exit
- (throw '|writifyTag| '|writifyFailed|)))
- (spadlet nob (cons qcar qcdr))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (spadlet qcar (|writify,writifyInner| qcar))
- (spadlet qcdr (|writify,writifyInner| qcdr))
- (qrplaca nob qcar)
- (qrplacd nob qcdr)
- (exit nob))))
- (when (vecp ob)
- (exit
- (seq
- (when (|isDomainOrPackage| ob)
- (exit
- (seq
- (spadlet d (|mkEvalable| (|devaluate| ob)))
- (spadlet nob
- (cons 'writified!!
- (cons 'devaluated
- (cons (|writify,writifyInner| d) nil))))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (exit nob))))
- (spadlet n (qvmaxindex ob))
- (spadlet nob (make-vec (plus n 1)))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (do ((|i| 0 (qsadd1 |i|)))
- ((qsgreaterp |i| n) NIL)
- (seq
- (exit
- (qsetvelt nob |i| (|writify,writifyInner| (QVELT ob |i|))))))
- (exit nob))))
- (when (boot-equal ob 'writified!!)
- (exit
- (cons 'writified!! (cons 'self nil))))
- (when (|constructor?| ob)
- (exit ob))
- (when (compiled-function-p ob)
- (exit
- (throw '|writifyTag| '|writifyFailed|)))
- (when (hashtablep ob)
- (exit
- (seq
- (spadlet nob (cons 'writified!! nil))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (spadlet keys (hkeys ob))
- (qrplacd nob
- (cons
- 'hashtable
- (cons
- (hashtable-class ob)
- (cons
- (|writify,writifyInner| keys)
- (cons
- (prog (tmp0)
- (spadlet tmp0 nil)
- (return
- (do ((tmp1 keys (cdr tmp1)) (k nil))
- ((or (atom tmp1)
- (progn
- (setq k (car tmp1))
- nil))
- (nreverse0 tmp0))
- (seq
- (exit
- (setq tmp0
- (cons
- (|writify,writifyInner| (HGET ob k))
- tmp0)))))))
- nil)))))
- (exit nob))))
- (when (placep ob)
- (exit
- (seq
- (spadlet nob (cons 'writified!! (cons 'place nil)))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (exit nob))))
- (when (readtablep ob)
- (exit
- (throw '|writifyTag| '|writifyFailed|)))
- (when (stringp ob)
- (exit
- (seq
- (when (eq ob |$NullStream|)
- (exit
- (cons 'writified!! (cons 'nullstream nil))))
- (when (eq ob |$NonNullStream|)
- (exit
- (cons 'writified!! (cons 'nonnullstream nil))))
- (exit ob))))
- (when (floatp ob)
- (exit
- (seq
- (when (boot-equal ob (read-from-string (stringimage ob)))
- (exit ob))
- (exit
- (cons 'writified!!
- (cons 'float
- (cons ob
- (multiple-value-list (integer-decode-float ob)))))))))
- (exit ob)))))
-
-@
-<<defun writify>>=
-(defun |writify| (ob)
- (prog (|$seen| |$writifyComplained|)
- (declare (special |$seen| |$writifyComplained|))
- (return
- (cond
- ((null (|ScanOrPairVec| (|function| |unwritable?|) ob))
- ob)
- (t
- (spadlet |$seen| (make-hashtable 'eq))
- (spadlet |$writifyComplained| nil)
- (|writify,writifyInner| ob))))))
-
-@
-\subsection{defun spadClosure?}
-\begin{verbatim}
-spadClosure? ob ==
- fun := QCAR ob
- not (name := BPINAME fun) => nil
- vec := QCDR ob
- not VECP vec => nil
- name
-\end{verbatim}
-<<defun spadClosure?>>=
-(defun |spadClosure?| (ob)
- (prog (fun name vec)
- (return
- (progn
- (spadlet fun (qcar ob))
- (cond
- ((null (spadlet name (bpiname fun))) nil)
- (t
- (spadlet vec (qcdr ob))
- (cond
- ((null (vecp vec)) nil)
- (t name))))))))
-
-@
-\subsection{defun dewritify}
-\begin{verbatim}
-dewritify ob ==
- (not ScanOrPairVec(function is?, ob)
- where is? a == a = 'WRITIFIED_!_!) => ob
-
- $seen: local := MAKE_-HASHTABLE 'EQ
-
- dewritifyInner ob where
- dewritifyInner ob ==
- null ob => nil
- e := HGET($seen, ob) => e
-
- PAIRP ob and CAR ob = 'WRITIFIED_!_! =>
- type := ob.1
- type = 'SELF =>
- 'WRITIFIED_!_!
- type = 'BPI =>
- oname := ob.2
- f :=
- INTP oname => EVAL GENSYMMER oname
- SYMBOL_-FUNCTION oname
- not COMPILED_-FUNCTION_-P f =>
- error '"A required BPI does not exist."
- #ob > 3 and HASHEQ f ^= ob.3 =>
- error '"A required BPI has been redefined."
- HPUT($seen, ob, f)
- f
- type = 'HASHTABLE =>
- nob := MAKE_-HASHTABLE ob.2
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- for k in ob.3 for e in ob.4 repeat
- HPUT(nob, dewritifyInner k, dewritifyInner e)
- nob
- type = 'DEVALUATED =>
- nob := EVAL dewritifyInner ob.2
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- type = 'SPADCLOSURE =>
- vec := dewritifyInner ob.2
- name := ob.3
- not FBOUNDP name =>
- error STRCONC('"undefined function: ", SYMBOL_-NAME
name)
- nob := CONS(SYMBOL_-FUNCTION name, vec)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- type = 'PLACE =>
- nob := READ MAKE_-INSTREAM NIL
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- nob
- type = 'READTABLE =>
- error '"Cannot de-writify a read table."
- type = 'NULLSTREAM => $NullStream
- type = 'NONNULLSTREAM => $NonNullStream
- type = 'FLOAT =>
- [fval, signif, expon, sign] := CDDR ob
- fval := SCALE_-FLOAT( FLOAT(signif, fval), expon)
- sign<0 => -fval
- fval
- error '"Unknown type to de-writify."
-
- PAIRP ob =>
- qcar := QCAR ob
- qcdr := QCDR ob
- nob := CONS(qcar, qcdr)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- QRPLACA(nob, dewritifyInner qcar)
- QRPLACD(nob, dewritifyInner qcdr)
- nob
- VECP ob =>
- n := QVMAXINDEX ob
- nob := MAKE_-VEC(n+1)
- HPUT($seen, ob, nob)
- HPUT($seen, nob, nob)
- for i in 0..n repeat
- QSETVELT(nob, i, dewritifyInner QVELT(ob,i))
- nob
- -- Default case: return the object itself.
- ob
-\end{verbatim}
-<<defun dewritify,is?>>=
-(defun |dewritify,is?| (a)
- (boot-equal a 'writified!!))
-
-@
-<<defun dewritify,dewritifyInner>>=
-(defun |dewritify,dewritifyInner| (ob)
- (prog (e type oname f vec name tmp1 signif expon sign fval qcar qcdr n nob)
- (return
- (seq
- (when (null ob)
- (exit nil))
- (when (spadlet e (hget |$seen| ob))
- (exit e))
- (when (and (pairp ob) (boot-equal (car ob) 'writified!!))
- (exit
- (seq
- (spadlet type (elt ob 1))
- (when (boot-equal type 'self)
- (exit 'writified!!))
- (when (boot-equal type 'bpi)
- (exit
- (seq
- (spadlet oname (elt ob 2))
- (spadlet f
- (seq
- (when (intp oname) (exit (eval (gensymmer oname))))
- (exit (symbol-function oname))))
- (when (null (compiled-function-p f))
- (exit (|error| (makestring "A required BPI does not exist."))))
- (when (and (> (|#| ob) 3) (nequal (hasheq f) (elt ob 3)))
- (exit (|error| (makestring "A required BPI has been redefined."))))
- (hput |$seen| ob f)
- (exit f))))
- (when (boot-equal type 'hashtable)
- (exit
- (seq
- (spadlet nob (make-hashtable (elt ob 2)))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (do ((tmp0 (elt ob 3) (cdr tmp0))
- (k nil)
- (tmp1 (elt ob 4) (cdr tmp1))
- (e nil))
- ((or (atom tmp0)
- (progn
- (setq k (car tmp0))
- nil)
- (atom tmp1)
- (progn
- (setq e (car tmp1))
- nil))
- nil)
- (seq
- (exit
- (hput nob (|dewritify,dewritifyInner| k)
- (|dewritify,dewritifyInner| e)))))
- (exit nob))))
- (when (boot-equal type 'devaluated)
- (exit
- (seq
- (spadlet nob (eval (|dewritify,dewritifyInner| (elt ob 2))))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (exit nob))))
- (when (boot-equal type 'spadclosure)
- (exit
- (seq
- (spadlet vec (|dewritify,dewritifyInner| (elt ob 2)))
- (spadlet name (ELT ob 3))
- (when (null (fboundp name))
- (exit
- (|error|
- (strconc (makestring "undefined function: ")
- (symbol-name name)))))
- (spadlet nob (cons (symbol-function name) vec))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (exit nob))))
- (when (boot-equal type 'place)
- (exit
- (seq
- (spadlet nob (vmread (make-instream nil)))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (exit nob))))
- (when (boot-equal type 'readtable)
- (exit (|error| (makestring "Cannot de-writify a read table."))))
- (when (boot-equal type 'nullstream)
- (exit |$NullStream|))
- (when (boot-equal type 'nonnullstream)
- (exit |$NonNullStream|))
- (when (boot-equal type 'float)
- (exit
- (seq
- (progn
- (spadlet tmp1 (cddr ob))
- (spadlet fval (car tmp1))
- (spadlet signif (cadr tmp1))
- (spadlet expon (caddr tmp1))
- (spadlet sign (cadddr tmp1))
- tmp1)
- (spadlet fval (scale-float (float signif fval) expon))
- (when (minusp sign)
- (exit (spaddifference fval)))
- (exit fval))))
- (exit (|error| (makestring "Unknown type to de-writify."))))))
- (when (pairp ob)
- (exit
- (seq
- (spadlet qcar (qcar ob))
- (spadlet qcdr (qcdr ob))
- (spadlet nob (cons qcar qcdr))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (qrplaca nob (|dewritify,dewritifyInner| qcar))
- (qrplacd nob (|dewritify,dewritifyInner| qcdr))
- (exit nob))))
- (when (vecp ob)
- (exit
- (seq
- (spadlet n (qvmaxindex ob))
- (spadlet nob (make-vec (plus n 1)))
- (hput |$seen| ob nob)
- (hput |$seen| nob nob)
- (do ((|i| 0 (qsadd1 |i|)))
- ((qsgreaterp |i| n) nil)
- (seq
- (exit
- (qsetvelt nob |i|
- (|dewritify,dewritifyInner| (qvelt ob |i|))))))
- (exit nob))))
- (exit ob)))))
-
-@
-<<defun dewritify>>=
-(defun |dewritify| (ob)
- (prog (|$seen|)
- (declare (special |$seen|))
- (return
- (cond
- ((null (|ScanOrPairVec| (|function| |dewritify,is?|) ob))
- ob)
- (t
- (spadlet |$seen| (make-hashtable 'EQ))
- (|dewritify,dewritifyInner| ob))))))
-
-@
-\subsection{defun ScanOrPairVec}
-\begin{verbatim}
-ScanOrPairVec(f, ob) ==
- $seen: local := MAKE_-HASHTABLE 'EQ
-
- CATCH('ScanOrPairVecAnswer, ScanOrInner(f, ob)) where
- ScanOrInner(f, ob) ==
- HGET($seen, ob) => nil
- PAIRP ob =>
- HPUT($seen, ob, true)
- ScanOrInner(f, QCAR ob)
- ScanOrInner(f, QCDR ob)
- nil
- VECP ob =>
- HPUT($seen, ob, true)
- for i in 0..#ob-1 repeat ScanOrInner(f, ob.i)
- nil
- FUNCALL(f, ob) =>
- THROW('ScanOrPairVecAnswer, true)
- nil
-\end{verbatim}
-<<defun ScanOrPairVec>>=
-(defun |ScanOrPairVec,ScanOrInner| (f ob)
- (seq
- (when (hget |$seen| ob)
- (exit nil))
- (when (pairp ob)
- (exit
- (seq
- (hput |$seen| ob t)
- (|ScanOrPairVec,ScanOrInner| f (qcar ob))
- (|ScanOrPairVec,ScanOrInner| f (qcdr ob))
- (exit nil))))
- (when (vecp ob)
- (exit
- (seq
- (hput |$seen| ob t)
- (do ((tmp0 (spaddifference (|#| ob) 1)) (|i| 0 (qsadd1 |i|)))
- ((qsgreaterp |i| tmp0) nil)
- (seq
- (exit (|ScanOrPairVec,ScanOrInner| f (elt ob |i|)))))
- (exit nil))))
- (when (funcall f ob)
- (exit
- (throw '|ScanOrPairVecAnswer| t)))
- (exit nil)))
-
-(defun |ScanOrPairVec| (f ob)
- (prog (|$seen|)
- (declare (special |$seen|))
- (return
- (progn
- (spadlet |$seen| (make-hashtable 'eq))
- (catch '|ScanOrPairVecAnswer| (|ScanOrPairVec,ScanOrInner| f ob))))))
-
-@
-\subsection{defun gensymInt}
-\begin{verbatim}
-gensymInt g ==
- not GENSYMP g => error '"Need a GENSYM"
- p := PNAME g
- n := 0
- for i in 2..#p-1 repeat n := 10 * n + charDigitVal p.i
- n
-\end{verbatim}
-<<defun gensymInt>>=
-(defun |gensymInt| (g)
- (prog (p n)
- (return
- (seq
- (cond
- ((null (gensymp g))
- (|error| (makestring "Need a GENSYM")))
- (t
- (spadlet p (pname g))
- (spadlet n 0)
- (do ((tmp0 (spaddifference (|#| p) 1)) (|i| 2 (qsadd1 |i|)))
- ((qsgreaterp |i| tmp0) nil)
- (seq
- (exit
- (spadlet n (plus (times 10 n) (|charDigitVal| (elt p |i|)))))))
- n))))))
-
-@
-\subsection{defun charDigitVal}
-\begin{verbatim}
-charDigitVal c ==
- digits := '"0123456789"
- n := -1
- for i in 0..#digits-1 while n < 0 repeat
- if c = digits.i then n := i
- n < 0 => error '"Character is not a digit"
- n
-\end{verbatim}
-<<defun charDigitVal>>=
-(defun |charDigitVal| (c)
- (prog (digits n)
- (return
- (seq
- (progn
- (spadlet digits (makestring "0123456789"))
- (spadlet n (spaddifference 1))
- (do ((tmp0 (spaddifference (|#| digits) 1)) (|i| 0 (qsadd1 |i|)))
- ((or (qsgreaterp |i| tmp0) (null (minusp n))) nil)
- (seq
- (exit
- (cond
- ((boot-equal c (elt digits |i|)) (spadlet n |i|))
- (t nil)))))
- (cond
- ((minusp n) (|error| (makestring "Character is not a digit")))
- (t n)))))))
-
-@
-\subsection{defun histFileErase}
-\begin{verbatim}
-histFileErase file ==
- --OBEY STRCONC('"rm -rf ", file)
- PROBE_-FILE(file) and DELETE_-FILE(file)
-\end{verbatim}
-<<defun histFileErase>>=
-(defun |histFileErase| (file)
- (when (probe-file file)
- (delete-file file)))
-
-@
-\section{History File Messages}
-<<History File Messages>>=
-S2IH0001
- You have not reached step %1b yet, and so its value cannot be
- supplied.
-S2IH0002
- Cannot supply value for step %1b because 1 is the first step.
-S2IH0003
- Step %1b has no value.
-S2IH0004
- The history facility is not on, so you cannot use %b %% %d .
-S2IH0006
- You have not used the correct syntax for the %b history %d command.
- Issue %b )help history %d for more information.
-S2IH0007
- The history facility is already on.
-S2IH0008
- The history facility is now on.
-S2IH0009
- Turning on the history facility will clear the contents of the
- workspace.
- Please enter %b y %d or %b yes %d if you really want to do this:
-S2IH0010
- The history facility is still off.
-S2IH0011
- The history facility is already off.
-S2IH0012
- The history facility is now off.
-S2IH0013
- The history facility is not on, so the .input file containing your user input
- cannot be created.
-S2IH0014
- Edit %b %1 %d to see the saved input lines.
-S2IH0015
- The argument %b n %d for %b )history )change n must be a nonnegative
- integer and your argument, %1b , is not one.
-S2IH0016
- The history facility is not on, so no information can be saved.
-S2IH0018
- The saved history file is %1b .
-S2IH0019
- There is no history file, so value of step %1b is
- undefined.
-S2IH0022
- No history information had been saved yet.
-S2IH0023
- %1b is not a valid filename for the history file.
-S2IH0024
- History information cannot be restored from %1b because the file does
- not exist.
-S2IH0025
- The workspace has been successfully restored from the history file
- %1b .
-S2IH0026
- The history facility command %1b cannot be performed because the
- history facility is not on.
-S2IH0027
- A value containing a %1b is being saved in a history file or a
- compiled input file INLIB. This type
- is not yet usable in other history operations. You might want to issue
- %b )history )off %d
-S2IH0029
- History information is already being maintained in an external file
- (and not in memory).
-S2IH0030
- History information is already being maintained in memory (and not
- in an external file).
-S2IH0031
- When the history facility is active, history information will be
- maintained in a file (and not in an internal table).
-S2IH0032
- When the history facility is active, history information will be
- maintained in memory (and not in an external file).
-S2IH0034
- Missing element in internal history table.
-S2IH0035
- Can't save the value of step number %1b. You can re-generate this value
- by running the input file %2b.
-S2IH0036
- The value specified cannot be saved to a file.
-S2IH0037
- You must specify a file name to the history save command
-S2IH0038
- You must specify a file name to the history write command
-@
-
-\chapter{The Frame Mechanism}
-\section{)frame}
-%\label{ugSysCmdframe}
-%\index{frame}
-\par\noindent{\bf Command Syntax:}
-\begin{list}{}
-\item{\tt )frame new {\it frameName}}
-\item{\tt )frame drop {\it [frameName]}}
-\item{\tt )frame next}
-\item{\tt )frame last}
-\item{\tt )frame names}
-\item{\tt )frame import {\it frameName} {\it [objectName1 [objectName2 ...]]}}
-\item{\tt )set message frame on | off}
-\item{\tt )set message prompt frame}
-\end{list}
-
-\par\noindent{\bf Command Description:}
-
-A {\it frame} can be thought of as a logical session within the
-physical session that you get when you start the system. You can
-have as many frames as you want, within the limits of your computer's
-storage, paging space, and so on.
-Each frame has its own {\it step number}, {\it environment} and {\it history.}
-You can have a variable named {\tt a} in one frame and it will
-have nothing to do with anything that might be called {\tt a} in
-any other frame.
-
-Some frames are created by the HyperDoc program and these can
-have pretty strange names, since they are generated automatically.
-\index{frame names}
-To find out the names
-of all frames, issue
-\begin{verbatim}
-)frame names
-\end{verbatim}
-It will indicate the name of the current frame.
-
-You create a new frame
-\index{frame new}
-``{\bf quark}'' by issuing
-\begin{verbatim}
-)frame new quark
-\end{verbatim}
-The history facility can be turned on by issuing either
-{\tt )set history on} or {\tt )history )on}.
-If the history facility is on and you are saving history information
-in a file rather than in the Axiom environment
-then a history file with filename {\bf quark.axh} will
-be created as you enter commands.
-If you wish to go back to what
-you were doing in the
-\index{frame next}
-``{\bf initial}'' frame, use
-\index{frame last}
-\begin{verbatim}
-)frame next
-\end{verbatim}
-or
-\begin{verbatim}
-)frame last
-\end{verbatim}
-to cycle through the ring of available frames to get back to
-``{\bf initial}''.
-
-If you want to throw
-away a frame (say ``{\bf quark}''), issue
-\begin{verbatim}
-)frame drop quark
-\end{verbatim}
-If you omit the name, the current frame is dropped.
-\index{frame drop}
-
-If you do use frames with the history facility on and writing to a file,
-you may want to delete some of the older history files.
-\index{file!history}
-These are directories, so you may want to issue a command like
-{\tt rm -r quark.axh} to the operating system.
-
-You can bring things from another frame by using
-\index{frame import}
-{\tt )frame import}.
-For example, to bring the {\tt f} and {\tt g} from the frame ``{\bf quark}''
-to the current frame, issue
-\begin{verbatim}
-)frame import quark f g
-\end{verbatim}
-If you want everything from the frame ``{\bf quark}'', issue
-\begin{verbatim}
-)frame import quark
-\end{verbatim}
-You will be asked to verify that you really want everything.
-
-There are two {\tt )set} flags
-\index{set message frame}
-to make it easier to tell where you are.
-\begin{verbatim}
-)set message frame on | off
-\end{verbatim}
-will print more messages about frames when it is set on.
-By default, it is off.
-\begin{verbatim}
-)set message prompt frame
-\end{verbatim}
-will give a prompt
-\index{set message prompt frame}
-that looks like
-\begin{verbatim}
-initial (1) ->
-\end{verbatim}
-\index{prompt!with frame name}
-when you start up. In this case, the frame name and step make up the
-prompt.
-
-\par\noindent{\bf Also See:}
-{\tt )history} \index{ugSysCmdhistory} and
-{\tt )set} \index{ugSysCmdset}.
-
-\subsection{defun frameName}
-\begin{verbatim}
-frameName(frame) == CAR frame
-\end{verbatim}
-<<defun frameName>>=
-(defun |frameName| (frame)
- (car frame))
-
-@
-\section{Variables Used}
-\section{Data Structures}
-\section{Functions}
-\subsection{defun frameNames}
-\begin{verbatim}
-frameNames() == [frameName f for f in $interpreterFrameRing]
-\end{verbatim}
-<<defun frameNames>>=
-(defun |frameNames| ()
- (prog ()
- (return
- (seq
- (prog (tmp0)
- (spadlet tmp0 nil)
- (return
- (do ((tmp1 |$interpreterFrameRing| (cdr tmp1)) (f nil))
- ((or (atom tmp1)
- (progn (setq f (car tmp1)) nil))
- (nreverse0 tmp0))
- (seq
- (exit
- (setq tmp0 (cons (|frameName| f) tmp0)))))))))))
-
-@
-\subsection{defun frameEnvironment}
-\begin{verbatim}
-frameEnvironment fname ==
- -- extracts the environment portion of a frame
- -- if fname is not a valid frame name then the empty environment
- -- is returned
- fname = frameName first $interpreterFrameRing => $InteractiveFrame
- ifr := rest $interpreterFrameRing
- e := LIST LIST NIL
- while ifr repeat
- [f,:ifr] := ifr
- if fname = frameName f then
- e := CADR f
- ifr := NIL
- e
-\end{verbatim}
-<<defun frameEnvironment>>=
-(defun |frameEnvironment| (fname)
- (prog
- (tmp1 f e ifr)
- (return
- (seq
- (cond
- ((boot-equal fname (|frameName| (CAR |$interpreterFrameRing|)))
- |$InteractiveFrame|)
- (t
- (spadlet ifr (cdr |$interpreterFrameRing|))
- (spadlet e (list (list nil)))
- (do ()
- ((null ifr) nil)
- (seq
- (exit
- (progn
- (spadlet tmp1 ifr)
- (spadlet f (car tmp1))
- (spadlet ifr (cdr tmp1))
- (cond
- ((boot-equal fname (|frameName| f))
- (spadlet e (cadr f))
- (spadlet ifr nil))
- (t nil)))))) e))))))
-
-@
-\subsection{defun emptyInterpreterFrame}
-\begin{verbatim}
-emptyInterpreterFrame(name) ==
- LIST(name, -- frame name
- LIST LIST NIL, -- environment
- 1, -- $IOindex
- $HiFiAccess, -- $HiFiAccess
- $HistList, -- $HistList
- $HistListLen, -- $HistListLen
- $HistListAct, -- $HistListAct
- $HistRecord, -- $HistRecord
- NIL, -- $internalHistoryTable
- COPY_-SEQ $localExposureDataDefault -- $localExposureData
- )
-\end{verbatim}
-<<defun emptyInterpreterFrame>>=
-(defun |emptyInterpreterFrame| (name)
- (list name
- (list (list nil))
- 1
- |$HiFiAccess|
- |$HistList|
- |$HistListLen|
- |$HistListAct|
- |$HistRecord|
- nil
- (copy-seq |$localExposureDataDefault|)))
-
-@
-\subsection{defun createCurrentInterpreterFrame}
-\begin{verbatim}
-createCurrentInterpreterFrame() ==
- LIST($interpreterFrameName, -- frame name
- $InteractiveFrame, -- environment
- $IOindex, -- $IOindex
- $HiFiAccess, -- $HiFiAccess
- $HistList, -- $HistList
- $HistListLen, -- $HistListLen
- $HistListAct, -- $HistListAct
- $HistRecord, -- $HistRecord
- $internalHistoryTable, -- $internalHistoryTable
- $localExposureData -- $localExposureData
- )
-\end{verbatim}
-<<defun createCurrentInterpreterFrame>>=
-(defun |createCurrentInterpreterFrame| ()
- (list
- |$interpreterFrameName|
- |$InteractiveFrame|
- |$IOindex|
- |$HiFiAccess|
- |$HistList|
- |$HistListLen|
- |$HistListAct|
- |$HistRecord|
- |$internalHistoryTable|
- |$localExposureData|))
-
-@
-\subsection{defun updateFromCurrentInterpreterFrame}
-\begin{verbatim}
-updateFromCurrentInterpreterFrame() ==
- [$interpreterFrameName, _
- $InteractiveFrame, _
- $IOindex, _
- $HiFiAccess, _
- $HistList, _
- $HistListLen, _
- $HistListAct, _
- $HistRecord, _
- $internalHistoryTable, _
- $localExposureData _
- ] := first $interpreterFrameRing
- if $frameMessages then
- sayMessage ['" Current interpreter frame is called",:bright
- $interpreterFrameName]
- NIL
-\end{verbatim}
-<<defun updateFromCurrentInterpreterFrame>>=
-(defun |updateFromCurrentInterpreterFrame| ()
- (prog (tmp1)
- (return
- (progn
- (spadlet tmp1 (CAR |$interpreterFrameRing|))
- (spadlet |$interpreterFrameName| (car tmp1))
- (spadlet |$InteractiveFrame| (cadr tmp1))
- (spadlet |$IOindex| (caddr tmp1))
- (spadlet |$HiFiAccess| (cadddr tmp1))
- (spadlet |$HistList| (car (cddddr tmp1)))
- (spadlet |$HistListLen| (cadr (cddddr tmp1)))
- (spadlet |$HistListAct| (caddr (cddddr tmp1)))
- (spadlet |$HistRecord| (cadddr (cddddr tmp1)))
- (spadlet |$internalHistoryTable| (car (cddddr (cddddr tmp1))))
- (spadlet |$localExposureData| (cadr (cddddr (cddddr tmp1))))
- (when |$frameMessages|
- (|sayMessage|
- (cons
- (makestring " Current interpreter frame is called")
- (|bright| |$interpreterFrameName|))))
- nil))))
-
-@
-\subsection{defun findFrameInRing}
-\begin{verbatim}
-findFrameInRing(name) ==
- val := NIL
- for frame in $interpreterFrameRing repeat
- CAR frame = name =>
- val := frame
- return frame
- val
-\end{verbatim}
-<<defun findFrameInRing>>=
-(defun |findFrameInRing| (name)
- (prog (val)
- (return
- (seq
- (progn
- (spadlet val nil)
- (seq
- (do ((tmp0 |$interpreterFrameRing| (cdr tmp0)) (frame nil))
- ((or (atom tmp0)
- (progn (setq frame (car tmp0)) nil))
- nil)
- (seq
- (exit
- (when (boot-equal (CAR frame) name)
- (exit
- (progn
- (spadlet val frame)
- (return frame)))))))
- (exit val)))))))
-
-@
-\subsection{defun updateCurrentInterpreterFrame}
-\begin{verbatim}
-updateCurrentInterpreterFrame() ==
- RPLACA($interpreterFrameRing,createCurrentInterpreterFrame())
- updateFromCurrentInterpreterFrame()
- NIL
-\end{verbatim}
-<<defun updateCurrentInterpreterFrame>>=
-(defun |updateCurrentInterpreterFrame| ()
- (progn
- (rplaca |$interpreterFrameRing| (|createCurrentInterpreterFrame|))
- (|updateFromCurrentInterpreterFrame|)
- nil))
-
-@
-\subsection{defun initializeInterpreterFrameRing}
-\begin{verbatim}
-initializeInterpreterFrameRing() ==
- $interpreterFrameName := 'initial
- $interpreterFrameRing := [emptyInterpreterFrame($interpreterFrameName)]
- updateFromCurrentInterpreterFrame()
- NIL
-\end{verbatim}
-<<defun initializeInterpreterFrameRing>>=
-(defun |initializeInterpreterFrameRing| ()
- (progn
- (spadlet |$interpreterFrameName| '|initial|)
- (spadlet |$interpreterFrameRing|
- (cons (|emptyInterpreterFrame| |$interpreterFrameName|) nil))
- (|updateFromCurrentInterpreterFrame|) nil))
-
-@
-\subsection{defun nextInterpreterFrame}
-\begin{verbatim}
-nextInterpreterFrame() ==
- updateCurrentInterpreterFrame()
- null rest $interpreterFrameRing => NIL -- nothing to do
- $interpreterFrameRing :=
- NCONC2(rest $interpreterFrameRing,[first $interpreterFrameRing])
- updateFromCurrentInterpreterFrame()
-\end{verbatim}
-<<defun nextInterpreterFrame>>=
-(defun |nextInterpreterFrame| ()
- (progn
- (|updateCurrentInterpreterFrame|)
- (cond
- ((null (cdr |$interpreterFrameRing|))
- nil)
- (t
- (spadlet |$interpreterFrameRing|
- (nconc2
- (cdr |$interpreterFrameRing|)
- (cons
- (car |$interpreterFrameRing|) nil)))
- (|updateFromCurrentInterpreterFrame|)))))
-
-@
-\subsection{defun changeToNamedInterpreterFrame}
-\begin{verbatim}
-changeToNamedInterpreterFrame(name) ==
- updateCurrentInterpreterFrame()
- frame := findFrameInRing(name)
- null frame => NIL
- $interpreterFrameRing := [frame,:NREMOVE($interpreterFrameRing, frame)]
- updateFromCurrentInterpreterFrame()
-\end{verbatim}
-<<defun changeToNamedInterpreterFrame>>=
-(defun |changeToNamedInterpreterFrame| (name)
- (prog (frame)
- (return
- (progn
- (|updateCurrentInterpreterFrame|)
- (spadlet frame (|findFrameInRing| name))
- (cond
- ((null frame)
- nil)
- (t
- (spadlet |$interpreterFrameRing|
- (cons frame (nremove |$interpreterFrameRing| frame)))
- (|updateFromCurrentInterpreterFrame|)))))))
-
-@
-\subsection{defun previousInterpreterFrame}
-\begin{verbatim}
-previousInterpreterFrame() ==
- updateCurrentInterpreterFrame()
- null rest $interpreterFrameRing => NIL -- nothing to do
- [:b,l] := $interpreterFrameRing
- $interpreterFrameRing := NCONC2([l],b)
- updateFromCurrentInterpreterFrame()
-\end{verbatim}
-<<defun previousInterpreterFrame>>=
-(defun |previousInterpreterFrame| ()
- (prog (tmp1 l b)
- (return
- (progn
- (|updateCurrentInterpreterFrame|)
- (cond
- ((null (cdr |$interpreterFrameRing|))
- nil)
- (t
- (spadlet tmp1 (reverse |$interpreterFrameRing|))
- (spadlet l (car tmp1))
- (spadlet b (nreverse (cdr tmp1)))
- (spadlet |$interpreterFrameRing| (nconc2 (cons l nil) b))
- (|updateFromCurrentInterpreterFrame|)))))))
-
-@
-\subsection{defun addNewInterpreterFrame}
-\begin{verbatim}
-addNewInterpreterFrame(name) ==
- null name => throwKeyedMsg("S2IZ0018",NIL)
- updateCurrentInterpreterFrame()
- -- see if we already have one by that name
- for f in $interpreterFrameRing repeat
- name = frameName(f) => throwKeyedMsg("S2IZ0019",[name])
- initHistList()
- $interpreterFrameRing := CONS(emptyInterpreterFrame(name),
- $interpreterFrameRing)
- updateFromCurrentInterpreterFrame()
- _$ERASE histFileName()
-\end{verbatim}
-<<defun addNewInterpreterFrame>>=
-(defun |addNewInterpreterFrame| (name)
- (seq
- (cond
- ((null name)
- (|throwKeyedMsg| 'S2IZ0018 nil)) ; you must provide a name for new frame
- (t
- (|updateCurrentInterpreterFrame|)
- (seq
- (do ((tmp0 |$interpreterFrameRing| (cdr tmp0)) (f nil))
- ((or (atom tmp0)
- (progn (setq f (car tmp0)) nil))
- nil)
- (seq
- (exit
- (when (boot-equal name (|frameName| f))
- (exit
- (|throwKeyedMsg| 'S2IZ0019 ; existing frame with same name
- (cons name nil)))))))
- (|initHistList|)
- (spadlet |$interpreterFrameRing|
- (cons (|emptyInterpreterFrame| name) |$interpreterFrameRing|))
- (|updateFromCurrentInterpreterFrame|)
- ($erase (|histFileName|)))))))
-
-@
-\subsection{defun closeInterpreterFrame}
-\begin{verbatim}
-closeInterpreterFrame(name) ==
- -- if name = NIL then it means the current frame
- null rest $interpreterFrameRing =>
- name and (name ^= $interpreterFrameName) =>
- throwKeyedMsg("S2IZ0020",[$interpreterFrameName])
- throwKeyedMsg("S2IZ0021",NIL)
- if null name then $interpreterFrameRing := rest $interpreterFrameRing
- else -- find the frame
- found := nil
- ifr := NIL
- for f in $interpreterFrameRing repeat
- found or (name ^= frameName(f)) => ifr := CONS(f,ifr)
- found := true
- not found => throwKeyedMsg("S2IZ0022",[name])
- _$ERASE makeHistFileName(name)
- $interpreterFrameRing := nreverse ifr
- updateFromCurrentInterpreterFrame()
-\end{verbatim}
-<<defun closeInterpreterFrame>>=
-(defun |closeInterpreterFrame| (name)
- (prog (ifr found)
- (return
- (seq
- (cond
- ((null (cdr |$interpreterFrameRing|))
- (cond
- ((and name (nequal name |$interpreterFrameName|))
- (|throwKeyedMsg| 'S2IZ0020 ; 1 frame left. not the correct name.
- (cons |$interpreterFrameName| nil)))
- (t (|throwKeyedMsg| 'S2IZ0021 nil)))) ; only 1 frame left, not closed
- (t
- (cond
- ((null name)
- (spadlet |$interpreterFrameRing| (cdr |$interpreterFrameRing|)))
- (t
- (spadlet found nil)
- (spadlet ifr nil)
- (do ((tmp0 |$interpreterFrameRing| (cdr tmp0)) (f nil))
- ((or (atom tmp0) (progn (setq f (car tmp0)) nil)) nil)
- (seq
- (exit
- (cond
- ((or found (nequal name (|frameName| f)))
- (spadlet ifr (cons f ifr)))
- (t
- (spadlet found t))))))
- (cond
- ((null found)
- (|throwKeyedMsg| 'S2IZ0022 (cons name nil)))
- (t
- ($erase (|makeHistFileName| name))
- (spadlet |$interpreterFrameRing| (nreverse ifr))))))
- (|updateFromCurrentInterpreterFrame|)))))))
-
-@
-\subsection{defun displayFrameNames}
-\begin{verbatim}
-displayFrameNames() ==
- fs := "append"/[ ['%l,'" ",:bright frameName f] for f in
- $interpreterFrameRing]
- sayKeyedMsg("S2IZ0024",[fs])
-\end{verbatim}
-<<defun displayFrameNames>>=
-(defun |displayFrameNames| ()
- (prog (fs)
- (return
- (seq
- (progn
- (spadlet fs
- (prog (tmp0)
- (spadlet tmp0 NIL)
- (return
- (do ((tmp1 |$interpreterFrameRing| (cdr tmp1)) (f nil))
- ((or (atom tmp1)
- (progn (setq f (car tmp1)) nil))
- tmp0)
- (seq
- (exit
- (setq tmp0
- (append tmp0 (cons '|%l|
- (cons (makestring " ") (|bright| (|frameName| f))))))))))))
- (|sayKeyedMsg| 'S2IZ0024 (cons fs nil))))))) ; frame names are ...
-
-@
-\subsection{defun importFromFrame}
-\begin{verbatim}
-importFromFrame args ==
- -- args should have the form [frameName,:varNames]
- if args and atom args then args := [args]
- null args => throwKeyedMsg("S2IZ0073",NIL)
- [fname,:args] := args
- not member(fname,frameNames()) =>
- throwKeyedMsg("S2IZ0074",[fname])
- fname = frameName first $interpreterFrameRing =>
- throwKeyedMsg("S2IZ0075",NIL)
- fenv := frameEnvironment fname
- null args =>
- x := UPCASE queryUserKeyedMsg("S2IZ0076",[fname])
- MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
- vars := NIL
- for [v,:props] in CAAR fenv repeat
- v = "--macros" =>
- for [m,:.] in props repeat vars := cons(m,vars)
- vars := cons(v,vars)
- importFromFrame [fname,:vars]
- sayKeyedMsg("S2IZ0077",[fname])
- for v in args repeat
- plist := GETALIST(CAAR fenv,v)
- plist =>
- -- remove anything with the same name in the current frame
- clearCmdParts ['propert,v]
- for [prop,:val] in plist repeat
- putHist(v,prop,val,$InteractiveFrame)
- (m := get("--macros--",v,fenv)) =>
- putHist("--macros--",v,m,$InteractiveFrame)
- sayKeyedMsg("S2IZ0079",[v,fname])
- sayKeyedMsg("S2IZ0078",[fname])
-\end{verbatim}
-<<defun importFromFrame>>=
-(defun |importFromFrame| (args)
- (prog (temp1 fname fenv x v props vars plist prop val m)
- (return
- (seq
- (progn
- (when (and args (atom args))
- (spadlet args (cons args nil)))
- (cond
- ((null args)
- (|throwKeyedMsg| 'S2IZ0073 nil)) ; missing frame name
- (t
- (spadlet temp1 args)
- (spadlet fname (car temp1))
- (spadlet args (cdr temp1))
- (cond
- ((null (|member| fname (|frameNames|)))
- (|throwKeyedMsg| 'S2IZ0074 (cons fname nil))) ; not frame name
- ((boot-equal fname (|frameName| (car |$interpreterFrameRing|)))
- (|throwKeyedMsg| 'S2IZ0075 NIL)) ; cannot import from curr frame
- (t
- (spadlet fenv (|frameEnvironment| fname))
- (cond
- ((null args)
- (spadlet x
- (upcase (|queryUserKeyedMsg| 'S2IZ0076 (cons fname nil))))
- ; import everything?
- (cond
- ((memq (string2id-n x 1) '(y yes))
- (spadlet vars nil)
- (do ((tmp0 (caar fenv) (cdr tmp0)) (tmp1 nil))
- ((or (atom tmp0)
- (progn (setq tmp1 (car tmp0)) nil)
- (progn
- (progn
- (spadlet v (car tmp1))
- (spadlet props (cdr tmp1))
- tmp1)
- nil))
- nil)
- (seq
- (exit
- (cond
- ((boot-equal v '|--macros|)
- (do ((tmp2 props (cdr tmp2))
- (tmp3 nil))
- ((or (atom tmp2)
- (progn (setq tmp3 (car tmp2)) nil)
- (progn
- (progn (spadlet m (car tmp3)) tmp3)
- nil))
- nil)
- (seq
- (exit
- (spadlet vars (cons m vars))))))
- (t (spadlet vars (cons v vars)))))))
- (|importFromFrame| (cons fname vars)))
- (t
- (|sayKeyedMsg| 'S2IZ0077 (cons fname nil)))))
- (t
- (do ((tmp4 args (cdr tmp4)) (v nil))
- ((or (atom tmp4) (progn (setq v (car tmp4)) nil)) nil)
- (seq
- (exit
- (progn
- (spadlet plist (getalist (caar fenv) v))
- (cond
- (plist
- (|clearCmdParts| (cons '|propert| (cons v nil)))
- (do ((tmp5 plist (cdr tmp5)) (tmp6 nil))
- ((or (atom tmp5)
- (progn (setq tmp6 (car tmp5)) nil)
- (progn
- (progn
- (spadlet prop (car tmp6))
- (spadlet val (cdr tmp6))
- tmp6)
- nil))
- nil)
- (seq
- (exit (|putHist| v prop val |$InteractiveFrame|)))))
- ((spadlet m (|get| '|--macros--| v fenv))
- (|putHist| '|--macros--| v m |$InteractiveFrame|))
- (t
- (|sayKeyedMsg| 'S2IZ0079 ; frame not found
- (cons v (cons fname nil)))))))))
- (|sayKeyedMsg| 'S2IZ0078 ; import complete
- (cons fname nil)))))))))))))
-
-@
-\subsection{defun frame}
-\begin{verbatim}
--- the system command
-
-frame l == frameSpad2Cmd l
-\end{verbatim}
-<<defun frame>>=
-(defun |frame| (l)
- (|frameSpad2Cmd| l))
-
-@
-\subsection{defun frameSpad2Cmd}
-\begin{verbatim}
-frameSpad2Cmd args ==
- frameArgs := '(drop import last names new next)
- $options => throwKeyedMsg("S2IZ0016",['")frame"])
- null(args) => helpSpad2Cmd ['frame]
- arg := selectOptionLC(first args,frameArgs,'optionError)
- args := rest args
- if args is [a] then args := a
- if ATOM args then args := object2Identifier args
- arg = 'drop =>
- args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args])
- closeInterpreterFrame(args)
- arg = 'import => importFromFrame args
- arg = 'last => previousInterpreterFrame()
- arg = 'names => displayFrameNames()
- arg = 'new =>
- args and PAIRP(args) => throwKeyedMsg("S2IZ0017",[args])
- addNewInterpreterFrame(args)
- arg = 'next => nextInterpreterFrame()
-
- NIL
-\end{verbatim}
-<<defun frameSpad2Cmd>>=
-(defun |frameSpad2Cmd| (args)
- (prog (frameArgs arg a)
- (return
- (progn
- (spadlet frameArgs '(|drop| |import| |last| |names| |new| |next|))
- (cond
- (|$options|
- (|throwKeyedMsg| 'S2IZ0016 ; frame command does not take options
- (cons (makestring ")frame") nil)))
- ((null args)
- (|helpSpad2Cmd| (cons '|frame| nil)))
- (t
- (spadlet arg
- (|selectOptionLC| (car args) frameArgs '|optionError|))
- (spadlet args (cdr args))
- (cond
- ((and (pairp args)
- (eq (qcdr args) nil)
- (progn (spadlet a (qcar args)) t))
- (spadlet args a)))
- (when (atom args)
- (spadlet args (|object2Identifier| args)))
- (cond
- ((boot-equal arg '|drop|)
- (cond
- ((and args (pairp args))
- (|throwKeyedMsg| 'S2IZ0017 ; not a valid frame name
- (cons args nil)))
- (t (|closeInterpreterFrame| args))))
- ((boot-equal arg '|import|)
- (|importFromFrame| args))
- ((boot-equal arg '|last|)
- (|previousInterpreterFrame|))
- ((boot-equal arg '|names|)
- (|displayFrameNames|))
- ((boot-equal arg '|new|)
- (cond
- ((and args (pairp args))
- (|throwKeyedMsg| 'S2IZ0017 ; not a valid frame name
- (cons args nil)))
- (t
- (|addNewInterpreterFrame| args))))
- ((boot-equal arg '|next|)
- (|nextInterpreterFrame|))
- (t nil))))))))
-
-@
-\section{Frame File Messages}
-<<Frame File Messages>>=
-S2IZ0016
- The %1b system command takes arguments but no options.
-S2IZ0017
- %1b is not a valid frame name
-S2IZ0018
- You must provide a name for the new frame.
-S2IZ0019
- You cannot use the name %1b for a new frame because an existing
- frame already has that name.
-S2IZ0020
- There is only one frame active and therefore that cannot be closed.
- Furthermore, the frame name you gave is not the name of the current frame.
- The current frame is called %1b .
-S2IZ0021
- The current frame is the only active one. Issue %b )clear all %d to
- clear its contents.
-S2IZ0022
- There is no frame called %1b and so your command cannot be
- processed.
-S2IZ0024
- The names of the existing frames are: %1 %l
- The current frame is the first one listed.
-S2IZ0073
- %b )frame import %d must be followed by the frame name. The names
- of objects in that frame can then optionally follow the frame name.
- For example,
- %ceon %b )frame import calculus %d %ceoff
- imports all objects in the %b calculus %d frame, and
- %ceon %b )frame import calculus epsilon delta %d %ceoff
- imports the objects named %b epsilon %d and %b delta %d from the
- frame %b calculus %d .
- Please note that if the current frame contained any information
- about objects with these names, then that information would be
- cleared before the import took place.
-S2IZ0074
- You cannot import anything from the frame %1b because that is not
- the name of an existing frame.
-S2IZ0075
- You cannot import from the current frame (nor is there a need!).
-S2IZ0076
- User verification required:
- do you really want to import everything from the frame %1b ?
- If so, please enter %b y %d or %b yes %d :
-S2IZ0077
- On your request, AXIOM will not import everything from frame %1b.
-S2IZ0078
- Import from frame %1b is complete. Please issue %b )display all %d
- if you wish to see the contents of the current frame.
-S2IZ0079
- AXIOM cannot import %1b from frame %2b because it cannot be found.
-@
-\chapter{The Undo Mechanism}
-\section{)undo}
-\index{ugSysCmdundo}
-
-\index{undo}
-
-
-\par\noindent{\bf User Level Required:} interpreter
-
-\par\noindent{\bf Command Syntax:}
-\begin{list}{}
-\item{\tt )undo}
-\item{\tt )undo} {\it integer}
-\item{\tt )undo} {\it integer [option]}
-\item{\tt )undo} {\tt )redo}
-\end{list}
-%
-where {\it option} is one of
-%
-\begin{list}{}
-\item{\tt )after}
-\item{\tt )before}
-\end{list}
-
-\par\noindent{\bf Command Description:}
-
-This command is used to
-restore the state of the user environment to an earlier
-point in the interactive session.
-The argument of an {\tt )undo} is an integer which must designate some
-step number in the interactive session.
-
-\begin{verbatim}
-)undo n
-)undo n )after
-\end{verbatim}
-These commands return the state of the interactive
-environment to that immediately after step {\tt n}.
-If {\tt n} is a positive number, then {\tt n} refers to step nummber
-{\tt n}. If {\tt n} is a negative number, it refers to the \tt n-th
-previous command (that is, undoes the effects of the last $-n$
-commands).
-
-A {\tt )clear all} resets the {\tt )undo} facility.
-Otherwise, an {\tt )undo} undoes the effect of {\tt )clear} with
-options {\tt properties}, {\tt value}, and {\tt mode}, and
-that of a previous {\tt undo}.
-If any such system commands are given between steps $n$ and
-$n + 1$ ($n > 0$), their effect is undone
-for {\tt )undo m} for any $0 < m \leq n$..
-
-The command {\tt )undo} is equivalent to {\tt )undo -1} (it undoes
-the effect of the previous user expression).
-The command {\tt )undo 0} undoes any of the above system commands
-issued since the last user expression.
-
-\begin{verbatim}
-)undo n )before
-\end{verbatim}
-This command returns the state of the interactive
-environment to that immediately before step {\tt n}.
-Any {\tt )undo} or {\tt )clear} system commands
-given before step {\tt n} will not be undone.
-
-\begin{verbatim}
-)undo )redo
-\end{verbatim}
-This command reads the file {\tt redo.input}.
-created by the last {\tt )undo} command.
-This file consists of all user input lines, excluding those
-backtracked over due to a previous {\tt )undo}.
-
-\par\noindent{\bf Also See:}
-{\tt )history} \index{ugSysCmdhistory}.
-The command {\tt )history )write} will eliminate the ``undone'' command
-lines of your program.
-\section{Variables Used}
-\section{Data Structures}
-[[$frameRecord = [delta1, delta2,... ] ]] where
-[[delta(i)]] contains changes in the ``backwards'' direction.
-Each [[delta(i)]] has the form [[((var . proplist)...)]] where
-proplist denotes an ordinary proplist. For example, an entry
-of the form [[((x (value) (mode (Integer)))...)]] indicates that
-to undo 1 step, [[x]]'s value is cleared and its mode should be set
-to [[(Integer)]].
-
-A [[delta(i)]] of the form [[(systemCommand . delta)]] is a special
-delta indicating changes due to system commands executed between
-the last command and the current command. By recording these deltas
-separately, it is possible to undo to either BEFORE or AFTER
-the command. These special [[delta(i)]]s are given ONLY when a
-a system command is given which alters the environment.
-
-Note: [[recordFrame('system)]] is called before a command is executed, and
-[[recordFrame('normal)]] is called after (see processInteractive1).
-If no changes are found for former, no special entry is given.
-
-The [[$previousBindings]] is a copy of the
-[[CAAR $InteractiveFrame]]. This is used to
-compute the [[delta(i)]]s stored in [[$frameRecord]].
-\section{Functions}
-\subsection{Initial Undo Variables}
-\begin{verbatim}
-$undoFlag := true --Default setting for undo is "on"
-$frameRecord := nil --Initial setting for frame record
-$previousBindings := nil
-\end{verbatim}
-<<initvars>>=
-(defvar |$undoFlag| t "t means we record undo information")
-(defvar |$frameRecord| nil "a list of value changes")
-(defvar |$previousBindings| nil "a copy of Interactive Frame info for undo")
-(defvar |$reportUndo| nil "t means we report the steps undo takes")
-@
-\subsection{defun undo}
-\begin{verbatim}
-undo(l) ==
---undo takes one option ")redo" which simply reads "redo.input",
--- a file created by every normal )undo command (see below)
- undoWhen := 'after
- if $options is [[key]] then
- stringPrefix?(s := PNAME key,'"redo") =>
- $options := nil --clear $options so that "read" won't see them
- read '(redo_.input)
- not stringPrefix?(s,'"before") =>
- userError '"only option to undo is _")redo_""
- undoWhen := 'before
- n :=
- null l => -1
- first l
- if IDENTP n then
- n := PARSE_-INTEGER PNAME n
- if not FIXP n then userError '"undo argument must be an integer"
- $InteractiveFrame := undoSteps(undoCount n,undoWhen)
- nil
-\end{verbatim}
-<<defun undo>>=
-(defun |undo| (l)
- (prog (tmp1 key s undoWhen n)
- (return
- (progn
- (spadlet undoWhen '|after|)
- (when
- (and (pairp |$options|)
- (eq (qcdr |$options|) nil)
- (progn
- (spadlet tmp1 (qcar |$options|))
- (and (pairp tmp1)
- (eq (qcdr tmp1) nil)
- (progn (spadlet key (qcar tmp1)) t)))
- (cond
- ((|stringPrefix?| (spadlet s (pname key)) (makestring "redo"))
- (spadlet |$options| nil)
- (|read| '(|redo.input|)))
- ((null (|stringPrefix?| s (makestring "before")))
- (|userError| (makestring "only option to undo is \")redo\"")))
- (t
- (spadlet undoWhen '|before|)))))
- (if (null l)
- (spadlet n (spaddifference 1))
- (spadlet n (car l)))
- (when (identp n)
- (spadlet n (parse-integer (pname n)))
- (cond
- ((null (fixp n))
- (|userError| (makestring "undo argument must be an integer")))
- (t
- nil)))
- (spadlet |$InteractiveFrame| (|undoSteps| (|undoCount| n) undoWhen))
- nil))))
-
-@
-\subsection{defun recordFrame}
-\begin{verbatim}
-recordFrame(systemNormal) ==
- null $undoFlag => nil --do nothing if facility is turned off
- currentAlist := KAR $frameRecord
- delta := diffAlist(CAAR $InteractiveFrame,$previousBindings)
- if systemNormal = 'system then
- null delta => return nil --do not record
- delta := ['systemCommand,:delta]
- $frameRecord := [delta,:$frameRecord]
- $previousBindings := --copy all but the individual properties
- [CONS(CAR x,[CONS(CAR y,CDR y) for y in CDR x]) for x in CAAR
$InteractiveFrame]
- first $frameRecord
-\end{verbatim}
-<<defun recordFrame>>=
-(defun |recordFrame| (systemNormal)
- (prog (currentAlist delta)
- (return
- (seq
- (cond
- ((null |$undoFlag|) nil)
- (t
- (spadlet currentAlist (kar |$frameRecord|))
- (spadlet delta
- (|diffAlist| (caar |$InteractiveFrame|) |$previousBindings|))
- (cond
- ((boot-equal systemNormal '|system|)
- (cond
- ((null delta)
- (return nil))
- (t
- (spadlet delta (cons '|systemCommand| delta))))))
- (spadlet |$frameRecord| (cons delta |$frameRecord|))
- (spadlet |$previousBindings|
- (prog (tmp0)
- (spadlet tmp0 nil)
- (return
- (do ((tmp1 (caar |$InteractiveFrame|) (cdr tmp1)) (x nil))
- ((or (atom tmp1)
- (progn (setq x (car tmp1)) nil))
- (nreverse0 tmp0))
- (seq
- (exit
- (setq tmp0
- (cons
- (cons
- (car x)
- (prog (tmp2)
- (spadlet tmp2 nil)
- (return
- (do ((tmp3 (cdr x) (cdr tmp3)) (|y| nil))
- ((or (atom tmp3)
- (progn (setq |y| (car tmp3)) nil))
- (nreverse0 tmp2))
- (seq
- (exit
- (setq tmp2 (cons (cons (car |y|) (cdr |y|)) tmp2))))))))
- tmp0))))))))
- (car |$frameRecord|)))))))
-
-@
-\subsection{defun diffAlist}
-\begin{verbatim}
-diffAlist(new,old) ==
---record only those properties which are different
- for (pair := [name,:proplist]) in new repeat
- -- name has an entry both in new and old world
- -- (1) if the old world had no proplist for that variable, then
- -- record NIL as the value of each new property
- -- (2) if the old world does have a proplist for that variable, then
- -- a) for each property with a value: give the old value
- -- b) for each property missing: give NIL as the old value
- oldPair := ASSQ(name,old) =>
- null (oldProplist := CDR oldPair) =>
- --record old values of new properties as NIL
- acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc]
- deltas := nil
- for (propval := [prop,:val]) in proplist repeat
- null (oldPropval := ASSOC(prop,oldProplist)) => --missing property
- deltas := [[prop],:deltas]
- EQ(CDR oldPropval,val) => 'skip
- deltas := [oldPropval,:deltas]
- deltas => acc := [[name,:NREVERSE deltas],:acc]
- acc := [[name,:[[prop] for [prop,:.] in proplist]],:acc]
---record properties absent on new list (say, from a )cl all)
- for (oldPair := [name,:r]) in old repeat
- r and null LASSQ(name,new) =>
- acc := [oldPair,:acc]
- -- name has an entry both in new and old world
- -- (1) if the new world has no proplist for that variable
- -- (a) if the old world does, record the old proplist
- -- (b) if the old world does not, record nothing
- -- (2) if the new world has a proplist for that variable, it has
- -- been handled by the first loop.
- res := NREVERSE acc
- if BOUNDP '$reportUndo and $reportUndo then reportUndo res
- res
-\end{verbatim}
-<<defun diffAlist>>=
-(defun |diffAlist| (new old)
- (prog (proplist oldPair oldProplist val oldPropval deltas prop name r acc res)
- (return
- (seq
- (progn
- (do ((tmp0 new (cdr tmp0)) (pair nil))
- ((or (atom tmp0)
- (progn (setq pair (car tmp0)) nil)
- (progn
- (progn
- (spadlet name (car pair))
- (spadlet proplist (cdr pair))
- pair)
- nil))
- nil)
- (seq
- (exit
- (cond
- ((spadlet oldPair (assq name old))
- (cond
- ((null (spadlet oldProplist (cdr oldPair)))
- (spadlet acc
- (cons
- (cons
- name
- (prog (tmp1)
- (spadlet tmp1 nil)
- (return
- (do ((tmp2 proplist (cdr tmp2)) (tmp3 nil))
- ((or (atom tmp2)
- (progn (setq tmp3 (car tmp2)) nil)
- (progn
- (progn (spadlet prop (car tmp3)) tmp3)
- nil))
- (nreverse0 tmp1))
- (seq
- (exit
- (setq tmp1 (cons (cons prop nil) tmp1))))))))
- acc)))
- (t
- (spadlet deltas nil)
- (do ((tmp4 proplist (cdr tmp4)) (|propval| nil))
- ((or (atom tmp4)
- (progn (setq |propval| (car tmp4)) nil)
- (progn
- (progn
- (spadlet prop (car |propval|))
- (spadlet val (cdr |propval|))
- |propval|)
- nil))
- nil)
- (seq
- (exit
- (cond
- ((null (spadlet oldPropval (|assoc| prop oldProplist)))
- (spadlet deltas (cons (cons prop nil) deltas)))
- ((eq (cdr oldPropval) val) '|skip|)
- (t (spadlet deltas (cons oldPropval deltas)))))))
- (when deltas
- (spadlet acc
- (cons (cons name (nreverse deltas)) acc))))))
- (t
- (spadlet acc
- (cons
- (cons
- name
- (prog (tmp5)
- (spadlet tmp5 nil)
- (return
- (do ((tmp6 proplist (cdr tmp6)) (tmp7 nil))
- ((or (atom tmp6)
- (progn (setq tmp7 (CAR tmp6)) nil)
- (progn
- (progn (spadlet prop (CAR tmp7)) tmp7)
- nil))
- (nreverse0 tmp5))
- (seq
- (exit
- (setq tmp5 (cons (cons prop nil) tmp5))))))))
- acc)))))))
- (seq
- (do ((tmp8 old (cdr tmp8)) (oldPair nil))
- ((or (atom tmp8)
- (progn (setq oldPair (car tmp8)) nil)
- (progn
- (progn
- (spadlet name (car oldPair))
- (spadlet r (cdr oldPair))
- oldPair)
- nil))
- nil)
- (seq
- (exit
- (cond
- ((and r (null (lassq name new)))
- (exit
- (spadlet acc (cons oldPair acc))))))))
- (spadlet res (nreverse acc))
- (cond
- ((and (boundp '|$reportUndo|) |$reportUndo|)
- (|reportUndo| res)))
- (exit res)))))))
-
-@
-\subsection{defun reportUndo}
-This function is enabled by setting [[|$reportUndo]] to a non-nil value.
-An example of the output generated is:
-\begin{verbatim}
-r := binary(22/7)
-
-
- ___
- (1) 11.001
- Type: BinaryExpansion
-Properties of % ::
- value was: NIL
- value is: ((|BinaryExpansion|) WRAPPED . #(1 (1 1) NIL (0 0 1)))
-Properties of r ::
- value was: NIL
- value is: ((|BinaryExpansion|) WRAPPED . #(1 (1 1) NIL (0 0 1)))
-
-\end{verbatim}
-
-\begin{verbatim}
-reportUndo acc ==
- for [name,:proplist] in acc repeat
- sayBrightly STRCONC("Properties of ",PNAME name,'" ::")
- curproplist := LASSOC(name,CAAR $InteractiveFrame)
- for [prop,:value] in proplist repeat
- sayBrightlyNT ['" ",prop,'" was: "]
- pp value
- sayBrightlyNT ['" ",prop,'" is: "]
- pp LASSOC(prop,curproplist)
-\end{verbatim}
-<<defun reportUndo>>=
-(defun |reportUndo| (acc)
- (prog (name proplist curproplist prop value)
- (return
- (seq
- (do ((tmp0 acc (cdr tmp0)) (tmp1 nil))
- ((or (atom tmp0)
- (progn (setq tmp1 (car tmp0)) nil)
- (progn
- (progn
- (spadlet name (car tmp1))
- (spadlet proplist (cdr tmp1))
- tmp1)
- nil))
- nil)
- (seq
- (exit
- (progn
- (|sayBrightly|
- (strconc '|Properties of | (pname name) (makestring " ::")))
- (spadlet curproplist (lassoc name (caar |$InteractiveFrame|)))
- (do ((tmp2 proplist (cdr tmp2)) (tmp3 nil))
- ((or (atom tmp2)
- (progn (setq tmp3 (car tmp2)) nil)
- (progn
- (progn
- (spadlet prop (car tmp3))
- (spadlet value (cdr tmp3))
- tmp3)
- nil))
- nil)
- (seq
- (exit
- (progn
- (|sayBrightlyNT|
- (cons
- (makestring " ")
- (cons prop (cons (makestring " was: ") nil))))
- (|pp| value)
- (|sayBrightlyNT|
- (cons
- (makestring " ")
- (cons prop (cons (makestring " is: ") nil))))
- (|pp| (lassoc prop curproplist))))))))))))))
-
-@
-\subsection{defun clearFrame}
-\begin{verbatim}
-clearFrame() ==
- clearCmdAll()
- $frameRecord := nil
- $previousBindings := nil
-\end{verbatim}
-<<defun clearFrame>>=
-(defun |clearFrame| ()
- (progn
- (|clearCmdAll|)
- (spadlet |$frameRecord| nil)
- (spadlet |$previousBindings| nil)))
-
-@
-\subsection{defun undoCount}
-\begin{verbatim}
---=======================================================================
--- Undoing previous m commands
---=======================================================================
-undoCount(n) == --computes the number of undo's, given $IOindex
---pp ["IOindex = ",$IOindex]
- m :=
- n >= 0 => $IOindex - n - 1
- -n
- m >= $IOindex => userError STRCONC('"Magnitude of undo argument must be less
than step number (",STRINGIMAGE $IOindex,'").")
- m
-\end{verbatim}
-<<defun undoCount>>=
-(defun |undoCount| (n)
- (prog (m)
- (return
- (progn
- (spadlet m
- (cond
- ((>= n 0) (spaddifference (spaddifference |$IOindex| n) 1))
- (t (spaddifference n))))
- (cond
- ((>= m |$IOindex|)
- (|userError|
- (strconc
- (makestring
- "Magnitude of undo argument must be less than step number (")
- (stringimage |$IOindex|) (makestring ")."))))
- (t m))))))
-
-@
-\subsection{defun undoSteps}
-\begin{verbatim}
-undoSteps(m,beforeOrAfter) ==
--- undoes m previous commands; if )before option, then undo one extra at end
---Example: if $IOindex now is 6 and m = 2 then general layout of $frameRecord,
--- after the call to recordFrame below will be:
--- (<change for systemcommands>
--- (<change for #5> <change for system commands>
--- (<change for #4> <change for system commands>
--- (<change for #3> <change for system commands>
--- <change for #2> <change for system commands>
--- <change for #1> <change for system commands>) where system
--- command entries are optional and identified by (systemCommand . change).
--- For a ")undo 3 )after", m = 2 and undoStep swill restore the environment
--- up to, but not including <change for #3>.
--- An "undo 3 )before" will additionally restore <change for #3>.
--- Thus, the later requires one extra undo at the end.
- writeInputLines('redo,$IOindex - m)
- recordFrame('normal) --do NOT mark this as a system command change
- --do this undo FIRST (i=0 case)
- env := COPY CAAR $InteractiveFrame
- for i in 0..m for framelist in tails $frameRecord repeat
- env := undoSingleStep(first framelist,env)
- framelist is [.,['systemCommand,:systemDelta],:.] =>
--- pp '"===============> AHA <============="
- framelist := rest framelist --undoing system commands given
- env := undoSingleStep(systemDelta,env) -- before command line
- lastTailSeen := framelist
- if beforeOrAfter = 'before then --do one additional undo for )before
- env := undoSingleStep(first rest lastTailSeen,env)
- $frameRecord := rest $frameRecord --flush the effect of extra recordFrame
- $InteractiveFrame := LIST LIST env
-\end{verbatim}
-<<defun undoSteps>>=
-(defun |undoSteps| (m beforeOrAfter)
- (prog (tmp1 tmp2 systemDelta framelist lastTailSeen env)
- (return
- (seq
- (progn
- (|writeInputLines| '|redo| (spaddifference |$IOindex| m))
- (|recordFrame| '|normal|)
- (spadlet env (copy (caar |$InteractiveFrame|)))
- (do ((|i| 0 (qsadd1 |i|)) (framelist |$frameRecord| (cdr framelist)))
- ((or (qsgreaterp |i| m) (atom framelist)) nil)
- (seq
- (exit
- (progn
- (spadlet env (|undoSingleStep| (CAR framelist) env))
- (cond
- ((and (pairp framelist)
- (progn
- (spadlet tmp1 (qcdr framelist))
- (and (pairp tmp1)
- (progn
- (spadlet tmp2 (qcar tmp1))
- (and (pairp tmp2)
- (eq (qcar tmp2) '|systemCommand|)
- (progn
- (spadlet systemDelta (qcdr tmp2))
- t))))))
- (spadlet framelist (cdr framelist))
- (spadlet env (|undoSingleStep| systemDelta env)))
- (t (spadlet lastTailSeen framelist)))))))
- (cond
- ((boot-equal beforeOrAfter '|before|)
- (spadlet env (|undoSingleStep| (car (cdr lastTailSeen)) env))))
- (spadlet |$frameRecord| (cdr |$frameRecord|))
- (spadlet |$InteractiveFrame| (list (list env))))))))
-
-@
-\subsection{defun undoSingleStep}
-\begin{verbatim}
-undoSingleStep(changes,env) ==
---Each change is a name-proplist pair. For each change:
--- (1) if there exists a proplist in env, then for each prop-value change:
--- (a) if the prop exists in env, RPLAC in the change value
--- (b) otherwise, CONS it onto the front of prop-values for that name
--- (2) add change to the front of env
--- pp '"----Undoing 1 step--------"
--- pp changes
- for (change := [name,:changeList]) in changes repeat
- if LASSOC('localModemap,changeList) then
- changeList := undoLocalModemapHack changeList
- pairlist := ASSQ(name,env) =>
- proplist := CDR pairlist =>
- for (pair := [prop,:value]) in changeList repeat
- node := ASSQ(prop,proplist) => RPLACD(node,value)
- RPLACD(proplist,[CAR proplist,:CDR proplist])
- RPLACA(proplist,pair)
- RPLACD(pairlist,changeList)
- env := [change,:env]
- env
-\end{verbatim}
-<<defun undoSingleStep>>=
-(defun |undoSingleStep| (changes env)
- (prog (name changeList pairlist proplist prop value node)
- (return
- (seq
- (progn
- (do ((tmp0 changes (cdr tmp0)) (|change| nil))
- ((or (atom tmp0)
- (progn (setq |change| (car tmp0)) nil)
- (progn
- (progn
- (spadlet name (car |change|))
- (spadlet changeList (cdr |change|))
- |change|)
- nil))
- nil)
- (seq
- (exit
- (progn
- (when (lassoc '|localModemap| changeList)
- (spadlet changeList (|undoLocalModemapHack| changeList)))
- (cond
- ((spadlet pairlist (assq name env))
- (cond
- ((spadlet proplist (cdr pairlist))
- (do ((tmp1 changeList (cdr tmp1)) (pair nil))
- ((or (atom tmp1)
- (progn (setq pair (car tmp1)) nil)
- (progn
- (progn
- (spadlet prop (car pair))
- (spadlet value (cdr pair))
- pair)
- nil))
- nil)
- (seq
- (exit
- (cond
- ((spadlet node (assq prop proplist))
- (rplacd node value))
- (t
- (rplacd proplist
- (cons (car proplist) (cdr proplist)))
- (rplaca proplist pair)))))))
- (t (rplacd pairlist changeList))))
- (t
- (spadlet env (cons |change| env))))))))
- env)))))
-
-@
-\subsection{defun undoLocalModemapHack}
-\begin{verbatim}
-undoLocalModemapHack changeList ==
- [newPair for (pair := [name,:value]) in changeList | newPair] where newPair
==
- name = 'localModemap => [name]
- pair
-\end{verbatim}
-<<defun undoLocalModemapHack>>=
-(defun |undoLocalModemapHack| (changeList)
- (prog (name value)
- (return
- (seq
- (prog (tmp0)
- (spadlet tmp0 NIL)
- (return
- (do ((tmp1 changeList (cdr tmp1)) (pair nil))
- ((or (atom tmp1)
- (progn (setq pair (car tmp1)) nil)
- (progn
- (progn
- (spadlet name (car pair))
- (spadlet value (cdr pair))
- pair)
- nil))
- (nreverse0 tmp0))
- (seq
- (exit
- (cond
- ((cond
- ((boot-equal name '|localModemap|) (cons name nil))
- (t pair))
- (setq tmp0
- (cons
- (cond
- ((boot-equal name '|localModemap|) (cons name nil))
- (t pair)) tmp0)))))))))))))
-
-@
-\subsection{defun removeUndoLines}
-Removing undo lines from [[)hist )write linelist]]
-\begin{verbatim}
-removeUndoLines u == --called by writeInputLines
- xtra :=
- STRINGP $currentLine => [$currentLine]
- REVERSE $currentLine
- xtra := [x for x in xtra | not stringPrefix?('")history",x)]
- u := [:u, :xtra]
- not (or/[stringPrefix?('")undo",x) for x in u]) => u
- --(1) reverse the list
- --(2) walk down the (reversed) list: when >n appears remove:
- -- (a) system commands
- -- (b) if n > 0: (replace n by n-1; remove a command; repeat (a-b))
- savedIOindex := $IOindex --save value
- $IOindex := 1
- for y in tails u repeat
- (x := first y).0 = char '_) =>
- stringPrefix?('")undo",s := trimString x) => --parse "undo )option"
- s1 := trimString SUBSTRING(s,5,nil)
- if s1 ^= '")redo" then
- m := charPosition(char '_),s1,0)
- code :=
- m < MAXINDEX s1 => s1.(m + 1)
- char 'a
- s2 := trimString SUBSTRING(s1,0,m)
- n :=
- s1 = '")redo" => 0
- s2 ^= '"" => undoCount PARSE_-INTEGER s2
- -1
- RPLACA(y,CONCAT('">",code,STRINGIMAGE n))
- nil
- $IOindex := $IOindex + 1 --referenced by undoCount
- acc := nil
- for y in tails NREVERSE u repeat
- (x := first y).0 = char '_> =>
- code := x . 1 --code = a,b, or r
- n := PARSE_-INTEGER SUBSTRING(x,2,nil) --n = number of undo steps
- y := rest y --kill >n line
- while y repeat
- c := first y
- c.0 = char '_) or c.0 = char '_> => y := rest y --kill system commands
- n = 0 => return nil --including undos
- n := n - 1
- y := rest y --kill command
- y and code^= char 'b => acc := [c,:acc] --add last unless )before
- acc := [x,:acc]
- $IOindex := savedIOindex
- acc
-\end{verbatim}
-<<defun removeUndoLines>>=
-(defun |removeUndoLines| (u)
- (prog (xtra savedIOindex s s1 m s2 x code c n y acc)
- (return
- (seq
- (progn
- (spadlet xtra
- (cond
- ((stringp |$currentLine|) (cons |$currentLine| nil))
- (t (reverse |$currentLine|))))
- (spadlet xtra
- (prog (tmp0)
- (spadlet tmp0 nil)
- (return
- (do ((tmp1 xtra (cdr tmp1)) (x nil))
- ((or (atom tmp1)
- (progn (setq x (car tmp1)) nil))
- (nreverse0 tmp0))
- (seq
- (exit
- (cond
- ((null (|stringPrefix?| (makestring ")history") x))
- (setq tmp0 (cons x tmp0))))))))))
- (spadlet u (append u xtra))
- (cond
- ((null
- (prog (tmp2)
- (spadlet tmp2 nil)
- (return
- (do ((tmp3 nil tmp2) (tmp4 u (cdr tmp4)) (x nil))
- ((or tmp3 (atom tmp4) (progn (setq x (car tmp4)) nil)) tmp2)
- (seq
- (exit
- (setq tmp2
- (or tmp2 (|stringPrefix?| (makestring ")undo") x))))))))) u)
- (t
- (spadlet savedIOindex |$IOindex|)
- (spadlet |$IOindex| 1)
- (do ((y u (cdr y)))
- ((atom y) nil)
- (seq
- (exit
- (cond
- ((boot-equal (elt (spadlet x (car y)) 0) (|char| '|)|))
- (cond
- ((|stringPrefix?| (makestring ")undo")
- (spadlet s (|trimString| x)))
- (spadlet s1 (|trimString| (substring s 5 nil)))
- (cond
- ((nequal s1 (makestring ")redo"))
- (spadlet m (|charPosition| (|char| '|)|) s1 0))
- (spadlet code
- (cond
- ((> (maxindex s1) m) (elt s1 (plus m 1)))
- (t (|char| '|a|))))
- (spadlet s2 (|trimString| (substring s1 0 m)))))
- (spadlet n
- (cond
- ((boot-equal s1 (makestring ")redo"))
- 0)
- ((nequal s2 (makestring ""))
- (|undoCount| (parse-integer s2)))
- (t (spaddifference 1))))
- (rplaca y
- (concat (makestring ">") code (stringimage n))))
- (t nil)))
- (t (spadlet |$IOindex| (plus |$IOindex| 1)))))))
- (spadlet acc nil)
- (do ((y (nreverse u) (cdr y)))
- ((atom y) nil)
- (seq
- (exit
- (cond
- ((boot-equal (elt (spadlet x (car y)) 0) (|char| '>))
- (spadlet code (elt x 1))
- (spadlet n (parse-integer (substring x 2 nil)))
- (spadlet y (cdr y))
- (do ()
- ((null y) nil)
- (seq
- (exit
- (progn
- (spadlet c (car y))
- (cond
- ((or (boot-equal (elt c 0) (|char| '|)|))
- (boot-equal (elt c 0) (|char| '>)))
- (spadlet y (cdr y)))
- ((eql n 0)
- (return nil))
- (t
- (spadlet n (spaddifference n 1))
- (spadlet y (cdr y))))))))
- (cond
- ((and y (nequal code (|char| '|b|)))
- (spadlet acc (cons c acc)))))
- (t (spadlet acc (cons x acc)))))))
- (spadlet |$IOindex| savedIOindex)
- acc)))))))
-
-@
-
-\chapter{The Spad Server Mechanism}
-<<initvars>>=
-(defvar $openServerIfTrue t "t means try starting an open server")
-(defconstant $SpadServerName "/tmp/.d" "the name of the spad server socket")
-(defvar |$SpadServer| nil "t means Scratchpad acts as a remote server")
-
-@
-
-\chapter{The Help Browser Mechanism}
-The Axiom book on the help browser is a complete rewrite of the
-hyperdoc mechanism. There are several components that were needed
-to make this function. Most of the web browser components are
-described in bookvol11.pamphlet. This portion describes some of
-the design issues needed to support the interface.
-
-The axServer command takes a port (defaulting to 8085) and a
-program to handle the browser interaction (defaulting to multiServ).
-The axServer function opens the port, constructs the stream, and
-passes the stream to multiServ. The multiServ loop processes one
-interaction at a time.
-
-So the basic process is that the Axiom ``)browse'' command opens a
-socket and listens for http requests. Based on the type of request
-(either 'GET' or 'POST') and the content of the request, which is
-one of:
-\begin{itemize}
-\item command - algebra request/response
-\item lispcall - a lisp s-expression to be evaluated
-\item showcall - an Axiom )show command
-\end{itemize}
-the multiServ function will call a handler function to evaluate
-the command line and construct a response. GET requests result
-in a new browser page. POST requests result in an inline result.
-
-Most responses contain the fields:
-\begin{itemize}
-\item stepnum - this is the Axiom step number
-\item command - this is the original command from the browser
-\item algebra - this is the Axiom 2D algebra output
-\item mathml - this is the MathML version of the Axiom algebra
-\item type - this is the type of the Axiom result
-\end{itemize}
-
-\section{Browsers, MathML, and Fonts}
-This work has the Firefox browser as its target. Firefox has built-in
-support for MathML, javascript, and XMLHttpRequest handling. More details
-are available in bookvol11.pamphlet but the very basic machinery for
-communication with the browser involves a dance between the browser
-and the multiServ function (see the axserver.spad.pamphlet).
-
-In particular, a simple request is embedded in a web page as:
-\begin{verbatim}
-<ul>
- <li>
- <input type="submit" id="p3" class="subbut"
- onclick="makeRequest('p3');"
- value="sin(x)" />
- <div id="ansp3"><div></div></div>
- </li>
-</ul>
-\end{verbatim}
-which says that this is an html ``input'' field of type ``submit''.
-The CSS display class is ``subbut'' which is of a different color
-than the surrounding text to make it obvious that you can click on
-this field. Clickable fields that have no response text are of class
-``noresult''.
-
-The javascript call to ``makeRequest'' gives the ``id'' of this input
-field, which must be unique in the page, as an argument. In this case,
-the argument is 'p3'. The ``value'' field holds the display text which
-will be passed back to Axiom as a command.
-
-When the result arrives the ``showanswer'' function will select out
-the mathml field of the response, construct the ``id'' of the html
-div to hold the response by concatenating the string ``ans'' (answer)
-to the ``id'' of the request resulting, in this case, as ``ansp3''.
-The ``showanswer'' function will find this div and replace it with a
-div containing the mathml result.
-
-The ``makeRequest'' function is:
-\begin{verbatim}
- function makeRequest(arg) {
- http_request = new XMLHttpRequest();
- var command = commandline(arg);
- //alert(command);
- http_request.open('POST', '127.0.0.1:8085', true);
- http_request.onreadystatechange = handleResponse;
- http_request.setRequestHeader('Content-Type', 'text/plain');
- http_request.send("command="+command);
- return(false);
-\end{verbatim}
-It contains a request to open a local server connection to Axiom,
-sets ``handleResponse'' as the function to call on reply, sets up
-the type of request, fills in the command field, and sends off the
-http request.
-
-When a response is received, the ``handleResponse'' function checks
-for the correct reply state, strips out the important text, and
-calls ``showanswer''.
-\begin{verbatim}
- function handleResponse() {
- if (http_request.readyState == 4) {
- if (http_request.status == 200) {
- showanswer(http_request.responseText,'mathAns');
- } else
- {
- alert('There was a problem with the request.'+ http_request.statusText);
- }
- }
- }
-\end{verbatim}
-See bookvol11.pamphlet for further details.
-
-\section{The axServer/multiServ loop}
-The basic call to start an Axiom browser listener is:
-\begin{verbatim}
- )set message autoload off
- )set output mathml on
- axServer(8085,multiServ)$AXSERV
-\end{verbatim}
-
-This call sets the port, opens a socket, attaches it to a stream,
-and then calls ``multiServ'' with that stream. The ``multiServ''
-function loops serving web responses to that port.
-
-\section{The )browse command}
-In order to make the whole process cleaner the function ``)browse''
-handles the details. This code creates the command-line function for )browse
-
-The browse function does the internal equivalent of the following 3 command
-line statments:
-\begin{verbatim}
- )set message autoload off
- )set output mathml on
- axServer(8085,multiServ)$AXSERV
-\end{verbatim}
-which causes Axiom to start serving web pages on port 8085
-
-For those unfamiliar with calling algebra from lisp there are a
-few points to mention.
-
-The loadLib needs to be called to load the algebra code into the image.
-Normally this is automatic but we are not using the interpreter so
-we need to do this ``by hand''.
-
-Each algebra file contains a "constructor function" which builds the
-domain, which is a vector, and then caches the vector so that every
-call to the contructor returns an EQ vector, that is, the same vector.
-In this case, we call the constructor $\vert$AxiomServer$\vert$
-
-The axServer function was mangled internally to
-$\vert$AXSERV;axServer;IMV;2$\vert$.
-The multiServ function was mangled to $\vert$AXSERV;multiServ;SeV;3$\vert$
-Note well that if you change axserver.spad these names might change
-which will generate the error message along the lines of:
-\begin{verbatim}
- System error:
- The function $\vert$AXSERV;axServer;IMV;2$\vert$ is undefined.
-\end{verbatim}
-
-To fix this you need to look at int/algebra/AXSERV.nrlib/code.lsp
-and find the new mangled function name. A better solution would
-be to dynamically look up the surface names in the domain vector.
-
-Each Axiom function expects the domain vector as the last argument.
-This is not obvious from the call as the interpreter supplies it.
-We must do that ``by hand''.
-
-We don't call the multiServ function. We pass it as a parameter to
-the axServer function. When it does get called by the SPADCALL
-macro it needs to be a lisp pair whose car is the function and
-whose cdr is the domain vector. We construct that pair here as
-the second argument to axServer. The third, hidden, argument to
-axServer is the domain vector which we supply ``by hand''.
-
-The socket can be supplied on the command line but defaults to 8085.
-Axiom supplies the arguments as a list.
-<<defun browse>>=
-(defun |browse| (socket)
- (let (axserv browser)
- (if socket
- (setq socket (car socket))
- (setq socket 8085))
- (|set| '(|mes| |auto| |off|))
- (|set| '(|out| |mathml| |on|))
- (|loadLib| '|AxiomServer|)
- (setq axserv (|AxiomServer|))
- (setq browser
- (|AXSERV;axServer;IMV;2| socket
- (cons #'|AXSERV;multiServ;SeV;3| axserv) axserv))))
-
-@
-Now we have to bolt it into Axiom. This involves two lookups.
-
-We create the lisp pair
-\begin{verbatim}
-(|browse| . |development|)
-\end{verbatim}
-and cons it into the \$systemCommands command table. This allows the
-command to be executed in development mode. This lookup decides if
-this command is allowed. It also has the side-effect of putting the
-command into the \$SYSCOMMANDS variable which is used to determine
-if the token is a command.
-
-\section{The server support code}
-
-\chapter{Axiom Build-time Functions}
-\subsection{defun spad-save}
-The {\bf spad-save} function is just a cover function for more
-lisp system specific save functions. There is no standard name
-for saving a lisp image so we make one and conditionalize it
-at compile time.
-
-This function is passed the name of an image that will be saved.
-The saved image contains all of the loaded functions.
-
-This is used in the [[src/interp/Makefile.pamphlet]] in three places:
-\begin{list}{}
-\item creating depsys, an image for compiling axiom.
-
-Some of the Common Lisp code we compile uses macros which
-are assumed to be available at compile time. The {\bf DEPSYS}
-image is created to contain the compile time environment
-and saved. We pipe compile commands into this environment
-to compile from Common Lisp to machine dependent code.
-\begin{verbatim}
-DEPSYS= ${OBJ}/${SYS}/bin/depsys
-\end{verbatim}
-
-\item creating savesys, an image for running axiom.
-
-Once we've compile all of the Common Lisp files we fire up
-a clean lisp image called {\bf LOADSYS}, load all of the
-final executable code and save it out as {\bf SAVESYS}.
-The {\bf SAVESYS} image is copied to the [[${MNT}/${SYS}/bin]]
-subdirectory and becomes the axiom executable image.
-\begin{verbatim}
-LOADSYS= ${OBJ}/${SYS}/bin/lisp
-SAVESYS= ${OBJ}/${SYS}/bin/interpsys
-AXIOMSYS= ${MNT}/${SYS}/bin/AXIOMsys
-\end{verbatim}
-
-
-\item creating debugsys, an image with all interpreted functions loaded.
-
-Occasionally we need to really get into the system internals.
-The best way to do this is to run almost all of the lisp code
-interpreted rather than compiled (note that cfuns.lisp and sockio.lisp
-still need to be loaded in compiled form as they depend on the
-loader to link with lisp internals). This image is nothing more
-than a load of the file src/interp/debugsys.lisp.pamphlet. If
-you need to make test modifications you can add code to that
-file and it will show up here.
-\begin{verbatim}
-DEBUGSYS=${OBJ}/${SYS}/bin/debugsys
-\end{verbatim}
-\end{list}
-<<defun spad-save>>=
-(defun user::spad-save (save-file)
- (setq |$SpadServer| nil)
- (setq $openServerIfTrue t)
-#+:AKCL
- (system::save-system save-file)
-#+:allegro
- (if (fboundp 'boot::restart)
- (excl::dumplisp :name save-file :restart-function #'boot::restart)
- (excl::dumplisp :name save-file))
-#+Lucid
- (if (fboundp 'boot::restart)
- (sys::disksave save-file :restart-function #'boot::restart)
- (sys::disksave save-file))
-#+:CCL
- (preserve)
-)
-
-@
-
-\chapter{The Interpreter}
-<<Interpreter>>=
-(in-package "BOOT")
-<<initvars>>
-
-<<defun addNewInterpreterFrame>>
-
-<<defun browse>>
-
-<<defun changeHistListLen>>
-<<defun changeToNamedInterpreterFrame>>
-<<defun charDigitVal>>
-<<defun clearFrame>>
-<<defun closeInterpreterFrame>>
-<<defun createCurrentInterpreterFrame>>
-
-<<defun dewritify>>
-<<defun dewritify,dewritifyInner>>
-<<defun dewritify,is?>>
-<<defun diffAlist>>
-<<defun disableHist>>
-<<defun display>>
-<<defun displayFrameNames>>
-<<defun displayMacros>>
-<<defun displayOperations>>
-<<defun displaySpad2Cmd>>
-
-<<defun emptyInterpreterFrame>>
-
-<<defun fetchOutput>>
-<<defun findFrameInRing>>
-<<defun frame>>
-<<defun frameEnvironment>>
-<<defun frameName>>
-<<defun frameNames>>
-<<defun frameSpad2Cmd>>
-
-<<defun getenviron>>
-<<defun gensymInt>>
-
-<<defun histFileErase>>
-<<defun history>>
-<<defun histFileName>>
-<<defun histInputFileName>>
-<<defun historySpad2Cmd>>
-
-<<defun incBiteOff>>
-<<defun incFileName>>
-<<defun importFromFrame>>
-<<defun init-memory-config>>
-<<defun initHist>>
-<<defun initHistList>>
-<<defun initializeInterpreterFrameRing>>
-<<defun initroot>>
-<<defun intloop>>
-<<defun intloopPrefix?>>
-<<defun intloopReadConsole>>
-
-<<defun loadExposureGroupData>>
-
-<<defun make-absolute-filename>>
-<<defun makeHistFileName>>
-<<defun makeInitialModemapFrame>>
-
-<<defun ncIntLoop>>
-<<defun ncloopCommand>>
-<<defun ncloopEscaped>>
-<<defun ncloopInclude>>
-<<defun ncloopInclude1>>
-<<defun ncloopIncFileName>>
-<<defun ncloopPrefix?>>
-<<defun ncTopLevel>>
-<<defun nextInterpreterFrame>>
-
-<<defun oldHistFileName>>
-
-<<defun previousInterpreterFrame>>
-<<defun putHist>>
-
-<<defun readHiFi>>
-<<defun reclaim>>
-<<defun recordNewValue>>
-<<defun recordNewValue0>>
-<<defun recordOldValue>>
-<<defun recordOldValue0>>
-<<defun recordFrame>>
-<<defun removeUndoLines>>
-<<defun reportUndo>>
-<<defun reroot>>
-<<defun resetInCoreHist>>
-<<defun restart>>
-<<defun restoreHistory>>
-<<defun runspad>>
-
-<<defun safeWritify>>
-<<defun saveHistory>>
-<<defun ScanOrPairVec>>
-<<defun setCurrentLine>>
-<<defun setHistoryCore>>
-<<defun set-restart-hook>>
-<<defun showInOut>>
-<<defun showInput>>
-<<defun setIOindex>>
-<<defun showHistory>>
-<<defun spad>>
-<<defun spad-save>>
-<<defun spadClosure?>>
-<<defun SpadInterpretStream>>
-<<defun SPADRREAD>>
-<<defun SPADRWRITE>>
-<<defun SPADRWRITE0>>
-<<defun statisticsInitialization>>
-
-<<defun undo>>
-<<defun undoChanges>>
-<<defun undoCount>>
-<<defun undoFromFile>>
-<<defun undoInCore>>
-<<defun undoLocalModemapHack>>
-<<defun undoSingleStep>>
-<<defun undoSteps>>
-<<defun unwritable?>>
-<<defun updateCurrentInterpreterFrame>>
-<<defun updateFromCurrentInterpreterFrame>>
-<<defun updateHist>>
-<<defun updateInCoreHist>>
-
-<<defun writify>>
-<<defun writify,writifyInner>>
-<<defun writifyComplain>>
-<<defun writeHiFi>>
-<<defun writeHistModesAndValues>>
-<<defun writeInputLines>>
-
-<<defun yesanswer>>
-
-@
-\chapter{Makefile.bookvol5}
-<<*>>=
-LATEX=/usr/bin/latex
-LISP=${AXIOM}/obj/linux/bin/lisp
-TANGLE=/usr/local/bin/NOTANGLE
-WEAVE=/usr/local/bin/NOWEAVE -delay
-
-all: bookvol5
- @echo 0 done
-
-bookvol5: bookvol5.pamphlet
- @echo 1 extracting the bookvol5reter
- ${WEAVE} bookvol5.pamphlet >bookvol5.tex
- ${LATEX} bookvol5.tex
- ${LATEX} bookvol5.tex
- ${TANGLE} -R"Interpreter" bookvol5.pamphlet >bookvol5.lisp
-
-remake:
- @echo 2 rebuilding the makefile
- @${TANGLE} bookvol5.pamphlet >Makefile.bookvol5
-
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/bootlex.lisp.pamphlet b/src/interp/bootlex.lisp.pamphlet
index 37ddf16..c281226 100644
--- a/src/interp/bootlex.lisp.pamphlet
+++ b/src/interp/bootlex.lisp.pamphlet
@@ -173,18 +173,14 @@
(*spad-input-file* nil)
(*spad-output-file* nil)
&aux
- ;; (Echo-Meta *spad-input-file*)
- ;; (*comp370-apply* (function print-and-eval-defun))
(*comp370-apply* (function print-defun))
(*fileactq-apply* (function print-defun))
- ;; (|$InteractiveMode| nil)
($SPAD T)
($BOOT nil)
(XCape #\_)
(OPTIONLIST nil)
(*EOF* NIL)
(File-Closed NIL)
- ;; ($current-directory "/spad/libraries/")
(/editfile *spad-input-file*)
(|$noSubsumption| |$noSubsumption|)
in-stream out-stream)
diff --git a/src/interp/database.boot.pamphlet
b/src/interp/database.boot.pamphlet
index 383cf07..3c11489 100644
--- a/src/interp/database.boot.pamphlet
+++ b/src/interp/database.boot.pamphlet
@@ -582,46 +582,6 @@ dropPrefix(fn) ==
MEMBER(fn.0,[char "?",char "-",char "+"]) => SUBSTRING(fn,1,nil)
fn
---moved to util.lisp
---++loadExposureGroupData() ==
---++ egFile := ['interp,'exposed]
---++-- null MAKE_-INPUT_-FILENAME(egFile) =>
---++-- throwKeyedMsg("S2IL0003",[namestring egFile])
---++ stream:= DEFIOSTREAM(['(MODE . INPUT),['FILE,:egFile]],80,0)
---++ $globalExposureGroupAlist := NIL
---++ egName := NIL
---++ egFiles := NIL
---++ while (not PLACEP (x:= READ_-LINE stream)) repeat
---++ x := DROPTRAILINGBLANKS x
---++ SIZE(x) = 0 => 'iterate -- blank line
---++ (x.0 = char "#") or (x.0 = char "*") => 'iterate -- comment
---++ x.0 = char " " =>
---++ -- possible exposure group member name and library name
---++ null egName =>
---++ throwKeyedMsg("S2IZ0069A",[namestring egFile,x])
---++ x := dropLeadingBlanks x
---++ -- should be two tokens on the line
---++ p := STRPOS('" ",x,1,NIL)
---++ NULL p =>
---++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x])
---++ n := object2Identifier SUBSTRING(x,0,p)
---++ x := dropLeadingBlanks SUBSTRING(x,p+1,NIL)
---++ SIZE(x) = 0 =>
---++ throwKeyedMsg("S2IZ0069B",[namestring egFile,x])
---++ egFiles := [[n,:object2Identifier x],:egFiles]
---++ -- have a new group name
---++ if egName then $globalExposureGroupAlist :=
---++ [[egName,:nreverse egFiles],:$globalExposureGroupAlist]
---++ egFiles := NIL
---++ STRPOS('" ",x,1,NIL) =>
---++ throwKeyedMsg("S2IZ0069C",[namestring egFile,x])
---++ egName := object2Identifier x
---++ if egFiles then $globalExposureGroupAlist :=
---++ [[egName,:nreverse egFiles],:$globalExposureGroupAlist]
---++ SHUT stream
---++ $globalExposureGroupAlist := nreverse $globalExposureGroupAlist
---++ 'done
-
isExposedConstructor name ==
-- this function checks the local exposure data in the frame to
-- see if the given constructor is exposed. The format of
diff --git a/src/interp/interp-proclaims.lisp b/src/interp/interp-proclaims.lisp
index 85867b2..3c9d854 100644
--- a/src/interp/interp-proclaims.lisp
+++ b/src/interp/interp-proclaims.lisp
@@ -56,7 +56,7 @@
BOOT::|compExpression| BOOT::|e02gafDefaultSolve|
BOOT::|e02aefDefaultSolve| BOOT::|e02bbfDefaultSolve|
BOOT::|asytranForm| BOOT::|asytranFormSpecial|
- BOOT::|asytranApplySpecial| BOOT::SOCK-GET-STRING
+ BOOT::|asytranApplySpecial|
BOOT::|sockGetString| BOOT::|showIt| BOOT::|pmPreparse,fn|
BOOT::|pmPreparse,gn| BOOT::|dbSearchAbbrev|
BOOT::|mkUpDownPattern,recurse| BOOT::|htMkPath|
@@ -687,7 +687,7 @@
BOOT::|e02dff| BOOT::|e02def| BOOT::|e02ddf| BOOT::|e02dcf|
BOOT::|e02daf| BOOT::|e02bef| BOOT::|e02bdf|
BOOT::|minusInfinity| BOOT::|plusInfinity|
- BOOT::SERVER-SWITCH BOOT::CLEARDATABASE BOOT::NBOOT-LEXPR
+ BOOT::CLEARDATABASE BOOT::NBOOT-LEXPR
BOOT::BOOT-LEXPR BOOT::|executeQuietCommand|
BOOT::|serverSwitch| BOOT::|scanS|
BOOT::|sendNagmanErrorSignal| BOOT::|d01gbf| BOOT::|d01gaf|
@@ -1060,12 +1060,11 @@
BOOT::|e02dafGen| BOOT::|e02bdfSolve| BOOT::|e02dffGen|
BOOT::|e02akfSolve| BOOT::|asyJoinPart| BOOT::|printLine|
BOOT::|sockSendWakeup| BOOT::|sockGetFloat|
- BOOT::PRINT-LINE BOOT::SOCK-SEND-WAKEUP
- BOOT::SOCK-GET-FLOAT BOOT::|/tb| BOOT::|/ry| BOOT::|/rx|
+ BOOT::|/tb| BOOT::|/ry| BOOT::|/rx|
BOOT::|/cxd| BOOT::/FOOBAR BOOT::/CX BOOT::NEWNAMTRANS
BOOT::|htMakeInputList| BOOT::SPAD-MODETRAN
- BOOT::|popSatOutput| BOOT::|subrname| BOOT::SOCK-GET-INT
- BOOT::OPEN-SERVER BOOT::|protectedEVAL|
+ BOOT::|popSatOutput| BOOT::|subrname|
+ BOOT::|protectedEVAL|
BOOT::|setOutputTex| BOOT::|setOutputFortran| BOOT::|set|
BOOT::|setLinkerArgs| BOOT::|protectSymbols|
BOOT::|protectedSymbolsWarning| BOOT::|setStreamsCalculate|
@@ -1122,7 +1121,7 @@
BOOT::|sayDisplayWidth| BOOT::INIT-LIB-FILE-GETTER
BOOT::INIT-FILE-GETTER BOOT::|entryWidth| BOOT::FILE-RUNNER
BOOT::|editFile| BOOT::|readForDoc| BOOT::|checkNumOfArgs|
- BOOT::|openServer| BOOT::|removeBackslashes|
+ BOOT::OPENSERVER BOOT::|removeBackslashes|
BOOT::|checkAddBackSlashes| BOOT::/RF-1 BOOT::|docreport|
BOOT::|ExecuteInterpSystemCommand| BOOT::|pfFileName|
BOOT::|InterpExecuteSpadSystemCommand| BOOT::|alistSize|
@@ -2611,8 +2610,7 @@
BOOT::|e01dafDefaultSolve| BOOT::|replaceNamedHTPage|
BOOT::|e02bafDefaultSolve| BOOT::|e02bdfDefaultSolve|
BOOT::|e02defDefaultSolve| BOOT::|sockSendFloat|
- BOOT::SOCK-SEND-SIGNAL BOOT::SOCK-SEND-FLOAT
- BOOT::SOCK-SEND-STRING BOOT::SOCK-SEND-INT BOOT::ERASE
+ BOOT::ERASE
BOOT::|sayErrorly| BOOT::|saturnSayErrorly| BOOT::|set1|
BOOT::|displaySetOptionInformation| BOOT::|mkGrepPattern|
BOOT::|showDoc| BOOT::|genSearchSayJump| BOOT::|oPageFrom|
diff --git a/src/interp/sockio.lisp.pamphlet b/src/interp/sockio.lisp.pamphlet
index c58f2cf..f03492e 100644
--- a/src/interp/sockio.lisp.pamphlet
+++ b/src/interp/sockio.lisp.pamphlet
@@ -113,57 +113,11 @@ resolve the problem
(defentry NANQ () (double "NANQ"))
)
-(defun open-server (name)
-#+(and :lucid :ibm/370) -2
-#-(and :lucid :ibm/370)
- (open_server name))
-(defun sock-get-int (type)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_get_int type))
-(defun sock-send-int (type val)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_int type val))
-(defun sock-get-string (type buf buf-len)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_get_string_buf type buf buf-len))
-(defun sock-send-string (type str)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_string_len type str (length str)))
-(defun sock-get-float (type)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_get_float type))
-(defun sock-send-float (type val)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_float type val))
-(defun sock-send-wakeup (type)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_wakeup type))
-(defun server-switch ()
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (server_switch))
-(defun sock-send-signal (type signal)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_signal type signal))
-(defun print-line (str)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (print_line str))
(defun |plusInfinity| () (plus_infinity))
(defun |minusInfinity| () (minus_infinity))
;; Macros for use in Boot
-(defun |openServer| (name)
- (open_server name))
(defun |sockGetInt| (type)
(sock_get_int type))
(defun |sockSendInt| (type val)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Axiom-developer] 20090212.01.tpd.patch (remove unused code),
daly <=