Changeset 14176

Timestamp:

10/11/12 11:33:19 (12 years ago)

Author:

Mark Evenson

Message:

Refactor PATHNAME implementation details to tighten existing semantics.

None of this should change the behavior of CL:PATHNAME, but it
prepares for that in subsequent patches to address problems in merging
when the defaults points to a JAR-PATHNAME.

Fix COMPILE-FILE to work with source located in jar archive.

Moved Utilities.getFile() to instance method of Pathname which makes
more logical sense. Moved Utilities.getPathnameDirectory() to static
instance classes. These functions no longer merge their argument with
*DEFAULT-PATHNAME-DEFAULTS*, as this should be done explictly at a
higher level in the Lisp calling into Java abstraction.

RENAME-FILE no longer on namestrings, but instead use the result of
TRUENAME invocation, as namestrings will not always roundtrip
exactly back to PATHNAMES.

POPULATE-ZIP-FASL no longer forms its argumentes by merging paths,
instead using MAKE-PATHNAME with controlled defaults.

SYSTEM:NEXT-CLASSFILE-NAME and SYSTEM:COMPUTE-CLASSFILE-NAME changed
to NEXT-CLASSFILE and COMPUTE-CLASSFILE returning PATHNAME objects
rather than namestrings.

Compiler now dumps pathname in alternate form that preserves DEVICE
:UNSPECIFIC.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• Load.java (modified) (6 diffs)
• Pathname.java (modified) (13 diffs)
• Utilities.java (modified) (1 diff)
• compile-file.lisp (modified) (13 diffs)
• compiler-pass2.lisp (modified) (1 diff)
• directory.lisp (modified) (1 diff)
• dump-form.lisp (modified) (2 diffs)
• file_write_date.java (modified) (1 diff)
• probe_file.java (modified) (2 diffs)
• zip.java (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/Load.java ¶

@@ -141 +141 @@
             mergedPathname = Pathname.mergePathnames(pathname, pathnameDefaults);
         }
-
-        Pathname truename = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
+        Pathname loadableFile = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
+        Pathname truename = coercePathnameOrNull(Pathname.truename(loadableFile));
 
         if (truename == null || truename.equals(NIL)) {
@@ -194 +194 @@
             }
             truename = (Pathname)initTruename;
-        }
-        
+        } 
+        
         InputStream in = truename.getInputStream();
         Debug.assertTrue(in != null);
@@ -250 +250 @@
     static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
 
+    private static final Pathname coercePathnameOrNull(LispObject p) {
+        if (p == null) {
+            return null;
+        }
+        Pathname result = null;
+        try {
+            result = (Pathname)p;
+        } catch (Throwable t) { // XXX narrow me!
+            return null;
+        }
+        return result;
+    }
+        
+
     public static final LispObject loadSystemFile(final String filename,
                                                   boolean verbose,
@@ -268 +282 @@
         }
         URL url = null;
-        truename = findLoadableFile(mergedPathname);
-        final String COMPILE_FILE_TYPE = Lisp._COMPILE_FILE_TYPE_.symbolValue().getStringValue();
+        Pathname loadableFile = findLoadableFile(mergedPathname);
+        truename = coercePathnameOrNull(Pathname.truename(loadableFile));
+        
+        final String COMPILE_FILE_TYPE 
+          = Lisp._COMPILE_FILE_TYPE_.symbolValue().getStringValue();
+
         if (truename == null || truename.equals(NIL) || bootPath.equals(NIL)) {
             // Make an attempt to use the boot classpath
@@ -287 +305 @@
             if (!bootPath.equals(NIL)) {
                 Pathname urlPathname = new Pathname(url);
-                truename = findLoadableFile(urlPathname);
+                loadableFile = findLoadableFile(urlPathname);
+                truename = (Pathname)Pathname.truename(loadableFile);
                 if (truename == null) {
                     return error(new LispError("Failed to find loadable system file in boot classpath "
@@ -482 +501 @@
             Pathname truePathname = null;
             if (!truename.equals(NIL)) {
-                truePathname = new Pathname(((Pathname)truename).getNamestring());
+                if (truename instanceof Pathname) {
+                    truePathname = new Pathname((Pathname)truename);
+                } else if (truename instanceof AbstractString) {
+                    truePathname = new Pathname(truename.getStringValue());
+                } else {
+                    Debug.assertTrue(false);
+                }
                 String type = truePathname.type.getStringValue();
                 if (type.equals(Lisp._COMPILE_FILE_TYPE_.symbolValue(thread).getStringValue())

trunk/abcl/src/org/armedbear/lisp/Pathname.java ¶

@@ -1 @@
-/*
+/* 
  * Pathname.java
  *
@@ -1640 +1640 @@
                             if (file.isDirectory()) {
                                 if (arg2 != NIL) {
-                                    p = Utilities.getDirectoryPathname(file);
+                                    p = Pathname.getDirectoryPathname(file);
                                 } else {
                                     p = new Pathname(file.getAbsolutePath()); 
@@ -1916 +1916 @@
     }
 
-    private static final Primitive MERGE_PATHNAMES = new pf_merge_pathnames();
+    static final Primitive MERGE_PATHNAMES = new pf_merge_pathnames();
     @DocString(name="merge-pathnames",
                args="pathname &optional default-pathname default-version",
@@ -2115 +2115 @@
     }
 
+
     public static final LispObject truename(Pathname pathname) {
         return truename(pathname, false);
@@ -2135 +2136 @@
                                             boolean errorIfDoesNotExist) 
     {
+        if (pathname == null || pathname.equals(NIL)) {  // XXX duplicates code at the end of this longish function: figure out proper nesting of labels.
+            if (errorIfDoesNotExist) {
+                StringBuilder sb = new StringBuilder("The file ");
+                sb.append(pathname.princToString());
+                sb.append(" does not exist.");
+                return error(new FileError(sb.toString(), pathname));
+            }
+            return NIL;
+        }
         if (pathname instanceof LogicalPathname) {
             pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname);
@@ -2143 +2153 @@
         }
         if (!(pathname.isJar() || pathname.isURL())) {
-            pathname
+            Pathname result 
                 = mergePathnames(pathname,
                                  coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
                                  NIL);
-            final String namestring = pathname.getNamestring();
-            if (namestring == null) {
-                return error(new FileError("Pathname has no namestring: " 
-                                           + pathname.princToString(),
-                                           pathname));
-            }
-            
-            final File file = new File(namestring);
-            if (file.isDirectory()) {
-                return Utilities.getDirectoryPathname(file);
-            }
+            final File file = result.getFile();
             if (file.exists()) {
-                try {
-                    return new Pathname(file.getCanonicalPath());
-                } catch (IOException e) {
-                    return error(new FileError(e.getMessage(), pathname));
-                }
+                if (file.isDirectory()) {
+                    result = Pathname.getDirectoryPathname(file);
+                } else {
+                    try {
+                        result = new Pathname(file.getCanonicalPath());
+                    } catch (IOException e) {
+                        return error(new FileError(e.getMessage(), pathname));
+                    }
+                }
+                return result;
             }
         } else if (pathname.isURL()) {
@@ -2344 +2349 @@
             }
         } else {
-            File file = Utilities.getFile(this);
+            File file = getFile();
             try { 
                 result = new FileInputStream(file);
@@ -2361 +2366 @@
     public long getLastModified() {
         if (!(isJar() || isURL())) {
-            File f = Utilities.getFile(this);
+            File f = getFile();
             return f.lastModified();
         }
@@ -2453 +2458 @@
             }
                     
-            File file = Utilities.getFile(defaultedPathname);
+            File file = defaultedPathname.getFile();
             return file.mkdir() ? T : NIL;
         }
@@ -2462 +2467 @@
                args="filespec new-name",
                returns="defaulted-new-name, old-truename, new-truename",
-    doc="rename-file modifies the file system in such a way that the file indicated by FILESPEC is renamed to DEFAULTED-NEW-NAME.")
+               doc = "Modifies the file system in such a way that the file indicated by FILESPEC is renamed to DEFAULTED-NEW-NAME.\n"
+               + "\n"
+               + "Returns three values if successful. The primary value, DEFAULTED-NEW-NAME, is \n"
+               + "the resulting name which is composed of NEW-NAME with any missing components filled in by \n"
+               + "performing a merge-pathnames operation using filespec as the defaults. The secondary \n" 
+               + "value, OLD-TRUENAME, is the truename of the file before it was renamed. The tertiary \n"
+               + "value, NEW-TRUENAME, is the truename of the file after it was renamed.\n")
     private static class pf_rename_file extends Primitive {
         pf_rename_file() {
@@ -2469 +2480 @@
         @Override
         public LispObject execute(LispObject first, LispObject second) {
-            final Pathname original = (Pathname) truename(first, true);
-            final String originalNamestring = original.getNamestring();
+            Pathname oldPathname = coerceToPathname(first);
+            Pathname oldTruename = (Pathname) truename(oldPathname, true);
             Pathname newName = coerceToPathname(second);
             if (newName.isWild()) {
                 error(new FileError("Bad place for a wild pathname.", newName));
             }
-            if (original.isJar()) {
-                error(new FileError("Bad place for a jar pathname.", original));
+            if (oldTruename.isJar()) {
+                error(new FileError("Bad place for a jar pathname.", oldTruename));
             }
             if (newName.isJar()) {
                 error(new FileError("Bad place for a jar pathname.", newName));
             }
-            if (original.isURL()) {
-                error(new FileError("Bad place for a URL pathname.", original));
+            if (oldTruename.isURL()) {
+                error(new FileError("Bad place for a URL pathname.", oldTruename));
             }
             if (newName.isURL()) {
@@ -2488 +2499 @@
             }
                 
-            newName = mergePathnames(newName, original, NIL);
-            final String newNamestring;
-            if (newName instanceof LogicalPathname) {
-                newNamestring = LogicalPathname.translateLogicalPathname((LogicalPathname) newName).getNamestring();
-            } else {
-                newNamestring = newName.getNamestring();
-            }
-            if (originalNamestring != null && newNamestring != null) {
-                final File source = new File(originalNamestring);
-                final File destination = new File(newNamestring);
-                if (Utilities.isPlatformWindows) {
-                    if (destination.isFile()) {
-                        ZipCache.remove(destination);
-                        destination.delete();
-                    }
-                }
-                if (source.renameTo(destination)) { // Success!
-                        return LispThread.currentThread().setValues(newName, original,
-                                                                    truename(newName, true));
-                }
+            Pathname defaultedNewName = mergePathnames(newName, oldTruename, NIL);
+
+            File source = oldTruename.getFile();
+            File destination = null;
+            if (defaultedNewName instanceof LogicalPathname) {
+                destination = LogicalPathname.translateLogicalPathname((LogicalPathname)defaultedNewName)
+                    .getFile();
+            } else {
+                destination = defaultedNewName.getFile();
+            }
+            // By default, MSDOG doesn't allow one to remove files that are open.
+            if (Utilities.isPlatformWindows) {
+              if (destination.isFile()) {
+                ZipCache.remove(destination);
+                destination.delete();
+              }
+            }
+            if (source.renameTo(destination)) { // Success!
+              Pathname newTruename = (Pathname)truename(defaultedNewName, true);
+              return LispThread.currentThread().setValues(defaultedNewName, 
+                                                          oldTruename,
+                                                          newTruename);
             }
             return error(new FileError("Unable to rename "
-                                       + original.princToString()
+                                       + oldTruename.princToString()
                                        + " to " + newName.princToString()
-                                       + "."));
+                                       + ".",
+                                       oldTruename));
         }
     }
@@ -2656 +2670 @@
         return null; // Error
     }
+
+
+    File getFile() {
+        String namestring = getNamestring(); // XXX UNC pathnames currently have no namestring
+        if (namestring != null) {
+            return new File(namestring);
+        }
+        error(new FileError("Pathname has no namestring: " + princToString(),
+                        this));
+        // Not reached.
+        return null;
+    }
+    public static Pathname getDirectoryPathname(File file) {
+        try {
+            String namestring = file.getCanonicalPath();
+            if (namestring != null && namestring.length() > 0) {
+                if (namestring.charAt(namestring.length() - 1) != File.separatorChar) {
+                    namestring = namestring.concat(File.separator);
+                }
+            }
+            return new Pathname(namestring);
+        } catch (IOException e) {
+            error(new LispError(e.getMessage()));
+            // Not reached.
+            return null;
+        }
+    }
+
 }
 

trunk/abcl/src/org/armedbear/lisp/Utilities.java ¶

@@ -91 +91 @@
     }
 
-    public static File getFile(Pathname pathname)
-    {
-        return getFile(pathname,
-                       coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()));
-    }
-
-    public static File getFile(Pathname pathname, Pathname defaultPathname)
-
-    {
-        Pathname merged =
-            Pathname.mergePathnames(pathname, defaultPathname, NIL);
-        String namestring = merged.getNamestring();
-        if (namestring != null)
-            return new File(namestring);
-        error(new FileError("Pathname has no namestring: " + merged.princToString(),
-                             merged));
-        // Not reached.
-        return null;
-    }
-
-    public static Pathname getDirectoryPathname(File file)
-
-    {
-        try {
-            String namestring = file.getCanonicalPath();
-            if (namestring != null && namestring.length() > 0) {
-                if (namestring.charAt(namestring.length() - 1) != File.separatorChar)
-                    namestring = namestring.concat(File.separator);
-            }
-            return new Pathname(namestring);
-        }
-        catch (IOException e) {
-            error(new LispError(e.getMessage()));
-            // Not reached.
-            return null;
-        }
-    }
-
     public static ZipInputStream getZipInputStream(ZipFile zipfile,
                                                    String entryName) {

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp ¶

@@ +1 @@
+
 ;;; compile-file.lisp
 ;;;
@@ -54 +55 @@
   (%format nil "~A_0" (base-classname output-file-pathname)))
 
-(declaim (ftype (function (t) t) compute-classfile-name))
-(defun compute-classfile-name (n &optional (output-file-pathname
+(declaim (ftype (function (t) t) compute-classfile))
+(defun compute-classfile (n &optional (output-file-pathname
                                             *output-file-pathname*))
-  "Computes the name of the class file associated with number `n'."
+  "Computes the pathname of the class file associated with number `n'."
   (let ((name
          (sanitize-class-name
     (%format nil "~A_~D" (pathname-name output-file-pathname) n))))
-    (namestring (merge-pathnames (make-pathname :name name :type *compile-file-class-extension*)
-                                 output-file-pathname))))
+    (merge-pathnames (make-pathname :name name :type *compile-file-class-extension*)
+                                 output-file-pathname)))
 
 (defun sanitize-class-name (name)
@@ -75 +76 @@
   
 
-(declaim (ftype (function () t) next-classfile-name))
-(defun next-classfile-name ()
-  (compute-classfile-name (incf *class-number*)))
+(declaim (ftype (function () t) next-classfile))
+(defun next-classfile ()
+  (compute-classfile (incf *class-number*)))
 
 (defmacro report-error (&rest forms)
@@ -186 +187 @@
          (expr `(lambda () ,form))
          (saved-class-number *class-number*)
-         (classfile (next-classfile-name))
+         (classfile (next-classfile))
          (result
           (with-open-file
@@ -308 +309 @@
                  (jvm::with-saved-compiler-policy
                      (let* ((saved-class-number *class-number*)
-                            (classfile (next-classfile-name))
+                            (classfile (next-classfile))
                             (result
                              (with-open-file
@@ -451 +452 @@
     (let* ((expr (function-lambda-expression (macro-function name)))
            (saved-class-number *class-number*)
-           (classfile (next-classfile-name)))
+           (classfile (next-classfile)))
       (with-open-file
           (f classfile
@@ -491 +492 @@
                           ,@decls (block ,block-name ,@body)))
                  (saved-class-number *class-number*)
-                 (classfile (next-classfile-name))
+                 (classfile (next-classfile))
                  (internal-compiler-errors nil)
                  (result (with-open-file
@@ -637 +638 @@
 
 (defun populate-zip-fasl (output-file)
-  (let* ((type ;; Don't use ".zip", it'll result in an extension
-          ;;  with a dot, which is rejected by NAMESTRING
+  (let* ((type ;; Don't use ".zip", it'll result in an extension with
+               ;; a dot, which is rejected by NAMESTRING
           (%format nil "~A~A" (pathname-type output-file) "-zip"))
-         (zipfile (namestring
-                   (merge-pathnames (make-pathname :type type)
-                                    output-file)))
+         (output-file (if (logical-pathname-p output-file)
+                          (translate-logical-pathname output-file)
+                          output-file))
+         (zipfile 
+          (if (find :windows *features*)
+              (make-pathname :defaults output-file :type type)
+              (make-pathname :defaults output-file :type type
+                             :device :unspecific)))
          (pathnames nil)
-         (fasl-loader (namestring (merge-pathnames
-                                   (make-pathname :name (fasl-loader-classname)
-                                                  :type *compile-file-class-extension*)
-                                   output-file))))
+         (fasl-loader (make-pathname :defaults output-file
+                                     :name (fasl-loader-classname)
+                                     :type *compile-file-class-extension*)))
     (when (probe-file fasl-loader)
       (push fasl-loader pathnames))
     (dotimes (i *class-number*)
-      (let ((truename (probe-file (compute-classfile-name (1+ i)))))
+      (let ((truename (probe-file (compute-classfile (1+ i)))))
         (when truename
           (push truename pathnames)
@@ -669 +674 @@
               (push resource pathnames))))))
     (setf pathnames (nreverse (remove nil pathnames)))
-    (let ((load-file (merge-pathnames (make-pathname :type "_")
-                                      output-file)))
+    (let ((load-file (make-pathname :defaults output-file
+                                    :type "_")))
       (rename-file output-file load-file)
       (push load-file pathnames))
@@ -711 +716 @@
 (defvar *fasl-stream* nil)
 
+(defvar *debug-compile-from-stream* nil)
 (defun compile-from-stream (in output-file temp-file temp-file2
                             extract-toplevel-funcs-and-macros
@@ -723 +729 @@
          (start (get-internal-real-time))
          *fasl-uninterned-symbols*)
+    (setf *debug-compile-from-stream* 
+          (list :in in
+                :compile-file-pathname *compile-file-pathname*))
     (when *compile-verbose*
       (format t "; Compiling ~A ...~%" namestring))
@@ -849 +858 @@
                  do (write-line line out)))))
         (delete-file temp-file)
-        (remove-zip-cache-entry output-file) ;; Necessary under windows
+        (when (find :windows *features*)
+          (remove-zip-cache-entry output-file))
         (rename-file temp-file2 output-file)
 
@@ -871 +881 @@
            (when suffix
              (setq type (concatenate 'string type suffix)))
-           (merge-pathnames (make-pathname :type type)
-                            pathname)))
+           (make-pathname :type type :defaults pathname)))
     (unless (or (and (probe-file input-file)
                      (not (file-directory-p input-file)))

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp ¶

@@ -7556 +7556 @@
 (defmacro with-file-compilation (&body body)
   `(let ((*file-compilation* t)
-         (*pathnames-generator* #'sys::next-classfile-name))
+         (*pathnames-generator* #'sys::next-classfile))
      ,@body))
 

trunk/abcl/src/org/armedbear/lisp/directory.lisp ¶

@@ -118 +118 @@
                     (cond ((file-directory-p entry)
                            (when (pathname-match-p (file-namestring (pathname-as-file entry)) (file-namestring pathname))
-                             (push entry matching-entries)))
+                             (push (truename entry) matching-entries)))
                           ((pathname-match-p (or (file-namestring entry) "") (file-namestring pathname))
-                           (push entry matching-entries))))
+                           (push (truename entry) matching-entries))))
                   matching-entries))))
         ;; Not wild.

trunk/abcl/src/org/armedbear/lisp/dump-form.lisp ¶

@@ -176 +176 @@
     index))
 
+(declaim (ftype (function (pathname stream) t) dump-pathname))
+(defun dump-pathname (pathname stream)
+  (write-string "#P(" stream)
+  (write-string ":HOST " stream)
+  (dump-form (pathname-host pathname) stream)
+  (write-string " :DEVICE " stream)
+  (dump-form (pathname-device pathname) stream)
+  (write-string " :DIRECTORY " stream)
+  (dump-form (pathname-directory pathname) stream)
+  (write-string " :NAME " stream)
+  (dump-form (pathname-name pathname) stream)
+  (write-string " :TYPE " stream)
+  (dump-form (pathname-type pathname) stream)
+  (write-string " :VERSION " stream)
+  (dump-form (pathname-version pathname) stream)
+  (write-string ")" stream))
+
 (declaim (ftype (function (t stream) t) dump-object))
 (defun dump-object (object stream)
@@ -183 +200 @@
           ((stringp object)
            (%stream-output-object object stream))
+          ((pathnamep object)
+           (dump-pathname object stream))
           ((bit-vector-p object)
            (%stream-output-object object stream))

trunk/abcl/src/org/armedbear/lisp/file_write_date.java ¶

@@ -52 +52 @@
         if (pathname.isWild())
             error(new FileError("Bad place for a wild pathname.", pathname));
-        long lastModified = pathname.getLastModified();
+        Pathname defaultedPathname = (Pathname) Pathname.MERGE_PATHNAMES.execute(pathname);
+        long lastModified = defaultedPathname.getLastModified();
         if (lastModified == 0)
             return NIL;

trunk/abcl/src/org/armedbear/lisp/probe_file.java ¶

@@ -75 +75 @@
             if (pathname.isWild())
                 error(new FileError("Bad place for a wild pathname.", pathname));
-            File file = Utilities.getFile(pathname);
-            return file.isDirectory() ? Utilities.getDirectoryPathname(file) : NIL;
+            Pathname defaultedPathname = (Pathname)Pathname.MERGE_PATHNAMES.execute(pathname);
+            File file = defaultedPathname.getFile();
+            return file.isDirectory() ? Pathname.getDirectoryPathname(file) : NIL;
         }
     };
@@ -86 +87 @@
     {
         @Override
-        public LispObject execute(LispObject arg)
+        public LispObject execute(LispObject arg)  // XXX Should this merge with defaults?
         {
             Pathname pathname = coerceToPathname(arg);
             if (pathname.isWild())
                 error(new FileError("Bad place for a wild pathname.", pathname));
-            File file = Utilities.getFile(pathname);
+            File file = pathname.getFile();
             return file.isDirectory() ? T : NIL;
         }

trunk/abcl/src/org/armedbear/lisp/zip.java ¶

@@ -216 +216 @@
             final Pathname source = Lisp.coerceToPathname(key);
             final Pathname destination = Lisp.coerceToPathname(value);
-            final File file = Utilities.getFile(source);
+            final File file = source.getFile();
             try {
                 String jarEntry = destination.getNamestring();