Initial population.

1 files changed, 1683 insertions, 0 deletions

diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet
new file mode 100644
index 00000000..ec9f4ad1
--- /dev/null
+++ b/src/interp/util.lisp.pamphlet
@@ -0,0 +1,1683 @@
+% Oh Emacs, this is a -*- Lisp -*- file, despite appearance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\$SPAD/src/interp util.lisp}
+\author{Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+
+\section{util.lisp}
+
+This file is a collection of utility functions that are useful
+for system level work. A couple of the functions, {\bf build-depsys}
+and {\bf build-interpsys} interface to the src/interp/Makefile.
+
+A second group of related functions allows us to rebuild portions
+of the system from the command prompt. This varies from rebuilding
+individual files to whole directories. The most complex functions
+like {\bf makespad} can rebuild the whole algebra tree.
+
+A third group of related functions are used to set up the 
+{\bf autoload} mechanism. These enable whole subsystems to
+be kept out of memory until they are used.
+
+A fourth group of related functions are used to construct and
+search Emacs TAGS files.
+
+A fifth group of related functions are some translated boot
+functions we need to define here so they work and are available
+at load time.
+
+\subsection{Building Depsys (build-depsys)}
+
+The {\bf depsys} image is one of the two images we build from
+the src/interp subdirectory (the other is {\bf interpsys}). We
+use {\bf depsys} as a compile-time image as it contains all of
+the necessary functions and macros to compile any file. The 
+{\bf depsys} image is almost the same as an {\bf interpsys}
+image but it does not have any autoload triggers or databases
+loaded.
+<<build-depsys>>=
+(defun build-depsys (load-files spad)
+#+:CCL
+  (setq *package* (find-package "BOOT"))
+#+:AKCL
+  (in-package "BOOT")
+  (mapcar #'load load-files)
+  (initroot spad)
+  #+:AKCL
+  (init-memory-config :cons 1000 :fixnum 400 :symbol 1000 :package 16
+		      :array 800 :string 1000 :cfun 200 :cpages 2000
+		      :rpages 2000 :hole 4000) )
+;;  (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8
+;;		      :array 400 :string 500 :cfun 100 :cpages 1000
+;;		      :rpages 1000 :hole 2000) )
+
+@
+
+\subsection{Building Interpsys (build-interpsys)}
+\begin{verbatim}
+;############################################################################
+;# autoload dependencies
+;#
+;# if you are adding a file which is to be autoloaded the following step
+;# information is useful:
+;#  there are 2 cases:
+;#   1) adding files to currently autoloaded parts
+;#	(as of 2/92: browser old parser and old compiler)
+;#   2) adding new files
+;#   case 1:
+;#     a) you have to add the file to the list of files currently there
+;#	  (e.g. see BROBJS above)
+;#     b) add an autolaod rule
+;#	  (e.g. ${AUTO}/parsing.${O}: ${OUT}/parsing.${O})
+;#     c) edit util.lisp to add the 'external' function (those that
+;#	  should trigger the autoload
+;#   case 2:
+;#     build-interpsys (in util.lisp) needs an extra argument for the
+;#     new autoload things and several functions in util.lisp need hacking.
+;############################################################################
+\end{verbatim}
+The {\bf build-interpsys} function takes a list of files to load
+into the image ({\bf load-files}). It also takes several lists of files, 
+one for each subsystem which will be autoloaded. Autoloading is explained
+below. Next it takes a set of shell variables, the most important of 
+which is the {\bf spad} variable. This is normally set to be the same
+as the final build location. This function is called in the 
+src/interp/Makefile. 
+
+This function calls {\bf initroot} to set up pathnames we need. Next
+it sets up the lisp system memory (at present only for AKCL/GCL). Next
+it loads all of the named files, resets a few global state variables,
+loads the databases, sets up autoload triggers and clears out hash tables.
+After this function is called the image is clean and can be saved.
+<<build-interpsys>>=
+(defun build-interpsys (load-files parse-files comp-files browse-files
+	     translate-files nagbr-files asauto-files spad)
+  (initroot spad)
+  #+:AKCL
+  (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8
+		      :array 400 :string 500 :cfun 100 :cpages 1000
+		      :rpages 1000 :hole 2000)
+  <<compiler-notes>>
+  (mapcar #'|AxiomCore|::|importModule| load-files)
+  (|resetWorkspaceVariables|)
+  (|initHist|)
+  (|initNewWorld|)
+  (compressopen)
+  (interpopen)
+  (create-initializers)
+  (|start| :fin)
+#+:CCL
+  (resethashtables)
+  (setq *load-verbose* nil)
+  (|setBootAutloadProperties| comp-functions comp-files)
+  (|setBootAutloadProperties| parse-functions parse-files)
+  (|setBootAutloadProperties| browse-functions browse-files)
+  (|setBootAutloadProperties| translate-functions translate-files)
+  (|setNAGBootAutloadProperties| nagbr-functions nagbr-files)
+  (|setBootAutloadProperties| asauto-functions asauto-files)
+  (setf (symbol-function 'boot::|addConsDB|) #'identity)
+  (resethashtables) ; the databases into core, then close the streams
+ )
+
+@
+
+\subsubsection{GCL porting changes}
+
+GCL likes to output lines of the form:
+\begin{verbatim}
+;; Note: Tail-recursive call of |matSuperList1| was replaced by iteration.
+\end{verbatim}
+which is pointless and should be removed. Bill Schelter added this while
+he was debugging tail-recursive replacement and it never was removed.
+<<compiler-notes>>=
+  #+:AKCL
+  (setq compiler::*suppress-compiler-notes* t)
+@
+
+
+\subsection{The variables}
+
+Various lisps use different ``extensions'' on the filename to indicate
+that a file has been compiled. We set this variable correctly depending
+on the system we are using.
+<<bin-path>>=
+(defvar *bin-path*
+  #+kcl "o"
+  #+lucid "bbin"
+  #+symbolics "bin"
+  #+cmulisp "fasl"
+  #+:ccl "not done this way at all")
+
+@
+
+\subsubsection{directory-list}
+
+This is the system-wide list of directories to search.
+It is set up in the {\bf reroot} function.
+<<directory-list>>=
+(defvar $directory-list ())
+
+@
+
+
+\subsubsection{relative-directory-list}
+
+The relative directory list specifies a search path for files 
+for the current directory structure. It has been changed from the
+NAG distribution back to the original form. 
+<<relative-directory-list>>=
+(defvar $relative-directory-list
+  '("/../../src/input/"
+    "/share/msgs/"
+    "/../../src/algebra/"
+    "/../../src/interp/"  ; for boot and lisp  files (helps fd)
+    "/doc/spadhelp/" ))
+
+@
+
+
+\subsubsection{library-directory-list}
+
+This is the system-wide search path for library files.
+It is set up in the {\bf reroot} function.
+<<library-directory-list>>=
+(defvar $library-directory-list ())
+
+@
+
+\subsubsection{relative-library-directory-list}
+
+The relative directory list specifies how to find the algebra
+directory from the current {\bf AXIOM} shell variable.
+<<relative-library-directory-list>>=
+(defvar $relative-library-directory-list '("/algebra/"))
+
+@
+
+
+\subsection{The autoload list}
+
+There are several subsystems within {\bf AXIOM} that are not normally
+loaded into a running system. They will be loaded only if you invoke
+one of the functions listed here. Each of these listed functions will
+have their definitions replaced by a special ``autoloader'' function.
+The first time a function named here is called it will trigger a
+load of the associated subsystem, the autoloader functions will get
+overwritten, the function call is retried and now succeeds. Files
+containing functions listed here are assumed to exist in the 
+{\bf autoload} subdirectory. The list of files to load is defined
+in the src/interp/Makefile.
+
+\subsubsection{setBootAutloadProperties}
+
+This function is called by {\bf build-interpsys}. It takes two lists.
+The first is a list of functions that need to be used as 
+``autoload triggers''. The second is a list of files to load if one
+of the trigger functions is called. At system build time each of the
+functions in the first list is set up to load every file in the second
+list. In this way we will automatically load a whole subsystem if we
+touch any function in that subsystem. We call a helper function
+called {\bf setBootAutoLoadProperty} to set up the autoload trigger.
+This helper function is listed below.
+<<setBootAutloadProperties>>=
+(defun |setBootAutloadProperties| (fun-list file-list)
+#+:AKCL
+  (mapc #'(lambda (fun) (|setBootAutoLoadProperty| fun file-list)) fun-list)
+#+:CCL
+  (mapc #'(lambda (fun) (lisp::set-autoload fun file-list)) fun-list)
+)
+
+@
+
+\subsubsection{setBootAutoLoadProperty}
+
+This is a helper function to set up the autoload trigger. It sets
+the function cell of each symbol to {\bf mkBootAutoLoad} which is
+listed below. 
+<<setBootAutoLoadProperty>>=
+(defun |setBootAutoLoadProperty| (func file-list)
+  (setf (symbol-function func) (|mkBootAutoLoad| func file-list)) )
+
+@
+
+\subsubsection{mkBootAutoLoad}
+
+This is how the autoload magic happens. Every function named in the
+autoload lists is actually just another name for this function. When
+the named function is called we call {\bf boot-load} on all of the
+files in the subsystem. This overwrites all of the autoload triggers.
+We then look up the new (real) function definition and call it again
+with the real arguments. Thus the subsystem loads and the original
+call succeeds.
+<<mkBootAutoLoad>>=
+(defun |mkBootAutoLoad| (fn file-list)
+   (function (lambda (&rest args)
+		 (mapc #'boot-load file-list)
+		 (unless (string= (subseq (string fn) 0 4) "LOAD")
+		  (apply (symbol-function fn) args)))))
+
+@
+
+\subsubsection{boot-load}
+
+This function knows where the {\bf autoload} subdirectory lives.
+It is called by {\bf mkBootAutoLoad} above to find the necessary
+files.
+<<boot-load>>=
+(defun boot-load (file)
+  (let ((name (concat $SPADROOT "/autoload/" (pathname-name file))))
+    (if |$printLoadMsgs|
+	(format t "   Loading ~A.~%" name))
+    (load name)))
+
+@
+
+\subsubsection{setNAGBootAutloadProperties}
+
+This is a further refinement of the autoload scheme. Since the
+Numerical Algorithms Group (NAG) fortran library contains many
+functions we subdivide the NAG library subsystem into chapters.
+We use a different helper function {\bf get-NAG-chapter} to decide
+which files to load.
+<<setNAGBootAutloadProperties>>=
+(defun |setNAGBootAutloadProperties| (function-list file-list)
+  (mapcar
+    #'(lambda (f)
+        (|setBootAutloadProperties|
+          (get-NAG-chapter (chapter-name f) function-list)
+          (nag-files f file-list)))
+    file-list))
+
+@
+
+\subsubsection{get-NAG-chapter}
+
+This function is used to find the names of the files to load.
+On solaris 9 under GCL the original implementation will fail because
+the max number of arguments is 63. We rewrite it to get around this
+problem. It originally read:
+\begin{verbatim}
+(defun get-NAG-chapter (chapter function-list)
+ (apply 'append
+  (mapcar
+   #'(lambda (f)
+     (cond 
+      ((equalp chapter (subseq (string f) 0 (length chapter))) (list f ))))
+   function-list)))
+
+\end{verbatim}
+<<get-NAG-chapter>>=
+(defun get-NAG-chapter (chapter function-list)
+ (let ((l (length chapter)) r)
+  (dolist (f function-list)
+   (when (equalp chapter (subseq (string f) 0 l))
+    (push f r)))
+  (nreverse r)))
+
+@
+
+\subsubsection{nag-files}
+
+We analyze the function names to decide which chapter we are in.
+We load files based on the chapter.
+<<nag-files>>=
+(defun nag-files (filename filelist)
+  (apply 'append (mapcar
+     #'(lambda (f)
+         (cond ((equalp (chapter-name filename) (chapter-name f)) (list f))) )
+     filelist)))
+
+@
+
+\subsubsection{chapter-name}
+
+The library names follow a convention that allows us to extract
+the chapter name. 
+<<chapter-name>>=
+(defun chapter-name (f)
+#+:AKCL
+  (apply
+    #'(lambda (s)
+        (cond ((equalp (aref s 0) #\s) "s") (T (reverse (subseq s 0 3)))))
+    (list (string-left-trim "a.o" (reverse f) )) )
+#+:CCL
+  (subseq (string-downcase (string f)) 4 (length (string f)))
+)
+
+@
+
+\subsubsection{parse-functions}
+
+This is the {\bf boot parser} subsystem. It is only needed by 
+developers who translate boot code to Common Lisp.
+<<parse-functions>>=
+(setq parse-functions
+      '(
+;;      loadparser
+	|oldParserAutoloadOnceTrigger|
+	|PARSE-Expression|
+	boot-parse-1
+	BOOT
+	SPAD
+	init-boot/spad-reader))
+
+@
+
+\subsubsection{comp-functions}
+
+This is the {\bf spad compiler} subsystem. It is only needed by
+developers who write or modify algebra code.
+<<comp-functions>>=
+(setq comp-functions
+      '(
+;;      loadcompiler
+	|oldCompilerAutoloadOnceTrigger|
+	|compileSpad2Cmd|
+	|convertSpadToAsFile|
+	|compilerDoit|
+	|compilerDoitWithScreenedLisplib|
+	|mkCategory|
+	|cons5|
+	|sublisV|))
+
+@
+
+\subsubsection{browse-functions}
+
+This is the {\bf browser} subsystem. It will get autoloaded only
+if you use the browse function of the {\bf hypertex} system.
+<<browse-functions>>=
+(setq browse-functions
+      '(
+;;      loadbrowse
+	|browserAutoloadOnceTrigger|
+        |parentsOf|	      ;interop.boot
+	|getParentsFor|	      ;old compiler
+	|folks|		      ;for astran
+	|extendLocalLibdb|    ;)lib needs this
+        |oSearch|
+        |aokSearch|
+        |kSearch|
+        |aSearch|
+        |genSearch|
+        |docSearch|
+        |abSearch|
+        |detailedSearch|
+	|ancestorsOf|
+	|aPage|
+	|dbGetOrigin|
+	|dbGetParams|
+	|dbGetKindString|
+	|dbGetOrigin|
+	|dbComments|
+	|grepConstruct|
+	|buildLibdb|
+	|bcDefiniteIntegrate|
+	|bcDifferentiate|
+	|bcDraw|
+	|bcExpand|
+	|bcIndefiniteIntegrate|
+	|bcLimit|
+	|bcMatrix|
+	|bcProduct|
+	|bcSeries|
+	|bcSolve|
+	|bcSum|
+	|cSearch|
+	|conPage|
+	|dbName|
+	|dbPart|
+        |extendLocalLibdb|
+	|form2HtString|
+	|htGloss|
+	|htGreekSearch|
+	|htHistory|
+	|htSystemCommands|
+	|htSystemVariables|
+	|htTextSearch|
+	|htTutorialSearch|
+	|htUserVariables|
+	|htsv|
+	|oPage|
+	|oPageFrom|
+	|spadSys|
+	|spadType|
+	|syscomPage|
+	|unescapeStringsInForm|))
+
+@
+
+\subsubsection{translate-functions}
+
+This is a little used subsystem to generate {\bf ALDOR} code
+from {\bf Spad} code. Frankly, I'd be amazed if it worked.
+<<translate-functions>>=
+(setq translate-functions '(
+;; .spad to .as translator, in particular
+;;	loadtranslate
+	|spad2AsTranslatorAutoloadOnceTrigger|
+	))
+
+@
+
+\subsubsection{asauto-functions}
+
+This is part of the {\bf ALDOR subsystem}. These will be loaded
+if you compile a {\bf .as} file rather than a {\bf .spad} file.
+{\bf ALDOR} is an external compiler that gets automatically called
+if the file extension is {\bf .as}.
+<<asauto-functions>>=
+(setq asauto-functions '(
+	loadas
+;;	|as|			     ;; now in as.boot
+;;	|astran|		     ;; now in as.boot
+	|spad2AxTranslatorAutoloadOnceTrigger|
+	|sourceFilesToAxcliqueAxFile|
+	|sourceFilesToAxFile|
+	|setExtendedDomains|
+	|makeAxFile|
+        |makeAxcliqueAxFile|
+        |nrlibsToAxFile|
+        |attributesToAxFile| ))
+
+@
+
+\subsubsection{debug-functions}
+
+These are some {\bf debugging} functions that I use. I can't imagine
+why you might autoload them but they don't need to be in a running
+system.
+<<debug-functions>>=
+(setq debug-functions '(
+	loaddebug
+	|showSummary|
+	|showPredicates|
+	|showAttributes|
+	|showFrom|
+	|showImp|))
+
+@
+
+\subsubsection{anna-functions}
+
+The {\bf ANNA} subsystem, invoked thru {\bf hypertex}, is an
+expert system that understands the Numerical Algorithms Group (NAG)
+fortran library. 
+<<anna-functions>>=
+(setq anna-functions '(
+	|annaInt|
+	|annaMInt|
+	|annaOde|
+	|annaOpt|
+	|annaOpt2|
+	|annaPDESolve|
+	|annaOptDefaultSolve1|
+	|annaOptDefaultSolve2|
+	|annaOptDefaultSolve3|
+	|annaOptDefaultSolve4|
+	|annaOptDefaultSolve5|
+	|annaOpt2DefaultSolve|
+	|annaFoo|
+	|annaBar|
+	|annaJoe|
+	|annaSue|
+	|annaAnn|
+	|annaBab|
+	|annaFnar|
+	|annaDan|
+	|annaBlah|
+	|annaTub|
+	|annaRats|
+	|annaMInt|
+	|annaOdeDefaultSolve1|
+	|annaOdeDefaultSolve2|))
+
+@
+
+\subsubsection{nagbr-functions}
+
+The Numerical Algorithms Group (NAG) fortran library has a set
+of cover functions. These functions need to be loaded if you use
+the NAG library.
+<<nagbr-functions>>=
+(setq nagbr-functions '(
+       loadnag
+       |c02aff| |c02agf|
+       |c05adf| |c05nbf| |c05pbf|
+       |c06eaf| |c06ebf| |c06ecf| |c06ekf| |c06fpf| |c06fqf| |c06frf|
+		|c06fuf| |c06gbf| |c06gcf| |c06gqf| |c06gsf|
+       |d01ajf| |d01akf| |d01alf| |d01amf| |d01anf| |d01apf| |d01aqf|
+		|d01asf| |d01bbf| |d01fcf| |d01gaf| |d01gbf|
+       |d02bbf| |d02bhf| |d02cjf| |d02ejf| |d02gaf| |d02gbf| |d02kef|
+		|d02raf|
+       |d03edf| |d03eef| |d03faf|
+       |e01baf| |e01bef| |e01bff| |e01bgf| |e01bhf| |e01daf| |e01saf|
+		|e01sbf| |e01sef|
+       |e02adf| |e02aef| |e02agf| |e02ahf| |e02ajf| |e02akf| |e02baf|
+		|e02bbf| |e02bcf| |e02bdf| |e02bef| |e02daf| |e02dcf|
+		|e02ddf| |e02def| |e02dff| |e02gaf| |e02zaf|
+       |e04dgf| |e04fdf| |e04gcf| |e04jaf| |e04mbf| |e04naf| |e04ucf|
+		|e04ycf|
+       |f01brf| |f01bsf| |f01maf| |f01mcf| |f01qcf| |f01qdf| |f01qef|
+		|f01rcf| |f01rdf| |f01ref|
+       |f02aaf| |f02abf| |f02adf| |f02aef| |f02aff| |f02agf| |f02ajf|
+		|f02akf| |f02awf| |f02axf| |f02bbf| |f02bjf| |f02fjf|
+		|f02wef| |f02xef|
+       |f04adf| |f04arf| |f04asf| |f04atf| |f04axf| |f04faf| |f04jgf|
+		|f04maf| |f04mbf| |f04mcf| |f04qaf|
+       |f07adf| |f07aef| |f07fdf| |f07fef|
+       |s01eaf| |s13aaf| |s13acf| |s13adf| |s14aaf| |s14abf| |s14baf|
+		|s15adf| |s15aef| |s17acf| |s17adf| |s17aef| |s17aff|
+		|s17agf| |s17ahf| |s17ajf| |s17akf| |s17dcf| |s17def|
+		|s17dgf| |s17dhf| |s17dlf| |s18acf| |s18adf| |s18aef|
+		|s18aff| |s18dcf| |s18def| |s19aaf| |s19abf| |s19acf|
+		|s19adf| |s20acf| |s20adf| |s21baf| |s21bbf| |s21bcf|
+		|s21bdf|
+      ))
+
+@
+
+
+\subsection{The command-line build functions}
+
+\subsubsection{translist}
+
+Translate a list of boot files to common lisp.
+<<translist>>=
+(defun translist (fns)
+  (mapcar #'(lambda (f) (format t "translating ~a~%" (concat f ".boot"))
+			(translate f))
+	  fns))
+
+@
+
+\subsubsection{translate}
+
+Translate a single boot file to common lisp
+<<translate>>=
+(defun translate (file) ;; translates a single boot file
+#+:CCL
+  (setq *package* (find-package "BOOT"))
+#+:AKCL
+  (in-package "BOOT")
+  (let (*print-level* *print-length* (fn (pathname-name file))
+	(bootfile  (merge-pathnames file (concat $spadroot "nboot/.boot"))))
+    (declare (special *print-level* *print-length*))
+    (boot bootfile (make-pathname :type "lisp" :defaults bootfile))))
+
+@
+
+\subsubsection{compile-boot-file}
+
+Translate a single boot file to common lisp, compile it 
+and load it.
+<<compile-boot-file>>=
+(defun compile-boot-file (file)
+  "compile and load a boot file"
+  (boot (concat file ".boot") (concat file ".lisp"))
+#+:AKCL
+  (compile-file (concat file ".lisp"))
+#+:AKCL
+  (load (concat file "." *bin-path*))
+#+:CCL
+  (load (concat file ".lisp"))
+)
+
+@
+
+\subsubsection{retranslate-file-if-necessary}
+
+Retranslate a single boot file if it has been changed.
+<<retranslate-file-if-necessary>>=
+(defun retranslate-file-if-necessary (bootfile)
+   (let* ((lfile (make-pathname :type "lisp" :defaults bootfile))
+	  (ldate (our-write-date lfile))
+	  (binfile (make-pathname :type *bin-path*  :defaults bootfile))
+	  (bindate (our-write-date binfile))
+	  (bootdate (our-write-date   bootfile)))
+       (if (and ldate bootdate (> ldate bootdate)) nil
+	   (if (and bindate bootdate (> bindate bootdate)) nil
+	       (progn (format t "translating ~a~%" bootfile)
+		      (boot bootfile lfile) (list bootfile))))))
+
+@
+
+\subsubsection{retranslate-directory}
+
+Translate a directory of boot code to common lisp if the boot code
+is newer.
+<<retranslate-directory>>=
+(defun retranslate-directory (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "boot"))
+	  (files (directory pattern)))
+      (mapcan #'retranslate-file-if-necessary files)))
+
+@
+
+\subsubsection{recompile-NRLIB-if-necessary}
+
+Recompile a single library's lisp file if it is out of date.
+The {\bf recompile-lib-file-if-necessary} is defined in nlib.lisp.
+<<recompile-NRLIB-if-necessary>>=
+(defun recompile-NRLIB-if-necessary (lib)
+  (recompile-lib-file-if-necessary (concat (namestring lib) "/code.lsp"))
+  (lift-NRLIB-name (namestring lib)))
+
+@
+
+\subsubsection{lift-NRLIB-name}
+
+We used to use FOO.NRLIB/code.o files for algebra. However there
+was no need for this additional level of indirection since the rest
+of the information in an NRLIB is now kept in the daase files. Thus
+we lift the FOO.NRLIB/code.o to FOO.o in the final system.
+<<lift-NRLIB-name>>=
+(defun lift-NRLIB-name (f)
+  (obey (concat "cp " f "/code.o " (subseq f 0 (position #\. f)) ".o"))
+  nil)
+
+@
+
+\subsubsection{recompile-lib-directory}
+
+Recompile library lisp code if necessary.
+<<recompile-lib-directory>>=
+(defun recompile-lib-directory (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "NRLIB"))
+	  (files (directory pattern)))
+      (mapcan #'recompile-NRLIB-if-necessary files)))
+
+@
+
+\subsubsection{recompile-all-files}
+
+Force recompilation of all lisp files in a directory.
+<<recompile-all-files>>=
+(defun recompile-all-files (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "lisp"))
+	  (files (directory pattern)))
+     (mapcar #'compile-file files)))
+
+@
+
+\subsubsection{recompile-directory}
+
+This function will compile any lisp code that has changed in a directory.
+<<recompile-directory>>=
+(defun recompile-directory (dir)
+  (let* ((direc (make-directory dir))
+	 (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "lisp"))
+	  (files (directory pattern)))
+      (mapcan #'recompile-file-if-necessary files)))
+
+@
+
+\subsubsection{recompile-file-if-necessary}
+
+This is a helper function that checks the time stamp between
+the given file and its compiled binary. If the file has changed
+since it was last compiled this function will recompile it.
+<<recompile-file-if-necessary>>=
+(defun recompile-file-if-necessary (lfile)
+   (let* ((bfile (make-pathname :type *bin-path* :defaults lfile))
+	  (bdate (our-write-date bfile))
+	  (ldate (our-write-date lfile)))
+       (if (and bdate ldate (> bdate ldate)) nil
+	   (progn
+	     (format t "compiling ~a~%" lfile)
+	     (compile-file lfile)
+	     (list bfile)))))
+
+@
+
+\subsubsection{our-write-date}
+
+Get the write date of a file. In GCL we need to check that it
+exists first. This is a simple helper function.
+<<our-write-date>>=
+(defun our-write-date (file) (and #+kcl (probe-file file)
+				  (file-write-date file)))
+
+@
+
+\subsubsection{fe}
+
+I'm unsure what this does but I believe it is related to an interpreter
+command. Invoking ``)fe'' in the interpreter tries to get at the 
+src/interp/TAGS file.
+<<fe>>=
+(defun fe (function file &optional (compflag nil) &aux (fn (pathname-name file)))
+  (let ((tbootfile (concat "/tmp/" fn ".boot"))
+	(tlispfile (concat "/tmp/" fn ".lisp")))
+    (system::run-aix-program "fc"
+	 :arguments (list (string function)
+			  (namestring
+			   (merge-pathnames file (concat $SPADROOT "nboot/.boot"))))
+	 :if-output-exists :supersede :output tbootfile)
+    (boot tbootfile tlispfile)
+    (if compflag (progn (compile-file tlispfile)
+			(load (make-pathname :type *bin-path* :defaults tlispfile)))
+      (load tlispfile))))
+@
+
+\subsubsection{fc}
+
+I'm unsure what this does but I believe it is related to an interpreter
+command. Invoking ``)fc'' in the interpreter tries to get at the 
+src/interp/TAGS file.
+<<fc>>=
+(defun fc (function file) (fe function file t))
+
+@
+
+\subsubsection{compspadfiles}
+
+The {\bf compspadfiles} function will recompile a list of {\bf spad} files.
+The filelist should be a file containing names of files to compile.
+<<compspadfiles>>=
+(defun compspadfiles (filelist ;; should be a file containing files to compile
+		      &optional (*default-pathname-defaults*
+				 (pathname (concat $SPADROOT "nalgebra/"))))
+   (with-open-file (stream filelist)
+	(do ((fname (read-line stream nil nil) (read-line stream nil nil)))
+	    ((null fname) 'done)
+	  (setq fname (string-right-trim " *" fname))
+	  (when (not (equal (elt fname 0) #\*))
+	      (spad fname (concat (pathname-name fname) ".out"))))))
+
+@
+
+\subsubsection{load-directory}
+
+Load a whole subdirectory of compiled files
+<<load-directory>>=
+(defun load-directory (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type *bin-path*))
+	  (files (directory pattern)))
+      (mapcar #'load files)))
+
+@
+
+\subsubsection{interp-make-directory}
+
+This is used by the ")cd" system command.
+<<interp-make-directory>>=
+(defun interp-make-directory (direc)
+  (setq direc (namestring direc))
+  (if (string= direc "")  $current-directory
+   (if (or (memq :unix *features*)
+	   (memq 'unix *features*))
+    (progn
+      (if (char/= (char $current-directory (1-(length $current-directory))) #\/)
+	  (setq $current-directory (concat $current-directory "/")))
+      (if (char/= (char direc 0) #\/)
+	  (setq direc (concat $current-directory direc)))
+      (if (char/= (char direc (1- (length direc))) #\/)
+	  (setq direc (concat direc "/")))
+      direc)
+    (progn ;; Assume Windows conventions
+      (if (not (or (char= (char $current-directory (1- (length $current-directory))) #\/)
+                   (char= (char $current-directory (1- (length $current-directory))) #\\ )))
+	  (setq $current-directory (concat $current-directory "\\")))
+      (if (not (or (char= (char direc 0) #\/)
+                   (char= (char direc 0) #\\)
+                   (find #\: direc)))
+          (setq direc (concat $current-directory direc)))
+      (if (not (or (char= (char direc (1- (length direc))) #\/)
+                   (char= (char direc (1- (length direc))) #\\ )))
+	  (setq direc (concat direc "\\")))
+      direc))))
+
+@
+
+\subsubsection{make-directory}
+
+Make a directory relative to the {\bf \$spadroot} variable.
+<<make-directory>>=
+(defun make-directory (direc)
+  (setq direc (namestring direc))
+  (if (string= direc "")  $SPADROOT
+   (if (or (memq :unix *features*)
+	   (memq 'unix *features*))
+    (progn
+      (if (char/= (char direc 0) #\/)
+	  (setq direc (concat $SPADROOT "/" direc)))
+      (if (char/= (char direc (1- (length direc))) #\/)
+	  (setq direc (concat direc "/")))
+      direc)
+    (progn ;; Assume Windows conventions
+      (if (not (or (char= (char direc 0) #\/)
+                   (char= (char direc 0) #\\)
+                   (find #\: direc)))
+          (setq direc (concat $SPADROOT "\\" direc)))
+      (if (not (or (char= (char direc (1- (length direc))) #\/)
+                   (char= (char direc (1- (length direc))) #\\ )))
+	  (setq direc (concat direc "\\")))
+      direc))))
+
+@
+
+\subsubsection{recompile-all-libs}
+
+Occasionally it will be necessary to iterate over all of the NRLIB
+directories and compile each of the code.lsp files in every NRLIB.
+This function will do that. A correct call looks like:
+\begin{verbatim}
+(in-package "BOOT")
+(recompile-all-libs "/spad/mnt/${SYS}/algebra")
+\end{verbatim}
+where the [[${SYS}]] variable is same as the one set at build time.
+<<recompile-all-libs>>=
+(defun recompile-all-libs (dir)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "NRLIB"))
+	  (files (directory pattern)))
+     (mapcar
+       #'(lambda (lib) (compile-lib-file (concat (namestring lib) "/code.lsp")))
+       files)))
+
+@
+
+\subsubsection{recompile-all-algebra-files}
+
+We occasionally need to completely rebuild the algebra from the spad
+files. This function will iterate across a directory containing all
+of the spad files and attempt to recompile them. A correct call looks
+like:
+\begin{verbatim}
+(in-package "BOOT")
+(recompile-all-algebra-files "nalg")
+\end{verbatim}
+Note that it will build a pathname from the current {\bf AXIOM}
+shell variable. So if the {\bf AXIOM} shell variable had the value
+\begin{verbatim}
+/spad/mnt/${SYS}
+\end{verbatim}
+(where the [[${SYS}]] variable is the same one set at build time)
+then the wildcard expands to
+\begin{verbatim}
+/spad/mnt/${SYS}/nalg/*.spad
+\end{verbatim}
+and all of the matching files would be recompiled.
+<<recompile-all-algebra-files>>=
+(defun recompile-all-algebra-files (dir) ;; a desperation measure
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type "spad"))
+	  (files (directory pattern))
+	  (*default-pathname-defaults* (pathname direc)))
+     (mapcar
+       #'(lambda (fname) (spad fname (concat (pathname-name fname) ".out")))
+       files)))
+
+@
+
+\subsubsection{boottocl}
+
+The {\bf boottocl} function is the workhorse function that translates
+{\bf .boot} files to {\bf Common Lisp}. It basically wraps the actual
+{\bf boot} function call to ensure that we don't truncate lines 
+because of {\bf *print-level*} or {\bf *print-length*}.
+<<boottocl>>=
+(in-package "OLD-BOOT") 
+
+(defun boot (file) ;; translates a single boot file
+#+:CCL
+  (setq *package* (find-package "BOOT"))
+#+:AKCL
+  (in-package "BOOT")
+  (let (*print-level* 
+	*print-length* 
+	(fn (pathname-name file))
+	(*print-pretty* t))
+    (declare (special *print-level* *print-length*))
+    (boot::boot
+      file
+      (merge-pathnames (make-pathname :type "clisp") file))))
+
+@
+
+\subsubsection{yearweek}
+
+We need a way of distinguishing different versions of the system.
+There used to be a way to touch the src/timestamp file whenever
+you checked in a change to the change control subsystem. 
+During make PART=interp (the default for make) we set timestamp
+to the filename of this timestamp file. This function converts it
+to a luser readable string and sets the *yearweek* variable.
+
+The result of this function is a string that is printed as a banner 
+when Axiom starts. The actual printing is done by the function
+[[spadStartUpMsgs]] in [[src/interp/msgdb.boot]]. It uses a 
+format string from the file [[src/doc/msgs/s2-us.msgs]].
+<<yearweek>>=
+(defun yearweek ()
+ "set *yearweek* to the current time string for the version banner"
+  (declare (special timestamp) (special *yearweek*))
+  (if (and (boundp 'timestamp) (probe-file timestamp))
+      (let (sec min hour date month year day dayvec monvec)
+	(setq dayvec '("Monday" "Tuesday" "Wednesday" "Thursday"
+		       "Friday" "Saturday" "Sunday"))
+	(setq monvec '("January" "February" "March" "April" "May" "June"
+		       "July" "August" "September" "October" "November"
+		       "December"))
+	(multiple-value-setq (sec min hour date month year day)
+			     (decode-universal-time
+			      (file-write-date timestamp)))
+	(setq *yearweek*
+	  (copy-seq
+	      (format nil "~a ~a ~d, ~d at ~2,'0d:~2,'0d:~2,'0d "
+		      (elt dayvec day)
+		      (elt monvec (1- month)) date year hour min sec))))
+      (setq *yearweek* "no timestamp")))
+
+@
+
+\subsubsection{makelib}
+
+Make will not compare dates across directories.
+Rather than copy all of the code.lsp files to the MNT directory
+we run this function to compile the files that are out of date
+this function assumes that the shell variables INT and MNT are set.
+
+Also of note: on the rt some files (those in the nooptimize list)
+need to be compiled without optimize due to compiler bugs
+<<makelib>>=
+(defun makelib (mid out stype btype)
+ "iterate over the NRLIBs, compiling ones that are out of date.
+  mid is the directory containing code.lsp
+  out is the directory containing code.o"
+ (let (libs lspdate odate nooptimize (alphabet #\space))
+#+(and :akcl :rt)
+  (setq nooptimize '("FFCAT-.NRLIB" "CHVAR.NRLIB" "PFO.NRLIB" "SUP.NRLIB"
+		     "INTG0.NRLIB" "FSPRMELT.NRLIB" "VECTOR.NRLIB"
+		     "EUCDOM-.NRLIB"))
+  (if (and mid out)
+   (format t "doing directory on ~s...~%" (concatenate 'string mid "/*"))
+   (error "makelib:MID=~a OUT=~a~% these are not set properly~%" mid out))
+#+:akcl (compiler::emit-fn nil)
+#+:akcl (si::chdir mid)
+#-:akcl (vmlisp::obey (concatenate 'string "cd " mid))
+  (setq libs (directory "*.NRLIB"))
+  (unless libs
+   (format t "makelib:directory of ~a returned NIL~%" mid)
+   (bye -1))
+  (princ "checking ")
+  (dolist (lib libs)
+   (unless (char= (schar (pathname-name lib) 0) alphabet)
+    (setq alphabet (schar (pathname-name lib) 0))
+    (princ alphabet)
+    (finish-output))
+   (let (dotlsp doto mntlib intkaf mntkaf intkafdate mntkafdate)
+    (setq dotlsp
+      (concatenate 'string mid "/" (file-namestring lib) "/code." stype))
+    (setq doto
+      (concatenate 'string out "/" (pathname-name lib) ".NRLIB/code." btype))
+    (setq mntlib
+      (concatenate 'string out "/" (pathname-name lib) ".NRLIB"))
+    (setq intkaf
+      (concatenate 'string mid "/" (file-namestring lib) "/index.KAF*"))
+    (setq mntkaf
+      (concatenate 'string out "/" (pathname-name lib) ".NRLIB/index.KAF*"))
+    (unless (probe-file mntlib)
+     (format t "creating directory ~a~%" mntlib)
+     (vmlisp::obey (concatenate 'string "cp -pr " (namestring lib) " " out))
+     (when (probe-file (concatenate 'string mntlib "/code." stype))
+      (delete-file  (concatenate 'string mntlib "/code." stype))))
+    (setq intkafdate (and (probe-file intkaf) (file-write-date intkaf)))
+    (setq mntkafdate (and (probe-file mntkaf) (file-write-date mntkaf)))
+    (when intkafdate
+     (unless (and mntkafdate (> mntkafdate intkafdate))
+      (format t "~&copying ~s to ~s" intkaf mntkaf)
+      (vmlisp::obey
+       (concatenate 'string "cp " 
+         (namestring intkaf) " " (namestring mntkaf)))))
+    (setq lspdate (and (probe-file dotlsp) (file-write-date dotlsp)))
+    (setq odate (and (probe-file doto) (file-write-date doto)))
+    (when lspdate
+     (unless (and odate (> odate lspdate))
+#+(and :akcl :rt)
+      (if (member (file-namestring lib) nooptimize :test #'string=)
+       (setq compiler::*speed* 0)
+       (setq compiler::*speed* 3))
+      (compile-lib-file dotlsp :output-file doto)))))))
+
+@
+
+\subsubsection{makespad}
+
+Make will not compare dates across directories.
+In particular, it cannot compare the algebra files because there
+is a one-to-many correspondence. This function will walk over
+all of the algebra NRLIB files and find all of the spad files
+that are out of date and need to be recompiled. This function
+creates a file "/tmp/compile.input" to be used later in the
+makefile.
+
+Note that the file /tmp/compile.input is not currently used
+as algebra source recompiles are not necessarily something
+we want done automatically. Nevertheless, in the quest for
+quality we check anyway.
+<<makespad>>=
+(defun makespad (src mid stype)
+ "iterate over the spad files, compiling ones that are out of date.
+  src is the directory containing .spad
+  mid is the directory containing code.lsp
+  out is the directory containing code.o"
+ (let (mntlibs spadwork (alphabet #\space))
+  (labels (
+   (findsrc (mid libname)
+    "return a string name of the source file given the library file
+     name (eg PI) as a string"
+    (let (kaffile index alist)
+     (setq kaffile 
+      (concatenate 'string mid "/" libname ".NRLIB/index.KAF*"))
+     (with-open-file (kaf kaffile)
+      (setq index (read kaf))
+      (file-position kaf index)
+      (setq alist (read kaf))
+     (setq index (third (assoc "sourceFile" alist :test #'string=)))
+      (file-position kaf index)
+     (pathname-name (pathname (read kaf index)))))))
+  (format t "makespad:src=~s mid=~s stype=~s~%" src mid stype)
+  (if (and src mid)
+   (format t "doing directory on ~s...~%" (concatenate 'string src "/*"))
+   (error "makespad:SRC=~a MID=~a not set properly~%" src mid))
+#+:akcl (si::chdir mid)
+#-:akcl (vmlisp::obey (concatenate 'string "cd " mid))
+  (setq mntlibs (directory "*.NRLIB"))
+  (unless mntlibs
+   (format t "makespad:directory of ~a returned NIL~%" src)
+   (bye 1))
+  (princ "checking ")
+  (dolist (lib mntlibs)
+   (unless (char= (schar (pathname-name lib) 0) alphabet)
+    (setq alphabet (schar (pathname-name lib) 0))
+    (princ alphabet)
+    (finish-output))
+   (let (spad spaddate lsp lspdate)
+    (setq spad
+      (concatenate 'string src "/" (findsrc mid (pathname-name lib)) ".spad"))
+    (setq spaddate
+      (and (probe-file spad) (file-write-date spad)))
+    (setq lsp
+      (concatenate 'string mid "/" (pathname-name lib) ".NRLIB/code." stype))
+    (setq lspdate
+      (and (probe-file lsp) (file-write-date lsp)))
+    (cond
+     ((and spaddate lspdate (<= spaddate lspdate)))
+     ((and spaddate lspdate (> spaddate lspdate))
+       (setq spadwork (adjoin spad spadwork :test #'string=)))
+     ((and spaddate (not lspdate)) 
+       (setq spadwork (adjoin spad spadwork :test #'string=)))
+     ((and (not spaddate) lspdate)
+       (format t "makespad:missing spad file ~a for lisp file ~a~%" spad lsp))
+     ((and (not spaddate) (not lspdate))
+       (format t "makespad:NRLIB ~a exist but is spad ~a and lsp ~a don't~%"
+         lib spad lsp)))))
+   (with-open-file (tmp "/tmp/compile.input" :direction :output)
+    (dolist (spad spadwork)
+     (format t "~a is out of date~%" spad)
+     (format tmp ")co ~a~%" spad))))))
+
+@
+
+\subsubsection{libcheck}
+
+We need to ensure that the INTERP.EXPOSED list, which is a list
+of the exposed constructors, is consistent with the actual libraries.
+<<libcheck>>=
+(defun libcheck (int)
+ "check that INTERP.EXPOSED and NRLIBs are consistent"
+ (let (interp nrlibs)
+ (labels (
+  (CONSTRUCTORNAME (nrlib)
+   "find the long name of a constructor given an abbreviation string"
+   (let (file sourcefile name)
+    (setq file (findsrc nrlib))
+    (setq sourcefile
+      (concatenate 'string int "/" file ".spad"))
+    (when (and file (probe-file sourcefile))
+     (setq name (searchsource sourcefile nrlib)))))
+  (NOCAT (longnames)
+   "remove the categories from the list of long names"
+   (remove-if 
+    #'(lambda (x) 
+       (let ((c (schar x (1- (length x)))))
+        (or (char= c #\&) (char= c #\-)))) longnames))
+  (FINDSRC (libname)
+   "return a string name of the source file given the library file
+    name (eg PI) as a string"
+   (let (kaffile index alist result)
+    (setq kaffile 
+     (concatenate 'string int "/" libname ".NRLIB/index.KAF*"))
+    (if (probe-file kaffile)
+     (with-open-file (kaf kaffile)
+      (setq index (read kaf))
+      (file-position kaf index)
+      (setq alist (read kaf))
+     (setq index (third (assoc "sourceFile" alist :test #'string=)))
+      (file-position kaf index)
+     (setq result (pathname-name (pathname (read kaf index))))))
+     (format t "~a does not exist~%" kaffile)
+    result))
+  (READINTERP ()
+   "read INTERP.EXPOSED and return a sorted abbreviation list"
+   (let (expr names longnames)
+    (with-open-file (in (concatenate 'string int "/INTERP.EXPOSED"))
+     (catch 'eof
+      (loop
+       (setq expr (read-line in nil 'eof))
+       (when (eq expr 'eof) (throw 'eof nil))
+       (when
+        (and
+         (> (length expr) 58)
+         (char= (schar expr 0) #\space) 
+         (not (char= (schar expr 8) #\space)))
+         (push (string-trim '(#\space) (subseq expr 8 57)) longnames)
+         (push (string-right-trim '(#\space) (subseq expr 58)) names)))))
+    (setq longnames (sort longnames #'string<))
+    (setq names (sort names #'string<))
+    (values names longnames)))
+  (READLIBS (algebra)
+   "read the NRLIB directory and return a sorted abbreviation list"
+   (let (libs nrlibs)
+#+:akcl (si::chdir algebra)
+#-:akcl (vmlisp::obey (concatenate 'string "cd " algebra))
+    (setq nrlibs (directory "*.NRLIB"))
+    (unless nrlibs
+     (error "libcheck: (directory ~s) returned NIL~%" 
+         (concatenate 'string algebra "/*.NRLIB")))
+    (dolist (lib nrlibs)
+     (push (pathname-name lib) libs))
+    (sort libs #'string<)))
+  (SEARCHSOURCE (sourcefile nrlib)
+   "search a sourcefile for the long constructor name of the nrlib string"
+   (let (in expr start)
+    (setq nrlib (concatenate 'string " " nrlib " "))
+    (catch 'done
+     (with-open-file (in sourcefile)
+      (loop
+       (setq expr (read-line in nil 'done))
+       (when (eq expr 'done) (throw 'done nil))
+       (when (and (> (length expr) 4)
+                (string= ")abb" (subseq expr 0 4))
+                (search nrlib expr :test #'string=)
+                (setq start (position #\space expr :from-end t :test #'char=)))
+        (throw 'done (string-trim '(#\space) (subseq expr start)))))))))
+  (SRCABBREVS (sourcefile)
+   (let (in expr start end names longnames)
+    (catch 'done
+     (with-open-file (in sourcefile)
+      (loop
+       (setq expr (read-line in nil 'done))
+       (when (eq expr 'done) (throw 'done nil))
+       (when (and (> (length expr) 4)
+             (string= ")abb" (subseq expr 0 4)))
+        (setq point (position #\space expr :from-end t :test #'char=))
+        (push (string-trim '(#\space) (subseq expr point)) longnames)
+        (setq mark
+         (position #\space 
+          (string-right-trim '(#\space)
+           (subseq expr 0 (1- point))) :from-end t))
+        (push (string-trim '(#\space) (subseq expr mark point)) names)))))
+    (values names longnames)))
+  (SRCSCAN ()
+   (let (longnames names)
+#+:gcl (system::chdir int)
+#-:gcl (vmlisp::obey (concatenate 'string "cd " int))
+    (setq spads (directory "*.spad"))
+    (dolist (spad spads)
+     (multiple-value-setq (short long) (srcabbrevs spad))
+     (setq names (nconc names short))
+     (setq longnames (nconc longnames long)))
+    (setq names (sort names #'string<))
+    (setq longnames (sort longnames #'string<))
+    (values names longnames))))
+  (multiple-value-setq (abbrevs constructors) (readinterp))
+  (setq nrlibs (readlibs int))
+  (dolist (lib (set-difference nrlibs abbrevs :test #'string=))
+    (format t "libcheck:~a/~a.NRLIB is not in INTERP.EXPOSED~%" int lib))
+  (dolist (expose (set-difference abbrevs nrlibs :test #'string=))
+    (format t "libcheck:~a is in INTERP.EXPOSED with no NRLIB~%" expose))
+  (multiple-value-setq (srcabbrevs srcconstructors) (srcscan))
+  (setq abbrevs (nocat abbrevs))
+  (setq constructors (nocat constructors))
+  (dolist (item (set-difference srcabbrevs abbrevs :test #'string=))
+    (format t "libcheck:~a is in ~a but not in INTERP.EXPOSED~%" item
+     (findsrc item)))
+  (dolist (item (set-difference abbrevs srcabbrevs :test #'string=))
+    (format t "libcheck:~a is in INTERP.EXPOSED but has no spad sourcfile~%"
+      item))
+  (dolist (item (set-difference srcconstructors constructors :test #'string=))
+    (format t "libcheck:~a is not in INTERP.EXPOSED~%" item))
+  (dolist (item (set-difference constructors srcconstructors :test #'string=))
+    (format t "libcheck:~a has no spad source file~%" item)))))
+
+@
+
+
+\subsection{Constructing TAGS}
+
+TAGS are useful for finding functions if you run Emacs. We have a
+set of functions that construct TAGS files for Axiom.
+\subsubsection{make-tags-file}
+Run the etags command on all of the lisp code. Then run the
+{\bf spadtags-from-directory} function on the boot code. The
+final TAGS file is constructed in the {\bf tmp} directory.
+<<make-tags-file>>=
+(defun make-tags-file ()
+#+:gcl (system:chdir "/tmp")
+#-:gcl (vmlisp::obey (concatenate 'string "cd " "/tmp"))
+  (obey (concat "etags " (make-absolute-filename "../../src/interp/*.lisp")))
+  (spadtags-from-directory "../../src/interp" "boot")
+  (obey "cat /tmp/boot.TAGS >> /tmp/TAGS"))
+
+@
+
+\subsubsection{spadtags-from-directory}
+
+This function will walk across a directory and call 
+{\bf spadtags-from-file} on each file.
+<<spadtags-from-directory>>=
+(defun spadtags-from-directory (dir type)
+   (let* ((direc (make-directory dir))
+	  (pattern (make-pathname :directory (pathname-directory direc)
+				  :name :wild :type type))
+	  (files (directory pattern)))
+     (with-open-file
+      (tagstream (concatenate 'string "/tmp/" type ".TAGS") :direction :output
+		 :if-exists :supersede :if-does-not-exist :create)
+      (dolist (file files (namestring tagstream))
+	      (print (list "processing:" file))
+	      (write-char #\page tagstream)
+	      (terpri tagstream)
+	      (write-string (namestring file) tagstream)
+	      (write-char #\, tagstream)
+	      (princ (spadtags-from-file file) tagstream)
+	      (terpri tagstream)
+	      (with-open-file (stream "/tmp/*TAGS")
+		 (do ((line (read-line stream nil nil)
+			    (read-line stream nil nil)))
+		     ((null line) nil)
+		     (write-line line tagstream)))))))
+
+@
+
+\subsubsection{spadtags-from-file}
+
+This function knows how to find function names in {\bf boot} code
+so we can add them to the TAGS file using standard etags format.
+<<spadtags-from-file>>=
+(defun spadtags-from-file (spadfile)
+  (with-open-file (tagstream "/tmp/*TAGS" :direction :output
+			     :if-exists :supersede :if-does-not-exist :create)
+    (with-open-file (stream spadfile)
+       (do ((char-count 0 (file-position stream))
+	    (line (read-line stream nil nil) (read-line stream nil nil))
+	    (line-count 1 (1+ line-count)))
+	   ((null line) (file-length tagstream))
+	   (if (/= (length line) 0)
+	       (let ((firstchar (elt line 0)) (end nil)
+		     (len (length line)))
+		 (cond ((member firstchar '(#\space #\{ #\} #\tab )
+				:test #'char= ) "skip")
+		       ((string= line ")abb" :end1 (min 4 len))
+			(setq end (position #\space line :from-end t
+					    :test-not #'eql)
+			      end (and end (position #\space line :from-end t
+						     :end end)))
+			(write-tag-line line tagstream end
+					line-count char-count))
+		       ((char= firstchar #\)) "skip")
+		       ((and (> len 1) (string= line "--" :end1 2)) "skip")
+		       ((and (> len 1) (string= line "++" :end1 2)) "skip")
+		       ((search "==>" line) "skip")
+		       ((and (setq end (position #\space line)
+				   end (or (position #\( line :end end) end)
+				   end (or (position #\: line :end end) end)
+				   end (or (position #\[ line :end end) end))
+			     (equal end 0)) "skip")
+		       ((position #\] line :end end) "skip")
+		       ((string= line "SETANDFILEQ" :end1 end) "skip")
+		       ((string= line "EVALANDFILEACTQ" :end1 end) "skip")
+		       (t (write-tag-line line tagstream
+					  (if (numberp end) (+ end 1) end)
+					  line-count char-count))  )))))))
+
+@
+
+\subsubsection{write-tag-line}
+
+This function knows how to write a single line into a TAGS file
+using the etags file format.
+<<write-tag-line>>=
+(defun write-tag-line (line tagstream endcol line-count char-count)
+  (write-string line tagstream :end endcol)
+  (write-char #\rubout tagstream)
+  (princ line-count tagstream)
+  (write-char #\, tagstream)
+  (princ char-count tagstream)
+  (terpri tagstream))
+
+@
+
+\subsubsection{blankcharp}
+
+This is a trivial predicate for calls to {\bf position-if-not} in the
+{\bf findtag} function.
+<<blankcharp>>=
+(defun blankcharp (c) (char= c #\Space))
+
+@
+
+\subsubsection{findtag}
+
+The {\bf findtag} function is a user-level function to figure out
+which file contains a given tag. This is sometimes useful if Emacs
+is not around or TAGS are not loaded.
+<<findtag>>=
+(defun findtag (tag &optional (tagfile (concat $spadroot "/../../src/interp/TAGS")) )
+  ;; tag is an identifier
+    (with-open-file (tagstream tagfile)
+	(do ((tagline (read-line tagstream nil nil)
+		      (read-line tagstream nil nil))
+	     (*package* (symbol-package tag))
+	     (sourcefile)
+	     (stringtag (string tag))
+	     (pos)
+	     (tpos)
+	     (type))
+	    ((null tagline) ())
+	    (cond ((char= (char tagline 0) #\Page)
+		   (setq tagline (read-line tagstream nil nil))
+		   (setq sourcefile (subseq tagline 0
+					    (position #\, tagline)))
+		   (setq type (pathname-type sourcefile)))
+		  ((string= type "lisp")
+		   (if (match-lisp-tag tag tagline)
+		       (return (cons sourcefile tagline))))
+		  ((> (mismatch ")abb" tagline) 3)
+		   (setq pos (position #\Space tagline :start 3))
+		   (setq pos (position-if-not #'blankcharp tagline
+					      :start pos))
+		   (setq pos (position #\Space tagline :start pos))
+		   (setq pos (position-if-not #'blankcharp tagline
+					      :start pos))
+		   (setq tpos (mismatch stringtag tagline :start2 pos))
+		   (if (and (= tpos (length (string tag)))
+			    (member (char tagline (+ pos tpos)) '(#\Space #\Rubout)))
+		       (return (cons sourcefile tagline))))
+		  ((setq pos (mismatch stringtag tagline))
+		   (if (and (= pos (length stringtag))
+			    (> (length tagline) pos)
+			    (member (char tagline pos)
+				    '( #\Space #\( #\:) ))
+		       (return (cons sourcefile tagline))))))))
+
+@
+
+\subsubsection{match-lisp-tag}
+
+The {\bf match-lisp-tag} function is used by {\bf findtag}. This
+function assumes that \\ can only appear as first character of name.
+<<match-lisp-tag>>=
+(defun match-lisp-tag (tag tagline &optional (prefix nil)
+			   &aux (stringtag (string tag)) pos tpos)
+  (when (and (if prefix
+		 (= (mismatch prefix tagline :test #'char-equal)
+		    (length prefix))
+	       t)
+	     (numberp (setq pos (position #\Space tagline)))
+	     (numberp (setq pos (position-if-not #'blankcharp tagline
+						 :start pos))))
+	(if (char= (char tagline pos) #\') (incf pos))
+	(if (member (char tagline pos) '( #\\ #\|))
+	    (setq tpos (1+ pos))
+	  (setq tpos pos))
+	(and (= (mismatch stringtag tagline :start2 tpos :test #'char-equal)
+		(length stringtag))
+	     (eq tag (read-from-string tagline nil nil :start pos))) ))
+
+@
+
+
+\subsection{Translated Boot functions}
+
+\subsubsection{string2BootTree}
+
+<<string2BootTree>>=
+(DEFUN |string2BootTree| (S)
+  (init-boot/spad-reader)
+  (LET* ((BOOT-LINE-STACK (LIST (CONS 1 S)))
+     ($BOOT T)
+     ($SPAD NIL)
+     (XTOKENREADER 'GET-BOOT-TOKEN)
+     (LINE-HANDLER 'NEXT-BOOT-LINE)
+     (PARSEOUT (PROGN (|PARSE-Expression|) (POP-STACK-1))))
+    (DECLARE (SPECIAL BOOT-LINE-STACK $BOOT $SPAD XTOKENREADER LINE-HANDLER))
+    (DEF-RENAME (|new2OldLisp| PARSEOUT))))
+
+@
+
+\subsubsection{string2SpadTree}
+
+<<string2SpadTree>>=
+(DEFUN |string2SpadTree| (LINE)
+  (DECLARE (SPECIAL LINE))
+  (if (and (> (LENGTH LINE) 0) (EQ (CHAR LINE 0) #\) ))
+    (|processSynonyms|))
+  (ioclear)
+  (LET* ((BOOT-LINE-STACK (LIST (CONS 1 LINE)))
+     ($BOOT NIL)
+     ($SPAD T)
+     (XTOKENREADER 'GET-BOOT-TOKEN)
+     (LINE-HANDLER 'NEXT-BOOT-LINE)
+     (PARSEOUT (PROG2 (|PARSE-NewExpr|) (POP-STACK-1))))
+    (DECLARE (SPECIAL BOOT-LINE-STACK $BOOT $SPAD XTOKENREADER LINE-HANDLER))
+    PARSEOUT))
+
+@
+
+\subsubsection{processSynonyms}
+
+;;--------------------> NEW DEFINITION (see i-syscmd.boot.pamphlet)
+<<processSynonyms>>=
+(defun |processSynonyms| () nil) ;;dummy def for depsys, redefined later
+
+@
+
+
+\section{License}
+
+<<license>>=
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;;
+;; 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.
+
+@
+<<*>>=
+<<license>>
+
+#-:common-lisp (IMPORT-MODULE "vmlisp")
+
+(in-package "BOOT")
+(export '($spadroot $directory-list $current-directory reroot
+	  make-absolute-filename |$msgDatabaseName| |$defaultMsgDatabaseName|))
+
+<<our-write-date>>
+<<make-directory>>
+<<interp-make-directory>>
+<<bin-path>>
+<<load-directory>>
+<<compspadfiles>>
+<<recompile-all-algebra-files>>
+<<fe>>
+<<fc>>
+<<recompile-directory>>
+<<recompile-file-if-necessary>>
+<<recompile-all-files>>
+<<recompile-lib-directory>>
+<<recompile-all-libs>>
+<<recompile-NRLIB-if-necessary>>
+<<lift-NRLIB-name>>
+<<retranslate-directory>>
+<<retranslate-file-if-necessary>>
+<<make-tags-file>>
+<<spadtags-from-directory>>
+<<spadtags-from-file>>
+<<write-tag-line>>
+<<blankcharp>>
+<<findtag>>
+<<match-lisp-tag>>
+<<compile-boot-file>>
+<<translate>>
+<<translist>>
+<<relative-directory-list>>
+<<relative-library-directory-list>>
+<<directory-list>>
+<<library-directory-list>>
+<<boottocl>>
+
+(in-package "BOOT")
+
+<<parse-functions>>
+<<comp-functions>>
+<<browse-functions>>
+<<translate-functions>>
+<<asauto-functions>>
+<<debug-functions>>
+<<anna-functions>>
+<<nagbr-functions>>
+<<setBootAutloadProperties>>
+<<boot-load>>
+<<setBootAutoLoadProperty>>
+<<mkBootAutoLoad>>
+<<build-interpsys>>
+<<setNAGBootAutloadProperties>>
+<<get-NAG-chapter>>
+<<nag-files>>
+<<chapter-name>>
+<<build-depsys>>
+
+<<string2BootTree>>
+<<string2SpadTree>>
+<<processSynonyms>>
+
+;; the following are for conditional reading
+#+:ieee-floating-point (setq $ieee t)
+#-:ieee-floating-point (setq $ieee nil)
+(setq |$opSysName| '"shell")
+#+:CCL (defun machine-type () "unknown")
+(setq |$machineType| (machine-type))
+; spad-clear-input patches around fact that akcl clear-input leaves newlines chars
+(defun spad-clear-input (st) (clear-input st) (if (listen st) (read-char st)))
+
+<<yearweek>>
+(defun sourcepath (f)
+ "find the sourcefile in the system directories"
+ (let (axiom algebra naglink)
+  (setq axiom (|getEnv| "AXIOM"))
+  (setq algebra (concatenate 'string axiom "/../../src/algebra/" f ".spad"))
+  (setq naglink (concatenate 'string axiom "/../../src/naglink/" f ".spad"))
+  (cond
+   ((probe-file algebra) algebra)
+   ((probe-file naglink) naglink)
+   ('else nil))))
+
+(defun srcabbrevs (sourcefile)
+ "read spad source files and return the constructor names and abbrevs"
+ (let (expr point mark names longnames)
+  (catch 'done
+   (with-open-file (in sourcefile)
+    (loop
+     (setq expr (read-line in nil 'done))
+     (when (eq expr 'done) (throw 'done nil))
+     (when (and (> (length expr) 4) (string= ")abb" (subseq expr 0 4)))
+      (setq expr (string-right-trim '(#\space #\tab) expr))
+      (setq point (position #\space expr :from-end t :test #'char=))
+      (push (subseq expr (1+ point)) longnames)
+      (setq expr (string-right-trim '(#\space #\tab)
+		       (subseq expr 0 point)))
+      (setq mark (position #\space expr  :from-end t))
+      (push (subseq expr (1+ mark)) names)))))
+  (values longnames names)))
+
+
+#+(and :AKCL (not (or :dos :win32)))
+(in-package "COMPILER")
+#+(and :AKCL (not (or :dos :win32)))
+(defun gazonk-name ( &aux tem)
+ "return the name of the intermediate compiler file"
+ (dotimes (i 1000)
+  (setq tem (merge-pathnames (format nil "/tmp/gazonk~d.lsp" i)))
+  (unless (probe-file tem)
+    (return-from gazonk-name (pathname tem))))
+ (error "1000 gazonk names used already!"))
+
+(in-package "BOOT")
+
+(defun |tr| (fn)
+  (|oldCompilerAutoloadOnceTrigger|)
+  (|browserAutoloadOnceTrigger|)
+  (|spad2AsTranslatorAutoloadOnceTrigger|)
+  (|convertSpadFile| fn) )
+
+<<makelib>>
+<<makespad>>
+<<libcheck>>
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}