[armedbear-cvs] r12792 - branches/generic-class-file/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Thu Jul 8 22:15:44 UTC 2010
Author: ehuelsmann
Date: Thu Jul 8 18:15:43 2010
New Revision: 12792
Log:
CLASS-NAME integration for +lisp-symbol+.
Modified:
branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Thu Jul 8 18:15:43 2010
@@ -201,8 +201,6 @@
(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;")
(defconstant +lisp-fixnum-class+ "org/armedbear/lisp/Fixnum")
@@ -744,7 +742,7 @@
(unless (local-variable-p variable)
(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+)
(HASH-TABLE +lisp-hash-table+)
@@ -761,7 +759,7 @@
(emit 'instanceof instanceof-class)
(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"
(lisp-object-arg-types 2) +lisp-object+)
@@ -2100,7 +2098,7 @@
(emit-push-constant-int (dump-uninterned-symbol-index symbol))
(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)))
(emit-invokestatic +lisp+ "internKeyword"
@@ -2120,7 +2118,7 @@
(string "STR" ,#'equal ,#'serialize-string
,+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:
@@ -2220,9 +2218,9 @@
(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 'checkcast +lisp-symbol+))
(emit 'getstatic class name +lisp-symbol+))
- (emit-invokevirtual +lisp-symbol-class+
+ (emit-invokevirtual +lisp-symbol+
(if setf
"getSymbolSetfFunctionOrDie"
"getSymbolFunctionOrDie")
@@ -3367,7 +3365,7 @@
(p2-test-predicate form "isSpecialVariable"))
(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)
(p2-test-instanceof-predicate form +lisp-cons+))
@@ -4626,7 +4624,7 @@
(p2-instanceof-predicate form target representation +lisp-abstract-string+))
(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)
(p2-instanceof-predicate form target representation +lisp-abstract-vector+))
@@ -5097,7 +5095,7 @@
(emit-move-from-stack target))
(t
(emit-load-externalized-object (cadr name))
- (emit-invokevirtual +lisp-symbol-class+
+ (emit-invokevirtual +lisp-symbol+
"getSymbolSetfFunctionOrDie"
nil +lisp-object+)
(emit-move-from-stack target))))
@@ -5723,7 +5721,7 @@
(emit 'new +lisp-structure-object+)
(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))
(emit-invokevirtual +lisp-object+ "copyToArray"
@@ -5743,7 +5741,7 @@
(emit 'new +lisp-structure-object+)
(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))
(apply 'maybe-emit-clear-values args)
@@ -7208,7 +7206,7 @@
(cond ((constantp name)
;; "... 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)
(eq (variable-compiland variable) *current-compiland*)
@@ -7219,7 +7217,7 @@
+lisp-object+))
(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)
(emit-move-from-stack target representation)))
@@ -7250,7 +7248,7 @@
(eq (derive-type (%cadr form)) 'SYMBOL))
(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))
(emit-invokevirtual +lisp-thread+ "setSpecialVariable"
@@ -7402,8 +7400,8 @@
(let ((arg (%cadr form)))
(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
(compile-function-call form target representation)))))
@@ -7414,8 +7412,8 @@
(let ((arg (%cadr form)))
(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)
(emit-move-from-stack target representation))
@@ -7428,9 +7426,9 @@
(let ((arg (%cadr form)))
(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)
(emit-move-from-stack target representation)
@@ -7443,7 +7441,7 @@
;; The value to be checked is on the stack.
(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+)
(HASH-TABLE +lisp-hash-table+)
@@ -7459,7 +7457,7 @@
(emit 'dup)
(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+)
(label LABEL1))
Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp (original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp Thu Jul 8 18:15:43 2010
@@ -109,7 +109,7 @@
(define-class-name +lisp+ "org.armedbear.lisp.Lisp")
(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")
(define-class-name +!lisp-integer+ "org.armedbear.lisp.LispInteger")
More information about the armedbear-cvs
mailing list