Changeset 8378


Ignore:
Timestamp:
01/21/05 03:27:43 (16 years ago)
Author:
piso
Message:

Work in progress (tested).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/jvm.lisp

    r8377 r8378  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.360 2005-01-20 20:10:23 piso Exp $
     4;;; $Id: jvm.lisp,v 1.361 2005-01-21 03:27:43 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    886886      (emit 'ldc (pool-int n))))
    887887
     888(defparameter *descriptors* (make-hash-table :test #'equal))
     889
    888890(defun make-descriptor (arg-types return-type)
    889   (with-output-to-string (s)
    890     (princ #\( s)
    891     (dolist (type arg-types)
    892       (princ type s))
    893     (princ #\) s)
    894     (princ (or return-type "V") s)))
     891  (let* ((key (list arg-types return-type))
     892         (descriptor (gethash key *descriptors*)))
     893    (or descriptor
     894        (setf (gethash key *descriptors*)
     895              (with-output-to-string (s)
     896                (princ #\( s)
     897                (dolist (type arg-types)
     898                  (princ type s))
     899                (princ #\) s)
     900                (princ (or return-type "V") s))))))
    895901
    896902(defun descriptor (designator)
     
    916922    (setf (instruction-stack instruction) stack)))
    917923
    918 ;; (defun emit-invokevirtual (class-name method-name descriptor stack)
    919 ;;   (let ((instruction (emit 'invokevirtual
    920 ;;                            class-name method-name (descriptor descriptor))))
    921 ;;     (setf (instruction-stack instruction) stack)))
    922 
    923 (defun emit-invokevirtual-2 (class-name method-name arg-types return-type)
     924(defun emit-invokevirtual (class-name method-name arg-types return-type)
    924925  (let* ((descriptor (make-descriptor arg-types return-type))
    925926         (stack (- (if return-type 1 0) 1 (length arg-types)))
     
    953954      (aver (fixnump *arity*))
    954955      (aver (not (minusp *arity*)))
    955 ;;       (emit 'aload 1)
    956956      (aver (not (null (compiland-argument-register *current-compiland*))))
    957957      (emit 'aload (compiland-argument-register *current-compiland*))
     
    960960      (emit 'if_icmpeq `,label1)
    961961      (emit 'aload 0) ; this
    962       (emit-invokevirtual-2 *this-class* "argCountError" nil nil)
     962      (emit-invokevirtual *this-class* "argCountError" nil nil)
    963963      (emit 'label `,label1))))
    964964
     
    11401140;; Expects value on stack.
    11411141(defun emit-invoke-method (method-name target representation)
    1142   (emit-invokevirtual-2 +lisp-object-class+
    1143                         method-name
    1144                         nil
    1145                         +lisp-object+)
     1142  (emit-invokevirtual +lisp-object-class+ method-name nil +lisp-object+)
    11461143  (when (eq representation :unboxed-fixnum)
    11471144    (emit-unbox-fixnum))
     
    20362033                                  -1)))
    20372034        (declare-field f +lisp-object+)
    2038         (emit-invokevirtual-2 +lisp-symbol-class+
    2039                               "getSymbolFunctionOrDie"
    2040 ;;                               "()Lorg/armedbear/lisp/LispObject;"
    2041 ;;                               0)
    2042                               nil
    2043                               +lisp-object+)
     2035        (emit-invokevirtual +lisp-symbol-class+
     2036                            "getSymbolFunctionOrDie"
     2037                            nil
     2038                            +lisp-object+)
    20442039        (emit 'putstatic
    20452040              *this-class*
     
    20732068                                    -1)))
    20742069          (declare-field f +lisp-object+)
    2075           (emit-invokevirtual-2 +lisp-symbol-class+
    2076                                 "getSymbolSetfFunctionOrDie"
    2077 ;;                                 "()Lorg/armedbear/lisp/LispObject;"
    2078 ;;                                 0)
    2079                                 nil
    2080                                 +lisp-object+)
     2070          (emit-invokevirtual +lisp-symbol-class+
     2071                              "getSymbolSetfFunctionOrDie"
     2072                              nil
     2073                              +lisp-object+)
    20812074          (emit 'putstatic
    20822075                *this-class*
     
    21722165            g1
    21732166            +lisp-string+)
    2174 ;;       (emit 'dup)
    21752167      (emit-invokestatic +lisp-class+
    21762168                         "recall"
     
    21812173            g2
    21822174            +lisp-object+)
    2183 ;;       (emit-invokestatic +lisp-class+
    2184 ;;                          "forget"
    2185 ;;                          "(Lorg/armedbear/lisp/SimpleString;)V"
    2186 ;;                          -1)
    21872175      (setf *static-code* *code*)
    21882176      g2)))
     
    24412429               (single-valued-p (second args)))
    24422430    (emit-clear-values))
    2443   (emit-invokevirtual-2 +lisp-object-class+
    2444                         op
    2445                         (list +lisp-object+)
    2446                         +lisp-object+)
     2431  (emit-invokevirtual +lisp-object-class+ op (list +lisp-object+) +lisp-object+)
    24472432  (when (eq representation :unboxed-fixnum)
    24482433    (emit-unbox-fixnum))
     
    24892474             (maybe-emit-clear-values first)
    24902475             (emit 'sipush second)
    2491              (emit-invokevirtual-2 +lisp-object-class+
    2492                                    "getSlotValue"
    2493                                    (list "I")
    2494                                    +lisp-object+)
     2476             (emit-invokevirtual +lisp-object-class+
     2477                                 "getSlotValue"
     2478                                 '("I")
     2479                                 +lisp-object+)
    24952480             (when (eq representation :unboxed-fixnum)
    24962481               (emit-unbox-fixnum))
     
    25132498
    25142499(defun p2-eql (form &key (target *val*) representation)
    2515 ;;   (dformat t "p2-eql form = ~S~%" form)
    25162500  (unless (= (length form) 3)
    25172501    (error "Wrong number of arguments for EQL."))
    25182502  (let ((arg1 (second form))
    25192503        (arg2 (third form)))
    2520 ;;     (dformat t "arg1 = ~S~%" arg1)
    2521 ;;     (dformat t "arg2 = ~S~%" arg2)
    25222504    (cond
    25232505     ((and (fixnum-or-unboxed-variable-p arg1)
    25242506           (fixnum-or-unboxed-variable-p arg2))
    2525 ;;       (dformat t "p2-eql case 1~%")
    25262507      (emit-push-int arg1)
    25272508      (emit-push-int arg2)
     
    25402521      (maybe-emit-clear-values arg2)
    25412522      (emit 'swap)
    2542       (emit-invokevirtual-2 +lisp-object-class+
    2543                             "eql"
    2544                             ;;"(I)Z"
    2545                             ;;-1)
    2546                             (list "I")
    2547                             "Z")
     2523      (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
    25482524      (let ((label1 (gensym))
    25492525            (label2 (gensym)))
     
    25592535      (maybe-emit-clear-values arg1)
    25602536      (emit-push-int arg2)
    2561       (emit-invokevirtual-2 +lisp-object-class+
    2562                             "eql"
    2563 ;;                           "(I)Z"
    2564 ;;                           -1)
    2565                             (list "I")
    2566                             "Z")
     2537      (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
    25672538      (let ((label1 (gensym))
    25682539            (label2 (gensym)))
     
    25752546      (emit-move-from-stack target))
    25762547     (t
    2577 ;;       (dformat t "p2-eql case 3~%")
    25782548      (compile-form arg1 :target :stack)
    25792549      (compile-form arg2 :target :stack)
     
    25812551                   (single-valued-p arg2))
    25822552        (emit-clear-values))
    2583       (emit-invokevirtual-2 +lisp-object-class+
    2584                             "EQL"
    2585 ;;                           "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2586 ;;                           -1)
    2587                             (list +lisp-object+)
    2588                             +lisp-object+)
    2589       (emit-move-from-stack target))))
    2590   )
     2553      (emit-invokevirtual +lisp-object-class+ "EQL" (list +lisp-object+) +lisp-object+)
     2554      (emit-move-from-stack target)))))
    25912555
    25922556(defun compile-function-call-3 (op args target)
     
    26112575       (compile-form (third args) :target :stack)
    26122576       (maybe-emit-clear-values (third args))
    2613        (emit-invokevirtual-2 +lisp-object-class+
    2614                              "setSlotValue"
    2615                              ;;"(ILorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2616                              ;;-2)
    2617                              (list "I" +lisp-object+)
    2618                              +lisp-object+)
     2577       (emit-invokevirtual +lisp-object-class+
     2578                           "setSlotValue"
     2579                           (list "I" +lisp-object+)
     2580                           +lisp-object+)
    26192581       (emit-move-from-stack target)
    26202582       t))
     
    27032665                       (list +lisp-object-array+)))
    27042666        (return-type +lisp-object+))
    2705     (emit-invokevirtual-2 +lisp-object-class+ "execute" arg-types return-type)))
     2667    (emit-invokevirtual +lisp-object-class+ "execute" arg-types return-type)))
    27062668
    27072669(defun emit-call-thread-execute (numargs)
     
    27102672                       (list +lisp-object+ +lisp-object-array+)))
    27112673        (return-type +lisp-object+))
    2712     (emit-invokevirtual-2 +lisp-thread-class+ "execute" arg-types return-type)))
     2674    (emit-invokevirtual +lisp-thread-class+ "execute" arg-types return-type)))
    27132675
    27142676(defun compile-function-call (form target representation)
     
    28932855                              (list +lisp-object-array+ +lisp-object-array+)))
    28942856               (result-type +lisp-object+))
    2895           (emit-invokevirtual-2 +lisp-ctf-class+ "execute" arg-types result-type))
     2857          (emit-invokevirtual +lisp-ctf-class+ "execute" arg-types result-type))
    28962858        ;; No closure variables.
    28972859        (let* ((arg-count (length args))
     
    29002862                              (list +lisp-object-array+)))
    29012863               (result-type +lisp-object+))
    2902           (emit-invokevirtual-2 +lisp-object-class+ "execute" arg-types result-type)))
     2864          (emit-invokevirtual +lisp-object-class+ "execute" arg-types result-type)))
    29032865
    29042866    (cond ((null target)
     
    29702932      (when s
    29712933        (process-args args)
    2972         (emit-invokevirtual-2 +lisp-object-class+
    2973                               s
    2974 ;;                               "()Z"
    2975 ;;                               0)
    2976                               nil
    2977                               "Z")
     2934        (emit-invokevirtual +lisp-object-class+ s nil "Z")
    29782935        (return-from compile-test-2 (if negatep 'ifne 'ifeq)))))
    29792936  ;; Otherwise...
     
    30042961             (emit-clear-values))
    30052962           (emit-push-constant-int second)
    3006            (emit-invokevirtual-2 +lisp-object-class+
    3007                                  (case op
    3008                                    (<  "isLessThan")
    3009                                    (<= "isLessThanOrEqualTo")
    3010                                    (>  "isGreaterThan")
    3011                                    (>= "isGreaterThanOrEqualTo")
    3012                                    (=  "isEqualTo")
    3013                                    (/= "isNotEqualTo"))
    3014                                  (list "I")
    3015                                  "Z")
     2963           (emit-invokevirtual +lisp-object-class+
     2964                               (case op
     2965                                 (<  "isLessThan")
     2966                                 (<= "isLessThanOrEqualTo")
     2967                                 (>  "isGreaterThan")
     2968                                 (>= "isGreaterThanOrEqualTo")
     2969                                 (=  "isEqualTo")
     2970                                 (/= "isNotEqualTo"))
     2971                               '("I")
     2972                               "Z")
    30162973           ;; Java boolean on stack here
    30172974           (let ((LABEL1 (gensym))
     
    30903047          (maybe-emit-clear-values arg1)
    30913048          (emit-push-int arg2)
    3092           (emit-invokevirtual-2 +lisp-object-class+
    3093                                 (case op
    3094                                   (<  "isLessThan")
    3095                                   (<= "isLessThanOrEqualTo")
    3096                                   (>  "isGreaterThan")
    3097                                   (>= "isGreaterThanOrEqualTo")
    3098                                   (=  "isEqualTo")
    3099                                   (/= "isNotEqualTo"))
    3100 ;;                               "(I)Z"
    3101 ;;                               -1)
    3102                                 (list "I")
    3103                                 "Z")
     3049          (emit-invokevirtual +lisp-object-class+
     3050                              (case op
     3051                                (<  "isLessThan")
     3052                                (<= "isLessThanOrEqualTo")
     3053                                (>  "isGreaterThan")
     3054                                (>= "isGreaterThanOrEqualTo")
     3055                                (=  "isEqualTo")
     3056                                (/= "isNotEqualTo"))
     3057                              '("I")
     3058                              "Z")
    31043059          (return-from compile-test-3 (if negatep 'ifne 'ifeq))))
    31053060
     
    31113066            (compile-form arg2 :target :stack)
    31123067            (emit 'swap)
    3113             (emit-invokevirtual-2 +lisp-object-class+
    3114                                   "isGreaterThan"
    3115 ;;                                   "(I)Z"
    3116 ;;                                   -1)
    3117                                   (list "I")
    3118                                   "Z")
     3068            (emit-invokevirtual +lisp-object-class+
     3069                                "isGreaterThan"
     3070                                '("I")
     3071                                "Z")
    31193072            (return-from compile-test-3 (if negatep 'ifne 'ifeq)))))
    31203073
     
    31383091            (maybe-emit-clear-values first)
    31393092            (emit-push-constant-int second)
    3140             (emit-invokevirtual-2 +lisp-object-class+ s (list "I") "Z"))
     3093            (emit-invokevirtual +lisp-object-class+ s '("I") "Z"))
    31413094           ((setf variable (unboxed-fixnum-variable second))
    31423095            (compile-form first :target :stack)
     
    31443097            (aver (variable-register variable))
    31453098            (emit 'iload (variable-register variable))
    3146             (emit-invokevirtual-2 +lisp-object-class+ s (list "I") "Z"))
     3099            (emit-invokevirtual +lisp-object-class+ s '("I") "Z"))
    31473100           (t
    31483101            (process-args args)
    3149             (emit-invokevirtual-2 +lisp-object-class+
    3150                                   s
    3151                                   (list +lisp-object+)
    3152                                   "Z")))
     3102            (emit-invokevirtual +lisp-object-class+ s (list +lisp-object+) "Z")))
    31533103          (return-from compile-test-3 (if negatep 'ifne 'ifeq))))))
    31543104
     
    32403190                        "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    32413191                        0)
    3242      (emit-invokevirtual-2 +lisp-object-class+
    3243                            "execute"
    3244                            nil
    3245                            +lisp-object+)
     3192     (emit-invokevirtual +lisp-object-class+ "execute" nil +lisp-object+)
    32463193     (emit-move-from-stack target))
    32473194    (3
     
    32753222         (emit 'swap)
    32763223         (emit 'aload values-register)
    3277          (emit-invokevirtual-2 +lisp-thread-class+
    3278                                "accumulateValues"
    3279 ;;                              "(Lorg/armedbear/lisp/LispObject;[Lorg/armedbear/lisp/LispObject;)[Lorg/armedbear/lisp/LispObject;"
    3280 ;;                              -2)
    3281                                (list +lisp-object+ +lisp-object-array+)
    3282                                +lisp-object-array+)
     3224         (emit-invokevirtual +lisp-thread-class+
     3225                             "accumulateValues"
     3226                             (list +lisp-object+ +lisp-object-array+)
     3227                             +lisp-object-array+)
    32833228         (emit 'astore values-register)
    32843229         (maybe-emit-clear-values values-form))
    32853230       (emit 'aload function-register)
    32863231       (emit 'aload values-register)
    3287        (emit-invokevirtual-2 +lisp-object-class+
    3288                              "execute"
    3289 ;;                              "([Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    3290 ;;                              -1)
    3291                              (list +lisp-object-array+)
    3292                              +lisp-object+)
     3232       (emit-invokevirtual +lisp-object-class+
     3233                           "execute"
     3234                           (list +lisp-object-array+)
     3235                           +lisp-object+)
    32933236       (emit-move-from-stack target)))))
    32943237
     
    33053248               +lisp-symbol+)
    33063249         (emit 'swap)
    3307          (emit-invokevirtual-2 +lisp-thread-class+
    3308                                "bindSpecial"
    3309 ;;                                "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
    3310 ;;                                -3))
    3311                                (list +lisp-symbol+ +lisp-object+)
    3312                                nil))
     3250         (emit-invokevirtual +lisp-thread-class+
     3251                             "bindSpecial"
     3252                             (list +lisp-symbol+ +lisp-object+)
     3253                             nil))
    33133254        ((variable-closure-index variable)
    33143255         (emit 'aload (compiland-closure-register *current-compiland*))
     
    33863327             (emit 'aload result-register)
    33873328             (emit 'bipush (length vars))
    3388              (emit-invokevirtual-2 +lisp-thread-class+
    3389                                    "getValues"
    3390 ;;                                    "(Lorg/armedbear/lisp/LispObject;I)[Lorg/armedbear/lisp/LispObject;"
    3391 ;;                                    -2)
    3392                                    (list +lisp-object+ "I")
    3393                                    +lisp-object-array+)
     3329             (emit-invokevirtual +lisp-thread-class+
     3330                                 "getValues"
     3331                                 (list +lisp-object+ "I")
     3332                                 +lisp-object-array+)
    33943333             ;; Values array is now on the stack at runtime.
    33953334             (label LABEL2)
     
    34063345    ;; Make the variables visible for the body forms.
    34073346    (dolist (variable variables)
    3408       (push variable *visible-variables*)
    3409 ;;       (push variable *all-variables*)
    3410       )
     3347      (push variable *visible-variables*))
    34113348    ;; Body.
    34123349    (compile-progn-body (cdddr form) target)
     
    35253462                (declare-symbol (variable-name variable))
    35263463                +lisp-symbol+)
    3527           (emit-invokevirtual-2 +lisp-thread-class+
    3528                                 "bindSpecialToCurrentValue"
    3529 ;;                                 "(Lorg/armedbear/lisp/Symbol;)V"
    3530 ;;                                 -2)
    3531                                 (list +lisp-symbol+)
    3532                                 nil)
     3464          (emit-invokevirtual +lisp-thread-class+
     3465                              "bindSpecialToCurrentValue"
     3466                              (list +lisp-symbol+)
     3467                              nil)
    35333468          (setf boundp t))
    35343469         (initform
     
    39803915      (emit 'dup))
    39813916    (compile-form (second args) :target :stack)
    3982     (emit-invokevirtual-2 +lisp-object-class+
    3983                           "setCdr"
    3984 ;;                           "(Lorg/armedbear/lisp/LispObject;)V"
    3985 ;;                           -2)
    3986                           (list +lisp-object+)
    3987                           nil)
     3917    (emit-invokevirtual +lisp-object-class+
     3918                        "setCdr"
     3919                        (list +lisp-object+)
     3920                        nil)
    39883921    (when target
    39893922      (emit-move-from-stack target))))
     
    42074140                        (declare-symbol name)
    42084141                        +lisp-symbol+)
    4209                   (emit-invokevirtual-2 +lisp-object-class+
    4210                                         "getSymbolFunctionOrDie"
    4211 ;;                                         "()Lorg/armedbear/lisp/LispObject;"
    4212 ;;                                         0)
    4213                                         nil
    4214                                         +lisp-object+)
     4142                  (emit-invokevirtual +lisp-object-class+
     4143                                      "getSymbolFunctionOrDie"
     4144                                      nil
     4145                                      +lisp-object+)
    42154146                  (emit-move-from-stack target))))
    42164147          ((and (consp name) (eq (car name) 'SETF))
     
    42344165                        (declare-symbol (cadr name))
    42354166                        +lisp-symbol+)
    4236                   (emit-invokevirtual-2 +lisp-symbol-class+
    4237                                         "getSymbolSetfFunctionOrDie"
    4238 ;;                                         "()Lorg/armedbear/lisp/LispObject;"
    4239 ;;                                         0)
    4240                                         nil
    4241                                         +lisp-object+)
     4167                  (emit-invokevirtual +lisp-symbol-class+
     4168                                      "getSymbolSetfFunctionOrDie"
     4169                                      nil
     4170                                      +lisp-object+)
    42424171                  (emit-move-from-stack target))))
    42434172          ((compiland-p name)
     
    42934222      (maybe-emit-clear-values arg1)
    42944223      (emit 'iload (variable-register var2))
    4295       (emit-invokevirtual-2 +lisp-object-class+
    4296                             "ash"
    4297 ;;                             "(I)Lorg/armedbear/lisp/LispObject;"
    4298 ;;                             -1)
    4299                             (list "I")
    4300                             +lisp-object+)
     4224      (emit-invokevirtual +lisp-object-class+ "ash" '("I") +lisp-object+)
    43014225      (when (eq representation :unboxed-fixnum)
    43024226        (emit-unbox-fixnum))
     
    43074231      (maybe-emit-clear-values arg1)
    43084232      (emit-push-constant-int arg2)
    4309       (emit-invokevirtual-2 +lisp-object-class+
    4310                             "ash"
    4311 ;;                             "(I)Lorg/armedbear/lisp/LispObject;"
    4312 ;;                             -1)
    4313                             (list "I")
    4314                             +lisp-object+)
     4233      (emit-invokevirtual +lisp-object-class+ "ash" '("I") +lisp-object+)
    43154234      (when (eq representation :unboxed-fixnum)
    43164235        (emit-unbox-fixnum))
     
    43724291              (maybe-emit-clear-values arg1)
    43734292              (emit-push-constant-int arg2)
    4374               (emit-invokevirtual-2 +lisp-object-class+
    4375                                     "logand"
    4376 ;;                                     "(I)Lorg/armedbear/lisp/LispObject;"
    4377 ;;                                     -1)
    4378                                     (list "I")
    4379                                     +lisp-object+)
     4293              (emit-invokevirtual +lisp-object-class+ "logand" '("I") +lisp-object+)
    43804294              (when (eq representation :unboxed-fixnum)
    43814295                (emit-unbox-fixnum))
     
    44064320         (when (subtypep (second form) 'FIXNUM)
    44074321           (dformat t "derive-type THE case form = ~S returning FIXNUM~%" form)
    4408            (return-from derive-type 'FIXNUM))
    4409          )))))
     4322           (return-from derive-type 'FIXNUM)))))))
    44104323  t)
    44114324
     
    44174330    (cond
    44184331     ((eq representation :unboxed-fixnum)
    4419       (emit-invokevirtual-2 +lisp-object-class+
    4420                             "length"
    4421 ;;                             "()I"
    4422 ;;                             0))
    4423                             nil
    4424                             "I"))
     4332      (emit-invokevirtual +lisp-object-class+ "length" nil "I"))
    44254333     (t
    4426       (emit-invokevirtual-2 +lisp-object-class+
    4427                             "LENGTH"
    4428 ;;                             "()Lorg/armedbear/lisp/LispObject;"
    4429 ;;                             0)))
    4430                             nil
    4431                             +lisp-object+)))
     4334      (emit-invokevirtual +lisp-object-class+ "LENGTH" nil +lisp-object+)))
    44324335    (emit-move-from-stack target representation)))
    44334336
     
    44444347      (emit-clear-values))
    44454348    (emit 'swap)
    4446     (emit-invokevirtual-2 +lisp-object-class+
    4447                           "NTH"
    4448 ;;                           "(I)Lorg/armedbear/lisp/LispObject;"
    4449 ;;                           -1)
    4450                           (list "I")
    4451                           +lisp-object+)
     4349    (emit-invokevirtual +lisp-object-class+ "NTH" '("I") +lisp-object+)
    44524350    (when (eq representation :unboxed-fixnum)
    44534351      (emit-unbox-fixnum))
     
    45344432         (maybe-emit-clear-values arg2)
    45354433         (emit 'swap)
    4536          (emit-invokevirtual-2 +lisp-object-class+
    4537                                "add"
    4538 ;;                                "(I)Lorg/armedbear/lisp/LispObject;"
    4539 ;;                                -1)
    4540                                (list "I")
    4541                                +lisp-object+)
     4434         (emit-invokevirtual +lisp-object-class+ "add" '("I") +lisp-object+)
    45424435         (when (eq representation :unboxed-fixnum)
    45434436           (emit-unbox-fixnum))
     
    45484441         (maybe-emit-clear-values arg1)
    45494442         (emit-push-int arg2)
    4550          (emit-invokevirtual-2 +lisp-object-class+
    4551                                "add"
    4552 ;;                                "(I)Lorg/armedbear/lisp/LispObject;"
    4553 ;;                                -1)
    4554                                (list "I")
    4555                                +lisp-object+)
     4443         (emit-invokevirtual +lisp-object-class+ "add" '("I") +lisp-object+)
    45564444         (when (eq representation :unboxed-fixnum)
    45574445           (emit-unbox-fixnum))
     
    46444532         (maybe-emit-clear-values arg1)
    46454533         (emit-push-int arg2)
    4646          (emit-invokevirtual-2 +lisp-object-class+
    4647                                "subtract"
    4648 ;;                                "(I)Lorg/armedbear/lisp/LispObject;"
    4649 ;;                                -1)
    4650                                (list "I")
    4651                                +lisp-object+)
     4534         (emit-invokevirtual +lisp-object-class+ "subtract" '("I") +lisp-object+)
    46524535         (when (eq representation :unboxed-fixnum)
    46534536           (emit-unbox-fixnum))
     
    46774560               (single-valued-p (third form)))
    46784561    (emit-clear-values))
    4679   (emit-invokevirtual-2 +lisp-object-class+
    4680                         "SCHAR"
    4681 ;;                         "(I)Lorg/armedbear/lisp/LispObject;"
    4682 ;;                         -1)
    4683                         (list "I")
    4684                         +lisp-object+)
     4562  (emit-invokevirtual +lisp-object-class+ "SCHAR" '("I") +lisp-object+)
    46854563  (emit-move-from-stack target))
    46864564
    46874565(defun compile-aref (form &key (target *val*) representation)
    4688 ;;   (dformat t "compile-aref form = ~S~%" form)
    46894566  (unless (= (length form) 3)
    46904567    (return-from compile-aref (compile-function-call form target representation)))
     
    46944571               (single-valued-p (third form)))
    46954572    (emit-clear-values))
    4696   (emit-invokevirtual-2 +lisp-object-class+
    4697                         "AREF"
    4698 ;;                         "(I)Lorg/armedbear/lisp/LispObject;"
    4699 ;;                         -1)
    4700                         (list "I")
    4701                         +lisp-object+)
     4573  (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+)
    47024574  (emit-move-from-stack target))
    47034575
     
    47084580           :format-arguments (list (car form))))
    47094581  (let ((arg (second form)))
    4710 ;;     (dformat t "arg = ~S~%" arg)
    47114582    (cond ((null arg)
    47124583           (emit-push-t))
    47134584          ((and (constantp arg) (not (block-node-p arg)))
    4714 ;;            (dformat t "compile-not/null constantp case~%")
    47154585           (emit-push-nil))
    47164586          ((and (consp arg)
     
    47644634                (compile-form arg1 :target :stack)
    47654635                (compile-form arg2 :target :stack))))
    4766        (emit-invokevirtual-2 +lisp-thread-class+
    4767                              "setValues"
    4768 ;;                              "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    4769 ;;                              -2)
    4770                              (list +lisp-object+ +lisp-object+)
    4771                              +lisp-object+)
     4636       (emit-invokevirtual +lisp-thread-class+
     4637                           "setValues"
     4638                           (list +lisp-object+ +lisp-object+)
     4639                           +lisp-object+)
    47724640       (emit-move-from-stack target))
    47734641      (3
     
    47754643       (dolist (arg args)
    47764644         (compile-form arg :target :stack))
    4777        (emit-invokevirtual-2 +lisp-thread-class+
    4778                              "setValues"
    4779 ;;                            "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    4780 ;;                            -3)
    4781                              (list +lisp-object+ +lisp-object+ +lisp-object+)
    4782                              +lisp-object+)
     4645       (emit-invokevirtual +lisp-thread-class+
     4646                           "setValues"
     4647                           (list +lisp-object+ +lisp-object+ +lisp-object+)
     4648                           +lisp-object+)
    47834649       (emit-move-from-stack target))
    47844650      (t
     
    47914657        +lisp-symbol+)
    47924658  (emit-push-current-thread)
    4793   (emit-invokevirtual-2 +lisp-symbol-class+
    4794                         "symbolValue"
    4795 ;;                         "(Lorg/armedbear/lisp/LispThread;)Lorg/armedbear/lisp/LispObject;"
    4796 ;;                         -1)
    4797                         (list +lisp-thread+)
    4798                         +lisp-object+)
     4659  (emit-invokevirtual +lisp-symbol-class+
     4660                      "symbolValue"
     4661                      (list +lisp-thread+)
     4662                      +lisp-object+)
    47994663  (when (eq representation :unboxed-fixnum)
    48004664    (emit-unbox-fixnum))
     
    48764740           (compile-form value-form :target :stack)
    48774741           (maybe-emit-clear-values value-form)
    4878            (emit-invokevirtual-2 +lisp-thread-class+
    4879                                  "setSpecialVariable"
    4880 ;;                                  "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    4881 ;;                                  -2)
    4882                                  (list +lisp-symbol+ +lisp-object+)
    4883                                  +lisp-object+)
     4742           (emit-invokevirtual +lisp-thread-class+
     4743                               "setSpecialVariable"
     4744                               (list +lisp-symbol+ +lisp-object+)
     4745                               +lisp-object+)
    48844746           (emit-move-from-stack target))
    48854747          ((and (eq (variable-representation variable) :unboxed-fixnum)
     
    49394801    (emit-push-current-thread)
    49404802    (emit 'aload tag-register)
    4941     (emit-invokevirtual-2 +lisp-thread-class+
    4942                           "pushCatchTag"
    4943 ;;                           "(Lorg/armedbear/lisp/LispObject;)V"
    4944 ;;                           -2)
    4945                           (list +lisp-object+)
    4946                           nil)
     4803    (emit-invokevirtual +lisp-thread-class+
     4804                        "pushCatchTag"
     4805                        (list +lisp-object+)
     4806                        nil)
    49474807    ; Stack depth is 0.
    49484808    (emit 'label label1) ; Start of protected range.
     
    49604820    (emit 'if_acmpne label4) ; Stack depth is 1.
    49614821    (emit 'aload *thread*)
    4962     (emit-invokevirtual-2 +lisp-throw-class+
    4963                           "getResult"
    4964 ;;                         "(Lorg/armedbear/lisp/LispThread;)Lorg/armedbear/lisp/LispObject;"
    4965 ;;                         -1)
    4966                           (list +lisp-thread+)
    4967                           +lisp-object+)
     4822    (emit-invokevirtual +lisp-throw-class+
     4823                        "getResult"
     4824                        (list +lisp-thread+)
     4825                        +lisp-object+)
    49684826    (emit-move-from-stack target) ; Stack depth is 0.
    49694827    (emit 'goto label5)
     
    49714829    ;; A Throwable object is on the runtime stack here. Stack depth is 1.
    49724830    (emit 'aload *thread*)
    4973     (emit-invokevirtual-2 +lisp-thread-class+
    4974                           "popCatchTag"
    4975 ;;                           "()V"
    4976 ;;                           -1)
    4977                           nil
    4978                           nil)
     4831    (emit-invokevirtual +lisp-thread-class+ "popCatchTag" nil nil)
    49794832    (emit 'athrow) ; And we're gone.
    49804833    (emit 'label label5)
    49814834    ;; Finally...
    49824835    (emit 'aload *thread*)
    4983     (emit-invokevirtual-2 +lisp-thread-class+
    4984                           "popCatchTag"
    4985 ;;                           "()V"
    4986 ;;                           -1)
    4987                           nil
    4988                           nil)
     4836    (emit-invokevirtual +lisp-thread-class+ "popCatchTag" nil nil)
    49894837    (let ((handler1 (make-handler :from label1
    49904838                                  :to label2
     
    50274875
    50284876(defun compile-throw (form &key (target *val*) representation)
    5029 ;;   (let ((new-form (rewrite-throw form)))
    5030 ;;     (when (neq new-form form)
    5031 ;;       (return-from compile-throw (compile-form new-form :target target))))
    50324877  (emit-push-current-thread)
    50334878  (compile-form (second form) :target :stack) ; Tag.
    50344879  (emit-clear-values) ; Do this unconditionally! (MISC.503)
    50354880  (compile-form (third form) :target :stack) ; Result.
    5036   (emit-invokevirtual-2 +lisp-thread-class+
    5037                         "throwToTag"
    5038 ;;                         "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)V"
    5039 ;;                         -3)
    5040                         (list +lisp-object+ +lisp-object+)
    5041                         nil)
     4881  (emit-invokevirtual +lisp-thread-class+
     4882                      "throwToTag"
     4883                      (list +lisp-object+ +lisp-object+)
     4884                      nil)
    50424885  ;; Following code will not be reached.
    50434886  (when target
     
    55285371                     +lisp-symbol+)
    55295372               (emit 'aload (variable-register variable))
    5530                (emit-invokevirtual-2 +lisp-thread-class+
    5531                                      "bindSpecial"
    5532 ;;                                      "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
    5533 ;;                                      -3)
    5534                                      (list +lisp-symbol+ +lisp-object+)
    5535                                      nil)
     5373               (emit-invokevirtual +lisp-thread-class+
     5374                                   "bindSpecial"
     5375                                   (list +lisp-symbol+ +lisp-object+)
     5376                                   nil)
    55365377               (setf (variable-register variable) nil))
    55375378              ((variable-index variable)
     
    55445385               (emit 'bipush (variable-index variable))
    55455386               (emit 'aaload)
    5546                (emit-invokevirtual-2 +lisp-thread-class+
    5547                                      "bindSpecial"
    5548 ;;                                      "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
    5549 ;;                                      -3)
    5550                                      (list +lisp-symbol+ +lisp-object+)
    5551                                      nil)
     5387               (emit-invokevirtual +lisp-thread-class+
     5388                                   "bindSpecial"
     5389                                   (list +lisp-symbol+ +lisp-object+)
     5390                                   nil)
    55525391               (setf (variable-index variable) nil)))))
    55535392
     
    55735412        (cond ((or (memq '&OPTIONAL args) (memq '&KEY args))
    55745413               (emit 'iconst_0)
    5575                (emit-invokevirtual-2 *this-class*
    5576                                      "processArgs"
    5577                                      (list +lisp-object-array+ "I")
    5578                                      +lisp-object-array+))
     5414               (emit-invokevirtual *this-class*
     5415                                   "processArgs"
     5416                                   (list +lisp-object-array+ "I")
     5417                                   +lisp-object-array+))
    55795418              (t
    5580                (emit-invokevirtual-2 *this-class*
    5581                                      "fastProcessArgs"
    5582                                      (list +lisp-object-array+)
    5583                                      +lisp-object-array+)))
     5419               (emit-invokevirtual *this-class*
     5420                                   "fastProcessArgs"
     5421                                   (list +lisp-object-array+)
     5422                                   +lisp-object-array+)))
    55845423        (emit 'astore (compiland-argument-register compiland)))
    55855424
    55865425      (cond
    55875426       ((and (not *child-p*) (not *using-arg-array*))
    5588         (dformat t "prologue case 2~%")
    55895427        (dolist (variable (reverse *visible-variables*))
    55905428          (when (eq (variable-representation variable) :unboxed-fixnum)
Note: See TracChangeset for help on using the changeset viewer.