Changeset 12650


Ignore:
Timestamp:
05/02/10 19:58:56 (11 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:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java

    r12649 r12650  
    5151        {
    5252            AUTOLOADING_CACHE, // allow loading local preloaded functions
    53             Load._FASL_ANONYMOUS_PACKAGE_, // package for uninterned symbols
    5453            Load._FASL_UNINTERNED_SYMBOLS_, // vector of uninterned symbols
    5554            Symbol._PACKAGE_,              // current package
  • trunk/abcl/src/org/armedbear/lisp/FaslReader.java

    r12604 r12650  
    142142        {
    143143            LispThread thread = LispThread.currentThread();
    144             Symbol symbol = (Symbol) stream.readSymbol(FaslReadtable.getInstance());
    145             LispObject pkg = Load._FASL_ANONYMOUS_PACKAGE_.symbolValue(thread);
    146             Debug.assertTrue(pkg != NIL);
    147             symbol = ((Package)pkg).intern(symbol.getName());
    148             symbol.setPackage(NIL);
    149             return symbol;
     144            return stream.readSymbol(FaslReadtable.getInstance());
    150145        }
    151146    };
     
    278273        @Override
    279274        public LispObject execute(Stream stream, char c, int n)
    280 
    281275        {
    282276            return stream.readCharacterLiteral(FaslReadtable.getInstance(),
     
    284278        }
    285279    };
     280
     281    // ### fasl-sharp-question-mark
     282    public static final DispatchMacroFunction FASL_SHARP_QUESTION_MARK =
     283        new DispatchMacroFunction("fasl-sharp-question-mark", PACKAGE_SYS,
     284                                  false, "stream sub-char numarg")
     285    {
     286        @Override
     287        public LispObject execute(Stream stream, char c, int n)
     288        {
     289            LispThread thread = LispThread.currentThread();
     290            LispObject uninternedSymbols =
     291                Load._FASL_UNINTERNED_SYMBOLS_.symbolValue(thread);
     292
     293            if (! (uninternedSymbols instanceof Cons)) // it must be a vector
     294                return uninternedSymbols.AREF(n);
     295
     296            // During normal loading, we won't get to this bit, however,
     297            // with eval-when processing, we may need to fall back to
     298            // *FASL-UNINTERNED-SYMBOLS* being an alist structure
     299            LispObject label = LispInteger.getInstance(n);
     300            while (uninternedSymbols != NIL)
     301              {
     302                LispObject item = uninternedSymbols.car();
     303                if (label.eql(item.cdr()))
     304                  return item.car();
     305
     306                uninternedSymbols = uninternedSymbols.cdr();
     307              }
     308            return error(new LispError("No entry for uninterned symbol."));
     309        }
     310    };
     311
    286312}
  • trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java

    r12591 r12650  
    101101        dtfunctions[12]   = LispReader.SHARP_ILLEGAL; // page
    102102        dtfunctions[13]   = LispReader.SHARP_ILLEGAL; // return
     103        dtfunctions['?']  = FaslReader.FASL_SHARP_QUESTION_MARK;
    103104        dispatchTables.constants['#'] = dt;
    104105
  • trunk/abcl/src/org/armedbear/lisp/Load.java

    r12649 r12650  
    362362    // internal symbol
    363363    static final Symbol _FASL_VERSION_ =
    364         exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(35));
     364        exportConstant("*FASL-VERSION*", PACKAGE_SYS, Fixnum.getInstance(36));
    365365
    366366    // ### *fasl-external-format*
     
    369369        internConstant("*FASL-EXTERNAL-FORMAT*", PACKAGE_SYS,
    370370                       new SimpleString("UTF-8"));
    371 
    372     // ### *fasl-anonymous-package*
    373     // internal symbol
    374     /**
    375      * This variable gets bound to a package with no name in which the
    376      * reader can intern its uninterned symbols.
    377      *
    378      */
    379     public static final Symbol _FASL_ANONYMOUS_PACKAGE_ =
    380         internSpecial("*FASL-ANONYMOUS-PACKAGE*", PACKAGE_SYS, NIL);
    381371
    382372    // ### *fasl-uninterned-symbols*
     
    405395                    // OK
    406396                    final LispThread thread = LispThread.currentThread();
    407                     thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, NIL);
    408397                    thread.bindSpecial(_FASL_UNINTERNED_SYMBOLS_, NIL);
    409398                    thread.bindSpecial(_SOURCE_, NIL);
     
    596585        LispObject result = NIL;
    597586        try {
    598             thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, new Package());
    599587            thread.bindSpecial(AUTOLOADING_CACHE,
    600588                               AutoloadedFunctionProxy.makePreloadingContext());
  • trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

    r12626 r12650  
    7070(declaim (ftype (function (t) t) verify-load))
    7171(defun verify-load (classfile)
    72   (if (> *safety* 0) 
     72  (if (> *safety* 0)
    7373    (and classfile
    7474         (let ((*load-truename* *output-file-pathname*))
     
    7676            (load-compiled-function classfile))))
    7777    t))
    78    
     78
    7979(declaim (ftype (function (t) t) process-defconstant))
    8080(defun process-defconstant (form)
     
    515515             (namestring (namestring *compile-file-truename*))
    516516             (start (get-internal-real-time))
    517              elapsed)
     517             elapsed
     518             *fasl-uninterned-symbols*)
    518519        (when *compile-verbose*
    519520          (format t "; Compiling ~A ...~%" namestring))
     
    528529                  (jvm::*functions-defined-in-current-file* '())
    529530                  (*fbound-names* '())
    530                   (*fasl-anonymous-package* (%make-package))
    531531                  (*fasl-stream* out)
    532532                  *forms-for-output*)
     
    566566            (write "; -*- Mode: Lisp -*-" :escape nil :stream out)
    567567            (%stream-terpri out)
    568             (let ((*package* (find-package '#:cl))
    569                   (count-sym (gensym)))
     568            (let ((*package* (find-package '#:cl)))
    570569              (write (list 'init-fasl :version *fasl-version*)
    571570                     :stream out)
     
    574573                     :stream out)
    575574              (%stream-terpri out)
    576               (dump-form `(dotimes (,count-sym ,*class-number*)
    577                             (function-preload
    578                              (%format nil "~A-~D.cls"
    579                                       ,(substitute #\_ #\. (pathname-name output-file))
    580                                       (1+ ,count-sym)))) out)
     575              ;; Note: Beyond this point, you can't use DUMP-FORM,
     576              ;; because the list of uninterned symbols has been fixed now.
     577              (when *fasl-uninterned-symbols*
     578                (write (list 'setq '*fasl-uninterned-symbols*
     579                             (coerce (mapcar #'car
     580                                             (nreverse *fasl-uninterned-symbols*))
     581                                     'vector))
     582                       :stream out))
     583              (%stream-terpri out)
     584              ;; we work with a fixed variable name here to work around the
     585              ;; lack of availability of the circle reader in the fasl reader
     586              ;; but it's a toplevel form anyway
     587              (write `(dotimes (i ,*class-number*)
     588                        (function-preload
     589                         (%format nil "~A-~D.cls"
     590                                  ,(substitute #\_ #\. (pathname-name output-file))
     591                                  (1+ i))))
     592                     :stream out
     593                     :circle t)
    581594              (%stream-terpri out))
    582595
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12639 r12650  
    87618761        (*local-functions* nil)
    87628762        (*pathnames-generator* (constantly nil))
    8763         (sys::*fasl-anonymous-package* (sys::%make-package))
    87648763        environment)
    87658764    (unless (and (consp definition) (eq (car definition) 'LAMBDA))
  • trunk/abcl/src/org/armedbear/lisp/dump-form.lisp

    r11566 r12650  
    104104             (java:java-object-p object))
    105105         (dump-instance object stream))
     106        ((and (symbolp object) ;; uninterned symbol
     107              (null (symbol-package object)))
     108         (let ((index (cdr (assoc object *fasl-uninterned-symbols*))))
     109           (unless index
     110             (setq index (1+ (or (cdar *fasl-uninterned-symbols*) -1)))
     111             (setq *fasl-uninterned-symbols*
     112                   (acons object index *fasl-uninterned-symbols*)))
     113           (write-string "#" stream)
     114           (write index :stream stream)
     115           (write-string "?" stream)))
    106116        (t
    107117         (%stream-output-object object stream))))
Note: See TracChangeset for help on using the changeset viewer.