Changeset 12692

Timestamp:

05/16/10 19:45:41 (13 years ago)

Author:

ehuelsmann

Message:

Replace lookup-or-declare-symbol - which was used to load a
symbol in all cases - with the easier paradigm EMIT-LOAD-SYMBOL.

File:

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

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

@@ -751 +751 @@
 
 (defun emit-push-variable-name (variable)
-  (multiple-value-bind
-        (name class)
-      (lookup-or-declare-symbol (variable-name variable))
-  (emit 'getstatic class name +lisp-symbol+)))
+  (emit-load-symbol (variable-name variable)))
 
 (defknown generate-instanceof-type-check-for-variable (t t) t)
@@ -2235 +2232 @@
     (t (externalize-object symbol))))
 
-(defun lookup-or-declare-symbol (symbol)
-  "Returns the value-pair (VALUES field class) from which
-the Java object representing SYMBOL can be retrieved."
+(defun emit-load-symbol (symbol)
+  "Loads a symbol, optionally after externalizing it."
   (multiple-value-bind
         (name class)
       (lookup-known-symbol symbol)
     (if name
-        (values name class)
-        (values (declare-symbol symbol) *this-class*))))
+        (emit 'getstatic class name +lisp-symbol+)
+        (emit 'getstatic *this-class* (declare-symbol symbol) +lisp-symbol+))))
 
 (defknown declare-function (symbol &optional setf) string)
@@ -2257 +2253 @@
    (multiple-value-bind
          (name class)
-       (lookup-or-declare-symbol symbol)
+       (lookup-known-symbol symbol)
+     ;; This is a work-around for the fact that
+     ;; EMIT-LOAD-SYMBOL can't be used due to the fact that
+     ;; here we won't know where to send the code yet (the LET
+     ;; selects between *code* and *static-code*, while
+     ;; EMIT-LOAD-SYMBOL wants to modify those specials too
+     (unless name
+        (setf name (declare-symbol symbol)
+              class *this-class*))
      (let (saved-code)
        (let ((*code* (if *declare-inline* *code* *static-code*)))
@@ -3031 +3035 @@
       (cond ((eq op (compiland-name *current-compiland*)) ; recursive call
              (if (notinline-p op)
-                 (multiple-value-bind
-                       (name class)
-                     (lookup-or-declare-symbol op)
-                   (emit 'getstatic class name +lisp-symbol+))
+                 (emit-load-symbol op)
                  (aload 0)))
             (t
-             (multiple-value-bind
-                   (name class)
-                 (lookup-or-declare-symbol op)
-               (emit 'getstatic class name +lisp-symbol+))))
+             (emit-load-symbol op)))
       (process-args args)
       (if (or (<= *speed* *debug*) *require-stack-frame*)
@@ -5025 +5023 @@
            (emit-move-from-stack target representation))
           ((symbolp obj)
-           (multiple-value-bind
-                 (name class)
-               (lookup-or-declare-symbol obj)
-             (emit 'getstatic class name +lisp-symbol+))
+           (emit-load-symbol obj)
            (emit-move-from-stack target representation))
           ((listp obj)
@@ -5268 +5263 @@
           (emit-move-from-stack target))
          (t
-          (multiple-value-bind
-                (name class)
-              (lookup-or-declare-symbol name)
-            (emit 'getstatic class name +lisp-symbol+))
+          (emit-load-symbol name)
           (emit-invokevirtual +lisp-object-class+ "getSymbolFunctionOrDie"
                               nil +lisp-object+)
@@ -5310 +5302 @@
           (emit-move-from-stack target))
          (t
-          (multiple-value-bind
-                (name class)
-              (lookup-or-declare-symbol (cadr name))
-            (emit 'getstatic class name +lisp-symbol+))
+          (emit-load-symbol (cadr name))
           (emit-invokevirtual +lisp-symbol-class+
                               "getSymbolSetfFunctionOrDie"
@@ -7526 +7515 @@
                  (not (enclosed-by-runtime-bindings-creating-block-p
                        (variable-block variable))))
-      (multiple-value-bind
-            (name class)
-          (lookup-or-declare-symbol name)
-        (emit 'getstatic class name +lisp-symbol+)))
+      (emit-load-symbol name))
     (cond ((constantp name)
            ;; "... a reference to a symbol declared with DEFCONSTANT always
@@ -7632 +7618 @@
 ;;              (format t "compiling pushSpecial~%")
              (emit-push-current-thread)
-             (multiple-value-bind
-                   (name class)
-                 (lookup-or-declare-symbol name)
-               (emit 'getstatic class name +lisp-symbol+))
+             (emit-load-symbol name)
        (compile-forms-and-maybe-emit-clear-values (second value-form) 'stack nil)
              (emit-invokevirtual +lisp-thread-class+ "pushSpecial"
@@ -7641 +7624 @@
             (t
              (emit-push-current-thread)
-             (multiple-value-bind
-                   (name class)
-                 (lookup-or-declare-symbol name)
-               (emit 'getstatic class name +lisp-symbol+))
+             (emit-load-symbol name)
        (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
              (emit-invokevirtual +lisp-thread-class+ "setSpecialVariable"
@@ -8129 +8109 @@
                    (emit 'iconst_1))
                   ((nil)
-                   (multiple-value-bind
-                         (name class)
-                       (lookup-or-declare-symbol form)
-                     (emit 'getstatic class name +lisp-symbol+))))
+                   (emit-load-symbol form)))
                 (emit-move-from-stack target representation))
                (t