Changeset 12859


Ignore:
Timestamp:
08/04/10 20:25:03 (12 years ago)
Author:
ehuelsmann
Message:

Introduce EMIT-GETFIELD and EMIT-PUTFIELD to further improve the
resolver vs emitter layers.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12858 r12859  
    510510    (apply #'%emit 'putstatic (u2 index))))
    511511
     512(declaim (inline emit-getfield emit-putfield))
     513(defknown emit-getfield (t t t) t)
     514(defun emit-getfield (class-name field-name type)
     515  (let* ((index (if (null *current-code-attribute*)
     516                    (pool-field class-name field-name type)
     517                    (pool-add-field-ref *pool* class-name field-name type))))
     518    (apply #'%emit 'getfield (u2 index))))
     519
     520(defknown emit-putfield (t t t) t)
     521(defun emit-putfield (class-name field-name type)
     522  (let* ((index (if (null *current-code-attribute*)
     523                    (pool-field class-name field-name type)
     524                    (pool-add-field-ref *pool* class-name field-name type))))
     525    (apply #'%emit 'putfield (u2 index))))
     526
     527
     528
    512529(defvar type-representations '((:int fixnum)
    513530                               (:long (integer #.most-negative-java-long
     
    553570        (t
    554571         (emit 'checkcast +lisp-character+)
    555          (emit 'getfield +lisp-character+ "value" :char))))
     572         (emit-getfield +lisp-character+ "value" :char))))
    556573
    557574;;                     source type /
     
    842859        (t
    843860         (emit 'checkcast +lisp-fixnum+)
    844          (emit 'getfield +lisp-fixnum+ "value" :int))))
     861         (emit-getfield +lisp-fixnum+ "value" :int))))
    845862
    846863(defknown emit-unbox-long () t)
     
    857874        (t
    858875         (emit 'checkcast +lisp-single-float+)
    859          (emit 'getfield +lisp-single-float+ "value" :float))))
     876         (emit-getfield +lisp-single-float+ "value" :float))))
    860877
    861878(defknown emit-unbox-double () t)
     
    867884        (t
    868885         (emit 'checkcast +lisp-double-float+)
    869          (emit 'getfield +lisp-double-float+ "value" :double))))
     886         (emit-getfield +lisp-double-float+ "value" :double))))
    870887
    871888(defknown fix-boxing (t t) t)
     
    878895                     (< *safety* 3))
    879896                (emit 'checkcast +lisp-fixnum+)
    880                 (emit 'getfield +lisp-fixnum+ "value" :int))
     897                (emit-getfield +lisp-fixnum+ "value" :int))
    881898               (t
    882899                (emit-invokevirtual +lisp-object+ "intValue" nil :int))))
     
    11621179;; getfield, putfield class-name field-name type-name
    11631180(define-resolver (180 181) (instruction)
    1164   (let* ((args (instruction-args instruction))
    1165          (index (pool-field (first args)
    1166                             (second args) (third args))))
    1167     (inst (instruction-opcode instruction) (u2 index))))
     1181  ;; we used to create the pool-field here; that moved to the emit-* layer
     1182  instruction)
    11681183
    11691184;; new, anewarray, checkcast, instanceof class-name
     
    11911206
    11921207(defun resolve-instructions (code)
    1193   (let ((vector (make-array 512 :fill-pointer 0 :adjustable t)))
    1194     (dotimes (index (length code) vector)
     1208  (let* ((len (length code))
     1209         (vector (make-array (ash len 1) :fill-pointer 0 :adjustable t)))
     1210    (dotimes (index len vector)
    11951211      (declare (type (unsigned-byte 16) index))
    11961212      (let ((instruction (svref code index)))
     
    12011217                   (inst 'aload *thread*)
    12021218                   (inst 'aconst_null)
    1203                    (inst 'putfield (list +lisp-thread+ "_values"
    1204                                          +lisp-object-array+)))))
     1219                   (inst 'putfield (u2 (pool-field +lisp-thread+ "_values"
     1220                                                   +lisp-object-array+))))))
    12051221             (dolist (instruction instructions)
    12061222               (vector-push-extend (resolve-instruction instruction) vector))))
     
    37403756    ;; Save multiple values returned by first subform.
    37413757    (emit-push-current-thread)
    3742     (emit 'getfield +lisp-thread+ "_values" +lisp-object-array+)
     3758    (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
    37433759    (astore values-register)
    37443760    (dolist (subform subforms)
     
    37473763    (emit-push-current-thread)
    37483764    (aload values-register)
    3749     (emit 'putfield +lisp-thread+ "_values" +lisp-object-array+)
     3765    (emit-putfield +lisp-thread+ "_values" +lisp-object-array+)
    37503766    ;; Result.
    37513767    (aload result-register)
     
    39463962             ;; Store values from values form in values register.
    39473963             (emit-push-current-thread)
    3948              (emit 'getfield +lisp-thread+ "_values" +lisp-object-array+)
     3964             (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
    39493965             (emit-move-from-stack values-register)
    39503966             ;; Did we get just one value?
     
    41214137           (emit 'aaload)
    41224138           (emit-swap representation nil)
    4123            (emit 'putfield +lisp-closure-binding+ "value" +lisp-object+))
     4139           (emit-putfield +lisp-closure-binding+ "value" +lisp-object+))
    41244140          ((variable-environment variable)
    41254141           (assert (not *file-compilation*))
     
    41534169         (emit-push-constant-int (variable-closure-index variable))
    41544170         (emit 'aaload)
    4155          (emit 'getfield +lisp-closure-binding+ "value" +lisp-object+))
     4171         (emit-getfield +lisp-closure-binding+ "value" +lisp-object+))
    41564172        ((variable-environment variable)
    41574173         (assert (not *file-compilation*))
     
    44124428        (astore go-register)
    44134429        ;; Get the tag.
    4414         (emit 'getfield +lisp-go+ "tagbody" +lisp-object+) ; Stack depth is still 1.
     4430        (emit-getfield +lisp-go+ "tagbody" +lisp-object+) ; Stack depth is still 1.
    44154431        (emit-push-variable (tagbody-id-variable block))
    44164432        (emit 'if_acmpne RETHROW) ;; Not this TAGBODY
    44174433        (aload go-register)
    4418         (emit 'getfield +lisp-go+ "tag" +lisp-object+) ; Stack depth is still 1.
     4434        (emit-getfield +lisp-go+ "tag" +lisp-object+) ; Stack depth is still 1.
    44194435        (astore tag-register)
    44204436        ;; Don't actually generate comparisons for tags
     
    45874603        ;; The Return object is on the runtime stack. Stack depth is 1.
    45884604        (emit 'dup) ; Stack depth is 2.
    4589         (emit 'getfield +lisp-return+ "tag" +lisp-object+) ; Still 2.
     4605        (emit-getfield +lisp-return+ "tag" +lisp-object+) ; Still 2.
    45904606        (emit-push-variable (block-id-variable block))
    45914607        ;; If it's not the block we're looking for...
     
    45974613        (emit 'athrow)
    45984614        (label THIS-BLOCK)
    4599         (emit 'getfield +lisp-return+ "result" +lisp-object+)
     4615        (emit-getfield +lisp-return+ "result" +lisp-object+)
    46004616        (emit-move-from-stack target) ; Stack depth is 0.
    46014617        ;; Finally...
     
    71247140                      (variable-block variable))))
    71257141           (aload (variable-binding-register variable))
    7126            (emit 'getfield +lisp-special-binding+ "value"
     7142           (emit-getfield +lisp-special-binding+ "value"
    71277143                 +lisp-object+))
    71287144          (t
     
    72047220             (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
    72057221             (emit 'dup_x1) ;; copy past th
    7206              (emit 'putfield +lisp-special-binding+ "value"
     7222             (emit-putfield +lisp-special-binding+ "value"
    72077223                   +lisp-object+))
    72087224            ((and (consp value-form)
     
    73127328     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    73137329           (emit 'checkcast +lisp-symbol+)
    7314            (emit 'getfield  +lisp-symbol+ "name" +lisp-simple-string+)
     7330           (emit-getfield  +lisp-symbol+ "name" +lisp-simple-string+)
    73157331           (emit-move-from-stack target representation))
    73167332          (t
     
    75717587      ;; The Throw object is on the runtime stack. Stack depth is 1.
    75727588      (emit 'dup) ; Stack depth is 2.
    7573       (emit 'getfield +lisp-throw+ "tag" +lisp-object+) ; Still 2.
     7589      (emit-getfield +lisp-throw+ "tag" +lisp-object+) ; Still 2.
    75747590      (aload tag-register) ; Stack depth is 3.
    75757591      ;; If it's not the tag we're looking for, we branch to the start of the
     
    76487664        (unless (single-valued-p protected-form)
    76497665          (emit-push-current-thread)
    7650           (emit 'getfield +lisp-thread+ "_values" +lisp-object-array+)
     7666          (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
    76517667          (astore values-register))
    76527668        (label END-PROTECTED-RANGE))
     
    76617677      (astore exception-register)
    76627678      (emit-push-current-thread)
    7663       (emit 'getfield +lisp-thread+ "_values" +lisp-object-array+)
     7679      (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
    76647680      (astore values-register)
    76657681      (let ((*register* *register*))
     
    76697685      (emit-push-current-thread)
    76707686      (aload values-register)
    7671       (emit 'putfield +lisp-thread+ "_values" +lisp-object-array+)
     7687      (emit-putfield +lisp-thread+ "_values" +lisp-object-array+)
    76727688      (aload exception-register)
    76737689      (emit 'athrow) ; Re-throw exception.
     
    76777693        (emit-push-current-thread)
    76787694        (aload values-register)
    7679         (emit 'putfield +lisp-thread+ "_values" +lisp-object-array+))
     7695        (emit-putfield +lisp-thread+ "_values" +lisp-object-array+))
    76807696      ;; Result.
    76817697      (aload result-register)
     
    79687984        (progn
    79697985          (aload 0)
    7970           (emit 'getfield +lisp-compiled-closure+ "ctx"
     7986          (emit-getfield +lisp-compiled-closure+ "ctx"
    79717987                +closure-binding-array+)
    79727988          (when local-closure-vars
Note: See TracChangeset for help on using the changeset viewer.