diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/nlib.lisp | 37 | ||||
| -rw-r--r-- | src/interp/pathname.boot | 2 | ||||
| -rw-r--r-- | src/interp/sys-utility.boot | 18 | ||||
| -rw-r--r-- | src/interp/vmlisp.lisp | 6 |
4 files changed, 26 insertions, 37 deletions
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp index e94a77d9..7a69738f 100644 --- a/src/interp/nlib.lisp +++ b/src/interp/nlib.lisp @@ -50,8 +50,7 @@ (if (null stream) (if missing-file-error-flag (ERROR (format nil "Library ~s doesn't exist" - ;;(make-filename (cdr file) 'LISPLIB)) - (make-filename (cdr file) 'NIL))) + (|makeFilename| (cdr file) 'NIL))) NIL) (|makeLibstream| 'input fullname (get-index-table-from-stream stream) @@ -183,7 +182,7 @@ ;; filearg is filespec or 1, 2 or 3 ids ;; (RPACKFILE filearg) -- compiles code files and converts to compressed format (defun rpackfile (filespec) - (setq filespec (make-filename filespec)) + (setq filespec (|makeFilename| filespec)) (if (string= (pathname-type filespec) "NRLIB") (recompile-lib-file-if-necessary (concat (namestring filespec) "/code.lsp")) @@ -242,37 +241,9 @@ (mapcar #'string keys)) (putindextable ctable filearg)) -;; cms file operations -(defun make-filename (filearg &optional (filetype nil)) - (let ((filetype (if (symbolp filetype) - (symbol-name filetype) - filetype))) - (cond - ((pathnamep filearg) - (cond ((pathname-type filearg) (namestring filearg)) - (t (namestring (make-pathname :directory (pathname-directory filearg) - :name (pathname-name filearg) - :type filetype))))) - ;; Previously, given a filename containing "." and - ;; an extension this function would return filearg. MCD 23-8-95. - ((and (stringp filearg) (pathname-type filearg) (null filetype)) filearg) - ;; ((and (stringp filearg) - ;; (or (pathname-type filearg) (null filetype))) - ;; filearg) - ((and (stringp filearg) (stringp filetype) - (pathname-type filearg) - (string-equal (pathname-type filearg) filetype)) - filearg) - ((consp filearg) - (make-filename (car filearg) (or (cadr filearg) filetype))) - (t (if (stringp filetype) (setq filetype (intern filetype "BOOT"))) - (let ((ft (or (cdr (assoc filetype $filetype-table)) filetype))) - (if ft - (concatenate 'string (string filearg) "." (string ft)) - (string filearg))))))) (defun make-full-namestring (filearg &optional (filetype nil)) - (namestring (merge-pathnames (make-filename filearg filetype)))) + (namestring (merge-pathnames (|makeFilename| filearg filetype)))) (defun get-directory-list (ft) (let ((cd (get-current-directory))) @@ -288,7 +259,7 @@ (defun make-input-filename (filearg &optional (filetype nil)) (let* - ((filename (make-filename filearg filetype)) + ((filename (|makeFilename| filearg filetype)) (dirname (pathname-directory filename)) (ft (pathname-type filename)) (dirs (get-directory-list ft)) diff --git a/src/interp/pathname.boot b/src/interp/pathname.boot index 3dece48d..1a3bc6b3 100644 --- a/src/interp/pathname.boot +++ b/src/interp/pathname.boot @@ -51,7 +51,7 @@ pathname p == pathname? p => p p isnt [.,:.] => PATHNAME p if #p>2 then p:=[p.0,p.1] - PATHNAME apply(FUNCTION MAKE_-FILENAME, p) + PATHNAME apply(function makeFilename, p) namestring p == null p => nil diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot index d3a8c18d..6c7afa17 100644 --- a/src/interp/sys-utility.boot +++ b/src/interp/sys-utility.boot @@ -427,3 +427,21 @@ addCompilerOption(key,val) == st := outputTextFile strconc(libDirname val,'"/code.lsp") $compilerOptions := [['COMPILER_-OUTPUT_-STREAM,:st],:$compilerOptions] nil + +makeFilename(filearg,filetype==nil) == + if ident? filetype then + filetype := symbolName filetype + filePath? filearg => filePathString + filePathType filearg ~= nil => filearg + makeFilePath(directory <- filePathDirectory filearg, + name <- filePathName filearg, type <- filetype) + string? filearg and filePathType filearg ~= nil and filetype = nil => filearg + string? filearg and string? filetype and filePathType filearg ~= nil + and stringEq?(filePathType filearg,filetype) => filearg + filearg is [.,:.] => + makeFilename(first filearg,second filearg or filetype) + if string? filetype then + filetype := makeSymbol filetype + ft := rest symbolAssoc(filetype,$FILETYPE_-TABLE) or filetype + ft = nil => toString filearg + strconc(toString filearg,'".",toString ft) diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index a6a0aa3a..28602764 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -932,7 +932,7 @@ (declare (ignore width) (ignore recnum)) (cond ((numberp filespec) (make-synonym-stream '*standard-output*)) ((null filespec) (error "not handled yet")) - (t (open (make-filename filespec) :direction :output + (t (open (|makeFilename| filespec) :direction :output :if-exists :supersede)))) (defun MAKE-APPENDSTREAM (filespec &optional (width nil) (recnum 0)) @@ -941,7 +941,7 @@ (cond ((numberp filespec) (make-synonym-stream '*standard-output*)) ((null filespec) (error "make-appendstream: not handled yet")) - ('else (open (make-filename filespec) :direction :output + ('else (open (|makeFilename| filespec) :direction :output :if-exists :append :if-does-not-exist :create)))) (defun DEFIOSTREAM (stream-alist buffer-size char-position) @@ -954,7 +954,7 @@ ((OUTPUT O) (make-synonym-stream '*standard-output*)) ((INPUT I) (make-synonym-stream '*standard-input*))) (let ((strm (case mode - ((OUTPUT O) (open (make-filename filename) + ((OUTPUT O) (open (|makeFilename| filename) :direction :output)) ((INPUT I) (open (make-input-filename filename) :direction :input))))) |