Changeset 11650

Timestamp:

02/09/09 21:53:11 (14 years ago)

Author:

ehuelsmann

Message:

Generate Symbol-typed fields if we expect to be loading off one.
Also: generate uniquely prefixed symbols, aiding debugging.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (10 diffs)

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

@@ -2071 +2071 @@
     (setf g (if *compile-file-truename*
           (declare-object-as-string symbol)
-          (declare-object symbol))))
+          (declare-object symbol +lisp-symbol+))))
    (t
     (let ((*code* *static-code*)
     (s (sanitize symbol)))
-      (setf g (symbol-name (gensym)))
+      (setf g (symbol-name (gensym "SYM")))
       (when s
         (setf g (concatenate 'string g "_" s)))
@@ -2093 +2093 @@
    symbol *declared-symbols* ht g
    (let ((*code* *static-code*))
-     (setf g (symbol-name (gensym)))
+     (setf g (symbol-name (gensym "KEY")))
      (declare-field g +lisp-symbol+)
      (emit 'ldc (pool-string (symbol-name symbol)))
@@ -2107 +2107 @@
   (declare-with-hashtable
    symbol *declared-functions* ht f
-   (setf f (symbol-name (gensym)))
+   (setf f (symbol-name (gensym "FUN")))
    (let ((s (sanitize symbol)))
      (when s
@@ -2160 +2160 @@
   (declare-with-hashtable
    local-function *declared-functions* ht g
-   (setf g (symbol-name (gensym)))
+   (setf g (symbol-name (gensym "LFUN")))
    (let* ((pathname (class-file-pathname (local-function-class-file local-function)))
     (*code* *static-code*))
@@ -2250 +2250 @@
 (defknown declare-character (t) string)
 (defun declare-character (c)
-  (let ((g (symbol-name (gensym)))
+  (let ((g (symbol-name (gensym "CHAR")))
         (n (char-code c))
         (*code* *static-code*))
@@ -2267 +2267 @@
     g))
 
-(defknown declare-object-as-string (t) string)
-(defun declare-object-as-string (obj)
-  (let* ((g (symbol-name (gensym)))
+(defknown declare-object-as-string (t &optional t) string)
+(defun declare-object-as-string (obj &optional (obj-class +lisp-object+))
+  (let* ((g (symbol-name (gensym "OBJSTR")))
          (s (with-output-to-string (stream) (dump-form obj stream)))
          (*code* *static-code*))
-    (declare-field g +lisp-object+)
+    (declare-field g obj-class)
     (emit 'ldc (pool-string s))
     (emit-invokestatic +lisp-class+ "readObjectFromString"
                        (list +java-string+) +lisp-object+)
-    (emit 'putstatic *this-class* g +lisp-object+)
+    (when (string/= obj-class +lisp-object+)
+      (emit 'checkcast obj-class))
+    (emit 'putstatic *this-class* g obj-class)
     (setf *static-code* *code*)
     g))
 
 (defun declare-load-time-value (obj)
-  (let* ((g (symbol-name (gensym)))
+  (let* ((g (symbol-name (gensym "LTV")))
          (s (with-output-to-string (stream) (dump-form obj stream)))
          (*code* *static-code*))
@@ -2299 +2301 @@
   (aver (or (structure-object-p obj) (standard-object-p obj)
             (java:java-object-p obj)))
-  (let* ((g (symbol-name (gensym)))
+  (let* ((g (symbol-name (gensym "INSTANCE")))
          (s (with-output-to-string (stream) (dump-form obj stream)))
          (*code* *static-code*))
@@ -2313 +2315 @@
 
 (defun declare-package (obj)
-  (let* ((g (symbol-name (gensym)))
+  (let* ((g (symbol-name (gensym "PKG")))
          (*print-level* nil)
          (*print-length* nil)
@@ -2326 +2328 @@
     g))
 
-(declaim (ftype (function (t) string) declare-object))
-(defun declare-object (obj)
-  (let ((key (symbol-name (gensym))))
+(declaim (ftype (function (t &optional t) string) declare-object))
+(defun declare-object (obj &optional (obj-class +lisp-object+))
+  (let ((key (symbol-name (gensym "OBJ"))))
     (remember key obj)
     (let* ((g1 (declare-string key))
-           (g2 (symbol-name (gensym)))
+           (g2 (symbol-name (gensym "O2BJ"))))
+      (let* (
            (*code* *static-code*))
-      (declare-field g2 +lisp-object+)
+      (declare-field g2 obj-class)
       (emit 'getstatic *this-class* g1 +lisp-simple-string+)
       (emit-invokestatic +lisp-class+ "recall"
                          (list +lisp-simple-string+) +lisp-object+)
-      (emit 'putstatic *this-class* g2 +lisp-object+)
+      (when (string/= obj-class +lisp-object+)
+        (emit 'checkcast obj-class))
+      (emit 'putstatic *this-class* g2 obj-class)
       (setf *static-code* *code*)
-      g2)))
+      g2))))
 
 (defun declare-lambda (obj)
-  (let* ((g (symbol-name (gensym)))
+  (let* ((g (symbol-name (gensym "LAMBDA")))
          (*print-level* nil)
          (*print-length* nil)
@@ -2362 +2367 @@
    string *declared-strings* ht g
    (let ((*code* *static-code*))
-        (setf g (symbol-name (gensym)))
+        (setf g (symbol-name (gensym "STR")))
         (declare-field g +lisp-simple-string+)
         (emit 'new +lisp-simple-string-class+)