Changeset 12787 for branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

Timestamp:

07/06/10 22:34:54 (13 years ago)

Author:

ehuelsmann

Message:

More CLASS-NAME integration into pass2.

File:

• branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (28 diffs)

branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -201 +201 @@
 (defconstant +fasl-loader-class+
   "org/armedbear/lisp/FaslClassLoader")
-(defconstant +lisp-class-class+ "org/armedbear/lisp/LispClass")
 (defconstant +lisp-object-class+ "org/armedbear/lisp/LispObject")
 (defconstant +lisp-object+ "Lorg/armedbear/lisp/LispObject;")
 (defconstant +lisp-object-array+ "[Lorg/armedbear/lisp/LispObject;")
 (defconstant +closure-binding-array+ "[Lorg/armedbear/lisp/ClosureBinding;")
-(defconstant +closure-binding-class+ "org/armedbear/lisp/ClosureBinding")
 (defconstant +lisp-symbol-class+ "org/armedbear/lisp/Symbol")
 (defconstant +lisp-symbol+ "Lorg/armedbear/lisp/Symbol;")
@@ -212 +210 @@
 (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;")
@@ -242 +239 @@
 (defconstant +lisp-special-binding+ "Lorg/armedbear/lisp/SpecialBinding;")
 (defconstant +lisp-special-binding-class+ "org/armedbear/lisp/SpecialBinding")
-(defconstant +lisp-special-bindings-mark+ "Lorg/armedbear/lisp/SpecialBindingsMark;")
-(defconstant +lisp-special-bindings-mark-class+ "org/armedbear/lisp/SpecialBindingsMark")
 (defconstant +lisp-throw-class+ "org/armedbear/lisp/Throw")
 (defconstant +lisp-return-class+ "org/armedbear/lisp/Return")
 (defconstant +lisp-go-class+ "org/armedbear/lisp/Go")
-(defconstant +lisp-compiled-closure-class+ "org/armedbear/lisp/CompiledClosure")
 (defconstant +lisp-primitive-class+ "org/armedbear/lisp/Primitive")
 (defconstant +lisp-hash-table-class+ "org/armedbear/lisp/HashTable")
 (defconstant +lisp-eql-hash-table-class+ "org/armedbear/lisp/EqlHashTable")
-(defconstant +lisp-package-class+ "org/armedbear/lisp/Package")
-(defconstant +lisp-readtable-class+ "org/armedbear/lisp/Readtable")
-(defconstant +lisp-stream-class+ "org/armedbear/lisp/Stream")
-(defconstant +lisp-closure-class+ "org/armedbear/lisp/Closure")
 (defconstant +lisp-closure-parameter-class+ "org/armedbear/lisp/Closure$Parameter")
 (defconstant +lisp-closure-parameter-array+ "[Lorg/armedbear/lisp/Closure$Parameter;")
@@ -786 +776 @@
                             (HASH-TABLE +lisp-hash-table-class+)
                             (FIXNUM     +lisp-fixnum-class+)
-                            (STREAM     +lisp-stream-class+)
+                            (STREAM     +lisp-stream+)
                             (STRING     +lisp-abstract-string-class+)
                             (VECTOR     +lisp-abstract-vector-class+)))
@@ -1865 +1855 @@
                  (emit-push-nil)
                  (emit-push-t)) ;; we don't need the actual supplied-p symbol
-             (emit 'getstatic +lisp-closure-class+ "OPTIONAL" "I")
+             (emit 'getstatic +lisp-closure+ "OPTIONAL" "I")
              (emit-invokespecial-init +lisp-closure-parameter-class+
                                       (list +lisp-symbol+ +lisp-object+
@@ -1898 +1888 @@
            (emit-constructor-lambda-list args)
            (emit-invokespecial-init super (lisp-object-arg-types 2)))
-          ((equal super +lisp-compiled-closure-class+)
+          ((equal super +lisp-compiled-closure+) ;;### only needs EQ when SUPER is guaranteed to be CLASS-NAME
            (aload req-params-register)
            (aload opt-params-register)
@@ -2135 +2125 @@
       ((null (symbol-package symbol))
        (emit-push-constant-int (dump-uninterned-symbol-index symbol))
-       (emit-invokestatic +lisp-load-class+ "getUninternedSymbol" '("I")
+       (emit-invokestatic +lisp-load+ "getUninternedSymbol" '("I")
                           +lisp-object+)
        (emit 'checkcast +lisp-symbol-class+))
@@ -3053 +3043 @@
     (emit-push-constant-int 0)                            ;; srcPos
     (emit-push-constant-int (length *closure-variables*))
-    (emit 'anewarray +closure-binding-class+)             ;; dest
+    (emit 'anewarray +lisp-closure-binding+)             ;; dest
     (emit 'dup)
     (astore register)  ;; save dest value
@@ -3102 +3092 @@
                                         ; Stack: template-function
              (when *closure-variables*
-               (emit 'checkcast +lisp-compiled-closure-class+)
+               (emit 'checkcast +lisp-compiled-closure+)
                (duplicate-closure-array compiland)
                (emit-invokestatic +lisp+ "makeCompiledClosure"
@@ -3392 +3382 @@
 
 (defun p2-test-packagep (form)
-  (p2-test-instanceof-predicate form +lisp-package-class+))
+  (p2-test-instanceof-predicate form +lisp-package+))
 
 (defun p2-test-rationalp (form)
@@ -3932 +3922 @@
 (defun emit-new-closure-binding (variable)
   ""
-  (emit 'new +closure-binding-class+)            ;; value c-b
+  (emit 'new +lisp-closure-binding+)            ;; value c-b
   (emit 'dup_x1)                                 ;; c-b value c-b
   (emit 'swap)                                   ;; c-b c-b value
-  (emit-invokespecial-init +closure-binding-class+
+  (emit-invokespecial-init +lisp-closure-binding+
                            (list +lisp-object+)) ;; c-b
   (aload (compiland-closure-register *current-compiland*))
@@ -4236 +4226 @@
            (emit 'aaload)
            (emit-swap representation nil)
-           (emit 'putfield +closure-binding-class+ "value" +lisp-object+))
+           (emit 'putfield +lisp-closure-binding+ "value" +lisp-object+))
           ((variable-environment variable)
            (assert (not *file-compilation*))
@@ -4268 +4258 @@
          (emit-push-constant-int (variable-closure-index variable))
          (emit 'aaload)
-         (emit 'getfield +closure-binding-class+ "value" +lisp-object+))
+         (emit 'getfield +lisp-closure-binding+ "value" +lisp-object+))
         ((variable-environment variable)
          (assert (not *file-compilation*))
@@ -4654 +4644 @@
 
 (defun p2-packagep (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-package-class+))
+  (p2-instanceof-predicate form target representation +lisp-package+))
 
 (defun p2-readtablep (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-readtable-class+))
+  (p2-instanceof-predicate form target representation +lisp-readtable+))
 
 (defun p2-simple-vector-p (form target representation)
@@ -4956 +4946 @@
       (dformat t "(compiland-closure-register parent) = ~S~%"
          (compiland-closure-register parent))
-      (emit 'checkcast +lisp-compiled-closure-class+)
+      (emit 'checkcast +lisp-compiled-closure+)
       (duplicate-closure-array parent)
       (emit-invokestatic +lisp+ "makeCompiledClosure"
@@ -5086 +5076 @@
 
                (when (compiland-closure-register *current-compiland*)
-                 (emit 'checkcast +lisp-compiled-closure-class+)
+                 (emit 'checkcast +lisp-compiled-closure+)
                  (duplicate-closure-array *current-compiland*)
                  (emit-invokestatic +lisp+ "makeCompiledClosure"
@@ -5624 +5614 @@
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
        (emit-push-constant-int 1) ; errorp
-       (emit-invokestatic +lisp-class-class+ "findClass"
+       (emit-invokestatic +lisp-class+ "findClass"
                           (list +lisp-object+ "Z") +lisp-object+)
        (fix-boxing representation nil)
@@ -5632 +5622 @@
    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                 arg2 'stack :boolean)
-         (emit-invokestatic +lisp-class-class+ "findClass"
+         (emit-invokestatic +lisp-class+ "findClass"
                             (list +lisp-object+ "Z") +lisp-object+)
          (fix-boxing representation nil)
@@ -5810 +5800 @@
     (cond ((eq (derive-compiler-type arg) 'STREAM)
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-           (emit 'checkcast +lisp-stream-class+)
-           (emit-invokevirtual +lisp-stream-class+ "getElementType"
+           (emit 'checkcast +lisp-stream+)
+           (emit-invokevirtual +lisp-stream+ "getElementType"
                                nil +lisp-object+)
            (emit-move-from-stack target representation))
@@ -5829 +5819 @@
            (compile-form arg1 'stack :int)
            (compile-form arg2 'stack nil)
-           (emit 'checkcast +lisp-stream-class+)
+           (emit 'checkcast +lisp-stream+)
            (maybe-emit-clear-values arg1 arg2)
            (emit 'swap)
-           (emit-invokevirtual +lisp-stream-class+ "_writeByte" '("I") nil)
+           (emit-invokevirtual +lisp-stream+ "_writeByte" '("I") nil)
            (when target
              (emit-push-nil)
@@ -5857 +5847 @@
          (cond ((compiler-subtypep type1 'stream)
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
-                (emit 'checkcast +lisp-stream-class+)
+                (emit 'checkcast +lisp-stream+)
                 (emit-push-constant-int 1)
                 (emit-push-nil)
-                (emit-invokevirtual +lisp-stream-class+ "readLine"
+                (emit-invokevirtual +lisp-stream+ "readLine"
                                     (list "Z" +lisp-object+) +lisp-object+)
                 (emit-move-from-stack target))
@@ -5871 +5861 @@
          (cond ((and (compiler-subtypep type1 'stream) (null arg2))
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
-                (emit 'checkcast +lisp-stream-class+)
+                (emit 'checkcast +lisp-stream+)
                 (emit-push-constant-int 0)
                 (emit-push-nil)
-                (emit-invokevirtual +lisp-stream-class+ "readLine"
+                (emit-invokevirtual +lisp-stream+ "readLine"
                                     (list "Z" +lisp-object+) +lisp-object+)
                 (emit-move-from-stack target)
@@ -7488 +7478 @@
                             (HASH-TABLE +lisp-hash-table-class+)
                             (FIXNUM     +lisp-fixnum-class+)
-          (STREAM     +lisp-stream-class+)
+          (STREAM     +lisp-stream+)
                             (STRING     +lisp-abstract-string-class+)
                             (VECTOR     +lisp-abstract-vector-class+)))
@@ -7950 +7940 @@
 (defun write-class-file (class-file stream)
   (let* ((super (abcl-class-file-superclass class-file))
-         (this-index (pool-class (abcl-class-file-class class-file)))
-         (super-index (pool-class super))
+         (this (abcl-class-file-class class-file))
+         (this-index (pool-class (!class-name this)))
+         (super-index (pool-class (!class-name super)))
          (constructor (make-constructor super
                                         (abcl-class-file-lambda-name class-file)
@@ -8103 +8094 @@
             ;; if we're the ultimate parent: create the closure array
             (emit-push-constant-int (length *closure-variables*))
-            (emit 'anewarray +closure-binding-class+))
+            (emit 'anewarray +lisp-closure-binding+))
         (progn
           (aload 0)
-          (emit 'getfield +lisp-compiled-closure-class+ "ctx"
+          (emit 'getfield +lisp-compiled-closure+ "ctx"
                 +closure-binding-array+)
           (when local-closure-vars
@@ -8130 +8121 @@
             (emit 'dup) ; array
             (emit-push-constant-int i)
-            (emit 'new +closure-binding-class+)
+            (emit 'new +lisp-closure-binding+)
             (emit 'dup)
             (cond
@@ -8148 +8139 @@
               (t
                (assert (not "Can't happen!!"))))
-            (emit-invokespecial-init +closure-binding-class+
+            (emit-invokespecial-init +lisp-closure-binding+
                                      (list +lisp-object+))
             (emit 'aastore)))))
@@ -8248 +8239 @@
           (if (or *hairy-arglist-p*
       (and *child-p* *closure-variables*))
-        +lisp-compiled-closure-class+
+        +lisp-compiled-closure+
       +lisp-primitive-class+))