Changeset 12856


Ignore:
Timestamp:
08/02/10 20:59:52 (13 years ago)
Author:
ehuelsmann
Message:

Change all literal strings for argument type identification (ie. "I")
to keyword symbols for readability (ie :int) and jvm-class-file
compatibility.

Note: This commit also removes the descriptor cache/hash. If there's
no other way, we can add it back for performance reasons, but I'd
rather put the burden of caching descriptors on the callers.

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

Legend:

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

    r12852 r12856  
    700700        (jvm::emit-invokevirtual +fasl-classloader+
    701701                                                         "putFunction"
    702                (list "I" jvm::+lisp-object+) jvm::+lisp-object+)
     702               (list :int jvm::+lisp-object+) jvm::+lisp-object+)
    703703        (jvm::emit 'jvm::pop))
    704704            t))))))
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12855 r12856  
    215215  "To be eliminated when all hard-coded strings are
    216216replaced by `class-name' structures"
    217   (if (typep class-name 'class-name)
    218       (class-ref class-name)
     217  (if (or (symbolp class-name) (typep class-name 'class-name))
     218      (internal-field-ref class-name)
    219219      class-name))
    220220
     
    413413           (emit 'pop2)))))
    414414
    415 (declaim (ftype (function (t t) cons) make-descriptor-info))
    416 (defun make-descriptor-info (arg-types return-type)
    417   (let ((descriptor (with-standard-io-syntax
    418                       (with-output-to-string (s)
    419                         (princ #\( s)
    420                         (dolist (type arg-types)
    421                           (princ type s))
    422                         (princ #\) s)
    423                         (princ (or return-type "V") s))))
    424         (stack-effect (let ((result (cond ((null return-type) 0)
    425                                           ((or (equal return-type "J")
    426                                                (equal return-type "D")) 2)
    427                                           (t 1))))
    428                         (dolist (type arg-types result)
    429                           (decf result (if (or (equal type "J")
    430                                                (equal type "D"))
    431                                            2 1))))))
    432     (cons descriptor stack-effect)))
    433 
    434 (defparameter *descriptors* (make-hash-table :test #'equal))
    435 
    436 (declaim (ftype (function (t t) cons) get-descriptor-info))
    437 (defun get-descriptor-info (arg-types return-type)
    438   (let* ((arg-types (mapcar #'!class-ref arg-types))
    439          (return-type (!class-ref return-type))
    440          (key (list arg-types return-type))
    441          (ht *descriptors*)
    442          (descriptor-info (gethash1 key ht)))
    443     (declare (type hash-table ht))
    444     (or descriptor-info
    445         (setf (gethash key ht) (make-descriptor-info arg-types return-type)))))
    446 
    447415(declaim (inline get-descriptor))
    448416(defun get-descriptor (arg-types return-type)
    449   (car (get-descriptor-info arg-types return-type)))
     417  (apply #'descriptor return-type arg-types))
    450418
    451419(declaim (ftype (function * t) emit-invokestatic))
    452420(defun emit-invokestatic (class-name method-name arg-types return-type)
    453   (let* ((info (get-descriptor-info arg-types return-type))
    454          (descriptor (car info))
    455          (stack-effect (cdr info))
     421  (let* ((descriptor (apply #'descriptor return-type arg-types))
     422         (stack-effect (apply #'descriptor-stack-effect return-type arg-types))
    456423         (index (if (null *current-code-attribute*)
    457424                    (pool-method class-name method-name descriptor)
     
    476443(defknown emit-invokevirtual (t t t t) t)
    477444(defun emit-invokevirtual (class-name method-name arg-types return-type)
    478   (let* ((info (get-descriptor-info arg-types return-type))
    479          (descriptor (car info))
    480          (stack-effect (cdr info))
     445  (let* ((descriptor (apply #'descriptor return-type arg-types))
     446         (stack-effect (apply #'descriptor-stack-effect return-type arg-types))
    481447         (index (if (null *current-code-attribute*)
    482448                    (pool-method class-name method-name descriptor)
     
    497463(defknown emit-invokespecial-init (string list) t)
    498464(defun emit-invokespecial-init (class-name arg-types)
    499   (let* ((info (get-descriptor-info arg-types nil))
    500          (descriptor (car info))
    501          (stack-effect (cdr info))
     465  (let* ((descriptor (apply #'descriptor :void arg-types))
     466         (stack-effect (apply #'descriptor-stack-effect :void arg-types))
    502467         (index (if (null *current-code-attribute*)
    503468                    (pool-method class-name "<init>" descriptor)
     
    525490                ((equal type +lisp-thread+)
    526491                 "LispThread")
    527                 ((equal type "C")
     492                ((equal type :char)
    528493                 "char")
    529                 ((equal type "I")
     494                ((equal type :int)
    530495                 "int")
    531                 ((equal type "Z")
     496                ((equal type :boolean)
    532497                 "boolean")
    533                 ((null type)
     498                ((or (null type)
     499                     (eq type :void))
    534500                 "void")
    535501                (t
     
    594560  (cond ((> *safety* 0)
    595561         (emit-invokestatic +lisp-character+ "getValue"
    596                             (lisp-object-arg-types 1) "C"))
     562                            (lisp-object-arg-types 1) :char))
    597563        (t
    598564         (emit 'checkcast +lisp-character+)
    599          (emit 'getfield +lisp-character+ "value" "C"))))
     565         (emit 'getfield +lisp-character+ "value" :char))))
    600566
    601567;;                     source type /
     
    624590when converting the internal representation to a LispObject.")
    625591
    626 (defvar rep-arg-chars
    627   '((:boolean . "Z")
    628     (:char    . "C")
    629     (:int     . "I")
    630     (:long    . "J")
    631     (:float   . "F")
    632     (:double  . "D"))
    633   "Lists the argument type identifiers for each
    634 of the internal representations.")
    635592
    636593(defun convert-representation (in out)
     
    643600    ;; Convert back to a lisp object
    644601    (when in
    645       (let ((class (cdr (assoc in rep-classes)))
    646             (arg-spec (cdr (assoc in rep-arg-chars))))
    647         (emit-invokestatic class "getInstance" (list arg-spec)
    648                            class)))
     602      (let ((class (cdr (assoc in rep-classes))))
     603        (emit-invokestatic class "getInstance" (list in) class)))
    649604    (return-from convert-representation))
    650605  (let* ((in-map (cdr (assoc in rep-conversion)))
     
    660615             (funcall op))
    661616            ((stringp op)
    662              (emit-invokevirtual +lisp-object+ op nil
    663                                  (cdr (assoc out rep-arg-chars))))
     617             (emit-invokevirtual +lisp-object+ op nil out))
    664618            (t
    665619             (emit op))))))
     
    816770  (unless (> *speed* *safety*)
    817771    (let ((label1 (gensym)))
    818       (emit-getstatic +lisp+ "interrupted" "Z")
     772      (emit-getstatic +lisp+ "interrupted" :boolean)
    819773      (emit 'ifeq label1)
    820774      (emit-invokestatic +lisp+ "handleInterrupt" nil nil)
     
    895849  (cond ((= *safety* 3)
    896850         (emit-invokestatic +lisp-fixnum+ "getValue"
    897                             (lisp-object-arg-types 1) "I"))
     851                            (lisp-object-arg-types 1) :int))
    898852        (t
    899853         (emit 'checkcast +lisp-fixnum+)
    900          (emit 'getfield +lisp-fixnum+ "value" "I"))))
     854         (emit 'getfield +lisp-fixnum+ "value" :int))))
    901855
    902856(defknown emit-unbox-long () t)
    903857(defun emit-unbox-long ()
    904858  (emit-invokestatic +lisp-bignum+ "longValue"
    905                      (lisp-object-arg-types 1) "J"))
     859                     (lisp-object-arg-types 1) :long))
    906860
    907861(defknown emit-unbox-float () t)
     
    910864  (cond ((= *safety* 3)
    911865         (emit-invokestatic +lisp-single-float+ "getValue"
    912                             (lisp-object-arg-types 1) "F"))
     866                            (lisp-object-arg-types 1) :float))
    913867        (t
    914868         (emit 'checkcast +lisp-single-float+)
    915          (emit 'getfield +lisp-single-float+ "value" "F"))))
     869         (emit 'getfield +lisp-single-float+ "value" :float))))
    916870
    917871(defknown emit-unbox-double () t)
     
    920874  (cond ((= *safety* 3)
    921875         (emit-invokestatic +lisp-double-float+ "getValue"
    922                             (lisp-object-arg-types 1) "D"))
     876                            (lisp-object-arg-types 1) :double))
    923877        (t
    924878         (emit 'checkcast +lisp-double-float+)
    925          (emit 'getfield +lisp-double-float+ "value" "D"))))
     879         (emit 'getfield +lisp-double-float+ "value" :double))))
    926880
    927881(defknown fix-boxing (t t) t)
     
    934888                     (< *safety* 3))
    935889                (emit 'checkcast +lisp-fixnum+)
    936                 (emit 'getfield +lisp-fixnum+ "value" "I"))
     890                (emit 'getfield +lisp-fixnum+ "value" :int))
    937891               (t
    938                 (emit-invokevirtual +lisp-object+ "intValue" nil "I"))))
     892                (emit-invokevirtual +lisp-object+ "intValue" nil :int))))
    939893        ((eq required-representation :char)
    940894         (emit-unbox-character))
     
    942896         (emit-unbox-boolean))
    943897        ((eq required-representation :long)
    944          (emit-invokevirtual +lisp-object+ "longValue" nil "J"))
     898         (emit-invokevirtual +lisp-object+ "longValue" nil :long))
    945899        ((eq required-representation :float)
    946          (emit-invokevirtual +lisp-object+ "floatValue" nil "F"))
     900         (emit-invokevirtual +lisp-object+ "floatValue" nil :float))
    947901        ((eq required-representation :double)
    948          (emit-invokevirtual +lisp-object+ "doubleValue" nil "D"))
     902         (emit-invokevirtual +lisp-object+ "doubleValue" nil :double))
    949903        (t (assert nil))))
    950904
     
    18211775                 (emit-push-nil)
    18221776                 (emit-push-t)) ;; we don't need the actual supplied-p symbol
    1823              (emit-getstatic +lisp-closure+ "OPTIONAL" "I")
     1777             (emit-getstatic +lisp-closure+ "OPTIONAL" :int)
    18241778             (emit-invokespecial-init +lisp-closure-parameter+
    18251779                                      (list +lisp-symbol+ +lisp-object+
    1826                                             +lisp-object+ "I")))
     1780                                            +lisp-object+ :int)))
    18271781
    18281782          (parameters-to-array (param key key-params-register)
     
    20251979        (emit-push-constant-int n)
    20261980        (emit-invokestatic +lisp-fixnum+ "getInstance"
    2027                            '("I") +lisp-fixnum+))
     1981                           '(:int) +lisp-fixnum+))
    20281982       ((<= most-negative-java-long n most-positive-java-long)
    20291983        (emit-push-constant-long n)
    20301984        (emit-invokestatic +lisp-bignum+ "getInstance"
    2031                            '("J") +lisp-integer+))
     1985                           '(:long) +lisp-integer+))
    20321986       (t
    20331987        (let* ((*print-base* 10)
     
    20361990          (emit-push-constant-int 10)
    20371991          (emit-invokestatic +lisp-bignum+ "getInstance"
    2038                              (list +java-string+ "I") +lisp-integer+)))))
     1992                             (list +java-string+ :int) +lisp-integer+)))))
    20391993
    20401994(defun serialize-character (c)
    20411995  "Generates code to restore a serialized character."
    20421996  (emit-push-constant-int (char-code c))
    2043   (emit-invokestatic +lisp-character+ "getInstance" '("C")
     1997  (emit-invokestatic +lisp-character+ "getInstance" '(:char)
    20441998                     +lisp-character+))
    20451999
     
    20492003  (emit 'dup)
    20502004  (emit 'ldc (pool-float s))
    2051   (emit-invokespecial-init +lisp-single-float+ '("F")))
     2005  (emit-invokespecial-init +lisp-single-float+ '(:float)))
    20522006
    20532007(defun serialize-double (d)
     
    20562010  (emit 'dup)
    20572011  (emit 'ldc2_w (pool-double d))
    2058   (emit-invokespecial-init +lisp-double-float+ '("D")))
     2012  (emit-invokespecial-init +lisp-double-float+ '(:double)))
    20592013
    20602014(defun serialize-string (string)
     
    20912045      ((null (symbol-package symbol))
    20922046       (emit-push-constant-int (dump-uninterned-symbol-index symbol))
    2093        (emit-invokestatic +lisp-load+ "getUninternedSymbol" '("I")
     2047       (emit-invokestatic +lisp-load+ "getUninternedSymbol" '(:int)
    20942048                          +lisp-object+)
    20952049       (emit 'checkcast +lisp-symbol+))
     
    23342288           ((integerp form)
    23352289            (emit-load-externalized-object form)
    2336             (emit-invokevirtual +lisp-object+ "intValue" nil "I"))
     2290            (emit-invokevirtual +lisp-object+ "intValue" nil :int))
    23372291           (t
    23382292            (sys::%format t "compile-constant int representation~%")
     
    23452299           ((integerp form)
    23462300            (emit-load-externalized-object form)
    2347             (emit-invokevirtual +lisp-object+ "longValue" nil "J"))
     2301            (emit-invokevirtual +lisp-object+ "longValue" nil :long))
    23482302           (t
    23492303            (sys::%format t "compile-constant long representation~%")
     
    24732427                (emit-invokevirtual +lisp-object+
    24742428                                    unboxed-method-name
    2475                                     nil "Z"))
     2429                                    nil :boolean))
    24762430               ((NIL)
    24772431                (emit-invokevirtual +lisp-object+
     
    26082562
    26092563(defun emit-ifne-for-eql (representation instruction-type)
    2610   (emit-invokevirtual +lisp-object+ "eql" instruction-type "Z")
     2564  (emit-invokevirtual +lisp-object+ "eql" instruction-type :boolean)
    26112565  (convert-representation :boolean representation))
    26122566
     
    26342588     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    26352589                  arg2 'stack :int)
    2636      (emit-ifne-for-eql representation '("I")))
     2590     (emit-ifne-for-eql representation '(:int)))
    26372591          ((fixnum-type-p type1)
    26382592     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    26392593                  arg2 'stack nil)
    26402594           (emit 'swap)
    2641      (emit-ifne-for-eql representation '("I")))
     2595     (emit-ifne-for-eql representation '(:int)))
    26422596          ((eq type2 'CHARACTER)
    26432597     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    26442598                  arg2 'stack :char)
    2645      (emit-ifne-for-eql representation '("C")))
     2599     (emit-ifne-for-eql representation '(:char)))
    26462600          ((eq type1 'CHARACTER)
    26472601     (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
    26482602                  arg2 'stack nil)
    26492603           (emit 'swap)
    2650      (emit-ifne-for-eql representation '("C")))
     2604     (emit-ifne-for-eql representation '(:char)))
    26512605          (t
    26522606     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     
    26552609             (:boolean
    26562610              (emit-invokevirtual +lisp-object+ "eql"
    2657                                   (lisp-object-arg-types 1) "Z"))
     2611                                  (lisp-object-arg-types 1) :boolean))
    26582612             ((NIL)
    26592613              (emit-invokevirtual +lisp-object+ "EQL"
     
    26712625           (compile-form arg2 'stack nil)
    26722626           (emit-invokestatic +lisp+ "memq"
    2673                               (lisp-object-arg-types 2) "Z")
     2627                              (lisp-object-arg-types 2) :boolean)
    26742628           (emit-move-from-stack target representation)))
    26752629        (t
     
    26882642           (cond ((eq type1 'SYMBOL) ; FIXME
    26892643                  (emit-invokestatic +lisp+ "memq"
    2690                                      (lisp-object-arg-types 2) "Z"))
     2644                                     (lisp-object-arg-types 2) :boolean))
    26912645                 (t
    26922646                  (emit-invokestatic +lisp+ "memql"
    2693                                      (lisp-object-arg-types 2) "Z")))
     2647                                     (lisp-object-arg-types 2) :boolean)))
    26942648           (emit-move-from-stack target representation)))
    26952649        (t
     
    30032957    (emit-push-constant-int (length *closure-variables*)) ;; length
    30042958    (emit-invokestatic +java-system+ "arraycopy"
    3005                        (list +java-object+ "I"
    3006                              +java-object+ "I" "I") nil)
     2959                       (list +java-object+ :int
     2960                             +java-object+ :int :int) nil)
    30072961    (aload register))) ;; reload dest value
    30082962
     
    31273081                                      (>= "isGreaterThanOrEqualTo")
    31283082                                      (=  "isEqualTo"))
    3129                                     '("I")
    3130                                     "Z")
     3083                                    '(:int)
     3084                                    :boolean)
    31313085                ;; Java boolean on stack here
    31323086                (convert-representation :boolean representation)
     
    32533207    (let ((arg (%cadr form)))
    32543208      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    3255       (emit-invokevirtual +lisp-object+ java-predicate nil "Z")
     3209      (emit-invokevirtual +lisp-object+ java-predicate nil :boolean)
    32563210      'ifeq)))
    32573211
     
    32753229    (let ((arg (%cadr form)))
    32763230      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    3277       (emit-invokevirtual +lisp-object+ "constantp" nil "Z")
     3231      (emit-invokevirtual +lisp-object+ "constantp" nil :boolean)
    32783232      'ifeq)))
    32793233
     
    34663420       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    34673421              arg2 'stack :char)
    3468              (emit-invokevirtual +lisp-object+ "eql" '("C") "Z")
     3422             (emit-invokevirtual +lisp-object+ "eql" '(:char) :boolean)
    34693423             'ifeq)
    34703424            ((eq type1 'CHARACTER)
     
    34723426              arg2 'stack nil)
    34733427             (emit 'swap)
    3474              (emit-invokevirtual +lisp-object+ "eql" '("C") "Z")
     3428             (emit-invokevirtual +lisp-object+ "eql" '(:char) :boolean)
    34753429             'ifeq)
    34763430            ((fixnum-type-p type2)
    34773431       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    34783432              arg2 'stack :int)
    3479              (emit-invokevirtual +lisp-object+ "eql" '("I") "Z")
     3433             (emit-invokevirtual +lisp-object+ "eql" '(:int) :boolean)
    34803434             'ifeq)
    34813435            ((fixnum-type-p type1)
     
    34833437              arg2 'stack nil)
    34843438             (emit 'swap)
    3485              (emit-invokevirtual +lisp-object+ "eql" '("I") "Z")
     3439             (emit-invokevirtual +lisp-object+ "eql" '(:int) :boolean)
    34863440             'ifeq)
    34873441            (t
     
    34893443              arg2 'stack nil)
    34903444             (emit-invokevirtual +lisp-object+ "eql"
    3491                                  (lisp-object-arg-types 1) "Z")
     3445                                 (lisp-object-arg-types 1) :boolean)
    34923446             'ifeq)))))
    34933447
     
    35053459             (emit-invokevirtual +lisp-object+
    35063460                                 translated-op
    3507                                  '("I") "Z"))
     3461                                 '(:int) :boolean))
    35083462            (t
    35093463       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     
    35113465             (emit-invokevirtual +lisp-object+
    35123466                                 translated-op
    3513                                  (lisp-object-arg-types 1) "Z")))
     3467                                 (lisp-object-arg-types 1) :boolean)))
    35143468      'ifeq)))
    35153469
     
    35323486             arg2 'stack nil)
    35333487      (emit-invokestatic +lisp+ "memq"
    3534                          (lisp-object-arg-types 2) "Z")
     3488                         (lisp-object-arg-types 2) :boolean)
    35353489      'ifeq)))
    35363490
     
    35423496             arg2 'stack nil)
    35433497      (emit-invokestatic +lisp+ "memql"
    3544                          (lisp-object-arg-types 2) "Z")
     3498                         (lisp-object-arg-types 2) :boolean)
    35453499      'ifeq)))
    35463500
     
    35613515       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    35623516              arg2 'stack :int)
    3563              (emit-invokevirtual +lisp-object+ "isNotEqualTo" '("I") "Z")
     3517             (emit-invokevirtual +lisp-object+ "isNotEqualTo" '(:int) :boolean)
    35643518             'ifeq)
    35653519            ((fixnum-type-p type1)
     
    35693523              arg2 'stack nil)
    35703524             (emit 'swap)
    3571              (emit-invokevirtual +lisp-object+ "isNotEqualTo" '("I") "Z")
     3525             (emit-invokevirtual +lisp-object+ "isNotEqualTo" '(:int) :boolean)
    35723526             'ifeq)
    35733527            (t
     
    35753529              arg2 'stack nil)
    35763530             (emit-invokevirtual +lisp-object+ "isNotEqualTo"
    3577                                  (lisp-object-arg-types 1) "Z")
     3531                                 (lisp-object-arg-types 1) :boolean)
    35783532             'ifeq)))))
    35793533
     
    36183572                                     (>= "isGreaterThanOrEqualTo")
    36193573                                     (=  "isEqualTo"))
    3620                                    '("I") "Z")
     3574                                   '(:int) :boolean)
    36213575               'ifeq)
    36223576              ((fixnum-type-p type1)
     
    36333587                                     (>= "isLessThanOrEqualTo")
    36343588                                     (=  "isEqualTo"))
    3635                                    '("I") "Z")
     3589                                   '(:int) :boolean)
    36363590               'ifeq)
    36373591              (t
     
    36453599                                     (>= "isGreaterThanOrEqualTo")
    36463600                                     (=  "isEqualTo"))
    3647                                    (lisp-object-arg-types 1) "Z")
     3601                                   (lisp-object-arg-types 1) :boolean)
    36483602               'ifeq))))))
    36493603
     
    40223976             (emit-push-constant-int (length vars))
    40233977             (emit-invokevirtual +lisp-thread+ "getValues"
    4024                                  (list +lisp-object+ "I") +lisp-object-array+)
     3978                                 (list +lisp-object+ :int) +lisp-object-array+)
    40253979             ;; Values array is now on the stack at runtime.
    40263980             (label LABEL2)
     
    51575111      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    51585112                   arg2 'stack :int)
    5159                   (emit-invokevirtual +lisp-object+ "ash" '("I") +lisp-object+)
     5113                  (emit-invokevirtual +lisp-object+ "ash" '(:int) +lisp-object+)
    51605114                  (fix-boxing representation result-type)))
    51615115           (emit-move-from-stack target representation))
     
    52215175    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    52225176                 arg2 'stack :int)
    5223                 (emit-invokevirtual +lisp-object+ "LOGAND" '("I") +lisp-object+)
     5177                (emit-invokevirtual +lisp-object+ "LOGAND" '(:int) +lisp-object+)
    52245178                (fix-boxing representation result-type)
    52255179                (emit-move-from-stack target representation))
     
    52305184                ;; swap args
    52315185                (emit 'swap)
    5232                 (emit-invokevirtual +lisp-object+ "LOGAND" '("I") +lisp-object+)
     5186                (emit-invokevirtual +lisp-object+ "LOGAND" '(:int) +lisp-object+)
    52335187                (fix-boxing representation result-type)
    52345188                (emit-move-from-stack target representation))
     
    52935247    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    52945248                 arg2 'stack :int)
    5295                 (emit-invokevirtual +lisp-object+ "LOGIOR" '("I") +lisp-object+)
     5249                (emit-invokevirtual +lisp-object+ "LOGIOR" '(:int) +lisp-object+)
    52965250                (fix-boxing representation result-type)
    52975251                (emit-move-from-stack target representation))
     
    53025256                ;; swap args
    53035257                (emit 'swap)
    5304                 (emit-invokevirtual +lisp-object+ "LOGIOR" '("I") +lisp-object+)
     5258                (emit-invokevirtual +lisp-object+ "LOGIOR" '(:int) +lisp-object+)
    53055259                (fix-boxing representation result-type)
    53065260                (emit-move-from-stack target representation))
     
    53575311    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    53585312                 arg2 'stack :int)
    5359                 (emit-invokevirtual +lisp-object+ "LOGXOR" '("I") +lisp-object+)
     5313                (emit-invokevirtual +lisp-object+ "LOGXOR" '(:int) +lisp-object+)
    53605314                (fix-boxing representation result-type))
    53615315               (t
     
    54415395                  (emit-push-constant-int size)
    54425396                  (emit-push-constant-int position)
    5443                   (emit-invokevirtual +lisp-object+ "LDB" '("I" "I") +lisp-object+)
     5397                  (emit-invokevirtual +lisp-object+ "LDB" '(:int :int) +lisp-object+)
    54445398                  (fix-boxing representation nil)
    54455399                  (emit-move-from-stack target representation))))
     
    54515405           (emit 'dup_x2) ;; use not supported by emit-dup: 3 values involved
    54525406           (emit 'pop)
    5453            (emit-invokevirtual +lisp-object+ "LDB" '("I" "I") +lisp-object+)
     5407           (emit-invokevirtual +lisp-object+ "LDB" '(:int :int) +lisp-object+)
    54545408           (fix-boxing representation nil)
    54555409           (emit-move-from-stack target representation))
     
    54705424     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    54715425                  arg2 'stack :int)
    5472            (emit-invokestatic +lisp+ "mod" '("I" "I") "I")
     5426           (emit-invokestatic +lisp+ "mod" '(:int :int) :int)
    54735427           (emit-move-from-stack target representation))
    54745428          ((fixnum-type-p type2)
    54755429     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    54765430                  arg2 'stack :int)
    5477            (emit-invokevirtual +lisp-object+ "MOD" '("I") +lisp-object+)
     5431           (emit-invokevirtual +lisp-object+ "MOD" '(:int) +lisp-object+)
    54785432           (fix-boxing representation nil) ; FIXME use derived result type
    54795433           (emit-move-from-stack target representation))
     
    55505504       (emit-push-constant-int 1) ; errorp
    55515505       (emit-invokestatic +lisp-class+ "findClass"
    5552                           (list +lisp-object+ "Z") +lisp-object+)
     5506                          (list +lisp-object+ :boolean) +lisp-object+)
    55535507       (fix-boxing representation nil)
    55545508       (emit-move-from-stack target representation))
     
    55585512                arg2 'stack :boolean)
    55595513         (emit-invokestatic +lisp-class+ "findClass"
    5560                             (list +lisp-object+ "Z") +lisp-object+)
     5514                            (list +lisp-object+ :boolean) +lisp-object+)
    55615515         (fix-boxing representation nil)
    55625516         (emit-move-from-stack target representation)))
     
    56335587           (emit 'dup)
    56345588     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    5635            (emit-invokespecial-init +lisp-simple-vector+ '("I"))
     5589           (emit-invokespecial-init +lisp-simple-vector+ '(:int))
    56365590           (emit-move-from-stack target representation)))
    56375591        (t
     
    56625616          (emit 'dup)
    56635617    (compile-forms-and-maybe-emit-clear-values arg2 'stack :int)
    5664           (emit-invokespecial-init class '("I"))
     5618          (emit-invokespecial-init class '(:int))
    56655619          (emit-move-from-stack target representation)
    56665620          (return-from p2-make-sequence)))))
     
    56775631           (emit 'dup)
    56785632     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    5679            (emit-invokespecial-init +lisp-simple-string+ '("I"))
     5633           (emit-invokespecial-init +lisp-simple-string+ '(:int))
    56805634           (emit-move-from-stack target representation)))
    56815635        (t
     
    57575711           (maybe-emit-clear-values arg1 arg2)
    57585712           (emit 'swap)
    5759            (emit-invokevirtual +lisp-stream+ "_writeByte" '("I") nil)
     5713           (emit-invokevirtual +lisp-stream+ "_writeByte" '(:int) nil)
    57605714           (when target
    57615715             (emit-push-nil)
     
    57665720           (maybe-emit-clear-values arg1 arg2)
    57675721           (emit-invokestatic +lisp+ "writeByte"
    5768                               (list "I" +lisp-object+) nil)
     5722                              (list :int +lisp-object+) nil)
    57695723           (when target
    57705724             (emit-push-nil)
     
    57865740                (emit-push-nil)
    57875741                (emit-invokevirtual +lisp-stream+ "readLine"
    5788                                     (list "Z" +lisp-object+) +lisp-object+)
     5742                                    (list :boolean +lisp-object+) +lisp-object+)
    57895743                (emit-move-from-stack target))
    57905744               (t
     
    58005754                (emit-push-nil)
    58015755                (emit-invokevirtual +lisp-stream+ "readLine"
    5802                                     (list "Z" +lisp-object+) +lisp-object+)
     5756                                    (list :boolean +lisp-object+) +lisp-object+)
    58035757                (emit-move-from-stack target)
    58045758                )
     
    63636317    (ecase representation
    63646318      (:int
    6365        (emit-invokevirtual +lisp-object+ "length" nil "I"))
     6319       (emit-invokevirtual +lisp-object+ "length" nil :int))
    63666320      ((:long :float :double)
    6367        (emit-invokevirtual +lisp-object+ "length" nil "I")
     6321       (emit-invokevirtual +lisp-object+ "length" nil :int)
    63686322       (convert-representation :int representation))
    63696323      (:boolean
    63706324       ;; FIXME We could optimize this all away in unsafe calls.
    6371        (emit-invokevirtual +lisp-object+ "length" nil "I")
     6325       (emit-invokevirtual +lisp-object+ "length" nil :int)
    63726326       (emit 'pop)
    63736327       (emit 'iconst_1))
     
    64266380                 list-form 'stack nil)
    64276381    (emit 'swap)
    6428     (emit-invokevirtual +lisp-object+ "NTH" '("I") +lisp-object+)
     6382    (emit-invokevirtual +lisp-object+ "NTH" '(:int) +lisp-object+)
    64296383    (fix-boxing representation nil) ; FIXME use derived result type
    64306384    (emit-move-from-stack target representation)))
     
    64656419        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    64666420              (emit-push-int arg2)
    6467               (emit-invokevirtual +lisp-object+ "multiplyBy" '("I") +lisp-object+)
     6421              (emit-invokevirtual +lisp-object+ "multiplyBy" '(:int) +lisp-object+)
    64686422              (fix-boxing representation result-type)
    64696423              (emit-move-from-stack target representation))
     
    65196473                                          "isLessThanOrEqualTo"
    65206474                                          "isGreaterThanOrEqualTo")
    6521                                       (lisp-object-arg-types 1) "Z")
     6475                                      (lisp-object-arg-types 1) :boolean)
    65226476                  (let ((LABEL1 (gensym)))
    65236477                    (emit 'ifeq LABEL1)
     
    65846538                (emit 'swap))
    65856539              (emit-invokevirtual +lisp-object+ "add"
    6586                                   '("I") +lisp-object+)
     6540                                  '(:int) +lisp-object+)
    65876541              (fix-boxing representation result-type)
    65886542              (emit-move-from-stack target representation))
     
    66566610              (emit-invokevirtual +lisp-object+
    66576611                                  "subtract"
    6658                                   '("I") +lisp-object+)
     6612                                  '(:int) +lisp-object+)
    66596613              (fix-boxing representation result-type)
    66606614              (emit-move-from-stack target representation))
     
    66826636           (maybe-emit-clear-values arg1 arg2)
    66836637           (emit-invokevirtual +lisp-abstract-string+ "charAt"
    6684                                '("I") "C")
     6638                               '(:int) :char)
    66856639           (emit-move-from-stack target representation))
    66866640          ((and (eq representation :char)
     
    66936647           (maybe-emit-clear-values arg1 arg2)
    66946648           (emit-invokevirtual +lisp-abstract-string+ "charAt"
    6695                                '("I") "C")
     6649                               '(:int) :char)
    66966650           (emit-move-from-stack target representation))
    66976651          ((fixnum-type-p type2)
     
    67006654           (emit-invokevirtual +lisp-object+
    67016655                               (symbol-name op) ;; "CHAR" or "SCHAR"
    6702                                '("I") +lisp-object+)
     6656                               '(:int) +lisp-object+)
    67036657           (when (eq representation :char)
    67046658             (emit-unbox-character))
     
    67376691               (emit-move-from-stack value-register :char))
    67386692             (maybe-emit-clear-values arg1 arg2 arg3)
    6739              (emit-invokevirtual class "setCharAt" '("I" "C") nil)
     6693             (emit-invokevirtual class "setCharAt" '(:int :char) nil)
    67406694             (when target
    67416695               (emit 'iload value-register)
     
    67536707     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    67546708                  arg2 'stack :int)
    6755            (emit-invokevirtual +lisp-object+ "SVREF" '("I") +lisp-object+)
     6709           (emit-invokevirtual +lisp-object+ "SVREF" '(:int) +lisp-object+)
    67566710           (fix-boxing representation nil)
    67576711           (emit-move-from-stack target representation)))
     
    67736727             (emit-move-from-stack value-register nil))
    67746728           (maybe-emit-clear-values arg1 arg2 arg3)
    6775            (emit-invokevirtual +lisp-object+ "svset" (list "I" +lisp-object+) nil)
     6729           (emit-invokevirtual +lisp-object+ "svset" (list :int +lisp-object+) nil)
    67766730           (when value-register
    67776731             (aload value-register)
     
    68086762         (compile-form (second form) 'stack nil)
    68096763         (compile-form (third form) 'stack :int)
    6810          (emit-invokevirtual +lisp-object+ "elt" '("I") +lisp-object+)
     6764         (emit-invokevirtual +lisp-object+ "elt" '(:int) +lisp-object+)
    68116765         (fix-boxing representation nil) ; FIXME use derived result type
    68126766         (emit-move-from-stack target representation))
     
    68256779    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    68266780                 arg2 'stack :int)
    6827           (emit-invokevirtual +lisp-object+ "aref" '("I") "I"))
     6781          (emit-invokevirtual +lisp-object+ "aref" '(:int) :int))
    68286782         (:long
    68296783    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    68306784                 arg2 'stack :int)
    6831           (emit-invokevirtual +lisp-object+ "aref_long" '("I") "J"))
     6785          (emit-invokevirtual +lisp-object+ "aref_long" '(:int) :long))
    68326786         (:char
    68336787          (cond ((compiler-subtypep type1 'string)
     
    68376791                 (maybe-emit-clear-values arg1 arg2)
    68386792                 (emit-invokevirtual +lisp-abstract-string+
    6839                                      "charAt" '("I") "C"))
     6793                                     "charAt" '(:int) :char))
    68406794                (t
    68416795     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    68426796                  arg2 'stack :int)
    6843                  (emit-invokevirtual +lisp-object+ "AREF" '("I") +lisp-object+)
     6797                 (emit-invokevirtual +lisp-object+ "AREF" '(:int) +lisp-object+)
    68446798                 (emit-unbox-character))))
    68456799         ((nil :float :double :boolean)
     
    68486802    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    68496803                 arg2 'stack :int)
    6850           (emit-invokevirtual +lisp-object+ "AREF" '("I") +lisp-object+)
     6804          (emit-invokevirtual +lisp-object+ "AREF" '(:int) +lisp-object+)
    68516805          (convert-representation nil representation)))
    68526806       (emit-move-from-stack target representation)))
     
    68816835           (maybe-emit-clear-values arg1 arg2 arg3)
    68826836           (cond ((fixnum-type-p type3)
    6883                   (emit-invokevirtual +lisp-object+ "aset" '("I" "I") nil))
     6837                  (emit-invokevirtual +lisp-object+ "aset" '(:int :int) nil))
    68846838                 (t
    6885                   (emit-invokevirtual +lisp-object+ "aset" (list "I" +lisp-object+) nil)))
     6839                  (emit-invokevirtual +lisp-object+ "aset" (list :int +lisp-object+) nil)))
    68866840           (when value-register
    68876841             (cond ((fixnum-type-p type3)
     
    69206874              (emit-push-constant-int arg2)
    69216875              (emit-invokevirtual +lisp-object+ "getSlotValue"
    6922                                   '("I") +lisp-object+)))
     6876                                  '(:int) +lisp-object+)))
    69236877           (emit-move-from-stack target representation))
    69246878          ((fixnump arg2)
     
    69286882             (:int
    69296883              (emit-invokevirtual +lisp-object+ "getFixnumSlotValue"
    6930                                   '("I") "I"))
     6884                                  '(:int) :int))
    69316885             ((nil :char :long :float :double)
    69326886              (emit-invokevirtual +lisp-object+ "getSlotValue"
    6933                                   '("I") +lisp-object+)
     6887                                  '(:int) +lisp-object+)
    69346888              ;; (convert-representation NIL NIL) is a no-op
    69356889              (convert-representation nil representation))
    69366890             (:boolean
    69376891              (emit-invokevirtual +lisp-object+ "getSlotValueAsBoolean"
    6938                                   '("I") "Z")))
     6892                                  '(:int) :boolean)))
    69396893           (emit-move-from-stack target representation))
    69406894          (t
     
    69756929              (astore value-register))
    69766930            (emit-invokevirtual +lisp-object+ "setSlotValue"
    6977                                 (list "I" +lisp-object+) nil)
     6931                                (list :int +lisp-object+) nil)
    69786932            (when value-register
    69796933              (aload value-register)
     
    70406994                  arg2 'stack nil)
    70416995           (emit 'swap)
    7042            (emit-invokevirtual +lisp-object+ "nthcdr" '("I") +lisp-object+)
     6996           (emit-invokevirtual +lisp-object+ "nthcdr" '(:int) +lisp-object+)
    70436997           (fix-boxing representation nil)
    70446998           (emit-move-from-stack target representation))
     
    73557309         (let ((arg (%cadr form)))
    73567310     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    7357            (emit-invokevirtual +lisp-object+ "sxhash" nil "I")
     7311           (emit-invokevirtual +lisp-object+ "sxhash" nil :int)
    73587312           (convert-representation :int representation)
    73597313           (emit-move-from-stack target representation)))
     
    78367790        (setf *hairy-arglist-p* t)
    78377791        (return-from analyze-args
    7838           (get-descriptor (list +lisp-object-array+) +lisp-object+)))
     7792          (descriptor +lisp-object+ +lisp-object-array+)))
    78397793      (return-from analyze-args
    78407794        (cond ((<= arg-count call-registers-limit)
    7841                (get-descriptor (lisp-object-arg-types arg-count) +lisp-object+))
     7795               (apply #'descriptor +lisp-object+
     7796                      (lisp-object-arg-types arg-count)))
    78427797              (t (setf *using-arg-array* t)
    78437798                 (setf (compiland-arity compiland) arg-count)
    7844                  (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
     7799                 (descriptor +lisp-object+ +lisp-object-array+)))))
    78457800    (when (or (memq '&KEY args)
    78467801              (memq '&OPTIONAL args)
     
    78487803      (setf *using-arg-array* t)
    78497804      (setf *hairy-arglist-p* t)
    7850       (return-from analyze-args
    7851                    (get-descriptor (list +lisp-object-array+) +lisp-object+)))
     7805      (return-from analyze-args (descriptor +lisp-object+ +lisp-object-array+)))
    78527806    (cond ((<= arg-count call-registers-limit)
    7853            (get-descriptor (lisp-object-arg-types (length args))
    7854                             +lisp-object+))
     7807           (apply #'descriptor +lisp-object+
     7808                      (lisp-object-arg-types (length args))))
    78557809          (t
    78567810           (setf *using-arg-array* t)
    78577811           (setf (compiland-arity compiland) arg-count)
    7858            (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
     7812           (descriptor +lisp-object+ +lisp-object-array+)))))
    78597813
    78607814(defmacro with-open-class-file ((var class-file) &body body)
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

    r12853 r12856  
    214214  "Returns a string describing the `return-type' and `argument-types'
    215215in JVM-internal representation."
    216   (format nil "(~{~A~})~A" (mapcar #'internal-field-ref argument-types)
    217           (internal-field-ref return-type)))
     216  (let* ((arg-strings (mapcar #'internal-field-ref argument-types))
     217         (ret-string (internal-field-ref return-type))
     218         (size (+ 2 (reduce #'+ arg-strings
     219                            :key #'length
     220                            :initial-value (length ret-string))))
     221         (str (make-array size :fill-pointer 0 :element-type 'character)))
     222    (with-output-to-string (s str)
     223      (princ #\( s)
     224      (dolist (arg-string arg-strings)
     225        (princ arg-string s))
     226      (princ #\) s)
     227      (princ ret-string s))
     228    str)
     229;;  (format nil "(~{~A~})~A"
     230;;          (internal-field-ref return-type))
     231  )
     232
     233(defun descriptor-stack-effect (return-type &rest argument-types)
     234  "Returns the effect on the stack position of the `argument-types' and
     235`return-type' of a method call.
     236
     237If the method consumes an implicit `this' argument, this function does not
     238take that effect into account."
     239  (flet ((type-stack-effect (arg)
     240           (case arg
     241             ((:long :double) 2)
     242             ((nil :void) 0)
     243             (otherwise 1))))
     244    (+ (reduce #'- argument-types
     245               :key #'type-stack-effect
     246               :initial-value 0)
     247       (type-stack-effect return-type))))
    218248
    219249
Note: See TracChangeset for help on using the changeset viewer.