Changeset 12650 for trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

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.

File:

• trunk/abcl/src/org/armedbear/lisp/compile-file.lisp (modified) (6 diffs)

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))