Changeset 12860


Ignore:
Timestamp:
08/04/10 21:36:42 (12 years ago)
Author:
ehuelsmann
Message:

Introduce EMIT-NEW, EMIT-ANEWARRAY, EMIT-CHECKCAST and EMIT-INSTANCEOF
to further improve the resolvers vs emitters layering.

Location:
branches/generic-class-file/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

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

    r12856 r12860  
    692692        (jvm::emit-invokevirtual jvm::+lisp-object+ "javaInstance"
    693693               nil jvm::+java-object+)
    694         (jvm::emit 'jvm::checkcast +fasl-classloader+)
     694        (jvm::emit-checkcast +fasl-classloader+)
    695695        (jvm::emit 'jvm::dup)
    696696        (jvm::emit-push-constant-int ,(1- i))
    697         (jvm::emit 'jvm::new ,class-name)
     697        (jvm::emit-new ,class-name)
    698698        (jvm::emit 'jvm::dup)
    699699        (jvm::emit-invokespecial-init ,class-name '())
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12859 r12860  
    526526
    527527
     528(defknown emit-new (t) t)
     529(declaim (inline emit-new emit-anewarray emit-checkcast emit-instanceof))
     530(defun emit-new (class-name)
     531  (apply #'%emit 'new (u2 (pool-class class-name))))
     532
     533(defknown emit-anewarray (t) t)
     534(defun emit-anewarray (class-name)
     535  (apply #'%emit 'anewarray (u2 (pool-class class-name))))
     536
     537(defknown emit-checkcast (t) t)
     538(defun emit-checkcast (class-name)
     539  (apply #'%emit 'checkcast (u2 (pool-class class-name))))
     540
     541(defknown emit-instanceof (t) t)
     542(defun emit-instanceof (class-name)
     543  (apply #'%emit 'instanceof (u2 (pool-class class-name))))
     544
    528545
    529546(defvar type-representations '((:int fixnum)
     
    559576(defknown emit-unbox-boolean () t)
    560577(defun emit-unbox-boolean ()
    561   (emit 'instanceof +lisp-nil+)
     578  (emit-instanceof +lisp-nil+)
    562579  (emit 'iconst_1)
    563580  (emit 'ixor))  ;; 1 -> 0 && 0 -> 1: in other words, negate the low bit
     
    569586                            (lisp-object-arg-types 1) :char))
    570587        (t
    571          (emit 'checkcast +lisp-character+)
     588         (emit-checkcast +lisp-character+)
    572589         (emit-getfield +lisp-character+ "value" :char))))
    573590
     
    714731        (LABEL1 (gensym)))
    715732    (emit-load-local-variable variable)
    716     (emit 'instanceof instanceof-class)
     733    (emit-instanceof instanceof-class)
    717734    (emit 'ifne LABEL1)
    718735    (emit-load-local-variable variable)
     
    858875                            (lisp-object-arg-types 1) :int))
    859876        (t
    860          (emit 'checkcast +lisp-fixnum+)
     877         (emit-checkcast +lisp-fixnum+)
    861878         (emit-getfield +lisp-fixnum+ "value" :int))))
    862879
     
    873890                            (lisp-object-arg-types 1) :float))
    874891        (t
    875          (emit 'checkcast +lisp-single-float+)
     892         (emit-checkcast +lisp-single-float+)
    876893         (emit-getfield +lisp-single-float+ "value" :float))))
    877894
     
    883900                            (lisp-object-arg-types 1) :double))
    884901        (t
    885          (emit 'checkcast +lisp-double-float+)
     902         (emit-checkcast +lisp-double-float+)
    886903         (emit-getfield +lisp-double-float+ "value" :double))))
    887904
     
    894911         (cond ((and (fixnum-type-p derived-type)
    895912                     (< *safety* 3))
    896                 (emit 'checkcast +lisp-fixnum+)
     913                (emit-checkcast +lisp-fixnum+)
    897914                (emit-getfield +lisp-fixnum+ "value" :int))
    898915               (t
     
    11841201;; new, anewarray, checkcast, instanceof class-name
    11851202(define-resolver (187 189 192 193) (instruction)
    1186   (let* ((args (instruction-args instruction))
    1187          (index (pool-class (first args))))
    1188     (inst (instruction-opcode instruction) (u2 index))))
     1203  ;; we used to create the pool-class here; that moved to the emit-* layer
     1204  instruction)
    11891205
    11901206;; iinc
     
    17551771                 `(progn
    17561772                    (emit-push-constant-int (length ,params))
    1757                     (emit 'anewarray +lisp-closure-parameter+)
     1773                    (emit-anewarray +lisp-closure-parameter+)
    17581774                    (astore (setf ,register (method-max-locals constructor)))
    17591775                    (incf (method-max-locals constructor))
     
    17651781                      (aload ,register)
    17661782                      (emit-push-constant-int ,count-sym)
    1767                       (emit 'new +lisp-closure-parameter+)
     1783                      (emit-new +lisp-closure-parameter+)
    17681784                      (emit 'dup)
    17691785                      ,@body
     
    20062022(defun serialize-float (s)
    20072023  "Generates code to restore a serialized single-float."
    2008   (emit 'new +lisp-single-float+)
     2024  (emit-new +lisp-single-float+)
    20092025  (emit 'dup)
    20102026  (emit 'ldc (pool-float s))
     
    20132029(defun serialize-double (d)
    20142030  "Generates code to restore a serialized double-float."
    2015   (emit 'new +lisp-double-float+)
     2031  (emit-new +lisp-double-float+)
    20162032  (emit 'dup)
    20172033  (emit 'ldc2_w (pool-double d))
     
    20202036(defun serialize-string (string)
    20212037  "Generate code to restore a serialized string."
    2022   (emit 'new +lisp-simple-string+)
     2038  (emit-new +lisp-simple-string+)
    20232039  (emit 'dup)
    20242040  (emit 'ldc (pool-string string))
     
    20532069       (emit-invokestatic +lisp-load+ "getUninternedSymbol" '(:int)
    20542070                          +lisp-object+)
    2055        (emit 'checkcast +lisp-symbol+))
     2071       (emit-checkcast +lisp-symbol+))
    20562072      ((keywordp symbol)
    20572073       (emit 'ldc (pool-string (symbol-name symbol)))
     
    21122128        (emit-getstatic *this-class* (cdr existing) field-type)
    21132129        (when cast
    2114           (emit 'checkcast cast))
     2130          (emit-checkcast cast))
    21152131        (return-from emit-load-externalized-object field-type)))
    21162132
     
    21282144                              (list +java-string+) +lisp-object+)
    21292145           (when (not (eq field-type +lisp-object+))
    2130              (emit 'checkcast field-type))
     2146             (emit-checkcast field-type))
    21312147           (emit-putstatic *this-class* field-name field-type)
    21322148           (setf *static-code* *code*)))
     
    21422158      (emit-getstatic *this-class* field-name field-type)
    21432159      (when cast
    2144         (emit 'checkcast cast))
     2160        (emit-checkcast cast))
    21452161      field-type)))
    21462162
     
    21732189             (progn ;; generated by the DECLARE-OBJECT*'s above
    21742190               (emit-getstatic class name +lisp-object+)
    2175                (emit 'checkcast +lisp-symbol+))
     2191               (emit-checkcast +lisp-symbol+))
    21762192             (emit-getstatic class name +lisp-symbol+))
    21772193         (emit-invokevirtual +lisp-symbol+
     
    22082224     ;; fixme *declare-inline*
    22092225     (declare-field g +lisp-object+ +field-access-private+)
    2210      (emit 'new class-name)
     2226     (emit-new class-name)
    22112227     (emit 'dup)
    22122228     (emit-invokespecial-init class-name '())
     
    27172733               (ht-form (%caddr form)))
    27182734           (compile-form ht-form 'stack nil)
    2719            (emit 'checkcast +lisp-hash-table+)
     2735           (emit-checkcast +lisp-hash-table+)
    27202736           (compile-form key-form 'stack nil)
    27212737           (maybe-emit-clear-values ht-form key-form)
     
    27352751               (value-form (fourth form)))
    27362752           (compile-form ht-form 'stack nil)
    2737            (emit 'checkcast +lisp-hash-table+)
     2753           (emit-checkcast +lisp-hash-table+)
    27382754           (compile-form key-form 'stack nil)
    27392755           (compile-form value-form 'stack nil)
     
    27822798              (t
    27832799               (emit-push-constant-int numargs)
    2784                (emit 'anewarray +lisp-object+)
     2800               (emit-anewarray +lisp-object+)
    27852801               (let ((i 0))
    27862802                 (dolist (arg args)
     
    29572973    (emit-push-constant-int 0)                            ;; srcPos
    29582974    (emit-push-constant-int (length *closure-variables*))
    2959     (emit 'anewarray +lisp-closure-binding+)             ;; dest
     2975    (emit-anewarray +lisp-closure-binding+)             ;; dest
    29602976    (emit 'dup)
    29612977    (astore register)  ;; save dest value
     
    30063022                                        ; Stack: template-function
    30073023             (when *closure-variables*
    3008                (emit 'checkcast +lisp-compiled-closure+)
     3024               (emit-checkcast +lisp-compiled-closure+)
    30093025               (duplicate-closure-array compiland)
    30103026               (emit-invokestatic +lisp+ "makeCompiledClosure"
     
    32213237    (let ((arg (%cadr form)))
    32223238      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    3223       (emit 'instanceof java-class)
     3239      (emit-instanceof java-class)
    32243240      'ifeq)))
    32253241
     
    38363852(defun emit-new-closure-binding (variable)
    38373853  ""
    3838   (emit 'new +lisp-closure-binding+)            ;; value c-b
     3854  (emit-new +lisp-closure-binding+)            ;; value c-b
    38393855  (emit 'dup_x1)                                 ;; c-b value c-b
    38403856  (emit 'swap)                                   ;; c-b c-b value
     
    43944410      ;; we have a block variable; that should be a closure variable
    43954411      (assert (not (null (variable-closure-index (tagbody-id-variable block)))))
    4396       (emit 'new +lisp-object+)
     4412      (emit-new +lisp-object+)
    43974413      (emit 'dup)
    43984414      (emit-invokespecial-init +lisp-object+ '())
     
    45014517   (check-arg-count form 1))
    45024518  (compile-forms-and-maybe-emit-clear-values (cadr form) 'stack nil)
    4503   (emit 'instanceof +lisp-cons+)
     4519  (emit-instanceof +lisp-cons+)
    45044520  (let ((LABEL1 (gensym))
    45054521        (LABEL2 (gensym)))
     
    45304546          (t
    45314547     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    4532            (emit 'instanceof java-class)
     4548           (emit-instanceof java-class)
    45334549           (convert-representation :boolean representation)
    45344550           (emit-move-from-stack target representation)))))
     
    45844600      ;; we have a block variable; that should be a closure variable
    45854601      (assert (not (null (variable-closure-index (block-id-variable block)))))
    4586       (emit 'new +lisp-object+)
     4602      (emit-new +lisp-object+)
    45874603      (emit 'dup)
    45884604      (emit-invokespecial-init +lisp-object+ '())
     
    46804696(define-inlined-function p2-cons (form target representation)
    46814697  ((check-arg-count form 2))
    4682   (emit 'new +lisp-cons+)
     4698  (emit-new +lisp-cons+)
    46834699  (emit 'dup)
    46844700  (let* ((args (%cdr form))
     
    48414857      (dformat t "(compiland-closure-register parent) = ~S~%"
    48424858         (compiland-closure-register parent))
    4843       (emit 'checkcast +lisp-compiled-closure+)
     4859      (emit-checkcast +lisp-compiled-closure+)
    48444860      (duplicate-closure-array parent)
    48454861      (emit-invokestatic +lisp+ "makeCompiledClosure"
     
    49714987
    49724988               (when (compiland-closure-register *current-compiland*)
    4973                  (emit 'checkcast +lisp-compiled-closure+)
     4989                 (emit-checkcast +lisp-compiled-closure+)
    49744990                 (duplicate-closure-array *current-compiland*)
    49754991                 (emit-invokestatic +lisp+ "makeCompiledClosure"
     
    55905606              (null representation))
    55915607         (let ((arg (second form)))
    5592            (emit 'new +lisp-simple-vector+)
     5608           (emit-new +lisp-simple-vector+)
    55935609           (emit 'dup)
    55945610     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
     
    56195635                 (setf class +lisp-simple-vector+)))))
    56205636        (when class
    5621           (emit 'new class)
     5637          (emit-new class)
    56225638          (emit 'dup)
    56235639    (compile-forms-and-maybe-emit-clear-values arg2 'stack :int)
     
    56345650              (null representation))
    56355651         (let ((arg (second form)))
    5636            (emit 'new +lisp-simple-string+)
     5652           (emit-new +lisp-simple-string+)
    56375653           (emit 'dup)
    56385654     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
     
    56455661  (cond ((and (check-arg-count form 2)
    56465662              (eq (derive-type (%cadr form)) 'SYMBOL))
    5647          (emit 'new +lisp-structure-object+)
     5663         (emit-new +lisp-structure-object+)
    56485664         (emit 'dup)
    56495665         (compile-form (%cadr form) 'stack nil)
    5650          (emit 'checkcast +lisp-symbol+)
     5666         (emit-checkcast +lisp-symbol+)
    56515667         (compile-form (%caddr form) 'stack nil)
    56525668         (maybe-emit-clear-values (%cadr form) (%caddr form))
     
    56655681    (cond ((and (<= 1 slot-count 6)
    56665682                (eq (derive-type (%car args)) 'SYMBOL))
    5667            (emit 'new +lisp-structure-object+)
     5683           (emit-new +lisp-structure-object+)
    56685684           (emit 'dup)
    56695685           (compile-form (%car args) 'stack nil)
    5670            (emit 'checkcast +lisp-symbol+)
     5686           (emit-checkcast +lisp-symbol+)
    56715687           (dolist (slot-form slot-forms)
    56725688             (compile-form slot-form 'stack nil))
     
    56815697(defun p2-make-hash-table (form target representation)
    56825698  (cond ((= (length form) 1) ; no args
    5683          (emit 'new +lisp-eql-hash-table+)
     5699         (emit-new +lisp-eql-hash-table+)
    56845700         (emit 'dup)
    56855701         (emit-invokespecial-init +lisp-eql-hash-table+ nil)
     
    56955711    (cond ((eq (derive-compiler-type arg) 'STREAM)
    56965712     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    5697            (emit 'checkcast +lisp-stream+)
     5713           (emit-checkcast +lisp-stream+)
    56985714           (emit-invokevirtual +lisp-stream+ "getElementType"
    56995715                               nil +lisp-object+)
     
    57145730           (compile-form arg1 'stack :int)
    57155731           (compile-form arg2 'stack nil)
    5716            (emit 'checkcast +lisp-stream+)
     5732           (emit-checkcast +lisp-stream+)
    57175733           (maybe-emit-clear-values arg1 arg2)
    57185734           (emit 'swap)
     
    57425758         (cond ((compiler-subtypep type1 'stream)
    57435759    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    5744                 (emit 'checkcast +lisp-stream+)
     5760                (emit-checkcast +lisp-stream+)
    57455761                (emit-push-constant-int 1)
    57465762                (emit-push-nil)
     
    57565772         (cond ((and (compiler-subtypep type1 'stream) (null arg2))
    57575773    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    5758                 (emit 'checkcast +lisp-stream+)
     5774                (emit-checkcast +lisp-stream+)
    57595775                (emit-push-constant-int 0)
    57605776                (emit-push-nil)
     
    63056321               (compile-form arg1 'stack nil)
    63066322               (compile-form arg2 'stack nil)
    6307                (emit 'checkcast +lisp-abstract-vector+)
     6323               (emit-checkcast +lisp-abstract-vector+)
    63086324               (maybe-emit-clear-values arg1 arg2)
    63096325               (emit 'swap)
     
    63476363    (cond ((>= 4 length 1)
    63486364     (dolist (cons-head cons-heads)
    6349        (emit 'new +lisp-cons+)
     6365       (emit-new +lisp-cons+)
    63506366       (emit 'dup)
    63516367       (compile-form cons-head 'stack nil))
     
    66386654                (zerop *safety*))
    66396655           (compile-form arg1 'stack nil)
    6640            (emit 'checkcast +lisp-abstract-string+)
     6656           (emit-checkcast +lisp-abstract-string+)
    66416657           (compile-form arg2 'stack :int)
    66426658           (maybe-emit-clear-values arg1 arg2)
     
    66496665                (fixnum-type-p type2))
    66506666           (compile-form arg1 'stack nil)
    6651            (emit 'checkcast +lisp-abstract-string+)
     6667           (emit-checkcast +lisp-abstract-string+)
    66526668           (compile-form arg2 'stack :int)
    66536669           (maybe-emit-clear-values arg1 arg2)
     
    66906706                             +lisp-abstract-string+)))
    66916707             (compile-form arg1 'stack nil)
    6692              (emit 'checkcast class)
     6708             (emit-checkcast class)
    66936709             (compile-form arg2 'stack :int)
    66946710             (compile-form arg3 'stack :char)
     
    67936809          (cond ((compiler-subtypep type1 'string)
    67946810                 (compile-form arg1 'stack nil) ; array
    6795                  (emit 'checkcast +lisp-abstract-string+)
     6811                 (emit-checkcast +lisp-abstract-string+)
    67966812                 (compile-form arg2 'stack :int) ; index
    67976813                 (maybe-emit-clear-values arg1 arg2)
     
    71757191         (emit-push-current-thread)
    71767192         (compile-form (%cadr form) 'stack nil)
    7177          (emit 'checkcast +lisp-symbol+)
     7193         (emit-checkcast +lisp-symbol+)
    71787194         (compile-form (%caddr form) 'stack nil)
    71797195         (maybe-emit-clear-values (%cadr form) (%caddr form))
     
    73277343    (cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
    73287344     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    7329            (emit 'checkcast +lisp-symbol+)
     7345           (emit-checkcast +lisp-symbol+)
    73307346           (emit-getfield  +lisp-symbol+ "name" +lisp-simple-string+)
    73317347           (emit-move-from-stack target representation))
     
    73397355    (cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
    73407356     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    7341            (emit 'checkcast +lisp-symbol+)
     7357           (emit-checkcast +lisp-symbol+)
    73427358           (emit-invokevirtual +lisp-symbol+ "getPackage"
    73437359                               nil +lisp-object+)
     
    73537369      (when (eq (derive-compiler-type arg) 'SYMBOL)
    73547370  (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    7355         (emit 'checkcast +lisp-symbol+)
     7371        (emit-checkcast +lisp-symbol+)
    73567372        (emit-push-current-thread)
    73577373        (emit-invokevirtual +lisp-symbol+ "symbolValue"
     
    73827398        (LABEL1 (gensym)))
    73837399    (emit 'dup)
    7384     (emit 'instanceof instanceof-class)
     7400    (emit-instanceof instanceof-class)
    73857401    (emit 'ifne LABEL1)
    73867402    (emit-getstatic +lisp-symbol+ expected-type-java-symbol-name +lisp-symbol+)
     
    79817997            ;; if we're the ultimate parent: create the closure array
    79827998            (emit-push-constant-int (length *closure-variables*))
    7983             (emit 'anewarray +lisp-closure-binding+))
     7999            (emit-anewarray +lisp-closure-binding+))
    79848000        (progn
    79858001          (aload 0)
     
    80088024            (emit 'dup) ; array
    80098025            (emit-push-constant-int i)
    8010             (emit 'new +lisp-closure-binding+)
     8026            (emit-new +lisp-closure-binding+)
    80118027            (emit 'dup)
    80128028            (cond
Note: See TracChangeset for help on using the changeset viewer.