[armedbear-cvs] r12441 - trunk/abcl/src/org/armedbear/lisp
Mark Evenson
mevenson at common-lisp.net
Wed Feb 10 16:22:21 UTC 2010
Author: mevenson
Date: Wed Feb 10 11:22:21 2010
New Revision: 12441
Log:
Return of the ZipCache now using last modified time.
Treat jars as zips in ZipCache which maintains an cache of all
ZipFiles accessed via Pathname jars (which should be the entire system
as Load now uses Pathname). ZipCache currently does not invalidate
entries for any non-file resources due to deficiencies in the JVM that
need to be corrected on a per-protocol basis. For instance, for HTTP
we need an implementation that uses HTTP HEAD requests to get the
Last-Modified header as opposed to re-fetching the entire resource as
the JVM URLConnection does.
SYS:REMOVE-ZIP-CACHE-ENTRY implements a way to invalidate ZipCache
entries from Lisp. Used it in COMPILE-FILE to successfully recompile
FASLs under Windows.
Rewrite remaining Pathname Primtives in the informative stack trace style.
Implement Debug.warn() which can be shut off with SYS::*DEBUG-WARN*.
The intent here is to have a way to warn about Java side events which
having potentially worrying side-effects during development which is
by default not visible to end users (although it can be).
Removed unused EXT:LAST-MODIFIED in favor of existing ANSI FILE-WRITE-DATE.
Added:
trunk/abcl/src/org/armedbear/lisp/ZipCache.java
Modified:
trunk/abcl/src/org/armedbear/lisp/Autoload.java
trunk/abcl/src/org/armedbear/lisp/Debug.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
Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java Wed Feb 10 11:22:21 2010
@@ -644,6 +644,7 @@
autoload(PACKAGE_SYS, "psxhash", "HashTableFunctions");
autoload(PACKAGE_SYS, "puthash", "HashTableFunctions");
autoload(PACKAGE_SYS, "puthash", "HashTableFunctions");
+ autoload(PACKAGE_SYS, "remove-zip-cache-entry", "ZipCache");
autoload(PACKAGE_SYS, "set-function-info-value", "function_info");
autoload(PACKAGE_SYS, "set-generic-function-argument-precedence-order","StandardGenericFunction", true);
autoload(PACKAGE_SYS, "set-generic-function-classes-to-emf-table","StandardGenericFunction", true);
Modified: trunk/abcl/src/org/armedbear/lisp/Debug.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Debug.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Debug.java Wed Feb 10 11:22:21 2010
@@ -33,8 +33,11 @@
package org.armedbear.lisp;
+import static org.armedbear.lisp.Lisp.*;
+
public final class Debug
{
+
public static final void assertTrue(boolean b)
{
if (!b) {
@@ -60,4 +63,21 @@
{
t.printStackTrace();
}
+
+ public static final Symbol _DEBUG_WARN_
+ = exportSpecial("*DEBUG-WARN*", PACKAGE_SYS, NIL);
+
+ public static void setDebugWarnings(boolean flag) {
+ if (flag) {
+ _DEBUG_WARN_.setSymbolValue(T);
+ } else {
+ _DEBUG_WARN_.setSymbolValue(NIL);
+ }
+ }
+
+ public static final void warn(String s) {
+ if (_DEBUG_WARN_.getSymbolValue() != null) {
+ trace(s);
+ }
+ }
}
Modified: trunk/abcl/src/org/armedbear/lisp/Pathname.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Pathname.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Pathname.java Wed Feb 10 11:22:21 2010
@@ -43,11 +43,14 @@
import java.net.URL;
import java.net.URLConnection;
import java.net.URLDecoder;
+import java.util.HashMap;
import java.util.StringTokenizer;
import java.util.jar.JarEntry;
import java.util.jar.JarFile;
import java.util.zip.ZipEntry;
+import java.util.zip.ZipFile;
import java.util.zip.ZipInputStream;
+import java.util.zip.ZipException;
public class Pathname extends LispObject {
@@ -1640,7 +1643,7 @@
// 2. JAR in JAR
// 3. JAR with Entry
// 4. JAR in JAR with Entry
- JarFile jarFile = getJarFile(jars.car());
+ ZipFile jarFile = ZipCache.get(jars.car());
String entryPath = pathname.asEntryPath();
if (jarFile != null) {
if (jars.cdr() instanceof Cons) {
@@ -1707,54 +1710,18 @@
return result;
}
- /** Make a JarURL from a generic URL reference. */
- private static URL makeJarURL(String url) {
- String jarURL = "jar:" + url + "!/";
+ protected static URL makeURL(LispObject device) {
URL result = null;
try {
- result = new URL(jarURL);
- } catch (MalformedURLException ex) {
- // XXX
- Debug.trace("Could not form jar URL from "
- + "'" + jarURL + "'"
- + " because " + ex);
- }
- return result;
- }
-
- private static JarFile getJarFile(LispObject device) {
- URL url = null;
if (device instanceof SimpleString) {
- url = makeJarURL(((SimpleString) device).getStringValue());
+ result = new URL(((SimpleString)device).getStringValue());
} else {
- url = makeJarURL((Pathname) device);
- }
- if (url == null) {
- return null;
- }
- URLConnection connection;
- try {
- connection = url.openConnection();
- } catch (IOException ex) {
- Debug.trace("Failed to open "
- + "'" + url + "'");
- return null;
+ // XXX ensure that we have cannonical path.
+ Pathname p = (Pathname)device;
+ result = new URL("file:" + p.getNamestring());
}
- if (!(connection instanceof JarURLConnection)) {
- // XXX
- Debug.trace("Could not get a URLConnection from " + url);
- return null;
- }
- JarURLConnection jarURLConnection = (JarURLConnection) connection;
- // XXX implement custom protocol handler that actual does the necessary caching
- connection.setUseCaches(false);
- JarFile result;
- try {
- result = jarURLConnection.getJarFile();
- } catch (IOException ex) {
- Debug.trace("Could not get a JarURLConnection from "
- + "'" + jarURLConnection + "'");
- return null;
+ } catch (MalformedURLException e) {
+ Debug.trace("Could not form URL from " + device);
}
return result;
}
@@ -1765,7 +1732,7 @@
String entryPath = asEntryPath();
// XXX We only return the bytes of an entry in a JAR
Debug.assertTrue(entryPath != null);
- JarFile jarFile = Pathname.getJarFile(device.car());
+ ZipFile jarFile = ZipCache.get(device.car());
Debug.assertTrue(jarFile != null);
// Is this a JAR within a JAR?
if (device.cdr() instanceof Cons) {
@@ -1802,22 +1769,6 @@
return result;
}
- // ### last-modified pathname => time-in-milliseconds
- public static final Primitive LAST_MODIFIED
- = new Primitive("LAST-MODIFIED", PACKAGE_EXT, true, "pathname",
- "If PATHNAME exists, returns the last modified time in miliseconds since the UNIX epoch.")
- {
- @Override
- public LispObject execute(LispObject arg) {
- final Pathname p = coerceToPathname(arg);
- if (p.isWild()) {
- error(new FileError("Bad place for a wild pathname.", p));
- }
- long time = p.getLastModified();
- return LispInteger.getInstance(time);
- }
- };
-
/** @return Time in milliseconds since the UNIX epoch at which the
* resource was last modified, or 0 if the time is unknown.
*/
@@ -1839,23 +1790,26 @@
LispObject o = d.car();
if (o instanceof SimpleString) {
// 0. JAR from URL
- URL u = makeJarURL(o.getStringValue());
- URLConnection c = null;
- try {
- c = u.openConnection();
- } catch(IOException e) {
- Debug.trace("Failed to open Connection for URL "
- + "'" + u + "'");
- return 0;
- }
- c.getLastModified();
+ // URL u = makeJarURL(o.getStringValue());
+ // XXX unimplemented
+ Debug.assertTrue(false);
+ // URLConnection c = null;
+ // try {
+ // c = u.openConnection();
+ // } catch(IOException e) {
+ // Debug.trace("Failed to open Connection for URL "
+ // + "'" + u + "'");
+ // return 0;
+ // }
+ // c.getLastModified();
} else {
// 1. JAR
return ((Pathname)o).getLastModified();
}
} else {
// 3. Entry in JAR
- final JarEntry entry = getJarFile(device.car()).getJarEntry(entryPath);
+ final ZipEntry entry
+ = ZipCache.get(device.car()).getEntry(entryPath);
if (entry == null) {
return 0;
}
@@ -1866,11 +1820,11 @@
return time;
}
} else {
- JarFile outerJar = getJarFile(d.car());
+ ZipFile outerJar = ZipCache.get(d.car());
if (entryPath.length() == 0) {
// 4. JAR in JAR
String jarPath = ((Pathname)d.cdr()).asEntryPath();
- final JarEntry entry = outerJar.getJarEntry(jarPath);
+ final ZipEntry entry = outerJar.getEntry(jarPath);
final long time = entry.getTime();
if (time == -1) {
return 0;
@@ -1894,96 +1848,107 @@
return 0;
}
- // ### mkdir
- private static final Primitive MKDIR =
- new Primitive("mkdir", PACKAGE_SYS, false) {
+ // ### mkdir pathname
+ private static final Primitive MKDIR = new mkdir();
+ private static class mkdir extends Primitive {
+ mkdir() {
+ super("mkdir", PACKAGE_SYS, false, "pathname");
+ }
- @Override
- public LispObject execute(LispObject arg) {
- final Pathname pathname = coerceToPathname(arg);
- if (pathname.isWild()) {
- error(new FileError("Bad place for a wild pathname.", pathname));
- }
- Pathname defaultedPathname =
+ @Override
+ public LispObject execute(LispObject arg) {
+ final Pathname pathname = coerceToPathname(arg);
+ if (pathname.isWild()) {
+ error(new FileError("Bad place for a wild pathname.", pathname));
+ }
+ Pathname defaultedPathname =
mergePathnames(pathname,
- coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
- NIL);
- File file = Utilities.getFile(defaultedPathname);
- return file.mkdir() ? T : NIL;
- }
- };
+ coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()),
+ NIL);
+ File file = Utilities.getFile(defaultedPathname);
+ return file.mkdir() ? T : NIL;
+ }
+ }
+
// ### rename-file filespec new-name => defaulted-new-name, old-truename, new-truename
- public static final Primitive RENAME_FILE =
- new Primitive("rename-file", "filespec new-name") {
+ private static final Primitive RENAME_FILE = new rename_file();
+ private static class rename_file extends Primitive {
+ 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 newName = coerceToPathname(second);
+ if (newName.isWild()) {
+ error(new FileError("Bad place for a wild 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()) {
+ destination.delete();
+ }
+ }
+ if (source.renameTo(destination)) { // Success!
+ return LispThread.currentThread().setValues(newName, original,
+ truename(newName, true));
+ }
+ }
+ return error(new FileError("Unable to rename "
+ + original.writeToString()
+ + " to " + newName.writeToString()
+ + "."));
+ }
+ }
- @Override
- public LispObject execute(LispObject first, LispObject second) {
- final Pathname original = (Pathname) truename(first, true);
- final String originalNamestring = original.getNamestring();
- Pathname newName = coerceToPathname(second);
- if (newName.isWild()) {
- error(new FileError("Bad place for a wild 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()) {
- destination.delete();
- }
- }
- if (source.renameTo(destination)) // Success!
- {
- return LispThread.currentThread().setValues(newName, original,
- truename(newName, true));
- }
- }
- return error(new FileError("Unable to rename "
- + original.writeToString()
- + " to " + newName.writeToString()
- + "."));
- }
- };
// ### file-namestring pathname => namestring
- private static final Primitive FILE_NAMESTRING =
- new Primitive("file-namestring", "pathname") {
+ private static final Primitive FILE_NAMESTRING = new file_namestring();
+ private static class file_namestring extends Primitive {
+ file_namestring() {
+ super("file-namestring", "pathname");
+ }
+ @Override
+ public LispObject execute(LispObject arg) {
+ Pathname p = coerceToPathname(arg);
+ StringBuilder sb = new StringBuilder();
+ if (p.name instanceof AbstractString) {
+ sb.append(p.name.getStringValue());
+ } else if (p.name == Keyword.WILD) {
+ sb.append('*');
+ } else {
+ return NIL;
+ }
+ if (p.type instanceof AbstractString) {
+ sb.append('.');
+ sb.append(p.type.getStringValue());
+ } else if (p.type == Keyword.WILD) {
+ sb.append(".*");
+ }
+ return new SimpleString(sb);
+ }
+ }
- @Override
- public LispObject execute(LispObject arg) {
- Pathname p = coerceToPathname(arg);
- StringBuilder sb = new StringBuilder();
- if (p.name instanceof AbstractString) {
- sb.append(p.name.getStringValue());
- } else if (p.name == Keyword.WILD) {
- sb.append('*');
- } else {
- return NIL;
- }
- if (p.type instanceof AbstractString) {
- sb.append('.');
- sb.append(p.type.getStringValue());
- } else if (p.type == Keyword.WILD) {
- sb.append(".*");
- }
- return new SimpleString(sb);
- }
- };
// ### host-namestring pathname => namestring
- private static final Primitive HOST_NAMESTRING =
- new Primitive("host-namestring", "pathname") {
-
- @Override
- public LispObject execute(LispObject arg) {
- return coerceToPathname(arg).host;
- }
- };
+ private static final Primitive HOST_NAMESTRING = new host_namestring();
+ private static class host_namestring extends Primitive {
+ host_namestring() {
+ super("host-namestring", "pathname");
+ }
+ @Override
+ public LispObject execute(LispObject arg) {
+ return coerceToPathname(arg).host;
+ }
+ }
public String toString() {
return getNamestring();
Modified: trunk/abcl/src/org/armedbear/lisp/Utilities.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Utilities.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Utilities.java Wed Feb 10 11:22:21 2010
@@ -229,7 +229,7 @@
}
}
- static InputStream getInputStream(JarFile jarFile, Pathname inner) {
+ static InputStream getInputStream(ZipFile jarFile, Pathname inner) {
String entryPath = inner.asEntryPath();
ZipEntry entry = jarFile.getEntry(entryPath);
if (entry == null) {
Added: trunk/abcl/src/org/armedbear/lisp/ZipCache.java
==============================================================================
--- (empty file)
+++ trunk/abcl/src/org/armedbear/lisp/ZipCache.java Wed Feb 10 11:22:21 2010
@@ -0,0 +1,187 @@
+/*
+ * ZipCache.java
+ *
+ * Copyright (C) 2003-2007 Peter Graves
+ * $Id: Pathname.java 12435 2010-02-09 15:42:58Z mevenson $
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module. An independent module is a module which is not derived from
+ * or based on this library. If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so. If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+package org.armedbear.lisp;
+
+
+import static org.armedbear.lisp.Lisp.*;
+
+import java.io.File;
+import java.io.IOException;
+import java.net.JarURLConnection;
+import java.net.MalformedURLException;
+import java.net.URL;
+import java.net.URLConnection;
+import java.util.HashMap;
+import java.util.zip.ZipException;
+import java.util.zip.ZipFile;
+
+/**
+ * A cache for all zip/jar file accesses by URL that uses the last
+ * modified time of the cached resource.
+ */
+public class ZipCache {
+ static class Entry {
+ long lastModified;
+ ZipFile file;
+ }
+
+ static HashMap<URL, Entry> zipCache = new HashMap<URL, Entry>();
+
+ public static ZipFile get(LispObject arg) {
+ return get(Pathname.makeURL(arg));
+ }
+
+ public static ZipFile get(URL url) {
+ Entry entry = zipCache.get(url);
+ if (entry != null) {
+ if (url.getProtocol().equals("file")) {
+ File f = new File(url.getPath());
+ long current = f.lastModified();
+ if (current > entry.lastModified) {
+ try {
+ entry.file.close();
+ entry.file = new ZipFile(f);
+ entry.lastModified = current;
+ } catch (IOException e) {
+ Debug.trace(e.toString()); // XXX
+ }
+ }
+ } else {
+ // Unfortunately, the Apple JDK under OS X doesn't do
+ // HTTP HEAD requests, instead refetching the entire
+ // resource, so the following code is a waste. I assume
+ // this is the case in all Sun-dervied JVMs. We'll have
+ // to implement a custom HTTP lastModified checker.
+
+ // URLConnection connection;
+ // try {
+ // connection = url.openConnection();
+ // } catch (IOException ex) {
+ // Debug.trace("Failed to open "
+ // + "'" + url + "'");
+ // return null;
+ // }
+ // long current = connection.getLastModified();
+ // if (current > entry.lastModified) {
+ // try {
+ // entry.file.close();
+ // } catch (IOException ex) {}
+ // entry = fetchURL(url, false);
+ // }
+ }
+ } else {
+ if (url.getProtocol().equals("file")) {
+ entry = new Entry();
+ File f = new File(url.getPath());
+ entry.lastModified = f.lastModified();
+ try {
+ entry.file = new ZipFile(f);
+ } catch (ZipException e) {
+ Debug.trace(e); // XXX
+ return null;
+ } catch (IOException e) {
+ Debug.trace(e); // XXX
+ return null;
+ }
+ } else {
+ entry = fetchURL(url, true);
+ }
+ zipCache.put(url, entry);
+ }
+ return entry.file;
+ }
+
+ static private Entry fetchURL(URL url, boolean cached) {
+ Entry result = new Entry();
+ URL jarURL = null;
+ try {
+ jarURL = new URL("jar:" + url + "!/");
+ } catch (MalformedURLException e) {
+ Debug.trace(e);
+ Debug.assertTrue(false); // XXX
+ }
+ URLConnection connection;
+ try {
+ connection = jarURL.openConnection();
+ } catch (IOException ex) {
+ Debug.trace("Failed to open "
+ + "'" + jarURL + "'");
+ return null;
+ }
+ if (!(connection instanceof JarURLConnection)) {
+ // XXX
+ Debug.trace("Could not get a URLConnection from " + jarURL);
+ return null;
+ }
+ JarURLConnection jarURLConnection = (JarURLConnection) connection;
+ jarURLConnection.setUseCaches(cached);
+ try {
+ result.file = jarURLConnection.getJarFile();
+ } catch (IOException e) {
+ Debug.trace(e);
+ Debug.assertTrue(false); // XXX
+ }
+ result.lastModified = jarURLConnection.getLastModified();
+ return result;
+ }
+
+
+
+ // ## remove-zip-cache-entry pathname => boolean
+ private static final Primitive REMOVE_ZIP_CACHE_ENTRY = new remove_zip_cache_entry();
+ private static class remove_zip_cache_entry extends Primitive {
+ remove_zip_cache_entry() {
+ super("remove-zip-cache-entry", PACKAGE_SYS, true, "pathname");
+ }
+ @Override
+ public LispObject execute(LispObject arg) {
+ Pathname p = coerceToPathname(arg);
+ URL url = Pathname.makeURL(p);
+ boolean result = ZipCache.remove(url);
+ return result ? T : NIL;
+ }
+ }
+
+
+ public static boolean remove(URL url) {
+ Entry entry = zipCache.get(url);
+ if (entry != null) {
+ try {
+ entry.file.close();
+ } catch (IOException e) {}
+ zipCache.remove(entry);
+ return true;
+ }
+ return false;
+ }
+ }
\ No newline at end of file
Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Wed Feb 10 11:22:21 2010
@@ -567,6 +567,7 @@
while (not (eq line :eof))
do (write-line line out))))
(delete-file temp-file)
+ (remove-zip-cache-entry output-file) ;; Necessary under windows
(rename-file temp-file2 output-file)
(when *compile-file-zip*
More information about the armedbear-cvs
mailing list