[armedbear-cvs] r12306 - trunk/abcl/src/org/armedbear/lisp

Erik Huelsmann ehuelsmann at common-lisp.net
Fri Dec 25 21:52:27 UTC 2009


Author: ehuelsmann
Date: Fri Dec 25 16:52:23 2009
New Revision: 12306

Log:
Land fast-boot-preloading branch on trunk.

Note: things to do include
 1. Applying the same strategy to macro functions
 2. Applying the same strategy to functions which get loaded during 
      EVAL-WHEN when compiling

Added:
   trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java
      - copied unchanged from r12305, /branches/fast-boot-preloading/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java
Modified:
   trunk/abcl/src/org/armedbear/lisp/Autoload.java
   trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
   trunk/abcl/src/org/armedbear/lisp/Lisp.java
   trunk/abcl/src/org/armedbear/lisp/Load.java
   trunk/abcl/src/org/armedbear/lisp/Symbol.java
   trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.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	Fri Dec 25 16:52:23 2009
@@ -664,6 +664,13 @@
         autoload(PACKAGE_SYS, "std-allocate-instance", "StandardObjectFunctions", true);
         autoload(PACKAGE_SYS, "zip", "zip", true);
 
+        autoload(PACKAGE_SYS, "proxy-preloaded-function",
+                 "AutoloadedFunctionProxy", false);
+        autoload(PACKAGE_SYS, "make-function-preloading-context",
+                 "AutoloadedFunctionProxy", false);
+        autoload(PACKAGE_SYS, "function-preload",
+                 "AutoloadedFunctionProxy", false);
+
         autoload(Symbol.COPY_LIST, "copy_list");
 
         autoload(Symbol.SET_CHAR, "StringFunctions");

Modified: trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java	Fri Dec 25 16:52:23 2009
@@ -219,11 +219,13 @@
         namestring = ((Pathname)arg).getNamestring();
       else if (arg instanceof AbstractString)
         namestring = arg.getStringValue();
-      if (namestring != null)
-        return loadCompiledFunction(namestring);
+      if (namestring != null) {
+          //    Debug.trace("autoloading preloaded ... " + namestring);
+        return AutoloadedFunctionProxy.loadPreloadedFunction(namestring);
+      }
       if(arg instanceof JavaObject) {
 	  try {
-	      return loadCompiledFunction((byte[]) arg.javaInstance(byte[].class));
+	      return loadClassBytes((byte[]) arg.javaInstance(byte[].class));
 	  } catch(Throwable t) {
 	      Debug.trace(t);
 	      return error(new LispError("Unable to load " + arg.writeToString()));

Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java	Fri Dec 25 16:52:23 2009
@@ -288,7 +288,7 @@
           {
             throw c;
           }
-        catch (Throwable t)
+        catch (Throwable t) // ControlTransfer handled above
           {
             Debug.trace(t);
             thread.setSpecialVariable(_SAVED_BACKTRACE_,
@@ -1204,6 +1204,15 @@
   public static final LispObject loadCompiledFunction(final String namestring)
 
   {
+      byte[] bytes = readFunctionBytes(namestring);
+      if (bytes != null)
+        return loadClassBytes(bytes);
+
+      return null;
+  }
+
+  public static final byte[] readFunctionBytes(final String namestring)
+  {
     final LispThread thread = LispThread.currentThread();
     final boolean absolute = Utilities.isFilenameAbsolute(namestring);
     LispObject device = NIL;
@@ -1276,8 +1285,7 @@
                               {
                                 long size = entry.getSize();
                                 InputStream in = zipFile.getInputStream(entry);
-                                LispObject obj = loadCompiledFunction(in, (int) size);
-                                return obj != null ? obj : NIL;
+                                return readFunctionBytes(in, (int) size);
                               }
                             else 
                               {
@@ -1285,13 +1293,10 @@
                                 entryName 
                                   = defaultPathname.name.getStringValue() 
                                   + "." +  "abcl";//defaultPathname.type.getStringValue();
-                                byte in[] 
-                                  = Utilities
-                                  .getZippedZipEntryAsByteArray(zipFile, 
+                                return Utilities
+                                  .getZippedZipEntryAsByteArray(zipFile,
                                                                 entryName,
                                                                 namestring);
-                                LispObject o = loadCompiledFunction(in);
-                                return o != null ? o : NIL;
                               }
                           }
                         finally
@@ -1301,88 +1306,107 @@
                       }
                   }
               }
+            catch (VerifyError e)
+              {
+                error(new LispError("Class verification failed: " +
+                                    e.getMessage()));
+                return null; // not reached
+              }
             catch (IOException e)
               {
                 Debug.trace(e);
               }
           }
-        return error(new LispError("Unable to load " + namestring));
+        error(new LispError("Unable to load " + namestring));
+        return null; // not reached
       }
     Pathname pathname = new Pathname(namestring);
     final File file = Utilities.getFile(pathname, defaultPathname);
     if (file != null && file.isFile())
       {
         // The .cls file exists.
-        LispObject obj = null;
-        try {
-            obj = loadCompiledFunction(new FileInputStream(file),
-                                       (int) file.length());
-        }
-        catch (FileNotFoundException e) {
-            return error(new LispError("Unable to load " +
-                         pathname.writeToString() + ": Not found."));
+        try
+          {
+            byte[] bytes = readFunctionBytes(new FileInputStream(file),
+                                             (int) file.length());
+            // FIXME close stream!
+            if (bytes != null)
+              return bytes;
+          }
+        catch (FileNotFoundException fnf) {
+            error(new LispError("Unable to load " + pathname.writeToString()
+                                + ": " + fnf.getMessage()));
+            return null; // not reached
         }
-        // FIXME close stream!
-        if (obj != null)
-          return obj;
-        return error(new LispError("Unable to load " +
-                                    pathname.writeToString()));
-      }
-    LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread);
-    String zipFileName = ((Pathname)loadTruename).getNamestring();
-    ZipFile zipFile = null;
+        return null; // not reached
+      }
     try
       {
-        zipFile = ZipCache.getZip(zipFileName);
-        ZipEntry entry = zipFile.getEntry(namestring);
-        if (entry != null)
+        LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread);
+        String zipFileName = ((Pathname)loadTruename).getNamestring();
+        ZipFile zipFile = ZipCache.getZip(zipFileName);
+        try
           {
-            LispObject obj = null;
-            try {
-                obj = loadCompiledFunction(zipFile.getInputStream(entry),
-                                                  (int) entry.getSize());
-            }
-            catch (IOException ignore) { };
-            if (obj != null)
-              return obj;
-            Debug.trace("Unable to load " + namestring);
-            return error(new LispError("Unable to load " + namestring));
+            ZipEntry entry = zipFile.getEntry(namestring);
+            if (entry != null)
+              {
+                byte[] bytes = readFunctionBytes(zipFile.getInputStream(entry),
+                                                 (int) entry.getSize());
+                if (bytes != null)
+                  return bytes;
+                Debug.trace("Unable to load " + namestring);
+                error(new LispError("Unable to load " + namestring));
+                return null; // not reached
+              }
+          }
+        finally
+          {
+            ZipCache.removeZip(zipFile.getName());
           }
       }
-    catch (IOException ignore) {
-        //ignore IOException from ZipCache.getZip()
-    }
-    finally
+    catch (IOException t)
       {
-        try {
-            ZipCache.removeZip(zipFile.getName());
+        Debug.trace(t);
+      }
+    error(new FileError("File not found: " + namestring,
+                        new Pathname(namestring)));
+    return null; // not reached
+  }
+
+    public static final Function makeCompiledFunctionFromClass(Class<?> c) {
+      try {
+	if (c != null) {
+	    Function obj = (Function)c.newInstance();
+	    return obj;
+        } else {
+            return null;
         }
-        catch (IOException ignore) { } // ignore
       }
-    return error(new FileError("File not found: " + namestring,
-                                new Pathname(namestring)));
-  }
+      catch (InstantiationException e) {} // ### FIXME
+      catch (IllegalAccessException e) {} // ### FIXME
 
-    public static final LispObject makeCompiledFunctionFromClass(Class<?> c) {
-	if (c != null)
-        try {
-            return (LispObject)c.newInstance();
-        }
-        catch (InstantiationException ignore) {
-            // ignore
-        }
-        catch (IllegalAccessException ignore) {
-            // ignore
-        }
-    return null;
+      return null;
     }
 
-  private static final LispObject loadCompiledFunction(InputStream in, int size)
+
+  public static final LispObject loadCompiledFunction(InputStream in, int size)
   {
-    byte[] bytes = new byte[size];
-    int bytesRemaining = size;
-    int bytesRead = 0;
-    try {
+      byte[] bytes = readFunctionBytes(in, size);
+      if (bytes != null)
+        return loadClassBytes(bytes);
+      else
+        return error(new FileError("Can't read file off stream."));
+  }
+
+
+
+  private static final byte[] readFunctionBytes(InputStream in, int size)
+  {
+    try
+      {
+        byte[] bytes = new byte[size];
+        int bytesRemaining = size;
+        int bytesRead = 0;
         while (bytesRemaining > 0)
           {
             int n = in.read(bytes, bytesRead, bytesRemaining);
@@ -1392,27 +1416,32 @@
             bytesRemaining -= n;
           }
         in.close();
-    }
-    catch (IOException e) {
-        return null; // fixme: return an error?
-    }
-    if (bytesRemaining > 0)
-      Debug.trace("bytesRemaining = " + bytesRemaining);
+        if (bytesRemaining > 0)
+          Debug.trace("bytesRemaining = " + bytesRemaining);
 
-    return loadCompiledFunction(bytes);
+        return bytes;
+      }
+    catch (IOException t)
+      {
+        Debug.trace(t); // FIXME: call error()?
+      }
+    return null;
   }
 
-    public static final LispObject loadCompiledFunction(byte[] bytes) {
-        return loadCompiledFunction(bytes, new JavaClassLoader());
+    public static final Function loadClassBytes(byte[] bytes)
+    {
+    	return loadClassBytes(bytes, new JavaClassLoader());
     }
 
-    public static final LispObject loadCompiledFunction(byte[] bytes, JavaClassLoader cl) {
+    public static final Function loadClassBytes(byte[] bytes,
+                                                JavaClassLoader cl)
+    {
         Class<?> c = cl.loadClassFromByteArray(null, bytes, 0, bytes.length);
-        LispObject obj = makeCompiledFunctionFromClass(c);
-        if (obj instanceof Function) {
-            ((Function)obj).setClassBytes(bytes);
-        }
-        return obj;
+	Function obj = makeCompiledFunctionFromClass(c);
+	if (obj != null) {
+	    obj.setClassBytes(bytes);
+	}
+	return obj;
     }
 
 
@@ -2442,6 +2471,10 @@
   public static final Symbol _AUTOLOAD_VERBOSE_ =
     exportSpecial("*AUTOLOAD-VERBOSE*", PACKAGE_EXT, NIL);
 
+  // ### *preloading-cache*
+ public static final Symbol AUTOLOADING_CACHE =
+   internSpecial("*AUTOLOADING-CACHE*", PACKAGE_SYS, NIL);
+
   // ### *compile-file-type*
   public static final String COMPILE_FILE_TYPE = "abcl";
   public static final Symbol _COMPILE_FILE_TYPE_ =

Modified: trunk/abcl/src/org/armedbear/lisp/Load.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Load.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Load.java	Fri Dec 25 16:52:23 2009
@@ -44,6 +44,7 @@
 import java.io.InputStream;
 import java.net.URL;
 import java.net.URLDecoder;
+import java.util.Hashtable;
 import java.util.zip.ZipEntry;
 import java.util.zip.ZipException;
 import java.util.zip.ZipFile;
@@ -606,6 +607,8 @@
         LispObject result = NIL;
         try {
             thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, new Package());
+            thread.bindSpecial(AUTOLOADING_CACHE,
+                               AutoloadedFunctionProxy.makePreloadingContext());
             while (true) {
                 LispObject obj = in.faslRead(false, EOF, true, thread);
                 if (obj == EOF)

Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java	Fri Dec 25 16:52:23 2009
@@ -3014,10 +3014,14 @@
     PACKAGE_SYS.addInternalSymbol("FORMAT-CONTROL");
   public static final Symbol FSET =
     PACKAGE_SYS.addInternalSymbol("FSET");
+  public static final Symbol FUNCTION_PRELOAD =
+    PACKAGE_SYS.addInternalSymbol("FUNCTION-PRELOAD");
   public static final Symbol INSTANCE =
     PACKAGE_SYS.addInternalSymbol("INSTANCE");
   public static final Symbol MACROEXPAND_MACRO =
     PACKAGE_SYS.addInternalSymbol("MACROEXPAND-MACRO");
+  public static final Symbol MAKE_FUNCTION_PRELOADING_CONTEXT =
+    PACKAGE_SYS.addInternalSymbol("MAKE-FUNCTION-PRELOADING-CONTEXT");
   public static final Symbol NAME =
     PACKAGE_SYS.addInternalSymbol("NAME");
   public static final Symbol OBJECT =
@@ -3026,6 +3030,8 @@
     PACKAGE_SYS.addInternalSymbol("OPERANDS");
   public static final Symbol OPERATION =
     PACKAGE_SYS.addInternalSymbol("OPERATION");
+  public static final Symbol PROXY_PRELOADED_FUNCTION =
+    PACKAGE_SYS.addInternalSymbol("PROXY-PRELOADED-FUNCTION");
   public static final Symbol _SOURCE =
     PACKAGE_SYS.addInternalSymbol("%SOURCE");
   public static final Symbol SOCKET_STREAM =

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	Fri Dec 25 16:52:23 2009
@@ -160,7 +160,7 @@
                      (compiled-function
                       (setf form
                             `(fset ',name
-                                   (load-compiled-function ,(file-namestring classfile))
+                                   (proxy-preloaded-function ',name ,(file-namestring classfile))
                                    ,*source-position*
                                    ',lambda-list
                                    ,doc))
@@ -484,6 +484,8 @@
          (type (pathname-type output-file))
          (temp-file (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp"))
                                      output-file))
+         (temp-file2 (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp2"))
+                                     output-file))
          (warnings-p nil)
          (failure-p nil))
     (with-open-file (in input-file :direction :input)
@@ -510,15 +512,6 @@
                   *forms-for-output*)
               (jvm::with-saved-compiler-policy
                   (jvm::with-file-compilation
-                      (write "; -*- Mode: Lisp -*-" :escape nil :stream out)
-                    (%stream-terpri out)
-                    (let ((*package* (find-package '#:cl)))
-                      (write (list 'init-fasl :version *fasl-version*)
-                             :stream out)
-                      (%stream-terpri out)
-                      (write (list 'setq '*source* *compile-file-truename*)
-                             :stream out)
-                      (%stream-terpri out))
                     (handler-bind ((style-warning #'(lambda (c)
                                                       (setf warnings-p t)
                                                       ;; let outer handlers
@@ -544,7 +537,34 @@
                     (finalize-fasl-output)
                     (dolist (name *fbound-names*)
                       (fmakunbound name)))))))
-        (rename-file temp-file output-file)
+        (with-open-file (in temp-file :direction :input)
+          (with-open-file (out temp-file2 :direction :output
+                               :if-does-not-exist :create
+                               :if-exists :supersede)
+            ;; write header
+            (write "; -*- Mode: Lisp -*-" :escape nil :stream out)
+            (%stream-terpri out)
+            (let ((*package* (find-package '#:cl))
+                  (count-sym (gensym)))
+              (write (list 'init-fasl :version *fasl-version*)
+                     :stream out)
+              (%stream-terpri out)
+              (write (list 'setq '*source* *compile-file-truename*)
+                     :stream out)
+              (%stream-terpri out)
+              (dump-form `(dotimes (,count-sym ,*class-number*)
+                            (function-preload
+                             (%format nil "~A-~D.cls" ,(pathname-name output-file)
+                                      (1+ ,count-sym)))) out)
+              (%stream-terpri out))
+
+
+            ;; copy remaining content
+            (loop for line = (read-line in nil :eof)
+               while (not (eq line :eof))
+               do (write-line line out))))
+        (delete-file temp-file)
+        (rename-file temp-file2 output-file)
 
         (when *compile-file-zip*
           (let* ((type ;; Don't use ".zip", it'll result in an extension

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Fri Dec 25 16:52:23 2009
@@ -2070,7 +2070,7 @@
      ;; fixme *declare-inline*
      (declare-field g +lisp-object+ +field-access-default+)
      (emit 'ldc (pool-string (file-namestring pathname)))
-     (emit-invokestatic +lisp-class+ "loadCompiledFunction"
+     (emit-invokestatic "org/armedbear/lisp/AutoloadedFunctionProxy" "loadPreloadedFunction"
 			(list +java-string+) +lisp-object+)
      (emit 'putstatic *this-class* g +lisp-object+)
      (setf *static-code* *code*)




More information about the armedbear-cvs mailing list