aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2009-02-22 14:33:02 +0000
committerdos-reis <gdr@axiomatics.org>2009-02-22 14:33:02 +0000
commitd89a465c194d12dc1eff31dc7adc861cdce98107 (patch)
tree6cb4dcdb0bd1b177e09ae380ae576bafa28b5195 /src
parent7d3b7d55f97f1d8119160e409b0922e3e6ec6ac7 (diff)
downloadopen-axiom-d89a465c194d12dc1eff31dc7adc861cdce98107.tar.gz
Remove unused code.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog13
-rw-r--r--src/interp/util.lisp275
2 files changed, 14 insertions, 274 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index bacfafbe..5e6aa71c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,18 @@
2009-02-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/util.lisp (MAKESPAD): Remove.
+ (MAKELIB): Likewise.
+ (tr): Likewise.
+ (MAKE-TAGS-FILE): Likewise.
+ (SPADTAGS-FROM-DIRECTORY): Likewise.
+ (SPADTAGS-FROM-FILE): Likewise.
+ (WRITE-TAG-LINE): Likewise.
+ (FINDTAG): Likewise.
+ (MATCH-LISP-TAG): Likewise.
+ (BLANKCHARP): Likewise.
+
+2009-02-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/msgdb.boot: Avoid SETANDFILEQ.
2009-02-21 Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 6c664800..8e2b0b9b 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2009, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -203,137 +203,6 @@
(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 ()
- (|changeDirectory| "/tmp")
- (|runCommand| (concat "etags " (|makeAbsoluteFilename| "../../src/interp/*.lisp")))
- (spadtags-from-directory "../../src/interp" "boot")
- (|runCommand| "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)
@@ -609,148 +478,6 @@
(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)
- (|changeDirectory| 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)
- (|runCommand| (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)
- (|runCommand|
- (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))
- (|changeDirectory| 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)