Changeset 12702


Ignore:
Timestamp:
05/18/10 21:44:11 (12 years ago)
Author:
ehuelsmann
Message:

Merge DECLARE-OBJECT functionality ("serialization" of objects
for in-memory [non compile-file] compilation) into
EMIT-LOAD-EXTERNALIZED-OBJECT.

File:
1 edited

Legend:

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

    r12699 r12702  
    235235(defconstant +lisp-abstract-vector-class+ "org/armedbear/lisp/AbstractVector")
    236236(defconstant +lisp-abstract-string-class+ "org/armedbear/lisp/AbstractString")
     237(defconstant +lisp-abstract-string+ "Lorg/armedbear/lisp/AbstractString;")
    237238(defconstant +lisp-simple-vector-class+ "org/armedbear/lisp/SimpleVector")
    238239(defconstant +lisp-simple-string-class+ "org/armedbear/lisp/SimpleString")
     
    21692170    (single-float "FLT" ,#'eql ,#'serialize-float ,+lisp-single-float+)
    21702171    (double-float "DBL" ,#'eql ,#'serialize-double ,+lisp-double-float+)
    2171     (string "STR" ,#'equal ,#'serialize-string ,+lisp-simple-string+)
     2172    (string "STR" ,#'equal ,#'serialize-string
     2173            ,+lisp-abstract-string+) ;; because of (not compile-file)
    21722174    (package "PKG" ,#'eq ,#'serialize-package ,+lisp-object+)
    21732175    (symbol "SYM" ,#'eq ,#'serialize-symbol ,+lisp-symbol+)
     
    22042206                serialization-table)
    22052207    (declare (ignore type)) ;; the type has been used in the selection process
     2208    (when (not *file-compilation*) ;; in-memory compilation wants object EQ-ness
     2209      (setf similarity-fn #'eq))
    22062210    (let ((existing (assoc object *externalized-objects* :test similarity-fn)))
    22072211      (when existing
     
    22162220      (push (cons object field-name) *externalized-objects*)
    22172221
    2218       (if *declare-inline*
    2219           (progn
    2220             (funcall dispatch-fn object)
    2221             (emit 'putstatic *this-class* field-name field-type))
    2222           (let ((*code* *static-code*))
    2223             (funcall dispatch-fn object)
    2224             (emit 'putstatic *this-class* field-name field-type)
    2225             (setf *static-code* *code*)))
     2222      (cond
     2223        ((not *file-compilation*)
     2224         (let ((*code* *static-code*))
     2225           (remember field-name object)
     2226           (emit 'ldc (pool-string field-name))
     2227           (emit-invokestatic +lisp-class+ "recall"
     2228                              (list +java-string+) +lisp-object+)
     2229           (when (string/= field-type +lisp-object+)
     2230             (emit 'checkcast (subseq field-type 1 (1- (length field-type)))))
     2231           (emit 'putstatic *this-class* field-name field-type)
     2232           (setf *static-code* *code*)))
     2233        (*declare-inline*
     2234         (funcall dispatch-fn object)
     2235         (emit 'putstatic *this-class* field-name field-type))
     2236        (t ;; *file-compilation* and (not *declare-inline*)
     2237         (let ((*code* *static-code*))
     2238           (funcall dispatch-fn object)
     2239           (emit 'putstatic *this-class* field-name field-type)
     2240           (setf *static-code* *code*))))
    22262241
    22272242      (emit 'getstatic *this-class* field-name field-type)
     
    24952510             (typep form 'single-float)
    24962511             (typep form 'double-float)
    2497              (characterp form))
     2512             (characterp form)
     2513             (stringp form)
     2514             (packagep form)
     2515             (pathnamep form)
     2516             (vectorp form))
    24982517         (emit-load-externalized-object form))
    24992518        ((or (stringp form)
     
    25012520             (pathnamep form)
    25022521             (vectorp form))
    2503          (if *file-compilation*
    2504              (emit-load-externalized-object form)
    2505              (emit 'getstatic *this-class*
    2506                    (declare-object form) +lisp-object+)))
     2522         (emit-load-externalized-object form))
    25072523        ((or (hash-table-p form)
    25082524             (typep form 'generic-function))
     
    25192535         (if *file-compilation*
    25202536             (error "COMPILE-CONSTANT unhandled case ~S" form)
    2521              (emit 'getstatic *this-class*
    2522                    (declare-object form) +lisp-object+))))
     2537             (emit-load-externalized-object form))))
    25232538  (emit-move-from-stack target representation))
    25242539
     
    31743189           (assert (local-function-references-allowed-p local-function))
    31753190           (assert (not *file-compilation*))
    3176            (emit 'getstatic *this-class*
    3177                  (declare-object (local-function-environment local-function)
    3178                                  +lisp-environment+
    3179                                  +lisp-environment-class+)
    3180                  +lisp-environment+)
    3181            (emit 'getstatic *this-class*
    3182                  (declare-object (local-function-name local-function))
    3183                  +lisp-object+)
     3191           (emit-load-externalized-object
     3192            (local-function-environmont local-function)
     3193            +lisp-environment-class+)
     3194           (emit-load-externalized-object (local-function-name local-function))
    31843195           (emit-invokevirtual +lisp-environment-class+ "lookupFunction"
    31853196                               (list +lisp-object+)
     
    43564367          ((variable-environment variable)
    43574368           (assert (not *file-compilation*))
    4358            (emit 'getstatic *this-class*
    4359                  (declare-object (variable-environment variable)
    4360                                  +lisp-environment+
    4361                                  +lisp-environment-class+)
    4362                  +lisp-environment+)
     4369           (emit-load-externalized-object (variable-environment variable)
     4370                                          +lisp-environment-class+)
    43634371           (emit 'swap)
    43644372           (emit-push-variable-name variable)
     
    43914399        ((variable-environment variable)
    43924400         (assert (not *file-compilation*))
    4393          (emit 'getstatic *this-class*
    4394                (declare-object (variable-environment variable)
    4395                                +lisp-environment+
    4396                                +lisp-environment-class+)
    4397                +lisp-environment+)
     4401         (emit-load-externalized-object (variable-environment variable)
     4402                                        +lisp-environment-class+)
    43984403         (emit-push-variable-name variable)
    43994404         (emit-invokevirtual +lisp-environment-class+ "lookup"
     
    46634668                                    (tagbody-tags block)))
    46644669          (aload tag-register)
    4665           (emit 'getstatic *this-class*
    4666                 (if *file-compilation*
    4667                     (declare-object-as-string (tag-label tag))
    4668                     (declare-object (tag-label tag)))
    4669                 +lisp-object+)
     4670          (emit-load-externalized-object (tag-label tag))
    46704671          ;; Jump if EQ.
    46714672          (emit 'if_acmpeq (tag-label tag)))
     
    47254726    ;; Non-local GO.
    47264727    (emit-push-variable (tagbody-id-variable tag-block))
    4727     (emit 'getstatic *this-class*
    4728           (if *file-compilation*
    4729               (declare-object-as-string (tag-label tag))
    4730               (declare-object (tag-label tag)))
    4731           +lisp-object+) ; Tag.
     4728    (emit-load-externalized-object (tag-label tag)) ; Tag.
    47324729    (emit-invokestatic +lisp-class+ "nonLocalGo" (lisp-object-arg-types 2)
    47334730                       +lisp-object+)
     
    48994896    (aver (block-non-local-return-p block))
    49004897    (emit-push-variable (block-id-variable block))
    4901     (emit 'getstatic *this-class*
    4902           (if *file-compilation*
    4903               (declare-object-as-string (block-name block))
    4904               (declare-object (block-name block)))
    4905           +lisp-object+)
     4898    (emit-load-externalized-object (block-name block))
    49064899    (emit-clear-values)
    49074900    (compile-form result-form 'stack nil)
     
    50044997           (emit-move-from-stack target representation))
    50054998          ((listp obj)
    5006            (let ((g (if *file-compilation*
    5007                         (declare-object-as-string obj)
    5008                         (declare-object obj))))
    5009              (emit 'getstatic *this-class* g +lisp-object+)
    5010              (emit-move-from-stack target representation)))
     4999           (emit-load-externalized-object obj)
     5000           (emit-move-from-stack target representation))
    50115001          ((constantp obj)
    50125002           (compile-constant obj target representation))
     
    51885178             (compile-and-write-to-stream (compiland-class-file compiland)
    51895179                                          compiland stream)
    5190              (emit 'getstatic *this-class*
    5191                    (declare-object (load-compiled-function
    5192                                     (sys::%get-output-stream-bytes stream)))
    5193                    +lisp-object+))))
     5180             (emit-load-externalized-object (load-compiled-function
     5181                                    (sys::%get-output-stream-bytes stream))))))
    51945182    (cond ((null *closure-variables*))  ; Nothing to do.
    51955183          ((compiland-closure-register *current-compiland*)
     
    52765264               (fboundp name)
    52775265               (fdefinition name))
    5278           (emit 'getstatic *this-class*
    5279                 (declare-object (fdefinition name)) +lisp-object+)
     5266          (emit-load-externalized-object (fdefinition name))
    52805267          (emit-move-from-stack target))
    52815268         (t
Note: See TracChangeset for help on using the changeset viewer.