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

[Erik Huelsmann]

Author: ehuelsmann
Date: Wed May 19 18:29:03 2010
New Revision: 12711

Log:
No longer use the reader to load "stand alone" uninterned symbols,
instead, inline calls to the array element 'getter'.

Modified:
   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/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Wed May 19 18:29:03 2010
@@ -213,6 +213,7 @@
 (defconstant +lisp-structure-object-class+ "org/armedbear/lisp/StructureObject")
 (defconstant +lisp-thread-class+ "org/armedbear/lisp/LispThread")
 (defconstant +lisp-thread+ "Lorg/armedbear/lisp/LispThread;")
+(defconstant +lisp-load-class+ "org/armedbear/lisp/Load")
 (defconstant +lisp-cons-class+ "org/armedbear/lisp/Cons")
 (defconstant +lisp-cons+ "Lorg/armedbear/lisp/Cons;")
 (defconstant +lisp-integer-class+ "org/armedbear/lisp/LispInteger")
@@ -2150,13 +2151,9 @@
       (name
        (emit 'getstatic class name +lisp-symbol+))
       ((null (symbol-package symbol))
-       ;; we need to read the #?<n> syntax for uninterned symbols
-
-       ;; TODO: we could use the byte code variant of
-       ;; Load._FASL_UNINTERNED_SYMBOLS_.symbolValue(LispThread.currentThread())
-       ;;    .aref(<index)
-       ;; to eliminate the reader dependency
-       (serialize-object symbol)
+       (emit-push-constant-int (dump-uninterned-symbol-index symbol))
+       (emit-invokestatic +lisp-load-class+ "getUninternedSymbol" '("I")
+                          +lisp-object+)
        (emit 'checkcast +lisp-symbol-class+))
       ((keywordp symbol)
        (emit 'ldc (pool-string (symbol-name symbol)))

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	Wed May 19 18:29:03 2010
@@ -31,7 +31,7 @@
 
 (in-package "SYSTEM")
 
-(export 'dump-form)
+(export '(dump-form dump-uninterned-symbol-index))
 
 (declaim (ftype (function (cons stream) t) dump-cons))
 (defun dump-cons (object stream)
@@ -89,6 +89,15 @@
           (dump-object load-form stream))
         (dump-object creation-form stream))))
 
+(declaim (ftype (function (symbol) integer) dump-uninterned-symbol-index))
+(defun dump-uninterned-symbol-index (symbol)
+  (let ((index (cdr (assoc symbol *fasl-uninterned-symbols*))))
+    (unless index
+      (setq index (1+ (or (cdar *fasl-uninterned-symbols*) -1)))
+      (setq *fasl-uninterned-symbols*
+            (acons symbol index *fasl-uninterned-symbols*)))
+    index))
+
 (declaim (ftype (function (t stream) t) dump-object))
 (defun dump-object (object stream)
   (cond ((consp object)
@@ -105,14 +114,9 @@
          (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)))
+         (write-string "#" stream)
+         (write (dump-uninterned-symbol-index object) :stream stream)
+         (write-string "?" stream))
         (t
          (%stream-output-object object stream))))