Changeset 13741

Timestamp:

May 27, 2010, 11:50:14 PM (9 years ago)

Author:

gb

Message:

Keep moving forward. Can -almost- compile simple functions.

Location:

branches/arm/compiler/ARM

Files:

• arm-arch.lisp (modified) (7 diffs)
• arm-asm.lisp (modified) (21 diffs)
• arm-backend.lisp (modified) (3 diffs)
• arm-disassemble.lisp (modified) (4 diffs)
• arm-lap.lisp (modified) (1 diff)
• arm-vinsns.lisp (modified) (193 diffs)
• arm2.lisp (modified) (8 diffs)

branches/arm/compiler/ARM/arm-arch.lisp

@@ -37 +37 @@
   (let* ((value (get-arm-register name)))
     (and value (< value 16) value)))
-                      
+
+(defun get-arm-sfpr (name)
+  (let* ((value (get-arm-register name)))
+    (and value (logbitp 5 value) (logand #x1f value))))
+
+(defun get-arm-dfpr (name)
+  (let* ((value (get-arm-register name)))
+    (and value (logbitp 6 value) (logand #x0f value))))
+  
 
 ;;; This allows redefinition, which might be helpful while
@@ -96 +104 @@
 (defarmgpr pc r15)
 
+
+
 ;;; Calling sequence may pass additional arguments in temp registers.
 ;;; "nfn" (new function) is always passed; it's the new value of "fn".
@@ -107 +117 @@
 (defarmgpr nargs imm2)
 
+(defmacro defarmsfpr (name val)
+  `(defconstant ,name (define-arm-register ',name ',val)))
+
+(defarmsfpr s0 32)
+(defarmsfpr s1 33)
+(defarmsfpr s2 34)
+(defarmsfpr s3 35)
+(defarmsfpr s4 36)
+(defarmsfpr s5 37)
+(defarmsfpr s6 38)
+(defarmsfpr s7 39)
+(defarmsfpr s8 40)
+(defarmsfpr s9 41)
+(defarmsfpr s10 42)
+(defarmsfpr s11 43)
+(defarmsfpr s12 44)
+(defarmsfpr s13 45)
+(defarmsfpr s14 46)
+(defarmsfpr s15 47)
+(defarmsfpr s16 48)
+(defarmsfpr s17 49)
+(defarmsfpr s18 50)
+(defarmsfpr s19 51)
+(defarmsfpr s20 52)
+(defarmsfpr s21 53)
+(defarmsfpr s22 54)
+(defarmsfpr s23 55)
+(defarmsfpr s24 56)
+(defarmsfpr s25 57)
+(defarmsfpr s26 58)
+(defarmsfpr s27 59)
+(defarmsfpr s28 60)
+(defarmsfpr s29 61)
+(defarmsfpr s30 62)
+(defarmsfpr s31 63)
+
+;;; The first 16 double-float registers overlap pairs of single-float
+;;; registers (d0 overlaps s0-s1, d15 overlaps s30-s31, etc.)
+
+(defmacro defarmdfpr (name val)
+  `(defconstant ,name (define-arm-register ',name ',val)))
+
+(defarmdfpr d0 64)
+(defarmdfpr d1 65)
+(defarmdfpr d2 66)
+(defarmdfpr d3 67)
+(defarmdfpr d4 68)
+(defarmdfpr d5 69)
+(defarmdfpr d6 70)
+(defarmdfpr d7 71)
+(defarmdfpr d8 72)
+(defarmdfpr d9 73)
+(defarmdfpr d10 74)
+(defarmdfpr d11 75)
+(defarmdfpr d12 76)
+(defarmdfpr d13 77)
+(defarmdfpr d14 78)
+(defarmdfpr d15 79)
 
 
@@ -218 +286 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defparameter *arm-subprims-shift* 8)
-(defparameter *arm-subprims-base* (ash 4 12) )
+(defparameter *arm-subprims-base* (ash 9 12) )
 )
 (defvar *arm-subprims*)
@@ -229 +297 @@
              (ccl::make-subprimitive-info :name (string name)
                                           :offset (prog1 origin
+                                                    (when (= origin #x10000)
+                                                      (setq step (ash 1 10)))
                                                     (incf origin step)))))
     (macrolet ((defarmsubprim (name)
@@ -449 +519 @@
 (defconstant target-most-negative-fixnum (ash -1 (1- (- nbits-in-word nfixnumtagbits))))
 (defconstant target-most-positive-fixnum (1- (ash 1 (1- (- nbits-in-word nfixnumtagbits)))))
+(defconstant fixnumone (ash 1 fixnumshift))
+
 
 
@@ -1313 +1385 @@
   al)
 
-(defconstant arm-cond-eq 0)
-(def
   
 (provide "ARM-ARCH")

branches/arm/compiler/ARM/arm-asm.lisp

@@ -94 +94 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
 
-(ccl::defenum (:prefix "ARM-OPERAND-TYPE-")
-  rd                                    ; destination register in bits 12:15
-  rn                                    ; unshifted source/base reg in 16:19
-  shifter                               ; composite operand for ALU ops
-  mem12                                 ; 12-bit address for LDR/STR/LDRB/STB
-  reglist
-  rnw                                   ; rn, with optional writeback.
-  uuoA                                  ; GPR in UUO bits 8:11
-  uuo-unary                             ; constant in UUO bits 12:15
-  uuoB                                  ; GPR in UUO bits 12:15
-  rm
-  b
-  subprim
-  mem8
-)
-
-(defparameter *arm-operand-type-names*
-  `((:rd . ,arm-operand-type-rd)
-    (:rn . ,arm-operand-type-rn)
-    (:shifter . ,arm-operand-type-shifter)
-    (:mem12 . ,arm-operand-type-mem12)
-    (:reglist . ,arm-operand-type-reglist)
-    (:rnw . ,arm-operand-type-rnw)
-    (:uuoA . ,arm-operand-type-uuoA)
-    (:uuo-unary . ,arm-operand-type-uuo-unary)
-    (:uuoB . ,arm-operand-type-uuoB)
-    (:rm . ,arm-operand-type-rm)
-    (:b . ,arm-operand-type-b)
-    (:subprim . ,arm-operand-type-subprim)
-    (:mem8 . ,arm-operand-type-mem8)
+(defparameter *arm-operand-types*
+  #(:rd                                 ; destination register in bits 12:15
+    :rn                                 ; unshifted source/base reg in 16:19
+    :shifter                            ; composite operand for ALU ops
+    :mem12                              ; 12-bit address for LDR/STR/LDRB/STB
+    :reglist
+    :rnw                                ; rn, with optional writeback.
+    :uuoA                               ; GPR in UUO bits 8:11
+    :uuo-unary                          ; constant in UUO bits 12:15
+    :uuoB                               ; GPR in UUO bits 12:15
+    :rm
+    :b
+    :subprim
+    :mem8
+    :dd
+    :dm
+    :sd
+    :sm
+    :dn
+    :sn
+    :rde
+    :rs
     ))
 
-
-
-
-(defun encode-arm-operand-type (name)
-  (or (cdr (assoc name *arm-operand-type-names* :test #'eq))
+(defun %encode-arm-operand-type (name)
+  (or (position name *arm-operand-types* :test #'eq)
       (error "Unknown ARM operand type name ~s." name)))
+
+(defmacro encode-arm-operand-type (name)
+  (%encode-arm-operand-type name))
 
 (ccl::defenum (:prefix "ARM-INSTRUCTION-FLAG-")
@@ -172 +164 @@
 
 (defmacro define-arm-instruction (name operand-type-names value mask-list flag-names)
-  `(%define-arm-instruction ,(string-downcase name) ,value ',mask-list ,(%encode-arm-instruction-flag flag-names) ',(mapcar #'encode-arm-operand-type operand-type-names) ))
+  `(%define-arm-instruction ,(string-downcase name) ,value ',mask-list ,(%encode-arm-instruction-flag flag-names) ',(mapcar #'%encode-arm-operand-type operand-type-names) ))
 
 (defparameter *arm-instruction-table*
@@ -185 +177 @@
      (:prefer-separate-cond))
    (define-arm-instruction uuo-error-wrong-nargs ()
-     #x07f000f1
+     #x07f001f8
      #x0fffffff
      (:prefer-separate-cond))
    (define-arm-instruction uuo-gc-trap ()
-     #x07f001f2
+     #x07f002f0
      #x0fffffff 
      (:prefer-separate-cond))
    (define-arm-instruction uuo-debug-trap ()
-     #x07f002f3
+     #x07f002f0
      #x0fffffff 
      (:prefer-separate-cond))
    (define-arm-instruction uuo-interrupt-now ()
-     #x07f003f4
+     #x07f003f0
      #x0fffffff
      (:prefer-separate-cond))
    (define-arm-instruction uuo-suspend-now ()
-     #x07f004f05
+     #x07f004f0
      #x0fffffff
      (:prefer-separate-cond))
@@ -232 +224 @@
 ;;; Unary UUOs
    (define-arm-instruction uuo-error-unbound (:uuoA)
-     #x07f000f1
+     #x07f000f9
      #x0ffff0ff
      (:prefer-separate-cond))
    (define-arm-instruction uuo-cerror-unbound (:uuoA)
-     #x07f010f1
+     #x07f010f9
      #x0ffff0ff
      (:prefer-separate-cond))
    (define-arm-instruction uuo-error-not-callable (:uuoA)
-     #x07f020f1
+     #x07f020f9
      #x0ffff0ff
      (:prefer-separate-cond))
@@ -248 +240 @@
      (:prefer-separate-cond))
    (define-arm-instruction uuo-error-no-throw-tag (:uuoA)
-     #x07f040f1
+     #x07f040f9
      #x0ffff0ff
      (:prefer-separate-cond))
-
+   (define-arm-instruction uuo-error-udf-call (:uuoA)
+     #x07f050f9
+     #x0ffff0ff
+     (:prefer-separate-cond))
+   (define-arm-instruction uuo-error-udf (:uuoA)
+     #x07f060f9
+     #x0ffff0ff
+     (:prefer-separate-cond))
+   
 ;;; Binary UUOs
    (define-arm-instruction uuo-error-vector-bounds (:uuoA :uuoB)
@@ -261 +261 @@
      #x0fff00ff
      (:prefer-separate-cond))
-
+   (define-arm-instruction uuo-error-integer-divide-by-zero (:uuoA :uuoB)
+     #x07f200ff
+     #x0fff00ff
+     (:prefer-separate-cond))
+   (define-arm-instruction uuo-error-slot-unbound (:uuoA :uuoB)
+     #x07f300ff
+     #x0fff00ff
+     (:prefer-separate-cond))
 
    (define-arm-instruction and (:rd :rn :shifter)
@@ -484 +491 @@
      #x0e3000f0
      ())
-
+   (define-arm-instruction ldrd  (:rde :mem8)
+     #x000000d0
+     #x0e3000f0
+     ())
+   (define-arm-instruction strd  (:rde :mem8)
+     #x000000f0
+     #x0e3000f0
+     ())
+
+   (define-arm-instruction mul (:rd :rm :rs)
+     #x00000090
+     #x0ff000f0
+     ())
+   (define-arm-instruction muls (:rd :rm :rs)
+     #x00100090
+     #x0ff000f0
+     ())
+   
    (define-arm-instruction stm (:rnw :reglist)
      #x08800000
@@ -545 +569 @@
      #x012fff30
      #x0ffffff0
+     ())
+
+;;; VFP instructions
+   (define-arm-instruction fabsd (:dd :dm)
+     #x0eb00bc0
+     #x0ff00ff0
+     ())
+   (define-arm-instruction fabss (:sd :sm)
+     #x0eb00ac0
+     #x0fb00fb0
+     ())
+   (define-arm-instruction faddd (:dd :dn :dm)
+     #x0e300b00
+     #x0ff00ff0
+     ())
+   (define-arm-instruction fadds (:sd :sn :sm)
+     #x0e300a00
+     #x0f300f50
+     ())
+   (define-arm-instruction fmsr (:sn :rd)
+     #x0e000a10
+     #x0ff00f90
+     ())
+   (define-arm-instruction fmrs (:rd :sn)
+     #x0e100a10
+     #x0ff00f90
+     ())
+   (define-arm-instruction fmrrd (:rd :rn :dm)
+     #x0e500b10
+     #x0ff00ff0
+     ())
+   (define-arm-instruction fmdrr (:dm :rd :rn)
+     #x0e400b10
+     #x0ff00ff0
+     ())
+   (define-arm-instruction fsitod (:dd :sm)
+     #x0eb80bc0
+     #x0fff0fc0
+     ())
+   (define-arm-instruction fsitos (:sd :sm)
+     #x0eb80ac0
+     #x0fff0fc0
+     ())
+   (define-arm-instruction fcmped (:dd :dm)
+     #x0eb40bc0
+     #x0fff0fc0
+     ())
+   (define-arm-instruction fcmpes (:dd :dm)
+     #x0eb40ac0
+     #x0fff0fc0
+     ())
+   (define-arm-instruction fmstat ()
+     #x0ef1fa10
+     #x0fffffff
+     ())
+   (define-arm-instruction fsubd (:dd :dn :dm)
+     #x0e300b40
+     #x0ff00fc0
+     ())
+   (define-arm-instruction fsubs (:sd :sn :sm)
+     #x0e300a40
+     #x0ff00fc0
+     ())
+   (define-arm-instruction fmuld (:dd :dn :dm)
+     #x0e200b00
+     #x0ff00ff0
+     ())
+   (define-arm-instruction fmuls (:sd :sn :sm)
+     #x0e200a00
+     #x0ff00ff0
+     ())
+   (define-arm-instruction fdivd (:dd :dn :dm)
+     #x0e800b00
+     #x0ff00ff0
+     ())
+   (define-arm-instruction fdivs (:sd :sn :sm)
+     #x0e800a00
+     #x0ff00ff0
+     ())
+   (define-arm-instruction fcpyd (:dd :dm)
+     #x0eb00b40
+     #x0fb00ff0
+     ())
+   (define-arm-instruction fcpyd (:sd :sm)
+     #x0eb00b40
+     #x0fb00fc0
+     ())
+   (define-arm-instruction fcvtsd (:sd :dm)
+     #x0eb70bc0
+     #x0fbf0fc0
      ())
    ))
@@ -667 +781 @@
   (or (get-arm-gpr form)
       (error "Expected an ARM general-purpose register, got ~s" form)))
+
+(defun need-arm-sfpr (form)
+  (or (get-arm-sfpr form)
+      (error "Expected an ARM single FP register, got ~s" form)))
+
+(defun need-arm-dfpr (form)
+  (or (get-arm-sfpr form)
+      (error "Expected an ARM double FP register, got ~s" form)))
 
 (defun encode-arm-shift-type (op)
@@ -943 +1065 @@
     (set-addressing-mode instruction mode constant-index))))
 
-
-        
+(defun parse-dd-operand (form instruction)
+  (set-field-value instruction (byte 4 12) (need-arm-dfpr form)))
+
+(defun parse-dm-operand (form instruction)
+  (set-field-value instruction (byte 4 0) (need-arm-dfpr form)))
+
+(defun parse-sd-operand (form instruction)
+  (let* ((val (need-arm-sfpr form)))
+    (set-field-value instruction (byte 4 12) (ash val -1))
+    (set-field-value instruction (byte 1 22) (logand val 1))))
+
+(defun parse-sm-operand (form instruction)
+  (let* ((val (need-arm-sfpr form)))
+    (set-field-value instruction (byte 4 0) (ash val -1))
+    (set-field-value instruction (byte 1 5) (logand val 1))))
+
+(defun parse-dn-operand (form instruction)
+  (set-field-value instruction (byte 4 16) (need-arm-dfpr form)))        
                              
-          
-
+(defun parse-sn-operand (form instruction)
+  (let* ((val (need-arm-sfpr form)))
+    (set-field-value instruction (byte 4 16) (ash val -1))
+    (set-field-value instruction (byte 1 7) (logand val 1))))
+
+(defun parse-rde-operand (form instruction)
+  (let* ((val (need-arm-gpr form)))
+    (when (oddp val)
+      (error "Register must be even-numbered: ~s." form))
+    (set-field-value instruction (byte 4 12) val)))
+
+(defun parse-rs-operand (form instruction)
+  (set-field-value instruction (byte 4 8) (need-arm-gpr form)))
+  
 (defparameter *arm-operand-parsers*
     #(parse-rd-operand
@@ -962 +1112 @@
       parse-subprim-operand
       parse-m8-operand
+      parse-dd-operand
+      parse-dm-operand
+      parse-sd-operand
+      parse-sm-operand
+      parse-dn-operand
+      parse-sn-operand
+      parse-rde-operand
+      parse-rs-operand
       ))
 
@@ -1102 +1260 @@
     (ccl::append-dll-node w1 primary )
     (let* ((n (set-element-addresses 0 primary)))
-      (setf (lap-instruction-opcode w1) n)
+      (setf (lap-instruction-opcode w1) (ash n (- arm::word-shift)))
       (set-element-addresses n constant-pool)))
   ;; Now fix up label references.  Recall that the PC value at some
@@ -1187 +1345 @@
 
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defparameter *vinsn-field-types*
   #(:cond
@@ -1206 +1365 @@
     :application
     :local-label
-    ))
+    :dd
+    :dm
+    :sd
+    :sm
+    :dn
+    :sn
+    )))
 
 (defmacro encode-vinsn-field-type (name)
@@ -1226 +1391 @@
       vinsn-parse-subprim-operand
       vinsn-parse-m8-operand
+      vinsn-parse-dd-operand
+      vinsn-parse-dm-operand
+      vinsn-parse-sd-operand
+      vinsn-parse-sm-operand
+      vinsn-parse-dn-operand
+      vinsn-parse-sn-operand
+      vinsn-parse-rde-operand
+      vinsn-parse-rs-operand
       ))
 
@@ -1236 +1409 @@
            (set-avi-opcode-field avi bytespec (need-arm-gpr form))))))
 
+(defun vinsn-arg-or-dfpr (avi form vinsn-params encoded-type bytespec)
+  (let* ((p (position form vinsn-params)))
+    (cond (p
+           (add-avi-operand avi encoded-type p)
+           nil)
+          (t           
+           (set-avi-opcode-field avi bytespec (need-arm-dfpr form))))))
+
+(defun vinsn-arg-or-sfpr (avi form vinsn-params encoded-type top4 low1)
+  (let* ((p (position form vinsn-params)))
+    (cond (p
+           (add-avi-operand avi encoded-type p)
+           nil)
+          (t
+           (let* ((val (need-arm-sfpr form)))
+             (set-avi-opcode-field avi top4 (ash val -1))
+             (set-avi-opcode-field avi low1 (logand val 1)))))))
+
+(defun simplify-arm-vinsn-application (form params)
+  (labels ((simplify-operand (op)
+             (if (atom op)
+               (if (typep form 'fixnum)
+                 op
+                 (if (constantp op)
+                   (eval op)
+                   (let* ((p (position op params)))
+                     (if p
+                       (list p)
+                       (error "Unknown operand: ~s" op)))))
+               (if (eq (car op) :apply)
+                 `(,(cadr op) ,@(mapcar #'simplify-operand (cddr op)))))))
+    `(,(cadr form) ,@(mapcar #'simplify-operand (cddr form)))))
+
 (defun vinsn-arg-or-constant (avi form vinsn-params encoded-type bytespec)
   (let* ((p (position form vinsn-params)))
@@ -1241 +1447 @@
            (add-avi-operand avi encoded-type p)
            nil)
+          ((typep form 'keyword)
+           (add-avi-operand avi encoded-type form)
+           nil)
           ((and (consp form) (eq (car form) :apply))
-           (add-avi-operand avi encoded-type (simplify-application form vinsn-params))
+           (add-avi-operand avi encoded-type (simplify-arm-vinsn-application form vinsn-params))
            nil)
           (t
@@ -1300 +1509 @@
 
 (defun vinsn-parse-m12-operand (avi value vinsn-params)
+  (when (typep value 'keyword)
+    (setq value `(:@ arm::pc (:$ ,value))))
   (destructuring-bind (op rn index) value     ; no (:@ reg) sugar
     (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 16))
@@ -1350 +1561 @@
                (destructuring-bind (marker reg) value
                  (if (eq marker :!)
-                   (set-avi-opcode-field avi (byte 1 21) 1))
-                   (error "Unrecognized writeback indicator in ~s." value)
+                   (set-avi-opcode-field avi (byte 1 21) 1)
+                   (error "Unrecognized writeback indicator in ~s." value))
                  reg))))
     (vinsn-arg-or-gpr avi rn vinsn-params  (encode-vinsn-field-type :rn) (byte 4 16))))
@@ -1378 +1589 @@
           ((typep value 'keyword)
            (add-avi-operand avi (encode-vinsn-field-type :local-label) value))
+          ((arm-subprimitive-address value)
+           (add-avi-operand avi (encode-vinsn-field-type :subprim) value))
           (t
            (error "Unknown branch target: ~s." value)))))
@@ -1434 +1647 @@
               (set-opcode-value-from-addressing-mode (avi-opcode avi) mode constant-index))))))
 
-              
-
-
-                                      
+(defun vinsn-parse-dd-operand (avi value vinsn-params)
+  (vinsn-arg-or-dfpr avi value vinsn-params (encode-vinsn-field-type :dd) (byte 4 12)))
+
+(defun vinsn-parse-dm-operand (avi value vinsn-params)
+  (vinsn-arg-or-dfpr avi value vinsn-params (encode-vinsn-field-type :dm) (byte 4 0)))
+
+(defun vinsn-parse-sd-operand (avi value vinsn-params)
+  (vinsn-arg-or-sfpr avi value vinsn-params (encode-vinsn-field-type :sd) (byte 4 12) (byte 1 22)))
+
+(defun vinsn-parse-sm-operand (avi value vinsn-params)
+  (vinsn-arg-or-sfpr avi value vinsn-params (encode-vinsn-field-type :sm) (byte 4 0) (byte 1 5)))
+
+(defun vinsn-parse-dn-operand (avi value vinsn-params)
+  (vinsn-arg-or-dfpr avi value vinsn-params (encode-vinsn-field-type :dn) (byte 4 16)))
+
+(defun vinsn-parse-sn-operand (avi value vinsn-params)
+  (vinsn-arg-or-sfpr avi value vinsn-params (encode-vinsn-field-type :sn) (byte 4 16) (byte 1 7)))
+
+(defun vinsn-parse-rde-operand (avi value vinsn-params)
+  (let* ((val (get-arm-gpr value)))
+    (when (and val (oddp val))
+      (error "Register ~s must be even-numbered." value)))
+  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rd) (byte 4 12)))
+
+(defun vinsn-parse-rs-operand (avi value vinsn-params)
+  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rs) (byte 4 8)))
+
 (defun vinsn-simplify-instruction (form vinsn-params)
   (destructuring-bind (name . opvals) form
-    (multiple-value-bind (template cond explicit-cond) (lookup-arm-instruction name)
-      (unless template
-        (error "Unknown ARM instruction - ~s" form))
-      (let* ((cond-indicator (and (consp (car opvals))
-                                  (keywordize (caar opvals))))
-             (avi (make-arm-vinsn-instruction (arm-instruction-template-val template))))
-        (when (or (eq cond-indicator :?)
-                  (eq cond-indicator :~))
-          (let* ((condform (pop opvals)))
-            (destructuring-bind (cond-name) (cdr condform)
-              (let* ((p (position cond-name vinsn-params)))
-                (if p
-                  (if explicit-cond
-                    (error "Can't use ~s with explicit condition name." condform)
-                    (progn
-                      (add-avi-operand avi (if (eq cond-indicator :?)
-                                             (encode-vinsn-field-type :cond)
-                                             (encode-vinsn-field-type :negated-cond))
-                                       p)
-                      (setq cond nil)))
-                  (let* ((c (need-arm-condition-name cond-name)))
-                    (when (eq cond-indicator :~)
-                      (if (< c 14)
-                        (setq c (logxor c 1))
-                        (error "Invalid explicit condition ~s." condform)))
-                    (if (and explicit-cond (not (eql c cond)))
-                      (error "Can't use explicit condition and :? : ~s" condform)
-                      (setq cond c))))))))
-        (let* ((optypes (arm-instruction-template-operand-types template))
-               (n (length optypes)))
-          (unless (= n (length opvals))
-            (error "ARM ~a instructions require ~d operands, but ~d were provided in ~s." (arm-instruction-template-name template) n (length opvals) form))
-          (dotimes (i n)
-            (let* ((optype (pop optypes))
-                   (opval (pop opvals)))
-              (funcall (svref *arm-vinsn-operand-parsers* optype)
-                       avi opval vinsn-params)))
-          (when cond
-            (set-avi-opcode-field avi (byte 4 28) cond))
-          (avi-head avi))))))
+    (case name
+      ((:code :data) form)
+      (:word (destructuring-bind (val) opvals
+               (let* ((p (position val vinsn-params)))
+                 (list name (if p (list p) (eval val))))))
+      (t
+       (multiple-value-bind (template cond explicit-cond) (lookup-arm-instruction name)
+         (unless template
+           (error "Unknown ARM instruction - ~s" form))
+         (let* ((cond-indicator (and (consp (car opvals))
+                                     (keywordize (caar opvals))))
+                (avi (make-arm-vinsn-instruction (arm-instruction-template-val template))))
+           (when (or (eq cond-indicator :?)
+                     (eq cond-indicator :~))
+             (let* ((condform (pop opvals)))
+               (destructuring-bind (cond-name) (cdr condform)
+                 (let* ((p (position cond-name vinsn-params)))
+                   (if p
+                     (if explicit-cond
+                       (error "Can't use ~s with explicit condition name." condform)
+                       (progn
+                         (add-avi-operand avi (if (eq cond-indicator :?)
+                                                (encode-vinsn-field-type :cond)
+                                                (encode-vinsn-field-type :negated-cond))
+                                          p)
+                         (setq cond nil)))
+                     (let* ((c (need-arm-condition-name cond-name)))
+                       (when (eq cond-indicator :~)
+                         (if (< c 14)
+                           (setq c (logxor c 1))
+                           (error "Invalid explicit condition ~s." condform)))
+                       (if (and explicit-cond (not (eql c cond)))
+                         (error "Can't use explicit condition and :? : ~s" condform)
+                         (setq cond c))))))))
+           (let* ((optypes (arm-instruction-template-operand-types template))
+                  (n (length optypes)))
+             (unless (= n (length opvals))
+               (error "ARM ~a instructions require ~d operands, but ~d were provided in ~s." (arm-instruction-template-name template) n (length opvals) form))
+             (dotimes (i n)
+               (let* ((optype (pop optypes))
+                      (opval (pop opvals)))
+                 (funcall (svref *arm-vinsn-operand-parsers* optype)
+                          avi opval vinsn-params)))
+             (when cond
+               (set-avi-opcode-field avi (byte 4 28) cond))
+             (avi-head avi))))))))
           
 
+(defparameter *arm-vinsn-insert-functions*
+    #(vinsn-insert-rd-operand
+      vinsn-insert-rn-operand
+      vinsn-insert-shifter-operand
+      vinsn-insert-m12-operand
+      vinsn-insert-reglist-operand
+      vinsn-insert-rnw-operand
+      vinsn-insert-uuoa-operand
+      vinsn-insert-uuo-unary-operand
+      vinsn-insert-uuob-operand
+      vinsn-insert-rm-operand
+      vinsn-insert-b-operand
+      vinsn-insert-subprim-operand
+      vinsn-insert-m8-operand
+      vinsn-insert-dd-operand
+      vinsn-insert-dm-operand
+      vinsn-insert-sd-operand
+      vinsn-insert-sm-operand
+      vinsn-insert-dn-operand
+      vinsn-insert-sn-operand
+      vinsn-insert-rde-operand
+      vinsn-insert-rs-operand
+      ))
 
 (provide "ARM-ASM")

branches/arm/compiler/ARM/arm-backend.lisp

@@ -32 +32 @@
 ;;; evaluable at macroexpansion time.
 (defun %define-arm-vinsn (backend vinsn-name results args temps body)
-  (let* ((opcode-vector (backend-lap-opcodes backend))
-         (opcode-lookup (backend-lookup-opcode backend))
-         (opcode-expander (backend-lookup-macro backend))
-         (backend-name (backend-name backend))
-         (arch-name (backend-target-arch-name backend))
+  (let* ((arch-name (backend-target-arch-name backend))
          (template-hash (backend-p2-template-hash-name backend))
          (name-list ())
@@ -98 +94 @@
         (dolist (name non-hybrid-results)
           (add-spec-name name)))
-      (break)
-      #+notyet
       (let* ((k -1))
         (declare (fixnum k))
@@ -169 +163 @@
                                (if (keywordp opname)
                                  form
-                                 (let* ((name (string opname))
-                                        (opnum (funcall opcode-lookup name)))
-                                   (if (and (not opnum) opcode-expander)
-                                     (let* ((expander (funcall opcode-expander name)))
-                                       (if expander
-                                         (simplify-form (funcall expander form nil))
-                                         (error "Unknown ~A instruction in ~s" backend-name form)))
-                                     (let* ((opcode (if (< -1 opnum (length opcode-vector))
-                                                      (svref opcode-vector opnum)
-                                                      (error "~& Invalid ~A opcode: ~s" backend-name name)))
-                                            (opvals (mapcar #'simplify-operand opvals)))
-                                       (setf (assq opnum opcode-alist) name)
-                                       (let* ((operands (opcode-vinsn-operands opcode))
-                                              (nmin (opcode-min-vinsn-args opcode))
-                                              (nmax (opcode-max-vinsn-args opcode))
-                                              (nhave (length opvals)))
-                                         (declare (fixnum nmin nmax nhave))
-                                         (if (= nhave nmax)
-                                           `(,opnum ,@opvals)
-                                           (if (> nhave nmax)
-                                             (error "Too many operands in ~s (~a accepts at most ~d)"
-                                                    (cdr w) name nmax)
-                                             (if (= nhave nmin)
-                                               (let* ((newops ()))
-                                                 (dolist (op operands `(,opnum ,@(nreverse newops)))
-                                                   (let* ((flags (operand-flags op)))
-                                                     (unless (logbitp operand-fake flags)
-                                                       (push (if (logbitp operand-optional flags)
-                                                               0
-                                                               (pop opvals))
-                                                             newops)))))
-                                               (error "Too few operands in ~s : (~a requires at least ~d)"
-                                                      (cdr w) name nmin))))))))))))))
+                                 (arm::vinsn-simplify-instruction form name-list)))))))
                 (let* ((template (make-vinsn-template
                                   :name vinsn-name

branches/arm/compiler/ARM/arm-disassemble.lisp

@@ -28 +28 @@
 (defun arm-gpr-name (regno)
   `(:gpr ,regno))
+
+(defun arm-fprd-name (regno)
+  `(:double ,regno))
+
+(defun arm-fprs-name (regno)
+  `(:single ,regno))
 
 
@@ -210 +216 @@
                       (if u :@+ :@-)) ,rn ,rm)))))))
 
+(defun extract-arm-dd-operand (opcodes i)
+  (let* ((opcode (adi-opcode (svref opcodes i))))
+    (arm-fprd-name (ldb (byte 4 12) opcode))))
+
+(defun extract-arm-dm-operand (opcodes i)
+  (let* ((opcode (adi-opcode (svref opcodes i))))
+    (arm-fprd-name (ldb (byte 4 0) opcode))))
+
+(defun extract-arm-sd-operand (opcodes i)
+  (let* ((opcode (adi-opcode (svref opcodes i))))
+    (arm-fprs-name (logior (ash (ldb (byte 4 12) opcode) 1)
+                           (ldb (byte 1 22) opcode)))))
+
+(defun extract-arm-sm-operand (opcodes i)
+  (let* ((opcode (adi-opcode (svref opcodes i))))
+    (arm-fprs-name (logior (ash (ldb (byte 4 0) opcode) 1)
+                           (ldb (byte 1 5) opcode)))))
+
+(defun extract-arm-dn-operand (opcodes i)
+  (let* ((opcode (adi-opcode (svref opcodes i))))
+    (arm-fprd-name (ldb (byte 4 16) opcode))))
+
+(defun extract-arm-sn-operand (opcodes i)
+  (let* ((opcode (adi-opcode (svref opcodes i))))
+    (arm-fprd-name (logior (ash (ldb (byte 4 16) opcode) 1)
+                           (ldb (byte 1 7) opcode)))))
+
+
 (defparameter *arm-operand-extract-functions*
   #(extract-arm-rd-operand
@@ -224 +258 @@
     extract-arm-subprim-operand
     extract-arm-m8-operand
+    extract-arm-dd-operand
+    extract-arm-dm-operand
+    extract-arm-sd-operand
+    extract-arm-sm-operand
+    extract-arm-dn-operand
+    extract-arm-sn-operand
     ))
 
@@ -319 +359 @@
                            (:? (format stream "(:? ~a)" (cadr operand)))
                            (:gpr (format stream "~a" (svref *arm-gpr-names* (cadr operand))))
+                           (:single (format stream "s~d" (cadr operand)))
+                           (:double (format stream "d~d" (cadr operand)))
                            (:reglist (format stream "~a"
                                              (mapcar (lambda (r)

branches/arm/compiler/ARM/arm-lap.lisp

@@ -127 +127 @@
       (:data
        (setq current (svref sections 1)))
-      (:text
+      (:code
        (setq current (svref sections 0)))
       (:section
        (setq current (svref sections
                             (ecase arg
-                              (:text 0)
+                              (:code 0)
                               (:data 1)))))
       (:word

branches/arm/compiler/ARM/arm-vinsns.lisp

@@ -48 +48 @@
                                            )
                                           ())
-  (mov  dest (:lsr idx 1))
+  (mov  dest (:lsr idx (:$ 1)))
   (add dest dest (:$ arm::misc-data-offset)))
 
@@ -55 +55 @@
                                           )
                                          ())
-  (mov dest (:lsr idx 2))
+  (mov dest (:lsr idx (:$ 2)))
   (add dest dest (:$ arm::misc-data-offset)))
 
@@ -65 +65 @@
   (add dest dest (:$ arm::misc-dfloat-offset)))
 
+#+notyet
 (define-arm-vinsn scale-1bit-misc-index (((word-index :u32)
                                           (bitnum :u8)) ; (unsigned-byte 5)
@@ -135 +136 @@
                                           ((v :lisp)
                                            (scaled-idx :u32))
-                                          ())
-  (lfsx dest v scaled-idx))
+                                          ((temp :u32)))
+  (ldr temp (:@ v scaled-idx))
+  (fmsr dest temp))
 
 (define-arm-vinsn misc-ref-c-single-float  (((dest :single-float))
                                             ((v :lisp)
                                              (idx :u32const))
-                                            ())
-  (lfs dest (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
+                                            ((temp :u32)))
+  (ldr temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2)))))
+  (fmsr dest temp))
 
 (define-arm-vinsn misc-ref-double-float  (((dest :double-float))
                                           ((v :lisp)
                                            (scaled-idx :u32))
-                                          ())
-  (lfdx dest v scaled-idx))
+                                          ((low (:u32 #.arm::imm0))
+                                           (high (:u32 #.arm::imm1))))
+  (ldrd low (:@ v scaled-idx))
+  (fmdrr dest low high))
 
 
@@ -154 +159 @@
                                             ((v :lisp)
                                              (idx :u32const))
-                                            ())
-  (lfd dest (:apply + arm::misc-dfloat-offset (:apply ash idx 3)) v))
+                                            ((low (:u32 #.arm::imm0))
+                                             (high (:u32 #.arm::imm1))))
+  (ldrd low (:@ v (:$ idx)))
+  (fmdrr dest low high))
 
 (define-arm-vinsn misc-set-c-double-float (((val :double-float))
                                            ((v :lisp)
-                                            (idx :u32const)))
-  (stfd val (:apply + arm::misc-dfloat-offset (:apply ash idx 3)) v))
+                                            (idx :u32const))
+                                           ((low (:u32 #.arm::imm0))
+                                            (high (:u32 #.arm::imm1))))
+  (fmrrd low high val)
+  (strd low (:@ v (:$ (:apply + arm::misc-dfloat-offset (:apply ash idx 3))))))
 
 (define-arm-vinsn misc-set-double-float (()
                                          ((val :double-float)
                                           (v :lisp)
-                                          (scaled-idx :u32)))
-  (stfdx val v scaled-idx))
-
-(define-arm-vinsn misc-set-c-single-float (((val :single-float))
-                                           ((v :lisp)
-                                            (idx :u32const)))
-  (stfs val (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
+                                          (scaled-idx :u32))
+                                         ((low (:u32 #.arm::imm0))
+                                          (high (:u32 #.arm::imm1))))
+  (fmrrd low high val)
+  (strd low (:@ v scaled-idx)))
+
+(define-arm-vinsn misc-set-c-single-float (()
+                                           ((val :single-float)
+                                            (v :lisp)
+                                            (idx :u32const))
+                                           ((temp :u32)))
+  (fmrs temp val)
+  (str temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
 
@@ -178 +194 @@
                                          ((val :single-float)
                                           (v :lisp)
-                                          (scaled-idx :u32)))
-  (stfsx val v scaled-idx))
+                                          (scaled-idx :u32))
+                                         ((temp :u32)))
+  (fmrs temp val)
+  (str temp (:@ v scaled-idx)))
 
 
@@ -198 +216 @@
                                     (idx :u32const))
                                    ())
-  (strh val (:+@ v (:apply + arm::misc-data-offset (:apply ash idx 1)))))
+  (strh val (:+@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
 
 (define-arm-vinsn misc-set-u16 (((val :u16))
@@ -209 +227 @@
                                   (scaled-idx :u32))
                                  ())
-  (lhax dest v scaled-idx))
+  (ldrsh dest (:@ v scaled-idx)))
 
 (define-arm-vinsn misc-ref-c-s16  (((dest :s16))
@@ -215 +233 @@
                                     (idx :u32const))
                                    ())
-  (lha dest (:apply + arm::misc-data-offset (:apply ash idx 1)) v))
+  (ldrsh dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
 
 
@@ -222 +240 @@
                                     (idx :u32const))
                                    ())
-  (sth val (:apply + arm::misc-data-offset (:apply ash idx 1)) v))
+  (strh val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
 
 (define-arm-vinsn misc-set-s16 (((val :s16))
                                 ((v :lisp)
                                  (scaled-idx :s32)))
-  (sthx val v scaled-idx))
+  (strh val (:@ v scaled-idx)))
 
 (define-arm-vinsn misc-ref-u8  (((dest :u8))
@@ -233 +251 @@
                                  (scaled-idx :u32))
                                 ())
-  (lbzx dest v scaled-idx))
+  (ldrb dest (:@ v scaled-idx)))
 
 (define-arm-vinsn misc-ref-c-u8  (((dest :u8))
@@ -239 +257 @@
                                    (idx :u32const))
                                   ())
-  (lbz dest (:apply + arm::misc-data-offset idx) v))
+  (ldrb dest (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
 
 (define-arm-vinsn misc-set-c-u8  (((val :u8))
@@ -245 +263 @@
                                    (idx :u32const))
                                   ())
-  (stb val (:apply + arm::misc-data-offset idx) v))
+  (strb val (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
 
 (define-arm-vinsn misc-set-u8  (((val :u8))
@@ -251 +269 @@
                                  (scaled-idx :u32))
                                 ())
-  (stbx val v scaled-idx))
+  (strb val (:@ v scaled-idx)))
 
 (define-arm-vinsn misc-ref-s8  (((dest :s8))
@@ -257 +275 @@
                                  (scaled-idx :u32))
                                 ())
-  (lbzx dest v scaled-idx)
-  (extsb dest dest))
+  (ldrsb dest (:@ v scaled-idx)))
 
 (define-arm-vinsn misc-ref-c-s8  (((dest :s8))
@@ -264 +281 @@
                                    (idx :u32const))
                                   ())
-  (lbz dest (:apply + arm::misc-data-offset idx) v)
-  (extsb dest dest))
+  (ldrsb dest (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
 
 (define-arm-vinsn misc-set-c-s8  (((val :s8))
@@ -271 +287 @@
                                    (idx :u32const))
                                   ())
-  (stb val (:apply + arm::misc-data-offset idx) v))
+  (strb val (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
 
 (define-arm-vinsn misc-set-s8  (((val :s8))
@@ -277 +293 @@
                                  (scaled-idx :u32))
                                 ())
-  (stbx val v scaled-idx))
-
+  (strb val (:@ v scaled-idx)))
+
+#+notyet
 (define-arm-vinsn misc-ref-c-bit (((dest :u8))
                                   ((v :lisp)
@@ -286 +303 @@
   (rlwinm dest dest (:apply 1+ (:apply logand idx #x1f)) 31 31))
 
+#+notyet
 (define-arm-vinsn misc-ref-c-bit-fixnum (((dest :imm))
                                          ((v :lisp)
@@ -302 +320 @@
                                    (scaled-idx :s32))
                                   ())
-  (lwzx dest v scaled-idx))
+  (ldr dest (:@ v scaled-idx)))
 
 
@@ -311 +329 @@
                                     (idx :s16const))
                                    ())
-  (lwz dest (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
+  (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
 (define-arm-vinsn misc-set-node (()
@@ -317 +335 @@
                                   (v :lisp)
                                   (scaled-idx :u32)))
-  (stwx val v scaled-idx))
+  (str val (:@ v scaled-idx)))
 
 ;;; This should only be used for initialization (when the value being
@@ -326 +344 @@
                                     (idx :s16const))
                                    ())
-  (stw val (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
+  (str val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
 
@@ -332 +350 @@
                                              ((v :lisp))
                                              ((temp :u32)))
-  (lwz temp arm::misc-header-offset v)
-  (rlwinm dest 
-          temp 
-          (- arm::nbits-in-word (- arm::num-subtag-bits arm::fixnumshift))
-          (- arm::num-subtag-bits arm::fixnumshift) 
-          (- arm::least-significant-bit arm::fixnumshift)))
+  (ldr temp (:@ v (:$ arm::misc-header-offset)))
+  (bic temp temp (:$ arm::subtag-mask))
+  (mov dest (:lsr temp (:$ (- arm::num-subtag-bits arm::fixnum-shift)))))
 
 (define-arm-vinsn check-misc-bound (()
@@ -343 +358 @@
                                      (v :lisp))
                                     ((temp :u32)))
-  (lwz temp arm::misc-header-offset v)
-  (rlwinm temp 
-          temp 
-          (- arm::nbits-in-word (- arm::num-subtag-bits arm::fixnumshift))
-          (- arm::num-subtag-bits arm::fixnumshift) 
-          (- arm::least-significant-bit arm::fixnumshift))
-  (twlge idx temp))
+  (ldr temp (:@ v (:$ arm::misc-header-offset)))
+  (bic temp temp (:$ arm::subtag-mask))
+  (cmp idx (:lsr temp (:$ (- arm::num-subtag-bits arm::fixnum-shift))))
+  (uuo-error-vector-bounds (:? hs) idx v))
 
 (define-arm-vinsn 2d-unscaled-index (((dest :imm)
@@ -356 +368 @@
                                       (i :imm)
                                       (j :imm)))
-  (mullw dim1 i dim1)
+  (mul dim1 i dim1)
   (add dest dim1 j))
 
 ;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
+
 (define-arm-vinsn 3d-unscaled-index (((dest :imm)
                                       (dim1 :u32)
@@ -368 +381 @@
                                       (j :imm)
                                       (k :imm)))
-  (mullw dim1 dim1 dim2)
-  (mullw dim2 j dim2)
-  (mullw dim1 i dim1)
+  (mul dim1 dim1 dim2)
+  (mul dim2 j dim2)
+  (mul dim1 i dim1)
   (add dim2 dim1 dim2)
   (add dest dim2 k))
@@ -377 +390 @@
 (define-arm-vinsn 2d-dim1 (((dest :u32))
                            ((header :lisp)))
-  (lwz dest (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
-  (srawi dest dest arm::fixnumshift))
+  (ldr dest (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
+  (mov dest (:asr dest (:$ arm::fixnumshift))))
+
+
 
 (define-arm-vinsn 3d-dims (((dim1 :u32)
                             (dim2 :u32))
                            ((header :lisp)))
-  (lwz dim1 (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
-  (lwz dim2 (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))) header)
-  (srawi dim1 dim1 arm::fixnumshift)
-  (srawi dim2 dim2 arm::fixnumshift))
+  (ldr dim1 (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
+  (ldr dim2 (:@ header (:$ (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))))))
+  (mov dim1 (:asr dim1 (:$ arm::fixnumshift)))
+  (mov dim2 (:asr dim2 (:$ arm::fixnumshift))))
 
 ;; Return dim1 (unboxed)
@@ -393 +408 @@
                                    (j :imm)
                                    (header :lisp)))
-  (lwz dim (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)) header)
-  (twlge i dim)
-  (lwz dim (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
-  (twlge j dim)
-  (srawi dim dim arm::fixnumshift))
+  (ldr dim (:@ header (:$ (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)))))
+  (cmp i dim)
+  (uuo-error-array-bounds (:? hs) i header)
+  (ldr dim (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
+  (cmp j dim)
+  (uuo-error-array-bounds (:? hs) j header)
+  (mov dim (:asr dim (:$ arm::fixnumshift))))
 
 (define-arm-vinsn check-3d-bound (((dim1 :u32)
@@ -405 +422 @@
                                    (k :imm)
                                    (header :lisp)))
-  (lwz dim1 (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)) header)
-  (twlge i dim1)
-  (lwz dim1 (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
-  (twlge j dim1)
-  (lwz dim2 (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))) header)
-  (twlge k dim2)
-  (srawi dim1 dim1 arm::fixnumshift)
-  (srawi dim2 dim2 arm::fixnumshift))
+  (ldr dim1 (:@ header (:$ (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)))))
+  (cmp i dim1)
+  (uuo-error-array-bounds (:? hs) i header)
+  (ldr dim1 (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
+  (cmp j dim1)
+  (uuo-error-array-bounds (:? hs) i header)
+  (ldr dim2 (:@ header (:$ (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))))))
+  (cmp k dim2)
+  (uuo-error-array-bounds (:? hs) i header)
+  (mov dim1 (:asr dim1 (:$ arm::fixnumshift)))
+  (mov dim2 (:asr dim2 (:$ arm::fixnumshift))))
 
 (define-arm-vinsn array-data-vector-ref (((dest :lisp))
                                          ((header :lisp)))
-  (lwz dest arm::arrayH.data-vector header))
+  (ldr dest (:@ header (:$ arm::arrayH.data-vector))))
   
 
+#+can-encode-array-rank-trap
 (define-arm-vinsn check-arrayH-rank (()
                                      ((header :lisp)
                                       (expected :u32const))
                                      ((rank :imm)))
-  (lwz rank arm::arrayH.rank header)
-  (twi 27 rank (:apply ash expected arm::fixnumshift)))
-
+  (ldr rank (:@ header (:$ arm::arrayH.rank)))
+  (cmp rank (:apply ash expected arm::fixnumshift))
+  (uuo-error-bad-array-rank (:? ne) expected header))
+
+#+can-remember-what-this-means
 (define-arm-vinsn check-arrayH-flags (()
                                       ((header :lisp)
@@ -443 +466 @@
                                   ((node :lisp)
                                    (cellno :u32const)))
-  (lwz dest (:apply + arm::misc-data-offset (:apply ash cellno 2)) node))
+  (ldr dest (:@ node (:$ (:apply + arm::misc-data-offset (:apply ash cellno 2))))))
 
 
@@ -451 +474 @@
                                (index :lisp))
                               ((scaled :u32)))
-  (la scaled arm::misc-data-offset index)
-  (lwzx dest instance scaled)
-  (tweqi dest arm::slot-unbound-marker))
+  (add scaled index (:$ arm::misc-data-offset))
+  (ldr dest (:@ instance scaled))
+  (cmp dest (:$ arm::slot-unbound-marker))
+  (uuo-error-slot-unbound (:? eq) instance index))
 
 
@@ -461 +485 @@
                                       ((src :address)
                                        (index :s16const)))
-  (lwz dest index src))
+  (ldr dest (:@ src (:$ index))))
 
 
@@ -467 +491 @@
                                              ((src :address)
                                               (index :s16const)))
-  (lwz dest index src))
+  (ldr dest (:@ src (:$ index))))
 
 (define-arm-vinsn mem-ref-c-natural (((dest :u32))
                                      ((src :address)
                                       (index :s16const)))
-  (lwz dest index src))
+  (ldr dest (:@ src (:$ index))))
   
 
@@ -478 +502 @@
                                     ((src :address)
                                      (index :s32)))
-  (lwzx dest src index))
+  (ldr dest (:@ src index)))
 
 (define-arm-vinsn mem-ref-signed-fullword (((dest :u32))
                                            ((src :address)
                                             (index :s32)))
-  (lwzx dest src index))
+  (ldr dest (:@ src index)))
 
 (define-arm-vinsn mem-ref-natural (((dest :u32))
                                    ((src :address)
                                     (index :s32)))
-  (lwzx dest src index))
+  (ldr dest (:@ src index)))
 
 
@@ -494 +518 @@
                                  ((src :address)
                                   (index :s16const)))
-  (lhz dest index src))
+  (ldrh dest (:@ src (:$ index))))
 
 
@@ -500 +524 @@
                                ((src :address)
                                 (index :s32)))
-  (lhzx dest src index))
+  (ldrh dest (:@ src index)))
 
 
@@ -507 +531 @@
                                  ((src :address)
                                   (index :s16const)))
-  (lha dest index src))
+  (ldrsh dest (:@ src (:$ index))))
 
 (define-arm-vinsn mem-ref-s16 (((dest :s16))
                                ((src :address)
                                 (index :s32)))
-  (lhax dest src index))
+  (ldrsh dest (:@ src index)))
 
 (define-arm-vinsn mem-ref-c-u8 (((dest :u8))
                                 ((src :address)
                                  (index :s16const)))
-  (lbz dest index src))
+  (ldrb dest (:@ src (:$ index))))
 
 (define-arm-vinsn mem-ref-u8 (((dest :u8))
                               ((src :address)
                                (index :s32)))
-  (lbzx dest src index))
+  (ldrb dest (:@ src index)))
 
 (define-arm-vinsn mem-ref-c-s8 (((dest :s8))
                                 ((src :address)
                                  (index :s16const)))
-  (lbz dest index src)
-  (extsb dest dest))
+  (ldrsb dest (:@ src (:$ index))))
 
 (define-arm-vinsn mem-ref-s8 (((dest :s8))
                               ((src :address)
                                (index :s32)))
-  (lbzx dest src index)
-  (extsb dest dest))
-
+  (ldrsb dest (:@ src index)))
+
+#+notyet
 (define-arm-vinsn mem-ref-c-bit (((dest :u8))
                                  ((src :address)
@@ -543 +566 @@
   (rlwinm dest dest bit-shift 31 31))
 
+
+#+notyet
 (define-arm-vinsn mem-ref-c-bit-fixnum (((dest :lisp))
                                         ((src :address)
@@ -551 +576 @@
   (rlwinm dest byteval bit-shift 29 29))
 
+#+notyet
 (define-arm-vinsn mem-ref-bit (((dest :u8))
                                ((src :address)
@@ -562 +588 @@
   (rlwnm dest dest bit-shift 31 31))
 
-
+#+notyet
 (define-arm-vinsn mem-ref-bit-fixnum (((dest :lisp))
                                       ((src :address)
@@ -580 +606 @@
 (define-arm-vinsn mem-ref-c-double-float (((dest :double-float))
                                           ((src :address)
-                                           (index :s16const)))
-  (lfd dest index src))
+                                           (index :s16const))
+                                          ((low (:u32 #.arm::imm0))
+                                           (high (:u32 #.arm::imm1))))
+  (ldrd low (:@ src (:$ index)))
+  (fmdrr dest low high))
 
 (define-arm-vinsn mem-ref-double-float (((dest :double-float))
                                         ((src :address)
-                                         (index :s32)))
-  (lfdx dest src index))
+                                         (index :s32))
+                                        ((low (:u32 #.arm::imm0))
+                                         (high (:u32 #.arm::imm1))))
+  (ldrd low (:@ src  index))
+  (fmdrr dest low high))
 
 (define-arm-vinsn mem-set-c-double-float (()
                                           ((val :double-float)
                                            (src :address)
-                                           (index :s16const)))
-  (stfd val index src))
+                                           (index :s16const))
+                                          ((low (:u32 #.arm::imm0))
+                                           (high (:u32 #.arm::imm1))))
+  (fmrrd low high src)
+  (strd low (:@ src (:$ index))))
 
 (define-arm-vinsn mem-set-double-float (()
                                         ((val :double-float)
                                          (src :address)
-                                         (index :s32)))
-  (stfdx val src index))
+                                         (index :s32)) ; imm2, I presume
+                                        ((low (:u32 #.arm::imm0))
+                                         (high (:u32 #.arm::imm1))))
+  (fmrrd low high src)
+  (strd low (:@ src index)))
 
 (define-arm-vinsn mem-ref-c-single-float (((dest :single-float))
                                           ((src :address)
-                                           (index :s16const)))
-  (lfs dest index src))
+                                           (index :s16const))
+                                          ((temp :u32)))
+  (ldr temp (:@ src (:$ index)))
+  (fmsr dest temp))
 
 (define-arm-vinsn mem-ref-single-float (((dest :single-float))
                                         ((src :address)
-                                         (index :s32)))
-  (lfsx dest src index))
+                                         (index :s32))
+                                        ((temp :u32)))
+  (ldr temp (:@ src index))
+  (fmsr dest temp))
 
 (define-arm-vinsn mem-set-c-single-float (()
                                           ((val :single-float)
                                            (src :address)
-                                           (index :s16const)))
-  (stfs val index src))
+                                           (index :s16const))
+                                          ((temp :u32)))
+  (fmrs temp src)
+  (str temp (:@ src (:$ index))))
 
 (define-arm-vinsn mem-set-single-float (()
                                         ((val :single-float)
                                          (src :address)
-                                         (index :s32)))
-  (stfsx val src index))
+                                         (index :s32))
+                                        ((temp :u32)))
+  (fmrs temp src)
+  (str temp (:@ src (:$ index))))
 
 
@@ -627 +673 @@
                                       (src :address)
                                       (index :s16const)))
-  (stw val index src))
+  (str val (:@ src (:$ index))))
 
 (define-arm-vinsn mem-set-address (()
@@ -633 +679 @@
                                     (src :address)
                                     (index :s32)))
-  (stwx val src index))
+  (str val (:@ src index)))
 
 (define-arm-vinsn mem-set-c-fullword (()
@@ -639 +685 @@
                                        (src :address)
                                        (index :s16const)))
-  (stw val index src))
+  (str val (:@ src (:$ index))))
 
 (define-arm-vinsn mem-set-fullword (()
@@ -645 +691 @@
                                      (src :address)
                                      (index :s32)))
-  (stwx val src index))
+  (str val (:@ src index)))
 
 (define-arm-vinsn mem-set-c-halfword (()
@@ -651 +697 @@
                                        (src :address)
                                        (index :s16const)))
-  (sth val index src))
+  (strh val (:@ src (:$ index))))
 
 (define-arm-vinsn mem-set-halfword (()
@@ -657 +703 @@
                                      (src :address)
                                      (index :s32)))
-  (sthx val src index))
+  (strh val (:@ src index)))
 
 (define-arm-vinsn mem-set-c-byte (()
@@ -663 +709 @@
                                    (src :address)
                                    (index :s16const)))
-  (stb val index src))
+  (strb val (:@ src (:$ index))))
 
 (define-arm-vinsn mem-set-byte (()
@@ -669 +715 @@
                                  (src :address)
                                  (index :s32)))
-  (stbx val src index))
-
+  (strb val (:@ src index)))
+
+#+later
 (define-arm-vinsn mem-set-c-bit-0 (()
                                    ((src :address)
@@ -681 +728 @@
   (stb val byte-index src))
 
+#+later
 (define-arm-vinsn mem-set-c-bit-1 (()
                                    ((src :address)
@@ -690 +738 @@
   (stb val byte-index src))
 
+#+later
 (define-arm-vinsn mem-set-c-bit (()
                                  ((src :address)
@@ -738 +787 @@
                                       ((object :lisp)))
   (and tag object (:$ arm::tagmask))
-  (mov tag (:lsl$ tag arm::fixnumshift)))
+  (mov tag (:lsl tag (:$ arm::fixnumshift))))
 
 (define-arm-vinsn extract-fulltag (((tag :u8))
@@ -749 +798 @@
                                           ((object :lisp)))
   (and tag object (:$ arm::fulltagmask))
-  (mov tag (:lsl$ tag arm::fixnumshift)))
+  (mov tag (:lsl tag (:$ arm::fixnumshift))))
 
 (define-arm-vinsn extract-typecode (((code :u8))
@@ -756 +805 @@
   (and code object (:$ arm::tagmask))
   (cmp code (:$ arm::tag-misc))
-  (ldrbeq code (:@$ object arm::misc-subtag-offset)))
+  (ldrbeq code (:@ object (:$ arm::misc-subtag-offset))))
 
 (define-arm-vinsn extract-typecode-fixnum (((code :imm))
@@ -763 +812 @@
   (and subtag object (:$ arm::tagmask))
   (cmp subtag (:$ arm::tag-misc))
-  (ldrbeq subtag (:@$ object arm::misc-subtag-offset))
-  (mov code (:lsl$ subtag arm::fixnumshift)))
+  (ldrbeq subtag (:@ object (:$ arm::misc-subtag-offset)))
+  (mov code (:lsl subtag (:$ arm::fixnumshift))))
 
 
@@ -781 +830 @@
   (beq :got-it)
   (cmp tag (:$ arm::tag-misc))
-  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
   (cmp tag (:$ arm::subtag-bignum))
   (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::xtype-integer))
@@ -791 +840 @@
   (and tag object (:$ arm::tagmask))
   (cmp tag (:$ arm::tag-misc))
-  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
   (cmp tag (:$ arm::subtag-simple-vector))
   (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::subtag-simple-vector)))
@@ -800 +849 @@
   (and tag object (:$ arm::tagmask))
   (cmp tag (:$ arm::tag-misc))
-  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
   (cmp tag (:$ arm::subtag-simple-base-string))
   (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::subtag-simple-base-string)))
@@ -810 +859 @@
   (and tag object (:$ arm::tagmask))
   (cmp tag (:$ arm::tag-misc))
-  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
   (cmp tag (:$ arm::max-real-subtag))
   (uuo-cerror-reg-not-xtype (:? hi) object (:$ arm::xtype-real)))
@@ -819 +868 @@
   (and tag object (:$ arm::tagmask))
   (cmp tag (:$ arm::tag-misc))
-  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
   (cmp tag (:$ arm::max-numeric-subtag))
   (uuo-cerror-reg-not-xtype (:? hi) object (:$ arm::xtype-number)))
@@ -834 +883 @@
                                   ((object :lisp))
                                   ((tag :u8)))
-  (and tag object (:$ arm::lisptagmask))
+  (and tag object (:$ arm::tagmask))
   (cmp tag (:$ arm::tag-misc))
   (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
@@ -853 +902 @@
                               ((tag :u32)))
   (mov tag (:lsl object (:$ (- arm::nbits-in-word (+ 8 arm::fixnumshift)))))
-  (mov tag (:asr tag (- arm::nbits-in-word (+ 8 arm::fixnumshift))))
+  (mov tag (:asr tag (:$ (- arm::nbits-in-word (+ 8 arm::fixnumshift)))))
   (cmp object (:lsl tag (:$ arm::fixnumshift)))
   (uuo-cerror-reg-not-xtype (:? ne)  object (:$ arm::xtype-s8)))
@@ -859 +908 @@
 
 (define-arm-vinsn require-u8 (()
-                              ((object :lisp)))
-  (tst object (:$ (lognot (ash #xff arm::fixnumshift))))
+                              ((object :lisp))
+                              ((temp :u32)))
+  (mov temp (:$ (lognot (ash #xff arm::fixnumshift))))
+  (tst object temp)
   (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::xtype-u8)))
 
@@ -890 +941 @@
   (ldreq header (:@ src (:$ arm::misc-header-offset)))
   (cmpeq tag header)
-  (uuo-cerror-object-not-xtype (:? ne) src (:$ arm::xtype-s32))
+  (uuo-cerror-reg-not-xtype (:? ne) src (:$ arm::xtype-s32))
   :got-it)
 
@@ -898 +949 @@
                                ((temp :u32)))
   :again
-  (test src (:$ (logior (ash 1 (1- arm::nbits-in-word)) arm::tagmask)))
+  (tst src (:$ (logior (ash 1 (1- arm::nbits-in-word)) arm::tagmask)))
   (beq :got-it)
   (and temp src (:$ arm::tagmask))
@@ -905 +956 @@
   (cmp temp (:$ arm::subtag-bignum))
   (bne :bad-if-ne)
-  (ldr temp (:@ src arm::misc-header-offset))
+  (ldr temp (:@ src (:$ arm::misc-header-offset)))
   (mov temp (:lsr temp (:$ arm::num-subtag-bits)))
   (cmp temp (:$ 2))
@@ -930 +981 @@
   (ldreq header (:@ src (:$ arm::misc-header-offset)))
   (andeq tag header (:$ arm::subtag-mask))
-  (cmp tag (:$ arm::subtag_bignum))
-  (move header (:lsr header (:$ arm::num-subtag-bits)))
+  (cmp tag (:$ arm::subtag-bignum))
+  (mov header (:lsr header (:$ arm::num-subtag-bits)))
   (bne :bad-if-ne)
   (cmp header (:$ 1))
@@ -949 +1000 @@
   (beq :got-it)
   (cmp temp (:$ arm::tag-misc))
-  (ldreq header (:@ src (:$ arm::misc-header-offset0)))
+  (ldreq header (:@ src (:$ arm::misc-header-offset)))
   (andeq temp src (:$ arm::subtag-mask))
   (moveq header (:lsr header (:$ arm::num-subtag-bits)))
@@ -1013 +1064 @@
   (cmp temp (:$ arm::tag-misc))
   (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
-  (ldr dest (:+@$ src arm::misc-header-offset))
-  (ldr temp (:$ arm::subtag-bignum))
+  (ldr dest (:@ src (:$ arm::misc-header-offset)))
+  (mov temp (:$ arm::subtag-bignum))
   (orr temp temp (:$ (ash 1 arm::num-subtag-bits)))
   (cmp dest temp)
   (bne :maybe-two-digit)
-  (ldr dest (:+@$ src arm::misc-data-offset))
+  (ldr dest (:@ src (:$ arm::misc-data-offset)))
   (tst dest (:$ 31))
   (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
@@ -1025 +1076 @@
   (add temp temp (:$ (ash 1 arm::num-subtag-bits)))
   (cmp dest temp)
-  (ldreq temp (:+@$ src (+ arm::misc-data-offset 4)))
+  (ldreq temp (:@ src (:$ (+ arm::misc-data-offset 4))))
   (cmpeq temp (:$ 0))
-  (ldreq dest (:+@$ src arm::misc-data-offset))
+  (ldreq dest (:@ src (:$ arm::misc-data-offset)))
   (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
-  :got-it))
+  :got-it)
 
 ;;; an object is of type (SIGNED-BYTE 32) iff
@@ -1039 +1090 @@
                              ((tag :u32)))
   (ands tag src (:$ arm::tagmask))
-  (mov dest (:asr$ src arm::fixnumshift))
+  (mov dest (:asr src (:$ arm::fixnumshift)))
   (beq :got-it)
   (mov dest (:$ arm::subtag-bignum))
   (orr dest dest (:$ (ash 1 arm::num-subtag-bits)))
   (cmp tag (:$ arm::tag-misc))
-  (ldreq tag (:+@ src (:$ arm::misc-header-offset)))
+  (ldreq tag (:@ src (:$ arm::misc-header-offset)))
   (cmpeq dest tag)
-  (ldreq dest (:+@ src (:$ arm::misc-data-offset)))
+  (ldreq dest (:@ src (:$ arm::misc-data-offset)))
   (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-s32))
-  :got-it))
+  :got-it)
 
 
@@ -1083 +1134 @@
                             ((src :lisp)))
   (mov dest (:lsl dest (:$ (- 24 arm::fixnumshift))))
-  (mov dest (:$ asr dest (:$ 24)))
+  (mov dest (:asr dest (:$ 24)))
   (cmp src (:lsl dest (:$ arm::fixnumshift)))
   (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-s8)))
@@ -1092 +1143 @@
   (cmp dest (:$ arm::subtag-character))
   (mov dest (:lsr src (:$ arm::charcode-shift)))
-  (uuo-error-object-not-xtype (:? ne) src (:$ arm::subtag-character)))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::subtag-character)))
 
 
@@ -1101 +1152 @@
   (uuo-error-reg-not-xtype (:? hi) src (:$ arm::xtype-bit)))
 
+#+later
 (define-arm-vinsn unbox-bit-bit0 (((dest :u32))
                                   ((src :lisp))
@@ -1110 +1162 @@
   :got-it)
 
-(define-arm-vinsn fixnum->fpr (((dest :double-float))
-                               ((src :lisp))
-                               ((imm :s32)))
-  (stfd arm::fp-s32conv -8 arm::sp)
-  (srawi imm src arm::fixnumshift)
-  (xoris imm imm #x8000)
-  (stw imm -4 arm::sp)
-  (lfd dest -8 arm::sp)
-  (fsub dest dest arm::fp-s32conv))
+(define-arm-vinsn fixnum->double (((dest :double-float))
+                                  ((src :lisp))
+                                  ((imm :s32)
+                                   (temp :single-float)))
+  (mov imm (:asr src (:$ arm::fixnumshift)))
+  (fmsr temp imm)
+  (fsitod dest temp))
+
+(define-arm-vinsn fixnum->single (((dest :single-float))
+                                  ((src :lisp))
+                                  ((imm :s32)))
+  (mov imm (:asr src (:$ arm::fixnumshift)))
+  (fmsr dest imm)
+  (fsitos dest dest))
 
 
@@ -1124 +1181 @@
                                              ((src :u32)
                                               (sh :u32)))
-  (srw dest src sh))
+  (mov dest (:lsr src sh)))
 
 (define-arm-vinsn u32logandc2 (((dest :u32))
                                ((x :u32)
                                 (y :u32)))
-  (andc dest x y))
+  (bic dest x y))
 
 (define-arm-vinsn u32logior (((dest :u32))
                              ((x :u32)
                               (y :u32)))
-  (or dest x y))
-
-(define-arm-vinsn rotate-left-variable-word (((dest :u32))
-                                             ((src :u32)
-                                              (rot :u32)))
-  (rlwnm dest src rot 0 31))
+  (orr dest x y))
 
 (define-arm-vinsn complement-shift-count (((dest :u32))
                                           ((src :u32)))
-  (subfic dest src 32))
+  (rsb dest src (:$ 32)))
 
 (define-arm-vinsn extract-lowbyte (((dest :u32))
                                    ((src :lisp)))
-  (clrlwi dest src (- arm::nbits-in-word arm::num-subtag-bits)))
-
-;;; Set DEST to the difference between the low byte of SRC and BYTEVAL.
-(define-arm-vinsn extract-compare-lowbyte (((dest :u32))
-                                           ((src :lisp)
-                                            (byteval :u8const)))
-  (clrlwi dest src (- arm::nbits-in-word arm::num-subtag-bits))
-  (subi dest dest byteval))
-
-
-;;; Set the "EQ" bit in condition-register field CRF if object is
-;;; a fixnum.  Leave the object's tag in TAG.
-;;; This is a little easier if CRF is CR0.
-(define-arm-vinsn eq-if-fixnum (((crf :crf)
-                                 (tag :u8))
-                                ((object :lisp))
-                                ())
-  ((:eq crf 0)
-   (clrlwi. tag object (- arm::nbits-in-word arm::nlisptagbits)))
-  ((:not (:eq crf 0))
-   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-   (cmpwi crf tag arm::tag-fixnum)))
+  (and dest src (:$ arm::subtag-mask)))
+
 
 
 
 (define-arm-vinsn trap-unless-fixnum (()
-                                      ((object :lisp))
-                                      ((tag :u8)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (twnei tag arm::tag-fixnum))
+                                      ((object :lisp)))
+  (tst object (:$ arm::fixnummask))
+  (uuo-error-reg-not-lisptag (:? ne) object (:$ arm::tag-fixnum)))
 
 (define-arm-vinsn trap-unless-list (()
                                     ((object :lisp))
                                     ((tag :u8)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (twnei tag arm::tag-list))
+  (ands tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-list))
+  (uuo-error-reg-not-lisptag (:? ne) object (:$ arm::tag-list)))
 
 (define-arm-vinsn trap-unless-single-float (()
                                             ((object :lisp))
-                                            ((tag :u8)
-                                             (crf :crf)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi crf tag arm::tag-misc)
-  (bne crf :do-trap)
-  (lbz tag arm::misc-subtag-offset object)
-  :do-trap
-  (twnei tag arm::subtag-single-float))
+                                            ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-single-float))
+  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-single-float)))
 
 (define-arm-vinsn trap-unless-double-float (()
                                             ((object :lisp))
-                                            ((tag :u8)
-                                             (crf :crf)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi crf tag arm::tag-misc)
-  (bne crf :do-trap)
-  (lbz tag arm::misc-subtag-offset object)
-  :do-trap
-  (twnei tag arm::subtag-double-float))
+                                            ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-double-float))
+  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-double-float)))
 
 
 (define-arm-vinsn trap-unless-array-header (()
                                             ((object :lisp))
-                                            ((tag :u8)
-                                             (crf :crf)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi crf tag arm::tag-misc)
-  (bne crf :do-trap)
-  (lbz tag arm::misc-subtag-offset object)
-  :do-trap
-  (twnei tag arm::subtag-arrayH))
+                                            ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-arrayH))
+  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-arrayH)))
 
 (define-arm-vinsn trap-unless-macptr (()
                                       ((object :lisp))
-                                      ((tag :u8)
-                                       (crf :crf)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi crf tag arm::tag-misc)
-  (bne crf :do-trap)
-  (lbz tag arm::misc-subtag-offset object)
-  :do-trap
-  (twnei tag arm::subtag-macptr))
+                                      ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-macptr))
+  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-macptr)))
 
 
@@ -1234 +1258 @@
                                        ((object :lisp))
                                        ((tag :u8)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (twnei tag arm::tag-misc))
-
-(define-arm-vinsn trap-unless-fulltag= (()
-                                        ((object :lisp)
-                                         (tagval :u16const))
-                                        ((tag :u8)))
-  (clrlwi tag object (- arm::nbits-in-word arm::ntagbits))
-  (twnei tag tagval))
-
-(define-arm-vinsn trap-unless-lowbyte= (()
-                                        ((object :lisp)
-                                         (tagval :u16const))
-                                        ((tag :u8)))
-  (clrlwi tag object (- arm::nbits-in-word 8))
-  (twnei tag tagval))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (uuo-error-reg-not-lisptag (:? ne) object (:$ arm::tag-misc)))
+
+
 
 (define-arm-vinsn trap-unless-character (()
                                          ((object :lisp))
                                          ((tag :u8)))
-  (clrlwi tag object (- arm::nbits-in-word 8))
-  (twnei tag arm::subtag-character))
+  (and tag object (:$ arm::subtag-mask))
+  (cmp tag (:$ arm::subtag-character))
+  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-character)))
 
 (define-arm-vinsn trap-unless-cons (()
                                     ((object :lisp))
                                     ((tag :u8)))
-  (clrlwi tag object (- arm::nbits-in-word arm::ntagbits))
-  (twnei tag arm::fulltag-cons))
+  (and tag object (:$ arm::fulltagmask))
+  (cmp tag (:$ arm::fulltag-cons))
+  (uuo-error-reg-not-fulltag (:? ne) object (:$ arm::fulltag-cons)))
 
 (define-arm-vinsn trap-unless-typecode= (()
                                          ((object :lisp)
                                           (tagval :u16const))
-                                         ((tag :u8)
-                                          (crf :crf)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi crf tag arm::tag-misc)
-  (bne crf :do-trap)
-  (lbz tag arm::misc-subtag-offset object)
-  :do-trap
-  (twnei tag tagval))
+                                         ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ tagval))
+  (uuo-error-reg-not-xtype (:? ne) object (:$ tagval)))
   
 (define-arm-vinsn subtract-constant (((dest :imm))
                                      ((src :imm)
                                       (const :s16const)))
-  (subi dest src const))
-
-(define-arm-vinsn trap-unless-numeric-type (()
-                                            ((object :lisp)
-                                             (maxtype :u16const))
-                                            ((crf0 (:crf 0))
-                                             (tag :u8)
-                                             (crfX :crf)))
-  (clrlwi. tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi tag arm::tag-misc)
-  (beq+ crf0 :fixnum)
-  (bne crfX :scale-tag)
-  (lbz tag arm::misc-subtag-offset object)
-  :scale-tag
-  (subi tag tag arm::min-numeric-subtag)
-  (twlgti tag (:apply - maxtype arm::min-numeric-subtag))
-  :fixnum)
+  (sub dest src (:$ const)))
+
 
 
 ;; Bit-extraction & boolean operations
 
-(eval-when (:compile-toplevel :execute)
-  (assert (= arm::t-offset #b10001))) ; ARM-bits 31 and 27 set
 
 ;; For some mind-numbing reason, IBM decided to call the most significant
@@ -1311 +1307 @@
 ;; 31.))
 
+#+later
 (define-arm-vinsn extract-variable-bit (((dest :u8))
                                         ((src :u32)
@@ -1318 +1315 @@
   (extrwi dest dest 1 0))
 
-
+#+later
 (define-arm-vinsn extract-variable-bit-fixnum (((dest :imm))
                                                ((src :u32)
@@ -1337 +1334 @@
 ;; between T and NIL) or 0.
 
+#+later
 (define-arm-vinsn lowbit->truth (((dest :lisp)
                                   (bits :u32))
@@ -1344 +1342 @@
   (addi dest bits (:apply target-nil-value)))
 
+#+later
 (define-arm-vinsn invert-lowbit (((bits :u32))
                                  ((bits :u32))
@@ -1351 +1350 @@
                            
 
-;; Some of the obscure-looking instruction sequences - which map some relation
-;; to ARM bit 31 of some register - were found by the GNU SuperOptimizer.
-;; Some of them use extended-precision instructions (which may cause interlocks
-;; on some superscalar ARMs, if I remember correctly.)  In general, sequences
-;; that GSO found that -don't- do extended precision are longer and/or use
-;; more temporaries.
-;; On the 604, the penalty for using an instruction that uses the CA bit is
-;; "at least" one cycle: it can't complete execution until all "older" instructions
-;; have.  That's not horrible, especially given that the alternative is usually
-;; to use more instructions (and, more importantly, more temporaries) to avoid
-;; using extended-precision.
-
-
-(define-arm-vinsn eq0->bit31 (((bits :u32))
-                              ((src (t (:ne bits)))))
-  (cntlzw bits src)
-  (srwi bits bits 5))                   ; bits = 0000...000X
-
-(define-arm-vinsn ne0->bit31 (((bits :u32))
-                              ((src (t (:ne bits)))))
-  (cntlzw bits src)
-  (slw bits src bits)
-  (srwi bits bits 31))                  ; bits = 0000...000X
-
-(define-arm-vinsn lt0->bit31 (((bits :u32))
-                              ((src (t (:ne bits)))))
-  (srwi bits src 31))                   ; bits = 0000...000X
-
-
+(define-arm-vinsn eq0->boolean (((dest t))
+                                ((src t)))
+  (cmp src (:$ 0))
+  (mov dest (:$ arm::nil-value))
+  (addeq dest dest (:$ arm::t-offset)))                
+
+
+(define-arm-vinsn ne0->boolean (((dest t))
+                                ((src t)))
+  (cmp src (:$ 0))
+  (mov dest (:$ arm::nil-value))
+  (addne dest dest (:$ arm::t-offset)))
+
+(define-arm-vinsn lt0->boolean (((dest t))
+                                ((src t)))
+  (cmp src (:$ 0))
+  (mov dest (:$ arm::nil-value))
+  (addmi dest dest (:$ arm::t-offset)))                
+
+
+#+later
 (define-arm-vinsn ge0->bit31 (((bits :u32))
                               ((src (t (:ne bits)))))
@@ -1385 +1376 @@
   (xori bits bits 1))                   ; bits = 0000...000X
 
-
+#+later
 (define-arm-vinsn le0->bit31 (((bits :u32))
                               ((src (t (:ne bits)))))
@@ -1392 +1383 @@
   (srwi bits bits 31))                  ; bits = 0000...000X
 
+#+later
 (define-arm-vinsn gt0->bit31 (((bits :u32))
                               ((src (t (:ne bits)))))
@@ -1398 +1390 @@
   (srwi bits bits 31))                  ; bits = 0000...000X
 
+#+later
 (define-arm-vinsn ne->bit31 (((bits :u32))
                              ((x t)
@@ -1407 +1400 @@
   (srwi bits bits 31))                  ; bits = 0000...000X
 
+#+later
 (define-arm-vinsn fulltag->bit31 (((bits :u32))
                                   ((lispobj :lisp)
@@ -1416 +1410 @@
   (srwi bits bits 5))
 
-
+#+later
 (define-arm-vinsn eq->bit31 (((bits :u32))
                              ((x t)
@@ -1424 +1418 @@
   (srwi bits bits 5))                   ; bits = 0000...000X
 
+#+later
 (define-arm-vinsn eqnil->bit31 (((bits :u32))
                                 ((x t)))
@@ -1430 +1425 @@
   (srwi bits bits 5))
 
+#+later
 (define-arm-vinsn ne->bit31 (((bits :u32))
                              ((x t)
@@ -1438 +1434 @@
   (xori bits bits 1))
 
+#+later
 (define-arm-vinsn nenil->bit31 (((bits :u32))
                                 ((x t)))
@@ -1445 +1442 @@
   (xori bits bits 1))
 
+#+later
 (define-arm-vinsn lt->bit31 (((bits :u32))
                              ((x (t (:ne bits)))
@@ -1455 +1453 @@
   (srwi bits bits 31))                  ; bits = 0000...000X
 
+#+later
 (define-arm-vinsn ltu->bit31 (((bits :u32))
                               ((x :u32)
@@ -1462 +1461 @@
   (neg bits bits))
 
+#+later
 (define-arm-vinsn le->bit31 (((bits :u32))
                              ((x (t (:ne bits)))
@@ -1472 +1472 @@
   (srwi bits bits 31))                  ; bits = 0000...000X
 
+#+later
 (define-arm-vinsn leu->bit31  (((bits :u32))
                                ((x :u32)
@@ -1478 +1479 @@
   (addze bits arm::rzero))
 
+#+later
 (define-arm-vinsn gt->bit31 (((bits :u32))
                              ((x (t (:ne bits)))
@@ -1488 +1490 @@
   (srwi bits bits 31))                  ; bits = 0000...000X
 
+#+later
 (define-arm-vinsn gtu->bit31 (((bits :u32))
                               ((x :u32)
@@ -1495 +1498 @@
   (neg bits bits))
 
+#+later
 (define-arm-vinsn ge->bit31 (((bits :u32))
                              ((x (t (:ne bits)))
@@ -1504 +1508 @@
   (srwi bits bits 31))                  ; bits = 0000...000X
 
+#+later
 (define-arm-vinsn geu->bit31 (((bits :u32))
                               ((x :u32)
@@ -1517 +1522 @@
 ;;; MFCR takes three cycles and waits for previous instructions to complete.
 ;;; Of course, using a CR field costs us something as well.
+#+later
 (define-arm-vinsn crbit->bit31 (((bits :u32))
                                 ((crf :crf)
@@ -1525 +1531 @@
 
 
-(define-arm-vinsn compare (((crf :crf))
+(define-arm-vinsn compare (()
                            ((arg0 t)
                             (arg1 t))
                            ())
-  (cmpw crf arg0 arg1))
-
-(define-arm-vinsn compare-to-nil (((crf :crf))
+  (cmp arg0 arg1))
+
+(define-arm-vinsn compare-to-nil (()
                                   ((arg0 t)))
-  (cmpwi crf arg0 (:apply target-nil-value)))
-
-(define-arm-vinsn compare-logical (((crf :crf))
+  (cmp arg0 (:$ arm::nil-value)))
+
+(define-arm-vinsn compare-logical (
                                    ((arg0 t)
                                     (arg1 t))
                                    ())
-  (cmplw crf arg0 arg1))
-
-(define-arm-vinsn double-float-compare (((crf :crf))
+  (cmp  arg0 arg1))
+
+(define-arm-vinsn double-float-compare (()
                                         ((arg0 :double-float)
                                          (arg1 :double-float))
                                         ())
-  (fcmpo crf arg0 arg1))
+  (fcmped arg0 arg1)
+  (fmstat))
               
 
@@ -1571 +1578 @@
                                    ((x :single-float)
                                     (y :single-float))
-                                   ((crf (:crf 4))))
+                                   ())
   (fadds result x y))
 
@@ -1593 +1600 @@
 
 
-(define-arm-vinsn compare-unsigned (((crf :crf))
+(define-arm-vinsn compare-unsigned (()
                                     ((arg0 :imm)
                                      (arg1 :imm))
                                     ())
-  (cmplw crf arg0 arg1))
-
-(define-arm-vinsn compare-signed-s16const (((crf :crf))
+  (cmp arg0 arg1))
+
+(define-arm-vinsn compare-signed-s16const (()
                                            ((arg0 :imm)
                                             (imm :s16const))
                                            ())
-  (cmpwi crf arg0 imm))
-
-(define-arm-vinsn compare-unsigned-u16const (((crf :crf))
+  (cmp arg0 (:$ imm)))
+
+(define-arm-vinsn compare-unsigned-u16const (()
                                              ((arg0 :u32)
                                               (imm :u16const))
                                              ())
-  (cmplwi crf arg0 imm))
+  (cmp arg0 (:$ imm)))
 
 
@@ -1615 +1622 @@
 ;; Extract a constant bit (0-31) from src; make it be bit 31 of dest.
 ;; Bitnum is treated mod 32.
+#+later
 (define-arm-vinsn extract-constant-arm-bit (((dest :u32))
                                             ((src :imm)
@@ -1622 +1630 @@
 
 
+#+later
 (define-arm-vinsn set-constant-arm-bit-to-variable-value (((dest :u32))
                                                           ((src :u32)
@@ -1628 +1637 @@
   (rlwimi dest bitval (:apply - 32 bitnum) bitnum bitnum))
 
+#+later
 (define-arm-vinsn set-constant-arm-bit-to-1 (((dest :u32))
                                              ((src :u32)
@@ -1636 +1646 @@
    (ori dest src (:apply ash #x8000 (:apply - (:apply - bitnum 16))))))
 
+#+later
 (define-arm-vinsn set-constant-arm-bit-to-0 (((dest :u32))
                                              ((src :u32)
@@ -1641 +1652 @@
   (rlwinm dest src 0 (:apply logand #x1f (:apply 1+ bitnum)) (:apply logand #x1f (:apply 1- bitnum))))
 
-  
+
+#+later
 (define-arm-vinsn insert-bit-0 (((dest :u32))
                                 ((src :u32)
@@ -1654 +1666 @@
 ;;; I think ...
 ;;; Actually, it'd be "unbox, then subtract from 30".
+#+later
 (define-arm-vinsn extract-variable-non-insane-bit (((dest :u32))
                                                    ((src :imm)
@@ -1666 +1679 @@
 (define-arm-vinsn %cdr (((dest :lisp))
                         ((src :lisp)))
-  (ldr dest (:+@$ src arm::cons.cdr)))
+  (ldr dest (:@ src (:$ arm::cons.cdr))))
 
 (define-arm-vinsn %car (((dest :lisp))
                         ((src :lisp)))
-  (ldr dest (:+@$ src arm::cons.car)))
+  (ldr dest (:@ src (:$ arm::cons.car))))
 
 (define-arm-vinsn %set-car (()
                             ((cell :lisp)
                              (new :lisp)))
-  (str dest (:+@$ src arm::cons.car)))
+  (str cell (:@ new (:$ arm::cons.car))))
 
 (define-arm-vinsn %set-cdr (()
                             ((cell :lisp)
                              (new :lisp)))
-  (str dest (:+@$ src arm::cons.cdr)))
-
+  (str cell (:@ new (:$ arm::cons.cdr))))
+
+#+later
 (define-arm-vinsn load-adl (()
                             ((n :u32const)))
@@ -1689 +1703 @@
 (define-arm-vinsn set-nargs (()
                              ((n :s16const)))
-  (li nargs (:apply ash n arm::word-shift)))
+  (mov nargs (:$ (:apply ash n arm::word-shift))))
 
 (define-arm-vinsn scale-nargs (()
                                ((nfixed :s16const)))
   ((:pred > nfixed 0)
-   (add nargs narg (:$ (:apply - (:apply ash nfixed arm::word-shift))))))
+   (add nargs nargs (:$ (:apply - (:apply ash nfixed arm::word-shift))))))
                            
 
@@ -1701 +1715 @@
     (()
      ((reg :lisp)))
-  (str reg (:+@! vsp (:$ (- arm::node-size)))))
+  (str reg (:@! vsp (:$ (- arm::node-size)))))
 
 (define-arm-vinsn (vpush-register-arg :push :node :vsp :outgoing-argument)
     (()
      ((reg :lisp)))
-  (str reg (:+@! vsp (:$ (- arm::node-size)))))
+  (str reg (:@! vsp (:$ (- arm::node-size)))))
 
 (define-arm-vinsn (vpop-register :pop :node :vsp)
@@ -1734 +1748 @@
                 (:apply %hard-regspec-value dest)
                 (:apply %hard-regspec-value src)))
-   (fmr dest src)))
+   (fcpyd dest src)))
 
 (define-arm-vinsn vcell-ref (((dest :lisp))
                              ((vcell :lisp)))
-  (lwz dest arm::misc-data-offset vcell))
+  (ldr dest (:@ vcell (:$ arm::misc-data-offset))))
 
 
@@ -1744 +1758 @@
                               ((closed (:lisp :ne dest)))
                               ((header :u32)))
-  (li header arm::value-cell-header)
-  (la arm::allocptr (- arm::fulltag-misc arm::value-cell.size) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stw closed arm::value-cell.value dest))
-
-(define-arm-vinsn make-tsp-vcell (((dest :lisp))
-                                  ((closed :lisp))
-                                  ((header :u32)))
-  (li header arm::value-cell-header)
-  (stwu arm::tsp -16 arm::tsp)
-  (stw arm::tsp 4 arm::tsp)
-  (stfd arm::fp-zero 8 arm::tsp)
-  (stw arm::rzero 4 arm::tsp)
-  (stw header (+ 8 arm::fulltag-misc arm::value-cell.header) arm::tsp)
-  (stw closed (+ 8 arm::fulltag-misc arm::value-cell.value) arm::tsp)
-  (la dest (+ 8 arm::fulltag-misc) arm::tsp))
-
-(define-arm-vinsn make-tsp-cons (((dest :lisp))
-                                 ((car :lisp) (cdr :lisp))
-                                 ())
-  (stwu arm::tsp -16 arm::tsp)
-  (stw arm::tsp 4 arm::tsp)
-  (stfd arm::fp-zero 8 arm::tsp)
-  (stw arm::rzero 4 arm::tsp)
-  (stw car (+ 8 arm::fulltag-cons arm::cons.car) arm::tsp)
-  (stw cdr (+ 8 arm::fulltag-cons arm::cons.cdr) arm::tsp)
-  (la dest (+ 8 arm::fulltag-cons) arm::tsp))
+  (mov header (:$ arm::subtag-value-cell))
+  (orr header header (:$ (ash arm::value-cell.element-count arm::num-subtag-bits)))
+  (sub allocptr allocptr (:$ (- arm::value-cell.size arm::fulltag-misc)))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str header (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (str closed (:@ dest (:$ arm::value-cell.value))))
+
+(define-arm-vinsn make-stack-vcell (((dest :lisp))
+                                    ((closed :lisp))
+                                    ((header :u32)))
+  (mov header (:$ arm::subtag-value-cell))
+  (orr header header (:$ (ash arm::value-cell.element-count arm::num-subtag-bits)))
+  (stmdb (:! sp) (closed header)))
+
+(define-arm-vinsn make-stack-cons (((dest :lisp))
+                                   ((car :lisp) (cdr :lisp))
+                                   ((header (:u32 #.arm::imm0))
+                                    (zero (:u32 #.arm::imm1))))
+  (mov header (:$ arm::subtag-simple-vector))
+  (mov zero (:$ 0))
+  (orr header header (:$ (ash 3 arm::num-subtag-bits)))
+  ((:pred <
+          (:apply %hard-regspec-value cdr)
+          (:apply %hard-regpsec-value car))
+   (stmdb (:! sp) (car cdr zero header)))
+  ((:not (:pred <
+                (:apply %hard-regspec-value cdr)
+                (:apply %hard-regpsec-value car)))
+   (stmdb (:! sp) (cdr car zero header))
+   (str car (:@ sp (:$ 12)))
+   (str cdr (:@ sp (:$ 8))))
+  (add dest sp (:$ (+ arm::dnode-size arm::fulltag-cons))))
 
 
 (define-arm-vinsn %closure-code% (((dest :lisp))
                                   ())
-  (lwz dest (:apply + arm::symbol.vcell (arm::nrs-offset %closure-code%) (:apply target-nil-value)) 0))
+  (mov dest (:$ arm::nil-value))
+  (ldr dest (:@ dest (:$ (:apply + arm::symbol.vcell (arm::nrs-offset %closure-code%))))))
 
 
 (define-arm-vinsn single-float-bits (((dest :u32))
                                      ((src :lisp)))
-  (lwz dest arm::single-float.value src))
+  (ldr dest (:@ src (:$ arm::single-float.value))))
 
 (define-arm-vinsn (call-subprim :call :subprim-call) (()
@@ -1822 +1843 @@
                                        ()
                                        ((temp :u32)))
-  (lwz temp arm::tcr.tlb-pointer arm::rcontext)
-  (lwz dest arm::INTERRUPT-LEVEL-BINDING-INDEX temp))
+  (ldr temp (:@ rcontext (:$ arm::tcr.tlb-pointer)))
+  (ldr dest (:@ temp (:$ arm::INTERRUPT-LEVEL-BINDING-INDEX))))
 
                          
@@ -1887 +1908 @@
 (define-arm-vinsn (discard-temp-frame :tsp :pop :discard) (()
                                                            ())
-  (lwz arm::tsp 0 arm::tsp))
+  (ldr arm::tsp (:@ arm::tsp (:$ 0))))
 
 
@@ -1897 +1918 @@
   (mov header (:$ (:apply ash (:apply + 1 (:apply logandc2 (:apply + 4 1 n-c-args) 1)) arm::num-subtag-bits)))
   (mov size (:lsr header (:$ (- arm::num-subtag-bits arm::word-shift))))
-  (orr header (:$ arm::subtag-u32-vector))
+  (orr header header (:$ arm::subtag-u32-vector))
   (mov prevsp sp)
   (add size size (:$ arm::node-size))
@@ -1936 +1957 @@
   (str argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
 
+#+notyet
 (define-arm-vinsn set-single-c-arg (()
                                     ((argval :single-float)
@@ -1941 +1963 @@
   (fsts argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
 
+#+notyet
 (define-arm-vinsn set-double-c-arg (()
                                     ((argval :double-float)
@@ -1957 +1980 @@
   (add dest dest (:$ arm::t-offset)))
 
-(define-arm-vinsn set-eq-bit (((dest :crf))
-                              ())
-  (creqv (:apply + arm::arm-eq-bit dest)
-         (:apply + arm::arm-eq-bit dest)
-         (:apply + arm::arm-eq-bit dest)))
+
 
 (define-arm-vinsn (ref-constant :constant-ref) (((dest :lisp))
@@ -1969 +1988 @@
 (define-arm-vinsn ref-indexed-constant (((dest :lisp))
                                         ((idxreg :s32)))
-  (lwzx dest arm::fn idxreg))
+  (ldr dest (:@ arm::fn idxreg)))
 
 
 (define-arm-vinsn cons (((dest :lisp))
                         ((newcar :lisp)
-                         (newcdr :lisp)))
-  (la arm::allocptr (- arm::fulltag-cons arm::cons.size) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw newcdr arm::cons.cdr arm::allocptr)
-  (stw newcar arm::cons.car arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits))
+                         (newcdr :lisp))
+                        ((allocbase :imm)))
+  (sub allocptr allocptr (:$ (- arm::cons.size arm::fulltag-cons)))
+  (ldr allocbase (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr allocbase)
+  (uuo-alloc-trap (:? lo))
+  (str newcdr (:@ allocptr (:$ arm::cons.cdr)))
+  (str newcar (:@ allocptr (:$ arm::cons.car)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask)))
 
 
@@ -1989 +2011 @@
                                  (nbytes :u32const))
                                 ((immtemp0 :u32)
-                                 (nodetemp :lisp)
-                                 (crf :crf)))
-  (la arm::allocptr (:apply - arm::fulltag-misc
-                            (:apply logand (lognot 7)
-                                    (:apply + (+ 7 4) nbytes)))
-      arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw Rheader arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+                                 (nodetemp :lisp)))
+  
+  (sub allocptr allocptr (:$ (:apply logand #xff
+                                 (:apply -
+                                    (:apply logand (lognot 7)
+                                    (:apply + (+ 7 4) nbytes))
+                                    arm::fulltag-misc))))
+  ((:pred > (:apply -
+                    (:apply logand (lognot 7)
+                            (:apply + (+ 7 4) nbytes))
+                    arm::fulltag-misc) #xff)
+   (sub allocptr allocptr (:$ (:apply logand #xff00
+                                 (:apply -
+                                    (:apply logand (lognot 7)
+                                    (:apply + (+ 7 4) nbytes))
+                                    arm::fulltag-misc)))))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str Rheader (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
   ((:not (:pred = nbytes 0))
-   (li immtemp0 (:apply + arm::misc-data-offset nbytes))
+   (mov immtemp0 (:$ (:apply + arm::misc-data-offset nbytes)))
    :loop
-   (subi immtemp0 immtemp0 4)
-   (cmpwi crf immtemp0 arm::misc-data-offset)
-   (lwz nodetemp 0 arm::vsp)
-   (la arm::vsp 4 arm::vsp)   
-   (stwx nodetemp dest immtemp0)
-   (bne crf :loop)))
+   (sub immtemp0 immtemp0 (:$ 4))
+   (cmp immtemp0 (:$ arm::misc-data-offset))
+   (ldr nodetemp (:@+ vsp (:$ arm::node-size)))
+   (str nodetemp (:@ dest immtemp0))
+   (bne :loop)))
 
 ;; allocate a small (phys size <= 32K bytes) misc obj of known size/subtag
@@ -2013 +2046 @@
                                      ((Rheader :u32)
                                       (nbytes :u32const)))
-  (la arm::allocptr (:apply - arm::fulltag-misc
-                            (:apply logand (lognot 7)
-                                    (:apply + (+ 7 4) nbytes)))
-      arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw Rheader arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits))
+  (sub allocptr allocptr (:$ (:apply
+                              logand #xff
+                              (:apply - (:apply logand (lognot 7)
+                                                (:apply + (+ 7 4) nbytes))))))
+  ((:pred > (:apply -
+                    (:apply logand (lognot 7)
+                            (:apply + (+ 7 4) nbytes))
+                    arm::fulltag-misc) #xff)
+   (sub allocptr allocptr (:$ (:apply logand #xff00
+                                 (:apply -
+                                    (:apply logand (lognot 7)
+                                    (:apply + (+ 7 4) nbytes))
+                                    arm::fulltag-misc)))))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str Rheader (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask)))
 
 (define-arm-vinsn (vstack-discard :vsp :pop :discard) (()
                                                        ((nwords :u32const)))
   ((:not (:pred = nwords 0))
-   (la arm::vsp (:apply ash nwords arm::word-shift) arm::vsp)))
+   (add vsp vsp (:$ (:apply ash nwords arm::word-shift)))))
 
 
@@ -2031 +2075 @@
                               ((cell :lcell)
                                (top :lcell)))
-  (lwz dest (:apply - 
+  (ldr dest (:@ vsp (:$ (:apply - 
                     (:apply - (:apply calc-lcell-depth top) 4)
-                    (:apply calc-lcell-offset cell)) arm::vsp))
+                    (:apply calc-lcell-offset cell))))))
 
 (define-arm-vinsn vframe-load (((dest :lisp))
                                ((frame-offset :u16const)
                                 (cur-vsp :u16const)))
-  (lwz dest (:apply - (:apply - cur-vsp 4) frame-offset) arm::vsp))
+  (ldr dest (:@ vsp (:$ (:apply - (:apply - cur-vsp 4) frame-offset)))))
 
 (define-arm-vinsn lcell-store (()
@@ -2044 +2088 @@
                                 (cell :lcell)
                                 (top :lcell)))
-  (stw src (:apply - 
+  (str src (:@ vsp (:$ (:apply - 
                    (:apply - (:apply calc-lcell-depth top) 4)
-                   (:apply calc-lcell-offset cell)) arm::vsp))
+                   (:apply calc-lcell-offset cell))))))
 
 (define-arm-vinsn vframe-store (()
@@ -2052 +2096 @@
                                  (frame-offset :u16const)
                                  (cur-vsp :u16const)))
-  (stw src (:apply - (:apply - cur-vsp 4) frame-offset) arm::vsp))
+  (str src (:@ vsp (:$ (:apply - (:apply - cur-vsp 4) frame-offset)))))
 
 (define-arm-vinsn load-vframe-address (((dest :imm))
                                        ((offset :s16const)))
-  (la dest offset arm::vsp))
+  (add dest vsp (:$ offset)))
 
 (define-arm-vinsn copy-lexpr-argument (()
                                        ()
                                        ((temp :lisp)))
-  (lwzx temp arm::vsp nargs)
-  (stwu temp -4 arm::vsp))
+  (ldr temp (:@ vsp nargs))
+  (str temp (:@! vsp (:$ (- arm::node-size)))))
 
 ;;; Boxing/unboxing of integers.
@@ -2070 +2114 @@
                               ((val :u8)) 
                               ())
-  (rlwinm result val arm::fixnumshift (- arm::nbits-in-word (+ 8 arm::fixnumshift)) (- arm::least-significant-bit arm::fixnumshift)))
+  (mov result (:lsr val (:$ 24)))
+  (mov result (:lsr val (:$ (- 24 arm::fixnumshift)))))
 
 ;;; Treat the low 8 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
@@ -2076 +2121 @@
                               ((val :s8)) 
                               ())
-  (extlwi result val 8 (- arm::nbits-in-word 8))
-  (srawi result result (- (- arm::nbits-in-word 8) arm::fixnumshift)))
+  (mov result (:lsr val (:$ 24)))
+  (mov result (:asr val (:$ (- 24 arm::fixnumshift)))))
 
 
@@ -2084 +2129 @@
                                ((val :u16)) 
                                ())
-  (rlwinm result val arm::fixnumshift (- arm::nbits-in-word (+ 16 arm::fixnumshift)) (- arm::least-significant-bit arm::fixnumshift)))
+  (mov result (:lsl val (:$ 16)))
+  (mov result (:lsr result (:$ (- 16 arm::fixnumshift)))))
 
 ;;; Treat the low 16 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
@@ -2108 +2154 @@
   (mov temp (:$ arm::subtag-bignum))
   (orr temp temp (:$ (ash 1 arm::num-subtag-bits)))
-  (add arm::allocptr arm::allocptr (:$ (- arm::fulltag-misc 8)))
-  (ldr result (:@ rcontext (:$ arm::tcr.save_allocbase)))
+  (add allocptr allocptr (:$ (- arm::fulltag-misc 8)))
+  (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
   (cmp allocptr result)
-  (uuo-alloc-trap-one (:? lo))
+  (uuo-alloc-trap (:? lo))
   (str temp (:@ allocptr (:$ arm::misc-header-offset)))
   (mov result allocptr)
@@ -2122 +2168 @@
 (define-arm-vinsn u32->integer (((result :lisp))
                                 ((src :u32))
-                                ((crf (:crf 0)) ; a casualty
-                                 (temp :s32)
+                                ((temp :s32)
                                  (size :u32)))
-  (clrrwi. temp src (- arm::least-significant-bit arm::nfixnumtagbits))
-  (slwi result src arm::fixnumshift)
-  (beq+ crf :done)
-  (cmpwi src 0)
-  (li temp arm::one-digit-bignum-header)
-  (li size (- 8 arm::fulltag-misc))
-  (bgt :common)
-  (li temp arm::two-digit-bignum-header)
-  (li size (- 16 arm::fulltag-misc))
-  :common
-  (sub arm::allocptr arm::allocptr size)
-  (twllt arm::allocptr arm::allocbase)
-  (stw temp arm::misc-header-offset arm::allocptr)
-  (mr result arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stw src arm::misc-data-offset result)
+  (tst src (:$ #xe0000000))
+  (moveq result (:lsr src (:$ arm::fixnumshift)))
+  (beq :done)
+  (cmp src (:$ 0))
+  (mov temp (:$ arm::subtag-bignum))
+  (movgt size (:$ (- (* 2 arm::dnode-size) arm::fulltag-misc)))
+  (orrgt temp temp (:$ (ash 2 arm::num-subtag-bits)))
+  (movlt size (:$ (- (* 1 arm::dnode-size) arm::fulltag-misc)))
+  (orrlt temp temp (:$ (ash 1 arm::num-subtag-bits)))
+  (sub allocptr allocptr size)
+  (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr result)
+  (uuo-alloc-trap (:? lo))
+  (str temp (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov result allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (str src (:@ result (:$ arm::misc-data-offset)))
   :done)
 
 (define-arm-vinsn u16->u32 (((dest :u32))
                             ((src :u16)))
-  (clrlwi dest src 16))
+  (mov dest (:$ #xff))
+  (orr dest dest (:$ #xff00))
+  (and dest dest src))
 
 (define-arm-vinsn u8->u32 (((dest :u32))
                            ((src :u8)))
-  (clrlwi dest src 24))
+  (and dest src (:$ #xff)))
 
 
 (define-arm-vinsn s16->s32 (((dest :s32))
                             ((src :s16)))
-  (extsh dest src))
+  (mov dest (:lsl src (:$ 16)))
+  (mov dest (:asr src (:$ 16))))
 
 (define-arm-vinsn s8->s32 (((dest :s32))
                            ((src :s8)))
-  (extsb dest src))
+  (mov dest (:lsl src (:$ 24)))
+  (mov dest (:asr src (:$ 24))))
 
 
@@ -2167 +2217 @@
 (define-arm-vinsn double->heap (((result :lisp)) ; tagged as a double-float
                                 ((fpreg :double-float)) 
-                                ((header-temp :u32)))
-  (li header-temp (arch::make-vheader arm::double-float.element-count arm::subtag-double-float))
-  (la arm::allocptr (- arm::fulltag-misc arm::double-float.size) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header-temp arm::misc-header-offset arm::allocptr)
-  (mr result arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stfd fpreg arm::double-float.value result)  )
+                                ((header-temp (:u32 #.arm::imm0))
+                                 (high (:u32 #.arm::imm1))))
+  (mov header-temp (:$ arm::subtag-double-float))
+  (orr header-temp header-temp (:$ (ash arm::double-float.element-count arm::num-subtag-bits)))
+  (sub allocptr allocptr (:$ (- arm::double-float.size arm::fulltag-misc)))
+  (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr result)
+  (uuo-alloc-trap (:? lo))
+  (str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov result allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (fmrrd header-temp high fpreg)
+  (strd header-temp (:@ result (:$ arm::double-float.value))))
 
 
@@ -2184 +2239 @@
                                 ((fpreg :single-float))
                                 ((header-temp :u32)))
-  (li header-temp (arch::make-vheader arm::single-float.element-count arm::subtag-single-float))
-  (la arm::allocptr (- arm::fulltag-misc arm::single-float.size) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header-temp arm::misc-header-offset arm::allocptr)
-  (mr result arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stfs fpreg arm::single-float.value result))
+  (mov header-temp (:$ arm::subtag-single-float))
+  (orr header-temp header-temp (:$ (ash arm::single-float.element-count arm::num-subtag-bits)))
+  (sub allocptr allocptr (:$ (- arm::single-float.size arm::fulltag-misc)))
+  (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr result)
+  (uuo-alloc-trap (:? lo))
+  (str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov result allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (fmrs header-temp fpreg)
+  (str header-temp (:@ result (:$ arm::single-float.value))))
+
 
 
@@ -2197 +2257 @@
                                 ((dest :lisp)
                                  (source :double-float))
-                                ())
-  (stfd source arm::double-float.value dest))
+                                ((low (:u32 #.arm::imm0))
+                                 (high (:u32 #.arm::imm1))))
+  (fmrrd low high source)
+  (str low (:@ dest (:$ arm::double-float.value))))
 
 (define-arm-vinsn get-double (((target :double-float))
                               ((source :lisp))
-                              ())
-  (lfd target arm::double-float.value source))
+                              ((low (:u32 #.arm::imm0))
+                               (high (:u32 #.arm::imm1))))
+  (ldrd low (:@ source (:$ arm::double-float.value)))
+  (fmdrr target low high))
 
 ;;; Extract a double-float value, typechecking in the process.
@@ -2211 +2275 @@
 (define-arm-vinsn get-double? (((target :double-float))
                                ((source :lisp))
-                               ((tag :u8)))
-  (and tag source (:$ arm::tagmask))
-  (cmp tag (:$ arm::tag-misc))
-  (ldrbeq tag (:@ source (:$ arm::misc-subtag-offset)))
-  (cmp tag (:$ arm::subtag-double-float))
+                               ((low (:u32 #.arm::imm0))
+                                (high (:u32 #.arm::imm1))))
+  (and low source (:$ arm::tagmask))
+  (cmp low (:$ arm::tag-misc))
+  (ldrbeq low (:@ source (:$ arm::misc-subtag-offset)))
+  (cmp imm0 (:$ arm::subtag-double-float))
   (uuo-error-reg-not-xtype (:? ne) source (:$ arm::subtag-double-float))
-  (ldrd imm0 imm1 (:@ source (:$ arm::double-float.value)))
-  (fmrrd target imm0 imm1))
+  (ldrd imm0 (:@ source (:$ arm::double-float.value)))
+  (fmdrr target imm0 imm1))
   
 
 (define-arm-vinsn double-to-single (((result :single-float))
                                     ((arg :double-float)))
-  (frsp result arg))
+  (fcvtsd result arg))
 
 (define-arm-vinsn store-single (()
                                 ((dest :lisp)
                                  (source :single-float))
-                                ())
-  (stfs source arm::single-float.value dest))
+                                ((temp :u32)))
+  (fmrs temp source)
+  (str temp (:@ dest (:$ arm::single-float.value))))
 
 (define-arm-vinsn get-single (((target :single-float))
                               ((source :lisp))
-                              ())
-  (lfs target arm::single-float.value source))
+                              ((temp :u32)))
+  (ldr temp (:@ source (:$ arm::single-float.value)))
+  (fmsr target temp))
 
 ;;; ... of characters ...
@@ -2253 +2320 @@
                                 ((src :imm))
                                 ((temp :u32)
-                                 (crf0 (:crf 0))))
-  (srwi temp src (+ arm::fixnumshift 1))
-  (cmplwi temp (ash #xffff -1))
-  (srwi temp src (+ arm::fixnumshift 11))
+                                 (temp2 :u32)))
+  (mov temp2 (:$ #x7f00))
+  (mov temp (:lsr src (:$ (+ arm::fixnumshift 1))))
+  (orr temp2 temp2 (:$ #xff))
+  (cmp temp temp2)
+  (mov temp (:lsr src (:$ (+ arm::fixnumshift 11))))
   (beq :bad)
-  (cmpwi temp 27)
-  (slwi dest src (- arm::charcode-shift arm::fixnumshift))
-  (bne+ :ok)
+  (cmp temp (:$ 27))
+  (mov dest (:lsr src (:$ (- arm::charcode-shift arm::fixnumshift))))
   :bad
-  (li dest (:apply target-nil-value))
-  (b :done)
-  :ok
-  (addi dest dest arm::subtag-character)
-  :done)
+  (moveq dest (:$ arm::nil-value))
+  (addne dest dest (:$ arm::subtag-character)))
 
 ;;; src is known to be a code for which CODE-CHAR returns non-nil.
@@ -2298 +2363 @@
                                 ((address :address))
                                 ((header :u32)))
-  (li header (logior (ash arm::macptr.element-count arm::num-subtag-bits) arm::subtag-macptr))
-  (la arm::allocptr (- arm::fulltag-misc arm::macptr.size) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (mov header (:$ arm::subtag-macptr))
+  (orr header header (:$ (ash arm::macptr.element-count arm::num-subtag-bits)))
+  (sub allocptr allocptr (:$ (- arm::macptr.size arm::fulltag-misc)))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str header (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
   ;; It's not necessary to zero out the domain/type fields, since newly
   ;; heap-allocated memory's guaranteed to be 0-filled.
-  (stw address arm::macptr.address dest))
+  (str address (:@ dest (:$ arm::macptr.address))))
 
 (define-arm-vinsn macptr->stack (((dest :lisp))
                                  ((address :address))
                                  ((header :u32)))
-  (li header arm::macptr-header)
-  (stwu arm::tsp (- (+ 8 arm::macptr.size)) arm::tsp)
-  (stw arm::tsp 4 arm::tsp)
-  (stw header (+ 8 arm::fulltag-misc arm::macptr.header) arm::tsp)
-  (stw address (+ 8 arm::fulltag-misc arm::macptr.address) arm::tsp)
-  ;; It -is- necessary to zero out the domain/type fields here, since
-  ;; stack-allocated memory isn't guaranteed to be 0-filled.
-  (stfd arm::fp-zero (+ 8 arm::fulltag-misc arm::macptr.domain) arm::tsp)
-  (la dest (+ 8 arm::fulltag-misc) arm::tsp))
+  (mov header (:$ arm::subtag-macptr))
+  (orr header header (:$ (ash arm::macptr.element-count arm::num-subtag-bits)))
+  (str header (:@! sp (:$ (- arm::macptr.size))))
+  (mov header (:$ 0))
+  (str header  (:@ sp (:$ (+ arm::fulltag-misc arm::macptr.domain))))
+  (str header  (:@ sp (:$ (+ arm::fulltag-misc arm::macptr.type))))
+  (str address (:@ sp (:$ (+ arm::fulltag-misc arm::macptr.address))))
+  (add dest sp (:$ arm::fulltag-misc)))
+
 
   
@@ -2329 +2397 @@
 (define-arm-vinsn adjust-vsp (()
                               ((amount :s16const)))
-  (la arm::vsp amount arm::vsp))
+  (add vsp vsp (:$ amount)))
 
 (define-arm-vinsn adjust-sp (()
                              ((amount :s16const)))
-  (la arm::sp amount arm::sp))
+  (add sp sp (:$ amount)))
 
 ;; Arithmetic on fixnums & unboxed numbers
@@ -2353 +2421 @@
                                                  ((unboxed :s32)
                                                   (header :u32)))
-  (nego. dest src)
-  (bns+ :done)
-  (mtxer arm::rzero)
-  (srawi unboxed dest arm::fixnumshift)
-  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
-  (li header arm::one-digit-bignum-header)
-  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stw unboxed arm::misc-data-offset dest)
+  (rsbs dest src (:$ 0))
+  (bvc :done)
+  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
+  (eor unboxed unboxed (:$ #xc0000000))
+  (mov header (:$ arm::subtag-bignum))
+  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
+  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str header (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
   :done)
 
@@ -2370 +2440 @@
                                               ((src :imm))
                                               )
-  (nego. arm::arg_z src)
-  (bsola- .SPfix-overflow)
-  :done)
+  (rsbs arm::arg_z src (:$ 0))
+  (blvs .SPfix-overflow))
   
                                                   
@@ -2379 +2448 @@
                                         ((src :imm)))
   
-  (neg dest src))
+  (rsb dest src (:$ 0)))
   
 
-(define-arm-vinsn logior-high (((dest :imm))
+(define-arm-vinsn logior-immediate (((dest :imm))
                                ((src :imm)
-                                (high :u16const)))
-  (oris dest src high))
-
-(define-arm-vinsn logior-low (((dest :imm))
-                              ((src :imm)
-                               (low :u16const)))
-  (ori dest src low))
+                                (imm :u32const)))
+  (orr dest src (:$ imm)))
+
+
 
                            
@@ -2398 +2464 @@
                              (y :imm))
                             ())
-  (or dest x y))
-
-(define-arm-vinsn logand-high (((dest :imm))
+  (orr dest x y))
+
+(define-arm-vinsn logand-immediate (((dest :imm))
                                ((src :imm)
-                                (high :u16const))
-                               ((crf0 (:crf 0))))
-  (andis. dest src high))
-
-(define-arm-vinsn logand-low (((dest :imm))
-                              ((src :imm)
-                               (low :u16const))
-                              ((crf0 (:crf 0))))
-  (andi. dest src low))
+                                (imm :u32const)))
+  (and dest src (:$ imm)))
 
 
@@ -2419 +2478 @@
   (and dest x y))
 
-(define-arm-vinsn clear-left (((dest :imm))
-                              ((src :imm)
-                               (nbits :s8const)))
-  (rlwinm dest src 0 (:apply 1+ nbits) 31))
-
-(define-arm-vinsn clear-right (((dest :imm))
-                               ((src :imm)
-                                (nbits :s8const)))
-  (rlwinm dest src 0 0 (:apply - 31 nbits)))
+(define-arm-vinsn logxor-immediate (((dest :imm))
+                                    ((src :imm)
+                                     (imm :u32const)))
+  (eor dest src (:$ imm)))
+                                    
 
                                
-(define-arm-vinsn logxor-high (((dest :imm))
-                               ((src :imm)
-                                (high :u16const)))
-  (xoris dest src high))
-
-(define-arm-vinsn logxor-low (((dest :imm))
-                              ((src :imm)
-                               (low :u16const)))
-  (xori dest src low))
-
-                           
 
 (define-arm-vinsn %logxor2 (((dest :imm))
@@ -2446 +2490 @@
                              (y :imm))
                             ())
-  (xor dest x y))
-
+  (eor dest x y))
+
+;;; ARM register shifts shift by the low byte of RS.
 (define-arm-vinsn %ilsl (((dest :imm))
                          ((count :imm)
                           (src :imm))
-                         ((temp :u32)
-                          (crx :crf)))
-  (cmpwi crx count (ash 31 arm::fixnumshift))
-  (srwi temp count arm::fixnumshift)
-  (slw dest src temp)
-  (ble+ crx :foo)
-  (li dest 0)
-  :foo)
-
+                         ((temp :u32)))
+  (mov temp (:asr count (:$ arm::fixnumshift)))
+  (mov dest (:lsl src temp)))
+
+;;; Shift by a constant = -> shift by 32.  Don't do that.
 (define-arm-vinsn %ilsl-c (((dest :imm))
                            ((count :u8const)
                             (src :imm)))
-                                        ; Hard to use armmacroinstructions that expand into expressions involving variables.
-  (rlwinm dest src count 0 (:apply - arm::least-significant-bit count)))
+  ((:pred = count 0)
+   (mov dest src))
+  ((:not (:pred = count 0))
+   (mov dest (:lsl src (:$ (:apply logand count 31))))))
 
 
@@ -2470 +2513 @@
                            ((count :u8const)
                             (src :imm))
-                           (temp :s32))
+                           ((temp :s32)))
   (mov temp (:lsr src (:$ count)))
-  (bic test src (:$ fixnummask)))
+  (bic dest temp (:$ arm::fixnummask)))
 
 
@@ -2479 +2522 @@
                           (src :imm))
                          ((temp :s32)))
-  (cmp count (:$ (ash 31 arm::fixnumshift)))
   (mov temp (:asr count (:$ arm::fixnumshift)))
   (mov temp (:asr src temp))
-  (movgt temp (:asr src (:$ 31)))
-  (bic test temp (:$ arm::fixnummask)))
+  (bic dest temp (:$ arm::fixnummask)))
 
 (define-arm-vinsn %iasr-c (((dest :imm))
@@ -2489 +2530 @@
                             (src :imm))
                            ((temp :s32)))
-  (mov temp (:asr src (:$ count)))
-  (bic dest src (:$ arm::fixnummask)))
+  ((:pred = count 0)
+   (mov dest src))
+  ((:not (:pred = count 0))
+   (mov temp (:asr src (:$ count)))
+   (bic dest src (:$ arm::fixnummask))))
 
 (define-arm-vinsn %ilsr (((dest :imm))
                          ((count :imm)
                           (src :imm))
-                         ((temp :s32)
-                          (crx :crf)))
-  (cmpwi crx count (ash 31 arm::fixnumshift))
-  (srwi temp count arm::fixnumshift)
-  (srw temp src temp)
-  (clrrwi dest temp arm::fixnumshift)
-  (ble+ crx :foo)
-  (li dest 0)
-  :foo  
-  )
-
-#+maybe
+                         ((temp :s32)))
+  (mov temp (:asr count (:$ arm::fixnumshift)))
+  (mov temp (:lsr src temp))
+  (bic dest temp (:$ arm::fixnummask)))
+
+
 (define-arm-vinsn %ilsr-c (((dest :imm))
                            ((count :u8const)
                             (src :imm))
                            ((temp :s32)))
-  (rlwinm temp src (:apply - 32 count) count 31)
-  (clrrwi dest temp arm::fixnumshift))
+  ((:pred = count 0)
+   (mov dest src))
+  ((:not (:pred = count 0))
+   (mov temp (:lsr src (:$ count)))
+   (bic dest temp (:$ arm::fixnummask))))
 
 (define-arm-vinsn natural-shift-left (((dest :u32))
                                       ((src :u32)
                                        (count :u8const)))
-  (rlwinm dest src count 0 (:apply - 31 count)))
+  ((:pred = count 0)
+   (mov dest src))
+  ((:not (:pred = count 0))
+   (mov dest (:lsl src (:$ count)))))
 
 (define-arm-vinsn natural-shift-right (((dest :u32))
                                        ((src :u32)
                                         (count :u8const)))
-  (rlwinm dest src (:apply - 32 count) count 31))
+  ((:pred = count 0)
+   (mov dest src))
+  ((:not (:pred = count 0))
+   (mov dest (:lsr src (:$ count)))))
 
 
@@ -2530 +2577 @@
                                                (type-error :u8const))
                                               ((tag :u8)
-                                               (flags :u32)
-                                               (crf :crf)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi crf tag arm::tag-misc)
-  (bne crf :bad)
-  (lbz tag arm::misc-subtag-offset object)
-  (cmpwi crf tag arm::subtag-arrayH)
-  (bne crf :bad) 
-  (lwz tag arm::arrayH.rank object)
-  (cmpwi crf tag (ash 2 arm::fixnumshift))
-  (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags arm::fixnumshift)))
-       
-  (lwz flags arm::arrayH.flags object)
-  (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags arm::fixnumshift)))
-  (bne crf :bad)
-  (cmpw crf tag flags)
-  (beq crf :good)
-  :bad
-  (uuo_interr type-error object)
-  :good)
+                                               (flags :u32)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-arrayH))
+  (bne :bad-if-ne)
+  (ldr tag (:@ object (:$ arm::arrayH.rank)))
+  (cmp tag (:$ (ash 2 arm::fixnumshift)))
+  (bne :bad-if-ne)
+  (mov tag (:$ (:apply ash (:apply logand expected-flags #xff00) arm::fixnumshift)))
+  (orr tag tag (:$ (:apply ash (:apply logand expected-flags #x00ff) arm::fixnumshift)))
+  (ldr flags (:@ object (:$ arm::arrayH.flags)))
+  (cmp tag flags)
+  :bad-if-ne
+  (uuo-error-reg-not-xtype (:? ne) object (:$ type-error)))
 
 (define-arm-vinsn trap-unless-simple-array-3 (()
                                               ((object :lisp)
-                                               (expected-flags :u32const)
+                                               (expected-flags :u16const)
                                                (type-error :u8const))
                                               ((tag :u8)
-                                               (flags :u32)
-                                               (crf :crf)))
-  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi crf tag arm::tag-misc)
-  (bne crf :bad)
-  (lbz tag arm::misc-subtag-offset object)
-  (cmpwi crf tag arm::subtag-arrayH)
-  (bne crf :bad) 
-  (lwz tag arm::arrayH.rank object)
-  (cmpwi crf tag (ash 3 arm::fixnumshift))
-  (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags arm::fixnumshift)))
-       
-  (lwz flags arm::arrayH.flags object)
-  (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags arm::fixnumshift)))
-  (bne crf :bad)
-  (cmpw crf tag flags)
-  (beq crf :good)
-  :bad
-  (uuo_interr type-error object)
-  :good)
+                                               (flags :u32)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-arrayH))
+  (bne :bad-if-ne)
+  (ldr tag (:@ object (:$ arm::arrayH.rank)))
+  (cmp tag (:$ (ash 3 arm::fixnumshift)))
+  (bne :bad-if-ne)
+  (mov tag (:$ (:apply ash (:apply logand expected-flags #xff00) arm::fixnumshift)))
+  (orr tag tag (:$ (:apply ash (:apply logand expected-flags #x00ff) arm::fixnumshift)))
+  (ldr flags (:@ object (:$ arm::arrayH.flags)))
+  (cmp tag flags)
+  :bad-if-ne
+  (uuo-error-reg-not-xtype (:? ne) object (:$ type-error)))
   
   
@@ -2582 +2619 @@
 (define-arm-vinsn sign-extend-halfword (((dest :imm))
                                         ((src :imm)))
-  (slwi dest src (- 16 arm::fixnumshift))
-  (srawi dest dest (- 16 arm::fixnumshift)))
-
-(define-arm-vinsn s32-highword (((dest :imm))
-                                ((src :s32))
-                                ((temp :s32)))
-  (srawi temp src 16)
-  (slwi dest temp arm::fixnumshift))
+  (mov dest (:lsl src (:$ (- 16 arm::fixnumshift))))
+  (mov dest (:asr dest (:$ (- 16 arm::fixnumshift)))))
+
 
                             
@@ -2602 +2634 @@
                                            ((x :imm)
                                             (y :imm))
-                                           ((cr0 (:crf 0))))
-  (addo. arm::arg_z x y)
-  (bsola- .SPfix-overflow))
+                                           ())
+  (adds arm::arg_z x y)
+  (blvs .SPfix-overflow))
 
 (define-arm-vinsn fixnum-add-overflow-inline (((dest :lisp))
                                               ((x :imm)
                                                (y :imm))
-                                              ((cr0 (:crf 0))
-                                               (unboxed :s32)
+                                              ((unboxed :s32)
                                                (header :u32)))
-  (addo. dest x y)
-  (bns+ cr0 :done)
-  (mtxer arm::rzero)
-  (srawi unboxed dest arm::fixnumshift)
-  (li header arm::one-digit-bignum-header)
-  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
-  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stw unboxed arm::misc-data-offset dest)
+  (adds dest x y)
+  (bvc :done)
+  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
+  (mov header (:$ arm::subtag-bignum))
+  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
+  (eor unboxed unboxed (:$ #xc0000000))
+  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str header (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
   :done)
 
@@ -2630 +2663 @@
                                                     (y :imm)
                                                     (target :label))
-                                                   ((cr0 (:crf 0))
-                                                    (unboxed :s32)
+                                                   ((unboxed :s32)
                                                     (header :u32)))
-  (addo. dest x y)
-  (bns+ cr0 target)
-  (mtxer arm::rzero)
-  (srawi unboxed dest arm::fixnumshift)
-  (li header arm::one-digit-bignum-header)
-  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
-  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stw unboxed arm::misc-data-offset dest)
+  (adds dest x y)
+  (bvc target)
+  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
+  (mov header (:$ arm::subtag-bignum))
+  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
+  (eor unboxed unboxed (:$ #xc0000000))
+  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocptr)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str header (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
   (b target))
   
@@ -2654 +2688 @@
                               ((x t)
                                (y t)))
-  (subf dest y x))
+  (sub dest x y))
 
 (define-arm-vinsn fixnum-sub-from-constant (((dest :imm))
                                             ((x :s16const)
                                              (y :imm)))
-  (subfic dest y (:apply ash x arm::fixnumshift)))
+  (rsb dest y (:$ (:apply ash x arm::fixnumshift))))
 
 
@@ -2667 +2701 @@
                                            ((x :imm)
                                             (y :imm)))
-  (subo. arm::arg_z x y)
-  (bsola- .SPfix-overflow))
+  (subs arm::arg_z x y)
+  (blvs .SPfix-overflow))
 
 (define-arm-vinsn fixnum-sub-overflow-inline (((dest :lisp))
@@ -2676 +2710 @@
                                                (unboxed :s32)
                                                (header :u32)))
-  (subo. dest x y)
-  (bns+ cr0 :done)
-  (mtxer arm::rzero)
-  (srawi unboxed dest arm::fixnumshift)
-  (li header arm::one-digit-bignum-header)
-  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
-  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stw unboxed arm::misc-data-offset dest)
+  (subs dest x y)
+  (bvc :done)
+  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
+  (mov header (:$ arm::subtag-bignum))
+  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
+  (eor unboxed unboxed (:$ #xc0000000))
+  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str header (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
   :done)
 
@@ -2694 +2730 @@
                                                     (y :imm)
                                                     (target :label))
-                                                   ((cr0 (:crf 0))
-                                                    (unboxed :s32)
+                                                   ((unboxed :s32)
                                                     (header :u32)))
-  (subo. dest x y)
-  (bns+ cr0 target)
-  (mtxer arm::rzero)
-  (srawi unboxed dest arm::fixnumshift)
-  (li header arm::one-digit-bignum-header)
-  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
-  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
-  (twllt arm::allocptr arm::allocbase)
-  (stw header arm::misc-header-offset arm::allocptr)
-  (mr dest arm::allocptr)
-  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
-  (stw unboxed arm::misc-data-offset dest)
+  (subs dest x y)
+  (bvc target)
+  (mov unboxed (:asr dest (:$ arm::fixnumshift0)))
+  (mov header (:$ arm::subtag-bignum))
+  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
+  (eor unboxed unboxed (:$ #xc0000000))
+  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
+  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
+  (cmp allocptr dest)
+  (uuo-alloc-trap (:? lo))
+  (str header (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov dest allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
   (b target))
 
@@ -2714 +2751 @@
 (define-arm-vinsn add-immediate (((dest t))
                                  ((src t)
-                                  (upper :u32const)
-                                  (lower :u32const)))
-  ((:not (:pred = upper 0))
-   (addis dest src upper)
-   ((:not (:pred = lower 0))
-    (addi dest dest lower)))
-  ((:and (:pred = upper 0) (:not (:pred = lower 0)))
-   (addi dest src lower)))
-
-;This must unbox one reg, but hard to tell which is better.
-;(The one with the smaller absolute value might be)
+                                  (imm :s32const)))
+  (add dest src (:$ imm)))
+
 (define-arm-vinsn multiply-fixnums (((dest :imm))
                                     ((a :imm)
                                      (b :imm))
                                     ((unboxed :s32)))
-  (srawi unboxed b arm::fixnumshift)
-  (mullw dest a unboxed))
-
-(define-arm-vinsn multiply-immediate (((dest :imm))
-                                      ((boxed :imm)
-                                       (const :s16const)))
-  (mulli dest boxed const))
+  (mov unboxed (:asr b (:$ arm::fixnumshift)))
+  (mul dest a unboxed))
+
+
 
 ;;; Mask out the code field of a base character; the result
@@ -2741 +2767 @@
 (define-arm-vinsn mask-base-char (((dest :u32))
                                   ((src :imm)))
-  (clrlwi dest src (- arm::nbits-in-word arm::charcode-shift)))
+  (and dest src (:$ arm::subtag-mask)))
 
 ;;; Set dest (of type :s32!) to 0 iff VAL is an istruct of type TYPE
@@ -2747 +2773 @@
                                  ((val :lisp)
                                   (type :lisp))
-                                 ((crf :crf)
-                                  (temp :lisp)))
-  (clrlwi dest val (- arm::nbits-in-word arm::nlisptagbits))
-  (cmpwi crf dest arm::tag-misc)
-  (li dest -1)
-  (bne crf :done)
-  (lbz dest arm::misc-subtag-offset val)
-  (cmpwi crf dest arm::subtag-istruct)
-  (bne crf :done)
-  (lwz temp arm::misc-data-offset val)
-  (subf dest type temp)
-  :done)
+                                 ((temp :lisp)))
+  (and dest val (:$ arm::tagmask))
+  (cmp dest (:$ arm::tag-misc))
+  (ldrbeq dest (:@ val (:$ arm::misc-subtag-offset)))
+  (cmp dest (:$ arm::subtag-istruct))
+  (movne dest (:$ -1))
+  (ldreq temp (:@ val (:$ arm::misc-data-offset)))
+  (subeq dest type temp))
   
   
@@ -2771 +2793 @@
                                            ((table :imm)
                                             (idx :imm)))
-  (lwz idx arm::symbol.binding-index src)
-  (lwz table arm::tcr.tlb-limit arm::rcontext)
-  (cmpw idx table)
-  (lwz table arm::tcr.tlb-pointer arm::rcontext)
-  (bge :symbol)
-  (lwzx dest table idx)
-  (cmpwi dest arm::subtag-no-thread-local-binding)
-  (bne :done)
-  :symbol
-  (lwz dest arm::symbol.vcell src)
-  :done
-  (tweqi dest arm::unbound-marker))
+  (ldr idx (:@ src (:$ arm::symbol.binding-index)))
+  (ldr table (:@ rcontext (:$ arm::tcr.tlb-limit)))
+  (cmp idx table)
+  (ldr table (:@ rcontext (:$ arm::tcr.tlb-pointer)))
+  (movhs idx (:$ 0))
+  (ldr dest (:@ table idx))
+  (cmp dest (:$ arm::subtag-no-thread-local-binding))
+  (ldreq dest (:@ src (:$ arm::symbol.vcell)))
+  (cmp dest (:$ arm::unbound-marker))
+  (uuo-error-unbound (:? eq) src))
 
 (define-arm-vinsn (%ref-symbol-value :call :subprim-call)
@@ -2793 +2813 @@
                                             ((table :imm)
                                              (idx :imm)))
-  (lwz idx arm::symbol.binding-index src)
-  (lwz table arm::tcr.tlb-limit arm::rcontext)
-  (cmpw idx table)
-  (lwz table arm::tcr.tlb-pointer arm::rcontext)
-  (bge :symbol)
-  (lwzx dest table idx)
-  (cmpwi dest arm::subtag-no-thread-local-binding)
-  (bne :done)
-  :symbol
-  (lwz dest arm::symbol.vcell src)
-  :done
-  )
+  (ldr idx (:@ src (:$ arm::symbol.binding-index)))
+  (ldr table (:@ rcontext (:$ arm::tcr.tlb-limit)))
+  (cmp idx table)
+  (ldr table (:@ rcontext (:$ arm::tcr.tlb-pointer)))
+  (movhs idx (:$ 0))
+  (ldr dest (:@ table idx))
+  (cmp dest (:$ arm::subtag-no-thread-local-binding))
+  (ldreq dest (:@ src (:$ arm::symbol.vcell))))
 
 (define-arm-vinsn (setq-special :call :subprim-call)
@@ -2817 +2833 @@
                                    ((crf :crf)
                                     (tag :u32)))
-  (lwz val arm::symbol.fcell sym)
-  (clrlwi tag val (- 32 arm::nlisptagbits))
-  (cmpwi crf tag arm::tag-misc)
-  (bne- crf :bad)
-  (lbz tag arm::misc-subtag-offset val)
-  (cmpwi crf tag arm::subtag-function)
-  (beq+ crf :good)
-  :bad 
-  (uuo_interr arch::error-udf sym)
-  :good)
+  (ldr val (:@ sym (:$ arm::symbol.fcell)))
+  (and tag val (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ val (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-function))
+  (uuo-error-udf (:? ne) sym))
 
 (define-arm-vinsn (temp-push-unboxed-word :push :word :sp)
@@ -2835 +2847 @@
   (orr header header (:$ (ash 1 arm::num-subtag-bits)))
   (str header (:@ sp (:$ (- arm::dnode-size))))
-  (str w (:@ sp 4)))
+  (str w (:@ sp (:$ 4))))
 
 (define-arm-vinsn (temp-pop-unboxed-word :pop :word :sp)
@@ -2843 +2855 @@
   (add sp sp (:$ arm::dnode-size)))
 
+#+notyet
 (define-arm-vinsn (temp-push-double-float :push :doubleword :sp)
     (()
@@ -2852 +2865 @@
   (fstd d (:@ sp (:$ 8))))
 
+#+notyet
 (define-arm-vinsn (temp-pop-double-float :pop :doubleword :sp)
     (()
@@ -2858 +2872 @@
   (add sp sp (:$ (* 2 arm::dnode-size))))
 
+#+notyet
 (define-arm-vinsn (temp-push-single-float :push :word :tsp)
     (()
@@ -2867 +2882 @@
   (fsts s (:@ sp (:$ 4))))
 
+#+notyet
 (define-arm-vinsn (temp-pop-single-float :pop :word :sp)
     (()
@@ -2881 +2897 @@
 (define-arm-vinsn %current-tcr (((dest :imm))
                                 ())
-  (mov dest arm::rcontext))
+  (mov dest rcontext))
 
 (define-arm-vinsn (dpayback :call :subprim-call) (()
@@ -2893 +2909 @@
 
 (define-arm-vinsn zero-double-float-register (((dest :double-float))
-                                              ())
-  (fmr dest arm::fp-zero))
+                                              ()
+                                              ((temp t)))
+  (mov temp (:$ 0))
+  (fmsr dest temp))
 
 (define-arm-vinsn zero-single-float-register (((dest :single-float))
-                                              ())
-  (fmr dest arm::fp-zero))
+                                              ()
+                                              ((temp t)))
+  (mov temp (:$ 0))
+  (fmdrr dest temp temp))
 
 (define-arm-vinsn load-double-float-constant (((dest :double-float))
@@ -2917 +2937 @@
                                      ((n :u16const)))
   (cmp nargs (:$ (:apply ash n 2)))
-  (uuo-error-wrong-nargs (:ne)))
+  (uuo-error-wrong-nargs (:? ne)))
 
 (define-arm-vinsn check-min-nargs (()
                                    ((min :u16const)))
   (cmp nargs (:$ (:apply ash min 2)))
-  (uuo-error-wrong-nargs (:lo)))
+  (uuo-error-wrong-nargs (:? lo)))
 
 
@@ -2928 +2948 @@
                                    ((max :u16const)))
   (cmp nargs (:$ (:apply ash max 2)))
-  (uuo-error-wrong-nargs (:hi)))
+  (uuo-error-wrong-nargs (:? hi)))
 
 ;;; Save context and establish FN.  The current VSP is the the
@@ -2936 +2956 @@
                                          ((imm :u32)))
   (mov imm (:$ arm::lisp-frame-marker))
-  (stmdb (:! sp) (imm vsp fn lr)))
+  (stmdb (:! sp) (imm vsp fn lr))
+  (mov fn nfn))
 
 
@@ -2945 +2966 @@
   (add imm vsp (:$ nbytes-vpushed))
   (mov imm0 (:$ arm::lisp-frame-marker))
-  (stmdb (:! sp) (imm0 imm fn lr)))
+  (stmdb (:! sp) (imm0 imm fn lr))
+  (mov fn nfn))
 
 
@@ -2954 +2976 @@
                                            ((imm :u32)))
   (stwu arm::sp (- arm::lisp-frame.size) arm::sp)
-  (stw arm::rzero arm::lisp-frame.savefn arm::sp)
-  (stw arm::loc-pc arm::lisp-frame.savelr arm::sp)
-  (stw arm::vsp arm::lisp-frame.savevsp arm::sp)
+  (str arm::rzero (:@ arm::sp (:$ arm::lisp-frame.savefn)))
+  (str arm::loc-pc (:@ arm::sp (:$ arm::lisp-frame.savelr)))
+  (str vsp (:@ arm::sp (:$ arm::lisp-frame.savevsp)))
   (mr arm::fn arm::nfn)
   ;; Do a stack-probe ...
-  (lwz imm arm::tcr.cs-limit arm::rcontext)
+  (ldr imm (:@ rcontext (:$ arm::tcr.cs-limit)))
   (twllt arm::sp imm))
   
@@ -2980 +3002 @@
       (arg-temp :u32)))
   ((:pred >= min-fixed $numarmargregs)
-   (stwu arm::arg_x -4 arm::vsp)   
-   (stwu arm::arg_y -4 arm::vsp)   
-   (stwu arm::arg_z -4 arm::vsp))
+   (stwu arm::arg_x -4 vsp)   
+   (stwu arm::arg_y -4 vsp)   
+   (stwu arm::arg_z -4 vsp))
   ((:pred = min-fixed 2)                ; at least 2 args
    (cmplwi crfx nargs (ash 2 arm::word-shift))
    (beq crfx :yz2)                      ; skip arg_x if exactly 2
-   (stwu arm::arg_x -4 arm::vsp)
+   (stwu arm::arg_x -4 vsp)
    :yz2
-   (stwu arm::arg_y -4 arm::vsp)
-   (stwu arm::arg_z -4 arm::vsp))
+   (stwu arm::arg_y -4 vsp)
+   (stwu arm::arg_z -4 vsp))
   ((:pred = min-fixed 1)                ; at least one arg
    (cmplwi crfx nargs (ash 2 arm::word-shift))
    (blt crfx :z1)                       ; branch if exactly one
    (beq crfx :yz1)                      ; branch if exactly two
-   (stwu arm::arg_x -4 arm::vsp)
+   (stwu arm::arg_x -4 vsp)
    :yz1
-   (stwu arm::arg_y -4 arm::vsp)   
+   (stwu arm::arg_y -4 vsp)   
    :z1
-   (stwu arm::arg_z -4 arm::vsp))
+   (stwu arm::arg_z -4 vsp))
   ((:pred = min-fixed 0)
    (cmplwi crfx nargs (ash 2 arm::word-shift))
@@ -3006 +3028 @@
    (blt crfx :z0)                       ; one
                                         ; Three or more ...
-   (stwu arm::arg_x -4 arm::vsp)
+   (stwu arm::arg_x -4 vsp)
    :yz0
-   (stwu arm::arg_y -4 arm::vsp)
+   (stwu arm::arg_y -4 vsp)
    :z0
-   (stwu arm::arg_z -4 arm::vsp)
+   (stwu arm::arg_z -4 vsp)
    :none
    )
   ((:pred = min-fixed 0)
-   (stwu nargs -4 arm::vsp))
+   (stwu nargs -4 vsp))
   ((:not (:pred = min-fixed 0))
    (subi arg-temp nargs (:apply ash min-fixed arm::word-shift))
-   (stwu arg-temp -4 arm::vsp))
-  (add entry-vsp arm::vsp nargs)
+   (stwu arg-temp -4 vsp))
+  (add entry-vsp vsp nargs)
   (la entry-vsp 4 entry-vsp)
   (bl .SPlexpr-entry))
@@ -3046 +3068 @@
 (define-arm-vinsn restore-cleanup-context (()
                                            ())
-  (ldr lr (:@ sp (:$ arm::lisp-frame.savelr))
+  (ldr lr (:@ sp (:$ arm::lisp-frame.savelr)))
   (add sp sp (:$ arm::lisp-frame.size)))
 
@@ -3056 +3078 @@
   (bne :done)
   ((:pred >= min 3)
-   (str arg_x (:@! vsp (:$ (- arm::node-size))))
+   (str arg_x (:@! vsp (:$ (- arm::node-size)))))
   ((:pred >= min 2)
    (mov arg_x arg_y))
   ((:pred >= min 1)
    (mov arg_y arg_z))
-  (move arm::arg_z (:$ arm::nil-value))
+  (mov arm::arg_z (:$ arm::nil-value))
   :done)
 
 (define-arm-vinsn default-2-args (()
                                   ((min :u16const)))
-  (cmp nargs (:apply ash (:apply 1+ min) 2))
+  (cmp nargs (:$ (:apply ash (:apply 1+ min) 2)))
   (bgt :done)
   (beq :one)
@@ -3083 +3105 @@
    (str arg_x (:@! vsp (:$ (- arm::node-size)))))
   ((:pred >= min 1)
-   (move arg_x arg_y))
-  (mr arm::arg_y arm::arg_z)
+   (mov arg_x arg_y))
+  (mov arm::arg_y arm::arg_z)
   :last
   (mov arg_z (:$ arm::nil-value))
@@ -3160 +3182 @@
                             (idx :imm))
                            ((imm :u32)))
-  (mov imm (:$ lsr idx (:$ arm::fixnumshift)))
+  (mov imm (:lsr idx (:$ arm::fixnumshift)))
   (add imm imm (:$ arm::misc-data-offset))
   (ldrb imm (:@ str imm))
@@ -3182 +3204 @@
                                ((imm :u32)
                                 (imm1 :u32)))
-  (mov imm (:lsr (:$ idx arm::fixnumshift)))
+  (mov imm (:lsr idx (:$ arm::fixnumshift)))
   (add imm imm (:$ arm::misc-data-offset))
-  (mov imm1 (:lst char (:$ arm::charcode-shift)))
+  (mov imm1 (:lsr char (:$ arm::charcode-shift)))
   (strb imm1 (:@ str imm)))
 
@@ -3215 +3237 @@
                                     ((imm :u32)
                                      (imm1 :u32)))
-  (addi imm idx arm::misc-data-offset)
-  (srwi imm1 code arm::fixnumshift)
-  (stwx imm1 str imm)
-  )
+  (add imm idx (:$ arm::misc-data-offset))
+  (mov imm1 (:lsr code (:$ arm::fixnumshift)))
+  (str imm1 (:@ str imm)))
 
 (define-arm-vinsn %scharcode8 (((code :imm))
                                ((str :lisp)
                                 (idx :imm))
-                               ((imm :u32)
-                                (cr0 (:crf 0))))
-  (srwi imm idx arm::fixnumshift)
-  (addi imm imm arm::misc-data-offset)
-  (lbzx imm str imm)
-  (slwi code imm arm::fixnumshift))
+                               ((imm :u32)))
+  (mov imm (:lsr idx (:$ arm::fixnumshift)))
+  (add imm imm (:$ arm::misc-data-offset))
+  (ldrb imm (:@ str imm))
+  (mov code (:lsl imm (:$ arm::fixnumshift))))
 
 (define-arm-vinsn %scharcode32 (((code :imm))
                                 ((str :lisp)
                                  (idx :imm))
-                                ((imm :u32)
-                                 (cr0 (:crf 0))))
-  (addi imm idx arm::misc-data-offset)
-  (lwzx imm str imm)
-  (slwi code imm arm::fixnumshift))
+                                ((imm :u32)))
+  (add imm idx (:$ arm::misc-data-offset))
+  (ldr imm (:@ str imm))
+  (mov code (:lsl imm (:$ arm::fixnumshift))))
 
 ;;; Clobbers LR
-(define-arm-vinsn (%debug-trap :call :subprim-call) (()
+(define-arm-vinsn %debug-trap (()
                                                      ())
-  (bl .SPbreakpoint)
-  )
-
-
+  (uuo-debug-trap))
+
+
+#+notyet
 (define-arm-vinsn eep.address (((dest t))
                                ((src (:lisp (:ne dest )))))
-  (lwz dest (+ (ash 1 2) arm::misc-data-offset) src)
+  (ldr dest (:@ src (:$ (+ (ash 1 2) arm::misc-data-offset))))
   (tweqi dest (:apply target-nil-value)))
                  
@@ -3257 +3276 @@
 (define-arm-vinsn %natural+-c (((dest :u32))
                                ((x :u32) (y :u16const)))
-  (addi dest x y))
+  (add dest x (:$ y)))
 
 (define-arm-vinsn %natural- (((dest :u32))
@@ -3265 +3284 @@
 (define-arm-vinsn %natural--c (((dest :u32))
                                ((x :u32) (y :u16const)))
-  (subi dest x y))
+  (sub dest x (:$ y)))
 
 (define-arm-vinsn %natural-logior (((dest :u32))
                                    ((x :u32) (y :u32)))
-  (or dest x y))
+  (orr dest x y))
 
 (define-arm-vinsn %natural-logior-c (((dest :u32))
-                                     ((x :u32) (high :u16const) (low :u16const)))
-  ((:not (:pred = high 0))
-   (oris dest x high))
-  ((:not (:pred = low 0))
-   (ori dest x low)))
+                                     ((x :u32) (c :u32const)))
+  (orr dest x (:$ c)))
 
 (define-arm-vinsn %natural-logxor (((dest :u32))
                                    ((x :u32) (y :u32)))
-  (xor dest x y))
+  (eor dest x y))
 
 (define-arm-vinsn %natural-logxor-c (((dest :u32))
-                                     ((x :u32) (high :u16const) (low :u16const)))
-  ((:not (:pred = high 0))
-   (xoris dest x high))
-  ((:not (:pred = low 0))
-   (xori dest x low)))
+                                     ((x :u32) (c :u32const)))
+  (eor dest x (:$ c)))
 
 (define-arm-vinsn %natural-logand (((dest :u32))
@@ -3293 +3306 @@
   (and dest x y))
 
-(define-arm-vinsn %natural-logand-high-c (((dest :u32))
-                                          ((x :u32) (high :u16const))
-                                          ((cr0 (:crf 0))))
-  (andis. dest x high))
-
-(define-arm-vinsn %natural-logand-low-c (((dest :u64))
-                                         ((x :u64) (low :u16const))
-                                         ((cr0 (:crf 0))))
-  (andi. dest x low))
-
-(define-arm-vinsn %natural-logand-mask-c (((dest :u32))
-                                          ((x :u32)
-                                           (start :u8const)
-                                           (end :u8const)))
-  (rlwinm dest x 0 start end))
+(define-arm-vinsn %natural-logand-c (((dest :u32))
+                                          ((x :u32) (c :u16const))
+                                     )
+  (and dest x (:$ c)))
+
+
+
+
+
 
 (define-arm-vinsn disable-interrupts (((dest :lisp))
@@ -3313 +3320 @@
                                       ((temp :imm)
                                        (temp2 :imm)))
-  (lwz temp2 arm::tcr.tlb-pointer arm::rcontext)
-  (li temp -4)
-  (lwz dest arm::interrupt-level-binding-index temp2)
-  (stw temp arm::interrupt-level-binding-index temp2))
+  (ldr temp2 (:@ rcontext (:$ arm::tcr.tlb-pointer)))
+  (mov temp (:$ -4))
+  (ldr dest (:@ temp2 (:$ arm::interrupt-level-binding-index)))
+  (str temp (:@ temp2 (:$ arm::interrupt-level-binding-index))))
 
 (define-arm-vinsn load-character-constant (((dest :lisp))
                                            ((code :u32const)))
-  (ori dest arm::rzero (:apply logior (:apply ash (:apply logand #xff code) arm::charcode-shift) arm::subtag-character))
-  ((:not (:pred = 0 (:apply ldb (byte 16 8) code)))
-   (oris dest dest (:apply ldb (byte 16 8) code))))
+  (mov dest (:$ arm::subtag-character))
+  ((:pred logtest #xff code)
+   (orr dest dest (:$ (:apply ash (:apply logand code #xff) 8))))
+  ((:pred logtest #xff00 code)
+   (orr dest dest (:$ (:apply ash (:apply ldb (byte 8 8) code) 16))))
+  ((:pred logtest #xff000 code)
+   (orr dest dest (:$ (:apply ash (:apply ldb (byte 8 16) code) 24)))))
 
 
@@ -3338 +3349 @@
                 (:apply %hard-regspec-value dest)
                 (:apply %hard-regspec-value src)))
-   (mr dest src))
+   (mov dest src))
   (b :done)
   :nilsym
@@ -3533 +3544 @@
 (define-arm-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
 
+#+notyet
 (define-arm-vinsn bind-interrupt-level-0-inline (()
                                                  ()
@@ -3539 +3551 @@
                                                   (link :imm)
                                                   (temp :imm)))
-  (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
-  (lwz value arm::interrupt-level-binding-index tlb)
-  (lwz link arm::tcr.db-link arm::rcontext)
+  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
+  (ldr value (:@ tlb (:$ arm::interrupt-level-binding-index)))
+  (ldr link (:@ rcontext (:$ arm::tcr.db-link)))
   (cmpwi value 0)
   (li temp arm::interrupt-level-binding-index)
-  (stwu value -4 arm::vsp)
-  (stwu temp -4 arm::vsp)
-  (stwu link -4 arm::vsp)
-  (stw arm::rzero arm::interrupt-level-binding-index tlb)
-  (stw arm::vsp  arm::tcr.db-link arm::rcontext)
+  (stwu value -4 vsp)
+  (stwu temp -4 vsp)
+  (stwu link -4 vsp)
+  (str arm::rzero (:@ tlb (:$ arm::interrupt-level-binding-index)))
+  (str vsp  (:@ rcontext (:$ arm::tcr.db-link)))
   (beq+ :done)
   (mr nargs value)
   (bgt :do-trap)
-  (lwz nargs arm::tcr.interrupt-pending arm::rcontext)
+  (ldr nargs (:@ rcontext (:$ arm::tcr.interrupt-pending)))
   :do-trap
   (twgti nargs 0)
@@ -3568 +3580 @@
                                                    (newvalue :imm)
                                                    (idx :imm)))
-  (li newvalue (ash -1 arm::fixnumshift))
-  (li idx arm::interrupt-level-binding-index)
-  (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
-  (lwz oldvalue arm::interrupt-level-binding-index tlb)
-  (lwz link arm::tcr.db-link arm::rcontext)
-  (stwu oldvalue -4 arm::vsp)
-  (stwu idx -4 arm::vsp)
-  (stwu link -4 arm::vsp)
-  (stw newvalue arm::interrupt-level-binding-index tlb)
-  (stw arm::vsp  arm::tcr.db-link arm::rcontext)
-  :done)
+  (mov newvalue (:$ (ash -1 arm::fixnumshift)))
+  (mov idx (:$ arm::interrupt-level-binding-index))
+  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
+  (ldr oldvalue (:@ tlb (:$ arm::interrupt-level-binding-index)))
+  (ldr link (:@ rcontext (:$ arm::tcr.db-link)))
+  (str oldvalue (:@! vsp (:$ (- arm::node-size))))
+  (str idx (:@! vsp (:$ (- arm::node-size))))
+  (str link (:@! vsp (:$ (- arm::node-size))))
+  (str newvalue (:@ tlb (:$ arm::interrupt-level-binding-index)))
+  (str vsp  (:@ rcontext (:$ arm::tcr.db-link))))
 
 (define-arm-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
@@ -3584 +3595 @@
 (define-arm-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
 
+#+notyet
 (define-arm-vinsn unbind-interrupt-level-inline (()
                                                  ()
@@ -3592 +3604 @@
                                                   (crf0 :crf)
                                                   (crf1 :crf)))
-  (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
-  (lwz value arm::interrupt-level-binding-index tlb)
-  (lwz link arm::tcr.db-link arm::rcontext)
+  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
+  (ldr value (:@ tlb (:$ arm::interrupt-level-binding-index)))
+  (ldr link (:@ rcontext (:$ arm::tcr.db-link)))
   (cmpwi crf1 value 0)
-  (lwz value 8 link)
-  (lwz link 0 link)
+  (ldr value (:@ link (:$ 8)))
+  (ldr link (:@ link (:$ 0)))
   (cmpwi crf0 value 0)
-  (stw value arm::interrupt-level-binding-index tlb)
-  (stw link arm::tcr.db-link arm::rcontext)
+  (str value (:@ tlb (:$ arm::interrupt-level-binding-index)))
+  (str link (:@ rcontext (:$ arm::tcr.db-link)))
   (bge crf1 :done)
   (blt crf0 :done)
   (mr save-nargs nargs)
-  (lwz nargs arm::tcr.interrupt-pending arm::rcontext)
+  (ldr nargs (:@ rcontext (:$ arm::tcr.interrupt-pending)))
   (twgti nargs 0)
   (mr nargs save-nargs)
@@ -3614 +3626 @@
                                             ((arg :lisp)
                                              (lab :label))
-                                            ((cr0 (:crf 0))
-                                             (tag :u8)))
-  (clrlwi. tag arg (- arm::nbits-in-word arm::nlisptagbits))
-  (bne cr0 lab))
+                                            ())
+  (tst arg (:$ arm::fixnummask))
+  (bne lab))
+
+
+
 
 (define-arm-vinsn branch-unless-both-args-fixnums (()
@@ -3625 +3639 @@
                                                    ((tag :u8)))
   (orr tag arg0 arg1)
-  (tst tag (:$ arm::tagmask))
+  (tst tag (:$ arm::fixnummask))
   (bne lab))
 
 ;;; In case arm::*arm-opcodes* was changed since this file was compiled.
+#+maybe-never
 (queue-fixup
  (fixup-vinsn-templates *arm-vinsn-templates* arm::*arm-opcode-numbers*))

branches/arm/compiler/ARM/arm2.lisp

@@ -503 +503 @@
       (setf (uvref function (1+ 2)) (aref imms i)))
     (setf (uvref function (+ numimms 1)) bits)
-    (let* ((maxpc (arm-lap-encode-regsave-info (arm-lap-do-labels)))
-           (code-vector-size (+ traceback-size (ash maxpc -2) prefix-size)))
-      (let* ((code-vector (%alloc-misc code-vector-size
+    (let* ((code-vector-size (arm::arm-finalize code data))
+           (code-vector (%alloc-misc code-vector-size
                                      (if cross-compiling
                                        target::subtag-xcode-vector
                                        target::subtag-code-vector)))
-             (j 0))
-        (dotimes (i prefix-size)
-          (setf (uvref code-vector i) (pop prefix)))
-        (arm-lap-resolve-labels)
-        (do-dll-nodes (insn *lap-instructions*)
-          (arm-lap-generate-instruction code-vector i insn)
-          (incf i))
-        (unless (eql 0 traceback-size)
-          (add-traceback-table code-vector i traceback-string))
-        (setf (uvref function 0) code-vector)
-        (%make-code-executable code-vector)
-        function))))
+           (j 0))
+      (dotimes (i prefix-size)
+        (setf (uvref code-vector i) (pop prefix)))
+      (arm-lap-resolve-labels)
+      (do-dll-nodes (insn *lap-instructions*)
+        (arm-lap-generate-instruction code-vector i insn)
+        (incf i))
+      (setf (uvref function 1) code-vector)
+      (%make-code-executable code-vector)
+      function)))
       
     
@@ -816 +813 @@
            (reg-vars ()))
       (declare (type (unsigned-byte 16) nargs))
-      (! save-lr)
       (if (<= nargs $numarmargregs)       ; caller didn't vpush anything
-        (if *arm2-open-code-inline*
-          (! save-lisp-context-vsp)
-          (! save-lisp-context-vsp-ool))
+        (! save-lisp-context-vsp)
         (let* ((offset (* (the fixnum (- nargs $numarmargregs)) *arm2-target-node-size*)))
           (declare (fixnum offset))
-          (if *arm2-open-code-inline*
-            (! save-lisp-context-offset offset)
-            (! save-lisp-context-offset-ool offset))))
+          (! save-lisp-context-offset offset)))
       (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
         (let* ((nstackargs (length stack-args)))
@@ -4777 +4769 @@
   (or (eq cd $backend-return) (arm2-mvpass-p cd)))
 
-(defun arm2-expand-note (note)
+(defun arm2-expand-note (note header)
   (let* ((lab (vinsn-note-label note)))
     (case (vinsn-note-class note)
       ((:begin-variable-scope :end-variable-scope
         :source-location-begin :source-location-end)
-       (setf (vinsn-label-info lab) (emit-lap-label lab))))))
+       (setf (vinsn-label-info lab) (arm::emit-lap-label header lab))))))
 
 (defun arm2-expand-vinsns (header current sections)
@@ -4791 +4783 @@
           (when (or t (vinsn-label-refs v) (null id))
             (setf (vinsn-label-info v) (arm::emit-lap-label current v)))
-          (arm2-expand-note id)))
+          (arm2-expand-note current id)))
       (setq current (arm2-expand-vinsn v current sections))))
   ;;; This doesn't have too much to do with anything else that's
@@ -5337 +5329 @@
     (let* ((fixval (or fix1 fix2))
            (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
-           (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
-           (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
-           (otherform (if (or high low) (if fix1 form2 form1))))
+           (ok-imm (and unboxed-fixval
+                        (arm::encode-arm-immediate unboxed-fixval)))
+           (otherform (if ok-imm (if fix1 form2 form1))))
       (if otherform
         (let* ((other-reg (arm2-one-untargeted-reg-form seg otherform arm::arg_z)))
           (when vreg
-            (ensuring-node-target (target vreg) 
-              (if high
-                (! logior-high target other-reg high)
-                (! logior-low target other-reg low)))))
+            (ensuring-node-target (target vreg)
+              (! logior-immediate target other-reg unboxed-fixval))))
         (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
           (if vreg (ensuring-node-target (target vreg) (! %logior2 target r1 r2)))))   
       (^))))
 
-;;; in a lot of (typical ?) cases, it might be possible to use a
-;;; rotate-and-mask instead of andi./andis.
 
 (defarm2 arm2-%ilogand2 %ilogand2 (seg vreg xfer form1 form2)
@@ -5360 +5348 @@
       (arm2-use-operator (%nx1-operator fixnum) seg vreg xfer (logand fix1 fix2))
       (let* ((fixval (or fix1 fix2))
-             (fixlen (if fixval (integer-length fixval)))
-             (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
-             (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
-             (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
-             (otherform (if (or high low) (if fix1 form2 form1))))
+             (unboxed-fixval (if fixval (ash fixval arm::fixnum-shift)))
+             (ok-imm (and unboxed-fixval
+                          (or (arm::encode-arm-immediate unboxed-fixval)
+                              (arm::encode-arm-immediate
+                               (logand #xffffffff (lognot unboxed-fixval))))))
+                                                                 
+             (otherform (if ok-imm (if fix1 form2 form1))))
         (if otherform
           (let* ((other-reg (arm2-one-untargeted-reg-form seg otherform arm::arg_z)))
             (when vreg
-              (ensuring-node-target (target vreg) 
-                (if high
-                  (! logand-high target other-reg high)
-                  (! logand-low target other-reg low)))))
-          (if (and fixval (= fixlen (logcount fixval)))
-            (let* ((nbits (- *arm2-target-bits-in-word*
-                             (1+ (+ *arm2-target-fixnum-shift* fixlen))))
-                   (otherreg (arm2-one-untargeted-reg-form seg (if fix1 form2 form1) arm::arg_z)))
-            
-              (if vreg (ensuring-node-target (target vreg)
-                         (if (> fixval 0)
-                           (! clear-left target otherreg nbits)
-                           (! clear-right target otherreg (+ fixlen
-                                                             *arm2-target-fixnum-shift*))))))
-          
+              (ensuring-node-target (target vreg)
+                (! logand-immediate target other-reg unboxed-fixval))))
             (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
-              (if vreg (ensuring-node-target (target vreg) (! %logand2 target r1 r2))))))
+              (if vreg (ensuring-node-target (target vreg) (! %logand2 target r1 r2)))))
         (^)))))
 
@@ -7778 +7755 @@
 (defarm2 arm2-%setf-double-float %setf-double-float (seg vref xfer fnode fval)
   (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg fnode arm::arg_z))
-  (let* ((target ($ arm::fp1 :class :fpr :mode :double-float))
+  (let* ((target ($ arm::d0 :class :fpr :mode :double-float))
          (node ($ arm::arg_z)))
     (arm2-one-targeted-reg-form seg fval target)
@@ -7790 +7767 @@
 (defarm2 arm2-%setf-short-float %setf-short-float (seg vreg xfer fnode fval)
   (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg fnode arm::arg_z))
-  (let* ((target ($ arm::fp1 :class :fpr :mode :single-float))
+  (let* ((target ($ arm::s0 :class :fpr :mode :single-float))
          (freg ($ arm::arg_z)))
     (arm2-one-targeted-reg-form seg fval target)