Changeset 12650

Timestamp:

05/02/10 19:58:56 (13 years ago)

Author:

ehuelsmann

Message:

Fix #79: Equally named -but different- uninterned symbols coalesced into
one in FASLs.

This commit removes the *FASL-ANONYMOUS-PACKAGE*: it's replaced by
*FASL-UNINTERNED-SYMBOLS* and a dispatch macro function which resolves
symbols by index instead of by name.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• AutoloadedFunctionProxy.java (modified) (1 diff)
• FaslReader.java (modified) (3 diffs)
• FaslReadtable.java (modified) (1 diff)
• Load.java (modified) (4 diffs)
• compile-file.lisp (modified) (6 diffs)
• compiler-pass2.lisp (modified) (1 diff)
• dump-form.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java

@@ -51 +51 @@
         {
             AUTOLOADING_CACHE, // allow loading local preloaded functions
-            Load._FASL_ANONYMOUS_PACKAGE_, // package for uninterned symbols
             Load._FASL_UNINTERNED_SYMBOLS_, // vector of uninterned symbols
             Symbol._PACKAGE_,              // current package

trunk/abcl/src/org/armedbear/lisp/FaslReader.java

@@ -142 +142 @@
         {
             LispThread thread = LispThread.currentThread();
-            Symbol symbol = (Symbol) stream.readSymbol(FaslReadtable.getInstance());
-            LispObject pkg = Load._FASL_ANONYMOUS_PACKAGE_.symbolValue(thread);
-            Debug.assertTrue(pkg != NIL);
-            symbol = ((Package)pkg).intern(symbol.getName());
-            symbol.setPackage(NIL);
-            return symbol;
+            return stream.readSymbol(FaslReadtable.getInstance());
         }
     };
@@ -278 +273 @@
         @Override
         public LispObject execute(Stream stream, char c, int n)
-
         {
             return stream.readCharacterLiteral(FaslReadtable.getInstance(),
@@ -284 +278 @@
         }
     };
+
+    // ### fasl-sharp-question-mark
+    public static final DispatchMacroFunction FASL_SHARP_QUESTION_MARK =
+        new DispatchMacroFunction("fasl-sharp-question-mark", PACKAGE_SYS,
+                                  false, "stream sub-char numarg")
+    {
+        @Override
+        public LispObject execute(Stream stream, char c, int n)
+        {
+            LispThread thread = LispThread.currentThread();
+            LispObject uninternedSymbols =
+                Load._FASL_UNINTERNED_SYMBOLS_.symbolValue(thread);
+
+            if (! (uninternedSymbols instanceof Cons)) // it must be a vector
+                return uninternedSymbols.AREF(n);
+
+            // During normal loading, we won't get to this bit, however,
+            // with eval-when processing, we may need to fall back to
+            // *FASL-UNINTERNED-SYMBOLS* being an alist structure
+            LispObject label = LispInteger.getInstance(n);
+            while (uninternedSymbols != NIL)
+              {
+                LispObject item = uninternedSymbols.car();
+                if (label.eql(item.cdr()))
+                  return item.car();
+
+                uninternedSymbols = uninternedSymbols.cdr();
+              }
+            return error(new LispError("No entry for uninterned symbol."));
+        }
+    };
+
 }

trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java

@@ -101 +101 @@
         dtfunctions[12]   = LispReader.SHARP_ILLEGAL; // page
         dtfunctions[13]   = LispReader.SHARP_ILLEGAL; // return
+        dtfunctions['?']  = FaslReader.FASL_SHARP_QUESTION_MARK;
         dispatchTables.constants['#'] = dt;
 

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

@@ -362 +362 @@
     // internal symbol
     static final Symbol _FASL_VERSION_ =
-        exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(35));
+        exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(36));
 
     // ### *fasl-external-format*
@@ -369 +369 @@
         internConstant("*FASL-EXTERNAL-FORMAT*", PACKAGE_SYS,
                        new SimpleString("UTF-8"));
-
-    // ### *fasl-anonymous-package*
-    // internal symbol
-    /**
-     * This variable gets bound to a package with no name in which the
-     * reader can intern its uninterned symbols.
-     *
-     */
-    public static final Symbol _FASL_ANONYMOUS_PACKAGE_ =
-        internSpecial("*FASL-ANONYMOUS-PACKAGE*", PACKAGE_SYS, NIL);
 
     // ### *fasl-uninterned-symbols*
@@ -405 +395 @@
                     // OK
                     final LispThread thread = LispThread.currentThread();
-                    thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, NIL);
                     thread.bindSpecial(_FASL_UNINTERNED_SYMBOLS_, NIL);
                     thread.bindSpecial(_SOURCE_, NIL);
@@ -596 +585 @@
         LispObject result = NIL;
         try {
-            thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, new Package());
             thread.bindSpecial(AUTOLOADING_CACHE,
                                AutoloadedFunctionProxy.makePreloadingContext());

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

@@ -70 +70 @@
 (declaim (ftype (function (t) t) verify-load))
 (defun verify-load (classfile)
-  (if (> *safety* 0) 
+  (if (> *safety* 0)
     (and classfile
          (let ((*load-truename* *output-file-pathname*))
@@ -76 +76 @@
             (load-compiled-function classfile))))
     t))
-    
+
 (declaim (ftype (function (t) t) process-defconstant))
 (defun process-defconstant (form)
@@ -515 +515 @@
              (namestring (namestring *compile-file-truename*))
              (start (get-internal-real-time))
-             elapsed)
+             elapsed
+             *fasl-uninterned-symbols*)
         (when *compile-verbose*
           (format t "; Compiling ~A ...~%" namestring))
@@ -528 +529 @@
                   (jvm::*functions-defined-in-current-file* '())
                   (*fbound-names* '())
-                  (*fasl-anonymous-package* (%make-package))
                   (*fasl-stream* out)
                   *forms-for-output*)
@@ -566 +566 @@
             (write "; -*- Mode: Lisp -*-" :escape nil :stream out)
             (%stream-terpri out)
-            (let ((*package* (find-package '#:cl))
-                  (count-sym (gensym)))
+            (let ((*package* (find-package '#:cl)))
               (write (list 'init-fasl :version *fasl-version*)
                      :stream out)
@@ -574 +573 @@
                      :stream out)
               (%stream-terpri out)
-              (dump-form `(dotimes (,count-sym ,*class-number*)
-                            (function-preload
-                             (%format nil "~A-~D.cls" 
-                                      ,(substitute #\_ #\. (pathname-name output-file))
-                                      (1+ ,count-sym)))) out)
+              ;; Note: Beyond this point, you can't use DUMP-FORM,
+              ;; because the list of uninterned symbols has been fixed now.
+              (when *fasl-uninterned-symbols*
+                (write (list 'setq '*fasl-uninterned-symbols*
+                             (coerce (mapcar #'car
+                                             (nreverse *fasl-uninterned-symbols*))
+                                     'vector))
+                       :stream out))
+              (%stream-terpri out)
+              ;; we work with a fixed variable name here to work around the
+              ;; lack of availability of the circle reader in the fasl reader
+              ;; but it's a toplevel form anyway
+              (write `(dotimes (i ,*class-number*)
+                        (function-preload
+                         (%format nil "~A-~D.cls"
+                                  ,(substitute #\_ #\. (pathname-name output-file))
+                                  (1+ i))))
+                     :stream out
+                     :circle t)
               (%stream-terpri out))
 

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

@@ -8761 +8761 @@
         (*local-functions* nil)
         (*pathnames-generator* (constantly nil))
-        (sys::*fasl-anonymous-package* (sys::%make-package))
         environment)
     (unless (and (consp definition) (eq (car definition) 'LAMBDA))

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

@@ -104 +104 @@
              (java:java-object-p object))
          (dump-instance object stream))
+        ((and (symbolp object) ;; uninterned symbol
+              (null (symbol-package object)))
+         (let ((index (cdr (assoc object *fasl-uninterned-symbols*))))
+           (unless index
+             (setq index (1+ (or (cdar *fasl-uninterned-symbols*) -1)))
+             (setq *fasl-uninterned-symbols*
+                   (acons object index *fasl-uninterned-symbols*)))
+           (write-string "#" stream)
+           (write index :stream stream)
+           (write-string "?" stream)))
         (t
          (%stream-output-object object stream))))