Changeset 12699 for trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Timestamp:

05/17/10 20:33:29 (13 years ago)

Author:

ehuelsmann

Message:

Refactor EXTERNALIZE-OBJECT into EMIT-LOAD-EXTERNALIZED-OBJECT.

In order to be able to do so, integrate DECLARE-SYMBOL into
its only call site: DECLARE-FUNCTION.

Simplify COMPILE-CONSTANT now that the commonalities between
the different COND branches is apparent.

File:

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

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

@@ -2073 +2073 @@
 ;; This way, the serialize-* functions can be used to depend on
 ;; each other to serialize nested constructs. They are also the
-;; building blocks of the EXTERNALIZE-OBJECT function, which is
-;; called from the compiler.
+;; building blocks of the EMIT-LOAD-EXTERNALIZED-OBJECT function,
+;; which is called from the compiler.
 
 (defun serialize-integer (n)
@@ -2181 +2181 @@
 5. The type of the field to save the serialized result to")
 
-(defknown externalize-object (t) string)
-(defun externalize-object (object)
+(defknown emit-load-externalized-object (t) string)
+(defun emit-load-externalized-object (object &optional cast)
   "Externalizes `object' for use in a FASL.
 
@@ -2206 +2206 @@
     (let ((existing (assoc object *externalized-objects* :test similarity-fn)))
       (when existing
-        (return-from externalize-object (cdr existing))))
+        (emit 'getstatic *this-class* (cdr existing) field-type)
+        (when cast
+          (emit 'checkcast cast))
+        (return-from emit-load-externalized-object field-type)))
 
     ;; We need to set up the serialized value
@@ -2222 +2225 @@
             (setf *static-code* *code*)))
 
-      field-name)))
-
-(defknown declare-symbol (symbol) string)
-(defun declare-symbol (symbol)
-  (cond
-    ((and (not *file-compilation*)
-          (null (symbol-package symbol)))
-     (declare-object symbol +lisp-symbol+ +lisp-symbol-class+))
-    (t (externalize-object symbol))))
+      (emit 'getstatic *this-class* field-name field-type)
+      (when cast
+        (emit 'checkcast cast))
+      field-type)))
 
 (defun emit-load-symbol (symbol)
@@ -2239 +2237 @@
     (if name
         (emit 'getstatic class name +lisp-symbol+)
-        (emit 'getstatic *this-class* (declare-symbol symbol) +lisp-symbol+))))
+        (emit-load-externalized-object symbol))))
 
 (defknown declare-function (symbol &optional setf) string)
@@ -2260 +2258 @@
      ;; EMIT-LOAD-SYMBOL wants to modify those specials too
      (unless name
-        (setf name (declare-symbol symbol)
+        (setf name (if *file-compilation*
+                       (declare-object-as-string symbol)
+                       (declare-object symbol))
               class *this-class*))
      (let (saved-code)
        (let ((*code* (if *declare-inline* *code* *static-code*)))
-         (emit 'getstatic class name +lisp-symbol+)
+         (if (eq class *this-class*)
+             (progn ;; generated by the DECLARE-OBJECT*'s above
+               (emit 'getstatic class name +lisp-object+)
+               (emit 'checkcast +lisp-symbol-class+))
+             (emit 'getstatic class name +lisp-symbol+))
          (emit-invokevirtual +lisp-symbol-class+
                              (if setf
@@ -2307 +2311 @@
 (defknown declare-object-as-string (t) string)
 (defun declare-object-as-string (obj)
-  ;; TODO: replace with externalize-object
+  ;; TODO: replace with emit-load-externalized-object
   ;; just replacing won't work however:
   ;;  field identification in Java includes the field type
   ;;  and we're not letting the caller know about the type of
-  ;;  field we're creating in externalize-object.
-  ;;  The solution is te rewrite externalize-object to
+  ;;  field we're creating in emit-load-externalized-object.
+  ;;  The solution is to rewrite externalize-object to
   ;;  EMIT-LOAD-EXTERNALIZED-OBJECT, which serializes *and*
   ;;  emits the right loading code (not just de-serialization anymore)
@@ -2433 +2437 @@
             (emit-push-constant-int form))
            ((integerp form)
-            (emit 'getstatic *this-class* (externalize-object form)
-                  +lisp-integer+)
+            (emit-load-externalized-object form)
             (emit-invokevirtual +lisp-object-class+ "intValue" nil "I"))
            (t
@@ -2445 +2448 @@
             (emit-push-constant-long form))
            ((integerp form)
-            (emit 'getstatic *this-class* (externalize-object form)
-                  +lisp-integer+)
+            (emit-load-externalized-object form)
             (emit-invokevirtual +lisp-object-class+ "longValue" nil "J"))
            (t
@@ -2490 +2492 @@
      (return-from compile-constant))
     ((NIL)))
-  (cond ((integerp form)
-         (emit 'getstatic *this-class* (externalize-object form)
-               +lisp-integer+))
-        ((typep form 'single-float)
-         (emit 'getstatic *this-class*
-               (externalize-object form) +lisp-single-float+))
-        ((typep form 'double-float)
-         (emit 'getstatic *this-class*
-               (externalize-object form) +lisp-double-float+))
-        ((numberp form)
-         ;; A number, but not a fixnum.
-         (emit 'getstatic *this-class*
-               (declare-object-as-string form) +lisp-object+))
-        ((stringp form)
+  (cond ((or (numberp form)
+             (typep form 'single-float)
+             (typep form 'double-float)
+             (characterp form))
+         (emit-load-externalized-object form))
+        ((or (stringp form)
+             (packagep form)
+             (pathnamep form)
+             (vectorp form))
          (if *file-compilation*
-             (emit 'getstatic *this-class*
-                   (externalize-object form) +lisp-simple-string+)
+             (emit-load-externalized-object form)
              (emit 'getstatic *this-class*
                    (declare-object form) +lisp-object+)))
-        ((vectorp form)
-         (if *file-compilation*
-             (emit 'getstatic *this-class*
-                   (declare-object-as-string form) +lisp-object+)
-             (emit 'getstatic *this-class*
-                   (declare-object form) +lisp-object+)))
-        ((characterp form)
-         (emit 'getstatic *this-class*
-               (externalize-object form) +lisp-character+))
-        ((or (hash-table-p form) (typep form 'generic-function))
+        ((or (hash-table-p form)
+             (typep form 'generic-function))
          (emit 'getstatic *this-class*
                (declare-object form) +lisp-object+))
-        ((pathnamep form)
-         (let ((g (if *file-compilation*
-                      (declare-object-as-string form)
-                      (declare-object form))))
-           (emit 'getstatic *this-class* g +lisp-object+)))
-        ((packagep form)
-         (let ((g (if *file-compilation*
-                      (externalize-object form)
-                      (declare-object form))))
-           (emit 'getstatic *this-class* g +lisp-object+)))
         ((or (structure-object-p form)
              (standard-object-p form)