Changeset 14909


Ignore:
Timestamp:
Jul 27, 2011, 8:58:12 PM (8 years ago)
Author:
gb
Message:

Back out of r14899 (ARM backend changes): at least one of those changes
is bogus. Some of those changes would be worthwhile if they were correct;
I'll try to isolate and fix the problems.

Although the commit message neglected to mention it, in r14897 the assembler
stopped allowing arbitrary symbols when it really wanted to use keywords,
on the assumption that "we always used keywords anyhow". That wasn't quite
true; change arm-vinsns, arm-lapmacros, and a few level-0 sources to ensure
that it is. (I don't think that we were keywordizing at runtime when
compiling lisp code, so the change had minimal effect on anything but
arguable aesthetics.)

Location:
trunk/source
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/ARM/arm-lapmacros.lisp

    r14764 r14909  
    2424(defarmlapmacro set-nargs (n)
    2525  (check-type n (unsigned-byte 8))
    26   `(mov nargs ($ (ash ,n arm::fixnumshift))))
     26  `(mov nargs (:$ (ash ,n arm::fixnumshift))))
    2727
    2828(defarmlapmacro check-nargs (min &optional (max min))
     
    4444        (if (= min 0)
    4545          `(progn
    46             (cmp nargs ($ (ash ,max arm::fixnumshift)))
     46            (cmp nargs (:$ (ash ,max arm::fixnumshift)))
    4747            (bls ,ok1)
    4848            (uuo-error-wrong-nargs (:? hi))
    4949            ,ok1)
    5050          `(progn
    51             (cmp nargs ($ (ash ,min arm::fixnumshift)))
     51            (cmp nargs (:$ (ash ,min arm::fixnumshift)))
    5252            (bhs ,ok1)
    5353            (uuo-error-wrong-nargs (:? lo))
    5454            ,ok1
    55             (cmp nargs ($ (ash ,max arm::fixnumshift)))
     55            (cmp nargs (:$ (ash ,max arm::fixnumshift)))
    5656            (bls ,ok2)
    5757            (uuo-error-wrong-nargs (:? hi))
     
    7272(defarmlapmacro build-lisp-frame (&optional (marker-reg 'imm0) (vsp 'vsp))
    7373  `(progn
    74     (mov ,marker-reg ($ arm::lisp-frame-marker))
     74    (mov ,marker-reg (:$ arm::lisp-frame-marker))
    7575    (stmdb (:! sp) (,marker-reg ,vsp fn lr))))
    7676
  • trunk/source/compiler/ARM/arm-vinsns.lisp

    r14898 r14909  
    12871287     ((src :lisp))
    12881288     ((imm :s32)))
    1289   (fmrx imm fpscr)
     1289  (fmrx imm :fpscr)
    12901290  (bic imm imm (:$ #xff))
    1291   (fmxr fpscr imm)
     1291  (fmxr :fpscr imm)
    12921292  (mov imm (:asr src (:$ arm::fixnumshift)))
    12931293  (fmsr dest imm)
     
    15211521      (y :double-float))
    15221522     ((imm :u32)))
    1523   (fmrx imm fpscr)
     1523  (fmrx imm :fpscr)
    15241524  (bic imm imm (:$ #xff))
    1525   (fmxr fpscr imm)
     1525  (fmxr :fpscr imm)
    15261526  (faddd result x y)
    15271527  (bla .SPcheck-fpu-exception))
     
    15381538      (y :double-float))
    15391539     ((imm :u32)))
    1540   (fmrx imm fpscr)
     1540  (fmrx imm :fpscr)
    15411541  (bic imm imm (:$ #xff))
    1542   (fmxr fpscr imm)
     1542  (fmxr :fpscr imm)
    15431543  (fsubd result x y)
    15441544  (bla .SPcheck-fpu-exception))
     
    15551555      (y :double-float))
    15561556     ((imm :u32)))
    1557   (fmrx imm fpscr)
     1557  (fmrx imm :fpscr)
    15581558  (bic imm imm (:$ #xff))
    1559   (fmxr fpscr imm)
     1559  (fmxr :fpscr imm)
    15601560  (fmuld result x y)
    15611561  (bla .SPcheck-fpu-exception))
     
    15721572      (y :double-float))
    15731573     ((imm :u32)))
    1574   (fmrx imm fpscr)
     1574  (fmrx imm :fpscr)
    15751575  (bic imm imm (:$ #xff))
    1576   (fmxr fpscr imm)
     1576  (fmxr :fpscr imm)
    15771577  (fdivd result x y)
    15781578  (bla .SPcheck-fpu-exception))
     
    16031603      (y :single-float))
    16041604     ((imm :u32)))
    1605   (fmrx imm fpscr)
     1605  (fmrx imm :fpscr)
    16061606  (bic imm imm (:$ #xff))
    1607   (fmxr fpscr imm)
     1607  (fmxr :fpscr imm)
    16081608  (fadds result x y)
    16091609  (bla .SPcheck-fpu-exception))
     
    16201620      (y :single-float))
    16211621     ((imm :u32)))
    1622   (fmrx imm fpscr)
     1622  (fmrx imm :fpscr)
    16231623  (bic imm imm (:$ #xff))
    1624   (fmxr fpscr imm)
     1624  (fmxr :fpscr imm)
    16251625  (fsubs result x y)
    16261626  (bla .SPcheck-fpu-exception))
     
    16371637      (y :single-float))
    16381638     ((imm :u32)))
    1639   (fmrx imm fpscr)
     1639  (fmrx imm :fpscr)
    16401640  (bic imm imm (:$ #xff))
    1641   (fmxr fpscr imm)
     1641  (fmxr :fpscr imm)
    16421642  (fmuls result x y)
    16431643  (bla .SPcheck-fpu-exception))
     
    16541654      (y :single-float))
    16551655     ((imm :u32)))
    1656   (fmrx imm fpscr)
     1656  (fmrx imm :fpscr)
    16571657  (bic imm imm (:$ #xff))
    1658   (fmxr fpscr imm)
     1658  (fmxr :fpscr imm)
    16591659  (fdivs result x y)
    16601660  (bla .SPcheck-fpu-exception))
     
    25112511     ((arg :double-float))
    25122512     ((imm :u32)))
    2513   (fmrx imm fpscr)
     2513  (fmrx imm :fpscr)
    25142514  (bic imm imm (:$ #xff))
    2515   (fmxr fpscr imm)
     2515  (fmxr :fpscr imm)
    25162516  (fcvtsd result arg)
    25172517  (bla .SPcheck-fpu-exception))
  • trunk/source/compiler/ARM/arm2.lisp

    r14899 r14909  
    151151
    152152(defvar *arm2-entry-label* nil)
    153 (defvar *arm2-fixed-args-label* nil)
    154 (defvar *arm2-fixed-args-tail-label* nil)
    155 (defvar *arm2-fixed-nargs* nil)
     153(defvar *arm2-tail-label* nil)
     154(defvar *arm2-tail-vsp* nil)
     155(defvar *arm2-tail-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)
    162163(defvar *arm2-need-nargs* t)
    163164
     
    399400           (*backend-immediates* (arm2-make-stack 64  target::subtag-simple-vector))
    400401           (*arm2-entry-label* nil)
    401            (*arm2-fixed-args-label* nil)
    402            (*arm2-fixed-args-tail-label*)
    403            (*arm2-fixed-nargs* nil)
     402           (*arm2-tail-label* nil)
     403           (*arm2-tail-vsp* nil)
     404           (*arm2-tail-nargs* nil)
    404405           (*arm2-inhibit-register-allocation* nil)
    405406           (*arm2-tail-allow* t)
     
    409410           (*arm2-trust-declarations* t)
    410411           (*arm2-entry-vstack* nil)
     412           (*arm2-fixed-nargs* nil)
    411413           (*arm2-need-nargs* t)
    412414           (fname (afunc-name afunc))
     
    851853           (reg-vars ()))
    852854      (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)))))
    862855      (if (<= nargs $numarmargregs)       ; caller didn't vpush anything
    863856        (! save-lisp-context-vsp)
     
    865858          (declare (fixnum offset))
    866859          (! save-lisp-context-offset offset)))
    867       (when *arm2-fixed-args-label*
    868         (@ (setq *arm2-fixed-args-tail-label* (backend-get-next-label))))
    869860      (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
    870861        (declare (ignore xvar yvar))
     
    11741165 
    11751166
    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          
     1167
    11921168
    11931169(defun arm2-stack-to-register (seg memspec reg)
     
    23932369           (callable (or symp lfunp label-p))
    23942370           (destreg (if symp ($ arm::fname) (if lfunp ($ arm::nfn) (unless label-p ($ arm::nfn)))))
    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))))
     2371           (alternate-tail-call
     2372            (and tail-p label-p *arm2-tail-label* (eql nargs *arm2-tail-nargs*) (not spread-p)))
     2373           )
    24062374      (when expression-p
    24072375        ;;Have to do this before spread args, since might be vsp-relative.
     
    24252393            (! spread-list)))
    24262394        (if nargs
    2427           (unless known-fixed-nargs (arm2-set-nargs seg nargs))
     2395          (unless alternate-tail-call (arm2-set-nargs seg nargs))
    24282396          (! pop-argument-registers)))
    24292397      (if callable
     
    24432411                (progn
    24442412                  (arm2-copy-register seg ($ arm::nfn) ($  arm::fn))
    2445                   (! call-label (aref *backend-labels* label)))
     2413                  (! call-label (aref *backend-labels* 1)))
    24462414                (progn
    24472415                  (if a-reg
     
    24512419                    (arm2-call-symbol seg nil)
    24522420                    (! call-known-function))))))
    2453           (progn
     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
    24542426              (arm2-unwind-stack seg xfer 0 0 #x7fffff)
    24552427              (if (and (not spread-p) nargs (%i<= nargs $numarmargregs))
     
    24582430                    (arm2-copy-register seg arm::nfn arm::fn))
    24592431                  (unless (or label-p a-reg) (arm2-store-immediate seg func destreg))
    2460                   (unless known-fixed-nargs
    2461                     (arm2-restore-full-lisp-context seg))
     2432                  (arm2-restore-full-lisp-context seg)
    24622433                  (if label-p
    2463                     (! jump (aref *backend-labels* label))
     2434                    (! jump (aref *backend-labels* 1))
    24642435                    (progn
    24652436                      (if symp
     
    24822453                         (if symp
    24832454                           (! jump-known-symbol)
    2484                            (! jump-known-function))))))))
     2455                           (! jump-known-function)))))))))
    24852456        ;; The general (funcall) case: we don't know (at compile-time)
    24862457        ;; for sure whether we've got a symbol or a (local, constant)
     
    27262697
    27272698(defun arm2-one-untargeted-reg-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))))))
     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)))))
    27502720             
    27512721
     
    28612831
    28622832(defun arm2-two-untargeted-reg-forms (seg aform areg bform breg)
    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))))))
     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))))
    28862852
    28872853
     
    51105076               (rev-opt (reverse (car opt))))
    51115077          (if (not (or opt rest keys))
    5112             (progn
    5113               (setq arg-regs (arm2-req-nargs-entry seg rev-fixed)))
     5078            (setq arg-regs (arm2-req-nargs-entry seg rev-fixed))
    51145079            (if (and (not (or hardopt rest keys))
    51155080                     (<= num-opt $numarmargregs))
     
    52045169          ;; to worry about.
    52055170
    5206 
     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))))
    52075178          (when method-var
    52085179            (arm2-seq-bind-var seg method-var arm::next-method-context))
     
    60255996
    60265997
    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 
    60805998(defarm2 arm2-if if (seg vreg xfer testform true false &aux test-val)
    60815999  (if (setq test-val (nx2-constant-form-value (acode-unwrapped-form-value testform)))
    60826000    (arm2-form seg vreg xfer (if (nx-null test-val) false true))
    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                   (^)))
     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)
    61326035              (progn
    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)
     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
    61496080                  (if true-cleanup-label
    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))))))))
     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))))))
    61906104
    61916105(defarm2 arm2-or or (seg vreg xfer forms)
     
    65346448               (if other
    65356449                 (let* ((constant (ash (or fix1 fix2) *arm2-target-fixnum-shift*))
    6536                         (reg (arm2-one-untargeted-reg-form seg other (if (and vreg (node-reg-p vreg)) vreg arm::arg_z))))
     6450                        (reg (arm2-one-untargeted-reg-form seg other arm::arg_z)))
    65376451                   (if (zerop constant)
    65386452                     (<- reg)
  • trunk/source/level-0/ARM/arm-def.lisp

    r14886 r14909  
    113113  @ok2
    114114  (bne @one)
    115   (cmp imm1 ($ 0))
     115  (cmp imm1 (:$ 0))
    116116  (beq @store)
    117117  (uuo-error-reg-not-xtype new-value (:$ arm::xtype-u32))
    118118  @one
    119   (cmp imm2 ($ 0))
     119  (cmp imm2 (:$ 0))
    120120  (bge @store)
    121121  (uuo-error-reg-not-xtype new-value (:$ arm::xtype-u32))
  • trunk/source/level-0/ARM/arm-float.lisp

    r14119 r14909  
    270270(defarmlapfunction %ffi-exception-status ()
    271271  (ldr imm1 (:@ rcontext (:$ arm::tcr.lisp-fpscr)))
    272   (fmrx imm2 fpscr)
     272  (fmrx imm2 :fpscr)
    273273  (and imm0 imm2 (:$ #xff))
    274274  (ands imm0 imm0 (:lsr imm1 (:$ 8)))
     
    277277  (mov arg_z (:lsl imm0 (:$ arm::fixnumshift)))
    278278  (bic imm0 imm2 (:$ #xff))
    279   (fmxr fpscr imm0)
     279  (fmxr :fpscr imm0)
    280280  (bx lr))
    281281
     
    517517(defarmlapfunction %double-float-sign ((n arg_z))
    518518  (ldr imm0 (:@ n (:$ arm::double-float.val-high)))
    519   (cmp imm0 ($ 0))
     519  (cmp imm0 (:$ 0))
    520520  (mov arg_z 'nil)
    521521  (addlt arg_z arg_z (:$ arm::t-offset))
     
    524524(defarmlapfunction %short-float-sign ((n arg_z))
    525525  (ldr imm0 (:@ n (:$ arm::single-float.value)))
    526   (cmp imm0 ($ 0))
     526  (cmp imm0 (:$ 0))
    527527  (mov arg_z 'nil)
    528528  (addlt arg_z arg_z (:$ arm::t-offset))
     
    532532  (build-lisp-frame)
    533533  (get-single-float s0 src imm0)
    534   (fmrx imm0 fpscr)
     534  (fmrx imm0 :fpscr)
    535535  (bic imm0 imm0 (:$ #xff))
    536   (fmxr fpscr imm0)
     536  (fmxr :fpscr imm0)
    537537  (fsqrts s1 s0)
    538538  (bla .SPcheck-fpu-exception)
     
    545545  (build-lisp-frame)
    546546  (get-double-float d0 src)
    547   (fmrx imm0 fpscr)
     547  (fmrx imm0 :fpscr)
    548548  (bic imm0 imm0 (:$ #xff))
    549   (fmxr fpscr imm0)
     549  (fmxr :fpscr imm0)
    550550  (fsqrtd d1 d0)
    551551  (bla .SPcheck-fpu-exception)
  • trunk/source/level-0/ARM/arm-io.lisp

    r14119 r14909  
    2222
    2323(defarmlapfunction %get-errno ()
    24   (mov temp0 ($ 0))
     24  (mov temp0 (:$ 0))
    2525  (ldr imm1 (:@ rcontext (:$ arm::tcr.errno-loc)))
    2626  (ldr imm0 (:@ imm1 (:$ 0)))
  • trunk/source/level-0/ARM/arm-misc.lisp

    r14708 r14909  
    330330  (ldrne  imm0 (:@ temp0 (:$ arm::area.active)))
    331331  (cmp imm1 imm0)
    332   (mov imm0 ($ 0))
     332  (mov imm0 (:$ 0))
    333333  (push1 imm0 imm1)
    334334  (streq imm1 (:@ temp0 (:$ arm::area.active)))
     
    395395  (add imm1 imm0 (:$ (arm::kernel-global gc-inhibit-count)))
    396396  @again
    397   (mov arg_x ($ 0))
     397  (mov arg_x (:$ 0))
    398398  (ldrex arg_y (:@ imm1))
    399399  (cmp arg_y '-1)
     
    402402  (addle arg_z arg_y '1)
    403403  (strex imm0 arg_z (:@ imm1))
    404   (cmp imm0 ($ 0))
     404  (cmp imm0 (:$ 0))
    405405  (bne @again)
    406406  (cmp arg_x '0)
  • trunk/source/level-0/ARM/arm-pred.lisp

    r14119 r14909  
    6161  @win
    6262  (mov arg_z 'nil)
    63   (add arg_z arg_z ($ arm::t-offset))
     63  (add arg_z arg_z (:$ arm::t-offset))
    6464  (bx lr)
    6565  @macptr
Note: See TracChangeset for help on using the changeset viewer.