diff --git a/changelog b/changelog index 877a8f2..41ec8e5 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20100227 tpd src/axiom-website/patches.html 20100227.02.tpd.patch +20100227 tpd src/interp/vmlisp.lisp remove unused functions 20100227 tpd src/axiom-website/patches.html 20100227.01.tpd.patch 20100227 tpd books/bookvol5 rewrite to common lisp functions 20100227 tpd src/interp/vmlisp.lisp remove some define-functions diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index e7a4947..e51b752 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2499,5 +2499,7 @@ faq FAQ 51: How can I do unicode in xterm?
books/bookvol5 merge and remove macex, begin documentation
20100227.01.tpd.patch src/interp/vmlisp.lisp remove some define-functions
+20100227.02.tpd.patch +src/interp/vmlisp.lisp remove unused functions
diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 4d4f486..9b14821 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -1982,7 +1982,7 @@ Camm issued a fix. This used to read: (fullname nil) (indextable nil)) (cond ((equal (elt (string mode) 0) #\I) - (setq fullname (make-input-filename (cdr file) 'NIL)) + (setq fullname (boot::makeInputFilename (cdr file) 'NIL)) (setq stream (get-input-index-stream fullname)) (if (null stream) (if missing-file-error-flag @@ -1994,8 +1994,8 @@ Camm issued a fix. This used to read: :indextable (get-index-table-from-stream stream) :indexstream stream))) ((equal (elt (string mode) 0) #\O) - ;;(setq fullname (make-full-namestring (cdr file) 'LISPLIB)) - (setq fullname (make-full-namestring (cdr file) 'NIL)) + ;;(setq fullname (boot::makeFullNamestring (cdr file) 'LISPLIB)) + (setq fullname (boot::makeFullNamestring (cdr file) 'NIL)) (case (directory? fullname) (-1 (makedir fullname)) (0 (error (format nil "~s is an existing file, not a library" fullname))) @@ -2088,7 +2088,7 @@ Camm issued a fix. This used to read: ;; (RKEYIDS filearg) -- interned version of keys (defun rkeyids (&rest filearg) (mapcar #'intern (mapcar #'car (getindextable - (make-input-filename filearg 'NIL))))) + (boot::makeInputFilename filearg 'NIL))))) ;; (RWRITE cvec item rstream) (defun rwrite (key item rstream) (if (equal (libstream-mode rstream) 'input) (error "not output stream")) @@ -2240,59 +2240,24 @@ do the compile, and then rename the result back to code.o. (concatenate 'string (string filearg) "." (string ft)) (string filearg))))))) -(defun make-full-namestring (filearg &optional (filetype nil)) - (namestring (merge-pathnames (make-filename filearg filetype)))) - -(defun make-input-filename (filearg &optional (filetype nil)) - (let* - ((filename (make-filename filearg filetype)) - (dirname (pathname-directory filename)) - (ft (pathname-type filename)) - (dirs (get-directory-list ft)) - (newfn nil)) - (if (or (null dirname) (eqcar dirname :relative)) - (dolist (dir dirs (probe-name filename)) - (when - (probe-file - (setq newfn (concatenate 'string dir filename))) - (return newfn))) - (probe-name filename)))) - -(defun probe-name (file) - (if (probe-file file) (namestring file) nil)) - -(defun get-directory-list (ft &aux (cd (namestring $current-directory))) - (declare (special $current-directory)) - (cond ((member ft '("nrlib" "daase") :test #'string=) - (if (eq BOOT::|$UserLevel| 'BOOT::|development|) - (cons cd $library-directory-list) - $library-directory-list)) - (t (adjoin cd - (adjoin (namestring (user-homedir-pathname)) $directory-list - :test #'string=) - :test #'string=)))) - -(defun $FILEP (&rest filearg) (make-full-namestring filearg)) +(defun $FILEP (&rest filearg) (boot::makeFullNamestring filearg)) (define-function '$OUTFILEP #'$FILEP) ;;temporary bogus def (defun $findfile (filespec filetypelist) (let ((file-name (if (consp filespec) (car filespec) filespec)) (file-type (if (consp filespec) (cadr filespec) nil))) (if file-type (push file-type filetypelist)) - (some #'(lambda (ft) (make-input-filename file-name ft)) + (some #'(lambda (ft) (boot::makeInputFilename file-name ft)) filetypelist))) ;; ($ERASE filearg) -> 0 if succeeds else 1 (defun $erase (&rest filearg) - (system (concat "rm -rf "(make-full-namestring filearg)))) + (system (concat "rm -rf "(boot::makeFullNamestring filearg)))) -;;(defun move-file (namestring1 namestring2) -;; (rename-file namestring1 namestring2)) - (defun $FCOPY (filespec1 filespec2) - (let ((name1 (make-full-namestring filespec1)) - (name2 (make-full-namestring filespec2))) + (let ((name1 (boot::makeFullNamestring filespec1)) + (name2 (boot::makeFullNamestring filespec2))) (if (library-file name1) (copy-lib-directory name1 name2) (copy-file name1 name2)))) @@ -4836,7 +4801,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ;;%% next form is used because $FINDFILE seems to screw up ;;%% sometimes. The stream is opened and closed several times ;;%% in case the filemode has changed during editing. - (SETQ EDINFILE (make-input-filename INFILE)) + (SETQ EDINFILE (boot::makeInputFilename INFILE)) (SETQ INPUTSTREAM (DEFSTREAM EDINFILE 'INPUT)) (|sayBrightly| (LIST " editing file" '|%b| (|namestring| EDINFILE) '|%d|)) @@ -4864,7 +4829,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size ;; next is done in case the diskmode changed (SHUT INPUTSTREAM) )) ;;(SETQ INFILE (|pathname| (IFCAR ($LISTFILE INFILE)))) - (SETQ INFILE (vmlisp::make-input-filename INFILE)) + (SETQ INFILE (boot::makeInputFilename INFILE)) (MAKEPROP /FN 'DEFLOC (CONS RECNO INFILE)) (SETQ oft (|object2Identifier| (UPCASE (|pathnameType| INFILE)))) @@ -4952,7 +4917,7 @@ terminals and empty or at-end files. In Common Lisp, we must assume record size (DEFUN /LOCATE (FN KEY INFILE INITRECNO) (PROG (FT RECNO KEYLENGTH LN) (if (AND (NOT (eq 'FROMWRITEUPDATE (|pathnameName| INFILE))) - (NOT (make-input-filename INFILE))) + (NOT (boot::makeInputFilename INFILE))) (RETURN NIL)) (SETQ FT (UPCASE (|object2Identifier| (|pathnameType| INFILE)))) (SETQ KEYLENGTH (STRINGLENGTH KEY))