diff options
Diffstat (limited to 'src/interp/util.lisp.pamphlet')
| -rw-r--r-- | src/interp/util.lisp.pamphlet | 1683 |
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 "~©ing ~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} |