Changeset 8377


Ignore:
Timestamp:
01/20/05 20:10:23 (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

    r8376 r8377  
    22;;;
    33;;; Copyright (C) 2003-2005 Peter Graves
    4 ;;; $Id: jvm.lisp,v 1.359 2005-01-20 17:09:07 piso Exp $
     4;;; $Id: jvm.lisp,v 1.360 2005-01-20 20:10:23 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    6565           (precompile-form (list* 'LAMBDA ',lambda-list ',body) t))
    6666     ',name))
     67
    6768#+nil
    6869(defmacro defsubst (&rest args)
     
    915916    (setf (instruction-stack instruction) stack)))
    916917
    917 (defun emit-invokevirtual (class-name method-name descriptor stack)
    918   (let ((instruction (emit 'invokevirtual
    919                            class-name method-name (descriptor descriptor))))
     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  (let* ((descriptor (make-descriptor arg-types return-type))
     925         (stack (- (if return-type 1 0) 1 (length arg-types)))
     926         (instruction (emit 'invokevirtual class-name method-name descriptor)))
    920927    (setf (instruction-stack instruction) stack)))
    921928
     
    953960      (emit 'if_icmpeq `,label1)
    954961      (emit 'aload 0) ; this
    955       (emit-invokevirtual *this-class*
    956                           "argCountError"
    957                           "()V"
    958                           -1)
     962      (emit-invokevirtual-2 *this-class* "argCountError" nil nil)
    959963      (emit 'label `,label1))))
    960964
     
    11361140;; Expects value on stack.
    11371141(defun emit-invoke-method (method-name target representation)
    1138   (emit-invokevirtual +lisp-object-class+
    1139                       method-name
    1140                       "()Lorg/armedbear/lisp/LispObject;"
    1141                       0)
     1142  (emit-invokevirtual-2 +lisp-object-class+
     1143                        method-name
     1144                        nil
     1145                        +lisp-object+)
    11421146  (when (eq representation :unboxed-fixnum)
    11431147    (emit-unbox-fixnum))
     
    18541858                          "<init>"
    18551859                          ;;                                "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/Environment;)V"
    1856                           `((,+lisp-symbol+ ,+lisp-object+ ,+lisp-object+ ,+lisp-environment+) nil)
     1860;;                           `((,+lisp-symbol+ ,+lisp-object+ ,+lisp-object+ ,+lisp-environment+) nil)
     1861                          (make-descriptor (list +lisp-symbol+ +lisp-object+ +lisp-object+ +lisp-environment+)
     1862                                           nil)
    18571863                          -5))
    18581864     (*child-p*
     
    20302036                                  -1)))
    20312037        (declare-field f +lisp-object+)
    2032         (emit-invokevirtual +lisp-symbol-class+
    2033                             "getSymbolFunctionOrDie"
    2034                             "()Lorg/armedbear/lisp/LispObject;"
    2035                             0)
     2038        (emit-invokevirtual-2 +lisp-symbol-class+
     2039                              "getSymbolFunctionOrDie"
     2040;;                               "()Lorg/armedbear/lisp/LispObject;"
     2041;;                               0)
     2042                              nil
     2043                              +lisp-object+)
    20362044        (emit 'putstatic
    20372045              *this-class*
     
    20652073                                    -1)))
    20662074          (declare-field f +lisp-object+)
    2067           (emit-invokevirtual +lisp-symbol-class+
    2068                               "getSymbolSetfFunctionOrDie"
    2069                               "()Lorg/armedbear/lisp/LispObject;"
    2070                               0)
     2075          (emit-invokevirtual-2 +lisp-symbol-class+
     2076                                "getSymbolSetfFunctionOrDie"
     2077;;                                 "()Lorg/armedbear/lisp/LispObject;"
     2078;;                                 0)
     2079                                nil
     2080                                +lisp-object+)
    20712081          (emit 'putstatic
    20722082                *this-class*
     
    24262436
    24272437(defun compile-binary-operation (op args target representation)
    2428 ;;   (dformat t "compile-binary-operation op = ~S representation = ~S~%"
    2429 ;;            op representation)
    24302438  (compile-form (first args) :target :stack)
    24312439  (compile-form (second args) :target :stack)
     
    24332441               (single-valued-p (second args)))
    24342442    (emit-clear-values))
    2435   (emit-invokevirtual +lisp-object-class+
    2436                       op
    2437                       "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2438                       -1)
     2443  (emit-invokevirtual-2 +lisp-object-class+
     2444                        op
     2445                        (list +lisp-object+)
     2446                        +lisp-object+)
    24392447  (when (eq representation :unboxed-fixnum)
    24402448    (emit-unbox-fixnum))
     
    24812489             (maybe-emit-clear-values first)
    24822490             (emit 'sipush second)
    2483              (emit-invokevirtual +lisp-object-class+
    2484                                  "getSlotValue"
    2485                                  "(I)Lorg/armedbear/lisp/LispObject;"
    2486                                  -1)
     2491             (emit-invokevirtual-2 +lisp-object-class+
     2492                                   "getSlotValue"
     2493                                   (list "I")
     2494                                   +lisp-object+)
    24872495             (when (eq representation :unboxed-fixnum)
    24882496               (emit-unbox-fixnum))
     
    25322540      (maybe-emit-clear-values arg2)
    25332541      (emit 'swap)
    2534       (emit-invokevirtual +lisp-object-class+
    2535                           "eql"
    2536                           "(I)Z"
    2537                           -1)
     2542      (emit-invokevirtual-2 +lisp-object-class+
     2543                            "eql"
     2544                            ;;"(I)Z"
     2545                            ;;-1)
     2546                            (list "I")
     2547                            "Z")
    25382548      (let ((label1 (gensym))
    25392549            (label2 (gensym)))
     
    25492559      (maybe-emit-clear-values arg1)
    25502560      (emit-push-int arg2)
    2551       (emit-invokevirtual +lisp-object-class+
    2552                           "eql"
    2553                           "(I)Z"
    2554                           -1)
     2561      (emit-invokevirtual-2 +lisp-object-class+
     2562                            "eql"
     2563;;                           "(I)Z"
     2564;;                           -1)
     2565                            (list "I")
     2566                            "Z")
    25552567      (let ((label1 (gensym))
    25562568            (label2 (gensym)))
     
    25692581                   (single-valued-p arg2))
    25702582        (emit-clear-values))
    2571       (emit-invokevirtual +lisp-object-class+
    2572                           "EQL"
    2573                           "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2574                           -1)
     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+)
    25752589      (emit-move-from-stack target))))
    25762590  )
     
    25972611       (compile-form (third args) :target :stack)
    25982612       (maybe-emit-clear-values (third args))
    2599        (emit-invokevirtual +lisp-object-class+
    2600                            "setSlotValue"
    2601                            "(ILorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2602                            -2)
     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+)
    26032619       (emit-move-from-stack target)
    26042620       t))
     
    26832699
    26842700(defun emit-call-execute (numargs)
    2685   (let ((descriptor
    2686          (case numargs
    2687            (0 "()Lorg/armedbear/lisp/LispObject;")
    2688            (1 "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2689            (2 "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2690            (3 "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2691            (4 "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2692            (t "([Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")))
    2693         (stack-effect (if (< numargs 5)
    2694                           (- numargs)
    2695                           -1)))
    2696     (emit-invokevirtual +lisp-object-class+ "execute" descriptor stack-effect)))
     2701  (let ((arg-types (if (<= numargs 4)
     2702                       (make-list numargs :initial-element +lisp-object+)
     2703                       (list +lisp-object-array+)))
     2704        (return-type +lisp-object+))
     2705    (emit-invokevirtual-2 +lisp-object-class+ "execute" arg-types return-type)))
    26972706
    26982707(defun emit-call-thread-execute (numargs)
    2699   (let ((descriptor
    2700          (case numargs
    2701            (0 "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2702            (1 "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2703            (2 "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2704            (3 "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2705            (4 "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
    2706            (t "(Lorg/armedbear/lisp/LispObject;[Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")))
    2707         (stack-effect (if (< numargs 5)
    2708                           (- (1+ numargs))
    2709                           -2)))
    2710     (emit-invokevirtual +lisp-thread-class+ "execute" descriptor stack-effect)))
     2708  (let ((arg-types (if (<= numargs 4)
     2709                       (make-list (1+ numargs) :initial-element +lisp-object+)
     2710                       (list +lisp-object+ +lisp-object-array+)))
     2711        (return-type +lisp-object+))
     2712    (emit-invokevirtual-2 +lisp-thread-class+ "execute" arg-types return-type)))
    27112713
    27122714(defun compile-function-call (form target representation)
     
    28852887
    28862888    (if *closure-variables*
    2887           (case (length args)
    2888             (0
    2889              (emit-invokevirtual +lisp-ctf-class+
    2890                                  "execute"
    2891                                  "([Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2892                                  -1))
    2893             (1
    2894              (emit-invokevirtual +lisp-ctf-class+
    2895                                  "execute"
    2896                                  "([Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2897                                  -2))
    2898             (2
    2899              (emit-invokevirtual +lisp-ctf-class+
    2900                                  "execute"
    2901                                  "([Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2902                                  -3))
    2903             (3
    2904              (emit-invokevirtual +lisp-ctf-class+
    2905                                  "execute"
    2906                                  "([Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2907                                  -4))
    2908             (4
    2909              (emit-invokevirtual +lisp-ctf-class+
    2910                                  "execute"
    2911                                  "([Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2912                                  -5))
    2913             (t
    2914              (emit-invokevirtual +lisp-ctf-class+
    2915                                  "execute"
    2916                                  "([Lorg/armedbear/lisp/LispObject;[Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2917                                  -2)))
    2918           ;; No closure variables.
    2919           (case (length args)
    2920             (0
    2921              (emit-invokevirtual +lisp-object-class+
    2922                                  "execute"
    2923                                  "()Lorg/armedbear/lisp/LispObject;"
    2924                                  0))
    2925             (1
    2926              (emit-invokevirtual +lisp-object-class+
    2927                                  "execute"
    2928                                  "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2929                                  -1))
    2930             (2
    2931              (emit-invokevirtual +lisp-object-class+
    2932                                  "execute"
    2933                                  "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2934                                  -2))
    2935             (3
    2936              (emit-invokevirtual +lisp-object-class+
    2937                                  "execute"
    2938                                  "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2939                                  -3))
    2940             (4
    2941              (emit-invokevirtual +lisp-object-class+
    2942                                  "execute"
    2943                                  "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2944                                  -4))
    2945             (t
    2946              (emit-invokevirtual +lisp-object-class+
    2947                                  "execute"
    2948                                  "([Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    2949                                  -1))))
     2889        (let* ((arg-count (length args))
     2890               (arg-types (if (<= arg-count 4)
     2891                              (list* +lisp-object-array+
     2892                                     (make-list arg-count :initial-element +lisp-object+))
     2893                              (list +lisp-object-array+ +lisp-object-array+)))
     2894               (result-type +lisp-object+))
     2895          (emit-invokevirtual-2 +lisp-ctf-class+ "execute" arg-types result-type))
     2896        ;; No closure variables.
     2897        (let* ((arg-count (length args))
     2898               (arg-types (if (<= arg-count 4)
     2899                              (make-list arg-count :initial-element +lisp-object+)
     2900                              (list +lisp-object-array+)))
     2901               (result-type +lisp-object+))
     2902          (emit-invokevirtual-2 +lisp-object-class+ "execute" arg-types result-type)))
     2903
    29502904    (cond ((null target)
    29512905           (emit 'pop)
     
    29962950         (aver (variable-register variable))
    29972951         (emit 'iload (variable-register variable))
    2998          (return-from compile-test-2 (if negatep 'iflt 'ifge))
    2999          )
    3000         ))
     2952         (return-from compile-test-2 (if negatep 'iflt 'ifge)))))
    30012953    (when (eq op 'SYMBOLP)
    30022954      (process-args args)
     
    30182970      (when s
    30192971        (process-args args)
    3020         (emit-invokevirtual +lisp-object-class+
    3021                             s
    3022                             "()Z"
    3023                             0)
     2972        (emit-invokevirtual-2 +lisp-object-class+
     2973                              s
     2974;;                               "()Z"
     2975;;                               0)
     2976                              nil
     2977                              "Z")
    30242978        (return-from compile-test-2 (if negatep 'ifne 'ifeq)))))
    30252979  ;; Otherwise...
     
    30503004             (emit-clear-values))
    30513005           (emit-push-constant-int second)
    3052            (emit-invokevirtual +lisp-object-class+
    3053                                (case op
    3054                                  (<  "isLessThan")
    3055                                  (<= "isLessThanOrEqualTo")
    3056                                  (>  "isGreaterThan")
    3057                                  (>= "isGreaterThanOrEqualTo")
    3058                                  (=  "isEqualTo")
    3059                                  (/= "isNotEqualTo"))
    3060                                "(I)Z"
    3061                                -1)
     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")
    30623016           ;; Java boolean on stack here
    30633017           (let ((LABEL1 (gensym))
     
    31363090          (maybe-emit-clear-values arg1)
    31373091          (emit-push-int arg2)
    3138           (emit-invokevirtual +lisp-object-class+
    3139                               (case op
    3140                                 (<  "isLessThan")
    3141                                 (<= "isLessThanOrEqualTo")
    3142                                 (>  "isGreaterThan")
    3143                                 (>= "isGreaterThanOrEqualTo")
    3144                                 (=  "isEqualTo")
    3145                                 (/= "isNotEqualTo"))
    3146                               "(I)Z"
    3147                               -1)
     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")
    31483104          (return-from compile-test-3 (if negatep 'ifne 'ifeq))))
    31493105
     
    31553111            (compile-form arg2 :target :stack)
    31563112            (emit 'swap)
    3157             (emit-invokevirtual +lisp-object-class+
    3158                                 "isGreaterThan"
    3159                                 "(I)Z"
    3160                                 -1)
     3113            (emit-invokevirtual-2 +lisp-object-class+
     3114                                  "isGreaterThan"
     3115;;                                   "(I)Z"
     3116;;                                   -1)
     3117                                  (list "I")
     3118                                  "Z")
    31613119            (return-from compile-test-3 (if negatep 'ifne 'ifeq)))))
    31623120
     
    31803138            (maybe-emit-clear-values first)
    31813139            (emit-push-constant-int second)
    3182             (emit-invokevirtual +lisp-object-class+ s "(I)Z" -1))
     3140            (emit-invokevirtual-2 +lisp-object-class+ s (list "I") "Z"))
    31833141           ((setf variable (unboxed-fixnum-variable second))
    31843142            (compile-form first :target :stack)
     
    31863144            (aver (variable-register variable))
    31873145            (emit 'iload (variable-register variable))
    3188             (emit-invokevirtual +lisp-object-class+ s "(I)Z" -1))
     3146            (emit-invokevirtual-2 +lisp-object-class+ s (list "I") "Z"))
    31893147           (t
    31903148            (process-args args)
    3191             (emit-invokevirtual +lisp-object-class+
    3192                                 s
    3193                                 "(Lorg/armedbear/lisp/LispObject;)Z"
    3194                                 -1)))
     3149            (emit-invokevirtual-2 +lisp-object-class+
     3150                                  s
     3151                                  (list +lisp-object+)
     3152                                  "Z")))
    31953153          (return-from compile-test-3 (if negatep 'ifne 'ifeq))))))
    31963154
     
    32173175
    32183176(defun compile-if (form &key (target *val*) representation)
    3219 ;;   (dformat t "compile-if form = ~S~%" form)
    32203177  (let* ((test (second form))
    32213178         (consequent (third form))
     
    32833240                        "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    32843241                        0)
    3285      (emit-invokevirtual +lisp-object-class+
    3286                          "execute"
    3287                          "()Lorg/armedbear/lisp/LispObject;"
    3288                          0)
     3242     (emit-invokevirtual-2 +lisp-object-class+
     3243                           "execute"
     3244                           nil
     3245                           +lisp-object+)
    32893246     (emit-move-from-stack target))
    32903247    (3
     
    33183275         (emit 'swap)
    33193276         (emit 'aload values-register)
    3320          (emit-invokevirtual +lisp-thread-class+
    3321                              "accumulateValues"
    3322                              "(Lorg/armedbear/lisp/LispObject;[Lorg/armedbear/lisp/LispObject;)[Lorg/armedbear/lisp/LispObject;"
    3323                              -2)
     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+)
    33243283         (emit 'astore values-register)
    33253284         (maybe-emit-clear-values values-form))
    33263285       (emit 'aload function-register)
    33273286       (emit 'aload values-register)
    3328        (emit-invokevirtual +lisp-object-class+
    3329                            "execute"
    3330                            "([Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    3331                            -1)
     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+)
    33323293       (emit-move-from-stack target)))))
    33333294
     
    33443305               +lisp-symbol+)
    33453306         (emit 'swap)
    3346          (emit-invokevirtual +lisp-thread-class+
    3347                              "bindSpecial"
    3348                              "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
    3349                              -3))
     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))
    33503313        ((variable-closure-index variable)
    33513314         (emit 'aload (compiland-closure-register *current-compiland*))
     
    34233386             (emit 'aload result-register)
    34243387             (emit 'bipush (length vars))
    3425              (emit-invokevirtual +lisp-thread-class+
    3426                                  "getValues"
    3427                                  "(Lorg/armedbear/lisp/LispObject;I)[Lorg/armedbear/lisp/LispObject;"
    3428                                  -2)
     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+)
    34293394             ;; Values array is now on the stack at runtime.
    34303395             (label LABEL2)
     
    35603525                (declare-symbol (variable-name variable))
    35613526                +lisp-symbol+)
    3562           (emit-invokevirtual +lisp-thread-class+
    3563                               "bindSpecialToCurrentValue"
    3564                               "(Lorg/armedbear/lisp/Symbol;)V"
    3565                               -2)
     3527          (emit-invokevirtual-2 +lisp-thread-class+
     3528                                "bindSpecialToCurrentValue"
     3529;;                                 "(Lorg/armedbear/lisp/Symbol;)V"
     3530;;                                 -2)
     3531                                (list +lisp-symbol+)
     3532                                nil)
    35663533          (setf boundp t))
    35673534         (initform
     
    40133980      (emit 'dup))
    40143981    (compile-form (second args) :target :stack)
    4015     (emit-invokevirtual +lisp-object-class+
    4016                         "setCdr"
    4017                         "(Lorg/armedbear/lisp/LispObject;)V"
    4018                         -2)
     3982    (emit-invokevirtual-2 +lisp-object-class+
     3983                          "setCdr"
     3984;;                           "(Lorg/armedbear/lisp/LispObject;)V"
     3985;;                           -2)
     3986                          (list +lisp-object+)
     3987                          nil)
    40193988    (when target
    40203989      (emit-move-from-stack target))))
     
    41824151      (emit-invokestatic +lisp-class+
    41834152                         "makeCompiledClosure"
    4184                          "(Lorg/armedbear/lisp/LispObject;[Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     4153;;                          "(Lorg/armedbear/lisp/LispObject;[Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
     4154                         (make-descriptor (list +lisp-object+ +lisp-object-array+)
     4155                                          +lisp-object+)
    41854156                         -1)
    41864157      (emit 'checkcast "org/armedbear/lisp/CompiledClosure")
     
    42364207                        (declare-symbol name)
    42374208                        +lisp-symbol+)
    4238                   (emit-invokevirtual +lisp-object-class+
    4239                                       "getSymbolFunctionOrDie"
    4240                                       "()Lorg/armedbear/lisp/LispObject;"
    4241                                       0)
     4209                  (emit-invokevirtual-2 +lisp-object-class+
     4210                                        "getSymbolFunctionOrDie"
     4211;;                                         "()Lorg/armedbear/lisp/LispObject;"
     4212;;                                         0)
     4213                                        nil
     4214                                        +lisp-object+)
    42424215                  (emit-move-from-stack target))))
    42434216          ((and (consp name) (eq (car name) 'SETF))
     
    42614234                        (declare-symbol (cadr name))
    42624235                        +lisp-symbol+)
    4263                   (emit-invokevirtual +lisp-symbol-class+
    4264                                       "getSymbolSetfFunctionOrDie"
    4265                                       "()Lorg/armedbear/lisp/LispObject;"
    4266                                       0)
     4236                  (emit-invokevirtual-2 +lisp-symbol-class+
     4237                                        "getSymbolSetfFunctionOrDie"
     4238;;                                         "()Lorg/armedbear/lisp/LispObject;"
     4239;;                                         0)
     4240                                        nil
     4241                                        +lisp-object+)
    42674242                  (emit-move-from-stack target))))
    42684243          ((compiland-p name)
     
    43184293      (maybe-emit-clear-values arg1)
    43194294      (emit 'iload (variable-register var2))
    4320       (emit-invokevirtual +lisp-object-class+
    4321                           "ash"
    4322                           "(I)Lorg/armedbear/lisp/LispObject;"
    4323                           -1)
     4295      (emit-invokevirtual-2 +lisp-object-class+
     4296                            "ash"
     4297;;                             "(I)Lorg/armedbear/lisp/LispObject;"
     4298;;                             -1)
     4299                            (list "I")
     4300                            +lisp-object+)
    43244301      (when (eq representation :unboxed-fixnum)
    43254302        (emit-unbox-fixnum))
     
    43304307      (maybe-emit-clear-values arg1)
    43314308      (emit-push-constant-int arg2)
    4332       (emit-invokevirtual +lisp-object-class+
    4333                           "ash"
    4334                           "(I)Lorg/armedbear/lisp/LispObject;"
    4335                           -1)
     4309      (emit-invokevirtual-2 +lisp-object-class+
     4310                            "ash"
     4311;;                             "(I)Lorg/armedbear/lisp/LispObject;"
     4312;;                             -1)
     4313                            (list "I")
     4314                            +lisp-object+)
    43364315      (when (eq representation :unboxed-fixnum)
    43374316        (emit-unbox-fixnum))
     
    43934372              (maybe-emit-clear-values arg1)
    43944373              (emit-push-constant-int arg2)
    4395               (emit-invokevirtual +lisp-object-class+
    4396                                   "logand"
    4397                                   "(I)Lorg/armedbear/lisp/LispObject;"
    4398                                   -1)
     4374              (emit-invokevirtual-2 +lisp-object-class+
     4375                                    "logand"
     4376;;                                     "(I)Lorg/armedbear/lisp/LispObject;"
     4377;;                                     -1)
     4378                                    (list "I")
     4379                                    +lisp-object+)
    43994380              (when (eq representation :unboxed-fixnum)
    44004381                (emit-unbox-fixnum))
     
    44364417    (cond
    44374418     ((eq representation :unboxed-fixnum)
    4438       (emit-invokevirtual +lisp-object-class+
    4439                           "length"
    4440                           "()I"
    4441                           0))
     4419      (emit-invokevirtual-2 +lisp-object-class+
     4420                            "length"
     4421;;                             "()I"
     4422;;                             0))
     4423                            nil
     4424                            "I"))
    44424425     (t
    4443       (emit-invokevirtual +lisp-object-class+
    4444                           "LENGTH"
    4445                           "()Lorg/armedbear/lisp/LispObject;"
    4446                           0)))
     4426      (emit-invokevirtual-2 +lisp-object-class+
     4427                            "LENGTH"
     4428;;                             "()Lorg/armedbear/lisp/LispObject;"
     4429;;                             0)))
     4430                            nil
     4431                            +lisp-object+)))
    44474432    (emit-move-from-stack target representation)))
    44484433
     
    44594444      (emit-clear-values))
    44604445    (emit 'swap)
    4461     (emit-invokevirtual +lisp-object-class+
    4462                         "NTH"
    4463                         "(I)Lorg/armedbear/lisp/LispObject;"
    4464                         -1)
     4446    (emit-invokevirtual-2 +lisp-object-class+
     4447                          "NTH"
     4448;;                           "(I)Lorg/armedbear/lisp/LispObject;"
     4449;;                           -1)
     4450                          (list "I")
     4451                          +lisp-object+)
    44654452    (when (eq representation :unboxed-fixnum)
    44664453      (emit-unbox-fixnum))
     
    45474534         (maybe-emit-clear-values arg2)
    45484535         (emit 'swap)
    4549          (emit-invokevirtual +lisp-object-class+
    4550                              "add"
    4551                              "(I)Lorg/armedbear/lisp/LispObject;"
    4552                              -1)
     4536         (emit-invokevirtual-2 +lisp-object-class+
     4537                               "add"
     4538;;                                "(I)Lorg/armedbear/lisp/LispObject;"
     4539;;                                -1)
     4540                               (list "I")
     4541                               +lisp-object+)
    45534542         (when (eq representation :unboxed-fixnum)
    45544543           (emit-unbox-fixnum))
     
    45594548         (maybe-emit-clear-values arg1)
    45604549         (emit-push-int arg2)
    4561          (emit-invokevirtual +lisp-object-class+
    4562                              "add"
    4563                              "(I)Lorg/armedbear/lisp/LispObject;"
    4564                              -1)
     4550         (emit-invokevirtual-2 +lisp-object-class+
     4551                               "add"
     4552;;                                "(I)Lorg/armedbear/lisp/LispObject;"
     4553;;                                -1)
     4554                               (list "I")
     4555                               +lisp-object+)
    45654556         (when (eq representation :unboxed-fixnum)
    45664557           (emit-unbox-fixnum))
     
    46534644         (maybe-emit-clear-values arg1)
    46544645         (emit-push-int arg2)
    4655          (emit-invokevirtual +lisp-object-class+
    4656                              "subtract"
    4657                              "(I)Lorg/armedbear/lisp/LispObject;"
    4658                              -1)
     4646         (emit-invokevirtual-2 +lisp-object-class+
     4647                               "subtract"
     4648;;                                "(I)Lorg/armedbear/lisp/LispObject;"
     4649;;                                -1)
     4650                               (list "I")
     4651                               +lisp-object+)
    46594652         (when (eq representation :unboxed-fixnum)
    46604653           (emit-unbox-fixnum))
     
    46844677               (single-valued-p (third form)))
    46854678    (emit-clear-values))
    4686   (emit-invokevirtual +lisp-object-class+
    4687                       "SCHAR"
    4688                       "(I)Lorg/armedbear/lisp/LispObject;"
    4689                       -1)
     4679  (emit-invokevirtual-2 +lisp-object-class+
     4680                        "SCHAR"
     4681;;                         "(I)Lorg/armedbear/lisp/LispObject;"
     4682;;                         -1)
     4683                        (list "I")
     4684                        +lisp-object+)
    46904685  (emit-move-from-stack target))
    46914686
     
    46994694               (single-valued-p (third form)))
    47004695    (emit-clear-values))
    4701   (emit-invokevirtual +lisp-object-class+
    4702                       "AREF"
    4703                       "(I)Lorg/armedbear/lisp/LispObject;"
    4704                       -1)
     4696  (emit-invokevirtual-2 +lisp-object-class+
     4697                        "AREF"
     4698;;                         "(I)Lorg/armedbear/lisp/LispObject;"
     4699;;                         -1)
     4700                        (list "I")
     4701                        +lisp-object+)
    47054702  (emit-move-from-stack target))
    47064703
     
    47674764                (compile-form arg1 :target :stack)
    47684765                (compile-form arg2 :target :stack))))
    4769        (emit-invokevirtual +lisp-thread-class+
    4770                            "setValues"
    4771                            "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    4772                            -2)
     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+)
    47734772       (emit-move-from-stack target))
    47744773      (3
     
    47764775       (dolist (arg args)
    47774776         (compile-form arg :target :stack))
    4778        (emit-invokevirtual +lisp-thread-class+
    4779                            "setValues"
    4780                            "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    4781                            -3)
     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+)
    47824783       (emit-move-from-stack target))
    47834784      (t
     
    47904791        +lisp-symbol+)
    47914792  (emit-push-current-thread)
    4792   (emit-invokevirtual +lisp-symbol-class+
    4793                       "symbolValue"
    4794                       "(Lorg/armedbear/lisp/LispThread;)Lorg/armedbear/lisp/LispObject;"
    4795                       -1)
     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+)
    47964799  (when (eq representation :unboxed-fixnum)
    47974800    (emit-unbox-fixnum))
     
    48734876           (compile-form value-form :target :stack)
    48744877           (maybe-emit-clear-values value-form)
    4875            (emit-invokevirtual +lisp-thread-class+
    4876                               "setSpecialVariable"
    4877                               "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;"
    4878                               -2)
     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+)
    48794884           (emit-move-from-stack target))
    48804885          ((and (eq (variable-representation variable) :unboxed-fixnum)
     
    49344939    (emit-push-current-thread)
    49354940    (emit 'aload tag-register)
    4936     (emit-invokevirtual +lisp-thread-class+
    4937                         "pushCatchTag"
    4938                         "(Lorg/armedbear/lisp/LispObject;)V"
    4939                         -2) ; Stack depth is 0.
     4941    (emit-invokevirtual-2 +lisp-thread-class+
     4942                          "pushCatchTag"
     4943;;                           "(Lorg/armedbear/lisp/LispObject;)V"
     4944;;                           -2)
     4945                          (list +lisp-object+)
     4946                          nil)
     4947    ; Stack depth is 0.
    49404948    (emit 'label label1) ; Start of protected range.
    49414949    ;; Implicit PROGN.
     
    49524960    (emit 'if_acmpne label4) ; Stack depth is 1.
    49534961    (emit 'aload *thread*)
    4954     (emit-invokevirtual +lisp-throw-class+
    4955                         "getResult"
    4956                         "(Lorg/armedbear/lisp/LispThread;)Lorg/armedbear/lisp/LispObject;"
    4957                         -1)
     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+)
    49584968    (emit-move-from-stack target) ; Stack depth is 0.
    49594969    (emit 'goto label5)
     
    49614971    ;; A Throwable object is on the runtime stack here. Stack depth is 1.
    49624972    (emit 'aload *thread*)
    4963     (emit-invokevirtual +lisp-thread-class+
    4964                         "popCatchTag"
    4965                         "()V"
    4966                         -1)
     4973    (emit-invokevirtual-2 +lisp-thread-class+
     4974                          "popCatchTag"
     4975;;                           "()V"
     4976;;                           -1)
     4977                          nil
     4978                          nil)
    49674979    (emit 'athrow) ; And we're gone.
    49684980    (emit 'label label5)
    49694981    ;; Finally...
    49704982    (emit 'aload *thread*)
    4971     (emit-invokevirtual +lisp-thread-class+
    4972                         "popCatchTag"
    4973                         "()V"
    4974                         -1)
     4983    (emit-invokevirtual-2 +lisp-thread-class+
     4984                          "popCatchTag"
     4985;;                           "()V"
     4986;;                           -1)
     4987                          nil
     4988                          nil)
    49754989    (let ((handler1 (make-handler :from label1
    49764990                                  :to label2
     
    50205034  (emit-clear-values) ; Do this unconditionally! (MISC.503)
    50215035  (compile-form (third form) :target :stack) ; Result.
    5022   (emit-invokevirtual +lisp-thread-class+
    5023                       "throwToTag"
    5024                       "(Lorg/armedbear/lisp/LispObject;Lorg/armedbear/lisp/LispObject;)V"
    5025                       -3)
     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)
    50265042  ;; Following code will not be reached.
    50275043  (when target
     
    55125528                     +lisp-symbol+)
    55135529               (emit 'aload (variable-register variable))
    5514                (emit-invokevirtual +lisp-thread-class+
    5515                                    "bindSpecial"
    5516                                    "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
    5517                                    -3)
     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)
    55185536               (setf (variable-register variable) nil))
    55195537              ((variable-index variable)
     
    55265544               (emit 'bipush (variable-index variable))
    55275545               (emit 'aaload)
    5528                (emit-invokevirtual +lisp-thread-class+
    5529                                    "bindSpecial"
    5530                                    "(Lorg/armedbear/lisp/Symbol;Lorg/armedbear/lisp/LispObject;)V"
    5531                                    -3)
     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)
    55325552               (setf (variable-index variable) nil)))))
    55335553
     
    55465566      (maybe-generate-arg-count-check)
    55475567      (maybe-generate-interrupt-check)
    5548       (cond
    5549        (*child-p*
    5550         (dformat t "prologue experimental case (child)~%")
    5551         (when *hairy-arglist-p*
    5552           (dformat t "prologue case 1~%")
    5553           (emit 'aload_0) ; this
    5554           (aver (not (null (compiland-argument-register compiland))))
    5555           (emit 'aload (compiland-argument-register compiland)) ; arg vector
    5556           (cond ((or (memq '&optional args) (memq '&key args))
    5557                  (emit 'iconst_0)
    5558                  (emit-invokevirtual *this-class*
    5559                                      "processArgs"
    5560                                      "([Lorg/armedbear/lisp/LispObject;I)[Lorg/armedbear/lisp/LispObject;"
    5561                                      -2))
    5562                 (t
    5563                  (emit-invokevirtual *this-class*
    5564                                      "fastProcessArgs"
    5565                                      "([Lorg/armedbear/lisp/LispObject;)[Lorg/armedbear/lisp/LispObject;"
    5566                                      -1)))
    5567           (emit 'astore (compiland-argument-register compiland))))
    5568        (*hairy-arglist-p*
    5569         (dformat t "prologue case 1~%")
     5568
     5569      (when *hairy-arglist-p*
    55705570        (emit 'aload_0) ; this
    55715571        (aver (not (null (compiland-argument-register compiland))))
    55725572        (emit 'aload (compiland-argument-register compiland)) ; arg vector
    5573         (cond ((or (memq '&optional args) (memq '&key args))
     5573        (cond ((or (memq '&OPTIONAL args) (memq '&KEY args))
    55745574               (emit 'iconst_0)
    5575                (emit-invokevirtual *this-class*
    5576                                    "processArgs"
    5577                                    "([Lorg/armedbear/lisp/LispObject;I)[Lorg/armedbear/lisp/LispObject;"
    5578                                    -2))
     5575               (emit-invokevirtual-2 *this-class*
     5576                                     "processArgs"
     5577                                     (list +lisp-object-array+ "I")
     5578                                     +lisp-object-array+))
    55795579              (t
    5580                (emit-invokevirtual *this-class*
    5581                                    "fastProcessArgs"
    5582                                    "([Lorg/armedbear/lisp/LispObject;)[Lorg/armedbear/lisp/LispObject;"
    5583                                    -1)))
     5580               (emit-invokevirtual-2 *this-class*
     5581                                     "fastProcessArgs"
     5582                                     (list +lisp-object-array+)
     5583                                     +lisp-object-array+)))
    55845584        (emit 'astore (compiland-argument-register compiland)))
    5585        ((not *using-arg-array*)
     5585
     5586      (cond
     5587       ((and (not *child-p*) (not *using-arg-array*))
    55865588        (dformat t "prologue case 2~%")
    55875589        (dolist (variable (reverse *visible-variables*))
Note: See TracChangeset for help on using the changeset viewer.