[armedbear-cvs] r12699 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Mon May 17 20:33:30 UTC 2010
Author: ehuelsmann
Date: Mon May 17 16:33:29 2010
New Revision: 12699
Log:
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.
Modified:
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Mon May 17 16:33:29 2010
@@ -2072,8 +2072,8 @@
;; 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)
"Generates code to restore a serialized integer."
@@ -2180,8 +2180,8 @@
4. The function to dispatch serialization to
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.
Returns the name of the field (in `*this-class*') from which
@@ -2205,7 +2205,10 @@
(declare (ignore type)) ;; the type has been used in the selection process
(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
(let ((field-name (symbol-name (gensym prefix))))
@@ -2221,15 +2224,10 @@
(emit 'putstatic *this-class* field-name field-type)
(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)
"Loads a symbol, optionally after externalizing it."
@@ -2238,7 +2236,7 @@
(lookup-known-symbol symbol)
(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)
(defun declare-function (symbol &optional setf)
@@ -2259,11 +2257,17 @@
;; selects between *code* and *static-code*, while
;; 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
"getSymbolSetfFunctionOrDie"
@@ -2306,12 +2310,12 @@
(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)
(let (saved-code
@@ -2432,8 +2436,7 @@
(cond ((fixnump form)
(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
(sys::%format t "compile-constant int representation~%")
@@ -2444,8 +2447,7 @@
(cond ((<= most-negative-java-long form most-positive-java-long)
(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
(sys::%format t "compile-constant long representation~%")
@@ -2489,47 +2491,23 @@
(emit-move-from-stack target representation)
(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)
(java:java-object-p form))
More information about the armedbear-cvs
mailing list