Changeset 14176


Ignore:
Timestamp:
10/11/12 11:33:19 (8 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:
10 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Load.java

    r14029 r14176  
    141141            mergedPathname = Pathname.mergePathnames(pathname, pathnameDefaults);
    142142        }
    143 
    144         Pathname truename = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
     143        Pathname loadableFile = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
     144        Pathname truename = coercePathnameOrNull(Pathname.truename(loadableFile));
    145145
    146146        if (truename == null || truename.equals(NIL)) {
     
    194194            }
    195195            truename = (Pathname)initTruename;
    196         }
    197        
     196        } 
     197       
    198198        InputStream in = truename.getInputStream();
    199199        Debug.assertTrue(in != null);
     
    250250    static final LispObject COMPILE_FILE_INIT_FASL_TYPE = new SimpleString("_");
    251251
     252    private static final Pathname coercePathnameOrNull(LispObject p) {
     253        if (p == null) {
     254            return null;
     255        }
     256        Pathname result = null;
     257        try {
     258            result = (Pathname)p;
     259        } catch (Throwable t) { // XXX narrow me!
     260            return null;
     261        }
     262        return result;
     263    }
     264       
     265
    252266    public static final LispObject loadSystemFile(final String filename,
    253267                                                  boolean verbose,
     
    268282        }
    269283        URL url = null;
    270         truename = findLoadableFile(mergedPathname);
    271         final String COMPILE_FILE_TYPE = Lisp._COMPILE_FILE_TYPE_.symbolValue().getStringValue();
     284        Pathname loadableFile = findLoadableFile(mergedPathname);
     285        truename = coercePathnameOrNull(Pathname.truename(loadableFile));
     286       
     287        final String COMPILE_FILE_TYPE
     288          = Lisp._COMPILE_FILE_TYPE_.symbolValue().getStringValue();
     289
    272290        if (truename == null || truename.equals(NIL) || bootPath.equals(NIL)) {
    273291            // Make an attempt to use the boot classpath
     
    287305            if (!bootPath.equals(NIL)) {
    288306                Pathname urlPathname = new Pathname(url);
    289                 truename = findLoadableFile(urlPathname);
     307                loadableFile = findLoadableFile(urlPathname);
     308                truename = (Pathname)Pathname.truename(loadableFile);
    290309                if (truename == null) {
    291310                    return error(new LispError("Failed to find loadable system file in boot classpath "
     
    482501            Pathname truePathname = null;
    483502            if (!truename.equals(NIL)) {
    484                 truePathname = new Pathname(((Pathname)truename).getNamestring());
     503                if (truename instanceof Pathname) {
     504                    truePathname = new Pathname((Pathname)truename);
     505                } else if (truename instanceof AbstractString) {
     506                    truePathname = new Pathname(truename.getStringValue());
     507                } else {
     508                    Debug.assertTrue(false);
     509                }
    485510                String type = truePathname.type.getStringValue();
    486511                if (type.equals(Lisp._COMPILE_FILE_TYPE_.symbolValue(thread).getStringValue())
  • trunk/abcl/src/org/armedbear/lisp/Pathname.java

    r14155 r14176  
    1 /*
     1/* 
    22 * Pathname.java
    33 *
     
    16401640                            if (file.isDirectory()) {
    16411641                                if (arg2 != NIL) {
    1642                                     p = Utilities.getDirectoryPathname(file);
     1642                                    p = Pathname.getDirectoryPathname(file);
    16431643                                } else {
    16441644                                    p = new Pathname(file.getAbsolutePath());
     
    19161916    }
    19171917
    1918     private static final Primitive MERGE_PATHNAMES = new pf_merge_pathnames();
     1918    static final Primitive MERGE_PATHNAMES = new pf_merge_pathnames();
    19191919    @DocString(name="merge-pathnames",
    19201920               args="pathname &optional default-pathname default-version",
     
    21152115    }
    21162116
     2117
    21172118    public static final LispObject truename(Pathname pathname) {
    21182119        return truename(pathname, false);
     
    21352136                                            boolean errorIfDoesNotExist)
    21362137    {
     2138        if (pathname == null || pathname.equals(NIL)) {  // XXX duplicates code at the end of this longish function: figure out proper nesting of labels.
     2139            if (errorIfDoesNotExist) {
     2140                StringBuilder sb = new StringBuilder("The file ");
     2141                sb.append(pathname.princToString());
     2142                sb.append(" does not exist.");
     2143                return error(new FileError(sb.toString(), pathname));
     2144            }
     2145            return NIL;
     2146        }
    21372147        if (pathname instanceof LogicalPathname) {
    21382148            pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname);
     
    21432153        }
    21442154        if (!(pathname.isJar() || pathname.isURL())) {
    2145             pathname
     2155            Pathname result
    21462156                = mergePathnames(pathname,
    21472157                                 coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
    21482158                                 NIL);
    2149             final String namestring = pathname.getNamestring();
    2150             if (namestring == null) {
    2151                 return error(new FileError("Pathname has no namestring: "
    2152                                            + pathname.princToString(),
    2153                                            pathname));
    2154             }
    2155            
    2156             final File file = new File(namestring);
    2157             if (file.isDirectory()) {
    2158                 return Utilities.getDirectoryPathname(file);
    2159             }
     2159            final File file = result.getFile();
    21602160            if (file.exists()) {
    2161                 try {
    2162                     return new Pathname(file.getCanonicalPath());
    2163                 } catch (IOException e) {
    2164                     return error(new FileError(e.getMessage(), pathname));
    2165                 }
     2161                if (file.isDirectory()) {
     2162                    result = Pathname.getDirectoryPathname(file);
     2163                } else {
     2164                    try {
     2165                        result = new Pathname(file.getCanonicalPath());
     2166                    } catch (IOException e) {
     2167                        return error(new FileError(e.getMessage(), pathname));
     2168                    }
     2169                }
     2170                return result;
    21662171            }
    21672172        } else if (pathname.isURL()) {
     
    23442349            }
    23452350        } else {
    2346             File file = Utilities.getFile(this);
     2351            File file = getFile();
    23472352            try {
    23482353                result = new FileInputStream(file);
     
    23612366    public long getLastModified() {
    23622367        if (!(isJar() || isURL())) {
    2363             File f = Utilities.getFile(this);
     2368            File f = getFile();
    23642369            return f.lastModified();
    23652370        }
     
    24532458            }
    24542459                   
    2455             File file = Utilities.getFile(defaultedPathname);
     2460            File file = defaultedPathname.getFile();
    24562461            return file.mkdir() ? T : NIL;
    24572462        }
     
    24622467               args="filespec new-name",
    24632468               returns="defaulted-new-name, old-truename, new-truename",
    2464     doc="rename-file modifies the file system in such a way that the file indicated by FILESPEC is renamed to DEFAULTED-NEW-NAME.")
     2469               doc = "Modifies the file system in such a way that the file indicated by FILESPEC is renamed to DEFAULTED-NEW-NAME.\n"
     2470               + "\n"
     2471               + "Returns three values if successful. The primary value, DEFAULTED-NEW-NAME, is \n"
     2472               + "the resulting name which is composed of NEW-NAME with any missing components filled in by \n"
     2473               + "performing a merge-pathnames operation using filespec as the defaults. The secondary \n"
     2474               + "value, OLD-TRUENAME, is the truename of the file before it was renamed. The tertiary \n"
     2475               + "value, NEW-TRUENAME, is the truename of the file after it was renamed.\n")
    24652476    private static class pf_rename_file extends Primitive {
    24662477        pf_rename_file() {
     
    24692480        @Override
    24702481        public LispObject execute(LispObject first, LispObject second) {
    2471             final Pathname original = (Pathname) truename(first, true);
    2472             final String originalNamestring = original.getNamestring();
     2482            Pathname oldPathname = coerceToPathname(first);
     2483            Pathname oldTruename = (Pathname) truename(oldPathname, true);
    24732484            Pathname newName = coerceToPathname(second);
    24742485            if (newName.isWild()) {
    24752486                error(new FileError("Bad place for a wild pathname.", newName));
    24762487            }
    2477             if (original.isJar()) {
    2478                 error(new FileError("Bad place for a jar pathname.", original));
     2488            if (oldTruename.isJar()) {
     2489                error(new FileError("Bad place for a jar pathname.", oldTruename));
    24792490            }
    24802491            if (newName.isJar()) {
    24812492                error(new FileError("Bad place for a jar pathname.", newName));
    24822493            }
    2483             if (original.isURL()) {
    2484                 error(new FileError("Bad place for a URL pathname.", original));
     2494            if (oldTruename.isURL()) {
     2495                error(new FileError("Bad place for a URL pathname.", oldTruename));
    24852496            }
    24862497            if (newName.isURL()) {
     
    24882499            }
    24892500               
    2490             newName = mergePathnames(newName, original, NIL);
    2491             final String newNamestring;
    2492             if (newName instanceof LogicalPathname) {
    2493                 newNamestring = LogicalPathname.translateLogicalPathname((LogicalPathname) newName).getNamestring();
    2494             } else {
    2495                 newNamestring = newName.getNamestring();
    2496             }
    2497             if (originalNamestring != null && newNamestring != null) {
    2498                 final File source = new File(originalNamestring);
    2499                 final File destination = new File(newNamestring);
    2500                 if (Utilities.isPlatformWindows) {
    2501                     if (destination.isFile()) {
    2502                         ZipCache.remove(destination);
    2503                         destination.delete();
    2504                     }
    2505                 }
    2506                 if (source.renameTo(destination)) { // Success!
    2507                         return LispThread.currentThread().setValues(newName, original,
    2508                                                                     truename(newName, true));
    2509                 }
     2501            Pathname defaultedNewName = mergePathnames(newName, oldTruename, NIL);
     2502
     2503            File source = oldTruename.getFile();
     2504            File destination = null;
     2505            if (defaultedNewName instanceof LogicalPathname) {
     2506                destination = LogicalPathname.translateLogicalPathname((LogicalPathname)defaultedNewName)
     2507                    .getFile();
     2508            } else {
     2509                destination = defaultedNewName.getFile();
     2510            }
     2511            // By default, MSDOG doesn't allow one to remove files that are open.
     2512            if (Utilities.isPlatformWindows) {
     2513              if (destination.isFile()) {
     2514                ZipCache.remove(destination);
     2515                destination.delete();
     2516              }
     2517            }
     2518            if (source.renameTo(destination)) { // Success!
     2519              Pathname newTruename = (Pathname)truename(defaultedNewName, true);
     2520              return LispThread.currentThread().setValues(defaultedNewName,
     2521                                                          oldTruename,
     2522                                                          newTruename);
    25102523            }
    25112524            return error(new FileError("Unable to rename "
    2512                                        + original.princToString()
     2525                                       + oldTruename.princToString()
    25132526                                       + " to " + newName.princToString()
    2514                                        + "."));
     2527                                       + ".",
     2528                                       oldTruename));
    25152529        }
    25162530    }
     
    26562670        return null; // Error
    26572671    }
     2672
     2673
     2674    File getFile() {
     2675        String namestring = getNamestring(); // XXX UNC pathnames currently have no namestring
     2676        if (namestring != null) {
     2677            return new File(namestring);
     2678        }
     2679        error(new FileError("Pathname has no namestring: " + princToString(),
     2680                        this));
     2681        // Not reached.
     2682        return null;
     2683    }
     2684    public static Pathname getDirectoryPathname(File file) {
     2685        try {
     2686            String namestring = file.getCanonicalPath();
     2687            if (namestring != null && namestring.length() > 0) {
     2688                if (namestring.charAt(namestring.length() - 1) != File.separatorChar) {
     2689                    namestring = namestring.concat(File.separator);
     2690                }
     2691            }
     2692            return new Pathname(namestring);
     2693        } catch (IOException e) {
     2694            error(new LispError(e.getMessage()));
     2695            // Not reached.
     2696            return null;
     2697        }
     2698    }
     2699
    26582700}
    26592701
  • trunk/abcl/src/org/armedbear/lisp/Utilities.java

    r13440 r14176  
    9191    }
    9292
    93     public static File getFile(Pathname pathname)
    94     {
    95         return getFile(pathname,
    96                        coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()));
    97     }
    98 
    99     public static File getFile(Pathname pathname, Pathname defaultPathname)
    100 
    101     {
    102         Pathname merged =
    103             Pathname.mergePathnames(pathname, defaultPathname, NIL);
    104         String namestring = merged.getNamestring();
    105         if (namestring != null)
    106             return new File(namestring);
    107         error(new FileError("Pathname has no namestring: " + merged.princToString(),
    108                              merged));
    109         // Not reached.
    110         return null;
    111     }
    112 
    113     public static Pathname getDirectoryPathname(File file)
    114 
    115     {
    116         try {
    117             String namestring = file.getCanonicalPath();
    118             if (namestring != null && namestring.length() > 0) {
    119                 if (namestring.charAt(namestring.length() - 1) != File.separatorChar)
    120                     namestring = namestring.concat(File.separator);
    121             }
    122             return new Pathname(namestring);
    123         }
    124         catch (IOException e) {
    125             error(new LispError(e.getMessage()));
    126             // Not reached.
    127             return null;
    128         }
    129     }
    130 
    13193    public static ZipInputStream getZipInputStream(ZipFile zipfile,
    13294                                                   String entryName) {
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r14163 r14176  
     1
    12;;; compile-file.lisp
    23;;;
     
    5455  (%format nil "~A_0" (base-classname output-file-pathname)))
    5556
    56 (declaim (ftype (function (t) t) compute-classfile-name))
    57 (defun compute-classfile-name (n &optional (output-file-pathname
     57(declaim (ftype (function (t) t) compute-classfile))
     58(defun compute-classfile (n &optional (output-file-pathname
    5859                                            *output-file-pathname*))
    59   "Computes the name of the class file associated with number `n'."
     60  "Computes the pathname of the class file associated with number `n'."
    6061  (let ((name
    6162         (sanitize-class-name
    6263    (%format nil "~A_~D" (pathname-name output-file-pathname) n))))
    63     (namestring (merge-pathnames (make-pathname :name name :type *compile-file-class-extension*)
    64                                  output-file-pathname))))
     64    (merge-pathnames (make-pathname :name name :type *compile-file-class-extension*)
     65                                 output-file-pathname)))
    6566
    6667(defun sanitize-class-name (name)
     
    7576 
    7677
    77 (declaim (ftype (function () t) next-classfile-name))
    78 (defun next-classfile-name ()
    79   (compute-classfile-name (incf *class-number*)))
     78(declaim (ftype (function () t) next-classfile))
     79(defun next-classfile ()
     80  (compute-classfile (incf *class-number*)))
    8081
    8182(defmacro report-error (&rest forms)
     
    186187         (expr `(lambda () ,form))
    187188         (saved-class-number *class-number*)
    188          (classfile (next-classfile-name))
     189         (classfile (next-classfile))
    189190         (result
    190191          (with-open-file
     
    308309                 (jvm::with-saved-compiler-policy
    309310                     (let* ((saved-class-number *class-number*)
    310                             (classfile (next-classfile-name))
     311                            (classfile (next-classfile))
    311312                            (result
    312313                             (with-open-file
     
    451452    (let* ((expr (function-lambda-expression (macro-function name)))
    452453           (saved-class-number *class-number*)
    453            (classfile (next-classfile-name)))
     454           (classfile (next-classfile)))
    454455      (with-open-file
    455456          (f classfile
     
    491492                          ,@decls (block ,block-name ,@body)))
    492493                 (saved-class-number *class-number*)
    493                  (classfile (next-classfile-name))
     494                 (classfile (next-classfile))
    494495                 (internal-compiler-errors nil)
    495496                 (result (with-open-file
     
    637638
    638639(defun populate-zip-fasl (output-file)
    639   (let* ((type ;; Don't use ".zip", it'll result in an extension
    640           ;;  with a dot, which is rejected by NAMESTRING
     640  (let* ((type ;; Don't use ".zip", it'll result in an extension with
     641               ;; a dot, which is rejected by NAMESTRING
    641642          (%format nil "~A~A" (pathname-type output-file) "-zip"))
    642          (zipfile (namestring
    643                    (merge-pathnames (make-pathname :type type)
    644                                     output-file)))
     643         (output-file (if (logical-pathname-p output-file)
     644                          (translate-logical-pathname output-file)
     645                          output-file))
     646         (zipfile
     647          (if (find :windows *features*)
     648              (make-pathname :defaults output-file :type type)
     649              (make-pathname :defaults output-file :type type
     650                             :device :unspecific)))
    645651         (pathnames nil)
    646          (fasl-loader (namestring (merge-pathnames
    647                                    (make-pathname :name (fasl-loader-classname)
    648                                                   :type *compile-file-class-extension*)
    649                                    output-file))))
     652         (fasl-loader (make-pathname :defaults output-file
     653                                     :name (fasl-loader-classname)
     654                                     :type *compile-file-class-extension*)))
    650655    (when (probe-file fasl-loader)
    651656      (push fasl-loader pathnames))
    652657    (dotimes (i *class-number*)
    653       (let ((truename (probe-file (compute-classfile-name (1+ i)))))
     658      (let ((truename (probe-file (compute-classfile (1+ i)))))
    654659        (when truename
    655660          (push truename pathnames)
     
    669674              (push resource pathnames))))))
    670675    (setf pathnames (nreverse (remove nil pathnames)))
    671     (let ((load-file (merge-pathnames (make-pathname :type "_")
    672                                       output-file)))
     676    (let ((load-file (make-pathname :defaults output-file
     677                                    :type "_")))
    673678      (rename-file output-file load-file)
    674679      (push load-file pathnames))
     
    711716(defvar *fasl-stream* nil)
    712717
     718(defvar *debug-compile-from-stream* nil)
    713719(defun compile-from-stream (in output-file temp-file temp-file2
    714720                            extract-toplevel-funcs-and-macros
     
    723729         (start (get-internal-real-time))
    724730         *fasl-uninterned-symbols*)
     731    (setf *debug-compile-from-stream*
     732          (list :in in
     733                :compile-file-pathname *compile-file-pathname*))
    725734    (when *compile-verbose*
    726735      (format t "; Compiling ~A ...~%" namestring))
     
    849858                 do (write-line line out)))))
    850859        (delete-file temp-file)
    851         (remove-zip-cache-entry output-file) ;; Necessary under windows
     860        (when (find :windows *features*)
     861          (remove-zip-cache-entry output-file))
    852862        (rename-file temp-file2 output-file)
    853863
     
    871881           (when suffix
    872882             (setq type (concatenate 'string type suffix)))
    873            (merge-pathnames (make-pathname :type type)
    874                             pathname)))
     883           (make-pathname :type type :defaults pathname)))
    875884    (unless (or (and (probe-file input-file)
    876885                     (not (file-directory-p input-file)))
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r14143 r14176  
    75567556(defmacro with-file-compilation (&body body)
    75577557  `(let ((*file-compilation* t)
    7558          (*pathnames-generator* #'sys::next-classfile-name))
     7558         (*pathnames-generator* #'sys::next-classfile))
    75597559     ,@body))
    75607560
  • trunk/abcl/src/org/armedbear/lisp/directory.lisp

    r13252 r14176  
    118118                    (cond ((file-directory-p entry)
    119119                           (when (pathname-match-p (file-namestring (pathname-as-file entry)) (file-namestring pathname))
    120                              (push entry matching-entries)))
     120                             (push (truename entry) matching-entries)))
    121121                          ((pathname-match-p (or (file-namestring entry) "") (file-namestring pathname))
    122                            (push entry matching-entries))))
     122                           (push (truename entry) matching-entries))))
    123123                  matching-entries))))
    124124        ;; Not wild.
  • trunk/abcl/src/org/armedbear/lisp/dump-form.lisp

    r13653 r14176  
    176176    index))
    177177
     178(declaim (ftype (function (pathname stream) t) dump-pathname))
     179(defun dump-pathname (pathname stream)
     180  (write-string "#P(" stream)
     181  (write-string ":HOST " stream)
     182  (dump-form (pathname-host pathname) stream)
     183  (write-string " :DEVICE " stream)
     184  (dump-form (pathname-device pathname) stream)
     185  (write-string " :DIRECTORY " stream)
     186  (dump-form (pathname-directory pathname) stream)
     187  (write-string " :NAME " stream)
     188  (dump-form (pathname-name pathname) stream)
     189  (write-string " :TYPE " stream)
     190  (dump-form (pathname-type pathname) stream)
     191  (write-string " :VERSION " stream)
     192  (dump-form (pathname-version pathname) stream)
     193  (write-string ")" stream))
     194
    178195(declaim (ftype (function (t stream) t) dump-object))
    179196(defun dump-object (object stream)
     
    183200          ((stringp object)
    184201           (%stream-output-object object stream))
     202          ((pathnamep object)
     203           (dump-pathname object stream))
    185204          ((bit-vector-p object)
    186205           (%stream-output-object object stream))
  • trunk/abcl/src/org/armedbear/lisp/file_write_date.java

    r12422 r14176  
    5252        if (pathname.isWild())
    5353            error(new FileError("Bad place for a wild pathname.", pathname));
    54         long lastModified = pathname.getLastModified();
     54        Pathname defaultedPathname = (Pathname) Pathname.MERGE_PATHNAMES.execute(pathname);
     55        long lastModified = defaultedPathname.getLastModified();
    5556        if (lastModified == 0)
    5657            return NIL;
  • trunk/abcl/src/org/armedbear/lisp/probe_file.java

    r12290 r14176  
    7575            if (pathname.isWild())
    7676                error(new FileError("Bad place for a wild pathname.", pathname));
    77             File file = Utilities.getFile(pathname);
    78             return file.isDirectory() ? Utilities.getDirectoryPathname(file) : NIL;
     77            Pathname defaultedPathname = (Pathname)Pathname.MERGE_PATHNAMES.execute(pathname);
     78            File file = defaultedPathname.getFile();
     79            return file.isDirectory() ? Pathname.getDirectoryPathname(file) : NIL;
    7980        }
    8081    };
     
    8687    {
    8788        @Override
    88         public LispObject execute(LispObject arg)
     89        public LispObject execute(LispObject arg)  // XXX Should this merge with defaults?
    8990        {
    9091            Pathname pathname = coerceToPathname(arg);
    9192            if (pathname.isWild())
    9293                error(new FileError("Bad place for a wild pathname.", pathname));
    93             File file = Utilities.getFile(pathname);
     94            File file = pathname.getFile();
    9495            return file.isDirectory() ? T : NIL;
    9596        }
  • trunk/abcl/src/org/armedbear/lisp/zip.java

    r13440 r14176  
    216216            final Pathname source = Lisp.coerceToPathname(key);
    217217            final Pathname destination = Lisp.coerceToPathname(value);
    218             final File file = Utilities.getFile(source);
     218            final File file = source.getFile();
    219219            try {
    220220                String jarEntry = destination.getNamestring();
Note: See TracChangeset for help on using the changeset viewer.