Changeset 16195


Ignore:
Timestamp:
Sep 11, 2014, 6:36:42 AM (7 years ago)
Author:
gb
Message:

Work-in-progress.

Location:
branches/pinsn/source
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • branches/pinsn/source/compiler/ARM/arm-backend.lisp

    r15849 r16195  
    3535;;; This defines a template.  All expressions in the body must be
    3636;;; evaluable at macroexpansion time.
    37 (defun %define-arm-vinsn (backend vinsn-name results args temps body)
     37(defun %define-arm-vinsn (backend name&attr results args temps body)
    3838  (let* ((arch-name (backend-target-arch-name backend))
    3939         (template-hash (backend-p2-template-hash-name backend))
    40          (name-list ())
    41          (attrs 0)
    42          (nhybrids 0)
    4340         (local-labels ())
    4441         (referenced-labels ())
    4542         (source-indicator (form-symbol arch-name "-VINSN"))
    46          (opcode-alist ()))
    47     (flet ((valid-spec-name (x)
    48              (or (and (consp x)
    49                       (consp (cdr x))
    50                       (null (cddr x))
    51                       (atom (car x))
    52                       (or (assoc (cadr x) *vreg-specifier-constant-constraints* :test #'eq)
    53                           (assoc (cadr x) *spec-class-storage-class-alist* :test #'eq)
    54                           (eq (cadr x) :label)
    55                           (and (consp (cadr x))
    56                                (or
    57                                 (assoc (caadr x) *vreg-specifier-constant-constraints* :test #'eq)
    58                                 (assoc (caadr x) *spec-class-storage-class-alist* :test #'eq))))
    59                       (car x))
    60                  (error "Invalid vreg spec: ~s" x)))
    61            (add-spec-name (vname)
    62              (if (member vname name-list :test #'eq)
    63                (error "Duplicate name ~s in vinsn ~s" vname vinsn-name)
    64                (push vname name-list))))
    65       (declare (dynamic-extent #'valid-spec-name #'add-spec-name))
    66       (when (consp vinsn-name)
    67         (setq attrs (encode-vinsn-attributes (cdr vinsn-name))
    68               vinsn-name (car vinsn-name)))
    69       (unless (and (symbolp vinsn-name) (eq *CCL-PACKAGE* (symbol-package vinsn-name)))
    70         (setq vinsn-name (intern (string vinsn-name) *CCL-PACKAGE*)))
    71       (dolist (n (append args temps))
    72         (add-spec-name (valid-spec-name n)))
    73       #+no
    74       (dolist (form body)
    75         (if (atom form)
    76           (add-spec-name form)))
    77       (setq name-list (nreverse name-list))
    78       ;; We now know that "args" is an alist; we don't know if
    79       ;; "results" is.  First, make sure that there are no duplicate
    80       ;; result names (and validate "results".)
    81       (do* ((res results tail)
    82             (tail (cdr res) (cdr tail)))
    83            ((null res))
    84         (let* ((name (valid-spec-name (car res))))
    85           (if (assoc name tail :test #'eq)
    86             (error "Duplicate result name ~s in ~s." name results))))
    87       (let* ((non-hybrid-results ())
    88              (match-args args))
    89         (dolist (res results)
    90           (let* ((res-name (car res)))
    91             (if (not (assoc res-name args :test #'eq))
    92               (if (not (= nhybrids 0))
    93                 (error "result ~s should also name an argument. " res-name)
    94                 (push res-name non-hybrid-results))
    95               (if (eq res-name (caar match-args))
    96                 (setf nhybrids (1+ nhybrids)
    97                       match-args (cdr match-args))
    98                 (error "~S - hybrid results should appear in same order as arguments." res-name)))))
    99         (dolist (name non-hybrid-results)
    100           (add-spec-name name)))
    101       (let* ((k -1))
    102         (declare (fixnum k))
    103         (let* ((name-alist (mapcar #'(lambda (n) (cons n (list (incf k)))) name-list)))
    104           (flet ((find-name (n)
    105                    (let* ((pair (assoc n name-alist :test #'eq)))
    106                      (declare (list pair))
    107                      (if pair
    108                        (cdr pair)
    109                        (or (arm::arm-subprimitive-offset n)
    110                            (error "Unknown name ~s" n))))))
    111             (labels ((simplify-operand (op)
    112                        (if (atom op)
    113                          (if (typep op 'fixnum)
    114                            op
    115                            (if (constantp op)
    116                              (progn
    117                                (if (keywordp op)
    118                                  (pushnew op referenced-labels))
    119                                (eval op))
    120                              (find-name op)))
    121                          (if (eq (car op) :apply)
    122                            `(,(cadr op) ,@(mapcar #'simplify-operand (cddr op)))
    123                            (simplify-operand (eval op)))))) ; Handler-case this?         
    124               (labels ((simplify-constraint (guard)
    125                          ;; A constraint is one of
    126 
    127                          ;; (:eq|:lt|:gt vreg-name constant)
    128 
    129                          ;; value" of vreg relop constant
    130 
    131                          ;; (:pred <function-name> <operand>* ;
    132                          ;; <function-name> unquoted, each <operand>
    133                          ;; is a vreg-name or constant expression.
    134 
    135                          ;; (:type vreg-name typeval) ; vreg is of
    136                          ;; "type" typeval
    137                          ;;
    138                          ;;(:not <constraint>) ; constraint is false
    139                          ;; (:and <constraint> ...)        ;  conjuntion
    140                          ;; (:or <constraint> ...)         ;  disjunction
    141                          ;; There's no "else"; we'll see how ugly it
    142                          ;; is without one.
    143                          (destructuring-bind (guardname &rest others) guard
    144                            (ecase guardname
    145                              (:not
    146                               (destructuring-bind (negation) others
    147                                 `(:not ,(simplify-constraint negation))))
    148                              (:pred
    149                               (destructuring-bind (predicate &rest operands) others
    150                                 `(:pred ,predicate ,@(mapcar #'simplify-operand operands))))
    151                              ((:eq :lt :gt :type)
    152                               (destructuring-bind (vreg constant) others
    153                                 (unless (constantp constant)
    154                                   (error "~S : not constant in constraint ~s ." constant guard))
    155                                 `(,guardname ,(find-name vreg) ,(eval constant))))
    156                              ((:or :and)
    157                               (unless others (error "Missing constraint list in ~s ." guard))
    158                               `(,guardname ,(mapcar #'simplify-constraint others))))))
    159                        (simplify-form (form)
    160                          (if (atom form)
    161                            (progn
    162                              (if (keywordp form) (push form local-labels) )
    163                              form)
    164                            (destructuring-bind (&whole w opname &rest opvals) form
    165                              (if (consp opname) ; A constraint, we presume ...
    166                                (cons (simplify-constraint opname)
    167                                      (mapcar #'simplify-form opvals))
    168                                (if (keywordp opname)
    169                                  (ecase opname
    170                                    ((:code :data :lock-constant-pool :unlock-constant-pool)  form)
    171                                    (:word (destructuring-bind (val) opvals
    172                                             (list opname
    173                                                   (let* ((p (position val name-list)))
    174                                                     (if p (list p) (eval val)))))))
    175                                  (arm::vinsn-simplify-instruction form name-list)))))))
    176                 (let* ((template (make-vinsn-template
    177                                   :name vinsn-name
    178                                   :result-vreg-specs results
    179                                   :argument-vreg-specs args
    180                                   :temp-vreg-specs temps
    181                                   :nhybrids nhybrids
    182                                   :results&args (append results (nthcdr nhybrids args))
    183                                   :nvp (- (+ (length results) (length args) (length temps))
    184                                           nhybrids)
    185                                   :body (prog1 (mapcar #'simplify-form body)
    186                                           (dolist (ref referenced-labels)
    187                                             (unless (memq ref local-labels)
    188                                               (error
    189                                                "local label ~S was referenced but never defined in VINSN-TEMPLATE definition for ~s" ref vinsn-name))))
    190                                   :local-labels local-labels :attributes attrs :opcode-alist
    191                                   opcode-alist)))
    192                   `(progn (set-vinsn-template ',vinsn-name ,template
    193                            ,template-hash) (record-source-file ',vinsn-name ',source-indicator)
    194                     ',vinsn-name))))))))))
     43         (template (%define-pinsn-template name&attr results args temps))
     44         (pinsn-name (pinsn-template-name template))
     45         (value-names (pinsn-template-names template)))
     46      (unless (and (symbolp pinsn-name) (eq *CCL-PACKAGE* (symbol-package pinsn-name)))
     47        (setq pinsn-name (intern (string pinsn-name) *CCL-PACKAGE*)))
     48
     49      (flet ((find-name (n)
     50         (let* ((p (position n value-names :test #'eq)))
     51           (if p
     52             (list p)
     53             (or (arm::arm-subprimitive-offset n)
     54                 (error "Unknown name ~s" n))))))
     55        (labels ((simplify-operand (op)
     56                   (if (atom op)
     57                     (if (typep op 'fixnum)
     58                       op
     59                       (if (constantp op)
     60                         (progn
     61                           (if (keywordp op)
     62                             (pushnew op referenced-labels))
     63                           (eval op))
     64                         (find-name op)))
     65                     (if (eq (car op) :apply)
     66                       `(,(cadr op) ,@(mapcar #'simplify-operand (cddr op)))
     67                       (simplify-operand (eval op))))) ; Handler-case this?         
     68                 (simplify-constraint (guard)
     69                   ;; A constraint is one of
     70                   
     71                   ;; (:eq|:lt|:gt vreg-name constant)
     72                   
     73                   ;; value" of vreg relop constant
     74                   
     75                   ;; (:pred <function-name> <operand>* ;
     76                   ;; <function-name> unquoted, each <operand>
     77                   ;; is a vreg-name or constant expression.
     78                   
     79                   ;; (:type vreg-name typeval) ; vreg is of
     80                   ;; "type" typeval
     81                   ;;
     82                   ;;(:not <constraint>) ; constraint is false
     83                   ;; (:and <constraint> ...)        ;  conjuntion
     84                   ;; (:or <constraint> ...)         ;  disjunction
     85                   ;; There's no "else"; we'll see how ugly it
     86                   ;; is without one.
     87                   (destructuring-bind (guardname &rest others) guard
     88                     (ecase guardname
     89                       (:not
     90                        (destructuring-bind (negation) others
     91                          `(:not ,(simplify-constraint negation))))
     92                       (:pred
     93                        (destructuring-bind (predicate &rest operands) others
     94                          `(:pred ,predicate ,@(mapcar #'simplify-operand operands))))
     95                       ((:eq :lt :gt :type)
     96                        (destructuring-bind (vreg constant) others
     97                          (unless (constantp constant)
     98                            (error "~S : not constant in constraint ~s ." constant guard))
     99                          `(,guardname ,(find-name vreg) ,(eval constant))))
     100                       ((:or :and)
     101                        (unless others (error "Missing constraint list in ~s ." guard))
     102                        `(,guardname ,(mapcar #'simplify-constraint others))))))
     103                 (simplify-form (form)
     104                   (if (atom form)
     105                     (progn
     106                       (if (keywordp form) (push form local-labels) )
     107                       form)
     108                     (destructuring-bind (&whole w opname &rest opvals) form
     109                       (if (consp opname) ; A constraint, we presume ...
     110                         (cons (simplify-constraint opname)
     111                               (mapcar #'simplify-form opvals))
     112                         (if (keywordp opname)
     113                           (ecase opname
     114                             ((:code :data :lock-constant-pool :unlock-constant-pool)  form)
     115                             (:word (destructuring-bind (val) opvals
     116                                      (list opname
     117                                            (let* ((p (position val value-names)))
     118                                              (if p (list p) (eval val)))))))
     119                           (arm::vinsn-simplify-instruction form value-names)))))))
     120          (setf (pinsn-template-body template)
     121                (mapcar #'simplify-form body)
     122                (pinsn-template-local-labels template)
     123                local-labels)
     124         
     125          (dolist (ref referenced-labels)
     126            (unless (memq ref local-labels)
     127              (error
     128               "local label ~S was referenced but never defined in PINSN definition for ~s" ref pinsn-name)))
     129         
     130          `(progn (set-vinsn-template ',pinsn-name ,template
     131                   ,template-hash)
     132            (record-source-file ',pinsn-name ',source-indicator)
     133            ',pinsn-name)))))
    195134
    196135
  • branches/pinsn/source/compiler/ARM/arm-vinsns.lisp

    r16106 r16195  
    3030
    3131
    32 ;;; Non-volatile FPRs.
    33 (define-arm-vinsn (push-nvfprs :push :multiple :doubleword :csp :predicatable)
    34     (()
    35      ((n :u16const)
    36       (header :u16const))
    37      ((d7 (:double-float #.arm::d7))))
    38   (flds s14 (:= :header))
    39   (fstmdbd d7 (:! arm::sp) (:apply + n 1))
    40   (fcpys single-float-zero s15)
    41   (:data)
    42   :header
    43   (:word header)
    44   (:code))
    45 
    46 (define-arm-vinsn (pop-nvfprs :pop :multiple :doubleword :csp :predicatable)
    47     (()
    48      ((n :u16const))
    49      ((d7 (:double-float #.arm::d7))))
    50   (fldmiad d7 (:! arm::sp) (:apply + n 1))
    51   (fcpys single-float-zero s15))
     32
    5233
    5334(define-arm-vinsn data-section (()
     
    6344
    6445(define-arm-vinsn (scale-node-misc-index :predicatable)
    65     (((dest :u32))
    66      ((idx :imm) ; A fixnum
     46    (((dest :s32))
     47     ((idx :gpr) ; A fixnum
    6748      )
    6849     ())
     
    7051
    7152(define-arm-vinsn (scale-32bit-misc-index :predicatable)
    72     (((dest :u32))
    73      ((idx :imm)                        ; A fixnum
     53    (((dest :s32))
     54     ((idx :gpr)                        ; A fixnum
    7455      )
    7556     ())
     
    7758
    7859(define-arm-vinsn (scale-16bit-misc-index :predicatable)
    79     (((dest :u32))
    80      ((idx :imm)                        ; A fixnum
     60    (((dest :s32))
     61     ((idx :gpr)                        ; A fixnum
    8162      )
    8263     ())
     
    8566
    8667(define-arm-vinsn (scale-8bit-misc-index :predicatable)
    87     (((dest :u32))
    88      ((idx :imm)                        ; A fixnum
     68    (((dest :s32))
     69     ((idx :gpr)                        ; A fixnum
    8970      )
    9071     ())
     
    9374
    9475(define-arm-vinsn (scale-64bit-misc-index :predicatable)
    95     (((dest :u32))
    96      ((idx :imm)                        ; A fixnum
     76    (((dest :s32))
     77     ((idx :gpr)                        ; A fixnum
    9778      )
    9879     ())
     
    10283
    10384(define-arm-vinsn (scale-1bit-misc-index :predicatable)
    104     (((word-index :u32)
     85    (((word-index :s32)
    10586      (bitnum :u8))                     ; (unsigned-byte 5)
    106      ((idx :imm)                        ; A fixnum
     87     ((idx :gpr)                        ; A fixnum
    10788      )
    10889     )
     
    126107    (((dest :u32))
    127108     ((v :lisp)
    128       (idx :u32const))
     109      (idx :literal))
    129110     ())
    130111  (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
     
    140121    (((dest :s32))
    141122     ((v :lisp)
    142       (idx :u32const))
     123      (idx :literal))
    143124     ())
    144125  (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
     
    149130     ((val :u32)
    150131      (v :lisp)
    151       (idx :u32const)))
     132      (idx :literal)))
    152133  (str val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
    153134
     
    156137     ((val :s32)
    157138      (v :lisp)
    158       (idx :u32const)))
     139      (idx :literal)))
    159140  (str val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
    160141
     
    185166    (((dest :single-float))
    186167     ((v :lisp)
    187       (idx :u32const))
     168      (idx :literal))
    188169     ())
    189170  (add lr v (:$ arm::misc-data-offset))
     
    194175    (((dest :double-float))
    195176     ((v :lisp)
    196       (unscaled-idx :imm)))
     177      (unscaled-idx :gpr)))
    197178  (add arm::lr v (:$ arm::misc-dfloat-offset))
    198179  (add arm::lr arm::lr (:lsl unscaled-idx (:$ 1)))
     
    204185    (((dest :complex-double-float))
    205186     ((v :lisp)
    206       (unscaled-idx :imm)))
     187      (unscaled-idx :gpr)))
    207188  (add arm::lr v (:$ arm::misc-dfloat-offset))
    208189  (add arm::lr arm::lr (:lsl unscaled-idx (:$ 2)))
     
    213194    (((dest :double-float))
    214195     ((v :lisp)
    215       (idx :u32const)))
     196      (idx :literal)))
    216197  (add lr v (:$ arm::double-float.value))
    217198  (fldd dest (:@ lr (:$ (:apply ash idx 3))))
     
    221202    (((val :double-float))
    222203     ((v :lisp)
    223       (idx :u32const)))
     204      (idx :literal)))
    224205  (add lr v (:$ arm::double-float.value))
    225206  (fstd val (:@ lr (:$ (:apply ash idx 3))))
     
    230211     ((val :double-float)
    231212      (v :lisp)
    232       (unscaled-idx :imm)))             ; a fixnum
     213      (unscaled-idx :gpr)))             ; a fixnum
    233214  (add lr v (:$ arm::misc-dfloat-offset))
    234215  (add lr lr (:lsl unscaled-idx (:$ 1)))
     
    240221     ((val :complex-double-float)
    241222      (v :lisp)
    242       (unscaled-idx :imm)))             ; a fixnum
     223      (unscaled-idx :gpr)))             ; a fixnum
    243224  (add lr v (:$ arm::misc-dfloat-offset))
    244225  (add lr lr (:lsl unscaled-idx (:$ 2)))
     
    250231     ((val :single-float)
    251232      (v :lisp)
    252       (idx :u32const)))
     233      (idx :literal)))
    253234  (add lr v (:$ arm::misc-data-offset))
    254235  (fsts val (:@ lr (:$ (:apply ash idx 2))))
     
    278259    (((dest :u16))
    279260     ((v :lisp)
    280       (idx :u32const))
     261      (idx :literal))
    281262     ())
    282263  (ldrh dest (:+@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
     
    285266    (((val :u16))
    286267     ((v :lisp)
    287       (idx :u32const))
     268      (idx :literal))
    288269     ())
    289270  (strh val (:+@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
     
    304285    (((dest :s16))
    305286     ((v :lisp)
    306       (idx :u32const))
     287      (idx :literal))
    307288     ())
    308289  (ldrsh dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
     
    312293    (((val :s16))
    313294     ((v :lisp)
    314       (idx :u32const))
     295      (idx :literal))
    315296     ())
    316297  (strh val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
     
    332313    (((dest :u8))
    333314     ((v :lisp)
    334       (idx :u32const))
     315      (idx :literal))
    335316     ())
    336317  (ldrb dest (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
     
    339320    (((val :u8))
    340321     ((v :lisp)
    341       (idx :u32const))
     322      (idx :literal))
    342323     ())
    343324  (strb val (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
     
    360341    (((dest :s8))
    361342     ((v :lisp)
    362       (idx :u32const))
     343      (idx :literal))
    363344     ())
    364345  (ldrsb dest (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
     
    367348    (((val :s8))
    368349     ((v :lisp)
    369       (idx :u32const))
     350      (idx :literal))
    370351     ())
    371352  (strb val (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
     
    382363    (((dest :u8))
    383364     ((v :lisp)
    384       (idx :u32const))
     365      (idx :literal))
    385366     ())
    386367  (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash (:apply ash idx -5) arm::word-shift)))))
     
    389370
    390371(define-arm-vinsn (misc-ref-c-bit-fixnum :predicatable)
    391     (((dest :imm))
     372    (((dest :gpr))
    392373     ((v :lisp)
    393       (idx :u32const))
     374      (idx :literal))
    394375     ((temp :u32)))
    395376  (ldr temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash (:apply ash idx -5) arm::word-shift)))))
     
    410391    (((dest :lisp))
    411392     ((v :lisp)
    412       (idx :s16const))
     393      (idx :literal))
    413394     ())
    414395  (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
     
    427408     ((val :lisp)
    428409      (v :lisp)
    429       (idx :s16const))
     410      (idx :literal))
    430411     ())
    431412  (str val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
     
    433414
    434415(define-arm-vinsn (misc-element-count-fixnum :predicatable)
    435     (((dest :imm))
     416    (((dest :gpr))
    436417     ((v :lisp))
    437418     ((temp :u32)))
     
    440421  (mov dest (:lsr temp (:$ (- arm::num-subtag-bits arm::fixnum-shift)))))
    441422
    442 (define-arm-vinsn check-misc-bound (()
    443                                     ((idx :imm)
    444                                      (v :lisp))
    445                                     ((temp :u32)))
    446   (ldr temp (:@ v (:$ arm::misc-header-offset)))
    447   (bic temp temp (:$ arm::subtag-mask))
    448   (cmp idx (:lsr temp (:$ (- arm::num-subtag-bits arm::fixnum-shift))))
    449   (blo :ok)
    450   (uuo-error-vector-bounds idx v)
     423(define-arm-vinsn uvector-header (((header :u32))
     424                                  ((v :lisp)))
     425  (ldr header (:@ v (:$ arm::misc-header-offset))))
     426
     427(define-arm-vinsn header->element-count (((element-count :u32))
     428                                         ((header :u32)))
     429  (mov element-count (:lsr header (:$ arm::num-subtag-bits))))
     430
     431(define-arm-vinsn compare-index-to-element-count (((cond :cr))
     432                                                  ((index :gpr)
     433                                                   (element-count :u32)))
     434  (cmp element-count (:asr index (:$ arm::fixnumshift))))
     435
     436(define-arm-vinsn vector-index-out-of-bounds (()
     437                                              ((idx :gpr)
     438                                               (v :lisp)))
     439  (uuo-error-vector-bounds idx v))
     440 
     441
     442(define-arm-vinsn cond-error-if-reg-not-lisptag (()
     443                                                 ((cond :cr)
     444                                                  (crbit :literal)
     445                                                  (reg :gpr)
     446                                                  (tag :literal)))
     447  (b (:~ crbit) :ok)
     448  (uuo-error-reg-not-lisptag reg (:$ tag))
    451449  :ok)
    452450
     451(define-arm-vinsn cond-error-if-reg-not-fulltag (()
     452                                                 ((cond :cr)
     453                                                  (crbit :literal)
     454                                                  (reg :gpr)
     455                                                  (tag :literal)))
     456  (b (:~ crbit) :ok)
     457  (uuo-error-reg-not-fulltag reg (:$ tag))
     458  :ok)
     459
     460(define-arm-vinsn cerror-if-reg-not-lisptag (()
     461                                             ((reg :gpr)
     462                                              (tag :literal)))
     463  (uuo-cerror-reg-not-lisptag reg (:$ tag)))
     464
     465(define-arm-vinsn cond-error-if-reg-not-typecode (()
     466                                                 ((cond :cr)
     467                                                  (crbit :literal)
     468                                                  (reg :gpr)
     469                                                  (tag :literal)))
     470  (b (:~ crbit) :ok)
     471  (uuo-error-reg-not-xtype reg (:$ tag))
     472  :ok)
     473
     474(define-arm-vinsn cerror-if-reg-not-typecode (()
     475                                                 ((reg :gpr)
     476                                                  (tag :literal)))
     477  (uuo-cerror-reg-not-xtype reg (:$ tag)))
     478
     479(define-arm-vinsn wrong-number-of-args (()
     480                                        ((cr-bit :literal)))
     481  ((:pred = cr-bit arm::arm-cond-eq)
     482   (uuo-error-wrong-nargs (:? ne)))
     483  ((:pred = cr-bit arm::arm-cond-hs)
     484   (uuo-error-wrong-nargs (:? lo)))
     485  ((:pred = cr-bit arm::arm-cond-ls)
     486   (uuo-error-wrong-nargs (:? hi))))
     487
    453488(define-arm-vinsn (2d-unscaled-index :predicatable)
    454     (((dest :imm)
    455       (dim1 :u32))
     489    (((dest :gpr)
     490      (dim1out :u32))
    456491     ((dim1 :u32)
    457       (i :imm)
    458       (j :imm)))
     492      (i :gpr)
     493      (j :gpr)))
    459494  (mla dest i dim1 j))
    460495
     
    462497
    463498(define-arm-vinsn (3d-unscaled-index :predicatable)
    464     (((dest :imm)
    465       (dim1 :u32)
    466       (dim2 :u32))
     499    (((dest :gpr)
     500      (dim1out :u32)
     501      (dim2out :u32))
    467502     ((dim1 :u32)
    468503      (dim2 :u32)
    469       (i :imm)
    470       (j :imm)
    471       (k :imm)))
     504      (i :gpr)
     505      (j :gpr)
     506      (k :gpr)))
    472507  (mul dim1 dim1 dim2)
    473508  (mla dim2 j dim2 k)
     
    493528;; Return dim1 (unboxed)
    494529(define-arm-vinsn check-2d-bound (((dim :u32))
    495                                   ((i :imm)
    496                                    (j :imm)
     530                                  ((i :gpr)
     531                                   (j :gpr)
    497532                                   (header :lisp)))
    498533  (ldr dim (:@ header (:$ (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)))))
     
    512547(define-arm-vinsn check-3d-bound (((dim1 :u32)
    513548                                   (dim2 :u32))
    514                                   ((i :imm)
    515                                    (j :imm)
    516                                    (k :imm)
     549                                  ((i :gpr)
     550                                   (j :gpr)
     551                                   (k :gpr)
    517552                                   (header :lisp)))
    518553  (ldr dim1 (:@ header (:$ (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)))))
     
    546581    (((dest :lisp))
    547582     ((node :lisp)
    548       (cellno :u32const)))
     583      (cellno :literal)))
    549584  (ldr dest (:@ node (:$ (:apply + arm::misc-data-offset (:apply ash cellno 2))))))
    550585
     
    552587
    553588(define-arm-vinsn  %slot-ref (((dest :lisp))
    554                               ((instance (:lisp (:ne dest)))
     589                              ((instance :lisp)
    555590                               (index :lisp))
    556591                              ((scaled :u32)))
     
    568603    (((dest :u32))
    569604     ((src :address)
    570       (index :s16const)))
     605      (index :literal)))
    571606  (ldr dest (:@ src (:$ index))))
    572607
     
    575610    (((dest :s32))
    576611     ((src :address)
    577       (index :s16const)))
     612      (index :literal)))
    578613  (ldr dest (:@ src (:$ index))))
    579614
     
    582617    (((dest :u32))
    583618     ((src :address)
    584       (index :s16const)))
     619      (index :literal)))
    585620  (ldr dest (:@ src (:$ index))))
    586621 
     
    608643    (((dest :u16))
    609644     ((src :address)
    610       (index :s16const)))
     645      (index :literal)))
    611646  (ldrh dest (:@ src (:$ index))))
    612647
     
    623658    (((dest :s16))
    624659     ((src :address)
    625       (index :s16const)))
     660      (index :literal)))
    626661  (ldrsh dest (:@ src (:$ index))))
    627662
     
    635670    (((dest :u8))
    636671     ((src :address)
    637       (index :s16const)))
     672      (index :literal)))
    638673  (ldrb dest (:@ src (:$ index))))
    639674
     
    647682    (((dest :s8))
    648683     ((src :address)
    649       (index :s16const)))
     684      (index :literal)))
    650685  (ldrsb dest (:@ src (:$ index))))
    651686
     
    659694    (((dest :u8))
    660695     ((src :address)
    661       (byte-index :s16const)
    662       (bit-shift :u8const)))
     696      (byte-index :literal)
     697      (bit-shift :literal)))
    663698  (ldrb dest (:@ src (:$ byte-index)))
    664699  (mov dest (:lsr dest (:$ bit-shift)))
     
    669704    (((dest :lisp))
    670705     ((src :address)
    671       (byte-index :s16const)
    672       (bit-shift :u8const))
     706      (byte-index :literal)
     707      (bit-shift :literal))
    673708     ((byteval :u8)))
    674709  (ldrb byteval (:@ src (:$ byte-index)))
     
    707742    (((dest :double-float))
    708743     ((src :address)
    709       (index :s16const)))
     744      (index :literal)))
    710745  (fldd dest (:@ src (:$ index)))
    711746)
     
    713748(define-arm-vinsn (mem-ref-double-float :predicatable)
    714749    (((dest :double-float)
    715       (src :address))
     750      (srcout :address))
    716751     ((src :address)
    717752      (index :lisp)))
    718   (add src src (:asr index (:$ arm::fixnumshift)))
    719   (fldd dest (:@ src (:$ 0))))
     753  (add srcout src (:asr index (:$ arm::fixnumshift)))
     754  (fldd dest (:@ srcout (:$ 0))))
    720755
    721756(define-arm-vinsn (mem-set-c-double-float :predicatable)
     
    723758     ((val :double-float)
    724759      (src :address)
    725       (index :s16const))
     760      (index :literal))
    726761     ((addr :u32)))
    727762  (add addr src (:$ index))
     
    740775    (((dest :single-float))
    741776     ((src :address)
    742       (index :s16const)))
     777      (index :literal)))
    743778  (flds dest (:@ src (:$ index))))
    744779
    745780(define-arm-vinsn (mem-ref-single-float :predicatable)
    746781    (((dest :single-float)
    747       (src :address))
     782      (srcout :address))
    748783     ((src :address)
    749784      (index :lisp)))
    750   (add src  src (:asr index (:$ arm::fixnumshift)))
    751   (flds dest (:@ src (:$ 0))))
     785  (add srcout  src (:asr index (:$ arm::fixnumshift)))
     786  (flds dest (:@ srcout (:$ 0))))
    752787
    753788;;; The caller should check that the index is kosher
     
    756791     ((val :single-float)
    757792      (src :address)
    758       (index :s16const)))
     793      (index :literal)))
    759794  (fsts val (:@ src (:$ index))))
    760795
     
    773808     ((val :address)
    774809      (src :address)
    775       (index :s16const)))
     810      (index :literal)))
    776811  (str val (:@ src (:$ index))))
    777812
     
    787822     ((val :u32)
    788823      (src :address)
    789       (index :s16const)))
     824      (index :literal)))
    790825  (str val (:@ src (:$ index))))
    791826
     
    801836     ((val :u16)
    802837      (src :address)
    803       (index :s16const)))
     838      (index :literal)))
    804839  (strh val (:@ src (:$ index))))
    805840
     
    815850     ((val :u16)
    816851      (src :address)
    817       (index :s16const)))
     852      (index :literal)))
    818853  (strb val (:@ src (:$ index))))
    819854
     
    828863    (()
    829864     ((src :address)
    830       (byte-index :s16const)
    831       (mask :u8const))
     865      (byte-index :literal)
     866      (mask :literal))
    832867     ((val :u8)))
    833868  (ldrb val (:@ src (:$ byte-index)))
     
    839874    (()
    840875     ((src :address)
    841       (byte-index :s16const)
    842       (mask :u8const))
     876      (byte-index :literal)
     877      (mask :literal))
    843878     ((val :u8)))
    844879  (ldrb val (:@ src (:$ byte-index)))
     
    849884(define-arm-vinsn mem-set-c-bit (()
    850885                                 ((src :address)
    851                                   (byte-index :s16const)
    852                                   (bit-index :u8const)
    853                                   (val :imm))
     886                                  (byte-index :literal)
     887                                  (bit-index :literal)
     888                                  (val :gpr))
    854889                                 ((byteval :u8)
    855890                                  (mask :u8)))
     
    892927  (and tag object (:$ arm::tagmask)))
    893928
    894 (define-arm-vinsn (extract-tag-fixnum :predicatable)
    895     (((tag :imm))
    896      ((object :lisp)))
    897   (mov tag (:lsl object (:$ arm::fixnumshift)))
    898   (and tag tag (:$ (ash arm::tagmask arm::fixnumshift))))
     929
    899930
    900931(define-arm-vinsn (extract-fulltag :predicatable)
     
    905936
    906937
    907 (define-arm-vinsn (extract-fulltag-fixnum :predicatable)
    908     (((tag :imm))
    909      ((object :lisp)))
    910   (mov tag (:lsl object (:$ arm::fixnumshift)))
    911   (and tag tag (:$ (ash arm::fulltagmask arm::fixnumshift))))
     938
    912939
    913940(define-arm-vinsn extract-typecode (((code :u8))
     
    918945  (ldrbeq code (:@ object (:$ arm::misc-subtag-offset))))
    919946
    920 (define-arm-vinsn extract-typecode-fixnum (((code :imm))
    921                                            ((object (:lisp (:ne code))))
    922                                            ((subtag :u8)))
    923   (and subtag object (:$ arm::tagmask))
    924   (cmp subtag (:$ arm::tag-misc))
    925   (ldrbeq subtag (:@ object (:$ arm::misc-subtag-offset)))
    926   (mov code (:lsl subtag (:$ arm::fixnumshift))))
    927 
    928 
    929 ;;; Can we assume that an error handler can retry this without our
    930 ;;; emitting a branch ?  I'd like to think so.
    931 (define-arm-vinsn require-fixnum (()
    932                                   ((object :lisp))
    933                                   ())
    934   (tst object (:$ arm::tagmask))
    935   (beq :ok)
    936   (uuo-cerror-reg-not-lisptag object (:$ arm::tag-fixnum))
    937   :ok)
    938 
    939 (define-arm-vinsn require-integer (()
    940                                    ((object :lisp))
    941                                    ((tag :u8)))
    942   (ands tag object (:$ arm::tagmask))
    943   (beq :got-it)
    944   (cmp tag (:$ arm::tag-misc))
    945   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    946   (cmp tag (:$ arm::subtag-bignum))
    947   (beq :got-it)
    948   (uuo-cerror-reg-not-xtype object (:$ arm::xtype-integer))
    949   :got-it)
    950 
    951 (define-arm-vinsn require-simple-vector (()
    952                                          ((object :lisp))
    953                                          ((tag :u8)))
    954   (and tag object (:$ arm::tagmask))
    955   (cmp tag (:$ arm::tag-misc))
    956   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    957   (cmp tag (:$ arm::subtag-simple-vector))
    958   (beq :ok)
    959   (uuo-cerror-reg-not-xtype object (:$ arm::subtag-simple-vector))
    960   :ok)
    961 
    962 (define-arm-vinsn require-simple-string (()
    963                                          ((object :lisp))
    964                                          ((tag :u8)))
    965   (and tag object (:$ arm::tagmask))
    966   (cmp tag (:$ arm::tag-misc))
    967   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    968   (cmp tag (:$ arm::subtag-simple-base-string))
    969   (beq :ok)
    970   (uuo-cerror-reg-not-xtype object (:$ arm::subtag-simple-base-string))
    971   :ok)
    972 
    973  
    974 (define-arm-vinsn require-real (()
    975                                 ((object :lisp))
    976                                 ((tag :u8)
    977                                  (mask :u32)
    978                                  (realtags :u32)))
    979   (mov mask (:$ 1))
    980   (and tag object (:$ arm::tagmask))
    981   (mov realtags (:$ (logand #xff arm::real-tags-mask)))
    982   (orr realtags realtags (:$ (logand #xff00 arm::real-tags-mask)))
    983   (cmp tag (:$ arm::tag-misc))
    984   (orr realtags realtags (:$ (logand #xffff0000 arm::real-tags-mask)))
    985   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    986   (tst realtags (:lsl mask tag))
    987   (bne :ok)
    988   (uuo-cerror-reg-not-xtype object (:$ arm::xtype-real))
    989   :ok)
    990 
    991 (define-arm-vinsn require-number (()
    992                                   ((object :lisp))
    993                                   ((tag :u8)
    994                                    (mask :u32)
    995                                    (numtags :u32)))
    996   (mov mask (:$ 1))
    997   (and tag object (:$ arm::tagmask))
    998   (mov numtags (:$ (logand #xff arm::numeric-tags-mask)))
    999   (orr numtags numtags (:$ (logand #xff00 arm::numeric-tags-mask)))
    1000   (cmp tag (:$ arm::tag-misc))
    1001   (orr numtags numtags (:$ (logand #xffff0000 arm::numeric-tags-mask)))
    1002   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    1003   (cmp tag (:$ 31))
    1004   (movhi mask (:$ 0))     ;not a number
    1005   (tst numtags (:lsl mask tag))
    1006   (bne :ok)
    1007   (cmp tag (:$ arm::subtag-complex-double-float))
    1008   (cmpne  tag (:$ arm::subtag-complex-single-float))
    1009   (beq :ok)
    1010   (uuo-cerror-reg-not-xtype object (:$ arm::xtype-number))
    1011   :ok)
    1012 
    1013 
    1014 (define-arm-vinsn require-list (()
    1015                                 ((object :lisp))
    1016                                 ((tag :u8)))
    1017   (and tag object (:$ arm::tagmask))
    1018   (cmp tag (:$ arm::tag-list))
    1019   (beq :ok)
    1020   (uuo-cerror-reg-not-lisptag object (:$ arm::tag-list))
    1021   :ok)
    1022 
    1023 (define-arm-vinsn require-symbol (()
    1024                                   ((object :lisp))
    1025                                   ((tag :u8)))
    1026   (and tag object (:$ arm::tagmask))
    1027   (cmp tag (:$ arm::tag-misc))
    1028   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    1029   (cmpeq tag (:$ arm::subtag-symbol))
    1030   (cmpne object (:$ arm::nil-value))
    1031   (beq :ok)
    1032   (uuo-cerror-reg-not-xtype object (:$ arm::subtag-symbol))
    1033   :ok)
    1034 
    1035 (define-arm-vinsn require-character (()
    1036                                      ((object :lisp))
    1037                                      ((tag :u8)))
    1038   (and tag object (:$ arm::subtag-mask))
    1039   (cmp tag (:$ arm::subtag-character))
    1040   (beq :ok)
    1041   (uuo-cerror-reg-not-xtype object (:$ arm::subtag-character))
    1042   :ok)
     947
     948(define-arm-vinsn extract-lowbyte (((code :u8))
     949                                    ((object :lisp))
     950                                    ())
     951  (and code object (:$ #xff)))
     952
     953
     954
     955
     956
     957
     958
     959(define-arm-vinsn set-z-if-integer-typecode (((cr :cr))
     960                                             ((tag :u8)))
     961  (cmp tag (:$ arm::tag-fixnum))
     962  (cmpne tag (:$ arm::subtag-bignum)))
     963
     964(define-arm-vinsn set-z-if-real-typecode (((cr :cr))
     965                                          ((tag :u8)))
     966  (cmp tag (:$ arm::tag-fixnum))
     967  (cmpne tag (:$ arm::subtag-bignum))
     968  (cmpne tag (:$ arm::subtag-single-float))
     969  (cmpne tag (:$ arm::subtag-double-float))
     970  (cmpne tag (:$ arm::subtag-ratio)))
     971
     972(define-arm-vinsn set-z-if-numeric-typecode (((cr :cr))
     973                                          ((tag :u8)))
     974  (cmp tag (:$ arm::tag-fixnum))
     975  (cmpne tag (:$ arm::subtag-bignum))
     976  (cmpne tag (:$ arm::subtag-single-float))
     977  (cmpne tag (:$ arm::subtag-double-float))
     978  (cmpne tag (:$ arm::subtag-ratio))
     979  (cmpne tag (:$ arm::subtag-complex-single-float))
     980  (cmpne tag (:$ arm::subtag-complex-double-float)))
     981
     982
    1043983
    1044984
     
    11951135
    11961136(define-arm-vinsn (box-fixnum :predicatable)
    1197     (((dest :imm))
     1137    (((dest :gpr))
    11981138     ((src :s32)))
    11991139  (mov dest (:lsl src (:$ arm::fixnumshift))))
     
    12011141(define-arm-vinsn (fixnum->signed-natural :predicatable)
    12021142    (((dest :s32))
    1203      ((src :imm)))
     1143     ((src :gpr)))
    12041144  (mov dest (:asr src (:$ arm::fixnumshift))))
    12051145
    12061146(define-arm-vinsn (fixnum->unsigned-natural :predicatable)
    12071147    (((dest :u32))
    1208      ((src :imm)))
     1148     ((src :gpr)))
    12091149  (mov dest (:lsr src (:$ arm::fixnumshift))))
    12101150
     
    13961336                                    ((src :u32)
    13971337                                     (mask :u32)
    1398                                      (crf :crf)))
     1338                                     (crf :cr)))
    13991339  (biceq dest src mask)
    14001340  (orrne dest src mask))
     
    14131353
    14141354
    1415 (define-arm-vinsn trap-unless-fixnum (()
    1416                                       ((object :lisp)))
    1417   (tst object (:$ arm::fixnummask))
    1418   (beq :ok)
    1419   (uuo-error-reg-not-lisptag object (:$ arm::tag-fixnum))
    1420   :ok)
     1355
    14211356
    14221357(define-arm-vinsn trap-unless-list (()
     
    14291364  :ok)
    14301365
    1431 (define-arm-vinsn trap-unless-single-float (()
    1432                                             ((object :lisp))
    1433                                             ((tag :u8)))
    1434   (and tag object (:$ arm::tagmask))
    1435   (cmp tag (:$ arm::tag-misc))
    1436   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    1437   (cmp tag (:$ arm::subtag-single-float))
    1438   (beq :ok)
    1439   (uuo-error-reg-not-xtype object (:$ arm::subtag-single-float))
    1440   :ok)
    1441 
    1442 (define-arm-vinsn trap-unless-double-float (()
    1443                                             ((object :lisp))
    1444                                             ((tag :u8)))
    1445   (and tag object (:$ arm::tagmask))
    1446   (cmp tag (:$ arm::tag-misc))
    1447   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    1448   (cmp tag (:$ arm::subtag-double-float))
    1449   (beq :ok)
    1450   (uuo-error-reg-not-xtype object (:$ arm::subtag-double-float))
    1451   :ok)
     1366
    14521367
    14531368
     
    14631378  :ok)
    14641379
    1465 (define-arm-vinsn trap-unless-macptr (()
    1466                                       ((object :lisp))
    1467                                       ((tag :u8)))
    1468   (and tag object (:$ arm::tagmask))
    1469   (cmp tag (:$ arm::tag-misc))
    1470   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    1471   (cmp tag (:$ arm::subtag-macptr))
    1472   (beq :ok)
    1473   (uuo-error-reg-not-xtype object (:$ arm::subtag-macptr))
    1474   :ok)
     1380
    14751381
    14761382
     
    14961402  :ok)
    14971403
    1498 (define-arm-vinsn trap-unless-cons (()
    1499                                     ((object :lisp))
    1500                                     ((tag :u8)))
    1501   (and tag object (:$ arm::fulltagmask))
    1502   (cmp tag (:$ arm::fulltag-cons))
    1503   (beq :ok)
    1504   (uuo-error-reg-not-fulltag  object (:$ arm::fulltag-cons))
    1505   :ok)
    1506 
    1507 (define-arm-vinsn trap-unless-typecode= (()
    1508                                          ((object :lisp)
    1509                                           (tagval :u16const))
    1510                                          ((tag :u8)))
    1511   (and tag object (:$ arm::tagmask))
    1512   (cmp tag (:$ arm::tag-misc))
    1513   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    1514   (cmp tag (:$ tagval))
    1515   (beq :ok)
    1516   (uuo-error-reg-not-xtype object (:$ tagval))
    1517   :ok)
    1518 
    1519 (define-arm-vinsn set-z-if-vector-header (((crf :crf))
    1520                                           ((src :lisp))
    1521                                           ((tag :u8)))
    1522   (and tag src (:$ arm::tagmask))
    1523   (cmp tag (:$ arm::tag-misc))
    1524   (ldrbeq tag (:@ src (:$ arm::misc-subtag-offset)))
    1525   (cmp tag (:$ arm::subtag-vectorH)))
     1404
    15261405
    15271406(define-arm-vinsn check-vector-header-bound (()
    15281407                                             ((header :lisp)
    1529                                               (index :imm))
     1408                                              (index :gpr))
    15301409                                             ((limit :u32)))
    15311410  (ldr limit (:@ header (:$ arm::vectorH.physsize)))
     
    15351414  :ok)
    15361415
    1537 (define-arm-vinsn deref-vector-header (((vector :lisp)
    1538                                         (index :lisp))
     1416(define-arm-vinsn deref-vector-header (((vectorout :lisp)
     1417                                        (indexout :lisp))
    15391418                                       ((vector :lisp)
    15401419                                        (index :lisp))
     
    15501429(define-arm-vinsn trap-unless-vector-type (()
    15511430                                           ((header :lisp)
    1552                                             (expected-type :u8const))
     1431                                            (expected-type :literal))
    15531432                                           ((flags :u32)
    15541433                                            (expected-flags :u32)))
     
    15631442(define-arm-vinsn trap-unless-simple-1d-array (()
    15641443                                               ((vector :lisp)
    1565                                                 (expected-type :u8const))
     1444                                                (expected-type :literal))
    15661445                                               ((flags :u32)))
    15671446  (and flags vector (:$ arm::tagmask))
     
    15741453  :ok)
    15751454 
    1576 (define-arm-vinsn (subtract-constant :predicatable)
    1577     (((dest :imm))
    1578      ((src :imm)
    1579       (const :s16const)))
    1580   (sub dest src (:$ const)))
     1455(define-arm-vinsn (:literal :predicatable)
     1456    (((dest :gpr))
     1457     ((src :gpr)
     1458      (:literal :literal)))
     1459  (sub dest src (:$ :literal)))
    15811460
    15821461
     
    16181497
    16191498
    1620 (define-arm-vinsn compare (((crf :crf))
    1621                            ((arg0 t)
    1622                             (arg1 t))
     1499(define-arm-vinsn compare (((crf :cr))
     1500                           ((arg0 :gpr)
     1501                            (arg1 :gpr))
    16231502                           ())
    16241503  (cmp arg0 arg1))
    16251504
    1626 (define-arm-vinsn compare-to-nil (((crf :crf))
    1627                                   ((arg0 t)))
     1505(define-arm-vinsn compare-to-nil (((crf :cr))
     1506                                  ((arg0 :gpr)))
    16281507  (cmp arg0 (:$ arm::nil-value)))
    16291508
    1630 (define-arm-vinsn compare-logical (((crf :crf))
    1631                                    ((arg0 t)
    1632                                     (arg1 t))
     1509(define-arm-vinsn compare-logical (((crf :cr))
     1510                                   ((arg0 :gpr)
     1511                                    (arg1 :gpr))
    16331512                                   ())
    16341513  (cmp  arg0 arg1))
    16351514
    1636 (define-arm-vinsn compare-immediate (((crf :crf))
    1637                                      ((arg t)
    1638                                       (imm :u32const)))
     1515(define-arm-vinsn compare-immediate (((crf :cr))
     1516                                     ((arg :gpr)
     1517                                      (imm :literal)))
    16391518  (cmp arg (:$ imm)))
    16401519
    1641 (define-arm-vinsn double-float-compare (((crf :crf))
     1520(define-arm-vinsn double-float-compare (((crf :cr))
    16421521                                        ((arg0 :double-float)
    16431522                                         (arg1 :double-float))
     
    16851564
    16861565
    1687 (define-arm-vinsn single-float-compare (((crf :crf))
     1566(define-arm-vinsn single-float-compare (((crf :cr))
    16881567                                        ((arg0 :single-float)
    16891568                                         (arg1 :single-float))
     
    17311610
    17321611(define-arm-vinsn compare-unsigned (()
    1733                                     ((arg0 :imm)
    1734                                      (arg1 :imm))
     1612                                    ((arg0 :gpr)
     1613                                     (arg1 :gpr))
    17351614                                    ())
    17361615  (cmp arg0 arg1))
     
    17401619
    17411620
    1742 ;; Extract a constant bit (0-31) from src; make it be bit 31 of dest.
     1621;; Extract a :literal bit (0-31) from src; make it be bit 31 of dest.
    17431622;; Bitnum is treated mod 32.
    17441623#+later
    1745 (define-arm-vinsn extract-constant-arm-bit (((dest :u32))
    1746                                             ((src :imm)
    1747                                              (bitnum :u16const))
     1624(define-arm-vinsn :literal (((dest :u32))
     1625                                            ((src :gpr)
     1626                                             (bitnum :literal))
    17481627                                            ())
    17491628  (rlwinm dest src (:apply + 1 bitnum) 31 31))
     
    17511630
    17521631
    1753 (define-arm-vinsn set-constant-arm-bit-to-variable-value (((dest :u32))
     1632(define-arm-vinsn :literal (((dest :u32))
    17541633                                                          ((src :u32)
    17551634                                                           (bitval :u32) ; 0 or 1
    1756                                                            (bitnum :u8const)))
     1635                                                           (bitnum :literal)))
    17571636  (cmp bitval (:$ 0))
    17581637  (biceq dest src (:$ (:apply ash 1 bitnum)))
    17591638  (orrne dest src (:$ (:apply ash 1 bitnum))))
    17601639
    1761 (define-arm-vinsn (set-constant-arm-bit-to-1 :predicatable)
     1640(define-arm-vinsn (:literal :predicatable)
    17621641    (((dest :u32))
    17631642     ((src :u32)
    1764       (bitnum :u8const)))
     1643      (bitnum :literal)))
    17651644  (orr dest src (:$ (:apply ash 1 bitnum))))
    17661645
    17671646
    1768 (define-arm-vinsn (set-constant-arm-bit-to-0 :predicatable)
     1647(define-arm-vinsn (:literal :predicatable)
    17691648    (((dest :u32))
    17701649     ((src :u32)
    1771       (bitnum :u8const)))
     1650      (bitnum :literal)))
    17721651  (bic dest src (:$ (:apply ash 1 bitnum))))
    17731652
     
    18021681(define-arm-vinsn (load-adl :predicatable)
    18031682    (()
    1804      ((n :u32const)))
     1683     ((n :literal)))
    18051684  (mov nargs (:$ (:apply logand #x00ff0000 n)))
    18061685  ((:not (:pred = 0 (:apply logand #xff000000 n)))
     
    18131692(define-arm-vinsn (set-nargs :predicatable)
    18141693    (()
    1815      ((n :s16const)))
     1694     ((n :literal)))
    18161695  ((:pred arm::encode-arm-immediate (:apply ash n arm::word-shift))
    18171696   (mov nargs (:$ (:apply ash n arm::word-shift))))
     
    18231702(define-arm-vinsn (scale-nargs :predicatable)
    18241703    (()
    1825      ((nfixed :s16const)))
     1704     ((nfixed :literal)))
    18261705  ((:pred > nfixed 0)
    18271706   (add nargs nargs (:$ (:apply - (:apply ash nfixed arm::word-shift))))))
     
    18371716(define-arm-vinsn (vpush-multiple-registers :push :node :multiple :vsp :predicatable)
    18381717    (()
    1839      ((mask :u16const)))
     1718     ((mask :literal)))
    18401719  (stmdb (:! arm::vsp) (:$ mask)))
    18411720
     
    18591738
    18601739(define-arm-vinsn (vpush-argregs :push :node :vsp) (()
    1861                                                     ((num-fixed-args :u16const)))
     1740                                                    ((num-fixed-args :literal)))
    18621741  ((:pred = num-fixed-args 0)
    18631742   (cmp nargs (:$ 0))
     
    19041783
    19051784(define-arm-vinsn (copy-gpr :predicatable)
    1906     (((dest t))
    1907      ((src t)))
     1785    (((dest :gpr))
     1786     ((src :gpr)))
    19081787  ((:not (:pred =
    19091788                (:apply %hard-regspec-value dest)
     
    19521831
    19531832
    1954 (define-arm-vinsn make-vcell (((dest :lisp))
    1955                               ((closed (:lisp :ne dest)))
    1956                               ((header :u32)))
    1957   (mov header (:$ (ash arm::value-cell.element-count arm::num-subtag-bits)))
    1958   (orr header header (:$  arm::subtag-value-cell))
    1959   (sub allocptr allocptr (:$ (- arm::value-cell.size arm::fulltag-misc)))
    1960   (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
    1961   (cmp allocptr dest)
    1962   (bhi :no-trap)
    1963   (uuo-alloc-trap)
    1964   :no-trap
    1965   (str header (:@ allocptr (:$ arm::misc-header-offset)))
    1966   (mov dest allocptr)
    1967   (bic allocptr allocptr (:$ arm::fulltagmask))
    1968   (str closed (:@ dest (:$ arm::value-cell.value))))
     1833(define-arm-vinsn make-header  (((dest :u32))
     1834                                ((element-count :literal)
     1835                                 (subtag :literal)))
     1836  (mov dest (:$ (:apply ash element-count arm::num-subtag-bits)))
     1837  (orr dest dest (:$ subtag)))
     1838
     1839
    19691840
    19701841(define-arm-vinsn (make-stack-vcell :predicatable)
    19711842    (((dest :lisp))
    1972      ((closed :lisp))
    1973      ((header :u32)))
    1974   (mov header (:$ (ash arm::value-cell.element-count arm::num-subtag-bits)))
    1975   (orr header header (:$ arm::subtag-value-cell))
     1843     ((closed :lisp)
     1844      (header :u32)))
    19761845  (stmdb (:! sp) (closed header))
    19771846  (add dest sp (:$ arm::fulltag-misc)))
     
    19791848(define-arm-vinsn (make-stack-cons :predicatable)
    19801849    (((dest :lisp))
    1981      ((car :lisp) (cdr :lisp))
    1982      ((header (:u32 #.arm::imm0))
    1983       (zero (:u32 #.arm::imm1))))
    1984   (mov header (:$ (ash 3 arm::num-subtag-bits)))
    1985   (orr header header (:$ arm::subtag-value-cell))
    1986   (mov zero (:$ 0))
    1987   ((:pred <
    1988           (:apply %hard-regspec-value cdr)
    1989           (:apply %hard-regspec-value car))
    1990    (stmdb (:! sp) (car cdr zero header)))
    1991   ((:not (:pred <
    1992                 (:apply %hard-regspec-value cdr)
    1993                 (:apply %hard-regspec-value car)))
    1994    (stmdb (:! sp) (cdr car zero header))
    1995    (str car (:@ sp (:$ 12)))
    1996    (str cdr (:@ sp (:$ 8))))
     1850     ((car :lisp)
     1851      (cdr :lisp)
     1852      (header :u32)
     1853      (zero :u32)))
     1854  (stmdb (:! sp) (car cdr zero header))
    19971855  (add dest sp (:$ (+ arm::dnode-size arm::fulltag-cons))))
    19981856
     
    20051863
    20061864;;; DEST pretty much has to be the LR, which won't stay alive very long.
    2007 (define-arm-vinsn %codevector-entry (((dest t))
     1865(define-arm-vinsn %codevector-entry (((dest :gpr))
    20081866                                     ((cv :lisp)))
    20091867  (add dest cv (:$ arm::misc-data-offset)))
     
    20161874
    20171875(define-arm-vinsn (call-subprim :call :subprim) (()
    2018                                                       ((spno :s32const)))
     1876                                                      ((spno :literal)))
    20191877  (sploadlr spno)
    20201878  (blx lr))
    20211879
    2022 (define-arm-vinsn (jump-subprim :jumpLR) (()
    2023                                           ((spno :s32const)))
     1880(define-arm-vinsn (jump-subprim :return) (()
     1881                                          ((spno :literal)))
    20241882  (spjump spno))
    20251883
    20261884;;; Same as "call-subprim", but gives us a place to
    20271885;;; track args, results, etc.
    2028 (define-arm-vinsn (call-subprim-0 :call :subprim) (((dest t))
    2029                                                         ((spno :s32const)))
     1886(define-arm-vinsn (call-subprim-0 :call :subprim) (((dest :gpr))
     1887                                                        ((spno :literal)))
    20301888  (sploadlr spno)
    20311889  (blx lr))
    20321890
    2033 (define-arm-vinsn (call-subprim-1 :call :subprim) (((dest t))
    2034                                                         ((spno :s32const)
    2035                                                          (z t)))
     1891(define-arm-vinsn (call-subprim-1 :call :subprim) (((dest :gpr))
     1892                                                        ((spno :literal)
     1893                                                         (z :gpr)))
    20361894  (sploadlr spno)
    20371895  (blx lr))
    20381896 
    2039 (define-arm-vinsn (call-subprim-2 :call :subprim) (((dest t))
    2040                                                         ((spno :s32const)
    2041                                                          (y t)
    2042                                                          (z t)))
     1897(define-arm-vinsn (call-subprim-2 :call :subprim) (((dest :gpr))
     1898                                                        ((spno :literal)
     1899                                                         (y :gpr)
     1900                                                         (z :gpr)))
    20431901  (sploadlr spno)
    20441902  (blx lr))
    20451903
    2046 (define-arm-vinsn (call-subprim-3 :call :subprim) (((dest t))
    2047                                                         ((spno :s32const)
    2048                                                          (x t)
    2049                                                          (y t)
    2050                                                          (z t)))
     1904(define-arm-vinsn (call-subprim-3 :call :subprim) (((dest :gpr))
     1905                                                        ((spno :literal)
     1906                                                         (x :gpr)
     1907                                                         (y :gpr)
     1908                                                         (z :gpr)))
    20511909  (sploadlr spno)
    20521910  (blx lr))
     
    20551913
    20561914(define-arm-vinsn (ref-interrupt-level :predicatable)
    2057     (((dest :imm))
     1915    (((dest :gpr))
    20581916     ()
    20591917     ((temp :u32)))
     
    20741932;;; just like JUMP, only (implicitly) asserts that the following
    20751933;;; code is somehow reachable.
    2076 (define-arm-vinsn (non-barrier-jump :xref) (()
    2077                                             ((label :label)))
     1934(define-arm-vinsn non-barrier-jump (()
     1935                                    ((label :label)))
    20781936  (b label))
    20791937
     
    20861944  (:unlock-constant-pool))
    20871945
     1946
    20881947(define-arm-vinsn set-carry-if-fixnum-in-range
    20891948    (((idx :u32)
    2090       (flags :crf))
    2091      ((reg :imm)
    2092       (minval :s32const)
    2093       (maxval :u32const))
     1949      (flags :cr))
     1950     ((reg :gpr)
     1951      (minval :literal)
     1952      (maxval :literal))
    20941953     ((temp :s32)))
    20951954  (mov idx (:asr reg (:$  arm::fixnumshift)))
     
    21512010(define-arm-vinsn (cbranch-true :branch) (()
    21522011                                          ((label :label)
    2153                                            (crf :crf)
    2154                                            (crbit :u8const)))
     2012                                           (crf :cr)
     2013                                           (crbit :literal)))
    21552014  (b (:? crbit) label))
    21562015
    21572016(define-arm-vinsn (cbranch-false :branch) (()
    21582017                                           ((label :label)
    2159                                             (crf :crf)
    2160                                             (crbit :u8const)))
     2018                                            (crf :cr)
     2019                                            (crbit :literal)))
    21612020  (b (:~ crbit) label))
    21622021
    2163 (define-arm-vinsn cond->boolean (((dest :imm))
    2164                                  ((cond :u8const)))
     2022(define-arm-vinsn cond->boolean (((dest :gpr))
     2023                                 ((cond :literal)))
    21652024  (mov dest (:$ arm::nil-value))
    21662025  (add (:? cond) dest dest (:$ arm::t-offset)))
     
    21692028
    21702029(define-arm-vinsn (lisp-word-ref :predicatable)
    2171     (((dest t))
    2172      ((base t)
    2173       (offset t)))
     2030    (((dest :gpr))
     2031     ((base :gpr)
     2032      (offset :gpr)))
    21742033  (ldr dest (:@ base offset)))
    21752034
    21762035(define-arm-vinsn (lisp-word-ref-c :predicatable)
    2177     (((dest t))
    2178      ((base t)
    2179       (offset :s16const)))
     2036    (((dest :gpr))
     2037     ((base :gpr)
     2038      (offset :literal)))
    21802039  (ldr dest (:@ base (:$ offset))))
    21812040
    21822041 
    21832042
    2184 ;; Load an unsigned, 32-bit constant into a destination register.
    2185 (define-arm-vinsn (lri :constant-ref :predicatable)
    2186     (((dest :imm))
    2187      ((intval :u32const))
     2043;; Load an unsigned, 32-bit :literal into a destination register.
     2044(define-arm-vinsn (lri :predicatable)
     2045    (((dest :gpr))
     2046     ((intval :literal))
    21882047     ())
    21892048  ((:pred arm::encode-arm-immediate intval)
     
    22142073(define-arm-vinsn (alloc-eabi-c-frame :predicatable)
    22152074    (()
    2216      ((n-c-args :u16const))
     2075     ((n-c-args :literal))
    22172076     ((header :u32)
    2218       (prevsp :imm)))
     2077      (prevsp :gpr)))
    22192078  (mov header (:$ (:apply ash (:apply + 1 (:apply logandc2 (:apply + 4 4 1 n-c-args) 1)) arm::num-subtag-bits)))
    22202079  (orr header header (:$ arm::subtag-u32-vector))
     
    22272086     ((n-c-args :lisp))
    22282087     ((header :u32)
    2229       (size :imm)
    2230       (prevsp :imm)))
     2088      (size :gpr)
     2089      (prevsp :gpr)))
    22312090  (add size n-c-args (:$ (ash (+ 4 4 1) arm::word-shift)))
    22322091  (bic size size (:$ arm::fixnumone))
     
    22662125    (()
    22672126     ((argval :u32)
    2268       (argnum :u16const)))
     2127      (argnum :literal)))
    22692128  (str argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    22702129
     
    22732132    (()
    22742133     ((argval :single-float)
    2275       (argnum :u16const)))
     2134      (argnum :literal)))
    22762135  (fsts argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    22772136
     
    22792138    (()
    22802139     ((argval :double-float)
    2281       (argnum :u16const)))
     2140      (argnum :literal)))
    22822141  (fstd argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    22832142
    22842143
    22852144
    2286 (define-arm-vinsn (load-nil :constant-ref :predicatable)
    2287     (((dest t))
     2145(define-arm-vinsn (load-nil :predicatable)
     2146    (((dest :gpr))
    22882147     ())
    22892148  (mov dest (:$ arm::nil-value)))
    22902149
    2291 (define-arm-vinsn (load-t :constant-ref :predicatable)
    2292     (((dest t))
     2150(define-arm-vinsn (load-t :predicatable)
     2151    (((dest :gpr))
    22932152     ())
    22942153  (mov dest (:$ arm::nil-value))
     
    22972156
    22982157
    2299 (define-arm-vinsn (ref-constant :constant-ref :predicatable)
     2158(define-arm-vinsn (ref-constant :predicatable)
    23002159    (((dest :lisp))
    2301      ((src :s16const)))
     2160     ((src :literal)))
    23022161  (ldr dest (:@ fn (:$ (:apply + arm::misc-data-offset (:apply ash (:apply + src 2) 2))))))
    23032162
     
    23102169(define-arm-vinsn cons (((dest :lisp))
    23112170                        ((newcar :lisp)
    2312                          (newcdr :lisp))
    2313                         ((allocbase :imm)))
     2171                         (newcdr :lisp)
     2172                         (allocbase :u32)))
    23142173  (sub allocptr allocptr (:$ (- arm::cons.size arm::fulltag-cons)))
    23152174  (ldr allocbase (:@ rcontext (:$ arm::tcr.save-allocbase)))
     
    23252184
    23262185
    2327 ;; subtag had better be a ARM-NODE-SUBTAG of some sort!
    2328 (define-arm-vinsn %arm-gvector (((dest :lisp))
    2329                                 ((Rheader :u32)
    2330                                  (nbytes :u32const))
    2331                                 ((immtemp0 :u32)
    2332                                  (nodetemp :lisp)))
    2333  
    2334   (sub allocptr allocptr (:$ (:apply logand #xff
    2335                                      (:apply -
    2336                                              (:apply logand (lognot 7)
    2337                                                      (:apply + (+ 7 4) nbytes))
    2338                                              arm::fulltag-misc))))
    2339   ((:pred > (:apply -
    2340                     (:apply logand (lognot 7)
    2341                             (:apply + (+ 7 4) nbytes))
    2342                     arm::fulltag-misc) #xff)
    2343    (sub allocptr allocptr (:$ (:apply logand #xff00
    2344                                       (:apply -
    2345                                               (:apply logand (lognot 7)
    2346                                                       (:apply + (+ 7 4) nbytes))
    2347                                               arm::fulltag-misc)))))
    2348   (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
    2349   (cmp allocptr dest)
    2350   (bhi :no-trap)
    2351   (uuo-alloc-trap)
    2352   :no-trap
    2353   (str Rheader (:@ allocptr (:$ arm::misc-header-offset)))
    2354   (mov dest allocptr)
    2355   (bic allocptr allocptr (:$ arm::fulltagmask))
    2356   ((:not (:pred = nbytes 0))
    2357    (mov immtemp0 (:$ (:apply logand #xff (:apply + arm::misc-data-offset nbytes))))
    2358    ((:not (:pred = (:apply logand #xff00 (:apply + arm::misc-data-offset nbytes)) 0))
    2359     (orr immtemp0 immtemp0 (:$ (:apply logand #xff00 (:apply + arm::misc-data-offset nbytes)))))
    2360    :loop
    2361    (sub immtemp0 immtemp0 (:$ 4))
    2362    (cmp immtemp0 (:$ arm::misc-data-offset))
    2363    (ldr nodetemp (:@+ vsp (:$ arm::node-size)))
    2364    (str nodetemp (:@ dest immtemp0))
    2365    (bne :loop)))
     2186
    23662187
    23672188;; allocate a small (phys size <= 32K bytes) misc obj of known size/subtag
    23682189(define-arm-vinsn %alloc-misc-fixed (((dest :lisp))
    23692190                                     ((Rheader :u32)
    2370                                       (nbytes :u32const)))
     2191                                      (nbytes :literal)))
    23712192  (sub allocptr allocptr (:$ (:apply
    23722193                              logand #xff
     
    23932214(define-arm-vinsn (vstack-discard :vsp :pop :discard :predicatable)
    23942215    (()
    2395      ((nwords :u32const)))
     2216     ((nwords :literal)))
    23962217  ((:not (:pred = nwords 0))
    23972218   (add vsp vsp (:$ (:apply ash nwords arm::word-shift)))))
     
    24022223(define-arm-vinsn (vframe-load :predicatable)
    24032224    (((dest :lisp))
    2404      ((frame-offset :u16const)
    2405       (cur-vsp :u16const)))
     2225     ((frame-offset :literal)
     2226      (cur-vsp :literal)))
    24062227  ((:pred < (:apply - (:apply - cur-vsp 4) frame-offset) 4096)
    24072228   (ldr dest (:@ vsp (:$ (:apply - (:apply - cur-vsp 4) frame-offset)))))
     
    24192240    (()
    24202241     ((src :lisp)
    2421       (frame-offset :u16const)
    2422       (cur-vsp :u16const)))
     2242      (frame-offset :literal)
     2243      (cur-vsp :literal)))
    24232244  ((:pred < (:apply - (:apply - cur-vsp 4) frame-offset) 4096)
    24242245   (str src (:@ vsp (:$ (:apply - (:apply - cur-vsp 4) frame-offset)))))
     
    24342255
    24352256(define-arm-vinsn (load-vframe-address :predicatable)
    2436     (((dest :imm))
    2437      ((offset :s16const)))
     2257    (((dest :gpr))
     2258     ((offset :literal)))
    24382259  (add dest vsp (:$ offset)))
    24392260
     
    24492270;;; Treat the low 8 bits of VAL as an unsigned integer; set RESULT to the equivalent fixnum.
    24502271(define-arm-vinsn (u8->fixnum :predicatable)
    2451     (((result :imm))
     2272    (((result :gpr))
    24522273     ((val :u8))
    24532274     ())
     
    24572278;;; Treat the low 8 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
    24582279(define-arm-vinsn (s8->fixnum :predicatable)
    2459     (((result :imm))
     2280    (((result :gpr))
    24602281     ((val :s8))
    24612282     ())
     
    24662287;;; Treat the low 16 bits of VAL as an unsigned integer; set RESULT to the equivalent fixnum.
    24672288(define-arm-vinsn (u16->fixnum :predicatable)
    2468     (((result :imm))
     2289    (((result :gpr))
    24692290     ((val :u16))
    24702291     ())
     
    24742295;;; Treat the low 16 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
    24752296(define-arm-vinsn (s16->fixnum :predicatable)
    2476     (((result :imm))
     2297    (((result :gpr))
    24772298     ((val :s16))
    24782299     ())
     
    24822303(define-arm-vinsn (fixnum->s16 :predicatable)
    24832304    (((result :s16))
    2484      ((src :imm)))
     2305     ((src :gpr)))
    24852306  (mov result (:asr src (:$ arm::fixnumshift))))
    24862307
     
    25612382
    25622383
    2563 ;;; ... of floats ...
    2564 
    2565 ;;; Heap-cons a double-float to store contents of FPREG.  Hope that we don't do
    2566 ;;; this blindly.
    2567 (define-arm-vinsn (double->heap :sets-lr) (((result :lisp)) ; tagged as a double-float
    2568                                 ((fpreg :double-float))
    2569                                 ((header-temp (:u32 #.arm::imm0))
    2570                                  (high (:u32 #.arm::imm1))))
    2571   (mov header-temp (:$ (logand #xff00 arm::double-float-header)))
    2572   (orr header-temp header-temp (:$ (logand #xff arm::double-float-header)))
    2573   (sub allocptr allocptr (:$ (- arm::double-float.size arm::fulltag-misc)))
    2574   (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
    2575   (cmp allocptr result)
    2576   (bhi :no-trap)
    2577   (uuo-alloc-trap)
    2578   :no-trap
    2579   (str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
    2580   (mov result allocptr)
    2581   (bic allocptr allocptr (:$ arm::fulltagmask))
    2582   (add lr result (:$ arm::double-float.value))
    2583   (fstd fpreg (:@ lr (:$ 0)))
    2584   (mov lr (:$ 0)))
    2585 
    2586 (define-arm-vinsn (complex-double-float->heap :sets-lr) (((result :lisp)) ; tagged as a double-float
    2587                                 ((fpreg :complex-double-float))
    2588                                 ((header-temp (:u32 #.arm::imm0))
    2589                                  (high (:u32 #.arm::imm1))))
    2590   (mov header-temp (:$ (logand #xff00 arm::complex-double-float-header)))
    2591   (orr header-temp header-temp (:$ (logand #xff arm::complex-double-float-header)))
    2592   (sub allocptr allocptr (:$ (- arm::complex-double-float.size arm::fulltag-misc)))
    2593   (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
    2594   (cmp allocptr result)
    2595   (bhi :no-trap)
    2596   (uuo-alloc-trap)
    2597   :no-trap
    2598   (str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
    2599   (mov result allocptr)
    2600   (bic allocptr allocptr (:$ arm::fulltagmask))
    2601   (add lr result (:$ arm::complex-double-float.realpart))
    2602   (fstmiad fpreg lr 2)
    2603   (mov lr (:$ 0)))
    2604 
    2605 
    2606 ;;; This is about as bad as heap-consing a double-float.  (In terms of
    2607 ;;; verbosity).  Wouldn't kill us to do either/both out-of-line, but
    2608 ;;; need to make visible to compiler so unnecessary heap-consing can
    2609 ;;; be elided.
    2610 (define-arm-vinsn (single->node :sets-lr)
    2611     (((result :lisp)) ; tagged as a single-float
    2612      ((fpreg :single-float))
    2613      ((header-temp :u32)))
    2614   (mov header-temp (:$ (logand #xff00 arm::single-float-header)))
    2615   (orr header-temp header-temp (:$ (logand #xff arm::single-float-header)))
    2616   (sub allocptr allocptr (:$ (- arm::single-float.size arm::fulltag-misc)))
    2617   (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
    2618   (cmp allocptr result)
    2619   (bhi :no-trap)
    2620   (uuo-alloc-trap)
    2621   :no-trap
    2622   (str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
    2623   (mov result allocptr)
    2624   (bic allocptr allocptr (:$ arm::fulltagmask))
    2625   (add lr result (:$ arm::single-float.value))
    2626   (fsts fpreg (:@ lr (:$ 0)))
    2627   (mov lr (:$ 0)))
    2628 
    2629 (define-arm-vinsn (complex-single-float->node :sets-lr)
    2630     (((result :lisp)) ; tagged as a complex-single-float
    2631      ((fpreg :complex-single-float))
    2632      ((header-temp :u32)))
    2633   (mov header-temp (:$ (logand #xff00 arm::complex-single-float-header)))
    2634   (orr header-temp header-temp (:$ (logand #xff arm::complex-single-float-header)))
    2635   (sub allocptr allocptr (:$ (- arm::complex-single-float.size arm::fulltag-misc)))
    2636   (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
    2637   (cmp allocptr result)
    2638   (bhi :no-trap)
    2639   (uuo-alloc-trap)
    2640   :no-trap
    2641   (str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
    2642   (mov result allocptr)
    2643   (bic allocptr allocptr (:$ arm::fulltagmask))
    2644   (add lr result (:$ arm::complex-single-float.realpart))
    2645   (fstd fpreg (:@ lr (:$ 0)))
    2646   (mov lr (:$ 0)))
     2384
     2385
     2386
     2387(define-arm-vinsn (%init-single-float :sets-lr)  (()
     2388                                                  ((object :lisp)
     2389                                                   (value :single-float)))
     2390  (add lr object (:$ arm::single-float.value))
     2391  (fsts value (:@ lr (:$ 0)))
     2392  (mov lr pc))
     2393
     2394(define-arm-vinsn (%init-complex-single-float :sets-lr)  (()
     2395                                                          ((object :lisp)
     2396                                                           (value :complex-single-float)))
     2397  (add lr object (:$ arm::complex-single-float.realpart))
     2398  (fstd value (:@ lr (:$ 0)))
     2399  (mov lr pc))
     2400
     2401(define-arm-vinsn (%init-double-float :sets-lr)  (()
     2402                                                  ((object :lisp)
     2403                                                   (value :double-float)))
     2404  (add lr object (:$ arm::double-float.value))
     2405  (fstd value (:@ lr (:$ 0)))
     2406  (mov lr pc))
     2407
     2408(define-arm-vinsn (%init-complex-double-float :sets-lr)  (()
     2409                                                          ((object :lisp)
     2410                                                           (value :complex-double-float)))
     2411  (add lr object (:$ arm::complex-double-float.realpart))
     2412  (fstmiad value lr 2)
     2413  (mov lr pc))
     2414
    26472415
    26482416
     
    26782446  (mov lr (:$ 0)))
    26792447
    2680 ;;; Extract a double-float value, typechecking in the process.
    2681 ;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
    2682 ;;; instead of replicating it ..
    2683 
    2684 (define-arm-vinsn (get-double? :sets-lr)
    2685     (((target :double-float))
    2686      ((source :lisp))
    2687      ((tag :u8)))
    2688   (and tag source (:$ arm::tagmask))
    2689   (cmp tag (:$ arm::tag-misc))
    2690   (ldrbeq tag (:@ source (:$ arm::misc-subtag-offset)))
    2691   (cmp tag (:$ arm::subtag-double-float))
    2692   (beq :ok)
    2693   (uuo-error-reg-not-xtype source (:$ arm::subtag-double-float))
    2694   :ok
    2695   (add lr source (:$ arm::double-float.pad))
    2696   (fldd target (:@ lr (:$ (- arm::double-float.value arm::double-float.pad)))))
    2697  
    26982448
    26992449(define-arm-vinsn double-to-single (((result :single-float))
     
    27412491
    27422492(define-arm-vinsn fixnum->char (((dest :lisp))
    2743                                 ((src :imm))
     2493                                ((src :gpr))
    27442494                                ((tempa :u32)
    27452495                                 (tempb :u32)))
     
    27592509(define-arm-vinsn (code-char->char :predicatable)
    27602510    (((dest :lisp))
    2761      ((src :imm))
     2511     ((src :gpr))
    27622512     ())
    27632513  (mov dest (:lsl src (:$ (- arm::charcode-shift arm::fixnum-shift))))
     
    27872537
    27882538
    2789 (define-arm-vinsn macptr->heap (((dest :lisp))
    2790                                 ((address :address))
    2791                                 ((header :u32)))
    2792   (mov header (:$ (logand #xff00 arm::macptr-header)))
    2793   (orr header header (:$ (logand #xff arm::macptr-header)))
    2794   (sub allocptr allocptr (:$ (- arm::macptr.size arm::fulltag-misc)))
    2795   (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
    2796   (cmp allocptr dest)
    2797   (bhi :no-trap)
    2798   (uuo-alloc-trap)
    2799   :no-trap
    2800   (str header (:@ allocptr (:$ arm::misc-header-offset)))
    2801   (mov dest allocptr)
    2802   (bic allocptr allocptr (:$ arm::fulltagmask))
    2803   ;; It's not necessary to zero out the domain/type fields, since newly
    2804   ;; heap-allocated memory's guaranteed to be 0-filled.
    2805   (str address (:@ dest (:$ arm::macptr.address))))
     2539
    28062540
    28072541(define-arm-vinsn (macptr->stack :predicatable)
     
    28242558(define-arm-vinsn (adjust-vsp :predicatable :vsp :pop :discard)
    28252559    (()
    2826      ((amount :s16const)))
     2560     ((amount :literal)))
    28272561  (add vsp vsp (:$ amount)))
    28282562
    28292563(define-arm-vinsn (adjust-sp :predicatable)
    28302564    (()
    2831      ((amount :s16const)))
     2565     ((amount :literal)))
    28322566  (add sp sp (:$ amount)))
    28332567
     
    28412575
    28422576(define-arm-vinsn (fixnum-lognot :predicatable)
    2843     (((dest :imm))
    2844      ((src :imm))
     2577    (((dest :gpr))
     2578     ((src :gpr))
    28452579     ((temp :u32)))
    28462580  (mvn temp src)
     
    28492583
    28502584(define-arm-vinsn negate-fixnum-set-flags  (((dest :lisp)
    2851                                              (flags :crf))
    2852                                             ((src :imm)))
     2585                                             (flags :cr))
     2586                                            ((src :gpr)))
    28532587  (rsbs dest src (:$ 0)))
    28542588 
     
    28582592(define-arm-vinsn (negate-fixnum-no-ovf :predicatable)
    28592593    (((dest :lisp))
    2860      ((src :imm)))
     2594     ((src :gpr)))
    28612595  (rsb dest src (:$ 0)))
    28622596 
    28632597
    28642598(define-arm-vinsn (logior-immediate :predicatable)
    2865     (((dest :imm))
    2866      ((src :imm)
    2867       (imm :u32const)))
     2599    (((dest :gpr))
     2600     ((src :gpr)
     2601      (imm :literal)))
    28682602  (orr dest src (:$ imm)))
    28692603
     
    28712605                           
    28722606(define-arm-vinsn (%logior2 :predicatable)
    2873     (((dest :imm))
    2874      ((x :imm)
    2875       (y :imm))
     2607    (((dest :gpr))
     2608     ((x :gpr)
     2609      (y :gpr))
    28762610     ())
    28772611  (orr dest x y))
    28782612
    28792613(define-arm-vinsn (logand-immediate :predicatable)
    2880     (((dest :imm))
    2881      ((src :imm)
    2882       (imm :u32const)))
     2614    (((dest :gpr))
     2615     ((src :gpr)
     2616      (imm :literal)))
    28832617  (and dest src (:$ imm)))
    28842618
    28852619
    28862620(define-arm-vinsn (%logand2 :predicatable)
    2887     (((dest :imm))
    2888      ((x :imm)
    2889       (y :imm))
     2621    (((dest :gpr))
     2622     ((x :gpr)
     2623      (y :gpr))
    28902624     ())
    28912625  (and dest x y))
    28922626
    28932627(define-arm-vinsn (logxor-immediate :predicatable)
    2894     (((dest :imm))
    2895      ((src :imm)
    2896       (imm :u32const)))
     2628    (((dest :gpr))
     2629     ((src :gpr)
     2630      (imm :literal)))
    28972631  (eor dest src (:$ imm)))
    28982632                                   
     
    29012635
    29022636(define-arm-vinsn (%logxor2 :predicatable)
    2903     (((dest :imm))
    2904      ((x :imm)
    2905       (y :imm))
     2637    (((dest :gpr))
     2638     ((x :gpr)
     2639      (y :gpr))
    29062640     ())
    29072641  (eor dest x y))
     
    29092643;;; ARM register shifts shift by the low byte of RS.
    29102644(define-arm-vinsn (%ilsl :predicatable)
    2911     (((dest :imm))
    2912      ((count :imm)
    2913       (src :imm))
    2914      ((temp :u32)))
    2915   (mov temp (:asr count (:$ arm::fixnumshift)))
    2916   (mov dest (:lsl src temp)))
    2917 
    2918 ;;; Shift by a constant = -> shift by 32.  Don't do that.
     2645    (((dest :gpr))
     2646     ((count :u32)
     2647      (src :gpr)))
     2648  (mov dest (:lsl src count)))
     2649
     2650;;; Shift by a :literal = -> shift by 32.  Don't do that.
    29192651(define-arm-vinsn (%ilsl-c :predicatable)
    2920     (((dest :imm))
    2921      ((count :u8const)
    2922       (src :imm)))
     2652    (((dest :gpr))
     2653     ((count :literal)
     2654      (src :gpr)))
    29232655  ((:pred = count 0)
    29242656   (mov dest src))
     
    29282660
    29292661(define-arm-vinsn (%ilsr-c :predicatable)
    2930     (((dest :imm))
    2931      ((count :u8const)
    2932       (src :imm))
     2662    (((dest :gpr))
     2663     ((count :literal)
     2664      (src :gpr))
    29332665     ((temp :s32)))
    29342666  (mov temp (:lsr src (:$ count)))
     
    29372669
    29382670(define-arm-vinsn (%iasr :predicatable)
    2939     (((dest :imm))
    2940      ((count :imm)
    2941       (src :imm))
     2671    (((dest :gpr))
     2672     ((count :gpr)
     2673      (src :gpr))
    29422674     ((temp :s32)))
    29432675  (mov temp (:asr count (:$ arm::fixnumshift)))
     
    29452677  (bic dest temp (:$ arm::fixnummask)))
    29462678
    2947 (define-arm-vinsn %iasr-c (((dest :imm))
    2948                            ((count :u8const)
    2949                             (src :imm))
     2679(define-arm-vinsn %iasr-c (((dest :gpr))
     2680                           ((count :literal)
     2681                            (src :gpr))
    29502682                           ((temp :s32)))
    29512683  ((:pred = count 0)
     
    29562688
    29572689(define-arm-vinsn (%ilsr :predicatable)
    2958     (((dest :imm))
    2959      ((count :imm)
    2960       (src :imm))
     2690    (((dest :gpr))
     2691     ((count :gpr)
     2692      (src :gpr))
    29612693     ((temp :s32)))
    29622694  (mov temp (:asr count (:$ arm::fixnumshift)))
     
    29662698
    29672699(define-arm-vinsn (%ilsr-c :predicatable)
    2968     (((dest :imm))
    2969      ((count :u8const)
    2970       (src :imm))
     2700    (((dest :gpr))
     2701     ((count :literal)
     2702      (src :gpr))
    29712703     ((temp :s32)))
    29722704  ((:pred = count 0)
     
    29792711    (((dest :u32))
    29802712     ((src :u32)
    2981       (count :u8const)))
     2713      (count :literal)))
    29822714  ((:pred = count 0)
    29832715   (mov dest src))
     
    29882720    (((dest :u32))
    29892721     ((src :u32)
    2990       (count :u8const)))
     2722      (count :literal)))
    29912723  ((:pred = count 0)
    29922724   (mov dest src))
     
    30162748(define-arm-vinsn trap-unless-simple-array-2 (()
    30172749                                              ((object :lisp)
    3018                                                (rexpected-flags :imm))
     2750                                               (rexpected-flags :gpr))
    30192751                                              ((tag :u8)
    30202752                                               (flags :u32)))
     
    30392771(define-arm-vinsn trap-unless-typed-array-2 (()
    30402772                                              ((object :lisp)
    3041                                                (subtag :u8const))
     2773                                               (subtag :literal))
    30422774                                              ((flags :u32)
    30432775                                               (tag :u8)))
     
    30642796(define-arm-vinsn trap-unless-simple-array-3 (()
    30652797                                              ((object :lisp)
    3066                                                (rexpected-flags :imm))
     2798                                               (rexpected-flags :gpr))
    30672799                                              ((tag :u8)
    30682800                                               (flags :u32)))
     
    30872819(define-arm-vinsn trap-unless-typed-array-3 (()
    30882820                                              ((object :lisp)
    3089                                                (subtag :u8const))
     2821                                               (subtag :literal))
    30902822                                              ((flags :u32)
    30912823                                               (tag :u8)))
     
    31142846 
    31152847(define-arm-vinsn (sign-extend-halfword :predicatable)
    3116     (((dest :imm))
    3117      ((src :imm)))
     2848    (((dest :gpr))
     2849     ((src :gpr)))
    31182850  (mov dest (:lsl src (:$ (- 16 arm::fixnumshift))))
    31192851  (mov dest (:asr dest (:$ (- 16 arm::fixnumshift)))))
     
    31232855
    31242856(define-arm-vinsn (fixnum-add :predicatable)
    3125     (((dest t))
    3126      ((x t)
    3127       (y t)))
     2857    (((dest :gpr))
     2858     ((x :gpr)
     2859      (y :gpr)))
    31282860  (add dest x y))
    31292861
    3130 (define-arm-vinsn fixnum-add-set-flags (((dest t)
    3131                                          (flags :crf))
    3132                                         ((x t)
    3133                                          (y t)))
     2862(define-arm-vinsn fixnum-add-set-flags (((dest :gpr)
     2863                                         (flags :cr))
     2864                                        ((x :gpr)
     2865                                         (y :gpr)))
    31342866  (adds dest x y))
    31352867
    3136 (define-arm-vinsn fixnum-sub-set-flags (((dest t)
    3137                                          (flags :crf))
    3138                                         ((x t)
    3139                                          (y t)))
     2868(define-arm-vinsn fixnum-sub-set-flags (((dest :gpr)
     2869                                         (flags :cr))
     2870                                        ((x :gpr)
     2871                                         (y :gpr)))
    31402872  (subs dest x y))
    31412873
     
    31442876
    31452877(define-arm-vinsn handle-fixnum-overflow-inline (((dest :lisp))
    3146                                                  ((src :imm))
     2878                                                 ((src :gpr))
    31472879                                                 ((unboxed :s32)
    31482880                                                  (header :u32)))
     
    31682900;;;  (setq dest (- x y))
    31692901(define-arm-vinsn (fixnum-sub :predicatable)
    3170     (((dest t))
    3171      ((x t)
    3172       (y t)))
     2902    (((dest :gpr))
     2903     ((x :gpr)
     2904      (y :gpr)))
    31732905  (sub dest x y))
    31742906
    31752907
    31762908(define-arm-vinsn fixnum-sub-set-flags
    3177     (((dest t)
    3178       (flags :crf))
    3179      ((x t)
    3180       (y t)))
     2909    (((dest :gpr)
     2910      (flags :cr))
     2911     ((x :gpr)
     2912      (y :gpr)))
    31812913  (subs dest x y))
    31822914
    3183 (define-arm-vinsn (fixnum-sub-constant :predicatable) (((dest t))
    3184                                                        ((x t)
    3185                                                         (y :s32const)))
     2915(define-arm-vinsn (:literal :predicatable) (((dest :gpr))
     2916                                                       ((x :gpr)
     2917                                                        (y :literal)))
    31862918  (sub dest x (:$ y)))
    31872919
    3188 (define-arm-vinsn fixnum-sub-constant-set-flags (((dest t)
    3189                                                   (flags :crf))
    3190                                                  ((x t)
    3191                                                   (y :s32const)))
     2920(define-arm-vinsn :literal (((dest :gpr)
     2921                                                  (flags :cr))
     2922                                                 ((x :gpr)
     2923                                                  (y :literal)))
    31922924  (subs dest x (:$ y)))
    31932925                                                       
    31942926
    3195 (define-arm-vinsn (fixnum-sub-from-constant :predicatable)
    3196     (((dest :imm))
    3197      ((x :s32const)
    3198       (y :imm)))
     2927(define-arm-vinsn (:literal :predicatable)
     2928    (((dest :gpr))
     2929     ((x :literal)
     2930      (y :gpr)))
    31992931  (rsb dest y (:$ x)))
    32002932
    32012933
    3202 (define-arm-vinsn fixnum-sub-from-constant-set-flags
    3203     (((dest :imm)
    3204       (flags :crf))
    3205      ((x :s32const)
    3206       (y :imm)))
     2934(define-arm-vinsn :literal
     2935    (((dest :gpr)
     2936      (flags :cr))
     2937     ((x :literal)
     2938      (y :gpr)))
    32072939  (rsbs dest y (:$ x)))
    32082940
     
    32112943;;; This is, of course, also "subtract-immediate."
    32122944(define-arm-vinsn (add-immediate :predicatable)
    3213     (((dest t))
    3214      ((src t)
    3215       (imm :s32const)))
     2945    (((dest :gpr))
     2946     ((src :gpr)
     2947      (imm :literal)))
    32162948  (add dest src (:$ imm)))
    32172949
    32182950(define-arm-vinsn add-immediate-set-flags
    3219     (((dest t)
    3220       (crf :crf))
    3221      ((src t)
    3222       (imm :s32const)))
     2951    (((dest :gpr)
     2952      (crf :cr))
     2953     ((src :gpr)
     2954      (imm :literal)))
    32232955  (adds dest src (:$ imm)))
    32242956
    32252957(define-arm-vinsn (multiply-fixnums :predicatable)
    3226     (((dest :imm))
    3227      ((a :imm)
    3228       (b :imm))
     2958    (((dest :gpr))
     2959     ((a :gpr)
     2960      (b :gpr))
    32292961     ((unboxed :s32)))
    32302962  (mov unboxed (:asr b (:$ arm::fixnumshift)))
     
    32372969(define-arm-vinsn (mask-base-char :predicatable)
    32382970    (((dest :u32))
    3239      ((src :imm)))
     2971     ((src :gpr)))
    32402972  (and dest src (:$ arm::subtag-mask)))
    32412973
     
    32552987(define-arm-vinsn (ref-symbol-value :call :subprim)
    32562988    (((val :lisp))
    3257      ((sym (:lisp (:ne val)))))
     2989     ((sym :lisp)))
    32582990  (sploadlr .SPspecrefcheck)
    32592991  (blx lr))
    32602992
    32612993(define-arm-vinsn ref-symbol-value-inline (((dest :lisp))
    3262                                            ((src (:lisp (:ne dest))))
    3263                                            ((table :imm)
    3264                                             (idx :imm)))
     2994                                           ((src :lisp))
     2995                                           ((table :gpr)
     2996                                            (idx :gpr)))
    32652997  (ldr idx (:@ src (:$ arm::symbol.binding-index)))
    32662998  (ldr table (:@ rcontext (:$ arm::tcr.tlb-limit)))
     
    32783010(define-arm-vinsn (%ref-symbol-value :call :subprim)
    32793011    (((val :lisp))
    3280      ((sym (:lisp (:ne val)))))
     3012     ((sym :lisp)))
    32813013  (sploadlr .SPspecref)
    32823014  (blx lr))
    32833015
    32843016(define-arm-vinsn %ref-symbol-value-inline (((dest :lisp))
    3285                                             ((src (:lisp (:ne dest))))
    3286                                             ((table :imm)
    3287                                              (idx :imm)))
     3017                                            ((src :lisp))
     3018                                            ((table :gpr)
     3019                                             (idx :gpr)))
    32883020  (ldr idx (:@ src (:$ arm::symbol.binding-index)))
    32893021  (ldr table (:@ rcontext (:$ arm::tcr.tlb-limit)))
     
    33043036
    33053037(define-arm-vinsn symbol-function (((val :lisp))
    3306                                    ((sym (:lisp (:ne val))))
    3307                                    ((crf :crf)
     3038                                   ((sym :lisp))
     3039                                   ((crf :cr)
    33083040                                    (tag :u32)))
    33093041  (ldr val (:@ sym (:$ arm::symbol.fcell)))
     
    33193051(define-arm-vinsn save-nfp (()
    33203052                            ()
    3321                             ((temp :imm)))
     3053                            ((temp :gpr)))
    33223054  ((:pred  > (:apply arm2-max-nfp-depth) 0)
    33233055   ;; screw: handle > 4K case
     
    33303062(define-arm-vinsn restore-nfp (()
    33313063                               ()
    3332                                ((temp :imm)))
     3064                               ((temp :gpr)))
    33333065  ((:pred > (:apply  arm2-max-nfp-depth) 0)
    33343066   (ldr temp (:@ sp (:$ 4)))
     
    33393071(define-arm-vinsn (nfp-store-double-float :nfp :set) (()
    33403072                                                      ((val :double-float)
    3341                                                        (offset :u16const)))
     3073                                                       (offset :literal)))
    33423074  (fstd val (:@ sp (:$ (:apply + 8 offset)))))
    33433075
    33443076(define-arm-vinsn (nfp-store-double-float-nested :nfp :set) (()
    33453077                                                             ((val :double-float)
    3346                                                               (offset :u16const)))
     3078                                                              (offset :literal)))
    33473079  (ldr lr (:@ rcontext (:$ arm::tcr.nfp)))
    33483080  (fstd val (:@ lr (:$ (:apply + 8 offset)))))
     
    33503082
    33513083(define-arm-vinsn (nfp-load-double-float :nfp :ref)  (((val :double-float))
    3352                                                       ((offset :u16const)))
     3084                                                      ((offset :literal)))
    33533085  (fldd val (:@ sp (:$ (:apply + 8 offset)))))
    33543086
    33553087(define-arm-vinsn (nfp-load-double-float-nested :nfp :ref) (((val :double-float))
    3356                                                             ((offset :u16const)))
     3088                                                            ((offset :literal)))
    33573089  (ldr lr (:@ rcontext (:$ arm::tcr.nfp)))
    33583090  (fldd val (:@ lr (:$ (:apply + 8 offset)))))
    33593091
    3360 (define-arm-vinsn (nfp-store-complex-double-float :nfp :set :doubleword)
     3092(define-arm-vinsn (nfp-store-complex-double-float :nfp :set)
    33613093    (()
    33623094     ((val :complex-double-float)
    3363       (offset :u16const)))
     3095      (offset :literal)))
    33643096  (fstd val (:@ sp (:$ (:apply + 8 offset))))
    33653097  (fstd (:apply 1+ (:apply %hard-regspec-value val))
    33663098        (:@ sp (:$ (:apply + 8 8 offset)))))
    33673099
    3368 (define-arm-vinsn (nfp-store-complex-double-float-nested :nfp :set :doubleword)
     3100(define-arm-vinsn (nfp-store-complex-double-float-nested :nfp :set)
    33693101    (()
    33703102     ((val :complex-double-float)
    3371       (offset :u16const)))
     3103      (offset :literal)))
    33723104  (ldr lr (:@ rcontext (:$ arm::tcr.nfp)))
    33733105  (fstd val (:@ lr (:$ (:apply + 8 offset))))
     
    33763108 
    33773109
    3378 (define-arm-vinsn (nfp-load-complex-double-float :nfp :ref :doubleword)
     3110(define-arm-vinsn (nfp-load-complex-double-float :nfp :ref)
    33793111    (((val :complex-double-float))
    3380      ((offset :u16const)))
     3112     ((offset :literal)))
    33813113  (fldd val (:@ sp (:$ (:apply + 8 offset))))
    33823114  (fldd (:apply 1+ (:apply %hard-regspec-value val))
    33833115        (:@ sp (:$ (:apply + 8 8 offset)))))
    33843116
    3385 (define-arm-vinsn (nfp-load-complex-double-float-nested :nfp :ref :doubleword)
     3117(define-arm-vinsn (nfp-load-complex-double-float-nested :nfp :ref)
    33863118    (((val :complex-double-float))
    3387      ((offset :u16const)))
     3119     ((offset :literal)))
    33883120  (ldr lr (:@ rcontext (:$ arm::tcr.nfp)))
    33893121  (fldd val (:@ lr (:$ (:apply + 8 offset))))
     
    33933125(define-arm-vinsn (nfp-store-single-float :nfp :set) (()
    33943126                                                      ((val :single-float)
    3395                                                        (offset :u16const)))
     3127                                                       (offset :literal)))
    33963128  (fsts val (:@ sp (:$ (:apply + 8 offset)))))
    33973129
     
    34013133(define-arm-vinsn (nfp-store-single-float-nested :nfp :set) (()
    34023134                                                             ((val :single-float)
    3403                                                               (offset :u16const)))
     3135                                                              (offset :literal)))
    34043136  (ldr lr (:@ rcontext (:$ arm::tcr.nfp)))
    34053137  (fsts val (:@ lr (:$ (:apply + 8 offset)))))
     
    34083140
    34093141(define-arm-vinsn (nfp-load-single-float :nfp :ref) (((val :single-float))
    3410                                                      ((offset :u16const)))
     3142                                                     ((offset :literal)))
    34113143  (flds val (:@ sp (:$ (:apply + 8 offset)))))
    34123144
    34133145(define-arm-vinsn (nfp-load-single-float-nested :nfp :ref) (((val :single-float))
    3414                                                             ((offset :u16const)))
     3146                                                            ((offset :literal)))
    34153147  (ldr lr (:@ rcontext (:$ arm::tcr.nfp)))
    34163148  (flds val (:@ lr (:$ (:apply + 8 offset)))))
     
    34183150(define-arm-vinsn (nfp-store-unboxed-word :nfp :set) (()
    34193151                                                      ((val :u32)
    3420                                                        (offset :u16const)))
     3152                                                       (offset :literal)))
    34213153  (str val (:@ sp (:$ (:apply + 8 offset)))))
    34223154
    34233155(define-arm-vinsn (nfp-store-unboxed-word-nested :nfp :set) (()
    34243156                                                             ((val :u32)
    3425                                                               (offset :u16const)))
     3157                                                              (offset :literal)))
    34263158  (ldr lr (:@ rcontext (:$ arm::tcr.nfp)))
    34273159  (str val (:@ lr (:$ (:apply + 8 offset)))))
    34283160
    34293161(define-arm-vinsn (nfp-load-unboxed-word :nfp :ref) (((val :u32))
    3430                                                      ((offset :u16const)))
     3162                                                     ((offset :literal)))
    34313163  (ldr val (:@ sp (:$ (:apply + 8 offset)))))
    34323164
    34333165(define-arm-vinsn (nfp-load-unboxed-word-nested :nfp :ref) (((val :u32))
    3434                                                             ((offset :u16const)))
     3166                                                            ((offset :literal)))
    34353167  (ldr lr (:@ rcontext (:$ arm::tcr.nfp)))
    34363168  (ldr val (:@ lr (:$ (:apply + 8 offset)))))
    34373169 
    34383170(define-arm-vinsn (%current-frame-ptr :predicatable)
    3439     (((dest :imm))
     3171    (((dest :gpr))
    34403172     ())
    34413173  (mov dest arm::sp))
    34423174
    34433175(define-arm-vinsn (%current-tcr :predicatable)
    3444     (((dest :imm))
     3176    (((dest :gpr))
    34453177     ())
    34463178  (mov dest rcontext))
    34473179
    3448 (define-arm-vinsn (dpayback :call :subprim) (()
    3449                                                   ((n :s16const))
    3450                                                   ((temp (:u32 #.arm::imm0))))
    3451   ((:pred > n 1)
    3452    (mov temp (:$ n))
    3453    (sploadlr .SPunbind-n))
    3454   ((:pred = n 1)
    3455    (sploadlr .SPunbind))
     3180
     3181(define-arm-vinsn (dpayback-1 :call :subprim) (()
     3182                                               ())
     3183  (sploadlr .SPunbind)
    34563184  (blx lr))
     3185
     3186(define-arm-vinsn (dpayback-n :call :subprim) (()
     3187                                               ((n :u32)))
     3188  (sploadlr .SPunbind-n)
     3189  (blx lr))
     3190
     3191 
     3192
    34573193
    34583194(define-arm-vinsn (zero-double-float-register :predicatable)
     
    34663202  (fcpys dest arm::single-float-zero))
    34673203
    3468 (define-arm-vinsn (load-single-float-constant-from-data :predicatable)
     3204(define-arm-vinsn (:literal :predicatable)
    34693205    (((dest :double-float))
    3470      ((val :u32const)))
     3206     ((val :literal)))
    34713207  (flds dest (:= :x))
    34723208  (:data)
     
    34753211  :code)
    34763212
    3477 (define-arm-vinsn (load-double-float-constant-from-data :predicatable)
     3213(define-arm-vinsn (:literal :predicatable)
    34783214    (((dest :double-float))
    3479      ((high :u32const)
    3480       (low :u32const)))
     3215     ((high :literal)
     3216      (low :literal)))
    34813217  (fldd dest (:= :x))
    34823218  (:data)
     
    34863222  :code)
    34873223
    3488 (define-arm-vinsn (load-single-float-constant :predicatable)
     3224(define-arm-vinsn (:literal :predicatable)
    34893225    (((dest :single-float))
    3490      ((src t)))
     3226     ((src :gpr)))
    34913227  (fmsr dest src))
    34923228
     
    34943230    (((node :lisp))
    34953231     ((base :lisp)
    3496       (offset :s16const)))
     3232      (offset :literal)))
    34973233  (ldr node (:@ base (:$ offset))))
    34983234
    3499 (define-arm-vinsn check-exact-nargs (()
    3500                                      ((n :u16const)))
    3501   (cmp nargs (:$ (:apply ash n 2)))
    3502   (beq :ok)
    3503   (uuo-error-wrong-nargs (:? ne))
    3504   :ok)
    3505 
    3506 (define-arm-vinsn check-exact-nargs-large (()
    3507                                            ((n :u16const))
    3508                                            ((preserve (:u32 #.arm::nargs))
    3509                                             (temp :u32)))
    3510   (mov temp (:$ (:apply logand #xff00 (:apply ash n 2))))
    3511   (orr temp temp (:$ (:apply logand #xff (:apply ash n 2))))
    3512   (cmp nargs temp)
    3513   (beq :ok)
    3514   (uuo-error-wrong-nargs (:? ne))
    3515   :ok)
    3516 
    3517 (define-arm-vinsn check-min-nargs (()
    3518                                    ((min :u16const)))
    3519   (cmp nargs (:$ (:apply ash min 2)))
    3520   (bhs :ok)
    3521   (uuo-error-wrong-nargs (:? lo))
    3522   :ok)
    3523 
    3524 (define-arm-vinsn check-min-nargs-large (()
    3525                                          ((min :u16const))
    3526                                          ((preserve (:u32 #.arm::nargs))
    3527                                           (temp :u32)))
    3528   (mov temp (:$ (:apply logand #xff00 (:apply ash min 2))))
    3529   (orr temp temp (:$ (:apply logand #xff (:apply ash min 2))))
    3530   (cmp nargs temp)
    3531   (bhs :ok)
    3532   (uuo-error-wrong-nargs (:? lo))
    3533   :ok)
    3534 
    3535 
    3536 (define-arm-vinsn check-max-nargs (()
    3537                                    ((max :u16const)))
    3538   (cmp nargs (:$ (:apply ash max 2)))
    3539   (bls :ok)
    3540   (uuo-error-wrong-nargs (:? hi))
    3541   :ok)
    3542 
    3543 (define-arm-vinsn check-max-nargs-large (()
    3544                                          ((max :u16const))
    3545                                          ((preserve (:u32 #.arm::nargs))
    3546                                           (temp :u32)))
    3547   (mov temp (:$ (:apply logand #xff00 (:apply ash max 2))))
    3548   (orr temp temp (:$ (:apply logand #xff (:apply ash max 2))))
    3549   (cmp nargs temp)
    3550   (bls :ok)
    3551   (uuo-error-wrong-nargs (:? hi))
    3552   :ok)
     3235
     3236
     3237
     3238
     3239
    35533240
    35543241;;; Save context and establish FN.  The current VSP is the the
    35553242;;; same as the caller's, e.g., no arguments were vpushed.
    35563243(define-arm-vinsn save-lisp-context-vsp (()
    3557                                          ()
    3558                                          ((imm :u32)))
    3559   (mov imm (:$ arm::lisp-frame-marker))
     3244                                         ((imm :u32))
     3245                                         ())
    35603246  (stmdb (:! sp) (imm vsp fn lr))
    35613247  (mov fn nfn))
    35623248
    35633249
    3564 
    3565 (define-arm-vinsn save-lisp-context-offset (()
    3566                                             ((nbytes-vpushed :u16const))
    3567                                             ((imm (:u32 #.arm::imm1))
    3568                                              (clobbered (:u32 #.arm::imm0))))
     3250(define-arm-vinsn set-fixed-savevsp  (((imm :u32))
     3251                                      ((nbytes-vpushed :literal)))
    35693252  ((:pred arm::encode-arm-immediate nbytes-vpushed)
    35703253   (add imm vsp (:$ nbytes-vpushed)))
     
    35723255   (mov imm (:$ (:apply logand #xff00 nbytes-vpushed)))
    35733256   (orr imm imm (:$ (:apply logand #xff nbytes-vpushed)))
    3574    (add imm imm vsp))
    3575   (mov imm0 (:$ arm::lisp-frame-marker))
    3576   (stmdb (:! sp) (imm0 imm fn lr))
    3577   (mov fn nfn))
    3578 
    3579 (define-arm-vinsn save-lisp-context-variable (()
    3580                                               ()
    3581                                               ((imm (:u32 #.arm::imm1))))
     3257   (add imm imm vsp)))
     3258
     3259(define-arm-vinsn set-variable-savevsp  (((imm :u32))
     3260                                         ())
    35823261  (subs imm nargs (:$ (ash $numarmargregs arm::word-shift)))
    35833262  (movmi imm (:$ 0))
    3584   (add imm imm vsp)
    3585   (mov imm0 (:$ arm::lisp-frame-marker))
    3586   (stmdb (:! sp) (imm0 imm fn lr))
    3587   (mov fn nfn)) 
     3263  (add imm imm vsp))
     3264
     3265(define-arm-vinsn save-lisp-context-offset (()
     3266                                            ((marker :u32)
     3267                                             (savevsp :u32)))
     3268
     3269  (stmdb (:! sp) (marker savevsp fn lr))
     3270  (mov fn nfn))
     3271
     3272 
    35883273
    35893274
     
    36013286;; Vpush the argument registers.  We got at least "min-fixed" args;
    36023287;; that knowledge may help us generate better code.
     3288#||
    36033289(define-arm-vinsn save-lexpr-argregs
    36043290    (()
    3605      ((min-fixed :u16const))
     3291     ((min-fixed :literal))
    36063292     ((entry-vsp (:u32 #.arm::imm1))
    36073293      (arg-temp (:u32 #.arm::imm0))
    36083294      (preserve (:u32 #.arm::nargs))
    3609       (other-temp :imm)))
     3295      (other-temp :gpr)))
    36103296  ((:pred >= min-fixed $numarmargregs)
    36113297   (stmdb (:! vsp) (arg_z arg_y arg_x)))
     
    36483334  (ldrne lr (:@ lr (:$ (arm::%kernel-global 'arm::lexpr-return1v))))
    36493335  )
    3650 
    3651 
    3652 
    3653 (define-arm-vinsn (jump-return-pc :jumpLR :predicatable)
     3336||#
     3337
     3338
     3339
     3340(define-arm-vinsn (jump-return-pc :return :predicatable)
    36543341    (()
    36553342     ())
    36563343  (bx lr))
    36573344
    3658 (define-arm-vinsn (restore-full-lisp-context :lispcontext :pop :csp :lrRestore :predicatable)
     3345(define-arm-vinsn (restore-full-lisp-context  :pop :csp :predicatable)
    36593346    (()
    36603347     ())
     
    36653352
    36663353
    3667 (define-arm-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR :predicatable)
     3354(define-arm-vinsn (popj  :pop :csp :return :predicatable)
    36683355    (()
    36693356     ())
     
    36803367
    36813368(define-arm-vinsn default-1-arg (()
    3682                                  ((min :u16const)))
     3369                                 ((min :literal)))
    36833370  (cmp nargs (:$ (:apply ash min 2)))
    36843371  (bne :done)
     
    36933380
    36943381(define-arm-vinsn default-2-args (()
    3695                                   ((min :u16const)))
     3382                                  ((min :literal)))
    36963383  (cmp nargs (:$ (:apply ash (:apply 1+ min) 2)))
    36973384  (bgt :done)
     
    37183405
    37193406(define-arm-vinsn default-3-args (()
    3720                                   ((min :u16const)))
     3407                                  ((min :literal)))
    37213408  (cmp nargs (:$ (:apply ash min 2)))
    37223409  (beq :none)
     
    37593446;;; the number of &optionals. 
    37603447(define-arm-vinsn (default-optionals :call :subprim) (()
    3761                                                            ((n :u16const)))
     3448                                                      ((n :literal)))
    37623449  (mov imm0 (:$ (:apply ash n 2)))
    37633450  (sploadlr .SPdefault-optional-args)
     
    37653452
    37663453;;; fname contains a known symbol
    3767 (define-arm-vinsn (call-known-symbol :call) (((result (:lisp arm::arg_z)))
     3454(define-arm-vinsn (call-known-symbol :call) (((result :lisp))
    37683455                                             ())
    37693456  (ldr nfn (:@ fname (:$ arm::symbol.fcell)))
     
    37713458  (blx lr))
    37723459
    3773 (define-arm-vinsn (jump-known-symbol :jumplr) (()
     3460(define-arm-vinsn (jump-known-symbol :return) (()
    37743461                                               ())
    37753462  (ldr nfn (:@ fname (:$ arm::symbol.fcell)))
     
    37813468  (blx lr))
    37823469
    3783 (define-arm-vinsn (jump-known-function :jumplr) (()
     3470(define-arm-vinsn (jump-known-function :return) (()
    37843471                                                 ())
    37853472  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
    37863473
    3787 (define-arm-vinsn (%schar8 :predicatable)
    3788     (((char :imm))
    3789      ((str :lisp)
    3790       (idx :imm))
    3791      ((imm :u32)))
    3792   (mov imm (:lsr idx (:$ arm::fixnumshift)))
    3793   (add imm imm (:$ arm::misc-data-offset))
    3794   (ldrb imm (:@ str imm))
    3795   (mov imm (:lsl imm (:$ arm::charcode-shift)))
    3796   (orr char imm (:$ arm::subtag-character)))
    3797 
    3798 (define-arm-vinsn (%schar32 :predicatable)
    3799     (((char :imm))
    3800      ((str :lisp)
    3801       (idx :imm))
    3802      ((imm :u32)))
    3803   (add imm idx (:$ arm::misc-data-offset))
    3804   (ldr imm (:@ str imm))
    3805   (mov imm (:lsl imm (:$ arm::charcode-shift)))
    3806   (orr char imm (:$ arm::subtag-character)))
    3807 
    3808 
    3809 (define-arm-vinsn (%set-schar8 :predicatable)
    3810     (()
    3811      ((str :lisp)
    3812       (idx :imm)
    3813       (char :imm))
    3814      ((imm :u32)
    3815       (imm1 :u32)))
    3816   (mov imm (:lsr idx (:$ arm::fixnumshift)))
    3817   (add imm imm (:$ arm::misc-data-offset))
    3818   (mov imm1 (:lsr char (:$ arm::charcode-shift)))
    3819   (strb imm1 (:@ str imm)))
    3820 
    3821 (define-arm-vinsn (%set-schar32 :predicatable)
    3822     (()
    3823      ((str :lisp)
    3824       (idx :imm)
    3825       (char :imm))
    3826      ((imm :u32)
    3827       (imm1 :u32)))
    3828   (add imm idx (:$ arm::misc-data-offset))
    3829   (mov imm1 (:lsr char (:$ arm::charcode-shift)))
    3830   (str imm1 (:@ str imm)))
    3831 
    3832 (define-arm-vinsn (%set-scharcode8 :predicatable)
    3833     (()
    3834      ((str :lisp)
    3835       (idx :imm)
    3836       (code :imm))
    3837      ((imm :u32)
    3838       (imm1 :u32)))
    3839   (mov imm (:lsr idx (:$ arm::fixnumshift)))
    3840   (add imm imm (:$ arm::misc-data-offset))
    3841   (mov imm1 (:lsr code (:$ arm::fixnumshift)))
    3842   (strb imm1 (:@ str imm)))
    3843 
    3844 
    3845 (define-arm-vinsn (%set-scharcode32 :predicatable)
    3846     (()
    3847      ((str :lisp)
    3848       (idx :imm)
    3849       (code :imm))
    3850      ((imm :u32)
    3851       (imm1 :u32)))
    3852   (add imm idx (:$ arm::misc-data-offset))
    3853   (mov imm1 (:lsr code (:$ arm::fixnumshift)))
    3854   (str imm1 (:@ str imm)))
    3855 
    3856 (define-arm-vinsn (%scharcode8 :predicatable)
    3857     (((code :imm))
    3858      ((str :lisp)
    3859       (idx :imm))
    3860      ((imm :u32)))
    3861   (mov imm (:lsr idx (:$ arm::fixnumshift)))
    3862   (add imm imm (:$ arm::misc-data-offset))
    3863   (ldrb imm (:@ str imm))
    3864   (mov code (:lsl imm (:$ arm::fixnumshift))))
    3865 
    3866 (define-arm-vinsn (%scharcode32 :predicatable)
    3867     (((code :imm))
    3868      ((str :lisp)
    3869       (idx :imm))
    3870      ((imm :u32)))
    3871   (add imm idx (:$ arm::misc-data-offset))
    3872   (ldr imm (:@ str imm))
    3873   (mov code (:lsl imm (:$ arm::fixnumshift))))
     3474
    38743475
    38753476;;; Clobbers LR
     
    38793480
    38803481
    3881 (define-arm-vinsn eep.address (((dest t))
    3882                                ((src (:lisp (:ne dest )))))
     3482(define-arm-vinsn eep.address (((dest :gpr))
     3483                               ((src :lisp)))
    38833484  (ldr dest (:@ src (:$ (+ (ash 1 2) arm::misc-data-offset))))
    38843485  (cmp dest (:$ arm::nil-value))
     
    38943495(define-arm-vinsn (%natural+-c :predicatable)
    38953496    (((dest :u32))
    3896      ((x :u32) (y :u16const)))
     3497     ((x :u32) (y :literal)))
    38973498  (add dest x (:$ y)))
    38983499
     
    39043505(define-arm-vinsn (%natural--c :predicatable)
    39053506    (((dest :u32))
    3906      ((x :u32) (y :u16const)))
     3507     ((x :u32) (y :literal)))
    39073508  (sub dest x (:$ y)))
    39083509
     
    39143515(define-arm-vinsn (%natural-logior-c :predicatable)
    39153516    (((dest :u32))
    3916      ((x :u32) (c :u32const)))
     3517     ((x :u32) (c :literal)))
    39173518  (orr dest x (:$ c)))
    39183519
     
    39243525(define-arm-vinsn (%natural-logxor-c :predicatable)
    39253526    (((dest :u32))
    3926      ((x :u32) (c :u32const)))
     3527     ((x :u32) (c :literal)))
    39273528  (eor dest x (:$ c)))
    39283529
     
    39333534
    39343535(define-arm-vinsn %natural-logand-c (((dest :u32))
    3935                                           ((x :u32) (c :u16const))
     3536                                          ((x :u32) (c :literal))
    39363537                                     )
    39373538  (and dest x (:$ c)))
    39383539
    3939 (define-arm-vinsn %ilogbitp-constant-bit (((dest :crf))
    3940                                           ((fixnum :imm)
    3941                                            (bitnum :u8const)))
     3540(define-arm-vinsn :literal (((dest :cr))
     3541                                          ((fixnum :gpr)
     3542                                           (bitnum :literal)))
    39423543  (tst fixnum (:$ (:apply ash 1 (:apply + bitnum arm::fixnumshift)))))
    39433544
    3944 (define-arm-vinsn %ilogbitp-variable-bit (((dest :crf))
    3945                                           ((fixnum :imm)
     3545(define-arm-vinsn %ilogbitp-variable-bit (((dest :cr))
     3546                                          ((fixnum :gpr)
    39463547                                           (bitnum :u8))
    3947                                           ((mask :imm)
     3548                                          ((mask :gpr)
    39483549                                           (unboxed :u8)))
    39493550  (mov unboxed (:asr bitnum (:$ arm::fixnumshift)))
     
    39583559    (((dest :lisp))
    39593560     ()
    3960      ((temp :imm)
    3961       (temp2 :imm)))
     3561     ((temp :gpr)
     3562      (temp2 :gpr)))
    39623563  (ldr temp2 (:@ rcontext (:$ arm::tcr.tlb-pointer)))
    39633564  (mov temp (:$ -4))
     
    39653566  (str temp (:@ temp2 (:$ arm::interrupt-level-binding-index))))
    39663567
    3967 (define-arm-vinsn (load-character-constant :predicatable)
     3568(define-arm-vinsn (:literal :predicatable)
    39683569    (((dest :lisp))
    3969      ((code :u32const)))
     3570     ((code :literal)))
    39703571  (mov dest (:$ (:apply ash (:apply logand code #xff) arm::charcode-shift)))
    39713572  (orr dest dest (:$ arm::subtag-character))
     
    40043605
    40053606(defmacro define-arm-subprim-jump-vinsn ((name &rest other-attrs) spno &optional)
    4006   `(define-arm-vinsn (,name  :jumpLR ,@other-attrs) (() ())
     3607  `(define-arm-vinsn (,name  :return ,@other-attrs) (() ())
    40073608    (spjump ,spno)))
    40083609
     
    40393640(define-arm-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
    40403641
    4041 (define-arm-vinsn (tail-funcall-vsp :jumpLR :predicatable) (() ())
     3642(define-arm-vinsn (tail-funcall-vsp :return :predicatable) (() ())
    40423643  (ldmia (:! sp) (imm0 vsp fn lr))
    40433644  (spjump .SPfuncall))
     
    40903691(define-arm-subprim-call-vinsn (bind)  .SPbind)
    40913692
    4092 (define-arm-subprim-jump-vinsn (nvalret :jumpLR) .SPnvalret)
     3693(define-arm-subprim-jump-vinsn (nvalret :return) .SPnvalret)
    40933694
    40943695(define-arm-subprim-call-vinsn (nthrowvalues) .SPnthrowvalues)
     
    41883789(define-arm-vinsn bind-interrupt-level-0-inline (()
    41893790                                                 ()
    4190                                                  ((tlb :imm)
    4191                                                   (value :imm)
    4192                                                   (link :imm)
    4193                                                   (temp :imm)))
     3791                                                 ((tlb :gpr)
     3792                                                  (value :gpr)
     3793                                                  (link :gpr)
     3794                                                  (temp :gpr)))
    41943795  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
    41953796  (ldr value (:@ tlb (:$ arm::interrupt-level-binding-index)))
     
    42163817(define-arm-vinsn bind-interrupt-level-m1-inline (()
    42173818                                                  ()
    4218                                                   ((tlb :imm)
    4219                                                    (oldvalue :imm)
    4220                                                    (link :imm)
    4221                                                    (newvalue :imm)
    4222                                                    (idx :imm)))
     3819                                                  ((tlb :gpr)
     3820                                                   (oldvalue :gpr)
     3821                                                   (link :gpr)
     3822                                                   (newvalue :gpr)
     3823                                                   (idx :gpr)))
    42233824  (mov newvalue (:$ (ash -1 arm::fixnumshift)))
    42243825  (mov idx (:$ arm::interrupt-level-binding-index))
     
    42403841(define-arm-subprim-call-vinsn (eabi-ff-callhf) .SPeabi-ff-callhf)
    42413842
     3843
     3844#+unbind-interrupt-level-inline
    42423845(define-arm-vinsn unbind-interrupt-level-inline (()
    42433846                                                 ()
    42443847                                                 ((preserve (:lisp #.arm::arg_z))
    42453848                                                  (preserved (:u32 #.arm::nargs))
    4246                                                   (tlb :imm)
    4247                                                   (link :imm)
    4248                                                   (saved-value :imm)
    4249                                                   (restored-value :imm)))
     3849                                                  (tlb :gpr)
     3850                                                  (link :gpr)
     3851                                                  (saved-value :gpr)
     3852                                                  (restored-value :gpr)))
    42503853  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
    42513854  (ldr saved-value (:@ tlb (:$ arm::interrupt-level-binding-index)))
     
    42653868  :done)
    42663869
    4267 (define-arm-vinsn test-fixnum  (((dest :crf))
     3870(define-arm-vinsn test-fixnum  (((dest :cr))
    42683871                                ((src :lisp)))
    42693872  (tst src (:$ arm::fixnummask)))
    42703873                 
    4271 (define-arm-vinsn test-fixnums (((dest :crf))
     3874(define-arm-vinsn test-fixnums (((dest :cr))
    42723875                                ((x :lisp)
    42733876                                 (y :lisp))
     
    42803883
    42813884
    4282 (define-arm-vinsn %ilognot (((dest :imm))
    4283                             ((src :imm))
     3885(define-arm-vinsn %ilognot (((dest :gpr))
     3886                            ((src :gpr))
    42843887                            ((temp :u32)))
    42853888  (orr temp src (:$ arm::fixnummask))
     
    42873890
    42883891(define-arm-vinsn fixnum-ref-c-double-float (((dest :double-float))
    4289                                              ((base :imm)
    4290                                               (idx :u32const)))
     3892                                             ((base :gpr)
     3893                                              (idx :literal)))
    42913894  (fldd dest (:@ base (:$ (:apply ash idx 3)))))
    42923895
    42933896(define-arm-vinsn fixnum-ref-double-float (((dest :double-float))
    4294                                            ((base :imm)
    4295                                             (idx :imm))
    4296                                            ((temp :imm)))
     3897                                           ((base :gpr)
     3898                                            (idx :gpr))
     3899                                           ((temp :gpr)))
    42973900  (add temp base (:lsl idx (:$ 1)))
    42983901  (fldd dest (:@ temp (:$ 0))))
    42993902
    43003903(define-arm-vinsn fixnum-set-c-double-float (()
    4301                                              ((base :imm)
    4302                                               (idx :u32const)
     3904                                             ((base :gpr)
     3905                                              (idx :literal)
    43033906                                              (val :double-float)))
    43043907  (fstd val (:@ base (:$ (:apply ash idx 3)))))
     
    43063909
    43073910(define-arm-vinsn fixnum-set-double-float (()
    4308                                            ((base :imm)
    4309                                             (idx :imm)
     3911                                           ((base :gpr)
     3912                                            (idx :gpr)
    43103913                                            (val :double-float))
    4311                                            ((temp :imm)))
     3914                                           ((temp :gpr)))
    43123915  (add temp base (:lsl idx (:$ 1)))
    43133916  (fstd val (:@ temp (:$ 0))))
    43143917
    4315 (define-arm-vinsn check-soft-float (((flags :crf))
     3918(define-arm-vinsn check-soft-float (((flags :cr))
    43163919                                    ()
    43173920                                    ((temp :u32)))
     
    43213924
    43223925;;; Do something that sets the Z bit
    4323 (define-arm-vinsn set-eq-bit (((flags :crf))
     3926(define-arm-vinsn set-eq-bit (((flags :cr))
    43243927                              ())
    43253928  (cmp sp sp))
  • branches/pinsn/source/compiler/ARM/arm2.lisp

    r16111 r16195  
    7070
    7171
     72(defmacro with-arm2-local-pinsn-macros ((&rest vars) &body body)
     73  `(macrolet ((p2-branch (&rest args)
     74               `(arm2-branch ,@args))
     75             (p2-copy-register (&rest args) `(arm2-copy-register ,@args)))
     76    (with-p2-local-pinsn-macros (,@vars) ,@body)))
     77
     78
    7279(defun arm2-emit-vinsn (vlist name vinsn-table &rest vregs)
    7380  (arm2-update-regmap (apply #'%emit-vinsn vlist name vinsn-table vregs)))
    7481
    75 (defmacro with-arm-local-vinsn-macros ((segvar &optional vreg-var xfer-var) &body body)
    76   (declare (ignorable xfer-var))
    77   (let* ((template-name-var (gensym))
    78          (template-temp (gensym))
    79          (args-var (gensym))
    80          (labelnum-var (gensym))
    81          (retvreg-var (gensym))
    82          (label-var (gensym)))
    83     `(macrolet ((! (,template-name-var &rest ,args-var)
    84                   (let* ((,template-temp (get-vinsn-template-cell ,template-name-var (backend-p2-vinsn-templates *target-backend*))))
    85                     (unless ,template-temp
    86                       (warn "VINSN \"~A\" not defined" ,template-name-var))
    87                     `(arm2-emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var))))
    88        (macrolet ((<- (,retvreg-var)
    89                     `(arm2-copy-register ,',segvar ,',vreg-var ,,retvreg-var))
    90                   (@  (,labelnum-var)
    91                     `(progn
    92                       (arm2-invalidate-regmap)
    93                       (backend-gen-label ,',segvar ,,labelnum-var)))
    94                   (@+ (,labelnum-var)
    95                     `(progn             ;keep regmap
    96                       (backend-gen-label ,',segvar ,,labelnum-var)))
    97                   (-> (,label-var)
    98                     `(! jump (aref *backend-labels* ,,label-var)))
    99                   (^ (&rest branch-args)
    100                     `(arm2-branch ,',segvar ,',xfer-var ,',vreg-var ,@branch-args))
    101                   (? (&key (class :gpr)
    102                           (mode :lisp))
    103                    (let* ((class-val
    104                            (ecase class
    105                              (:gpr hard-reg-class-gpr)
    106                              (:fpr hard-reg-class-fpr)
    107                              (:crf hard-reg-class-crf)))
    108                           (mode-val
    109                            (if (eq class :gpr)
    110                              (gpr-mode-name-value mode)
    111                              (if (eq class :fpr)
    112                                (if (eq mode :single-float)
    113                                  hard-reg-class-fpr-mode-single
    114                                  hard-reg-class-fpr-mode-double)
    115                                0))))
    116                      `(make-unwired-lreg nil
    117                        :class ,class-val
    118                        :mode ,mode-val)))
    119                   ($ (reg &key (class :gpr) (mode :lisp))
    120                    (let* ((class-val
    121                            (ecase class
    122                              (:gpr hard-reg-class-gpr)
    123                              (:fpr hard-reg-class-fpr)
    124                              (:crf hard-reg-class-crf)))
    125                           (mode-val
    126                            (if (eq class :gpr)
    127                              (gpr-mode-name-value mode)
    128                              (if (eq class :fpr)
    129                                (if (eq mode :single-float)
    130                                  hard-reg-class-fpr-mode-single
    131                                  hard-reg-class-fpr-mode-double)
    132                                0))))
    133                      `(make-wired-lreg ,reg
    134                        :class ,class-val
    135                        :mode ,mode-val))))
    136          ,@body))))
     82
    13783
    13884
     
    237183
    238184(defun arm2-nfp-ref (seg vreg ea)
    239   (with-arm-local-vinsn-macros (seg vreg)
     185  (with-arm2-local-pinsn-macros (seg vreg)
    240186    (let* ((offset (logand #xfff8 ea))
    241187           (type (logand #x7 ea))
     
    307253
    308254(defun arm2-reg-for-nfp-set (vreg ea)
    309   (with-arm-local-vinsn-macros (seg )
     255  (with-arm2-local-pinsn-macros (seg )
    310256    (let* ((type (logand #x7 ea))
    311257           (vreg-class (if vreg (hard-regspec-class vreg)))
     
    344290     
    345291(defun arm2-nfp-set (seg reg ea)
    346   (with-arm-local-vinsn-macros (seg )
     292  (with-arm2-local-pinsn-macros (seg )
    347293    (let* ((offset (logand #xfff8 ea))
    348294           (nested (> *arm2-undo-count* 0)))
     
    427373(defun arm2-do-lexical-reference (seg vreg ea)
    428374  (when vreg
    429     (with-arm-local-vinsn-macros (seg vreg)
     375    (with-arm2-local-pinsn-macros (seg vreg)
    430376      (if (memory-spec-p ea)
    431377        (if (eql (memspec-type ea) memspec-nfp-offset)
     
    442388
    443389(defun arm2-do-lexical-setq (seg vreg ea valreg)
    444   (with-arm-local-vinsn-macros (seg vreg)
     390  (with-arm2-local-pinsn-macros (seg vreg)
    445391    (cond ((typep ea 'lreg)
    446392            (arm2-copy-register seg ea valreg))
     
    461407;;; it isn't ever setqed, is it ?
    462408(defun arm2-heap-cons-next-method-var (seg var)
    463   (with-arm-local-vinsn-macros (seg)
     409  (with-arm2-local-pinsn-macros (seg)
    464410    (when (eq (ash 1 $vbitclosed)
    465411              (logand (logior (ash 1 $vbitclosed)
     
    597543           (*arm2-nfp-vars* ()))
    598544      (declare (dynamic-extent *arm2-gpr-locations* *arm2-gpr-constants*))
    599       (set-fill-pointer
    600        *backend-labels*
    601545       (set-fill-pointer
    602546        *arm2-undo-stack*
     
    604548         *arm2-undo-because*
    605549         (set-fill-pointer
    606           *backend-immediates* 0))))
    607       (backend-get-next-label)          ; start @ label 1, 0 is confused with NIL in compound cd
    608       (with-dll-node-freelist (vinsns *vinsn-freelist*)
     550          *backend-immediates* 0)))
     551
     552       (let* ((seg (p2-init-block)))
    609553        (unwind-protect
    610554             (progn
    611                (setq bits (arm2-toplevel-form vinsns (make-wired-lreg *arm2-result-reg*) $backend-return (afunc-acode afunc)))
     555               (setq bits (arm2-toplevel-form seg (p2-make-lreg seg *arm2-result-reg*) $backend-return (afunc-acode afunc)))
    612556               (dotimes (i (length *backend-immediates*))
    613557                 (let ((imm (aref *backend-immediates* i)))
    614558                   (when (arm2-symbol-locative-p imm) (aset *backend-immediates* i (car imm)))))
    615                (optimize-vinsns vinsns)
    616                (when (logbitp arm2-debug-vinsns-bit *arm2-debug-mask*)
    617                  (format t "~% vinsns for ~s (after generation)" (afunc-name afunc))
    618                  (do-dll-nodes (v vinsns) (format t "~&~s" v))
    619                  (format t "~%~%"))
     559               (remove-trivial-copies seg)
     560               (assign-pinsn-sequence-numbers seg)
     561               (build-interval-list seg)
     562               (linear-scan seg
     563                            (vector arm-node-regs
     564                                    arm-imm-regs
     565                                    arm-temp-fp-regs
     566                                    (ash 1 0)))
     567               (map-pinsns seg #'print)
     568               (break)
     569
    620570           
    621571               (with-dll-node-freelist (code arm::*lap-instruction-freelist*)
     
    625575                          debug-info)
    626576                     (declare (dynamic-extent sections))
    627                      (arm2-expand-vinsns vinsns code sections)
     577                     (arm2-expand-pinsns seg code sections)
    628578                     (if (logbitp $fbitnonnullenv (the fixnum (afunc-bits afunc)))
    629579                       (setq bits (+ bits (ash 1 $lfbits-nonnullenv-bit))))
     
    867817
    868818(defun arm2-check-fixnum-overflow (seg crf target &optional labelno)
    869   (with-arm-local-vinsn-macros (seg)
    870     (let* ((no-overflow (backend-get-next-label))
     819  (with-arm2-local-pinsn-macros (seg)
     820    (let* ((no-overflow (p2-get-next-label seg))
    871821           (label (if labelno (aref *backend-labels* labelno))))
    872822      (! cbranch-false (or label (aref *backend-labels* no-overflow)) crf arm::arm-cond-vs)
     
    896846  (when (> n 0)
    897847    (setq *arm2-compiler-register-save-note* (enqueue-vinsn-note seg :regsave))
    898     (with-arm-local-vinsn-macros (seg)
     848    (with-arm2-local-pinsn-macros (seg)
    899849      (! save-nvrs n))
    900850
     
    905855(defun arm2-save-non-volatile-fprs (seg n)
    906856  (unless (eql n 0)
    907     (with-arm-local-vinsn-macros (seg)
     857    (with-arm2-local-pinsn-macros (seg)
    908858      (! push-nvfprs n (logior (ash n arm::num-subtag-bits) arm::subtag-double-float-vector)))
    909859    (setq *arm2-non-volatile-fpr-count* n)))
     
    912862  (let* ((n *arm2-non-volatile-fpr-count*))
    913863    (unless (eql n 0)
    914     (with-arm-local-vinsn-macros (seg)
     864    (with-arm2-local-pinsn-macros (seg)
    915865      (! pop-nvfprs n)))))
    916866
     
    931881         (n *arm2-register-restore-count*))
    932882    (when (and ea n)
    933       (with-arm-local-vinsn-macros (seg)
     883      (with-arm2-local-pinsn-macros (seg)
    934884        (let* ((diff (- *arm2-vstack* ea)))
    935885          (if (and (eql 0 diff)
     
    1012962
    1013963(defun arm2-initopt (seg vloc spvloc vars inits spvars)
    1014   (with-arm-local-vinsn-macros (seg)
     964  (with-arm2-local-pinsn-macros (seg)
    1015965    (dolist (var vars vloc)
    1016966      (let* ((initform (pop inits))
     
    1018968             (reg (nx2-assign-register-var var))
    1019969             (sp-reg ($ arm::arg_z))
    1020              (regloadedlabel (if reg (backend-get-next-label))))
     970             (regloadedlabel (if reg (p2-get-next-label seg))))
    1021971        (unless (nx-null initform)
    1022972          (arm2-stack-to-register seg (arm2-vloc-ea spvloc) sp-reg)
    1023           (let ((skipinitlabel (backend-get-next-label)))
     973          (let ((skipinitlabel (p2-get-next-label seg)))
    1024974            (with-crf-target () crf
    1025975              (arm2-compare-register-to-nil seg crf (arm2-make-compound-cd 0 skipinitlabel) sp-reg  arm::arm-cond-eq t))
    1026976            (if reg
    1027977              (arm2-form seg reg regloadedlabel initform)
    1028               (arm2-register-to-stack seg (arm2-one-untargeted-reg-form seg initform ($ arm::arg_z)) (arm2-vloc-ea vloc)))
     978              (arm2-register-to-stack seg (arm2-one-untargeted-reg-form seg initform (?)) (arm2-vloc-ea vloc)))
    1029979            (@ skipinitlabel)))
    1030980        (if reg
     
    1042992(defun arm2-init-keys (seg vloc allow-others keyvars keysupp keyinits keykeys)
    1043993  (declare (ignore keykeys allow-others))
    1044   (with-arm-local-vinsn-macros (seg)
     994  (with-arm2-local-pinsn-macros (seg)
    1045995    (dolist (var keyvars)
    1046996      (let* ((spvar (pop keysupp))
    1047997             (initform (pop keyinits))
    1048998             (reg (nx2-assign-register-var var))
    1049              (regloadedlabel (if reg (backend-get-next-label)))
     999             (regloadedlabel (if reg (p2-get-next-label seg)))
    10501000
    10511001             (sp-reg ($ arm::arg_z))
     
    10531003        (unless (nx-null initform)
    10541004          (arm2-stack-to-register seg (arm2-vloc-ea sploc) sp-reg)
    1055           (let ((skipinitlabel (backend-get-next-label)))
     1005          (let ((skipinitlabel (p2-get-next-label seg)))
    10561006            (with-crf-target () crf
    10571007              (arm2-compare-register-to-nil seg crf (arm2-make-compound-cd 0 skipinitlabel) sp-reg  arm::arm-cond-eq t))
    10581008            (if reg
    10591009              (arm2-form seg reg regloadedlabel initform)
    1060               (arm2-register-to-stack seg (arm2-one-untargeted-reg-form seg initform ($ arm::arg_z)) (arm2-vloc-ea vloc)))
     1010              (arm2-register-to-stack seg (arm2-one-untargeted-reg-form seg initform (?)) (arm2-vloc-ea vloc)))
    10611011            (@ skipinitlabel)))
    10621012        (if reg
     
    10851035;;;  (nil if vpushed, var if still in arg_reg).
    10861036(defun arm2-argregs-entry (seg revargs)
    1087   (with-arm-local-vinsn-macros (seg)
     1037  (with-arm2-local-pinsn-macros (seg)
    10881038    (let* ((nargs (length revargs))
    10891039           (reg-vars ()))
     
    10931043             (not (some #'null revargs)))
    10941044        (setq *arm2-fixed-nargs* nargs))
     1045      (let* ((marker ($ arm::imm0 :mode :u32)))
     1046        (! lri marker arm::lisp-frame-marker)
    10951047      (if (<= nargs $numarmargregs)       ; caller didn't vpush anything
    1096         (! save-lisp-context-vsp)
    1097         (let* ((offset (* (the fixnum (- nargs $numarmargregs)) *arm2-target-node-size*)))
     1048        (! save-lisp-context-vsp marker)
     1049        (let* ((offset (* (the fixnum (- nargs $numarmargregs)) *arm2-target-node-size*))
     1050               (oldvsp ($ arm::imm1 :mode :u32)))         
    10981051          (declare (fixnum offset))
    1099           (! save-lisp-context-offset offset)))
     1052          (! set-fixed-savevsp oldvsp offset)
     1053          (! save-lisp-context-offset marker oldvsp))))
    11001054      (when *arm2-fixed-args-label*
    1101         (@ (setq *arm2-fixed-args-tail-label* (backend-get-next-label))))
     1055        (@ (setq *arm2-fixed-args-tail-label* (p2-get-next-label seg))))
    11021056      (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
    11031057        (let* ((nstackargs (length stack-args)))
     
    11351089      reg-vars)))
    11361090
     1091(defun arm2-check-nargs (seg nargs-reg count ok-bit)
     1092  (with-arm2-local-pinsn-macros (seg)
     1093    (let* ((count (ash count arm::fixnumshift))
     1094           (cr (? :class :crf))
     1095           (ok (p2-get-next-label seg)))
     1096      (cond ((arm::encode-arm-immediate count)
     1097             (! compare-immediate cr nargs-reg count))
     1098            (t
     1099             (let*  ((rcount (? :mode :u32)))
     1100               (! lri rcount count)
     1101               (! compare cr nargs-reg rcount))))
     1102      (! cbranch-true ok cr ok-bit)
     1103      (! wrong-number-of-args ok-bit)
     1104      (@ ok))))
     1105
     1106(defun arm2-trap-unless-fixnum (seg reg)
     1107  (with-arm2-local-pinsn-macros (seg)
     1108    (let* ((cr (? :class :crf)))
     1109      (! test-fixnum cr reg)
     1110      (! cond-error-reg-not-lisptag cr arm::arm-cond-ne reg arm::tag-fixnum))))
     1111
     1112(defun arm2-trap-unless-typecode= (seg reg typecode)
     1113  (with-arm2-local-pinsn-macros (seg)
     1114    (let* ((cr (? :class :crf))
     1115           (rtag (? :mode :u32)))
     1116      (! extract-typecode rtag reg)
     1117      (! compare-immediate cr rtag typecode)
     1118      (! cond-error-reg-not-typecode cr arm::arm-cond-ne reg typecode))))
     1119
     1120
    11371121;;; Just required args.
    11381122;;; Since this is just a stupid bootstrapping port, always save
     
    11411125  (let* ((nargs (length rev-fixed-args)))
    11421126    (declare (type (unsigned-byte 16) nargs))
    1143     (with-arm-local-vinsn-macros (seg)
     1127    (with-arm2-local-pinsn-macros (seg)
    11441128      (unless *arm2-reckless*
    1145         (if (arm::encode-arm-immediate (ash nargs arm::fixnumshift))
    1146           (! check-exact-nargs nargs)
    1147           (! check-exact-nargs-large nargs)))
     1129        (let* ((rnargs ($ arm::nargs :mode :u32)))
     1130          (arm2-check-nargs seg rnargs nargs arm::arm-cond-eq)))
    11481131      (arm2-argregs-entry seg rev-fixed-args))))
    11491132
     
    11551138         (max (+ min nopt)))
    11561139    (declare (type (unsigned-byte 16) min nopt max))
    1157     (with-arm-local-vinsn-macros (seg)
     1140    (with-arm2-local-pinsn-macros (seg)
     1141      (let* ((rnargs ($ arm::nargs :mode :u32)))
    11581142      (unless *arm2-reckless*
    11591143        (when rev-req-args
    1160           (if (arm::encode-arm-immediate min)
    1161             (! check-min-nargs min)
    1162             (! check-min-nargs-large min)))
    1163         (if (arm::encode-arm-immediate max)
    1164           (! check-max-nargs max)
    1165           (! check-max-nargs-large max)))
     1144          (arm2-check-nargs seg rnargs min arm::arm-cond-hs))
     1145        (arm2-check-nargs seg rnargs max arm::arm-cond-ls))
    11661146      (if (= nopt 1)
    11671147        (! default-1-arg min)
    11681148        (if (= nopt 2)
    11691149          (! default-2-args min)
    1170           (! default-3-args min)))
     1150          (! default-3-args min))))
    11711151      (arm2-argregs-entry seg (append rev-opt-args rev-req-args)))))
    11721152
     
    11771157;;; caller's state.
    11781158(defun arm2-lexpr-entry (seg num-fixed)
    1179   (with-arm-local-vinsn-macros (seg)
     1159  (with-arm2-local-pinsn-macros (seg)
    11801160    (! save-lexpr-argregs num-fixed)
    11811161    (dotimes (i num-fixed)
    11821162      (! copy-lexpr-argument))
    1183     (! save-lisp-context-vsp)))
     1163    (let* ((marker ($ arm::imm0 :mode :u32)))
     1164      (! lri marker arm::lisp-frame-marker)
     1165      (! save-lisp-context-vsp marker))))
    11841166
    11851167(defun arm2-load-lexpr-address (seg dest)
    1186   (with-arm-local-vinsn-macros (seg)
     1168  (with-arm2-local-pinsn-macros (seg)
    11871169    (! load-vframe-address dest *arm2-vstack*)))
    11881170
     
    12231205             (prog2
    12241206                 (when ,code-note
    1225                    (with-arm-local-vinsn-macros (,seg-var)
     1207                   (with-arm2-local-pinsn-macros (,seg-var)
    12261208                     (arm2-store-immediate ,seg-var ,code-note arm::temp0)
    12271209                     (with-node-temps (arm::temp0) (zero)
     
    12821264 
    12831265(defun arm2-nil (seg vreg xfer)
    1284   (with-arm-local-vinsn-macros (seg vreg xfer)
     1266  (with-arm2-local-pinsn-macros (seg vreg xfer)
    12851267    (if (arm2-for-value-p vreg)
    12861268      (ensuring-node-target (target vreg)
     
    12951277
    12961278(defun arm2-t (seg vreg xfer)
    1297   (with-arm-local-vinsn-macros (seg vreg xfer)
     1279  (with-arm2-local-pinsn-macros (seg vreg xfer)
    12981280    (if (arm2-for-value-p vreg)
    12991281      (ensuring-node-target (target vreg)
     
    13171299
    13181300(defun arm2-mvpass (seg form &optional xfer)
    1319   (with-arm-local-vinsn-macros (seg)
     1301  (with-arm2-local-pinsn-macros (seg)
    13201302    (arm2-form seg  ($ arm::arg_z) (logior (or xfer 0) $backend-mvpass-mask) form)))
    13211303
     
    13881370
    13891371(defun arm2-stack-to-register (seg memspec reg)
    1390   (with-arm-local-vinsn-macros (seg)
     1372  (with-arm2-local-pinsn-macros (seg)
    13911373    (let* ((offset (memspec-frame-address-offset memspec)))
    13921374      (if (eql (hard-regspec-class reg) hard-reg-class-fpr)
     
    14171399
    14181400(defun arm2-register-to-stack (seg reg memspec)
    1419   (with-arm-local-vinsn-macros (seg)
     1401  (with-arm2-local-pinsn-macros (seg)
    14201402    (let* ((offset (memspec-frame-address-offset memspec))
    14211403           (vinsn (! vframe-store reg offset *arm2-vstack*)))
     
    14331415    (compiler-bug "~s exceeded." call-arguments-limit)
    14341416    (if (< n 256)     
    1435       (with-arm-local-vinsn-macros (seg)
     1417      (with-arm2-local-pinsn-macros (seg)
    14361418        (! set-nargs n))
    14371419      (arm2-lri seg arm::nargs (ash n arm::word-shift)))))
     
    14441426
    14451427(defun arm2-immediate (seg vreg xfer form)
    1446   (with-arm-local-vinsn-macros (seg vreg xfer)
     1428  (with-arm2-local-pinsn-macros (seg vreg xfer)
    14471429    (if vreg
    14481430      (if (and (= (hard-regspec-class vreg) hard-reg-class-fpr)
     
    14891471
    14901472(defun arm2-store-immediate (seg imm dest)
    1491   (with-arm-local-vinsn-macros (seg)
     1473  (with-arm2-local-pinsn-macros (seg)
    14921474    (let* ((reg (arm2-register-constant-p imm)))
    14931475      (if reg
     
    15361518
    15371519(defun arm2-box-s32 (seg node-dest s32-src)
    1538   (with-arm-local-vinsn-macros (seg)
     1520  (with-arm2-local-pinsn-macros (seg)
    15391521    (if *arm2-open-code-inline*
    15401522      (! s32->integer node-dest s32-src)
     
    15481530
    15491531(defun arm2-box-u32 (seg node-dest u32-src)
    1550   (with-arm-local-vinsn-macros (seg)
     1532  (with-arm2-local-pinsn-macros (seg)
    15511533    (if *arm2-open-code-inline*
    15521534      (! u32->integer node-dest u32-src)
     
    15571539        (arm2-copy-register seg node-dest arg_z)))))
    15581540
    1559 
    1560 
     1541(defun arm2-macptr->heap  (seg dest address)
     1542  (with-arm2-local-pinsn-macros (seg)
     1543    (let* ((header (? :mode :u32)))
     1544      (! make-header header arm::macptr.element-count arm::subtag-macptr)
     1545      (! %alloc-misc-fixed dest header arm::macptr.size)
     1546      (! set-macptr-address address dest))))
     1547
     1548 
     1549(defun arm2-single->node (seg object value)
     1550  (with-arm2-local-pinsn-macros (seg)
     1551    (let* ((header (? :mode :u32)))
     1552      (! make-header header arm::single-float.element-count arm::subtag-single-float)
     1553      (! %alloc-misc-fixed object header arm::single-float.size)
     1554      (! %init-single-float object value))))
     1555
     1556(defun arm2-complex-single-float->node (seg object value)
     1557  (with-arm2-local-pinsn-macros (seg)
     1558    (let* ((header (? :mode :u32)))
     1559      (! make-header header arm::complex-single-float.element-count arm::subtag-complex-single-float)
     1560      (! %alloc-misc-fixed object header arm::complex-single-float.size)
     1561      (! %init-complex-single-float object value))))
     1562
     1563(defun arm2-double->heap (seg object value)
     1564  (with-arm2-local-pinsn-macros (seg)
     1565    (let* ((header (? :mode :u32)))
     1566      (! make-header header arm::double-float.element-count arm::subtag-double-float)
     1567      (! %alloc-misc-fixed object header arm::double-float.size)
     1568      (! %init-double-float object value))))
     1569
     1570(defun arm2-complex-double-float->heap (seg object value)
     1571  (with-arm2-local-pinsn-macros (seg)
     1572    (let* ((header (? :mode :u32)))
     1573      (! make-header header arm::complex-double-float.element-count arm::subtag-complex-double-float)
     1574      (! %alloc-misc-fixed object header arm::complex-double-float.size)
     1575      (! %init-complex-double-float object value))))
     1576
     1577(defun arm2-check-misc-bound (seg i v)
     1578  (with-arm2-local-pinsn-macros (seg)
     1579    (let* ((header (? :mode :u32))
     1580           (element-count (? :mode :u32))
     1581           (cr (? :class :crf))
     1582           (ok (p2-get-next-label seg)))
     1583      (! uvector-header header v)
     1584      (! header->element-count element-count header)
     1585      (! compare-index-to-element-count cr i element-count)
     1586      (! cbranch-true ok cr arm::arm-cond-hi)
     1587      (! vector-index-out-of-bounds i v)
     1588      (@ ok))))
     1589     
    15611590(defun arm2-vref1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum)
    1562   (with-arm-local-vinsn-macros (seg vreg xfer)
     1591  (with-arm2-local-pinsn-macros (seg vreg xfer)
    15631592    (when vreg
    15641593      (let* ((arch (backend-target-arch *target-backend*))
     
    16311660                    (<- fp-val)
    16321661                    (ensuring-node-target (target vreg)
    1633                       (! single->node target fp-val))))
     1662                      (arm2-single->node seg target fp-val))))
    16341663                 (:signed-32-bit-vector
    16351664                  (unless temp-is-vreg
     
    17261755                  (<- fp-val)
    17271756                  (ensuring-node-target (target vreg)
    1728                     (! double->heap target fp-val)))))
     1757                    (arm2-double->heap seg target fp-val)))))
    17291758             (:complex-single-float-vector
    17301759              (with-fp-target () (fp-val :complex-single-float)
     
    17461775                  (<- fp-val)
    17471776                  (ensuring-node-target (target vreg)
    1748                     (! complex-single-float->node target fp-val)))))))
     1777                    (arm2-complex-single-float->node seg target fp-val)))))))
    17491778          (is-128-bit
    17501779              (with-fp-target () (fp-val :complex-double-float)
     
    17631792                  (<- fp-val)
    17641793                  (ensuring-node-target (target vreg)
    1765                     (! complex-double-float->heap target fp-val)))))
     1794                    (arm2-complex-double-float->heap seg target fp-val)))))
    17661795          (t
    17671796           (unless is-1-bit
     
    17901819;;; This mostly knows how to reference the elements of an immediate miscobj.
    17911820(defun arm2-vref (seg vreg xfer type-keyword vector index safe)
    1792   (with-arm-local-vinsn-macros (seg vreg xfer)
     1821  (with-arm2-local-pinsn-macros (seg vreg xfer)
    17931822    (let* ((index-known-fixnum (acode-fixnum-form-p index))
    17941823           (unscaled-idx nil)
     
    17961825      (if (or safe (not index-known-fixnum))
    17971826        (multiple-value-setq (src unscaled-idx)
    1798           (arm2-two-untargeted-reg-forms seg vector arm::arg_y index arm::arg_z))
     1827          (arm2-two-untargeted-reg-forms seg vector (?) index (?)))
    17991828        (setq src (arm2-one-untargeted-reg-form seg vector arm::arg_z)))
    18001829      (when safe
    18011830        (if (typep safe 'fixnum)
    1802           (! trap-unless-typecode= src safe))
     1831          (arm2-trap-unless-typecode= seg src safe))
    18031832        (unless index-known-fixnum
    1804           (! trap-unless-fixnum unscaled-idx))
    1805         (! check-misc-bound unscaled-idx src))
     1833          (arm2-trap-unless-fixnum seg unscaled-idx))
     1834        (arm2-check-misc-bound seg unscaled-idx src))
    18061835      (arm2-vref1 seg vreg xfer type-keyword src unscaled-idx index-known-fixnum))))
    18071836
    18081837(defun arm2-1d-vref (seg vreg xfer type-keyword vector index safe)
    1809   (with-arm-local-vinsn-macros (seg vreg xfer)
    1810     (let* ((simple-case (backend-get-next-label))
    1811            (common-case (backend-get-next-label)))
     1838  (with-arm2-local-pinsn-macros (seg vreg xfer)
     1839    (let* ((simple-case (p2-get-next-label seg))
     1840           (common-case (p2-get-next-label seg)))
    18121841      (multiple-value-bind (src unscaled-idx)
    18131842          (arm2-two-untargeted-reg-forms seg vector ($ arm::arg_y) index ($ arm::arg_z))
     
    18161845          (arm2-branch seg (arm2-make-compound-cd simple-case 0) crf arm::arm-cond-eq nil)
    18171846          (when safe
    1818             (! trap-unless-fixnum unscaled-idx)
     1847            (arm2-trap-unless-fixnum seg unscaled-idx)
    18191848            (! check-vector-header-bound src unscaled-idx)
    18201849            (when (typep safe 'fixnum)
     
    18261855            (if (typep safe 'fixnum)
    18271856              (! trap-unless-simple-1d-array src safe))
    1828             (! trap-unless-fixnum unscaled-idx)
    1829             (! check-misc-bound unscaled-idx src))
     1857            (arm2-trap-unless-fixnum seg unscaled-idx)
     1858            (arm2-check-misc-bound seg unscaled-idx src))
    18301859          (@ common-case)
    18311860          (arm2-vref1 seg vreg xfer type-keyword src unscaled-idx nil))))))
     
    18381867
    18391868(defun arm2-aset2-via-gvset (seg vreg xfer  array i j new safe type-keyword  constval &optional (simple t))
    1840   (with-arm-local-vinsn-macros (seg vreg xfer)
     1869  (with-arm2-local-pinsn-macros (seg vreg xfer)
    18411870    (let* ((i-known-fixnum (acode-fixnum-form-p i))
    18421871           (j-known-fixnum (acode-fixnum-form-p j))
     
    18621891              (! trap-unless-typed-array-2 src safe))))
    18631892        (unless i-known-fixnum
    1864           (! trap-unless-fixnum unscaled-i))
     1893          (arm2-trap-unless-fixnum seg unscaled-i))
    18651894        (unless j-known-fixnum
    1866           (! trap-unless-fixnum unscaled-j)))
     1895          (arm2-trap-unless-fixnum seg unscaled-j)))
    18671896      (with-imm-target () dim1
    18681897        (let* ((idx-reg ($ arm::arg_y)))
     
    18821911 
    18831912(defun arm2-aset2 (seg vreg xfer  array i j new safe type-keyword dim0 dim1 &optional (simple t))
    1884   (with-arm-local-vinsn-macros (seg vreg xfer)
     1913  (with-arm2-local-pinsn-macros (seg vreg xfer)
    18851914    (let* ((i-known-fixnum (acode-fixnum-form-p i))
    18861915           (j-known-fixnum (acode-fixnum-form-p j))
     
    19341963                          (! trap-unless-typed-array-2 src safe))))
    19351964                    (unless i-known-fixnum
    1936                       (! trap-unless-fixnum unscaled-i))
     1965                      (arm2-trap-unless-fixnum seg unscaled-i))
    19371966                    (unless j-known-fixnum
    1938                       (! trap-unless-fixnum unscaled-j)))
     1967                      (arm2-trap-unless-fixnum seg unscaled-j)))
    19391968                  (with-imm-target (imm-val) dim1
    19401969                    (with-node-target (src node-val) idx-reg
     
    19551984
    19561985(defun arm2-aset3 (seg vreg xfer  array i j k new safe type-keyword  dim0 dim1 dim2 &optional (simple t))
    1957   (with-arm-local-vinsn-macros (seg target)
     1986  (with-arm2-local-pinsn-macros (seg target)
    19581987    (let* ((i-known-fixnum (acode-fixnum-form-p i))
    19591988           (j-known-fixnum (acode-fixnum-form-p j))
     
    20212050                (! trap-unless-typed-array-3 src safe)))
    20222051            (unless i-known-fixnum
    2023               (! trap-unless-fixnum unscaled-i))
     2052              (arm2-trap-unless-fixnum seg unscaled-i))
    20242053            (unless j-known-fixnum
    2025               (! trap-unless-fixnum unscaled-j))
     2054              (arm2-trap-unless-fixnum seg unscaled-j))
    20262055            (unless k-known-fixnum
    2027               (! trap-unless-fixnum unscaled-k)))
     2056              (arm2-trap-unless-fixnum seg unscaled-k)))
    20282057          (with-imm-target () dim1
    20292058            (with-imm-target (dim1) dim2
     
    20432072
    20442073(defun arm2-aref2 (seg vreg xfer array i j safe typekeyword &optional dim0 dim1(simple t))
    2045   (with-arm-local-vinsn-macros (seg vreg xfer)
     2074  (with-arm2-local-pinsn-macros (seg vreg xfer)
    20462075    (let* ((i-known-fixnum (acode-fixnum-form-p i))
    20472076           (j-known-fixnum (acode-fixnum-form-p j))
     
    20822111                (! trap-unless-typed-array-2 src safe)))))
    20832112        (unless i-known-fixnum
    2084           (! trap-unless-fixnum unscaled-i))
     2113          (arm2-trap-unless-fixnum seg unscaled-i))
    20852114        (unless j-known-fixnum
    2086           (! trap-unless-fixnum unscaled-j)))
     2115          (arm2-trap-unless-fixnum seg unscaled-j)))
    20872116      (with-node-target (src) idx-reg
    20882117        (with-imm-target () dim1
     
    21032132
    21042133(defun arm2-aref3 (seg vreg xfer array i j k safe typekeyword  dim0 dim1 dim2  &optional (simple t))
    2105   (with-arm-local-vinsn-macros (seg vreg xfer)
     2134  (with-arm2-local-pinsn-macros (seg vreg xfer)
    21062135    (let* ((i-known-fixnum (acode-fixnum-form-p i))
    21072136           (j-known-fixnum (acode-fixnum-form-p j))
     
    21452174            (! trap-unless-typed-array-3 src safe)))
    21462175        (unless i-known-fixnum
    2147           (! trap-unless-fixnum unscaled-i))
     2176          (arm2-trap-unless-fixnum seg unscaled-i))
    21482177        (unless j-known-fixnum
    2149           (! trap-unless-fixnum unscaled-j))
     2178          (arm2-trap-unless-fixnum seg unscaled-j))
    21502179        (unless k-known-fixnum
    2151           (! trap-unless-fixnum unscaled-k)))
     2180          (arm2-trap-unless-fixnum seg unscaled-k)))
    21522181      (with-node-target (src) idx-reg
    21532182        (with-imm-target () dim1
     
    22902319
    22912320(defun arm2-unboxed-reg-for-aset (seg type-keyword result-reg safe constval)
    2292   (with-arm-local-vinsn-macros (seg)
     2321  (with-arm2-local-pinsn-macros (seg)
    22932322    (let* ((arch (backend-target-arch *target-backend*))
    22942323           (is-node (member type-keyword (arch::target-gvector-types arch)))
     
    23092338               (let* ((reg (available-fp-temp *available-backend-fp-temps* :complex-double-float)))
    23102339                 (when reg
    2311                    (! trap-unless-typecode= result-reg reg arm::subtag-complex-double-float))
     2340                   (arm2-trap-unless-typecode= seg result-reg arm::subtag-complex-double-float))
    23122341                 (! get-complex-double-float reg result-reg)
    23132342                 reg))
     
    23182347                  (let* ((reg (available-fp-temp *available-backend-fp-temps* :double-float)))
    23192348                    (if safe
    2320                       (! get-double? reg result-reg)
    2321                       (! get-double reg result-reg))
     2349                      (arm2-trap-unless-typecode= seg reg arm::subtag-double-float))                   
     2350                    (! get-double reg result-reg)
    23222351                    reg))
    23232352                 (:complex-single-float-vector
    23242353                  (let* ((reg (available-fp-temp *available-backend-fp-temps* :complex-single-float)))
    23252354                    (when safe
    2326                       (! trap-unless-typecode= result-reg arm::subtag-complex-single-float))
     2355                      (arm2-trap-unless-typecode= seg result-reg arm::subtag-complex-single-float))
    23272356                    (! get-complex-single-float reg result-reg)
    23282357                    reg))))
     
    23352364                     (progn
    23362365                       (when safe
    2337                          (! trap-unless-fixnum result-reg))
     2366                         (arm2-trap-unless-fixnum seg result-reg))
    23382367                       (! fixnum->signed-natural reg result-reg))
    23392368                     (! unbox-s32 reg result-reg))
     
    23892418;;; "val-reg" might be boxed, if the vreg requires it to be.
    23902419(defun arm2-vset1 (seg vreg xfer type-keyword src  unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval &optional (node-value-needs-memoization t))
    2391   (with-arm-local-vinsn-macros (seg vreg xfer)
     2420  (with-arm2-local-pinsn-macros (seg vreg xfer)
    23922421    (let* ((arch (backend-target-arch *target-backend*))
    23932422           (is-node (member type-keyword (arch::target-gvector-types arch)))
     
    25332562  (let* ((afunc *arm2-cur-afunc*))
    25342563    (setf (afunc-bits afunc) (%ilogior (afunc-bits afunc) (ash 1 $fbitccoverage)))
    2535     (with-arm-local-vinsn-macros (seg)
     2564    (with-arm2-local-pinsn-macros (seg)
    25362565      (let* ((ccreg ($ arm::temp0)))
    25372566        (arm2-store-immediate seg note ccreg)
     
    25412570
    25422571(defun arm2-vset (seg vreg xfer type-keyword vector index value safe)
    2543   (with-arm-local-vinsn-macros (seg)
     2572  (with-arm2-local-pinsn-macros (seg)
    25442573    (let* ((arch (backend-target-arch *target-backend*))
    25452574           (is-node (member type-keyword (arch::target-gvector-types arch)))
     
    25742603              (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*)))
    25752604            (if (typep safe 'fixnum)
    2576               (! trap-unless-typecode= src safe))
     2605              (arm2-trap-unless-typecode= seg src safe))
    25772606            (unless index-known-fixnum
    2578               (! trap-unless-fixnum unscaled-idx))
    2579             (! check-misc-bound unscaled-idx src)))
     2607              (arm2-trap-unless-fixnum seg unscaled-idx))
     2608            (arm2-check-misc-bound seg unscaled-idx src)))
    25802609        (arm2-vset1 seg vreg xfer type-keyword src unscaled-idx index-known-fixnum result-reg (arm2-unboxed-reg-for-aset seg type-keyword result-reg safe constval) constval needs-memoization)))))
    25812610
    25822611(defun arm2-1d-vset (seg vreg xfer type-keyword vector index value safe)
    2583   (with-arm-local-vinsn-macros (seg)
     2612  (with-arm2-local-pinsn-macros (seg)
    25842613    (let* ((arch (backend-target-arch *target-backend*))
    2585            (simple-case (backend-get-next-label))
    2586            (common-case (backend-get-next-label))
     2614           (simple-case (p2-get-next-label seg))
     2615           (common-case (p2-get-next-label seg))
    25872616           (is-node (member type-keyword (arch::target-gvector-types arch)))
    25882617           (constval (arm2-constant-value-ok-for-type-keyword type-keyword value))
     
    26072636          (arm2-branch seg (arm2-make-compound-cd simple-case 0) crf arm::arm-cond-eq nil))
    26082637          (when safe
    2609             (! trap-unless-fixnum unscaled-idx)
     2638            (arm2-trap-unless-fixnum seg unscaled-idx)
    26102639            (! check-vector-header-bound src unscaled-idx)
    26112640            (when (typep safe 'fixnum)
     
    26172646            (if (typep safe 'fixnum)
    26182647              (! trap-unless-simple-1d-array src safe))
    2619             (! trap-unless-fixnum unscaled-idx)
    2620             (! check-misc-bound unscaled-idx src))
     2648            (arm2-trap-unless-fixnum seg unscaled-idx)
     2649            (arm2-check-misc-bound seg unscaled-idx src))
    26212650          (@ common-case)
    26222651
     
    26812710
    26822711(defun arm2-call-fn (seg vreg xfer fn arglist spread-p)
    2683   (with-arm-local-vinsn-macros (seg vreg xfer)
     2712  (with-arm2-local-pinsn-macros (seg vreg xfer)
    26842713    (when spread-p
    26852714      (destructuring-bind (stack-args reg-args) arglist
     
    27442773
    27452774(defun arm2-restore-full-lisp-context (seg)
    2746   (with-arm-local-vinsn-macros (seg)
     2775  (with-arm2-local-pinsn-macros (seg)
    27472776    (! restore-full-lisp-context)))
    27482777
     
    27572786  ; *arm2-open-code-inline*, since that does imply a time/speed
    27582787  ; tradeoff.
    2759   (with-arm-local-vinsn-macros (seg)
     2788  (with-arm2-local-pinsn-macros (seg)
    27602789    (if *arm2-optimize-for-space*
    27612790      (if jump-p
     
    27682797;;; Nargs = nil -> multiple-value case.
    27692798(defun arm2-invoke-fn (seg fn nargs spread-p xfer)
    2770   (with-arm-local-vinsn-macros (seg)
     2799  (with-arm2-local-pinsn-macros (seg)
    27712800    (let* ((f-op (acode-unwrapped-form-value fn))
    27722801           (immp (and (acode-p f-op)
     
    29152944
    29162945(defun arm2-make-closure (seg afunc downward-p)
    2917   (with-arm-local-vinsn-macros (seg)
     2946  (with-arm2-local-pinsn-macros (seg)
    29182947    (flet ((var-to-reg (var target)
    29192948             (let* ((ea (var-ea (var-bits var))))
     
    30563085
    30573086(defun arm2-formlist (seg stkargs &optional revregargs)
    3058   (with-arm-local-vinsn-macros (seg) 
     3087  (with-arm2-local-pinsn-macros (seg) 
    30593088    (let* ((nregs (length revregargs))
    30603089           (n nregs))
     
    30943123                 (:signed-doubleword :s64)))
    30953124         (modeval (gpr-mode-name-value mode)))
    3096     (with-arm-local-vinsn-macros (seg)
     3125    (with-arm2-local-pinsn-macros (seg)
    30973126      (let* ((value (arm2-integer-constant-p form mode)))
    30983127        (if value
     
    31643193         (nested (> *arm2-undo-count* 0))
    31653194         vinsn)
    3166     (with-arm-local-vinsn-macros (seg)
     3195    (with-arm2-local-pinsn-macros (seg)
    31673196      (if a-node
    31683197        (setq vinsn (arm2-vpush-register seg areg))
     
    32083237         (nested (> *arm2-undo-count* 0))
    32093238         vinsn)
    3210     (with-arm-local-vinsn-macros (seg)
     3239    (with-arm2-local-pinsn-macros (seg)
    32113240      (if a-node
    32123241        (setq vinsn (arm2-vpop-register seg areg))
     
    32343263      vinsn)))
    32353264
    3236 (defun arm2-acc-reg-for (reg)
    3237   (with-arm-local-vinsn-macros (seg)
    3238     (if (and (eql (hard-regspec-class reg) hard-reg-class-gpr)
    3239              (eql (get-regspec-mode reg) hard-reg-class-gpr-mode-node))
    3240       ($ arm::arg_z)
    3241       reg)))
     3265
    32423266
    32433267(defun arm2-copy-fpr (seg dest src)
    32443268  ;; src and dest are distinct FPRs with the same mode.
    3245   (with-arm-local-vinsn-macros (seg)
     3269  (with-arm2-local-pinsn-macros (seg)
    32463270    (case (fpr-mode-value-name (get-regspec-mode src))
    3247       (:single-float (! simgle-to-single dest src))
     3271      (:single-float (! single-to-single dest src))
    32483272      (:double-float (! double-to-double dest src))
    32493273      (:complex-single-float (! complex-single-float-to-complex-single-float
     
    32563280;;; It's easier to elide pushes and pops to the SP.
    32573281(defun arm2-elide-pushes (seg push-vinsn pop-vinsn)
    3258   (with-arm-local-vinsn-macros (seg)
     3282  (with-arm2-local-pinsn-macros (seg)
    32593283    (let* ((operands (vinsn-variable-parts push-vinsn))
    32603284           (pushed-reg (svref operands  0))
     
    34683492    (if (and aalready balready)
    34693493      (values aalready balready)
    3470       (with-arm-local-vinsn-macros (seg)
     3494      (with-arm2-local-pinsn-macros (seg)
    34713495        (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
    34723496               (avar (arm2-lexical-reference-p aform))
     
    36173641
    36183642(defun arm2-three-untargeted-reg-forms (seg aform areg bform breg cform creg)
    3619   (with-arm-local-vinsn-macros (seg)
     3643  (with-arm2-local-pinsn-macros (seg)
    36203644    (let* ((*arm2-nfp-depth* *arm2-nfp-depth*)
    36213645           (bnode (nx2-node-gpr-p breg))
     
    38093833
    38103834(defun arm2-lri (seg reg value)
    3811   (with-arm-local-vinsn-macros (seg)
     3835  (with-arm2-local-pinsn-macros (seg)
    38123836    (if (>= value 0)
    38133837      (! lri reg value)
     
    38163840
    38173841(defun arm2-multiple-value-body (seg form)
    3818   (let* ((lab (backend-get-next-label))
     3842  (let* ((lab (p2-get-next-label seg))
    38193843         (*arm2-vstack* *arm2-vstack*)
    38203844         (old-stack (arm2-encode-stack)))
    3821     (with-arm-local-vinsn-macros (seg)
     3845    (with-arm2-local-pinsn-macros (seg)
    38223846      (arm2-open-undo $undomvexpect)
    38233847      (arm2-undo-body seg nil (logior $backend-mvpass-mask lab) form old-stack)
     
    38793903
    38803904(defun arm2-compare-u8 (seg vreg xfer form u8constant cr-bit true-p u8-operator)
    3881   (with-arm-local-vinsn-macros (seg vreg xfer)
     3905  (with-arm2-local-pinsn-macros (seg vreg xfer)
    38823906    (with-imm-target () (u8 :u8)
    38833907      (with-crf-target () crf
     
    39033927;;; There are other cases involving constants that are worth exploiting.
    39043928(defun arm2-compare (seg vreg xfer i j cr-bit true-p)
    3905   (with-arm-local-vinsn-macros (seg vreg xfer)
     3929  (with-arm2-local-pinsn-macros (seg vreg xfer)
    39063930    (let* ((iu8 (let* ((i-fixnum (acode-fixnum-form-p i)))
    39073931                  (if (typep i-fixnum '(unsigned-byte 8))
     
    39423966
    39433967(defun arm2-natural-compare (seg vreg xfer i j cr-bit true-p)
    3944   (with-arm-local-vinsn-macros (seg vreg xfer)
     3968  (with-arm2-local-pinsn-macros (seg vreg xfer)
    39453969    (let* ((jconst (arm2-constant-for-compare-p j t))
    39463970           (iconst (arm2-constant-for-compare-p i t))
     
    39713995
    39723996(defun arm2-compare-registers (seg vreg xfer ireg jreg cr-bit true-p)
    3973   (with-arm-local-vinsn-macros (seg vreg xfer)
     3997  (with-arm2-local-pinsn-macros (seg vreg xfer)
    39743998    (if vreg
    39753999      (regspec-crf-gpr-case
     
    39864010
    39874011(defun arm2-compare-register-to-nil (seg vreg xfer ireg cr-bit true-p)
    3988   (with-arm-local-vinsn-macros (seg vreg xfer)
     4012  (with-arm2-local-pinsn-macros (seg vreg xfer)
    39894013    (if vreg
    39904014      (regspec-crf-gpr-case
     
    40014025
    40024026(defun arm2-compare-double-float-registers (seg vreg xfer ireg jreg cr-bit true-p)
    4003   (with-arm-local-vinsn-macros (seg vreg xfer)
     4027  (with-arm2-local-pinsn-macros (seg vreg xfer)
    40044028    (if vreg
    40054029      (regspec-crf-gpr-case
     
    40174041
    40184042(defun arm2-compare-single-float-registers (seg vreg xfer ireg jreg cr-bit true-p)
    4019   (with-arm-local-vinsn-macros (seg vreg xfer)
     4043  (with-arm2-local-pinsn-macros (seg vreg xfer)
    40204044    (if vreg
    40214045      (regspec-crf-gpr-case
     
    40464070(defun arm2-test-reg-%izerop (seg vreg xfer reg cr-bit true-p  zero)
    40474071  (declare (fixnum reg))
    4048   (with-arm-local-vinsn-macros (seg vreg xfer)
     4072  (with-arm2-local-pinsn-macros (seg vreg xfer)
    40494073    (regspec-crf-gpr-case
    40504074     (vreg dest)
     
    40794103
    40804104(defun arm2-vpush-register (seg src)
    4081   (with-arm-local-vinsn-macros (seg)
     4105  (with-arm2-local-pinsn-macros (seg)
    40824106    (prog1
    40834107      (! vpush-register src)
     
    40904114
    40914115(defun arm2-vpop-register (seg dest)
    4092   (with-arm-local-vinsn-macros (seg)
     4116  (with-arm2-local-pinsn-macros (seg)
    40934117    (prog1
    40944118      (! vpop-register dest)
     
    41044128     
    41054129(defun arm2-copy-register (seg dest src)
    4106   (with-arm-local-vinsn-macros (seg)
     4130  (with-arm2-local-pinsn-macros (seg)
    41074131    (when dest
    41084132      (let* ((dest-gpr (backend-ea-physical-reg dest hard-reg-class-gpr))
     
    41434167                    (! s8->fixnum dest src))
    41444168                   (#.hard-reg-class-gpr-mode-address
    4145                     (! macptr->heap dest src))))
     4169                    (arm2-macptr->heap seg dest src))))
    41464170                ((#.hard-reg-class-gpr-mode-u32
    41474171                  #.hard-reg-class-gpr-mode-address)
     
    41564180                         (unless (or (logbitp #.hard-reg-class-gpr-mode-address src-type)
    41574181                                     *arm2-reckless*)
    4158                            (! trap-unless-macptr src))
     4182                           (arm2-trap-unless-typecode= seg src arm::subtag-macptr))
    41594183                         (! deref-macptr dest src)))))
    41604184                   ((#.hard-reg-class-gpr-mode-u32
     
    42334257                                               (get-node-regspec-type-modes src))
    42344258                                      *arm2-reckless*)
    4235                             (! trap-unless-double-float src))
     4259                            (arm2-trap-unless-typecode= seg src arm::subtag-double-float))
    42364260                          (! get-double dest src))
    42374261                         (#.hard-reg-class-fpr-mode-single
     
    42414265                                                  (#.hard-reg-class-fpr-mode-complex-single-float
    42424266                          (unless *arm2-reckless*
    4243                             (! trap-unless-typecode= src arm::subtag-complex-single-float))
     4267                            (arm2-trap-unless-typecode= seg src arm::subtag-complex-single-float))
    42444268                          (! get-complex-single-float dest src))
    42454269                         (#.hard-reg-class-fpr-mode-complex-double-float
    42464270                          (unless *arm2-reckless*
    4247                             (! trap-unless-typecode= src arm::subtag-complex-double-float))
     4271                            (arm2-trap-unless-typecode= seg src arm::subtag-complex-double-float))
    42484272                          (! get-complex-double-float dest src)))))))
    42494273                (if dest-gpr
     
    42534277                       (case src-mode
    42544278                         (#.hard-reg-class-fpr-mode-double
    4255                           (! double->heap dest src))
     4279                          (arm2-double->heap seg dest src))
    42564280                         (#.hard-reg-class-fpr-mode-complex-double-float
    4257                             (! complex-double-float->heap dest src))
     4281                            (arm2-complex-double-float->heap seg dest src))
    42584282                         (#.hard-reg-class-fpr-mode-single
    4259                           (! single->node dest src))
     4283                          (arm2-single->node seg dest src))
    42604284                         (#.hard-reg-class-fpr-mode-complex-single-float
    4261                             (! complex-single-float->node dest src))))))
     4285                            (arm2-complex-single-float->node seg dest src))))))
    42624286                  (if (and src-fpr dest-fpr)
    42634287                    (unless (and (eql dest-fpr src-fpr)
     
    43174341  (when (acode-p form)
    43184342    (arm-with-note (form seg curstack) ; note this rebinds form/seg/curstack so can't setq
    4319       (with-arm-local-vinsn-macros (seg)
     4343      (with-arm2-local-pinsn-macros (seg)
    43204344        (let* ((op (acode-operator form))
    43214345               (operands (acode-operands form)))
     
    43434367                 (let* ((y ($ arm::arg_y))
    43444368                        (z ($ arm::arg_z))
    4345                         (result ($ arm::arg_z)))
     4369                        (result ($ arm::arg_z))
     4370                        (header ($ arm::imm0 :mode :u32))
     4371                        (zero ($ arm::imm1 :mode :u32)))
     4372
    43464373                   (arm2-two-targeted-reg-forms seg (car operands) y (cadr operands) z)
     4374                   (! make-header header 3 arm::subtag-simple-vector)
     4375                   (! lri zero 0)
    43474376                   (arm2-open-undo $undostkblk )
    4348                    (! make-stack-cons result y z)
     4377                   (! make-stack-cons result y z header 0)
    43494378                   (setq val result)))
    43504379                ((eq op (%nx1-operator %consmacptr%))
     
    43654394                             (! make-stack-block0)))
    43664395                       (with-crf-target () crf
    4367                          (let ((stack-block-0-label (backend-get-next-label))
    4368                                (done-label (backend-get-next-label))
     4396                         (let ((stack-block-0-label (p2-get-next-label seg))
     4397                               (done-label (p2-get-next-label seg))
    43694398                               (rval ($ arm::arg_z))
    43704399                               (rclear ($ arm::arg_y)))
     
    44194448(defun arm2-seq-bind-var (seg var val)
    44204449
    4421   (with-arm-local-vinsn-macros (seg)
     4450  (with-arm2-local-pinsn-macros (seg)
    44224451    (let* ((sym (var-name var))
    44234452           (bits (nx-var-bits var))
     
    44674496                  (arm2-set-var-ea seg var (or ea reg (arm2-vloc-ea vloc closed-p)))
    44684497                  (when make-vcell
    4469                     (with-node-temps () (vcell closed)
     4498                    (let* ((header (? :mode :u32))
     4499                           (vcell (?))
     4500                           (closed (?)))
    44704501                        (arm2-stack-to-register seg vloc closed)
     4502                        (! make-header header arm::value-cell.element-count
     4503                           arm::subtag-value-cell)
    44714504                        (if closed-downward
    44724505                          (progn
    4473                             (! make-stack-vcell vcell closed)
     4506                            (! make-stack-vcell vcell closed )
    44744507                            (arm2-open-undo $undostkblk))
    44754508                          (! make-vcell vcell closed))
     
    44874520                          (make-vcell (and closed-p (eq bits (var-bits var))))
    44884521                          (addr (arm2-vloc-ea vloc)))
    4489   (with-arm-local-vinsn-macros (seg)
     4522  (with-arm2-local-pinsn-macros (seg)
    44904523    (if (%ilogbitp $vbitspecial bits)
    44914524      (progn
     
    45034536                (! make-stack-vcell vcell closed)
    45044537                (arm2-open-undo $undostkblk))
    4505               (! make-vcell vcell closed))
     4538              (let* ((header (? :mode :u32)))
     4539                (! make-header header arm::value-cell.element-count
     4540                   arm::subtag-value-cell)
     4541                (! %alloc-misc-fixed vcell header arm::value-cell.size)
     4542                (! misc-set-c-node closed vcell 0)))
    45064543            (arm2-register-to-stack seg vcell vloc)))
    45074544         
     
    45314568
    45324569(defun arm2-dbind (seg value sym)
    4533   (with-arm-local-vinsn-macros (seg)
     4570  (with-arm2-local-pinsn-macros (seg)
    45344571    (let* ((ea-p (arm2-load-ea-p value))
    45354572           (nil-p (unless ea-p (nx-null (setq value (nx-untyped-form value)))))
     
    45864623;;; Callers should really be sure that this is what they want to use.
    45874624(defun arm2-absolute-natural (seg vreg xfer value)
    4588   (with-arm-local-vinsn-macros (seg vreg xfer)
     4625  (with-arm2-local-pinsn-macros (seg vreg xfer)
    45894626    (when vreg
    45904627      (arm2-lri seg vreg value))
     
    46014638
    46024639(defun arm2-store-macptr (seg vreg address-reg)
    4603   (with-arm-local-vinsn-macros (seg vreg)
     4640  (with-arm2-local-pinsn-macros (seg vreg)
    46044641    (when (arm2-for-value-p vreg)
    46054642      (if (logbitp vreg arm-imm-regs)
    46064643        (<- address-reg)
    4607         (! macptr->heap vreg address-reg)))))
     4644        (arm2-macptr->heap seg vreg address-reg)))))
    46084645
    46094646(defun arm2-store-signed-longword (seg vreg imm-reg)
    4610   (with-arm-local-vinsn-macros (seg vreg)
     4647  (with-arm2-local-pinsn-macros (seg vreg)
    46114648    (when (arm2-for-value-p vreg)
    46124649      (if (logbitp vreg arm-imm-regs)
     
    46154652
    46164653(defun arm2-store-signed-halfword (seg vreg imm-reg)
    4617   (with-arm-local-vinsn-macros (seg vreg)
     4654  (with-arm2-local-pinsn-macros (seg vreg)
    46184655    (when (arm2-for-value-p vreg)
    46194656      (if (logbitp vreg arm-imm-regs)
     
    46234660
    46244661(defun arm2-store-unsigned-halfword (seg vreg imm-reg)
    4625   (with-arm-local-vinsn-macros (seg vreg)
     4662  (with-arm2-local-pinsn-macros (seg vreg)
    46264663    (when (arm2-for-value-p vreg)
    46274664      (if (logbitp vreg arm-imm-regs)
     
    46344671;;; evaluated, evaluate "val" before evaluating "offset".
    46354672(defun arm2-%immediate-set-ptr (seg vreg xfer  ptr offset val)
    4636   (with-arm-local-vinsn-macros (seg vreg xfer)
     4673  (with-arm2-local-pinsn-macros (seg vreg xfer)
    46374674    (let* ((intval (acode-absolute-ptr-p val))
    46384675           (offval (acode-fixnum-form-p offset))
     
    47344771 
    47354772(defun arm2-memory-store-displaced (seg valreg basereg displacement size)
    4736   (with-arm-local-vinsn-macros (seg)
     4773  (with-arm2-local-pinsn-macros (seg)
    47374774    (case size
    47384775      ;;(8 (! mem-set-c-doubleword valreg basereg displacement))
     
    47424779
    47434780(defun arm2-memory-store-indexed (seg valreg basereg idxreg size)
    4744   (with-arm-local-vinsn-macros (seg)
     4781  (with-arm2-local-pinsn-macros (seg)
    47454782    (case size
    47464783      ;;(8 (! mem-set-doubleword valreg basereg idxreg))
     
    47504787     
    47514788(defun arm2-%immediate-store  (seg vreg xfer bits ptr offset val)
    4752   (with-arm-local-vinsn-macros (seg vreg xfer)
     4789  (with-arm2-local-pinsn-macros (seg vreg xfer)
    47534790    (if (eql 0 (%ilogand #xf bits))
    47544791      (arm2-%immediate-set-ptr seg vreg xfer  ptr offset val)
     
    49194956            (eq op (%nx1-operator lexical-reference)))
    49204957      (let* ((var (car (acode-operands form))))
    4921         (not (rassoc var *arm2-nfp-vars*))))))
     4958        (not (null (rassoc var *arm2-nfp-vars*)))))))
    49224959
    49234960
     
    49574994  (declare (ignorable check-boundp))
    49584995  (setq check-boundp (not *arm2-reckless*))
    4959   (with-arm-local-vinsn-macros (seg vreg xfer)
     4996  (with-arm2-local-pinsn-macros (seg vreg xfer)
    49604997    (when (or check-boundp vreg)
    49614998      (unless vreg (setq vreg ($ arm::arg_z)))
     
    49855022#|
    49865023               (defun arm2-ref-symbol-value (seg vreg xfer sym check-boundp) 
    4987 (with-arm-local-vinsn-macros (seg vreg xfer)
     5024(with-arm2-local-pinsn-macros (seg vreg xfer)
    49885025(when vreg
    49895026(if (eq sym '*interrupt-level*)
     
    50025039;;; Should be less eager to box result
    50035040(defun arm2-extract-charcode (seg vreg xfer char safe)
    5004   (with-arm-local-vinsn-macros (seg vreg xfer)
     5041  (with-arm2-local-pinsn-macros (seg vreg xfer)
    50055042    (let* ((src (arm2-one-untargeted-reg-form seg char arm::arg_z)))
    50065043      (when safe
     
    50155052  (if (arm2-form-typep listform 'list)
    50165053    (setq safe nil))     ; May also have been passed as NIL.
    5017   (with-arm-local-vinsn-macros (seg vreg xfer)
     5054  (with-arm2-local-pinsn-macros (seg vreg xfer)
    50185055    (let* ((src (arm2-one-untargeted-reg-form seg listform arm::arg_z)))
    50195056      (when safe
     
    50525089
    50535090(defun arm2-allocate-initialized-gvector (seg vreg xfer subtag initforms)
    5054   (with-arm-local-vinsn-macros (seg vreg xfer)
     5091  (with-arm2-local-pinsn-macros (seg vreg xfer)
    50555092    (if (null vreg)
    50565093      (dolist (f initforms) (arm2-form seg nil nil f))
     
    50635100                         (unless (arm-side-effect-free-form-p f)
    50645101                           (incf count)))))
    5065              (header (arch::make-vheader n subtag)))
     5102             (header (? :mode :u32)))
    50665103        (declare (fixnum n nntriv))
    5067         (cond ( (or *arm2-open-code-inline* (> nntriv 3))
    5068                (arm2-formlist seg initforms nil)
    5069                 (arm2-lri seg arm::imm0 header)
    5070                 (! %arm-gvector vreg arm::imm0 (ash n (arch::target-word-shift arch))))
    5071               (t
    5072                (let* ((pending ())
     5104        (let* ((pending ())
    50735105                      (vstack *arm2-vstack*))
    50745106                 (declare (fixnum vstack))
     
    50795111                       (push nil pending)
    50805112                       (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg form arm::arg_z)))))
    5081                  (arm2-lri seg arm::imm0 header)
     5113                 (! make-header header n subtag)
    50825114                 (ensuring-node-target (target vreg)
    5083                    (! %alloc-misc-fixed target arm::imm0 (ash n (arch::target-word-shift arch)))
    5084                    (with-node-temps (target) (nodetemp)
    5085                      (do* ((forms pending (cdr forms))
     5115                   (! %alloc-misc-fixed target header (ash n (arch::target-word-shift arch)))
     5116                   (do* ((forms pending (cdr forms))
    50865117                           (index (1- n) (1- index))
    50875118                           (pushed-cell (+ vstack (the fixnum (ash nntriv (arch::target-word-shift arch))))))
     
    50895120                       (declare (list forms) (fixnum pushed-cell))
    50905121                       (let* ((form (car forms))
    5091                               (reg nodetemp))
     5122                              (reg ()))
    50925123                         (if form
    5093                            (setq reg (arm2-one-untargeted-reg-form seg form nodetemp))
     5124                           (setq reg (arm2-one-untargeted-reg-form seg form (?)))
    50945125                           (progn
     5126                             (setq reg (?))
    50955127                             (decf pushed-cell *arm2-target-node-size*)
    5096                              (arm2-stack-to-register seg (arm2-vloc-ea pushed-cell) nodetemp)))
    5097                          (! misc-set-c-node reg target index)))))
    5098                  (! vstack-discard nntriv))
    5099                ))))
     5128                             (arm2-stack-to-register seg (arm2-vloc-ea pushed-cell) reg )))
     5129                         (! misc-set-c-node reg target index))))
     5130                 (! vstack-discard nntriv))))
    51005131    (^)))
    51015132
     
    51175148  (if (arm2-form-typep ptrform 'cons)
    51185149    (setq safe nil))                    ; May also have been passed as NIL.
    5119   (with-arm-local-vinsn-macros (seg vreg xfer)
     5150  (with-arm2-local-pinsn-macros (seg vreg xfer)
    51205151    (multiple-value-bind (ptr-vreg val-vreg) (arm2-two-targeted-reg-forms seg ptrform ($ arm::arg_y) valform ($ arm::arg_z))
    51215152      (when safe
    5122         (! trap-unless-cons ptr-vreg))
     5153        (let* ((tag (? :mode :u32))
     5154               (cr (? :class :crf)))
     5155          (! extract-fulltag tag ptr-vreg)
     5156          (! compare-immediate cr tag arm::fulltag-cons)
     5157          (! cond-error-if-reg-not-fulltag cr arm::arm-cond-ne ptr-vreg arm::fulltag-cons)))
    51235158      (if setcdr
    51245159        (! call-subprim-2 ($ arm::arg_z) (arm::arm-subprimitive-offset '.SPrplacd) ptr-vreg val-vreg)
     
    51565191  (declare (notinline arm2-branch))
    51575192  (let* ((*arm2-vstack* *arm2-vstack*))
    5158     (with-arm-local-vinsn-macros (seg)
     5193    (with-arm2-local-pinsn-macros (seg)
    51595194      (setq xfer (or xfer 0))
    51605195      (when (logbitp $backend-mvpass-bit xfer) ;(arm2-mvpass-p cd)
     
    51885223                    (! cbranch-false nlabel crf cr-bit)
    51895224                    (! cbranch-true tlabel crf cr-bit))
    5190                   (let* ((aux-label (backend-get-next-label))
     5225                  (let* ((aux-label (p2-get-next-label seg))
    51915226                         (auxl (aref *backend-labels* aux-label)))
    51925227                    (if tn0
     
    52435278         (numundo (%i- *arm2-undo-count* (arm2-encoding-undo-count old-stack))))
    52445279    (declare (fixnum numundo))
    5245     (with-arm-local-vinsn-macros (seg vreg xfer)
     5280    (with-arm2-local-pinsn-macros (seg vreg xfer)
    52465281      (if (arm2-equal-encodings-p  current-stack old-stack)
    52475282        (arm2-form seg vreg xfer body)
     
    52915326        (arm2-decode-stack (aref *arm2-undo-stack* target-catch))))
    52925327    (if (%i< 0 (setq diff (%i- current-cstack target-cstack)))
    5293       (with-arm-local-vinsn-macros (seg)
     5328      (with-arm2-local-pinsn-macros (seg)
    52945329        (! adjust-sp diff)))
    52955330    (if (%i< 0 (setq diff (%i- current-vstack target-vstack)))
    5296       (with-arm-local-vinsn-macros (seg)
     5331      (with-arm2-local-pinsn-macros (seg)
    52975332        (! vstack-discard (ash diff (- *arm2-target-fixnum-shift*)))))
    52985333    exit-vstack))
     
    53055340(defun arm2-do-return (seg)
    53065341  (let* ((*arm2-vstack* *arm2-vstack*))
    5307     (with-arm-local-vinsn-macros (seg)
     5342    (with-arm2-local-pinsn-macros (seg)
    53085343      (progn
    53095344        (arm2-set-vstack (arm2-unwind-stack seg $backend-return 0 0 #x7fffff))
     
    53265361  (let* ((cstack *arm2-cstack*)
    53275362         (vstack *arm2-vstack*))
    5328     (with-arm-local-vinsn-macros (seg vreg xfer)
     5363    (with-arm2-local-pinsn-macros (seg vreg xfer)
    53295364      (if (and (eq xfer $backend-return) (not (arm2-tailcallok xfer)))
    53305365        (progn
     
    53905425
    53915426(defun arm2-init-regvar (seg var reg addr)
    5392   (with-arm-local-vinsn-macros (seg)
     5427  (with-arm2-local-pinsn-macros (seg)
    53935428    (arm2-stack-to-register seg addr reg)
    53945429    (arm2-set-var-ea seg var (make-wired-lreg reg :class (hard-regspec-class reg) :mode (get-regspec-mode reg)))))
     
    54175452         reason)
    54185453    (declare (ignorable junk1))
    5419     (with-arm-local-vinsn-macros (seg)
     5454    (with-arm2-local-pinsn-macros (seg)
    54205455      (when (neq 0 nlevels)
    54215456        (let* ((numnlispareas 0))
     
    54725507                  (incf numnlispareas))
    54735508                (if (%i> cstack target-cstack)
    5474                   (with-arm-local-vinsn-macros (seg)
     5509                  (with-arm2-local-pinsn-macros (seg)
    54755510                    (! adjust-sp (%i- cstack target-cstack))))
    54765511                                        ; else what's going on? $sp-stkcons, for one thing
     
    54795514        vstack))))
    54805515
     5516(defun arm2-dpayback (seg n)
     5517  (with-arm2-local-pinsn-macros (seg)
     5518    (cond ((= n 1) (! dpayback-1))
     5519          (t (let* ((count (? :mode :u32)))
     5520               (! lri count n)
     5521               (! dpayback-n count))))))
    54815522
    54825523;;; Restore the most recent dynamic bindings.  Bindings
    54835524;;; of *INTERRUPT-LEVEL* get special treatment.
    54845525(defun arm2-dpayback-list (seg reasons)
    5485   (with-arm-local-vinsn-macros (seg)
     5526  (with-arm2-local-pinsn-macros (seg)
    54865527    (let* ((n 0))
    54875528      (declare (fixnum n))
    5488       (dolist (r reasons (if (> n 0) (! dpayback n)))
     5529      (dolist (r reasons (if (> n 0) (arm2-dpayback seg n)))
    54895530        (if (eql r $undospecial)
    54905531          (incf n)
     
    54925533            (progn
    54935534              (when (> n 0)
    5494                 (! dpayback n)
     5535                (arm2-dpayback seg n)
    54955536                (setq n 0))
     5537              #+unbind-interrupt-level-inline
    54965538              (if *arm2-open-code-inline*
    54975539                (! unbind-interrupt-level-inline)
    5498                 (! unbind-interrupt-level)))
     5540                (! unbind-interrupt-level))
     5541
     5542            #-unbind-interrupt-level-inlune
     5543            (! unbind-interrupt-level))
    54995544            (compiler-bug "unknown payback token ~s" r)))))))
    55005545
     
    56925737
    56935738(defun arm2-fixed-call-builtin (seg vreg xfer name)
    5694   (with-arm-local-vinsn-macros (seg vreg xfer)
     5739  (with-arm2-local-pinsn-macros (seg vreg xfer)
    56955740    (let* ((index (arch::builtin-function-name-offset name))
    56965741           (subprim (if index
     
    57125757
    57135758(defun arm2-unary-builtin (seg vreg xfer name form)
    5714   (with-arm-local-vinsn-macros (seg)
     5759  (with-arm2-local-pinsn-macros (seg)
    57155760    (arm2-one-targeted-reg-form seg form ($ arm::arg_z))
    57165761    (arm2-fixed-call-builtin seg vreg xfer name)))
    57175762
    57185763(defun arm2-binary-builtin (seg vreg xfer name form1 form2)
    5719   (with-arm-local-vinsn-macros (seg)
     5764  (with-arm2-local-pinsn-macros (seg)
    57205765    (arm2-two-targeted-reg-forms seg form1 ($ arm::arg_y) form2 ($ arm::arg_z))
    57215766    (arm2-fixed-call-builtin seg vreg xfer name)))
    57225767
    57235768(defun arm2-ternary-builtin (seg vreg xfer name form1 form2 form3)
    5724   (with-arm-local-vinsn-macros (seg)
     5769  (with-arm2-local-pinsn-macros (seg)
    57255770    (arm2-three-targeted-reg-forms seg form1 ($ arm::arg_x) form2 ($ arm::arg_y) form3 ($ arm::arg_z))
    57265771    (arm2-fixed-call-builtin seg vreg xfer name)))
     
    57365781        (let* ((fun `(nfunction ,name
    57375782                      (lambda (,vcode-block ,dest ,control ,@other-args) ,@decls
    5738                               (block ,name (with-arm-local-vinsn-macros (,vcode-block ,dest ,control) ,@body))))))
     5783                              (block ,name (with-arm2-local-pinsn-macros (,vcode-block ,dest ,control) ,@body))))))
    57395784          `(progn
    57405785            (record-source-file ',name 'function)
     
    57855830
    57865831(defarm2 arm2-lambda lambda-list (seg vreg xfer req opt rest keys auxen body p2decls &optional code-note)
    5787   (with-arm-local-vinsn-macros (seg vreg xfer)
     5832  (with-arm2-local-pinsn-macros (seg vreg xfer)
    57885833    (let* ((stack-consed-rest nil)
    57895834           (lexprp (if (consp rest) (progn (setq rest (car rest)) t)))
     
    58215866         
    58225867          (nx2-afunc-allocate-global-registers afunc (unless no-regs *arm2-nvrs*)))
    5823         (@ (backend-get-next-label))    ; generic self-reference label, should be label #1
     5868        (@ (p2-get-next-label seg))    ; generic self-reference label, should be label #1
    58245869        (when keys;; Ensure keyvect is the first immediate
    58255870          (backend-immediate-index (%cadr (%cdddr keys))))
     
    58395884                     (<= num-opt $numarmargregs))
    58405885              (setq arg-regs (arm2-simple-opt-entry seg rev-opt rev-fixed))
    5841               (progn
     5886              (let* ((rnargs ($ arm::nargs :mode :u32)))
    58425887                ;; If the minumum acceptable number of args is
    58435888                ;; non-zero, ensure that at least that many were
     
    58455890               
    58465891                (when rev-fixed
    5847                   (if (arm::encode-arm-immediate num-fixed)
    5848                     (! check-min-nargs num-fixed)
    5849                     (! check-min-nargs-large num-fixed)))
     5892                  (arm2-check-nargs seg rnargs num-fixed arm::arm-cond-hs))
    58505893                (unless (or rest keys)
    5851                   (let* ((max (+ num-fixed num-opt)))
    5852                     (if (arm::encode-arm-immediate max)
    5853                       (! check-max-nargs max)
    5854                       (! check-max-nargs-large max))))
     5894                  (arm2-check-nargs seg rnargs (+ num-fixed num-opt) arm::arm-cond-ls))
    58555895                (unless lexprp
    5856                   (! save-lisp-context-variable))
     5896                  (let* ((marker ($ arm::imm0 :mode :u32))
     5897                         (savevsp ($ arm::imm1 :mode :u32)))
     5898                    (! lri marker arm::lisp-frame-marker)
     5899                    (! set-variable-savevsp savevsp)
     5900                    (! save-lisp-context-offset marker savevsp)))
    58575901                ;; If there were &optional args, initialize their values
    58585902                ;; to NIL.  All of the argregs get vpushed as a result of this.
     
    60526096        (arm2-two-untargeted-reg-forms seg instance arm::arg_y idx arm::arg_z)
    60536097      (unless *arm2-reckless*
    6054         (! check-misc-bound i v))
     6098        (arm2-check-misc-bound seg i v))
    60556099      (with-node-temps (v i) (temp)
    60566100        (! %slot-ref temp v i)
     
    61026146      (arm2-form seg nil nil y)
    61036147      (arm2-form seg nil xfer z))
    6104     (multiple-value-bind (yreg zreg) (arm2-two-untargeted-reg-forms seg y arm::arg_y z arm::arg_z)
    6105       (ensuring-node-target (target vreg)
    6106         (! cons target yreg zreg))
     6148    (multiple-value-bind (yreg zreg) (arm2-two-untargeted-reg-forms seg y (?) z (?))
     6149      (let* ((temp (? :mode :u32)))
     6150        (ensuring-node-target (target vreg)
     6151          (! cons target yreg zreg temp)))
    61076152      (^))))
    61086153
     
    62776322        (! extract-tag vreg reg)
    62786323        (ensuring-node-target (target vreg)
    6279           (! extract-tag-fixnum target reg)))
     6324        (let* ((temp (? :mode :u8)))
     6325          (! extract-tag temp reg)
     6326          (! u8->fixnum target temp))))
    62806327      (^))))
    62816328
     
    62886335       (! extract-fulltag vreg reg)
    62896336      (ensuring-node-target (target vreg)
    6290         (! extract-fulltag-fixnum target reg)))
     6337        (let* ((temp (? :mode :u8)))
     6338          (! extract-fulltag temp reg)
     6339          (! u8->fixnum target temp))))
    62916340      (^))))
    62926341
     
    62996348      (unboxed-other-case (vreg :u8)
    63006349      (! extract-typecode vreg reg)                         
    6301       (ensuring-node-target (target vreg)
    6302         (! extract-typecode-fixnum target reg )))
     6350      (ensuring-node-target (target vreg)
     6351        (let* ((temp (? :mode :u8)))
     6352          (! extract-typecode temp reg)
     6353          (! u8->fixnum target temp))))
    63036354      (^))))
    63046355
     
    63346385         (dest (if (backend-crf-p vreg) arm::arg_z vreg)))
    63356386    (if need-label
    6336       (setq end-of-block (backend-get-next-label)))
     6387      (setq end-of-block (p2-get-next-label seg)))
    63376388    (setq last-cd (if need-label (%ilogior2 (if mvpass-p $backend-mvpass-mask 0) end-of-block) xfer))
    63386389    (%rplaca blocktag (cons (cons dest last-cd) curstack))
     
    63986449    (if vreg
    63996450      (ensuring-node-target (target vreg)
    6400         (case (arch::target-char-code-limit (backend-target-arch *target-backend*))
    6401           (256 (! %schar8 target src unscaled-idx))
    6402           (t (! %schar32 target src unscaled-idx)))))
     6451        (let* ((scaled (? :mode :s32))
     6452               (unboxed (? :mode :u32)))
     6453          (! scale-32bit-misc-index scaled unscaled-idx)
     6454          (! misc-ref-u32 unboxed src scaled)
     6455          (! u32->char target unboxed))))
    64036456    (^)))
    64046457
     
    64066459  (multiple-value-bind (src unscaled-idx char)
    64076460                       (arm2-three-untargeted-reg-forms seg
    6408                                                         str arm::arg_x
    6409                                                         idx arm::arg_y
    6410                                                         char arm::arg_z)
    6411     (case (arch::target-char-code-limit (backend-target-arch *target-backend*))
    6412       (256 (! %set-schar8 src unscaled-idx char))
    6413       (t (! %set-schar32 src unscaled-idx char)))
     6461                                                        str (?)
     6462                                                        idx (?)
     6463                                                        char (?))
     6464    (let* ((scaled (? :mode :s32))
     6465           (unboxed (? :mode :s32)))
     6466      (! scale-32bit-misc-index scaled unscaled-idx)
     6467      (! character->code unboxed char)
     6468      (! misc-set-u32 unboxed src scaled))
    64146469    (when vreg (<- char))
    64156470    (^)))
     
    64176472(defarm2 arm2-%set-scharcode %set-scharcode (seg vreg xfer str idx char)
    64186473  (multiple-value-bind (src unscaled-idx char)
    6419                        (arm2-three-untargeted-reg-forms seg str arm::arg_x idx arm::arg_y
    6420                                                         char arm::arg_z)
    6421     (case (arch::target-char-code-limit (backend-target-arch *target-backend*))
    6422       (256 (! %set-scharcode8 src unscaled-idx char))
    6423       (t (! %set-scharcode32 src unscaled-idx char)))
     6474                       (arm2-three-untargeted-reg-forms seg str (?)
     6475                                                        idx (?)
     6476                                                        char (?))
     6477    (let* ((scaled (? :mode :s32))
     6478           (code (? :mode :u32)))
     6479      (! unbox-fixnum code char)
     6480      (! scale-32-bit-misc-index scaled unscaled-idx)
     6481      (! misc-set-u32 code src scaled))
    64246482    (when vreg (<- char))
    64256483    (^)))
     
    64276485(defarm2 arm2-%scharcode %scharcode (seg vreg xfer str idx)
    64286486  (multiple-value-bind (src unscaled-idx)
    6429       (arm2-two-untargeted-reg-forms seg str arm::arg_y idx arm::arg_z)
     6487      (arm2-two-untargeted-reg-forms seg
     6488                                     str (?)
     6489                                     idx (?))
    64306490    (if vreg
    64316491      (ensuring-node-target (target vreg)
    6432         (case (arch::target-char-code-limit (backend-target-arch *target-backend*))
    6433           (256 (! %scharcode8 target src unscaled-idx))
    6434           (t (! %scharcode32 target src unscaled-idx)))))
     6492        (let* ((scaled (? :mode :s32))
     6493               (unboxed (? :mode :u32)))
     6494          (! scale-32bit-misc-index scaled unscaled-idx)
     6495          (! misc-ref-u32 unboxed src scaled)
     6496          (! box-fixnum target unboxed))))
    64356497    (^)))
    64366498
     
    64796541
    64806542(defun arm2-branch-unless-arg-fixnum (seg reg label)
    6481   (with-arm-local-vinsn-macros (seg)
     6543  (with-arm2-local-pinsn-macros (seg)
    64826544    (with-crf-target () crf
    64836545      (! test-fixnum crf reg)
     
    64856547
    64866548(defun arm2-branch-unless-both-args-fixnums (seg x y label)
    6487   (with-arm-local-vinsn-macros (seg)
     6549  (with-arm2-local-pinsn-macros (seg)
    64886550    (with-crf-target () crf
    64896551      (! test-fixnums crf x y)
     
    64926554
    64936555(defun arm2-inline-numcmp (seg vreg xfer cc name form1 form2)
    6494   (with-arm-local-vinsn-macros (seg vreg xfer)
     6556  (with-arm2-local-pinsn-macros (seg vreg xfer)
    64956557    (multiple-value-bind (cr-bit true-p) (acode-condition-to-arm-cr-bit cc)
    64966558      (let* ((otherform (and (eql cr-bit arm::arm-cond-eq)
     
    65026564          (arm2-one-targeted-reg-form seg otherform ($ arm::arg_z))
    65036565          (arm2-two-targeted-reg-forms seg  form1 ($ arm::arg_y) form2 ($ arm::arg_z)))
    6504         (let* ((out-of-line (backend-get-next-label))
    6505                (done (backend-get-next-label))
    6506                (continue (backend-get-next-label)))
     6566        (let* ((out-of-line (p2-get-next-label seg))
     6567               (done (p2-get-next-label seg))
     6568               (continue (p2-get-next-label seg)))
    65076569          (if otherform
    65086570            (unless (acode-fixnum-form-p otherform)
     
    65766638    (^)))
    65776639
    6578 (defarm2 arm2-fixnum fixnum (seg vreg xfer value)
     6640(defarm2 arm2-fixnaoum fixnum (seg vreg xfer value)
    65796641  (if (null vreg)
    65806642    (^)
     
    66696731         (tagop (%nx1-operator tag-label)))
    66706732    (dolist (tag taglist)
    6671       (rplacd tag (cons (backend-get-next-label) (cons encstack (cadr (cddr (cddr tag)))))))
     6733      (rplacd tag (cons (p2-get-next-label seg) (cons encstack (cadr (cddr (cddr tag)))))))
    66726734    (dolist (form body)
    66736735      (if (eq (acode-operator form) tagop)
     
    67876849(defun arm2-generate-casejump (seg vreg xfer ranges trueforms var otherwise)
    67886850  (when *arm2-generate-casejump*
    6789     (with-arm-local-vinsn-macros (seg vreg xfer)
     6851    (with-arm2-local-pinsn-macros (seg vreg xfer)
    67906852      (when ranges
    67916853        (let* ((min (caar ranges))
     
    67976859          (when                         ; determine min,max, count; punt on duplicate keys
    67986860              (dolist (range ranges t)
    6799                 (let* ((info (cons (backend-get-next-label) (pop trueforms))))
     6861                (let* ((info (cons (p2-get-next-label seg) (pop trueforms))))
    68006862                  (push info labeled-trueforms)
    68016863                  (unless (dolist (val range t)
     
    68136875              (when (and (> count 4)
    68146876                         (>= count (the fixnum (- span (the fixnum (ash span -2))))))
    6815                 (let* ((defaultlabel (backend-get-next-label))
    6816                        (endlabel (backend-get-next-label))
     6877                (let* ((defaultlabel (p2-get-next-label seg))
     6878                       (endlabel (p2-get-next-label seg))
    68176879                       (single-clause (and (eql count span)
    68186880                                           (eql (length labeled-trueforms) 1))))
     
    68776939                 (true-is-goto (arm2-go-label true))
    68786940                 (false-is-goto (and (not true-is-goto) (arm2-go-label false)))
    6879                  (endlabel (backend-get-next-label))
    6880                  (falselabel (backend-get-next-label))
     6941                 (endlabel (p2-get-next-label seg))
     6942                 (falselabel (p2-get-next-label seg))
    68816943                 (need-else (unless false-is-goto (or (not (nx-null false)) (arm2-for-value-p vreg))))
    68826944                 (both-single-valued (and (not *arm2-open-code-inline*)
     
    69176979              (progn
    69186980                (if (and need-else (arm2-mvpass-p xfer))
    6919                   (setq true-cleanup-label (backend-get-next-label)))         
     6981                  (setq true-cleanup-label (p2-get-next-label seg)))         
    69206982                (arm2-conditional-form
    69216983                 seg
     
    69817043(defarm2 arm2-or or (seg vreg xfer forms)
    69827044  (let* ((mvpass (arm2-mvpass-p xfer))
    6983          (tag1 (backend-get-next-label))
    6984          (tag2 (backend-get-next-label))
     7045         (tag1 (p2-get-next-label seg))
     7046         (tag2 (p2-get-next-label seg))
    69857047         (vstack *arm2-vstack*)
    69867048         (cstack *arm2-cstack*)
     
    70657127
    70667128(defun arm2-inline-add2 (seg vreg xfer form1 form2)
    7067   (with-arm-local-vinsn-macros (seg vreg xfer)
     7129  (with-arm2-local-pinsn-macros (seg vreg xfer)
    70687130    (arm2-two-targeted-reg-forms seg form1 ($ arm::arg_y) form2 ($ arm::arg_z))
    7069     (let* ((out-of-line (backend-get-next-label))
    7070            (done (backend-get-next-label)))
     7131    (let* ((out-of-line (p2-get-next-label seg))
     7132           (done (p2-get-next-label seg)))
    70717133      (ensuring-node-target (target vreg)
    70727134        (if (acode-fixnum-form-p form1)
     
    70857147
    70867148(defun arm2-inline-sub2 (seg vreg xfer form1 form2)
    7087   (with-arm-local-vinsn-macros (seg vreg xfer)
     7149  (with-arm2-local-pinsn-macros (seg vreg xfer)
    70887150    (arm2-two-targeted-reg-forms seg form1 ($ arm::arg_y) form2 ($ arm::arg_z))
    7089     (let* ((out-of-line (backend-get-next-label))
    7090            (done (backend-get-next-label)))
     7151    (let* ((out-of-line (p2-get-next-label seg))
     7152           (done (p2-get-next-label seg)))
    70917153      (ensuring-node-target (target vreg)
    70927154        (if (acode-fixnum-form-p form1)
     
    71397201
    71407202(defun arm2-inline-logior2 (seg vreg xfer form1 form2)
    7141   (with-arm-local-vinsn-macros (seg vreg xfer)
     7203  (with-arm2-local-pinsn-macros (seg vreg xfer)
    71427204    (let* ((fix1 (acode-fixnum-form-p form1))
    71437205           (fix2 (acode-fixnum-form-p form2)))