Changeset 11466


Ignore:
Timestamp:
12/21/08 22:53:09 (13 years ago)
Author:
vvoutilainen
Message:

Big refactoring for compile-form + maybe-emit-clear-values
combinations.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11465 r11466  
    594594      (emit 'clear-values)
    595595      (return))))
     596
     597(defun compile-forms-and-maybe-emit-clear-values (&rest forms-and-compile-args)
     598  (let ((forms-for-emit-clear
     599   (loop for (form arg1 arg2) on forms-and-compile-args by #'cdddr
     600      do (compile-form form arg1 arg2)
     601      collecting form)))
     602    (maybe-emit-clear-values forms-for-emit-clear)))
    596603
    597604(defknown emit-unbox-fixnum () t)
     
    22402247    (cond ((and boxed-method-name unboxed-method-name)
    22412248           (let ((arg (cadr form)))
    2242              (compile-form arg 'stack nil)
    2243              (maybe-emit-clear-values arg)
     2249       (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    22442250             (case representation
    22452251               (:boolean
     
    22792285    (let ((s (gethash1 op (the hash-table *unary-operators*))))
    22802286      (cond (s
    2281              (compile-form arg 'stack nil)
    2282              (maybe-emit-clear-values arg)
     2287       (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    22832288             (emit-invoke-method s target representation)
    22842289             t)
     
    23152320  (let ((arg1 (car args))
    23162321        (arg2 (cadr args)))
    2317   (compile-form arg1 'stack nil)
    2318   (compile-form arg2 'stack nil)
    2319   (maybe-emit-clear-values arg1 arg2)
    2320   (emit-invokevirtual +lisp-object-class+ op
    2321                       (lisp-object-arg-types 1) +lisp-object+)
    2322   (fix-boxing representation nil)
    2323   (emit-move-from-stack target representation)))
     2322    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     2323                 arg2 'stack nil)
     2324    (emit-invokevirtual +lisp-object-class+ op
     2325      (lisp-object-arg-types 1) +lisp-object+)
     2326    (fix-boxing representation nil)
     2327    (emit-move-from-stack target representation)))
    23242328
    23252329(declaim (ftype (function (t t t t) t) compile-function-call-2))
     
    23692373         (arg1 (%car args))
    23702374         (arg2 (%cadr args)))
    2371      (compile-form arg1 'stack nil)
    2372      (compile-form arg2 'stack nil)
    2373      (maybe-emit-clear-values arg1 arg2)
     2375    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     2376                 arg2 'stack nil)
    23742377     (let ((LABEL1 (gensym))
    23752378           (LABEL2 (gensym)))
     
    23952398    (cond ((and (fixnum-type-p type1)
    23962399                (fixnum-type-p type2))
    2397            (compile-form arg1 'stack :int)
    2398            (compile-form arg2 'stack :int)
    2399            (maybe-emit-clear-values arg1 arg2)
     2400     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     2401                  arg2 'stack :int)
    24002402           (let ((label1 (gensym))
    24012403                 (label2 (gensym)))
     
    24072409             (emit 'label `,label2)))
    24082410          ((fixnum-type-p type2)
    2409            (compile-form arg1 'stack nil)
    2410            (compile-form arg2 'stack :int)
    2411            (maybe-emit-clear-values arg1 arg2)
     2411     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     2412                  arg2 'stack :int)
    24122413           (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
    24132414           (case representation
     
    24232424                (emit 'label `,label2)))))
    24242425          ((fixnum-type-p type1)
    2425            (compile-form arg1 'stack :int)
    2426            (compile-form arg2 'stack nil)
    2427            (maybe-emit-clear-values arg1 arg2)
     2426     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     2427                  arg2 'stack nil)
    24282428           (emit 'swap)
    24292429           (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
     
    24402440                (emit 'label `,label2)))))
    24412441          ((eq type2 'CHARACTER)
    2442            (compile-form arg1 'stack nil)
    2443            (compile-form arg2 'stack :char)
    2444            (maybe-emit-clear-values arg1 arg2)
     2442     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     2443                  arg2 'stack :char)
    24452444           (emit-invokevirtual +lisp-object-class+ "eql" '("C") "Z")
    24462445           (case representation
     
    24562455                (emit 'label `,label2)))))
    24572456          ((eq type1 'CHARACTER)
    2458            (compile-form arg1 'stack :char)
    2459            (compile-form arg2 'stack nil)
    2460            (maybe-emit-clear-values arg1 arg2)
     2457     (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
     2458                  arg2 'stack nil)
    24612459           (emit 'swap)
    24622460           (emit-invokevirtual +lisp-object-class+ "eql" '("C") "Z")
     
    24732471                (emit 'label `,label2)))))
    24742472          (t
    2475            (compile-form arg1 'stack nil)
    2476            (compile-form arg2 'stack nil)
    2477            (maybe-emit-clear-values arg1 arg2)
     2473     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     2474                  arg2 'stack nil)
    24782475           (case representation
    24792476             (:boolean
     
    25682565             (arg2 (second args))
    25692566             (arg3 (third args)))
    2570          (compile-form arg1 'stack nil)
    2571          (compile-form arg2 'stack nil)
    2572          (compile-form arg3 'stack nil)
    2573          (maybe-emit-clear-values arg1 arg2 arg3)
     2567   (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     2568                arg2 'stack nil
     2569                arg3 'stack nil)
    25742570         (emit-invokestatic +lisp-class+ "getf"
    25752571                            (lisp-object-arg-types 3) +lisp-object+)
     
    28472843  (when (> *debug* *speed*)
    28482844    (return-from p2-funcall (compile-function-call form target representation)))
    2849   (compile-form (cadr form) 'stack nil)
    2850   (maybe-emit-clear-values (cadr form))
     2845  (compile-forms-and-maybe-emit-clear-values (cadr form) 'stack nil)
    28512846  (compile-call (cddr form))
    28522847;;   (case representation
     
    29702965                (let ((LABEL1 (gensym))
    29712966                      (LABEL2 (gensym)))
    2972                   (compile-form arg1 'stack :int)
    2973                   (compile-form arg2 'stack :int)
    2974                   (maybe-emit-clear-values arg1 arg2)
     2967      (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     2968                   arg2 'stack :int)
    29752969                  (emit (case op
    29762970                          (<  'if_icmpge)
     
    29912985                (let ((LABEL1 (gensym))
    29922986                      (LABEL2 (gensym)))
    2993                   (compile-form arg1 'stack :long)
    2994                   (compile-form arg2 'stack :long)
    2995                   (maybe-emit-clear-values arg1 arg2)
     2987      (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     2988                   arg2 'stack :long)
    29962989                  (emit 'lcmp)
    29972990                  (emit (case op
     
    30103003                (return-from p2-numeric-comparison))
    30113004               ((fixnump arg2)
    3012                 (compile-form arg1 'stack nil)
    3013                 (maybe-emit-clear-values arg1)
     3005    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    30143006                (emit-push-constant-int arg2)
    30153007                (emit-invokevirtual +lisp-object-class+
     
    31573149  (when (check-arg-count form 1)
    31583150    (let ((arg (%cadr form)))
    3159       (compile-form arg 'stack nil)
    3160       (maybe-emit-clear-values arg)
     3151      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    31613152      (emit-invokevirtual +lisp-object-class+ java-predicate nil "Z")
    31623153      'ifeq)))
     
    31663157  (when (check-arg-count form 1)
    31673158    (let ((arg (%cadr form)))
    3168       (compile-form arg 'stack nil)
    3169       (maybe-emit-clear-values arg)
     3159      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    31703160      (emit 'instanceof java-class)
    31713161      'ifeq)))
     
    31813171  (when (= (length form) 2)
    31823172    (let ((arg (%cadr form)))
    3183       (compile-form arg 'stack nil)
    3184       (maybe-emit-clear-values arg)
     3173      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    31853174      (emit-invokevirtual +lisp-object-class+ "constantp" nil "Z")
    31863175      'ifeq)))
     
    31933182    (let ((arg (%cadr form)))
    31943183      (cond ((fixnum-type-p (derive-compiler-type arg))
    3195              (compile-form arg 'stack :int)
    3196              (maybe-emit-clear-values arg)
     3184       (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    31973185             (emit-push-constant-int 1)
    31983186             (emit 'iand)
     
    32053193    (let ((arg (%cadr form)))
    32063194      (cond ((fixnum-type-p (derive-compiler-type arg))
    3207              (compile-form arg 'stack :int)
    3208              (maybe-emit-clear-values arg)
     3195       (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    32093196             (emit-push-constant-int 1)
    32103197             (emit 'iand)
     
    32243211           (arg-type (derive-compiler-type arg)))
    32253212      (cond ((memq arg-type '(CONS LIST NULL))
    3226              (compile-form arg nil nil) ; for effect
    3227              (maybe-emit-clear-values arg)
     3213       (compile-forms-and-maybe-emit-clear-values arg nil nil)
    32283214             :consequent)
    32293215            ((neq arg-type t)
    3230              (compile-form arg nil nil) ; for effect
    3231              (maybe-emit-clear-values arg)
     3216       (compile-forms-and-maybe-emit-clear-values arg nil nil)
    32323217             :alternate)
    32333218            (t
     
    32383223    (let ((arg (%cadr form)))
    32393224      (cond ((fixnum-type-p (derive-compiler-type arg))
    3240              (compile-form arg 'stack :int)
    3241              (maybe-emit-clear-values arg)
     3225       (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    32423226             'ifge)
    32433227            (t
     
    32483232    (let ((arg (%cadr form)))
    32493233      (cond ((fixnum-type-p (derive-compiler-type arg))
    3250              (compile-form arg 'stack :int)
    3251              (maybe-emit-clear-values arg)
     3234     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    32523235             'ifle)
    32533236            (t
     
    32583241    (let ((arg (%cadr form)))
    32593242      (cond ((fixnum-type-p (derive-compiler-type arg))
    3260              (compile-form arg 'stack :int)
    3261              (maybe-emit-clear-values arg)
     3243     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    32623244             'ifne)
    32633245            (t
     
    33203302         :alternate)
    33213303        ((eq (derive-compiler-type test-form) 'BOOLEAN)
    3322          (compile-form test-form 'stack :boolean)
    3323          (maybe-emit-clear-values test-form)
     3304   (compile-forms-and-maybe-emit-clear-values test-form 'stack :boolean)
    33243305         'ifeq)
    33253306        (t
    3326          (compile-form test-form 'stack nil)
    3327          (maybe-emit-clear-values test-form)
     3307   (compile-forms-and-maybe-emit-clear-values test-form 'stack nil)
    33283308         (emit-push-nil)
    33293309         'if_acmpeq)))
     
    33553335    (let* ((arg1 (%cadr form))
    33563336           (arg2 (%caddr form)))
    3357       (compile-form arg1 'stack :char)
    3358       (compile-form arg2 'stack :char)
    3359       (maybe-emit-clear-values arg1 arg2)
     3337      (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
     3338             arg2 'stack :char)
    33603339      'if_icmpne)))
    33613340
     
    33643343    (let ((arg1 (%cadr form))
    33653344          (arg2 (%caddr form)))
    3366       (compile-form arg1 'stack nil)
    3367       (compile-form arg2 'stack nil)
    3368       (maybe-emit-clear-values arg1 arg2)
     3345      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3346             arg2 'stack nil)
    33693347     'if_acmpne)))
    33703348
     
    33803358       'ifeq)
    33813359      (t
    3382        (compile-form form 'stack nil)
    3383        (maybe-emit-clear-values form)
     3360       (compile-forms-and-maybe-emit-clear-values form 'stack nil)
    33843361       (emit-push-nil)
    33853362       'if_acmpeq))))
     
    33963373           (type2 (derive-compiler-type arg2)))
    33973374      (cond ((and (fixnum-type-p type1) (fixnum-type-p type2))
    3398              (compile-form arg1 'stack :int)
    3399              (compile-form arg2 'stack :int)
    3400              (maybe-emit-clear-values arg1 arg2)
     3375       (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     3376              arg2 'stack :int)
    34013377             'if_icmpne)
    34023378            ((and (eq type1 'CHARACTER) (eq type2 'CHARACTER))
    3403              (compile-form arg1 'stack :char)
    3404              (compile-form arg2 'stack :char)
    3405              (maybe-emit-clear-values arg1 arg2)
     3379       (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
     3380              arg2 'stack :char)
    34063381             'if_icmpne)
    34073382            ((eq type2 'CHARACTER)
    3408              (compile-form arg1 'stack nil)
    3409              (compile-form arg2 'stack :char)
    3410              (maybe-emit-clear-values arg1 arg2)
     3383       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3384              arg2 'stack :char)
    34113385             (emit-invokevirtual +lisp-object-class+ "eql" '("C") "Z")
    34123386             'ifeq)
    34133387            ((eq type1 'CHARACTER)
    3414              (compile-form arg1 'stack :char)
    3415              (compile-form arg2 'stack nil)
    3416              (maybe-emit-clear-values arg1 arg2)
     3388       (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
     3389              arg2 'stack nil)
    34173390             (emit 'swap)
    34183391             (emit-invokevirtual +lisp-object-class+ "eql" '("C") "Z")
    34193392             'ifeq)
    34203393            ((fixnum-type-p type2)
    3421              (compile-form arg1 'stack nil)
    3422              (compile-form arg2 'stack :int)
    3423              (maybe-emit-clear-values arg1 arg2)
     3394       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3395              arg2 'stack :int)
    34243396             (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
    34253397             'ifeq)
    34263398            ((fixnum-type-p type1)
    3427              (compile-form arg1 'stack :int)
    3428              (compile-form arg2 'stack nil)
    3429              (maybe-emit-clear-values arg1 arg2)
     3399       (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     3400              arg2 'stack nil)
    34303401             (emit 'swap)
    34313402             (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
    34323403             'ifeq)
    34333404            (t
    3434              (compile-form arg1 'stack nil)
    3435              (compile-form arg2 'stack nil)
    3436              (maybe-emit-clear-values arg1 arg2)
     3405       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3406              arg2 'stack nil)
    34373407             (emit-invokevirtual +lisp-object-class+ "eql"
    34383408                                 (lisp-object-arg-types 1) "Z")
     
    34503420           (arg2 (%caddr form)))
    34513421      (cond ((fixnum-type-p (derive-compiler-type arg2))
    3452              (compile-form arg1 'stack nil)
    3453              (compile-form arg2 'stack :int)
    3454              (maybe-emit-clear-values arg1 arg2)
     3422       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3423              arg2 'stack :int)
    34553424             (emit-invokevirtual +lisp-object-class+
    34563425                                 translated-op
    34573426                                 '("I") "Z"))
    34583427            (t
    3459              (compile-form arg1 'stack nil)
    3460              (compile-form arg2 'stack nil)
    3461              (maybe-emit-clear-values arg1 arg2)
     3428       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3429              arg2 'stack nil)
    34623430             (emit-invokevirtual +lisp-object-class+
    34633431                                 translated-op
     
    34693437    (let ((arg1 (%cadr form))
    34703438          (arg2 (%caddr form)))
    3471       (compile-form arg1 'stack nil)
    3472       (compile-form arg2 'stack nil)
    3473       (maybe-emit-clear-values arg1 arg2)
     3439      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3440             arg2 'stack nil)
    34743441      (emit-invokevirtual +lisp-object-class+ "typep"
    34753442                          (lisp-object-arg-types 1) +lisp-object+)
     
    34813448    (let ((arg1 (%cadr form))
    34823449          (arg2 (%caddr form)))
    3483       (compile-form arg1 'stack nil)
    3484       (compile-form arg2 'stack nil)
    3485       (maybe-emit-clear-values arg1 arg2)
     3450      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3451             arg2 'stack nil)
    34863452      (emit-invokestatic +lisp-class+ "memq"
    34873453                         (lisp-object-arg-types 2) "Z")
     
    34923458    (let ((arg1 (%cadr form))
    34933459          (arg2 (%caddr form)))
    3494       (compile-form arg1 'stack nil)
    3495       (compile-form arg2 'stack nil)
    3496       (maybe-emit-clear-values arg1 arg2)
     3460      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3461             arg2 'stack nil)
    34973462      (emit-invokestatic +lisp-class+ "memql"
    34983463                         (lisp-object-arg-types 2) "Z")
     
    35093474            ((and (fixnum-type-p type1)
    35103475                  (fixnum-type-p type2))
    3511              (compile-form arg1 'stack :int)
    3512              (compile-form arg2 'stack :int)
    3513              (maybe-emit-clear-values arg1 arg2)
     3476       (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     3477              arg2 'stack :int)
    35143478             'if_icmpeq)
    35153479            ((fixnum-type-p type2)
    3516              (compile-form arg1 'stack nil)
    3517              (compile-form arg2 'stack :int)
    3518              (maybe-emit-clear-values arg1 arg2)
     3480       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3481              arg2 'stack :int)
    35193482             (emit-invokevirtual +lisp-object-class+ "isNotEqualTo" '("I") "Z")
    35203483             'ifeq)
     
    35223485             ;; FIXME Compile the args in reverse order and avoid the swap if
    35233486             ;; either arg is a fixnum or a lexical variable.
    3524              (compile-form arg1 'stack :int)
    3525              (compile-form arg2 'stack nil)
    3526              (maybe-emit-clear-values arg1 arg2)
     3487       (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     3488              arg2 'stack nil)
    35273489             (emit 'swap)
    35283490             (emit-invokevirtual +lisp-object-class+ "isNotEqualTo" '("I") "Z")
    35293491             'ifeq)
    35303492            (t
    3531              (compile-form arg1 'stack nil)
    3532              (compile-form arg2 'stack nil)
    3533              (maybe-emit-clear-values arg1 arg2)
     3493       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3494              arg2 'stack nil)
    35343495             (emit-invokevirtual +lisp-object-class+ "isNotEqualTo"
    35353496                                 (lisp-object-arg-types 1) "Z")
     
    35483509               (if (funcall op arg1 arg2) :consequent :alternate))
    35493510              ((and (fixnum-type-p type1) (fixnum-type-p type2))
    3550                (compile-form arg1 'stack :int)
    3551                (compile-form arg2 'stack :int)
    3552                (maybe-emit-clear-values arg1 arg2)
     3511         (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     3512                arg2 'stack :int)
    35533513               (ecase op
    35543514                 (<  'if_icmpge)
     
    35583518                 (=  'if_icmpne)))
    35593519              ((and (java-long-type-p type1) (java-long-type-p type2))
    3560                (compile-form arg1 'stack :long)
    3561                (compile-form arg2 'stack :long)
    3562                (maybe-emit-clear-values arg1 arg2)
     3520         (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     3521                arg2 'stack :long)
    35633522               (emit 'lcmp)
    35643523               (ecase op
     
    35693528                 (=  'ifne)))
    35703529              ((fixnum-type-p type2)
    3571                (compile-form arg1 'stack nil)
    3572                (compile-form arg2 'stack :int)
    3573                (maybe-emit-clear-values arg1 arg2)
     3530         (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3531                arg2 'stack :int)
    35743532               (emit-invokevirtual +lisp-object-class+
    35753533                                   (ecase op
     
    35843542               ;; FIXME We can compile the args in reverse order and avoid
    35853543               ;; the swap if either arg is a fixnum or a lexical variable.
    3586                (compile-form arg1 'stack :int)
    3587                (compile-form arg2 'stack nil)
    3588                (maybe-emit-clear-values arg1 arg2)
     3544         (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     3545                arg2 'stack nil)
    35893546               (emit 'swap)
    35903547               (emit-invokevirtual +lisp-object-class+
     
    35983555               'ifeq)
    35993556              (t
    3600                (compile-form arg1 'stack nil)
    3601                (compile-form arg2 'stack nil)
    3602                (maybe-emit-clear-values arg1 arg2)
     3557         (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3558                arg2 'stack nil)
    36033559               (emit-invokevirtual +lisp-object-class+
    36043560                                   (ecase op
     
    36313587                  (let ((arg1 (second arg))
    36323588                        (arg2 (third arg)))
    3633                     (compile-form arg1 'stack nil)
    3634                     (compile-form arg2 'stack nil)
    3635                     (maybe-emit-clear-values arg1 arg2)
     3589        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     3590                     arg2 'stack nil)
    36363591                    (emit 'if_acmpeq LABEL1)))
    36373592                 ((eq (derive-compiler-type arg) 'BOOLEAN)
    3638                   (compile-form arg 'stack :boolean)
    3639                   (maybe-emit-clear-values arg)
     3593      (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
    36403594                  (emit 'ifne LABEL1))
    36413595                 (t
    3642                   (compile-form arg 'stack nil)
    3643                   (maybe-emit-clear-values arg)
     3596      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    36443597                  (emit-push-nil)
    36453598                  (emit 'if_acmpne LABEL1))))
     
    36693622;;              (cond
    36703623;;               ((eq type 'BOOLEAN)
    3671                     (compile-form arg 'stack :boolean)
    3672                     (maybe-emit-clear-values arg)
    3673                     (emit 'ifeq LABEL1)
     3624     (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
     3625     (emit 'ifeq LABEL1)
    36743626;;                )
    36753627;;                    (t
     
    37103662           (let ((type (derive-compiler-type arg)))
    37113663             (cond ((eq type 'BOOLEAN)
    3712                     (compile-form arg 'stack :boolean)
    3713                     (maybe-emit-clear-values arg)
     3664        (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
    37143665                    (emit 'ifeq LABEL1))
    37153666                   (t
    3716                     (compile-form arg 'stack nil)
    3717                     (maybe-emit-clear-values arg)
     3667        (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    37183668                    (emit-push-nil)
    37193669                    (emit 'if_acmpeq LABEL1)))))
     
    37383688           (compile-form consequent target representation))
    37393689          ((equal (derive-compiler-type test) +true-type+)
    3740            (compile-form test nil nil) ; for effect
    3741            (maybe-emit-clear-values test)
     3690     (compile-forms-and-maybe-emit-clear-values test nil nil)
    37423691           (compile-form consequent target representation))
    37433692          ((and (consp test) (eq (car test) 'OR))
     
    39363885    (aver (= (length vars) (length variables)))
    39373886    (cond ((= (length vars) 1)
    3938            (compile-form (third form) 'stack nil)
    3939            (maybe-emit-clear-values (third form))
     3887     (compile-forms-and-maybe-emit-clear-values (third form) 'stack nil)
    39403888           (compile-binding (car variables)))
    39413889          (t
     
    44534401    (compile-function-call form target representation)
    44544402    (return-from p2-atom))
    4455   (compile-form (cadr form) 'stack nil)
    4456   (maybe-emit-clear-values (cadr form))
     4403  (compile-forms-and-maybe-emit-clear-values (cadr form) 'stack nil)
    44574404  (emit 'instanceof +lisp-cons-class+)
    44584405  (let ((LABEL1 (gensym))
     
    44814428  (let ((arg (%cadr form)))
    44824429    (cond ((null target)
    4483            (compile-form arg nil nil) ; for effect
    4484            (maybe-emit-clear-values arg))
     4430     (compile-forms-and-maybe-emit-clear-values arg nil nil))
    44854431          (t
    4486            (compile-form arg 'stack nil)
    4487            (maybe-emit-clear-values arg)
     4432     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    44884433           (emit 'instanceof java-class)
    44894434           (case representation
     
    45374482    (compile-function-call form target representation)
    45384483    (return-from p2-coerce-to-function))
    4539   (compile-form (%cadr form) 'stack nil)
    4540   (maybe-emit-clear-values (%cadr form))
     4484  (compile-forms-and-maybe-emit-clear-values (%cadr form) 'stack nil)
    45414485  (emit-invokestatic +lisp-class+ "coerceToFunction"
    45424486                     (lisp-object-arg-types 1) +lisp-object+)
     
    46664610           (compile-form arg target nil))
    46674611          ((and (consp arg) (eq (%car arg) 'cdr) (= (length arg) 2))
    4668            (compile-form (second arg) 'stack nil)
    4669            (maybe-emit-clear-values (second arg))
     4612     (compile-forms-and-maybe-emit-clear-values (second arg) 'stack nil)
    46704613           (emit-invoke-method "cadr" target representation))
    46714614          ((eq (derive-type arg) 'CONS)
     
    46764619           (emit-move-from-stack target representation))
    46774620          (t
    4678            (compile-form arg 'stack nil)
    4679            (maybe-emit-clear-values arg)
     4621     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    46804622           (emit-invoke-method "car" target representation)))))
    46814623
     
    46924634           (emit-move-from-stack target representation))
    46934635          (t
    4694            (compile-form arg 'stack nil)
    4695            (maybe-emit-clear-values arg)
     4636     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    46964637           (emit-invoke-method "cdr" target representation)))))
    46974638
     
    47054646         (arg1 (%car args))
    47064647         (arg2 (%cadr args)))
    4707     (compile-form arg1 'stack nil)
    4708     (compile-form arg2 'stack nil)
    4709     (maybe-emit-clear-values arg1 arg2))
     4648    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     4649                 arg2 'stack nil))
    47104650  (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
    47114651  (emit-move-from-stack target))
     
    52015141             (emit 'new +lisp-fixnum-class+)
    52025142             (emit 'dup))
    5203            (compile-form arg1 'stack :int)
    5204            (compile-form arg2 'stack :int)
    5205            (maybe-emit-clear-values arg1 arg2)
     5143     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5144                  arg2 'stack :int)
    52065145           (emit 'ineg)
    52075146           (emit 'ishr)
     
    52175156                       (java-long-type-p type1)
    52185157                       (java-long-type-p result-type))
    5219                   (compile-form arg1 'stack :long)
    5220                   (compile-form arg2 'stack :int)
    5221                   (maybe-emit-clear-values arg1 arg2)
     5158      (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     5159                   arg2 'stack :int)
    52225160                  (emit 'lshl)
    52235161                  (convert-long representation))
     
    52255163                       (java-long-type-p type1)
    52265164                       (java-long-type-p result-type))
    5227                   (compile-form arg1 'stack :long)
    5228                   (compile-form arg2 'stack :int)
    5229                   (maybe-emit-clear-values arg1 arg2)
     5165      (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     5166                   arg2 'stack :int)
    52305167                  (emit 'ineg)
    52315168                  (emit 'lshr)
     
    52355172;;                   (format t "p2-ash type1 = ~S type2 = ~S~%" type1 type2)
    52365173;;                   (format t "p2-ash result-type = ~S~%" result-type)
    5237                   (compile-form arg1 'stack nil)
    5238                   (compile-form arg2 'stack :int)
    5239                   (maybe-emit-clear-values arg1 arg2)
     5174      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5175                   arg2 'stack :int)
    52405176                  (emit-invokevirtual +lisp-object-class+ "ash" '("I") +lisp-object+)
    52415177                  (fix-boxing representation result-type)))
     
    52685204                (compile-constant (logand arg1 arg2) target representation))
    52695205               ((and (integer-type-p type1) (eql arg2 0))
    5270                 (compile-form arg1 nil nil) ; for effect
    5271                 (maybe-emit-clear-values arg1)
     5206    (compile-forms-and-maybe-emit-clear-values arg1 nil nil)
    52725207                (compile-constant 0 target representation))
    52735208               ((eql (fixnum-constant-value type1) -1)
    5274                 (compile-form arg1 nil nil) ; for effect
    5275                 (compile-form arg2 target representation)
    5276                 (maybe-emit-clear-values arg1 arg2))
     5209    (compile-forms-and-maybe-emit-clear-values arg1 nil nil
     5210                 arg2 target representation))
    52775211               ((eql (fixnum-constant-value type2) -1)
    5278                 (compile-form arg1 target representation)
    5279                 (compile-form arg2 nil nil) ; for effect
    5280                 (maybe-emit-clear-values arg1 arg2))
     5212    (compile-forms-and-maybe-emit-clear-values arg1 target representation
     5213                 arg2 nil nil))
    52815214               ((and (fixnum-type-p type1) (fixnum-type-p type2))
    52825215                ;;                     (format t "p2-logand fixnum case~%")
     
    52855218                  (emit 'new +lisp-fixnum-class+)
    52865219                  (emit 'dup))
    5287                 (compile-form arg1 'stack :int)
    5288                 (compile-form arg2 'stack :int)
    5289                 (maybe-emit-clear-values arg1 arg2)
     5220    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5221                 arg2 'stack :int)
    52905222                (emit 'iand)
    52915223                (case representation
     
    53045236                  (emit 'new +lisp-fixnum-class+)
    53055237                  (emit 'dup))
    5306                 (compile-form arg1 'stack :int)
    5307                 (compile-form arg2 'stack :int)
    5308                 (maybe-emit-clear-values arg1 arg2)
     5238    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5239                 arg2 'stack :int)
    53095240                (emit 'iand)
    53105241                (case representation
     
    53175248               ((and (java-long-type-p type1) (java-long-type-p type2))
    53185249                ;; Both arguments are longs.
    5319                 (compile-form arg1 'stack :long)
    5320                 (compile-form arg2 'stack :long)
    5321                 (maybe-emit-clear-values arg1 arg2)
     5250    (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     5251                 arg2 'stack :long)
    53225252                (emit 'land)
    53235253                (case representation
     
    53335263                         (compiler-subtypep type2 'unsigned-byte)))
    53345264                ;; One of the arguments is a positive long.
    5335                 (compile-form arg1 'stack :long)
    5336                 (compile-form arg2 'stack :long)
    5337                 (maybe-emit-clear-values arg1 arg2)
     5265    (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     5266                 arg2 'stack :long)
    53385267                (emit 'land)
    53395268                (case representation
     
    53465275               ((fixnum-type-p type2)
    53475276                ;;                     (format t "p2-logand LispObject.LOGAND(int) 1~%")
    5348                 (compile-form arg1 'stack nil)
    5349                 (compile-form arg2 'stack :int)
    5350                 (maybe-emit-clear-values arg1 arg2)
     5277    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5278                 arg2 'stack :int)
    53515279                (emit-invokevirtual +lisp-object-class+ "LOGAND" '("I") +lisp-object+)
    53525280                (fix-boxing representation result-type)
     
    53555283                ;;                     (format t "p2-logand LispObject.LOGAND(int) 2~%")
    53565284                ;; arg1 is a fixnum, but arg2 is not
    5357                 (compile-form arg1 'stack :int)
    5358                 (compile-form arg2 'stack 'nil)
    5359                 (maybe-emit-clear-values arg1 arg2)
     5285    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5286                 arg2 'stack nil)
    53605287                ;; swap args
    53615288                (emit 'swap)
     
    53655292               (t
    53665293                ;;                     (format t "p2-logand LispObject.LOGAND(LispObject)~%")
    5367                 (compile-form arg1 'stack nil)
    5368                 (compile-form arg2 'stack nil)
    5369                 (maybe-emit-clear-values arg1 arg2)
     5294    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5295                 arg2 'stack nil)
    53705296                (emit-invokevirtual +lisp-object-class+ "LOGAND"
    53715297                                    (lisp-object-arg-types 1) +lisp-object+)
     
    53835309      (1
    53845310       (let ((arg (%car args)))
    5385          (compile-form arg target representation)
    5386          (maybe-emit-clear-values arg)))
     5311   (compile-forms-and-maybe-emit-clear-values arg target representation)))
    53875312      (2
    53885313       (let* ((arg1 (%car args))
     
    53995324               result-type (derive-compiler-type form))
    54005325         (cond ((and (fixnum-constant-value type1) (fixnum-constant-value type2))
    5401                 (compile-form arg1 nil nil) ; for effect
    5402                 (compile-form arg2 nil nil) ; for effect
    5403                 (maybe-emit-clear-values arg1 arg2)
     5326    (compile-forms-and-maybe-emit-clear-values arg1 nil nil
     5327                 arg2 nil nil)
    54045328                (compile-constant (logior (fixnum-constant-value type1)
    54055329                                          (fixnum-constant-value type2))
     
    54095333                  (emit 'new +lisp-fixnum-class+)
    54105334                  (emit 'dup))
    5411                 (compile-form arg1 'stack :int)
    5412                 (compile-form arg2 'stack :int)
    5413                 (maybe-emit-clear-values arg1 arg2)
     5335    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5336                 arg2 'stack :int)
    54145337                (emit 'ior)
    54155338                (case representation
     
    54215344                (emit-move-from-stack target representation))
    54225345               ((and (eql (fixnum-constant-value type1) 0) (< *safety* 3))
    5423                 (compile-form arg1 nil nil) ; for effect
    5424                 (compile-form arg2 target representation)
    5425                 (maybe-emit-clear-values arg1 arg2))
     5346    (compile-forms-and-maybe-emit-clear-values arg1 nil nil
     5347                 arg2 target representation))
    54265348               ((and (eql (fixnum-constant-value type2) 0) (< *safety* 3))
    5427                 (compile-form arg1 target representation)
    5428                 (compile-form arg2 nil nil) ; for effect
    5429                 (maybe-emit-clear-values arg1 arg2))
     5349    (compile-forms-and-maybe-emit-clear-values arg1 target representation
     5350                 arg2 nil nil))
    54305351               ((or (eq representation :long)
    54315352                    (and (java-long-type-p type1) (java-long-type-p type2)))
    5432                 (compile-form arg1 'stack :long)
    5433                 (compile-form arg2 'stack :long)
    5434                 (maybe-emit-clear-values arg1 arg2)
     5353    (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     5354                 arg2 'stack :long)
    54355355                (emit 'lor)
    54365356                (convert-long representation)
    54375357                (emit-move-from-stack target representation))
    54385358               ((fixnum-type-p type2)
    5439                 (compile-form arg1 'stack nil)
    5440                 (compile-form arg2 'stack :int)
    5441                 (maybe-emit-clear-values arg1 arg2)
     5359    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5360                 arg2 'stack :int)
    54425361                (emit-invokevirtual +lisp-object-class+ "LOGIOR" '("I") +lisp-object+)
    54435362                (fix-boxing representation result-type)
     
    54455364               ((fixnum-type-p type1)
    54465365                ;; arg1 is of fixnum type, but arg2 is not
    5447                 (compile-form arg1 'stack :int)
    5448                 (compile-form arg2 'stack 'nil)
    5449                 (maybe-emit-clear-values arg1 arg2)
     5366    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5367                 arg2 'stack nil)
    54505368                ;; swap args
    54515369                (emit 'swap)
     
    54545372                (emit-move-from-stack target representation))
    54555373               (t
    5456                 (compile-form arg1 'stack nil)
    5457                 (compile-form arg2 'stack nil)
    5458                 (maybe-emit-clear-values arg1 arg2)
     5374    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5375                 arg2 'stack nil)
    54595376                (emit-invokevirtual +lisp-object-class+ "LOGIOR"
    54605377                                    (lisp-object-arg-types 1) +lisp-object+)
     
    54755392      (1
    54765393       (let ((arg (%car args)))
    5477          (compile-form arg target representation)
    5478          (maybe-emit-clear-values arg)))
     5394   (compile-forms-and-maybe-emit-clear-values arg target representation)))
    54795395      (2
    54805396       (let* ((arg1 (%car args))
     
    54915407               result-type (derive-compiler-type form))
    54925408         (cond ((eq representation :int)
    5493                 (compile-form arg1 'stack :int)
    5494                 (compile-form arg2 'stack :int)
    5495                 (maybe-emit-clear-values arg1 arg2)
     5409    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5410                 arg2 'stack :int)
    54965411                (emit 'ixor))
    54975412               ((and (fixnum-type-p type1) (fixnum-type-p type2))
     
    55005415                  (emit 'new +lisp-fixnum-class+)
    55015416                  (emit 'dup))
    5502                 (compile-form arg1 'stack :int)
    5503                 (compile-form arg2 'stack :int)
    5504                 (maybe-emit-clear-values arg1 arg2)
     5417    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5418                 arg2 'stack :int)
    55055419                (emit 'ixor)
    55065420                (case representation
     
    55115425                   (emit-invokespecial-init +lisp-fixnum-class+ '("I")))))
    55125426               ((and (java-long-type-p type1) (java-long-type-p type2))
    5513                 (compile-form arg1 'stack :long)
    5514                 (compile-form arg2 'stack :long)
    5515                 (maybe-emit-clear-values arg1 arg2)
     5427    (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     5428                 arg2 'stack :long)
    55165429                (emit 'lxor)
    55175430                (convert-long representation))
    55185431               ((fixnum-type-p type2)
    5519                 (compile-form arg1 'stack nil)
    5520                 (compile-form arg2 'stack :int)
    5521                 (maybe-emit-clear-values arg1 arg2)
     5432    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5433                 arg2 'stack :int)
    55225434                (emit-invokevirtual +lisp-object-class+ "LOGXOR" '("I") +lisp-object+)
    55235435                (fix-boxing representation result-type))
    55245436               (t
    5525                 (compile-form arg1 'stack nil)
    5526                 (compile-form arg2 'stack nil)
    5527                 (maybe-emit-clear-values arg1 arg2)
     5437    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5438                 arg2 'stack nil)
    55285439                (emit-invokevirtual +lisp-object-class+ "LOGXOR"
    55295440                                    (lisp-object-arg-types 1) +lisp-object+)
     
    55455456             (emit 'new +lisp-fixnum-class+)
    55465457             (emit 'dup))
    5547            (compile-form arg 'stack :int)
    5548            (maybe-emit-clear-values arg)
     5458     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    55495459           (emit 'iconst_m1)
    55505460           (emit 'ixor)
     
    55585468        (t
    55595469         (let ((arg (%cadr form)))
    5560            (compile-form arg 'stack nil)
    5561            (maybe-emit-clear-values arg))
     5470     (compile-forms-and-maybe-emit-clear-values arg 'stack nil))
    55625471         (emit-invokevirtual +lisp-object-class+ "LOGNOT" nil +lisp-object+)
    55635472         (fix-boxing representation nil)
     
    55835492    ;; need an unboxed fixnum result.
    55845493    (cond ((eql size 0)
    5585            (compile-form size-arg nil nil) ; for effect
    5586            (compile-form position-arg nil nil) ; for effect
    5587            (compile-form arg3 nil nil) ; for effect)
    5588            (maybe-emit-clear-values size-arg position-arg arg3)
     5494     (compile-forms-and-maybe-emit-clear-values size-arg nil nil
     5495                  position-arg nil nil
     5496                  arg3 nil nil)
    55895497           (compile-constant 0 target representation))
    55905498          ((and size position)
     
    55935501                    (emit 'new +lisp-fixnum-class+)
    55945502                    (emit 'dup))
    5595                   (compile-form size-arg nil nil) ; for effect
    5596                   (compile-form position-arg nil nil) ; for effect
    5597                   (compile-form arg3 'stack :int)
    5598                   (maybe-emit-clear-values size-arg position-arg arg3)
     5503      (compile-forms-and-maybe-emit-clear-values size-arg nil nil
     5504                   position-arg nil nil
     5505                   arg3 'stack :int)
    55995506                  (unless (zerop position)
    56005507                    (emit-push-constant-int position)
     
    56145521                    (emit 'new +lisp-fixnum-class+)
    56155522                    (emit 'dup))
    5616                   (compile-form size-arg nil nil) ; for effect
    5617                   (compile-form position-arg nil nil) ; for effect
    5618                   (compile-form arg3 'stack :long)
    5619                   (maybe-emit-clear-values size-arg position-arg arg3)
     5523      (compile-forms-and-maybe-emit-clear-values size-arg nil nil
     5524                   position-arg nil nil
     5525                   arg3 'stack :long)
    56205526                  (unless (zerop position)
    56215527                    (emit-push-constant-int position)
     
    56375543                  (emit-move-from-stack target representation))
    56385544                 (t
    5639                   (compile-form arg3 'stack nil)
    5640                   (maybe-emit-clear-values arg3)
     5545      (compile-forms-and-maybe-emit-clear-values arg3 'stack nil)
    56415546                  (emit-push-constant-int size)
    56425547                  (emit-push-constant-int position)
     
    56465551          ((and (fixnum-type-p size-type)
    56475552                (fixnum-type-p position-type))
    5648            (compile-form size-arg 'stack :int)
    5649            (compile-form position-arg 'stack :int)
    5650            (compile-form arg3 'stack nil)
    5651            (maybe-emit-clear-values size-arg position-arg arg3)
     5553     (compile-forms-and-maybe-emit-clear-values size-arg 'stack :int
     5554                  position-arg 'stack :int
     5555                  arg3 'stack nil)
    56525556           (emit 'dup_x2)
    56535557           (emit 'pop)
     
    56715575                (fixnum-type-p type1)
    56725576                (fixnum-type-p type2))
    5673            (compile-form arg1 'stack :int)
    5674            (compile-form arg2 'stack :int)
    5675            (maybe-emit-clear-values arg1 arg2)
     5577     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     5578                  arg2 'stack :int)
    56765579           (emit-invokestatic +lisp-class+ "mod" '("I" "I") "I")
    56775580           (emit-move-from-stack target representation))
    56785581          ((fixnum-type-p type2)
    5679            (compile-form arg1 'stack nil)
    5680            (compile-form arg2 'stack :int)
    5681            (maybe-emit-clear-values arg1 arg2)
     5582     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5583                  arg2 'stack :int)
    56825584           (emit-invokevirtual +lisp-object-class+ "MOD" '("I") +lisp-object+)
    56835585           (fix-boxing representation nil) ; FIXME use derived result type
    56845586           (emit-move-from-stack target representation))
    56855587          (t
    5686            (compile-form arg1 'stack nil)
    5687            (compile-form arg2 'stack nil)
    5688            (maybe-emit-clear-values arg1 arg2)
     5588     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5589                  arg2 'stack nil)
    56895590           (emit-invokevirtual +lisp-object-class+ "MOD"
    56905591                               (lisp-object-arg-types 1) +lisp-object+)
     
    57315632         (type (derive-compiler-type arg)))
    57325633    (cond ((fixnum-type-p type)
    5733            (compile-form arg 'stack :int)
    5734            (maybe-emit-clear-values arg)
     5634     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    57355635           (let ((LABEL1 (gensym))
    57365636                 (LABEL2 (gensym)))
     
    57515651             (emit-move-from-stack target representation)))
    57525652          ((java-long-type-p type)
    5753            (compile-form arg 'stack :long)
    5754            (maybe-emit-clear-values arg)
     5653     (compile-forms-and-maybe-emit-clear-values arg 'stack :long)
    57555654           (emit 'lconst_0)
    57565655           (emit 'lcmp)
     
    57655664             (emit-move-from-stack target representation)))
    57665665          (t
    5767            (compile-form arg 'stack nil)
    5768            (maybe-emit-clear-values arg)
     5666     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    57695667           (emit-invoke-method "ZEROP" target representation)))))
    57705668
     
    57885686      (1
    57895687       ;; errorp is true
    5790        (compile-form arg1 'stack nil)
    5791        (maybe-emit-clear-values arg1)
     5688       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    57925689       (emit-push-constant-int 1) ; errorp
    57935690       (emit-invokestatic +lisp-class-class+ "findClass"
     
    57975694      (2
    57985695       (let ((arg2 (second args)))
    5799          (compile-form arg1 'stack nil)
    5800          (compile-form arg2 'stack :boolean)
    5801          (maybe-emit-clear-values arg1 arg2)
     5696   (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5697                arg2 'stack :boolean)
    58025698         (emit-invokestatic +lisp-class-class+ "findClass"
    58035699                            (list +lisp-object+ "Z") +lisp-object+)
     
    58155711    (case arg-count
    58165712      (2
    5817        (compile-form arg1 'stack nil)
    5818        (compile-form arg2 'stack nil)
    5819        (maybe-emit-clear-values arg1 arg2)
     5713       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5714              arg2 'stack nil)
    58205715       (emit 'swap)
    58215716       (cond (target
     
    58385733         (arg1 (first args))
    58395734         (arg2 (second args)))
    5840     (compile-form arg1 'stack nil)
    5841     (compile-form arg2 'stack nil)
    5842     (maybe-emit-clear-values arg1 arg2)
     5735    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5736                 arg2 'stack nil)
    58435737    (emit-invokevirtual +lisp-object-class+ "SLOT_VALUE"
    58445738                        (lisp-object-arg-types 1) +lisp-object+)
     
    58585752         (*register* *register*)
    58595753         (value-register (when target (allocate-register))))
    5860     (compile-form arg1 'stack nil)
    5861     (compile-form arg2 'stack nil)
    5862     (compile-form arg3 'stack nil)
    5863     (maybe-emit-clear-values arg1 arg2 arg3)
     5754    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     5755                 arg2 'stack nil
     5756                 arg3 'stack nil)
    58645757    (when value-register
    58655758      (emit 'dup)
     
    58825775           (emit 'new +lisp-simple-vector-class+)
    58835776           (emit 'dup)
    5884            (compile-form arg 'stack :int)
    5885            (maybe-emit-clear-values arg)
     5777     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    58865778           (emit-invokespecial-init +lisp-simple-vector-class+ '("I"))
    58875779           (emit-move-from-stack target representation)))
     
    59145806          (emit 'new class)
    59155807          (emit 'dup)
    5916           (compile-form arg2 'stack :int)
    5917           (maybe-emit-clear-values arg2)
     5808    (compile-forms-and-maybe-emit-clear-values arg2 'stack :int)
    59185809          (emit-invokespecial-init class '("I"))
    59195810          (emit-move-from-stack target representation)
     
    59305821           (emit 'new +lisp-simple-string-class+)
    59315822           (emit 'dup)
    5932            (compile-form arg 'stack :int)
    5933            (maybe-emit-clear-values arg)
     5823     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    59345824           (emit-invokespecial-init +lisp-simple-string-class+ '("I"))
    59355825           (emit-move-from-stack target representation)))
     
    59915881  (let ((arg (%cadr form)))
    59925882    (cond ((eq (derive-compiler-type arg) 'STREAM)
    5993            (compile-form arg 'stack nil)
    5994            (maybe-emit-clear-values arg)
     5883     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    59955884           (emit 'checkcast +lisp-stream-class+)
    59965885           (emit-invokevirtual +lisp-stream-class+ "getElementType"
     
    60435932         (cond ((compiler-subtypep type1 'stream)
    60445933;;                 (format t "p2-read-line optimized case 1~%")
    6045                 (compile-form arg1 'stack nil)
    6046                 (maybe-emit-clear-values arg1)
     5934    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    60475935                (emit 'checkcast +lisp-stream-class+)
    60485936                (emit-push-constant-int 1)
     
    60605948         (cond ((and (compiler-subtypep type1 'stream) (null arg2))
    60615949;;                 (format t "p2-read-line optimized case 2~%")
    6062                 (compile-form arg1 'stack nil)
    6063                 (maybe-emit-clear-values arg1)
     5950    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    60645951                (emit 'checkcast +lisp-stream-class+)
    60655952                (emit-push-constant-int 0)
     
    65826469    (return-from p2-length))
    65836470  (let ((arg (cadr form)))
    6584     (compile-form arg 'stack nil)
    6585     (maybe-emit-clear-values arg)
     6471    (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    65866472    (case representation
    65876473      (:int
     
    66466532         (length (length args)))
    66476533    (cond ((= length 1)
    6648            (compile-form (first args) 'stack nil)
    6649            (maybe-emit-clear-values (first args))
     6534     (compile-forms-and-maybe-emit-clear-values (first args) 'stack nil)
    66506535           (emit-move-from-stack target representation))
    66516536          ((= length 2)
     
    67036588  (let ((index-form (second form))
    67046589        (list-form (third form)))
    6705     (compile-form index-form 'stack :int)
    6706     (compile-form list-form 'stack nil)
    6707     (maybe-emit-clear-values index-form list-form)
     6590    (compile-forms-and-maybe-emit-clear-values index-form 'stack :int
     6591                 list-form 'stack nil)
    67086592    (emit 'swap)
    67096593    (emit-invokevirtual +lisp-object-class+ "NTH" '("I") +lisp-object+)
     
    67356619                       (emit 'new +lisp-fixnum-class+)
    67366620                       (emit 'dup))
    6737                      (compile-form arg1 'stack :int)
    6738                      (compile-form arg2 'stack :int)
    6739                      (maybe-emit-clear-values arg1 arg2)
     6621         (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     6622                arg2 'stack :int)
    67406623                     (emit 'imul)
    67416624                     (unless (eq representation :int)
     
    67556638                   (java-long-type-p type2)
    67566639                   (java-long-type-p result-type))
    6757               (compile-form arg1 'stack :long)
    6758               (compile-form arg2 'stack :long)
    6759               (maybe-emit-clear-values arg1 arg2)
     6640        (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     6641               arg2 'stack :long)
    67606642              (emit 'lmul)
    67616643              (convert-long representation)
     
    67636645             ((fixnump arg2)
    67646646;;               (format t "p2-times case 3~%")
    6765               (compile-form arg1 'stack nil)
    6766               (maybe-emit-clear-values arg1)
     6647        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    67676648              (emit-push-int arg2)
    67686649              (emit-invokevirtual +lisp-object-class+ "multiplyBy" '("I") +lisp-object+)
     
    67866667                (arg2 (%cadr args)))
    67876668           (when (null target)
    6788              (compile-form arg1 nil nil)
    6789              (compile-form arg2 nil nil)
    6790              (maybe-emit-clear-values arg1 arg2)
     6669       (compile-forms-and-maybe-emit-clear-values arg1 nil nil
     6670              arg2 nil nil)
    67916671             (return-from p2-min/max))
    67926672           (when (notinline-p op)
     
    68916771              (compile-constant (+ arg1 arg2) target representation))
    68926772             ((and (numberp arg1) (eql arg1 0))
    6893               (compile-form arg1 nil nil) ; for effect
    6894               (compile-form arg2 'stack representation)
    6895               (maybe-emit-clear-values arg1 arg2)
     6773        (compile-forms-and-maybe-emit-clear-values arg1 nil nil
     6774               arg2 'stack representation)
    68966775              (emit-move-from-stack target representation))
    68976776             ((and (numberp arg2) (eql arg2 0))
    6898               (compile-form arg1 'stack representation)
    6899               (compile-form arg2 nil nil) ; for effect
    6900               (maybe-emit-clear-values arg1 arg2)
     6777        (compile-forms-and-maybe-emit-clear-values arg1 'stack representation
     6778               arg2 nil nil)
    69016779              (emit-move-from-stack target representation))
    69026780             ((and (fixnum-type-p type1) (fixnum-type-p type2))
     
    69066784                       (emit 'new +lisp-fixnum-class+)
    69076785                       (emit 'dup))
    6908                      (compile-form arg1 'stack :int)
    6909                      (compile-form arg2 'stack :int)
    6910                      (maybe-emit-clear-values arg1 arg2)
     6786         (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     6787                arg2 'stack :int)
    69116788                     (emit 'iadd)
    69126789                     (case representation
     
    69436820              (emit-move-from-stack target representation))
    69446821             ((eql arg2 1)
    6945               (compile-form arg1 'stack nil)
    6946               (maybe-emit-clear-values arg1)
     6822        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    69476823              (emit-invoke-method "incr" target representation))
    69486824             ((eql arg1 1)
    6949               (compile-form arg2 'stack nil)
    6950               (maybe-emit-clear-values arg2)
     6825        (compile-forms-and-maybe-emit-clear-values arg2 'stack nil)
    69516826              (emit-invoke-method "incr" target representation))
    69526827             ((fixnum-type-p type1)
    6953               (compile-form arg1 'stack :int)
    6954               (compile-form arg2 'stack nil)
    6955               (maybe-emit-clear-values arg1 arg2)
     6828        (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     6829               arg2 'stack nil)
    69566830              (emit 'swap)
    69576831              (emit-invokevirtual +lisp-object-class+ "add" '("I") +lisp-object+)
     
    70166890              (emit-move-from-stack target representation))
    70176891             (t
    7018               (compile-form arg 'stack nil)
    7019               (maybe-emit-clear-values arg)
     6892        (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    70206893              (emit-invokevirtual +lisp-object-class+ "negate"
    70216894                                  nil +lisp-object+)
     
    70376910                       (emit 'new +lisp-fixnum-class+)
    70386911                       (emit 'dup))
    7039                      (compile-form arg1 'stack :int)
    7040                      (compile-form arg2 'stack :int)
    7041                      (maybe-emit-clear-values arg1 arg2)
     6912         (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     6913                arg2 'stack :int)
    70426914                     (emit 'isub)
    70436915                     (case representation
     
    70586930             ((and (java-long-type-p type1) (java-long-type-p type2)
    70596931                   (java-long-type-p result-type))
    7060               (compile-form arg1 'stack :long)
    7061               (compile-form arg2 'stack :long)
    7062               (maybe-emit-clear-values arg1 arg2)
     6932        (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
     6933               arg2 'stack :long)
    70636934              (emit 'lsub)
    70646935              (convert-long representation)
    70656936              (emit-move-from-stack target representation))
    70666937             ((fixnum-type-p type2)
    7067               (compile-form arg1 'stack nil)
    7068               (compile-form arg2 'stack :int)
    7069               (maybe-emit-clear-values arg1 arg2)
     6938        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     6939               arg2 'stack :int)
    70706940              (emit-invokevirtual +lisp-object-class+ "subtract" '("I") +lisp-object+)
    70716941              (fix-boxing representation result-type)
     
    71136983           (emit-move-from-stack target representation))
    71146984          ((fixnum-type-p type2)
    7115            (compile-form arg1 'stack nil)
    7116            (compile-form arg2 'stack :int)
    7117            (maybe-emit-clear-values arg1 arg2)
     6985     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     6986                  arg2 'stack :int)
    71186987           (emit-invokevirtual +lisp-object-class+
    71196988                               (symbol-name op) ;; "CHAR" or "SCHAR"
     
    71827051         (let ((arg1 (%cadr form))
    71837052               (arg2 (%caddr form)))
    7184            (compile-form arg1 'stack nil) ; vector
    7185            (compile-form arg2 'stack :int) ; index
    7186            (maybe-emit-clear-values arg1 arg2)
     7053     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     7054                  arg2 'stack :int)
    71877055           (emit-invokevirtual +lisp-object-class+ "SVREF" '("I") +lisp-object+)
    71887056           (fix-boxing representation nil)
     
    72597127       (case representation
    72607128         (:int
    7261           (compile-form arg1 'stack nil) ; array
    7262           (compile-form arg2 'stack :int) ; index
    7263           (maybe-emit-clear-values arg1 arg2)
     7129    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     7130                 arg2 'stack :int)
    72647131          (emit-invokevirtual +lisp-object-class+ "aref" '("I") "I"))
    72657132         (:long
    7266           (compile-form arg1 'stack nil) ; array
    7267           (compile-form arg2 'stack :int) ; index
    7268           (maybe-emit-clear-values arg1 arg2)
     7133    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     7134                 arg2 'stack :int)
    72697135          (emit-invokevirtual +lisp-object-class+ "aref_long" '("I") "J"))
    72707136         (:char
     
    72777143                                     "charAt" '("I") "C"))
    72787144                (t
    7279                  (compile-form arg1 'stack nil) ; array
    7280                  (compile-form arg2 'stack :int) ; index
    7281                  (maybe-emit-clear-values arg1 arg2)
     7145     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     7146                  arg2 'stack :int)
    72827147                 (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+)
    72837148                 (emit-unbox-character))))
    72847149         (t
    7285           (compile-form arg1 'stack nil) ; array
    7286           (compile-form arg2 'stack :int) ; index
    7287           (maybe-emit-clear-values arg1 arg2)
     7150    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     7151                 arg2 'stack :int)
    72887152          (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+)
    72897153          (fix-boxing representation nil)))
     
    73777241    (cond ((and (fixnump arg2)
    73787242                (null representation))
    7379            (compile-form arg1 'stack nil)
    7380            (maybe-emit-clear-values arg1)
     7243     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    73817244           (case arg2
    73827245             (0
     
    73987261           (emit-move-from-stack target representation))
    73997262          ((fixnump arg2)
    7400            (compile-form arg1 'stack nil)
    7401            (maybe-emit-clear-values arg1)
     7263     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    74027264           (emit 'sipush arg2)
    74037265           (case representation
     
    74377299          (let* ((*register* *register*)
    74387300                 (value-register (when target (allocate-register))))
    7439             (compile-form arg1 'stack nil)
    7440             (compile-form arg3 'stack nil)
    7441             (maybe-emit-clear-values arg1 arg3)
     7301     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     7302                  arg3 'stack nil)
    74427303            (when value-register
    74437304              (emit 'dup)
     
    74827343          ((and (consp arg)
    74837344                (memq (%car arg) '(NOT NULL)))
    7484            (compile-form (second arg) 'stack nil)
    7485            (maybe-emit-clear-values (second arg))
     7345     (compile-forms-and-maybe-emit-clear-values (second arg) 'stack nil)
    74867346           (emit-push-nil)
    74877347           (let ((LABEL1 (gensym))
     
    74947354             (emit 'label LABEL2)))
    74957355          ((eq representation :boolean)
    7496            (compile-form arg 'stack :boolean)
    7497            (maybe-emit-clear-values arg)
     7356     (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
    74987357           (emit 'iconst_1)
    74997358           (emit 'ixor))
    75007359          ((eq (derive-compiler-type arg) 'BOOLEAN)
    7501            (compile-form arg 'stack :boolean)
    7502            (maybe-emit-clear-values arg)
     7360     (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
    75037361           (let ((LABEL1 (gensym))
    75047362                 (LABEL2 (gensym)))
     
    75107368             (emit 'label LABEL2)))
    75117369          (t
    7512            (compile-form arg 'stack nil)
    7513            (maybe-emit-clear-values arg)
     7370     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    75147371           (let ((LABEL1 (gensym))
    75157372                 (LABEL2 (gensym)))
     
    75317388         (arg2 (%cadr args)))
    75327389    (cond ((fixnum-type-p (derive-compiler-type arg1))
    7533            (compile-form arg1 'stack :int)
    7534            (compile-form arg2 'stack nil)
    7535            (maybe-emit-clear-values arg1 arg2)
     7390     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
     7391                  arg2 'stack nil)
    75367392           (emit 'swap)
    75377393           (emit-invokevirtual +lisp-object-class+ "nthcdr" '("I") +lisp-object+)
     
    75557411             (FAIL (gensym))
    75567412             (DONE (gensym)))
    7557          (compile-form arg1 'stack :boolean)
    7558          (maybe-emit-clear-values arg1)
     7413   (compile-forms-and-maybe-emit-clear-values arg1 'stack :boolean)
    75597414         (emit 'ifeq FAIL)
    75607415         (case representation
    75617416           (:boolean
    7562             (compile-form arg2 'stack :boolean)
    7563             (maybe-emit-clear-values arg2)
     7417      (compile-forms-and-maybe-emit-clear-values arg2 'stack :boolean)
    75647418            (emit 'goto DONE)
    75657419            (label FAIL)
     
    75917445             (LABEL1 (gensym))
    75927446             (LABEL2 (gensym)))
    7593          (compile-form arg1 'stack nil)
    7594          (maybe-emit-clear-values arg1)
     7447   (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    75957448         (emit 'dup)
    75967449         (emit-push-nil)
     
    76187471      (1
    76197472       (let ((arg (%car args)))
    7620          (compile-form arg target representation)
    7621          (maybe-emit-clear-values arg)))
     7473   (compile-forms-and-maybe-emit-clear-values arg target representation)))
    76227474      (2
    76237475       (emit-push-current-thread)
     
    78167668             ;; (push thing *special*) => (setq *special* (cons thing *special*))
    78177669;;              (format t "compiling pushSpecial~%")
    7818              (compile-form (second value-form) 'stack nil)
    7819              (maybe-emit-clear-values (second value-form))
     7670       (compile-forms-and-maybe-emit-clear-values (second value-form) 'stack nil)
    78207671             (emit-invokevirtual +lisp-thread-class+ "pushSpecial"
    78217672                                 (list +lisp-symbol+ +lisp-object+) +lisp-object+))
    78227673            (t
    7823              (compile-form value-form 'stack nil)
    7824              (maybe-emit-clear-values value-form)
     7674       (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
    78257675             (emit-invokevirtual +lisp-thread-class+ "setSpecialVariable"
    78267676                                 (list +lisp-symbol+ +lisp-object+) +lisp-object+)))
     
    78327682      ;; If we never read the variable, we don't have to set it.
    78337683      (cond (target
    7834              (compile-form value-form 'stack nil)
    7835              (maybe-emit-clear-values value-form)
     7684       (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
    78367685             (fix-boxing representation nil)
    78377686             (emit-move-from-stack target representation))
     
    79207769           (dformat t "p2-setq :int case value-form = ~S~%"
    79217770                    value-form)
    7922            (compile-form value-form 'stack :int)
    7923            (maybe-emit-clear-values value-form)
     7771     (compile-forms-and-maybe-emit-clear-values value-form 'stack :int)
    79247772           (when target
    79257773             (emit 'dup))
     
    79407788          ((eq (variable-representation variable) :char)
    79417789           (dformat t "p2-setq :char case~%")
    7942            (compile-form value-form 'stack :char)
    7943            (maybe-emit-clear-values value-form)
     7790     (compile-forms-and-maybe-emit-clear-values value-form 'stack :char)
    79447791           (when target
    79457792             (emit 'dup))
     
    79557802               (emit-move-from-stack target representation))))
    79567803          ((eq (variable-representation variable) :long)
    7957            (compile-form value-form 'stack :long)
    7958            (maybe-emit-clear-values value-form)
     7804     (compile-forms-and-maybe-emit-clear-values value-form 'stack :long)
    79597805           (when target
    79607806             (emit 'dup2))
     
    79707816             (emit-move-from-stack target representation)))
    79717817          ((eq (variable-representation variable) :boolean)
    7972            (compile-form value-form 'stack :boolean)
    7973            (maybe-emit-clear-values value-form)
     7818     (compile-forms-and-maybe-emit-clear-values value-form 'stack :boolean)
    79747819           (when target
    79757820             (emit 'dup))
     
    79837828             (emit-move-from-stack target representation)))
    79847829          (t
    7985            (compile-form value-form 'stack nil)
    7986            (maybe-emit-clear-values value-form)
     7830     (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
    79877831           (when target
    79887832             (emit 'dup))
     
    79987842             (emit 'new +lisp-fixnum-class+)
    79997843             (emit 'dup))
    8000            (compile-form arg 'stack nil)
    8001            (maybe-emit-clear-values arg)
     7844     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    80027845           (emit-invokevirtual +lisp-object-class+ "sxhash" nil "I")
    80037846           (unless (eq representation :int)
     
    80157858  (let ((arg (%cadr form)))
    80167859    (cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
    8017            (compile-form arg 'stack nil)
    8018            (maybe-emit-clear-values arg)
     7860     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    80197861           (emit 'checkcast +lisp-symbol-class+)
    80207862           (emit 'getfield  +lisp-symbol-class+ "name" +lisp-simple-string+)
     
    80307872  (let ((arg (%cadr form)))
    80317873    (cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
    8032            (compile-form arg 'stack nil)
    8033            (maybe-emit-clear-values arg)
     7874     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    80347875           (emit 'checkcast +lisp-symbol-class+)
    80357876           (emit-invokevirtual +lisp-symbol-class+ "getPackage"
     
    80457886    (let ((arg (%cadr form)))
    80467887      (when (eq (derive-compiler-type arg) 'SYMBOL)
    8047         (compile-form arg 'stack nil)
    8048         (maybe-emit-clear-values arg)
     7888  (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    80497889        (emit 'checkcast +lisp-symbol-class+)
    80507890        (emit-push-current-thread)
     
    82088048      (cond ((characterp arg1)
    82098049             (emit-push-constant-int (char-code arg1))
    8210              (compile-form arg2 'stack :char)
    8211              (maybe-emit-clear-values arg2))
     8050       (compile-forms-and-maybe-emit-clear-values arg2 'stack :char))
    82128051            ((characterp arg2)
    8213              (compile-form arg1 'stack :char)
    8214              (maybe-emit-clear-values arg1)
     8052       (compile-forms-and-maybe-emit-clear-values arg1 'stack :char)
    82158053             (emit-push-constant-int (char-code arg2)))
    82168054            (t
    8217              (compile-form arg1 'stack :char)
    8218              (compile-form arg2 'stack :char)
    8219              (maybe-emit-clear-values arg1 arg2)))
     8055       (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
     8056              arg2 'stack :char)))
    82208057      (let ((LABEL1 (gensym))
    82218058            (LABEL2 (gensym)))
     
    84348271         (compiler-unsupported "COMPILE-FORM unhandled case ~S" form)))
    84358272  t)
     8273
     8274
    84368275
    84378276;; Returns descriptor.
Note: See TracChangeset for help on using the changeset viewer.