Changeset 11652

Timestamp:

02/10/09 07:10:23 (14 years ago)

Author:

ehuelsmann

Message:

Check cast takes a class name as its argument, not a class reference.

Found by: Robert Dodier.

File:

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

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

@@ -2070 +2070 @@
    (cond ((null (symbol-package symbol))
     (setf g (if *compile-file-truename*
-          (declare-object-as-string symbol +lisp-symbol+)
-          (declare-object symbol +lisp-symbol+))))
+          (declare-object-as-string symbol +lisp-symbol+
+                                                +lisp-symbol-class+)
+          (declare-object symbol +lisp-symbol+
+                                      +lisp-symbol-class+))))
    (t
     (let ((*code* *static-code*)
@@ -2268 +2270 @@
 
 (defknown declare-object-as-string (t &optional t) string)
-(defun declare-object-as-string (obj &optional (obj-class +lisp-object+))
+(defun declare-object-as-string (obj &optional (obj-ref +lisp-object+)
+                                     obj-class)
   (let* ((g (symbol-name (gensym "OBJSTR")))
          (s (with-output-to-string (stream) (dump-form obj stream)))
          (*code* *static-code*))
-    (declare-field g obj-class)
+    (declare-field g obj-ref)
     (emit 'ldc (pool-string s))
     (emit-invokestatic +lisp-class+ "readObjectFromString"
                        (list +java-string+) +lisp-object+)
-    (when (string/= obj-class +lisp-object+)
+    (when (and obj-class (string/= obj-class +lisp-object+))
       (emit 'checkcast obj-class))
-    (emit 'putstatic *this-class* g obj-class)
+    (emit 'putstatic *this-class* g obj-ref)
     (setf *static-code* *code*)
     g))
@@ -2329 +2332 @@
 
 (declaim (ftype (function (t &optional t) string) declare-object))
-(defun declare-object (obj &optional (obj-class +lisp-object+))
+(defun declare-object (obj &optional (obj-ref +lisp-object+)
+                           obj-class)
   (let ((key (symbol-name (gensym "OBJ"))))
     (remember key obj)
@@ -2336 +2340 @@
       (let* (
            (*code* *static-code*))
-      (declare-field g2 obj-class)
+      (declare-field g2 obj-ref)
       (emit 'getstatic *this-class* g1 +lisp-simple-string+)
       (emit-invokestatic +lisp-class+ "recall"
                          (list +lisp-simple-string+) +lisp-object+)
-      (when (string/= obj-class +lisp-object+)
+      (when (and obj-class (string/= obj-class +lisp-object-class+))
         (emit 'checkcast obj-class))
-      (emit 'putstatic *this-class* g2 obj-class)
+      (emit 'putstatic *this-class* g2 obj-ref)
       (setf *static-code* *code*)
       g2))))