Changeset 12699


Ignore:
Timestamp:
05/17/10 20:33:29 (12 years ago)
Author:
ehuelsmann
Message:

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.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12692 r12699  
    20732073;; This way, the serialize-* functions can be used to depend on
    20742074;; each other to serialize nested constructs. They are also the
    2075 ;; building blocks of the EXTERNALIZE-OBJECT function, which is
    2076 ;; called from the compiler.
     2075;; building blocks of the EMIT-LOAD-EXTERNALIZED-OBJECT function,
     2076;; which is called from the compiler.
    20772077
    20782078(defun serialize-integer (n)
     
    218121815. The type of the field to save the serialized result to")
    21822182
    2183 (defknown externalize-object (t) string)
    2184 (defun externalize-object (object)
     2183(defknown emit-load-externalized-object (t) string)
     2184(defun emit-load-externalized-object (object &optional cast)
    21852185  "Externalizes `object' for use in a FASL.
    21862186
     
    22062206    (let ((existing (assoc object *externalized-objects* :test similarity-fn)))
    22072207      (when existing
    2208         (return-from externalize-object (cdr existing))))
     2208        (emit 'getstatic *this-class* (cdr existing) field-type)
     2209        (when cast
     2210          (emit 'checkcast cast))
     2211        (return-from emit-load-externalized-object field-type)))
    22092212
    22102213    ;; We need to set up the serialized value
     
    22222225            (setf *static-code* *code*)))
    22232226
    2224       field-name)))
    2225 
    2226 (defknown declare-symbol (symbol) string)
    2227 (defun declare-symbol (symbol)
    2228   (cond
    2229     ((and (not *file-compilation*)
    2230           (null (symbol-package symbol)))
    2231      (declare-object symbol +lisp-symbol+ +lisp-symbol-class+))
    2232     (t (externalize-object symbol))))
     2227      (emit 'getstatic *this-class* field-name field-type)
     2228      (when cast
     2229        (emit 'checkcast cast))
     2230      field-type)))
    22332231
    22342232(defun emit-load-symbol (symbol)
     
    22392237    (if name
    22402238        (emit 'getstatic class name +lisp-symbol+)
    2241         (emit 'getstatic *this-class* (declare-symbol symbol) +lisp-symbol+))))
     2239        (emit-load-externalized-object symbol))))
    22422240
    22432241(defknown declare-function (symbol &optional setf) string)
     
    22602258     ;; EMIT-LOAD-SYMBOL wants to modify those specials too
    22612259     (unless name
    2262         (setf name (declare-symbol symbol)
     2260        (setf name (if *file-compilation*
     2261                       (declare-object-as-string symbol)
     2262                       (declare-object symbol))
    22632263              class *this-class*))
    22642264     (let (saved-code)
    22652265       (let ((*code* (if *declare-inline* *code* *static-code*)))
    2266          (emit 'getstatic class name +lisp-symbol+)
     2266         (if (eq class *this-class*)
     2267             (progn ;; generated by the DECLARE-OBJECT*'s above
     2268               (emit 'getstatic class name +lisp-object+)
     2269               (emit 'checkcast +lisp-symbol-class+))
     2270             (emit 'getstatic class name +lisp-symbol+))
    22672271         (emit-invokevirtual +lisp-symbol-class+
    22682272                             (if setf
     
    23072311(defknown declare-object-as-string (t) string)
    23082312(defun declare-object-as-string (obj)
    2309   ;; TODO: replace with externalize-object
     2313  ;; TODO: replace with emit-load-externalized-object
    23102314  ;; just replacing won't work however:
    23112315  ;;  field identification in Java includes the field type
    23122316  ;;  and we're not letting the caller know about the type of
    2313   ;;  field we're creating in externalize-object.
    2314   ;;  The solution is te rewrite externalize-object to
     2317  ;;  field we're creating in emit-load-externalized-object.
     2318  ;;  The solution is to rewrite externalize-object to
    23152319  ;;  EMIT-LOAD-EXTERNALIZED-OBJECT, which serializes *and*
    23162320  ;;  emits the right loading code (not just de-serialization anymore)
     
    24332437            (emit-push-constant-int form))
    24342438           ((integerp form)
    2435             (emit 'getstatic *this-class* (externalize-object form)
    2436                   +lisp-integer+)
     2439            (emit-load-externalized-object form)
    24372440            (emit-invokevirtual +lisp-object-class+ "intValue" nil "I"))
    24382441           (t
     
    24452448            (emit-push-constant-long form))
    24462449           ((integerp form)
    2447             (emit 'getstatic *this-class* (externalize-object form)
    2448                   +lisp-integer+)
     2450            (emit-load-externalized-object form)
    24492451            (emit-invokevirtual +lisp-object-class+ "longValue" nil "J"))
    24502452           (t
     
    24902492     (return-from compile-constant))
    24912493    ((NIL)))
    2492   (cond ((integerp form)
    2493          (emit 'getstatic *this-class* (externalize-object form)
    2494                +lisp-integer+))
    2495         ((typep form 'single-float)
    2496          (emit 'getstatic *this-class*
    2497                (externalize-object form) +lisp-single-float+))
    2498         ((typep form 'double-float)
    2499          (emit 'getstatic *this-class*
    2500                (externalize-object form) +lisp-double-float+))
    2501         ((numberp form)
    2502          ;; A number, but not a fixnum.
    2503          (emit 'getstatic *this-class*
    2504                (declare-object-as-string form) +lisp-object+))
    2505         ((stringp form)
     2494  (cond ((or (numberp form)
     2495             (typep form 'single-float)
     2496             (typep form 'double-float)
     2497             (characterp form))
     2498         (emit-load-externalized-object form))
     2499        ((or (stringp form)
     2500             (packagep form)
     2501             (pathnamep form)
     2502             (vectorp form))
    25062503         (if *file-compilation*
    2507              (emit 'getstatic *this-class*
    2508                    (externalize-object form) +lisp-simple-string+)
     2504             (emit-load-externalized-object form)
    25092505             (emit 'getstatic *this-class*
    25102506                   (declare-object form) +lisp-object+)))
    2511         ((vectorp form)
    2512          (if *file-compilation*
    2513              (emit 'getstatic *this-class*
    2514                    (declare-object-as-string form) +lisp-object+)
    2515              (emit 'getstatic *this-class*
    2516                    (declare-object form) +lisp-object+)))
    2517         ((characterp form)
    2518          (emit 'getstatic *this-class*
    2519                (externalize-object form) +lisp-character+))
    2520         ((or (hash-table-p form) (typep form 'generic-function))
     2507        ((or (hash-table-p form)
     2508             (typep form 'generic-function))
    25212509         (emit 'getstatic *this-class*
    25222510               (declare-object form) +lisp-object+))
    2523         ((pathnamep form)
    2524          (let ((g (if *file-compilation*
    2525                       (declare-object-as-string form)
    2526                       (declare-object form))))
    2527            (emit 'getstatic *this-class* g +lisp-object+)))
    2528         ((packagep form)
    2529          (let ((g (if *file-compilation*
    2530                       (externalize-object form)
    2531                       (declare-object form))))
    2532            (emit 'getstatic *this-class* g +lisp-object+)))
    25332511        ((or (structure-object-p form)
    25342512             (standard-object-p form)
Note: See TracChangeset for help on using the changeset viewer.