diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 159e5e9..a8955dd 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -726,6 +726,7 @@ While not using the ``dollar'' convention this variable is still ``global''. (defvar |$InteractiveMode| t) @ + \defunsec{ncTopLevel}{Top-level read-parse-eval-print loop} Top-level read-parse-eval-print loop for the interpreter. Uses the Bill Burge's parser. @@ -1130,17 +1131,12 @@ This is used to hande {\tt )lisp} top level commands \defunsec{get-current-directory}{Get the current directory} <>= -#+:cmu -(defun get-current-directory () - "Get the current directory" - (namestring (extensions::default-directory))) - -#+(or :akcl :gcl) (defun get-current-directory () "Get the current directory" (namestring (truename ""))) @ + \defunsec{make-absolute-filename}{Prepend the absolute path to a filename} Prefix a filename with the {\bf AXIOM} shell variable. \usesdollar{make-absolute-filename}{spadroot} @@ -12688,6 +12684,28 @@ o )read rc)) @ + +\defun{updateSourceFiles}{updateSourceFiles} +\calls{updateSourceFiles}{pathname} +\calls{updateSourceFiles}{pathnameName} +\calls{updateSourceFiles}{pathnameType} +\calls{updateSourceFiles}{make-input-filename} +\calls{updateSourceFiles}{member} +\calls{updateSourceFiles}{pathnameTypeId} +\calls{updateSourceFiles}{insert} +\usesdollar{updateSourceFiles}{sourceFiles} +<>= +(defun |updateSourceFiles| (arg) + (declare (special |$sourceFiles|)) + (setq arg (|pathname| arg)) + (setq arg (|pathname| (list (|pathnameName| arg) (|pathnameType| arg) "*"))) + (when (and (make-input-filename arg) + (|member| (|pathnameTypeId| arg) '(boot lisp meta))) + (setq |$sourceFiles| (|insert| arg |$sourceFiles|))) + arg) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{fin help page} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -30417,6 +30435,108 @@ database format. @ \chapter{Special Lisp Functions} +\section{Filename Handling} +This code implements the Common Lisp pathname functions for +Lisp/VM. On VM, a filename is 3-list consisting of the filename, +filetype and filemode. We also UPCASE everything. + +\defun{namestring}{namestring} +\calls{namestring}{pathname} +<>= +(defun |namestring| (arg) + (namestring (|pathname| arg))) + +@ + +\defun{pathnameName}{pathnameName} +\calls{pathnameName}{pathname} +<>= +(defun |pathnameName| (arg) + (pathname-name (|pathname| arg))) + +@ + +\defun{pathnameType}{pathnameType} +\calls{pathnameType}{pathname} +<>= +(defun |pathnameType| (arg) + (pathname-type (|pathname| arg))) + +@ + +\defun{pathnameTypeId}{pathnameTypeId} +\calls{pathnameTypeId}{upcase} +\calls{pathnameTypeId}{object2Identifier} +\calls{pathnameTypeId}{pathnameType} +<>= +(defun |pathnameTypeId| (arg) + (upcase (|object2Identifier| (|pathnameType| arg)))) + +@ + +\defun{mergePathnames}{mergePathnames} +\calls{mergePathnames}{pathnameName} +\calls{mergePathnames}{nequal} +\calls{mergePathnames}{pathnameType} +\calls{mergePathnames}{pathnameDirectory} +<>= +(defun |mergePathnames| (a b) + (let (fn ft fm) + (cond + ((string= (setq fn (|pathnameName| a)) "*") b) + ((nequal fn (|pathnameName| b)) a) + ((string= (setq ft (|pathnameType| a)) "*") b) + ((nequal ft (|pathnameType| b)) a) + ((equal (setq fm (|pathnameDirectory| a)) (list "*" )) b) + (t a)))) + +@ + +\defun{pathnameDirectory}{pathnameDirectory} +\calls{pathnameDirectory}{pathname} +<>= +(defun |pathnameDirectory| (arg) + (namestring (make-pathname :directory (pathname-directory (|pathname| arg))))) + +@ + +\defun{pathname}{Axiom pathnames} +\calls{pathname}{pairp} +\calls{pathname}{pathname} +\calls{pathname}{make-filename} +<>= +(defun |pathname| (p) + (cond + ((null p) p) + ((pathnamep p) p) + ((null (pairp p)) (pathname p)) + (t + (when (> (|#| p) 2) (setq p (cons (elt p 0) (cons (elt p 1) nil)))) + (pathname (apply #'make-filename p))))) + +@ + +\defun{makePathname}{makePathname} +\calls{makePathname}{pathname} +\calls{makePathname}{object2String} +<>= +(defun |makePathname| (name type dir) + (declare (ignore dir)) + (|pathname| (list (|object2String| name) (|object2String| type)))) + +@ + +\defun{deleteFile}{Delete a file} +\calls{deleteFile}{erase} +\calls{deleteFile}{pathname} +\usesdollar{deleteFile}{erase} +<>= +(defun |deleteFile| (arg) + (declare (special $erase)) + ($erase (|pathname| arg))) + +@ + \defun{wrap}{wrap} \calls{wrap}{pairp} \calls{wrap}{lotsof} @@ -30438,7 +30558,6 @@ database format. @ - \defun{lotsof}{lotsof} <>= (defun lotsof (&rest items) @@ -31258,6 +31377,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -31564,10 +31684,12 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> <> +<> <> <> <> @@ -31579,6 +31701,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> +<> <> <> <> @@ -31641,6 +31764,11 @@ See Steele Common Lisp 1990 pp305-307 <> <> +<> +<> +<> +<> +<> <> <> <> @@ -31952,6 +32080,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> diff --git a/changelog b/changelog index 6b891a8..a01fafc 100644 --- a/changelog +++ b/changelog @@ -1,4 +1,10 @@ -20100118 tpd src/axiom-website/patches.html 20100118.01.tpd.patch +20100118 tpd src/axiom-website/patches.html 20100118.03.tpd.patch +20100118 tpd src/interp/vmlisp.lisp.pamphlet update sourceFileList with INPUT +20100118 tpd src/interp/pathname.lisp removed +20100118 tpd src/interp/lisplib.lisp move functions from pathname.lisp +20100118 tpd src/interp/Makefile merge and remove pathname.lisp +20100118 tpd books/bookvol5 merge and remove pathname.lisp +20100118 tpd src/axiom-website/patches.html 20100118.02.tpd.patch 20100118 tpd src/input/Makefile add ackermann 20100118 tpd src/input/ackermann.input test caching of functions 20100118 tpd src/axiom-website/patches.html 20100118.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 5a06c43..3570a77 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2386,5 +2386,7 @@ books/bookvol5 merge and remove i-toplev
books/bookvol5 merge and remove i-syscmd
20100118.02.tpd.patch src/input/ackermann.input test caching of functions
+20100118.03.tpd.patch +books/bookvol5 merge and remove pathname.lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index b1fd836..a6a9d8d 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -171,7 +171,7 @@ OBJS= ${OUT}/vmlisp.${O} \ ${OUT}/nrunfast.${O} \ ${OUT}/nrungo.${O} ${OUT}/nrunopt.${O} \ ${OUT}/nruntime.${O} \ - ${OUT}/packtran.${O} ${OUT}/pathname.${O} \ + ${OUT}/packtran.${O} \ ${OUT}/pf2sex.${O} \ ${OUT}/posit.${O} \ ${OUT}/ptrees.${O} ${OUT}/ptrop.${O} \ @@ -2849,30 +2849,6 @@ ${MID}/package.lisp: ${IN}/package.lisp.pamphlet @ -\subsection{pathname.lisp} -<>= -${OUT}/pathname.${O}: ${MID}/pathname.lisp - @ echo 136 making ${OUT}/pathname.${O} from ${MID}/pathname.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/pathname.lisp"' \ - ':output-file "${OUT}/pathname.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/pathname.lisp"' \ - ':output-file "${OUT}/pathname.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/pathname.lisp: ${IN}/pathname.lisp.pamphlet - @ echo 137 making ${MID}/pathname.lisp from \ - ${IN}/pathname.lisp.pamphlet - @ (cd ${MID} ; \ - ${TANGLE} ${IN}/pathname.lisp.pamphlet >pathname.lisp ) - -@ - \subsection{regress.lisp} <>= ${OUT}/regress.${O}: ${MID}/regress.${LISP} @@ -4148,9 +4124,6 @@ clean: <> <> -<> -<> - <> <> diff --git a/src/interp/lisplib.lisp.pamphlet b/src/interp/lisplib.lisp.pamphlet index a673cfb..a84f29b 100644 --- a/src/interp/lisplib.lisp.pamphlet +++ b/src/interp/lisplib.lisp.pamphlet @@ -12,6 +12,24 @@ <<*>>= (IN-PACKAGE "BOOT" ) +;isExistingFile f == +;-- p := pathname f +; --member(p,$existingFiles) => true +; if MAKE_-INPUT_-FILENAME f +; then +; --$existingFiles := [p,:$existingFiles] +; true +; else false + +(DEFUN |isExistingFile| (|f|) + (COND ((MAKE-INPUT-FILENAME |f|) 'T) ('T NIL))) + +;isSystemDirectory dir == EVERY(function CHAR_=,$SPADROOT,dir) + +(DEFUN |isSystemDirectory| (|dir|) + (declare (special $SPADROOT)) + (EVERY (|function| CHAR=) $SPADROOT |dir|)) + ;--% Standard Library Creation Functions ; ;readLib(fn,ft) == readLib1(fn,ft,"*") @@ -657,6 +675,131 @@ (REMPROP |name| 'LOADED) (SETF (SYMBOL-FUNCTION |name|) (|mkAutoLoad| |name| |name|)))) +;getFunctionSourceFile fun == +; null (f := getFunctionSourceFile1 fun) => NIL +; if MAKE_-INPUT_-FILENAME(f) then updateSourceFiles f +; f + +(DEFUN |getFunctionSourceFile| (|fun|) + (PROG (|f|) + (RETURN + (COND + ((NULL (SPADLET |f| (|getFunctionSourceFile1| |fun|))) NIL) + ('T + (COND ((MAKE-INPUT-FILENAME |f|) (|updateSourceFiles| |f|))) + |f|))))) + +;getFunctionSourceFile1 fun == +; -- returns NIL or [fn,ft,fm] +; (file := KDR GET(fun,'DEFLOC)) => pathname file +; null ((fileinfo := FUNLOC fun) or +; (fileinfo := FUNLOC unabbrev fun)) => +; u := bootFind fun => getFunctionSourceFile1 SETQ($FUNCTION,INTERN u) +; NIL +; 3 = #fileinfo => +; [fn,ft,$FUNCTION] := fileinfo +; newMKINFILENAM pathname [fn,ft] +; [fn,$FUNCTION] := fileinfo +; newMKINFILENAM pathname [fn] + +(DEFUN |getFunctionSourceFile1| (|fun|) + (PROG (|file| |fileinfo| |u| |ft| |fn|) + (declare (special $FUNCTION)) + (RETURN + (COND + ((SPADLET |file| (KDR (GETL |fun| 'DEFLOC))) + (|pathname| |file|)) + ((NULL (OR (SPADLET |fileinfo| (FUNLOC |fun|)) + (SPADLET |fileinfo| (FUNLOC (|unabbrev| |fun|))))) + (COND + ((SPADLET |u| (|bootFind| |fun|)) + (|getFunctionSourceFile1| (SETQ $FUNCTION (INTERN |u|)))) + ('T NIL))) + ((EQL 3 (|#| |fileinfo|)) (SPADLET |fn| (CAR |fileinfo|)) + (SPADLET |ft| (CADR |fileinfo|)) + (SPADLET $FUNCTION (CADDR |fileinfo|)) + (|newMKINFILENAM| (|pathname| (CONS |fn| (CONS |ft| NIL))))) + ('T (SPADLET |fn| (CAR |fileinfo|)) + (SPADLET $FUNCTION (CADR |fileinfo|)) + (|newMKINFILENAM| (|pathname| (CONS |fn| NIL)))))))) + +;_/MKINFILENAM(infile) == CATCH('FILNAM, newMKINFILENAM infile) + +(DEFUN /MKINFILENAM (|infile|) + (CATCH 'FILNAM (|newMKINFILENAM| |infile|))) + +;newMKINFILENAM(infile) == +; NULL infile => nil +; file := infile := pathname infile +; repeat +; fn := pathnameName file +; nfile := $FINDFILE (file,$sourceFileTypes) +; null nfile => +; nfile := file +; if fn = '"*" or fn = '"NIL" then sayKeyedMsg("S2IL0016",NIL) +; else sayKeyedMsg("S2IL0003",[namestring file]) +; ans := queryUserKeyedMsg("S2IL0017",NIL) +; if (SIZE(ans) > 0) and ('")" = SUBSTRING(ans,0,1)) then n := 2 +; else n := 1 +; nfn := UPCASE STRING2ID_-N(ans,n) +; (nfn = 0) or (nfn = 'QUIT) => +; sayKeyedMsg("S2IL0018",NIL) +; THROW('FILENAM,NIL) +; nfn = 'CREATE => return 'fromThisLoop +; file := pathname ans +; return 'fromThisLoop +; if nfile then pathname nfile +; else NIL + +(DEFUN |newMKINFILENAM| (|infile|) + (PROG (|fn| |nfile| |ans| |n| |nfn| |file|) + (declare (special |$sourceFileTypes| $FINDFILE)) + (RETURN + (SEQ (COND + ((NULL |infile|) NIL) + ('T + (SPADLET |file| (SPADLET |infile| (|pathname| |infile|))) + (DO () (NIL NIL) + (SEQ (EXIT (PROGN + (SPADLET |fn| (|pathnameName| |file|)) + (SPADLET |nfile| + ($FINDFILE |file| + |$sourceFileTypes|)) + (COND + ((NULL |nfile|) (SPADLET |nfile| |file|) + (COND + ((OR + (BOOT-EQUAL |fn| (MAKESTRING "*")) + (BOOT-EQUAL |fn| + (MAKESTRING "NIL"))) + (|sayKeyedMsg| 'S2IL0016 NIL)) + ('T + (|sayKeyedMsg| 'S2IL0003 + (CONS (|namestring| |file|) NIL)))) + (SPADLET |ans| + (|queryUserKeyedMsg| 'S2IL0017 + NIL)) + (COND + ((AND (> (SIZE |ans|) 0) + (BOOT-EQUAL (MAKESTRING ")") + (SUBSTRING |ans| 0 1))) + (SPADLET |n| 2)) + ('T (SPADLET |n| 1))) + (SPADLET |nfn| + (UPCASE + (STRING2ID-N |ans| |n|))) + (COND + ((OR (EQL |nfn| 0) + (BOOT-EQUAL |nfn| 'QUIT)) + (|sayKeyedMsg| 'S2IL0018 NIL) + (THROW 'FILENAM NIL)) + ((BOOT-EQUAL |nfn| 'CREATE) + (RETURN '|fromThisLoop|)) + ('T + (SPADLET |file| (|pathname| |ans|))))) + ('T (RETURN '|fromThisLoop|))))))) + (COND (|nfile| (|pathname| |nfile|)) ('T NIL)))))))) + ;--% Compilation ; ;compileConstructorLib(l,op,editFlag,traceFlag) == diff --git a/src/interp/pathname.lisp.pamphlet b/src/interp/pathname.lisp.pamphlet deleted file mode 100644 index c548b67..0000000 --- a/src/interp/pathname.lisp.pamphlet +++ /dev/null @@ -1,293 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp pathname.lisp} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -<<*>>= -(IN-PACKAGE "BOOT" ) - -;-- This file implements the Common Lisp pathname functions for -;-- Lisp/VM. On VM, a filename is 3-list consisting of the filename, -;-- filetype and filemode. We also UPCASE everything. -; -;-- This file also contains some other VM specific functions for -;-- dealing with files. -; -;--% Common Lisp Pathname Functions -; -;pathname? p == p=[] or PATHNAMEP p - -(DEFUN |pathname?| (|p|) (OR (NULL |p|) (PATHNAMEP |p|))) - -;pathname p == -; p = [] => p -; PATHNAMEP p => p -; not PAIRP p => PATHNAME p -; if #p>2 then p:=[p.0,p.1] -; PATHNAME APPLY(FUNCTION MAKE_-FILENAME, p) - -(DEFUN |pathname| (|p|) - (COND - ((NULL |p|) |p|) - ((PATHNAMEP |p|) |p|) - ((NULL (PAIRP |p|)) (PATHNAME |p|)) - ('T - (COND - ((> (|#| |p|) 2) - (SPADLET |p| (CONS (ELT |p| 0) (CONS (ELT |p| 1) NIL))))) - (PATHNAME (APPLY #'MAKE-FILENAME |p|))))) - -;namestring p == NAMESTRING pathname p - -(DEFUN |namestring| (|p|) (NAMESTRING (|pathname| |p|))) - -;pathnameName p == PATHNAME_-NAME pathname p - -(DEFUN |pathnameName| (|p|) (PATHNAME-NAME (|pathname| |p|))) - -;pathnameType p == PATHNAME_-TYPE pathname p - -(DEFUN |pathnameType| (|p|) (PATHNAME-TYPE (|pathname| |p|))) - -;pathnameTypeId p == UPCASE object2Identifier pathnameType p - -(DEFUN |pathnameTypeId| (|p|) - (UPCASE (|object2Identifier| (|pathnameType| |p|)))) - -;pathnameDirectory p == -; NAMESTRING MAKE_-PATHNAME(KEYWORD'DIRECTORY,PATHNAME_-DIRECTORY pathname p) - -(DEFUN |pathnameDirectory| (|p|) - (NAMESTRING - (MAKE-PATHNAME :DIRECTORY (PATHNAME-DIRECTORY (|pathname| |p|))))) - -;deleteFile f == _$ERASE pathname f - -(DEFUN |deleteFile| (|f|) - (declare (special $ERASE)) - ($ERASE (|pathname| |f|))) - -;isExistingFile f == -;-- p := pathname f -; --member(p,$existingFiles) => true -; if MAKE_-INPUT_-FILENAME f -; then -; --$existingFiles := [p,:$existingFiles] -; true -; else false - -(DEFUN |isExistingFile| (|f|) - (COND ((MAKE-INPUT-FILENAME |f|) 'T) ('T NIL))) - -;--% Scratchpad II File Name Functions -; -;makePathname(name,type,dir) == -; -- Common Lisp version of this will have to be written -; -- using MAKE-PATHNAME and the optional args. -; pathname [object2String name,object2String type] - -(DEFUN |makePathname| (|name| |type| |dir|) - (declare (ignore |dir|)) - (|pathname| - (CONS (|object2String| |name|) - (CONS (|object2String| |type|) NIL)))) - -;mergePathnames(a,b) == -; (fn := pathnameName(a)) = '"*" => b -; fn ^= pathnameName(b) => a -; (ft := pathnameType(a)) = '"*" => b -; ft ^= pathnameType(b) => a -; (fm := pathnameDirectory(a)) = ['"*"] => b -; a - -(DEFUN |mergePathnames| (|a| |b|) - (PROG (|fn| |ft| |fm|) - (RETURN - (COND - ((BOOT-EQUAL (SPADLET |fn| (|pathnameName| |a|)) - (MAKESTRING "*")) - |b|) - ((NEQUAL |fn| (|pathnameName| |b|)) |a|) - ((BOOT-EQUAL (SPADLET |ft| (|pathnameType| |a|)) - (MAKESTRING "*")) - |b|) - ((NEQUAL |ft| (|pathnameType| |b|)) |a|) - ((BOOT-EQUAL (SPADLET |fm| (|pathnameDirectory| |a|)) - (CONS (MAKESTRING "*") NIL)) - |b|) - ('T |a|))))) - -;isSystemDirectory dir == EVERY(function CHAR_=,$SPADROOT,dir) - -(DEFUN |isSystemDirectory| (|dir|) - (declare (special $SPADROOT)) - (EVERY (|function| CHAR=) $SPADROOT |dir|)) - -;-- the next function is an improved version of the one in DEBUG LISP -; -;_/MKINFILENAM(infile) == CATCH('FILNAM, newMKINFILENAM infile) - -(DEFUN /MKINFILENAM (|infile|) - (CATCH 'FILNAM (|newMKINFILENAM| |infile|))) - -;SETANDFILEQ($sourceFileTypes,'(INPUT SPAD BOOT LISP LISP370 META)) - -(SETANDFILEQ |$sourceFileTypes| (QUOTE (INPUT SPAD BOOT LISP LISP370 META))) - - -;newMKINFILENAM(infile) == -; NULL infile => nil -; file := infile := pathname infile -; repeat -; fn := pathnameName file -; nfile := $FINDFILE (file,$sourceFileTypes) -; null nfile => -; nfile := file -; if fn = '"*" or fn = '"NIL" then sayKeyedMsg("S2IL0016",NIL) -; else sayKeyedMsg("S2IL0003",[namestring file]) -; ans := queryUserKeyedMsg("S2IL0017",NIL) -; if (SIZE(ans) > 0) and ('")" = SUBSTRING(ans,0,1)) then n := 2 -; else n := 1 -; nfn := UPCASE STRING2ID_-N(ans,n) -; (nfn = 0) or (nfn = 'QUIT) => -; sayKeyedMsg("S2IL0018",NIL) -; THROW('FILENAM,NIL) -; nfn = 'CREATE => return 'fromThisLoop -; file := pathname ans -; return 'fromThisLoop -; if nfile then pathname nfile -; else NIL - -(DEFUN |newMKINFILENAM| (|infile|) - (PROG (|fn| |nfile| |ans| |n| |nfn| |file|) - (declare (special |$sourceFileTypes| $FINDFILE)) - (RETURN - (SEQ (COND - ((NULL |infile|) NIL) - ('T - (SPADLET |file| (SPADLET |infile| (|pathname| |infile|))) - (DO () (NIL NIL) - (SEQ (EXIT (PROGN - (SPADLET |fn| (|pathnameName| |file|)) - (SPADLET |nfile| - ($FINDFILE |file| - |$sourceFileTypes|)) - (COND - ((NULL |nfile|) (SPADLET |nfile| |file|) - (COND - ((OR - (BOOT-EQUAL |fn| (MAKESTRING "*")) - (BOOT-EQUAL |fn| - (MAKESTRING "NIL"))) - (|sayKeyedMsg| 'S2IL0016 NIL)) - ('T - (|sayKeyedMsg| 'S2IL0003 - (CONS (|namestring| |file|) NIL)))) - (SPADLET |ans| - (|queryUserKeyedMsg| 'S2IL0017 - NIL)) - (COND - ((AND (> (SIZE |ans|) 0) - (BOOT-EQUAL (MAKESTRING ")") - (SUBSTRING |ans| 0 1))) - (SPADLET |n| 2)) - ('T (SPADLET |n| 1))) - (SPADLET |nfn| - (UPCASE - (STRING2ID-N |ans| |n|))) - (COND - ((OR (EQL |nfn| 0) - (BOOT-EQUAL |nfn| 'QUIT)) - (|sayKeyedMsg| 'S2IL0018 NIL) - (THROW 'FILENAM NIL)) - ((BOOT-EQUAL |nfn| 'CREATE) - (RETURN '|fromThisLoop|)) - ('T - (SPADLET |file| (|pathname| |ans|))))) - ('T (RETURN '|fromThisLoop|))))))) - (COND (|nfile| (|pathname| |nfile|)) ('T NIL)))))))) - -;getFunctionSourceFile fun == -; null (f := getFunctionSourceFile1 fun) => NIL -; if MAKE_-INPUT_-FILENAME(f) then updateSourceFiles f -; f - -(DEFUN |getFunctionSourceFile| (|fun|) - (PROG (|f|) - (RETURN - (COND - ((NULL (SPADLET |f| (|getFunctionSourceFile1| |fun|))) NIL) - ('T - (COND ((MAKE-INPUT-FILENAME |f|) (|updateSourceFiles| |f|))) - |f|))))) - -;getFunctionSourceFile1 fun == -; -- returns NIL or [fn,ft,fm] -; (file := KDR GET(fun,'DEFLOC)) => pathname file -; null ((fileinfo := FUNLOC fun) or -; (fileinfo := FUNLOC unabbrev fun)) => -; u := bootFind fun => getFunctionSourceFile1 SETQ($FUNCTION,INTERN u) -; NIL -; 3 = #fileinfo => -; [fn,ft,$FUNCTION] := fileinfo -; newMKINFILENAM pathname [fn,ft] -; [fn,$FUNCTION] := fileinfo -; newMKINFILENAM pathname [fn] - -(DEFUN |getFunctionSourceFile1| (|fun|) - (PROG (|file| |fileinfo| |u| |ft| |fn|) - (declare (special $FUNCTION)) - (RETURN - (COND - ((SPADLET |file| (KDR (GETL |fun| 'DEFLOC))) - (|pathname| |file|)) - ((NULL (OR (SPADLET |fileinfo| (FUNLOC |fun|)) - (SPADLET |fileinfo| (FUNLOC (|unabbrev| |fun|))))) - (COND - ((SPADLET |u| (|bootFind| |fun|)) - (|getFunctionSourceFile1| (SETQ $FUNCTION (INTERN |u|)))) - ('T NIL))) - ((EQL 3 (|#| |fileinfo|)) (SPADLET |fn| (CAR |fileinfo|)) - (SPADLET |ft| (CADR |fileinfo|)) - (SPADLET $FUNCTION (CADDR |fileinfo|)) - (|newMKINFILENAM| (|pathname| (CONS |fn| (CONS |ft| NIL))))) - ('T (SPADLET |fn| (CAR |fileinfo|)) - (SPADLET $FUNCTION (CADR |fileinfo|)) - (|newMKINFILENAM| (|pathname| (CONS |fn| NIL)))))))) - -;updateSourceFiles p == -; p := pathname p -; p := pathname [pathnameName p, pathnameType p, '"*"] -; if MAKE_-INPUT_-FILENAME p and pathnameTypeId p in '(BOOT LISP META) then -; $sourceFiles := insert(p, $sourceFiles) -; p - -;;; *** |updateSourceFiles| REDEFINED - -(DEFUN |updateSourceFiles| (|p|) - (declare (special |$sourceFiles|)) - (PROGN - (SPADLET |p| (|pathname| |p|)) - (SPADLET |p| - (|pathname| - (CONS (|pathnameName| |p|) - (CONS (|pathnameType| |p|) - (CONS (MAKESTRING "*") NIL))))) - (COND - ((AND (MAKE-INPUT-FILENAME |p|) - (|member| (|pathnameTypeId| |p|) '(BOOT LISP META))) - (SPADLET |$sourceFiles| (|insert| |p| |$sourceFiles|)))) - |p|)) - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 78f3f6f..f623d02 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -2734,7 +2734,7 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-val |$SmallInteger| '(|SmallInteger|) "???") (def-boot-val |$SmallIntegerOpt| '(|SmallInteger| . OPT) "???") (def-boot-val |$sourceFileTypes| - '(SPAD BOOT LISP LISP370 META) + '(INPUT SPAD BOOT LISP LISP370 META) "Interpreter>System.boot") (def-boot-val $SPAD nil "Is this Spad code?") (def-boot-var $SPAD_ERRORS "???")