[armedbear-cvs] r12650 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Sun May 2 19:58:58 UTC 2010
Author: ehuelsmann
Date: Sun May 2 15:58:56 2010
New Revision: 12650
Log:
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.
Modified:
trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java
trunk/abcl/src/org/armedbear/lisp/FaslReader.java
trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java
trunk/abcl/src/org/armedbear/lisp/Load.java
trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
trunk/abcl/src/org/armedbear/lisp/dump-form.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/AutoloadedFunctionProxy.java Sun May 2 15:58:56 2010
@@ -50,7 +50,6 @@
new Symbol[]
{
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
Symbol.LOAD_TRUENAME // LOAD-TIME-VALUE depends on this
Modified: trunk/abcl/src/org/armedbear/lisp/FaslReader.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/FaslReader.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/FaslReader.java Sun May 2 15:58:56 2010
@@ -141,12 +141,7 @@
{
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());
}
};
@@ -277,10 +272,41 @@
{
@Override
public LispObject execute(Stream stream, char c, int n)
-
{
return stream.readCharacterLiteral(FaslReadtable.getInstance(),
LispThread.currentThread());
}
};
+
+ // ### 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."));
+ }
+ };
+
}
Modified: trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/FaslReadtable.java Sun May 2 15:58:56 2010
@@ -100,6 +100,7 @@
dtfunctions[10] = LispReader.SHARP_ILLEGAL; // newline, linefeed
dtfunctions[12] = LispReader.SHARP_ILLEGAL; // page
dtfunctions[13] = LispReader.SHARP_ILLEGAL; // return
+ dtfunctions['?'] = FaslReader.FASL_SHARP_QUESTION_MARK;
dispatchTables.constants['#'] = dt;
readtableCase = Keyword.UPCASE;
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 Sun May 2 15:58:56 2010
@@ -361,7 +361,7 @@
// ### *fasl-version*
// 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*
// internal symbol
@@ -369,16 +369,6 @@
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*
// internal symbol
/**
@@ -404,7 +394,6 @@
if (second.eql(_FASL_VERSION_.getSymbolValue())) {
// OK
final LispThread thread = LispThread.currentThread();
- thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, NIL);
thread.bindSpecial(_FASL_UNINTERNED_SYMBOLS_, NIL);
thread.bindSpecial(_SOURCE_, NIL);
return faslLoadStream(thread);
@@ -595,7 +584,6 @@
final SpecialBindingsMark mark = thread.markSpecialBindings();
LispObject result = NIL;
try {
- thread.bindSpecial(_FASL_ANONYMOUS_PACKAGE_, new Package());
thread.bindSpecial(AUTOLOADING_CACHE,
AutoloadedFunctionProxy.makePreloadingContext());
in.setExternalFormat(_FASL_EXTERNAL_FORMAT_.symbolValue(thread));
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 Sun May 2 15:58:56 2010
@@ -69,13 +69,13 @@
(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*))
(report-error
(load-compiled-function classfile))))
t))
-
+
(declaim (ftype (function (t) t) process-defconstant))
(defun process-defconstant (form)
;; "If a DEFCONSTANT form appears as a top level form, the compiler
@@ -514,7 +514,8 @@
(*class-number* 0)
(namestring (namestring *compile-file-truename*))
(start (get-internal-real-time))
- elapsed)
+ elapsed
+ *fasl-uninterned-symbols*)
(when *compile-verbose*
(format t "; Compiling ~A ...~%" namestring))
(with-compilation-unit ()
@@ -527,7 +528,6 @@
(*package* *package*)
(jvm::*functions-defined-in-current-file* '())
(*fbound-names* '())
- (*fasl-anonymous-package* (%make-package))
(*fasl-stream* out)
*forms-for-output*)
(jvm::with-saved-compiler-policy
@@ -565,19 +565,32 @@
;; write header
(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)
(%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"
- ,(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))
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 Sun May 2 15:58:56 2010
@@ -8760,7 +8760,6 @@
(*visible-variables* nil)
(*local-functions* nil)
(*pathnames-generator* (constantly nil))
- (sys::*fasl-anonymous-package* (sys::%make-package))
environment)
(unless (and (consp definition) (eq (car definition) 'LAMBDA))
(let ((function definition))
Modified: trunk/abcl/src/org/armedbear/lisp/dump-form.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dump-form.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/dump-form.lisp Sun May 2 15:58:56 2010
@@ -103,6 +103,16 @@
(standard-object-p object)
(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))))
More information about the armedbear-cvs
mailing list