[armedbear-cvs] r14176 - trunk/abcl/src/org/armedbear/lisp
mevenson at common-lisp.net
mevenson at common-lisp.net
Thu Oct 11 11:33:20 UTC 2012
Author: mevenson
Date: Thu Oct 11 04:33:19 2012
New Revision: 14176
Log:
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.
Modified:
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/Pathname.java
trunk/abcl/src/org/armedbear/lisp/Utilities.java
trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
trunk/abcl/src/org/armedbear/lisp/directory.lisp
trunk/abcl/src/org/armedbear/lisp/dump-form.lisp
trunk/abcl/src/org/armedbear/lisp/file_write_date.java
trunk/abcl/src/org/armedbear/lisp/probe_file.java
trunk/abcl/src/org/armedbear/lisp/zip.java
Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java Thu Oct 11 04:33:19 2012 (r14176)
@@ -140,8 +140,8 @@
= coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue());
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)) {
if (ifDoesNotExist) {
@@ -193,8 +193,8 @@
}
}
truename = (Pathname)initTruename;
- }
-
+ }
+
InputStream in = truename.getInputStream();
Debug.assertTrue(in != null);
@@ -249,6 +249,20 @@
private static final Symbol FASL_LOADER = PACKAGE_SYS.intern("*FASL-LOADER*");
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,
boolean print,
@@ -267,8 +281,12 @@
mergedPathname = pathname;
}
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
String path = pathname.asEntryPath();
@@ -286,7 +304,8 @@
}
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 "
+ "'" + url + "'"));
@@ -481,7 +500,13 @@
// Lisp.readFunctionBytes().
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())
|| type.equals(COMPILE_FILE_INIT_FASL_TYPE.toString())) {
Modified: trunk/abcl/src/org/armedbear/lisp/Pathname.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Pathname.java Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/Pathname.java Thu Oct 11 04:33:19 2012 (r14176)
@@ -1,4 +1,4 @@
-/*
+/*
* Pathname.java
*
* Copyright (C) 2003-2007 Peter Graves
@@ -1639,7 +1639,7 @@
Pathname p;
if (file.isDirectory()) {
if (arg2 != NIL) {
- p = Utilities.getDirectoryPathname(file);
+ p = Pathname.getDirectoryPathname(file);
} else {
p = new Pathname(file.getAbsolutePath());
}
@@ -1915,7 +1915,7 @@
}
}
- 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",
returns="pathname",
@@ -2114,6 +2114,7 @@
return dir;
}
+
public static final LispObject truename(Pathname pathname) {
return truename(pathname, false);
}
@@ -2134,6 +2135,15 @@
public static final LispObject truename(Pathname pathname,
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);
}
@@ -2142,27 +2152,22 @@
pathname));
}
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()) {
if (pathname.getInputStream() != null) {
@@ -2343,7 +2348,7 @@
+ ": " + e);
}
} else {
- File file = Utilities.getFile(this);
+ File file = getFile();
try {
result = new FileInputStream(file);
} catch (IOException e) {
@@ -2360,7 +2365,7 @@
*/
public long getLastModified() {
if (!(isJar() || isURL())) {
- File f = Utilities.getFile(this);
+ File f = getFile();
return f.lastModified();
}
@@ -2452,7 +2457,7 @@
defaultedPathname);
}
- File file = Utilities.getFile(defaultedPathname);
+ File file = defaultedPathname.getFile();
return file.mkdir() ? T : NIL;
}
}
@@ -2461,57 +2466,66 @@
@DocString(name="rename-file",
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() {
super("rename-file", "filespec new-name");
}
@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()) {
error(new FileError("Bad place for a jar pathname.", newName));
}
- 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));
}
}
@@ -2655,5 +2669,33 @@
}
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;
+ }
+ }
+
}
Modified: trunk/abcl/src/org/armedbear/lisp/Utilities.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Utilities.java Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/Utilities.java Thu Oct 11 04:33:19 2012 (r14176)
@@ -90,44 +90,6 @@
return false;
}
- 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) {
return Utilities.getZipInputStream(zipfile, entryName, false);
Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Thu Oct 11 04:33:19 2012 (r14176)
@@ -1,3 +1,4 @@
+
;;; compile-file.lisp
;;;
;;; Copyright (C) 2004-2006 Peter Graves
@@ -53,15 +54,15 @@
(defun fasl-loader-classname (&optional (output-file-pathname *output-file-pathname*))
(%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)
(let ((name (copy-seq name)))
@@ -74,9 +75,9 @@
name))
-(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)
`(handler-case (progn , at forms)
@@ -185,7 +186,7 @@
(let* ((toplevel-form (third form))
(expr `(lambda () ,form))
(saved-class-number *class-number*)
- (classfile (next-classfile-name))
+ (classfile (next-classfile))
(result
(with-open-file
(f classfile
@@ -307,7 +308,7 @@
(let ((lambda-expression (cadr function-form)))
(jvm::with-saved-compiler-policy
(let* ((saved-class-number *class-number*)
- (classfile (next-classfile-name))
+ (classfile (next-classfile))
(result
(with-open-file
(f classfile
@@ -450,7 +451,7 @@
(push name *toplevel-macros*)
(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
:direction :output
@@ -490,7 +491,7 @@
(let* ((expr `(lambda ,lambda-list
, at decls (block ,block-name , at body)))
(saved-class-number *class-number*)
- (classfile (next-classfile-name))
+ (classfile (next-classfile))
(internal-compiler-errors nil)
(result (with-open-file
(f classfile
@@ -636,21 +637,25 @@
(eval form))))
(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)
;;; XXX it would be better to just use the recorded number
@@ -668,8 +673,8 @@
:defaults truename)))
(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))
(zip zipfile pathnames)
@@ -710,6 +715,7 @@
(defvar *forms-for-output* nil)
(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
functions-file macros-file exports-file)
@@ -722,6 +728,9 @@
(namestring (namestring *compile-file-truename*))
(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))
(with-compilation-unit ()
@@ -848,7 +857,8 @@
while (not (eq line :eof))
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)
(when *compile-file-zip*
@@ -870,8 +880,7 @@
(flet ((pathname-with-type (pathname type &optional suffix)
(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)))
(pathname-type input-file))
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Thu Oct 11 04:33:19 2012 (r14176)
@@ -7555,7 +7555,7 @@
(defmacro with-file-compilation (&body body)
`(let ((*file-compilation* t)
- (*pathnames-generator* #'sys::next-classfile-name))
+ (*pathnames-generator* #'sys::next-classfile))
, at body))
Modified: trunk/abcl/src/org/armedbear/lisp/directory.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/directory.lisp Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/directory.lisp Thu Oct 11 04:33:19 2012 (r14176)
@@ -117,9 +117,9 @@
(dolist (entry entries)
(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.
(let ((truename (probe-file pathname)))
Modified: trunk/abcl/src/org/armedbear/lisp/dump-form.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dump-form.lisp Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/dump-form.lisp Thu Oct 11 04:33:19 2012 (r14176)
@@ -175,6 +175,23 @@
(acons symbol index *fasl-uninterned-symbols*)))
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)
(unless (df-handle-circularity object stream nil)
@@ -182,6 +199,8 @@
(dump-cons object stream))
((stringp object)
(%stream-output-object object stream))
+ ((pathnamep object)
+ (dump-pathname object stream))
((bit-vector-p object)
(%stream-output-object object stream))
((vectorp object)
Modified: trunk/abcl/src/org/armedbear/lisp/file_write_date.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/file_write_date.java Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/file_write_date.java Thu Oct 11 04:33:19 2012 (r14176)
@@ -51,7 +51,8 @@
Pathname pathname = coerceToPathname(arg);
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;
return number(lastModified / 1000 + 2208988800L);
Modified: trunk/abcl/src/org/armedbear/lisp/probe_file.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/probe_file.java Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/probe_file.java Thu Oct 11 04:33:19 2012 (r14176)
@@ -74,8 +74,9 @@
Pathname pathname = coerceToPathname(arg);
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;
}
};
@@ -85,12 +86,12 @@
new Primitive("file-directory-p", PACKAGE_EXT, true)
{
@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;
}
};
Modified: trunk/abcl/src/org/armedbear/lisp/zip.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/zip.java Wed Oct 10 07:17:11 2012 (r14175)
+++ trunk/abcl/src/org/armedbear/lisp/zip.java Thu Oct 11 04:33:19 2012 (r14176)
@@ -215,7 +215,7 @@
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();
if (jarEntry.startsWith("/")) {
More information about the armedbear-cvs
mailing list