Changeset 12792

Timestamp:

07/08/10 22:15:43 (13 years ago)

Author:

ehuelsmann

Message:

CLASS-NAME integration for +lisp-symbol+.

Location:

branches/generic-class-file/abcl/src/org/armedbear/lisp

Files:

• compiler-pass2.lisp (modified) (19 diffs)
• jvm-class-file.lisp (modified) (1 diff)

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

@@ -202 +202 @@
 (defconstant +lisp-object-array+ "[Lorg/armedbear/lisp/LispObject;")
 (defconstant +closure-binding-array+ "[Lorg/armedbear/lisp/ClosureBinding;")
-(defconstant +lisp-symbol-class+ "org/armedbear/lisp/Symbol")
-(defconstant +lisp-symbol+ "Lorg/armedbear/lisp/Symbol;")
 (defconstant +lisp-integer-class+ "org/armedbear/lisp/LispInteger")
 (defconstant +lisp-integer+ "Lorg/armedbear/lisp/LispInteger;")
@@ -745 +743 @@
     (return-from generate-instanceof-type-check-for-variable))
   (let ((instanceof-class (ecase expected-type
-                            (SYMBOL     +lisp-symbol-class+)
+                            (SYMBOL     +lisp-symbol+)
                             (CHARACTER  +lisp-character-class+)
                             (CONS       +lisp-cons+)
@@ -762 +760 @@
     (emit 'ifne LABEL1)
     (emit-load-local-variable variable)
-    (emit 'getstatic +lisp-symbol-class+ expected-type-java-symbol-name
+    (emit 'getstatic +lisp-symbol+ expected-type-java-symbol-name
           +lisp-symbol+)
     (emit-invokestatic +lisp+ "type_error"
@@ -2101 +2099 @@
        (emit-invokestatic +lisp-load+ "getUninternedSymbol" '("I")
                           +lisp-object+)
-       (emit 'checkcast +lisp-symbol-class+))
+       (emit 'checkcast +lisp-symbol+))
       ((keywordp symbol)
        (emit 'ldc (pool-string (symbol-name symbol)))
@@ -2121 +2119 @@
             ,+lisp-abstract-string+) ;; because of (not compile-file)
     (package "PKG" ,#'eq ,#'serialize-package ,+lisp-object+)
-    (symbol "SYM" ,#'eq ,#'serialize-symbol ,+!lisp-symbol+)
+    (symbol "SYM" ,#'eq ,#'serialize-symbol ,+lisp-symbol+)
     (T "OBJ" ,#'eq ,#'serialize-object ,+lisp-object+))
   "A list of 5-element lists. The elements of the sublists mean:
@@ -2221 +2219 @@
              (progn ;; generated by the DECLARE-OBJECT*'s above
                (emit 'getstatic class name +lisp-object+)
-               (emit 'checkcast +lisp-symbol-class+))
+               (emit 'checkcast +lisp-symbol+))
              (emit 'getstatic class name +lisp-symbol+))
-         (emit-invokevirtual +lisp-symbol-class+
+         (emit-invokevirtual +lisp-symbol+
                              (if setf
                                  "getSymbolSetfFunctionOrDie"
@@ -3368 +3366 @@
 
 (defun p2-test-symbolp (form)
-  (p2-test-instanceof-predicate form +lisp-symbol-class+))
+  (p2-test-instanceof-predicate form +lisp-symbol+))
 
 (defun p2-test-consp (form)
@@ -4627 +4625 @@
 
 (defun p2-symbolp (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-symbol-class+))
+  (p2-instanceof-predicate form target representation +lisp-symbol+))
 
 (defun p2-vectorp (form target representation)
@@ -5098 +5096 @@
          (t
           (emit-load-externalized-object (cadr name))
-          (emit-invokevirtual +lisp-symbol-class+
+          (emit-invokevirtual +lisp-symbol+
                               "getSymbolSetfFunctionOrDie"
                               nil +lisp-object+)
@@ -5724 +5722 @@
          (emit 'dup)
          (compile-form (%cadr form) 'stack nil)
-         (emit 'checkcast +lisp-symbol-class+)
+         (emit 'checkcast +lisp-symbol+)
          (compile-form (%caddr form) 'stack nil)
          (maybe-emit-clear-values (%cadr form) (%caddr form))
@@ -5744 +5742 @@
            (emit 'dup)
            (compile-form (%car args) 'stack nil)
-           (emit 'checkcast +lisp-symbol-class+)
+           (emit 'checkcast +lisp-symbol+)
            (dolist (slot-form slot-forms)
              (compile-form slot-form 'stack nil))
@@ -7209 +7207 @@
            ;; "... a reference to a symbol declared with DEFCONSTANT always
            ;; refers to its global value."
-           (emit-invokevirtual +lisp-symbol-class+ "getSymbolValue"
+           (emit-invokevirtual +lisp-symbol+ "getSymbolValue"
                                nil +lisp-object+))
           ((and (variable-binding-register variable)
@@ -7220 +7218 @@
           (t
            (emit-push-current-thread)
-           (emit-invokevirtual +lisp-symbol-class+ "symbolValue"
+           (emit-invokevirtual +lisp-symbol+ "symbolValue"
                                (list +lisp-thread+) +lisp-object+)))
     (fix-boxing representation nil)
@@ -7251 +7249 @@
          (emit-push-current-thread)
          (compile-form (%cadr form) 'stack nil)
-         (emit 'checkcast +lisp-symbol-class+)
+         (emit 'checkcast +lisp-symbol+)
          (compile-form (%caddr form) 'stack nil)
          (maybe-emit-clear-values (%cadr form) (%caddr form))
@@ -7403 +7401 @@
     (cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-           (emit 'checkcast +lisp-symbol-class+)
-           (emit 'getfield  +lisp-symbol-class+ "name" +lisp-simple-string+)
+           (emit 'checkcast +lisp-symbol+)
+           (emit 'getfield  +lisp-symbol+ "name" +lisp-simple-string+)
            (emit-move-from-stack target representation))
           (t
@@ -7415 +7413 @@
     (cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-           (emit 'checkcast +lisp-symbol-class+)
-           (emit-invokevirtual +lisp-symbol-class+ "getPackage"
+           (emit 'checkcast +lisp-symbol+)
+           (emit-invokevirtual +lisp-symbol+ "getPackage"
                                nil +lisp-object+)
            (fix-boxing representation nil)
@@ -7429 +7427 @@
       (when (eq (derive-compiler-type arg) 'SYMBOL)
   (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-        (emit 'checkcast +lisp-symbol-class+)
+        (emit 'checkcast +lisp-symbol+)
         (emit-push-current-thread)
-        (emit-invokevirtual +lisp-symbol-class+ "symbolValue"
+        (emit-invokevirtual +lisp-symbol+ "symbolValue"
                             (list +lisp-thread+) +lisp-object+)
         (fix-boxing representation nil)
@@ -7444 +7442 @@
   (declare (type symbol expected-type))
   (let ((instanceof-class (ecase expected-type
-                            (SYMBOL     +lisp-symbol-class+)
+                            (SYMBOL     +lisp-symbol+)
                             (CHARACTER  +lisp-character-class+)
                             (CONS       +lisp-cons+)
@@ -7460 +7458 @@
     (emit 'instanceof instanceof-class)
     (emit 'ifne LABEL1)
-    (emit 'getstatic +lisp-symbol-class+ expected-type-java-symbol-name +lisp-symbol+)
+    (emit 'getstatic +lisp-symbol+ expected-type-java-symbol-name +lisp-symbol+)
     (emit-invokestatic +lisp+ "type_error"
                        (lisp-object-arg-types 2) +lisp-object+)

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

@@ -110 +110 @@
 (define-class-name +lisp-nil+ "org.armedbear.lisp.Nil")
 (define-class-name +lisp-class+ "org.armedbear.lisp.LispClass")
-(define-class-name +!lisp-symbol+ "org.armedbear.lisp.Symbol")
+(define-class-name +lisp-symbol+ "org.armedbear.lisp.Symbol")
 (define-class-name +lisp-thread+ "org.armedbear.lisp.LispThread")
 (define-class-name +lisp-closure-binding+ "org.armedbear.lisp.ClosureBinding")