aboutsummaryrefslogtreecommitdiff
path: root/src/interp/util.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/util.lisp')
-rw-r--r--src/interp/util.lisp1118
1 files changed, 1118 insertions, 0 deletions
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
new file mode 100644
index 00000000..730b1df5
--- /dev/null
+++ b/src/interp/util.lisp
@@ -0,0 +1,1118 @@
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;; Copyright (C) 2007, Gabriel Dos Reis.
+;; 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.
+
+;; This file is a collection of utility functions that are useful
+;; for system level work. A couple of the functions, `build-depsys'
+;; and `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 `makespad' can rebuild the whole algebra tree.
+
+;; A third group of related functions are used to set up the
+;; `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.
+
+
+
+(IMPORT-MODULE "vmlisp")
+(import-module "parsing")
+
+(in-package "BOOT")
+(export '($directory-list $current-directory reroot
+ make-absolute-filename |$msgDatabaseName| |$defaultMsgDatabaseName|))
+
+(defun our-write-date (file) (and #+kcl (probe-file file)
+ (file-write-date file)))
+
+(defun make-directory (direc)
+ (setq direc (namestring direc))
+ (if (string= direc "") (|systemRootDirectory|)
+ (if (or (memq :unix *features*)
+ (memq 'unix *features*))
+ (progn
+ (if (char/= (char direc 0) #\/)
+ (setq direc (concat (|systemRootDirectory|) "/" 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 (|systemRootDirectory|) "\\" direc)))
+ (if (not (or (char= (char direc (1- (length direc))) #\/)
+ (char= (char direc (1- (length direc))) #\\ )))
+ (setq direc (concat direc "\\")))
+ direc))))
+
+(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))))
+
+;; 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.
+(defvar *bin-path*
+ #+kcl "o"
+ #+lucid "bbin"
+ #+symbolics "bin"
+ #+cmulisp "fasl"
+ #+:ccl "not done this way at all")
+
+(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)))
+
+(defun compspadfiles (filelist ;; should be a file containing files to compile
+ &optional (*default-pathname-defaults*
+ (pathname (concat (|systemRootDirectory|)
+ "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"))))))
+
+(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)))
+
+(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 (|systemRootDirectory|)
+ "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))))
+(defun fc (function file) (fe function file t))
+
+;; This function will compile any lisp code that has changed in a 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)))
+
+;; 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.
+(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)))))
+
+;; Force recompilation of all lisp files in a directory.
+(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)))
+
+
+;; Recompile library lisp code if necessary.
+(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)))
+
+(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)))
+
+;; 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.
+(defun recompile-NRLIB-if-necessary (lib)
+ (recompile-lib-file-if-necessary (concat (namestring lib) "/code.lsp"))
+ (lift-NRLIB-name (namestring lib)))
+
+
+;; 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.
+(defun lift-NRLIB-name (f)
+ (obey (concat "cp " f "/code.o " (subseq f 0 (position #\. f)) ".o"))
+ nil)
+
+;; Translate a directory of boot code to common lisp if the boot code
+;; is newer.
+(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)))
+
+
+;; Retranslate a single boot file if it has been changed.
+(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))))))
+
+
+;; TAGS are useful for finding functions if you run Emacs. We have a
+;; set of functions that construct TAGS files for Axiom.
+(defun make-tags-file ()
+#+:gcl (system:chdir "/tmp")
+#-:gcl (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"))
+
+(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)))))))
+
+(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)) )))))))
+
+(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))
+
+(defun blankcharp (c) (char= c #\Space))
+
+(defun findtag (tag &optional (tagfile (concat (|systemRootDirectory|) "/../../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))))))))
+
+(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))) ))
+
+;; Translate a single boot file to common lisp, compile it
+;; and load it.
+(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"))
+)
+
+
+;; Translate a single boot file to common lisp
+(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 (|systemRootDirectory|) "nboot/.boot"))))
+ (declare (special *print-level* *print-length*))
+ (boot bootfile (make-pathname :type "lisp" :defaults bootfile))))
+
+
+;; Translate a list of boot files to common lisp.
+(defun translist (fns)
+ (mapcar #'(lambda (f) (format t "translating ~a~%" (concat f ".boot"))
+ (translate f))
+ fns))
+
+
+;; 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.
+(defvar $relative-directory-list
+ '("/../../src/input/"
+ "/share/msgs/"
+ "/../../src/algebra/"
+ "/../../src/interp/" ; for boot and lisp files (helps fd)
+ "/doc/spadhelp/" ))
+
+;; The relative directory list specifies how to find the algebra
+;; directory from the current {\bf AXIOM} shell variable.
+(defvar $relative-library-directory-list '("/algebra/"))
+
+(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))))
+
+
+(in-package "BOOT")
+
+;; This is a little used subsystem to generate {\bf ALDOR} code
+;; from {\bf Spad} code. Frankly, I'd be amazed if it worked.
+(setq translate-functions '(
+;; .spad to .as translator, in particular
+;; loadtranslate
+ |spad2AsTranslatorAutoloadOnceTrigger|
+ ))
+
+;; 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}.
+(setq asauto-functions '(
+ loadas
+;; |as| ;; now in as.boot
+;; |astran| ;; now in as.boot
+ |spad2AxTranslatorAutoloadOnceTrigger|
+ |sourceFilesToAxcliqueAxFile|
+ |sourceFilesToAxFile|
+ |setExtendedDomains|
+ |makeAxFile|
+ |makeAxcliqueAxFile|
+ |nrlibsToAxFile|
+ |attributesToAxFile| ))
+
+;; 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.
+(setq debug-functions '(
+ loaddebug
+ |showSummary|
+ |showPredicates|
+ |showAttributes|
+ |showFrom|
+ |showImp|))
+
+;; The {\bf ANNA} subsystem, invoked thru {\bf hypertex}, is an
+;; expert system that understands the Numerical Algorithms Group (NAG)
+;; fortran library.
+(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|))
+
+;; 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.
+(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|
+ ))
+
+
+;; 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.
+(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)
+)
+
+
+;; This function knows where the {\bf autoload} subdirectory lives.
+;; It is called by {\bf mkBootAutoLoad} above to find the necessary
+;; files.
+(defun boot-load (file)
+ (let ((name (concat (|systemRootDirectory|)
+ "/autoload/"
+ (pathname-name file))))
+ (if |$printLoadMsgs|
+ (format t " Loading ~A.~%" name))
+ (load name)))
+
+;; 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.
+(defun |setBootAutoLoadProperty| (func file-list)
+ (setf (symbol-function func) (|mkBootAutoLoad| func file-list)) )
+
+;; 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.
+(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)))))
+
+;############################################################################
+;# 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.
+;############################################################################
+
+;; The `build-interpsys' function takes a list of files to load
+;; into the image (`load-files'). It also takes several lists of files,
+;; one for each subsystem which will be autoloaded. Autoloading is explained
+;; below. This function is called in the src/interp/Makefile.
+
+;; This function calls `reroot' 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.
+
+(defun build-interpsys (load-files
+ translate-files nagbr-files asauto-files)
+ (reroot)
+ #+:AKCL
+ (init-memory-config :cons 500 :fixnum 200 :symbol 500 :package 8
+ :array 400 :string 500 :cfun 100 :cpages 1000
+ :rpages 1000 :hole 2000)
+ #+:AKCL
+ (setq compiler::*suppress-compiler-notes* t)
+ (mapcar #'|AxiomCore|::|importModule| load-files)
+ (|resetWorkspaceVariables|)
+ (|initHist|)
+ (|initNewWorld|)
+ (compressopen)
+ (interpopen)
+ (create-initializers)
+ (|start| :fin)
+#+:CCL
+ (resethashtables)
+ (setq *load-verbose* nil)
+ (|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
+ )
+
+
+;; 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.
+(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))
+
+;; 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.
+(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)))
+
+
+;; We analyze the function names to decide which chapter we are in.
+;; We load files based on the chapter.
+(defun nag-files (filename filelist)
+ (apply 'append (mapcar
+ #'(lambda (f)
+ (cond ((equalp (chapter-name filename) (chapter-name f)) (list f))) )
+ filelist)))
+
+;; The library names follow a convention that allows us to extract
+;; the 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)))
+)
+
+
+;; The `depsys' image is one of the two images we build from
+;; the src/interp subdirectory (the other is `interpsys'). We
+;; use `depsys' as a compile-time image as it contains all of
+;; the necessary functions and macros to compile any file. The
+;; `depsys' image is almost the same as an `interpsys'
+;; image but it does not have any autoload triggers or databases
+;; loaded.
+
+(defun build-depsys (load-files)
+#+:CCL
+ (setq *package* (find-package "BOOT"))
+#+:AKCL
+ (in-package "BOOT")
+ (mapcar #'load load-files)
+ (reroot)
+ #+: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) )
+
+
+(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))))
+
+(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))
+
+
+;;--------------------> NEW DEFINITION (see i-syscmd.boot.pamphlet)
+(defun |processSynonyms| () nil) ;;dummy def for depsys, redefined later
+
+
+;; 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)))
+
+;; 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]].
+(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")))
+
+(defun sourcepath (f)
+ "find the sourcefile in the system directories"
+ (let (axiom algebra naglink)
+ (setq axiom (|systemRootDirectory|))
+ (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)
+ (|spad2AsTranslatorAutoloadOnceTrigger|)
+ (|convertSpadFile| fn) )
+
+
+;; 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
+(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 (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)
+ (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)
+ (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)))))))
+
+
+;; 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.
+(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 (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))))))
+
+
+;; We need to ensure that the INTERP.EXPOSED list, which is a list
+;; of the exposed constructors, is consistent with the actual libraries.
+(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 (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 (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)))))
+
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 20:01:05 +0000