Changeset 14899


Ignore:
Timestamp:
Jul 21, 2011, 10:40:08 AM (8 years ago)
Author:
gb
Message:

Try to allow some cases of self calls to skip arg-count checks,
self-tail-calls to reuse existing frame.

When trying to get one or two forms into arbitrary registers,
try to better exploit cases where the forms are references to
variables that're already known to be in registers.

Work-in-progress: implement some forms of CASE with a jump table.
(Pretty simple on ARM; code doesn't yet deal with some contexts

  • such as some forms of multiple-value return - and needs to

track stack changes, etc.

When trying to get the result of (%i+ val constant) into a register,
"suggest" that VAL be targeted to that register. (This is just done
to avoid invalidating register map entries in some cases; sometimes
it wins, sometimes it doesn't.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/ARM/arm2.lisp

    r14847 r14899  
    151151
    152152(defvar *arm2-entry-label* nil)
    153 (defvar *arm2-tail-label* nil)
    154 (defvar *arm2-tail-vsp* nil)
    155 (defvar *arm2-tail-nargs* nil)
     153(defvar *arm2-fixed-args-label* nil)
     154(defvar *arm2-fixed-args-tail-label* nil)
     155(defvar *arm2-fixed-nargs* nil)
    156156(defvar *arm2-tail-allow* t)
    157157(defvar *arm2-reckless* nil)
     
    160160(defvar *arm2-trust-declarations* nil)
    161161(defvar *arm2-entry-vstack* nil)
    162 (defvar *arm2-fixed-nargs* nil)
    163162(defvar *arm2-need-nargs* t)
    164163
     
    400399           (*backend-immediates* (arm2-make-stack 64  target::subtag-simple-vector))
    401400           (*arm2-entry-label* nil)
    402            (*arm2-tail-label* nil)
    403            (*arm2-tail-vsp* nil)
    404            (*arm2-tail-nargs* nil)
     401           (*arm2-fixed-args-label* nil)
     402           (*arm2-fixed-args-tail-label*)
     403           (*arm2-fixed-nargs* nil)
    405404           (*arm2-inhibit-register-allocation* nil)
    406405           (*arm2-tail-allow* t)
     
    410409           (*arm2-trust-declarations* t)
    411410           (*arm2-entry-vstack* nil)
    412            (*arm2-fixed-nargs* nil)
    413411           (*arm2-need-nargs* t)
    414412           (fname (afunc-name afunc))
     
    853851           (reg-vars ()))
    854852      (declare (type (unsigned-byte 16) nargs))
     853      (when (and
     854             (<= nargs $numarmargregs)
     855             (not (some #'null revargs)))
     856        (setq *arm2-fixed-nargs* nargs)
     857        ;; Self calls with valid fixed args may reference this
     858        ;; label. Preserve the register map (which ordinarily
     859        ;; woul be invalidated by the label.
     860        (with-arm2-saved-regmap (mask map)
     861          (@ (setq *arm2-fixed-args-label* (backend-get-next-label)))))
    855862      (if (<= nargs $numarmargregs)       ; caller didn't vpush anything
    856863        (! save-lisp-context-vsp)
     
    858865          (declare (fixnum offset))
    859866          (! save-lisp-context-offset offset)))
     867      (when *arm2-fixed-args-label*
     868        (@ (setq *arm2-fixed-args-tail-label* (backend-get-next-label))))
    860869      (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
    861870        (declare (ignore xvar yvar))
     
    11651174 
    11661175
    1167 
     1176(defun arm2-reg-for-var (form)
     1177  (let* ((var (arm2-lexical-reference-p form)))
     1178    (when var
     1179      (let* ((ea (var-ea var)))
     1180        (when (memory-spec-p ea)
     1181          (let* ((offset (memspec-frame-address-offset ea))
     1182                 (mask *arm2-gpr-locations-valid-mask*)
     1183                 (info *arm2-gpr-locations*))
     1184            (declare (fixnum mask) (simple-vector info))
     1185            (dotimes (reg 16)
     1186              (when (and (logbitp reg mask)
     1187                         (memq offset (svref info reg)))
     1188                (return reg)))))))))
     1189                 
     1190           
     1191         
    11681192
    11691193(defun arm2-stack-to-register (seg memspec reg)
     
    23692393           (callable (or symp lfunp label-p))
    23702394           (destreg (if symp ($ arm::fname) (if lfunp ($ arm::nfn) (unless label-p ($ arm::nfn)))))
    2371            (alternate-tail-call
    2372             (and tail-p label-p *arm2-tail-label* (eql nargs *arm2-tail-nargs*) (not spread-p)))
    2373            )
     2395           (known-fixed-nargs nil)
     2396           (label (when label-p
     2397                    (if (and *arm2-fixed-args-label*
     2398                               (eql nargs *arm2-fixed-nargs*)
     2399                               (not spread-p))
     2400                      (progn
     2401                        (setq known-fixed-nargs t)
     2402                        (if tail-p
     2403                          *arm2-fixed-args-tail-label*
     2404                          *arm2-fixed-args-label*))
     2405                      1))))
    23742406      (when expression-p
    23752407        ;;Have to do this before spread args, since might be vsp-relative.
     
    23932425            (! spread-list)))
    23942426        (if nargs
    2395           (unless alternate-tail-call (arm2-set-nargs seg nargs))
     2427          (unless known-fixed-nargs (arm2-set-nargs seg nargs))
    23962428          (! pop-argument-registers)))
    23972429      (if callable
     
    24112443                (progn
    24122444                  (arm2-copy-register seg ($ arm::nfn) ($  arm::fn))
    2413                   (! call-label (aref *backend-labels* 1)))
     2445                  (! call-label (aref *backend-labels* label)))
    24142446                (progn
    24152447                  (if a-reg
     
    24192451                    (arm2-call-symbol seg nil)
    24202452                    (! call-known-function))))))
    2421           (if alternate-tail-call
    2422             (progn
    2423               (arm2-unwind-stack seg xfer 0 0 *arm2-tail-vsp*)
    2424               (! jump (aref *backend-labels* *arm2-tail-label*)))
    2425             (progn
     2453          (progn
    24262454              (arm2-unwind-stack seg xfer 0 0 #x7fffff)
    24272455              (if (and (not spread-p) nargs (%i<= nargs $numarmargregs))
     
    24302458                    (arm2-copy-register seg arm::nfn arm::fn))
    24312459                  (unless (or label-p a-reg) (arm2-store-immediate seg func destreg))
    2432                   (arm2-restore-full-lisp-context seg)
     2460                  (unless known-fixed-nargs
     2461                    (arm2-restore-full-lisp-context seg))
    24332462                  (if label-p
    2434                     (! jump (aref *backend-labels* 1))
     2463                    (! jump (aref *backend-labels* label))
    24352464                    (progn
    24362465                      (if symp
     
    24532482                         (if symp
    24542483                           (! jump-known-symbol)
    2455                            (! jump-known-function)))))))))
     2484                           (! jump-known-function))))))))
    24562485        ;; The general (funcall) case: we don't know (at compile-time)
    24572486        ;; for sure whether we've got a symbol or a (local, constant)
     
    26972726
    26982727(defun arm2-one-untargeted-reg-form (seg form suggested)
    2699   (with-arm-local-vinsn-macros (seg)
    2700     (let* ((gpr-p (= (hard-regspec-class suggested) hard-reg-class-gpr))
    2701            (node-p (if gpr-p (= (get-regspec-mode suggested) hard-reg-class-gpr-mode-node))))
    2702       (if node-p
    2703         (let* ((ref (arm2-lexical-reference-ea form))
    2704                (reg (backend-ea-physical-reg ref hard-reg-class-gpr)))
    2705           (if reg
    2706             ref
    2707             (if (nx-null form)
    2708               (progn
    2709                 (! load-nil suggested)
    2710                 suggested)
    2711               (if (and (acode-p form)
    2712                        (eq (acode-operator form) (%nx1-operator immediate))
    2713                        (setq reg (arm2-register-constant-p (cadr form))))
    2714                 reg
    2715                 (if (and (acode-p form)
    2716                          (eq (acode-operator form) (%nx1-operator %current-tcr)))
    2717                   arm::rcontext
    2718                   (arm2-one-untargeted-lreg-form seg form suggested))))))
    2719         (arm2-one-untargeted-lreg-form seg form suggested)))))
     2728  (or (arm2-reg-for-var form)
     2729      (with-arm-local-vinsn-macros (seg)
     2730        (let* ((gpr-p (= (hard-regspec-class suggested) hard-reg-class-gpr))
     2731               (node-p (if gpr-p (= (get-regspec-mode suggested) hard-reg-class-gpr-mode-node))))
     2732          (if node-p
     2733            (let* ((ref (arm2-lexical-reference-ea form))
     2734                   (reg (backend-ea-physical-reg ref hard-reg-class-gpr)))
     2735              (if reg
     2736                ref
     2737                (if (nx-null form)
     2738                  (progn
     2739                    (! load-nil suggested)
     2740                    suggested)
     2741                  (if (and (acode-p form)
     2742                           (eq (acode-operator form) (%nx1-operator immediate))
     2743                           (setq reg (arm2-register-constant-p (cadr form))))
     2744                    reg
     2745                    (if (and (acode-p form)
     2746                             (eq (acode-operator form) (%nx1-operator %current-tcr)))
     2747                      arm::rcontext
     2748                      (arm2-one-untargeted-lreg-form seg form suggested))))))
     2749            (arm2-one-untargeted-lreg-form seg form suggested))))))
    27202750             
    27212751
     
    28312861
    28322862(defun arm2-two-untargeted-reg-forms (seg aform areg bform breg)
    2833   (with-arm-local-vinsn-macros (seg)
    2834     (let* ((avar (arm2-lexical-reference-p aform))
    2835            (adest areg)
    2836            (bdest breg)
    2837            (atriv (and (arm2-trivial-p bform) (nx2-node-gpr-p breg)))
    2838            (aconst (and (not atriv) (or (arm-side-effect-free-form-p aform)
    2839                                         (if avar (arm2-var-not-set-by-form-p avar bform)))))
    2840            (apushed (not (or atriv aconst))))
    2841       (progn
    2842         (unless aconst
    2843           (if atriv
    2844             (setq adest (arm2-one-untargeted-reg-form seg aform areg))
    2845             (setq apushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg aform (arm2-acc-reg-for areg))))))
    2846         (setq bdest (arm2-one-untargeted-reg-form seg bform breg))
    2847         (if aconst
    2848           (setq adest (arm2-one-untargeted-reg-form seg aform areg))
    2849           (if apushed
    2850             (arm2-elide-pushes seg apushed (arm2-pop-register seg areg)))))
    2851       (values adest bdest))))
     2863  (let* ((aalready (arm2-reg-for-var aform))
     2864         (balready (arm2-reg-for-var bform)))
     2865    (if (and aalready balready)
     2866      (values aalready balready)
     2867      (with-arm-local-vinsn-macros (seg)
     2868        (let* ((avar (arm2-lexical-reference-p aform))
     2869               (adest areg)
     2870               (bdest breg)
     2871               (atriv (and (arm2-trivial-p bform) (nx2-node-gpr-p breg)))
     2872               (aconst (and (not atriv) (or (arm-side-effect-free-form-p aform)
     2873                                            (if avar (arm2-var-not-set-by-form-p avar bform)))))
     2874               (apushed (not (or atriv aconst))))
     2875          (progn
     2876            (unless aconst
     2877              (if atriv
     2878                (setq adest (arm2-one-untargeted-reg-form seg aform areg))
     2879                (setq apushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg aform (arm2-acc-reg-for areg))))))
     2880            (setq bdest (arm2-one-untargeted-reg-form seg bform breg))
     2881            (if aconst
     2882              (setq adest (arm2-one-untargeted-reg-form seg aform areg))
     2883              (if apushed
     2884                (arm2-elide-pushes seg apushed (arm2-pop-register seg areg)))))
     2885          (values adest bdest))))))
    28522886
    28532887
     
    50765110               (rev-opt (reverse (car opt))))
    50775111          (if (not (or opt rest keys))
    5078             (setq arg-regs (arm2-req-nargs-entry seg rev-fixed))
     5112            (progn
     5113              (setq arg-regs (arm2-req-nargs-entry seg rev-fixed)))
    50795114            (if (and (not (or hardopt rest keys))
    50805115                     (<= num-opt $numarmargregs))
     
    51695204          ;; to worry about.
    51705205
    5171           (when (and nil
    5172                      (not (or opt rest keys))
    5173                      (<= num-fixed $numarmargregs)
    5174                      (not (some #'null arg-regs)))
    5175             (setq *arm2-tail-vsp* *arm2-vstack*
    5176                   *arm2-tail-nargs* num-fixed)
    5177             (@ (setq *arm2-tail-label* (backend-get-next-label))))
     5206
    51785207          (when method-var
    51795208            (arm2-seq-bind-var seg method-var arm::next-method-context))
     
    59966025
    59976026
     6027(defun arm2-generate-casejump (seg vreg xfer ranges trueforms var otherwise)
     6028  (declare (ignorable trueforms var otherwise))
     6029  (with-arm-local-vinsn-macros (seg vreg xfer)
     6030    (unless (arm2-mvpass-p xfer)
     6031      (when ranges
     6032        (let* ((min (caar ranges))
     6033               (max min)
     6034               (count 0)
     6035               (all ()))
     6036          (declare (fixnum min max count))
     6037          (when ; determine min,max, count; punt on duplicate keys
     6038              (dolist (range ranges t)
     6039                (let* ((info (cons (backend-get-next-label) (pop trueforms))))
     6040                  (unless (dolist (val range t)
     6041                            (declare (fixnum val))
     6042                            (when (assoc val all)
     6043                              (return nil))
     6044                            (push (cons val info) all)
     6045                            (if (< val min)
     6046                              (setq min val)
     6047                              (if (> val max)
     6048                                (setq max val)))
     6049                            (incf count))
     6050                    (return nil))))
     6051                (let* ((span (1+ (- max min))))
     6052                  (declare (fixnum span))
     6053                  (when (and (> count 4)
     6054                             (> count (the fixnum (- span (the fixnum (ash span -2))))))
     6055                    (let* ((defaultlabel (backend-get-next-label))
     6056                           (endlabel (backend-get-next-label))
     6057                           (reg ($ arm::arg_z)))
     6058                      (arm2-use-operator (%nx1-operator lexical-reference)
     6059                                         seg reg nil var)
     6060                      (! cjmp reg (ash min arm::fixnumshift) (ash (- max min) arm::fixnumshift)  (aref *backend-labels* defaultlabel))
     6061                      (do* ((val min (1+ val)))
     6062                           ((> val max))
     6063                        (declare (fixnum val))
     6064                        (let* ((info (assoc val all)))
     6065                          (! non-barrier-jump (aref *backend-labels* (if info (cadr info) defaultlabel)))))
     6066                      (let* ((target (arm2-cd-merge xfer endlabel)))
     6067                        (dolist (case (nreverse all))
     6068                          (let* ((lab (cadr case))
     6069                                 (form (cddr case)))
     6070                            (@ lab)
     6071                            (arm2-form seg vreg target form)))
     6072                        (@ defaultlabel)
     6073                        (arm2-form seg vreg target otherwise)
     6074                        (@ endlabel)
     6075                        (when (arm2-mvpass-p xfer)
     6076                          (^))
     6077                        t))))))))))
     6078                       
     6079
    59986080(defarm2 arm2-if if (seg vreg xfer testform true false &aux test-val)
    59996081  (if (setq test-val (nx2-constant-form-value (acode-unwrapped-form-value testform)))
    60006082    (arm2-form seg vreg xfer (if (nx-null test-val) false true))
    6001     (let* ((cstack *arm2-cstack*)
    6002            (vstack *arm2-vstack*)
    6003            (top-lcell *arm2-top-vstack-lcell*)
    6004            (entry-stack (arm2-encode-stack))
    6005            (true-stack nil)
    6006            (false-stack nil)
    6007            (true-cleanup-label nil)
    6008            (same-stack-effects nil)
    6009            (true-is-goto (arm2-go-label true))
    6010            (false-is-goto (and (not true-is-goto) (arm2-go-label false)))
    6011            (endlabel (backend-get-next-label))
    6012            (falselabel (backend-get-next-label))
    6013            (need-else (unless false-is-goto (or (not (nx-null false)) (arm2-for-value-p vreg))))
    6014            (both-single-valued (and (not *arm2-open-code-inline*)
    6015                                     (eq xfer $backend-return)
    6016                                     (arm2-for-value-p vreg)
    6017                                     need-else
    6018                                     (arm2-single-valued-form-p true)
    6019                                     (arm2-single-valued-form-p false)))
    6020            (saved-reg-mask 0)
    6021            (saved-reg-map (make-array 16 :initial-element nil)))
    6022       (declare (dynamic-extent saved-reg-map))
    6023       (if (eq 0 xfer)
    6024         (setq xfer nil))
    6025       (if both-single-valued            ; it's implied that we're returning
    6026         (let* ((result arm::arg_z))
    6027           (let ((merge-else-branch-label (if (nx-null false) (arm2-find-nilret-label))))
    6028             (arm2-conditional-form seg (arm2-make-compound-cd 0 falselabel) testform)
    6029             (arm2-copy-regmap (setq saved-reg-mask *arm2-gpr-locations-valid-mask*)
    6030                               *arm2-gpr-locations*
    6031                               saved-reg-map)
    6032             (arm2-form seg result endlabel true)
    6033             (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
    6034               (backend-copy-label merge-else-branch-label falselabel)
     6083    (multiple-value-bind (ranges trueforms var otherwise)
     6084        #+notyet (nx2-reconstruct-case testform true false)
     6085        #-notyet (values nil nil nil nil)
     6086      (or (arm2-generate-casejump seg vreg xfer ranges trueforms var otherwise)
     6087          (let* ((cstack *arm2-cstack*)
     6088                 (vstack *arm2-vstack*)
     6089                 (top-lcell *arm2-top-vstack-lcell*)
     6090                 (entry-stack (arm2-encode-stack))
     6091                 (true-stack nil)
     6092                 (false-stack nil)
     6093                 (true-cleanup-label nil)
     6094                 (same-stack-effects nil)
     6095                 (true-is-goto (arm2-go-label true))
     6096                 (false-is-goto (and (not true-is-goto) (arm2-go-label false)))
     6097                 (endlabel (backend-get-next-label))
     6098                 (falselabel (backend-get-next-label))
     6099                 (need-else (unless false-is-goto (or (not (nx-null false)) (arm2-for-value-p vreg))))
     6100                 (both-single-valued (and (not *arm2-open-code-inline*)
     6101                                          (eq xfer $backend-return)
     6102                                          (arm2-for-value-p vreg)
     6103                                          need-else
     6104                                          (arm2-single-valued-form-p true)
     6105                                          (arm2-single-valued-form-p false)))
     6106                 (saved-reg-mask 0)
     6107                 (saved-reg-map (make-array 16 :initial-element nil)))
     6108            (declare (dynamic-extent saved-reg-map))
     6109            (if (eq 0 xfer)
     6110              (setq xfer nil))
     6111            (if both-single-valued      ; it's implied that we're returning
     6112              (let* ((result arm::arg_z))
     6113                (let ((merge-else-branch-label (if (nx-null false) (arm2-find-nilret-label))))
     6114                  (arm2-conditional-form seg (arm2-make-compound-cd 0 falselabel) testform)
     6115                  (arm2-copy-regmap (setq saved-reg-mask *arm2-gpr-locations-valid-mask*)
     6116                                    *arm2-gpr-locations*
     6117                                    saved-reg-map)
     6118                  (arm2-form seg result endlabel true)
     6119                  (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
     6120                    (backend-copy-label merge-else-branch-label falselabel)
     6121                    (progn
     6122                      (@ falselabel)
     6123                      (arm2-predicate-block falselabel)
     6124                      (if (nx-null false) (@ (arm2-record-nilret-label)))
     6125                      (let* ((*arm2-gpr-locations-valid-mask* saved-reg-mask)
     6126                             (*arm2-gpr-locations* saved-reg-map))
     6127                        (arm2-form seg result nil false))))
     6128                  (@ endlabel)
     6129                  (arm2-predicate-block endlabel)
     6130                  (<- result)
     6131                  (^)))
    60356132              (progn
    6036                 (@ falselabel)
    6037                 (arm2-predicate-block falselabel)
    6038                 (if (nx-null false) (@ (arm2-record-nilret-label)))
    6039                 (let* ((*arm2-gpr-locations-valid-mask* saved-reg-mask)
    6040                        (*arm2-gpr-locations* saved-reg-map))
    6041                   (arm2-form seg result nil false))))
    6042             (@ endlabel)
    6043             (arm2-predicate-block endlabel)
    6044             (<- result)
    6045             (^)))
    6046         (progn
    6047           (if (and need-else (arm2-mvpass-p xfer))
    6048             (setq true-cleanup-label (backend-get-next-label)))         
    6049           (arm2-conditional-form
    6050            seg
    6051            (arm2-make-compound-cd
    6052             (or true-is-goto 0)
    6053             (or false-is-goto
    6054                 (if need-else
    6055                   (if true-is-goto 0 falselabel)
    6056                   (if true-is-goto xfer (arm2-cd-merge xfer falselabel)))))
    6057            testform)
    6058           (arm2-copy-regmap (setq saved-reg-mask *arm2-gpr-locations-valid-mask*)
    6059                             *arm2-gpr-locations*
    6060                             saved-reg-map)
    6061           (if true-is-goto
    6062             (arm2-unreachable-store)
    6063             (if true-cleanup-label
    6064               (progn
    6065                 (arm2-open-undo $undomvexpect)
    6066                 (arm2-form seg vreg (logior $backend-mvpass-mask true-cleanup-label) true))
    6067               (arm2-form seg vreg (if need-else (arm2-cd-merge xfer endlabel) xfer) true)))
    6068           (setq true-stack (arm2-encode-stack))
    6069           (setq *arm2-cstack* cstack)
    6070           (arm2-set-vstack vstack)
    6071           (setq *arm2-top-vstack-lcell* top-lcell)
    6072           (if false-is-goto (arm2-unreachable-store))
    6073           (let ((merge-else-branch-label (if (and (nx-null false) (eq xfer $backend-return)) (arm2-find-nilret-label))))
    6074             (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
    6075               (backend-copy-label merge-else-branch-label falselabel)
    6076               (progn
    6077                 (@ falselabel)
    6078                 (arm2-predicate-block falselabel)
    6079                 (when need-else
     6133                (if (and need-else (arm2-mvpass-p xfer))
     6134                  (setq true-cleanup-label (backend-get-next-label)))         
     6135                (arm2-conditional-form
     6136                 seg
     6137                 (arm2-make-compound-cd
     6138                  (or true-is-goto 0)
     6139                  (or false-is-goto
     6140                      (if need-else
     6141                        (if true-is-goto 0 falselabel)
     6142                        (if true-is-goto xfer (arm2-cd-merge xfer falselabel)))))
     6143                 testform)
     6144                (arm2-copy-regmap (setq saved-reg-mask *arm2-gpr-locations-valid-mask*)
     6145                                  *arm2-gpr-locations*
     6146                                  saved-reg-map)
     6147                (if true-is-goto
     6148                  (arm2-unreachable-store)
    60806149                  (if true-cleanup-label
    6081                     (arm2-mvpass seg false)
    6082                     (let* ((*arm2-gpr-locations-valid-mask* saved-reg-mask)
    6083                            (*arm2-gpr-locations* saved-reg-map))
    6084                       (arm2-form seg vreg xfer false)))
    6085                   (setq false-stack (arm2-encode-stack))))))
    6086           (when true-cleanup-label
    6087             (if (setq same-stack-effects (arm2-equal-encodings-p true-stack false-stack)) ; can share cleanup code
    6088               (@ true-cleanup-label))
    6089             (let* ((*arm2-returning-values* :pass))
    6090               (arm2-nlexit seg xfer 1)
    6091               (arm2-branch seg (if (and xfer (neq xfer $backend-mvpass-mask)) xfer (if (not same-stack-effects) endlabel)) vreg))
    6092             (unless same-stack-effects
    6093               (@ true-cleanup-label)
    6094               (multiple-value-setq (true *arm2-cstack* *arm2-vstack* *arm2-top-vstack-lcell*)
    6095                 (arm2-decode-stack true-stack))
    6096               (let* ((*arm2-returning-values* :pass))
    6097                 (arm2-nlexit seg xfer 1)
    6098                 (^)))
    6099             (arm2-close-undo)
    6100             (multiple-value-setq (*arm2-undo-count* *arm2-cstack* *arm2-vstack* *arm2-top-vstack-lcell*)
    6101               (arm2-decode-stack entry-stack)))
    6102           (@ endlabel)
    6103           (arm2-predicate-block endlabel))))))
     6150                    (progn
     6151                      (arm2-open-undo $undomvexpect)
     6152                      (arm2-form seg vreg (logior $backend-mvpass-mask true-cleanup-label) true))
     6153                    (arm2-form seg vreg (if need-else (arm2-cd-merge xfer endlabel) xfer) true)))
     6154                (setq true-stack (arm2-encode-stack))
     6155                (setq *arm2-cstack* cstack)
     6156                (arm2-set-vstack vstack)
     6157                (setq *arm2-top-vstack-lcell* top-lcell)
     6158                (if false-is-goto (arm2-unreachable-store))
     6159                (let ((merge-else-branch-label (if (and (nx-null false) (eq xfer $backend-return)) (arm2-find-nilret-label))))
     6160                  (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
     6161                    (backend-copy-label merge-else-branch-label falselabel)
     6162                    (progn
     6163                      (@ falselabel)
     6164                      (arm2-predicate-block falselabel)
     6165                      (when need-else
     6166                        (if true-cleanup-label
     6167                          (arm2-mvpass seg false)
     6168                          (let* ((*arm2-gpr-locations-valid-mask* saved-reg-mask)
     6169                                 (*arm2-gpr-locations* saved-reg-map))
     6170                            (arm2-form seg vreg xfer false)))
     6171                        (setq false-stack (arm2-encode-stack))))))
     6172                (when true-cleanup-label
     6173                  (if (setq same-stack-effects (arm2-equal-encodings-p true-stack false-stack)) ; can share cleanup code
     6174                    (@ true-cleanup-label))
     6175                  (let* ((*arm2-returning-values* :pass))
     6176                    (arm2-nlexit seg xfer 1)
     6177                    (arm2-branch seg (if (and xfer (neq xfer $backend-mvpass-mask)) xfer (if (not same-stack-effects) endlabel)) vreg))
     6178                  (unless same-stack-effects
     6179                    (@ true-cleanup-label)
     6180                    (multiple-value-setq (true *arm2-cstack* *arm2-vstack* *arm2-top-vstack-lcell*)
     6181                      (arm2-decode-stack true-stack))
     6182                    (let* ((*arm2-returning-values* :pass))
     6183                      (arm2-nlexit seg xfer 1)
     6184                      (^)))
     6185                  (arm2-close-undo)
     6186                  (multiple-value-setq (*arm2-undo-count* *arm2-cstack* *arm2-vstack* *arm2-top-vstack-lcell*)
     6187                    (arm2-decode-stack entry-stack)))
     6188                (@ endlabel)
     6189                (arm2-predicate-block endlabel))))))))
    61046190
    61056191(defarm2 arm2-or or (seg vreg xfer forms)
     
    64486534               (if other
    64496535                 (let* ((constant (ash (or fix1 fix2) *arm2-target-fixnum-shift*))
    6450                         (reg (arm2-one-untargeted-reg-form seg other arm::arg_z)))
     6536                        (reg (arm2-one-untargeted-reg-form seg other (if (and vreg (node-reg-p vreg)) vreg arm::arg_z))))
    64516537                   (if (zerop constant)
    64526538                     (<- reg)
Note: See TracChangeset for help on using the changeset viewer.