Changeset 13955

Timestamp:

Jul 12, 2010, 12:49:43 PM (9 years ago)

Author:

gb

Message:

arm-misc.lisp: Need xchgl for ARM (used in futex-based locking.)
l0-misc.lisp: ROOM and aux functions: no tsp on ARM
vinsn.lisp: rename :conditional attribute to :predicatable.
arm-vinsns.lisp, arm2.lisp: replace COPY-FPR with all 4 single/double
variants. Use :predicatable attribute to avoid some conditional branches.
arm-asm.lisp, arm-disassemble.lisp: add, fix some instruction definitions.

Location:

branches/arm

Files:

• compiler/ARM/arm-vinsns.lisp (modified) (86 diffs)
• compiler/ARM/arm2.lisp (modified) (18 diffs)
• compiler/vinsn.lisp (modified) (1 diff)
• level-0/ARM/arm-misc.lisp (modified) (1 diff)
• level-0/l0-misc.lisp (modified) (3 diffs)

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

@@ -32 +32 @@
 ;;; Index "scaling" and constant-offset misc-ref vinsns.
 
-(define-arm-vinsn scale-node-misc-index (((dest :u32))
-                                         ((idx :imm) ; A fixnum
-                                          )
-                                         ())
+(define-arm-vinsn (scale-node-misc-index :predicatable)
+    (((dest :u32))
+     ((idx :imm) ; A fixnum
+      )
+     ())
   (add dest idx (:$ arm::misc-data-offset)))
 
-(define-arm-vinsn scale-32bit-misc-index (((dest :u32))
-                                          ((idx :imm) ; A fixnum
-                                           )
-                                          ())
+(define-arm-vinsn (scale-32bit-misc-index :predicatable)
+    (((dest :u32))
+     ((idx :imm)                        ; A fixnum
+      )
+     ())
   (add dest idx (:$ arm::misc-data-offset)))
 
-(define-arm-vinsn scale-16bit-misc-index (((dest :u32))
-                                          ((idx :imm) ; A fixnum
-                                           )
-                                          ())
+(define-arm-vinsn (scale-16bit-misc-index :predicatable)
+    (((dest :u32))
+     ((idx :imm)                        ; A fixnum
+      )
+     ())
   (mov  dest (:lsr idx (:$ 1)))
   (add dest dest (:$ arm::misc-data-offset)))
 
-(define-arm-vinsn scale-8bit-misc-index (((dest :u32))
-                                         ((idx :imm) ; A fixnum
-                                          )
-                                         ())
+(define-arm-vinsn (scale-8bit-misc-index :predicatable)
+    (((dest :u32))
+     ((idx :imm)                        ; A fixnum
+      )
+     ())
   (mov dest (:lsr idx (:$ 2)))
   (add dest dest (:$ arm::misc-data-offset)))
 
-(define-arm-vinsn scale-64bit-misc-index (((dest :u32))
-                                          ((idx :imm) ; A fixnum
-                                           )
-                                          ())
+(define-arm-vinsn (scale-64bit-misc-index :predicatable)
+    (((dest :u32))
+     ((idx :imm)                        ; A fixnum
+      )
+     ())
   (add dest idx idx)
   (add dest dest (:$ arm::misc-dfloat-offset)))
 
 
-(define-arm-vinsn scale-1bit-misc-index (((word-index :u32)
-                                          (bitnum :u8)) ; (unsigned-byte 5)
-                                         ((idx :imm) ; A fixnum
-                                          )
-                                         )
+(define-arm-vinsn (scale-1bit-misc-index :predicatable)
+    (((word-index :u32)
+      (bitnum :u8))                     ; (unsigned-byte 5)
+     ((idx :imm)                        ; A fixnum
+      )
+     )
   (mov word-index (:lsr idx (:$ arm::fixnumshift)))
   (and bitnum word-index (:$ 31))
@@ -79 +85 @@
 
 
-(define-arm-vinsn misc-ref-u32  (((dest :u32))
-                                 ((v :lisp)
-                                  (scaled-idx :u32))
-                                 ())
+(define-arm-vinsn (misc-ref-u32 :predicatable)
+    (((dest :u32))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ())
   (ldr dest (:+@ v scaled-idx)))
 
 
-(define-arm-vinsn misc-ref-c-u32  (((dest :u32))
-                                   ((v :lisp)
-                                    (idx :u32const))
-                                   ())
+(define-arm-vinsn (misc-ref-c-u32 :predicatable)
+    (((dest :u32))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
-(define-arm-vinsn misc-ref-s32 (((dest :s32))
-                                ((v :lisp)
-                                 (scaled-idx :u32))
-                                ())
+(define-arm-vinsn (misc-ref-s32 :predicatable)
+    (((dest :s32))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ())
   (ldr dest (:+@ v  scaled-idx)))
 
-(define-arm-vinsn misc-ref-c-s32  (((dest :s32))
-                                   ((v :lisp)
-                                    (idx :u32const))
-                                   ())
+(define-arm-vinsn (misc-ref-c-s32 :predicatable)
+    (((dest :s32))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
 
-(define-arm-vinsn misc-set-c-u32 (()
-                                  ((val :u32)
-                                   (v :lisp)
-                                   (idx :u32const)))
+(define-arm-vinsn (misc-set-c-u32 :predicatable)
+    (()
+     ((val :u32)
+      (v :lisp)
+      (idx :u32const)))
   (str val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
-(define-arm-vinsn misc-set-c-s32 (()
-                                  ((val :s32)
-                                   (v :lisp)
-                                   (idx :u32const)))
+(define-arm-vinsn (misc-set-c-s32 :predicatable)
+    (()
+     ((val :s32)
+      (v :lisp)
+      (idx :u32const)))
   (str val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
-(define-arm-vinsn misc-set-u32 (()
-                                ((val :u32)
-                                 (v :lisp)
-                                 (scaled-idx :u32)))
+(define-arm-vinsn (misc-set-u32 :predicatable)
+    (()
+     ((val :u32)
+      (v :lisp)
+      (scaled-idx :u32)))
   (str val (:+@ v scaled-idx)))
 
-(define-arm-vinsn misc-set-s32 (()
-                                ((val :s32)
-                                 (v :lisp)
-                                 (scaled-idx :u32)))
+(define-arm-vinsn (misc-set-s32 :predicatable)
+    (()
+     ((val :s32)
+      (v :lisp)
+      (scaled-idx :u32)))
   (str val (:+@ v scaled-idx)))
 
                               
-(define-arm-vinsn misc-ref-single-float  (((dest :single-float))
-                                          ((v :lisp)
-                                           (scaled-idx :u32))
-                                          ((temp :u32)))
+(define-arm-vinsn (misc-ref-single-float :predicatable)
+    (((dest :single-float))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ((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))
-                                            ((temp :u32)))
+(define-arm-vinsn (misc-ref-c-single-float :predicatable)
+    (((dest :single-float))
+     ((v :lisp)
+      (idx :u32const))
+     ((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))
-                                          ((low (:u32 #.arm::imm0))
-                                           (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (misc-ref-double-float :predicatable)
+    (((dest :double-float))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ((low (:u32 #.arm::imm0))
+      (high (:u32 #.arm::imm1))))
   (ldrd low (:@ v scaled-idx))
   (fmdrr dest low high))
 
 
-(define-arm-vinsn misc-ref-c-double-float  (((dest :double-float))
-                                            ((v :lisp)
-                                             (idx :u32const))
-                                            ((low (:u32 #.arm::imm0))
-                                             (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (misc-ref-c-double-float :predicatable)
+    (((dest :double-float))
+     ((v :lisp)
+      (idx :u32const))
+     ((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))
-                                           ((low (:u32 #.arm::imm0))
-                                            (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (misc-set-c-double-float :predicatable)
+    (((val :double-float))
+     ((v :lisp)
+      (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))
-                                         ((low (:u32 #.arm::imm0))
-                                          (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (misc-set-double-float :predicatable)
+    (()
+     ((val :double-float)
+      (v :lisp)
+      (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)))
+(define-arm-vinsn (misc-set-c-single-float :predicatable)
+    (()
+     ((val :single-float)
+      (v :lisp)
+      (idx :u32const))
+     ((temp :u32)))
   (fmrs temp val)
   (str temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
@@ -188 +209 @@
 
 
-(define-arm-vinsn misc-set-single-float (()
-                                         ((val :single-float)
-                                          (v :lisp)
-                                          (scaled-idx :u32))
-                                         ((temp :u32)))
+(define-arm-vinsn (misc-set-single-float :predicatable)
+    (()
+     ((val :single-float)
+      (v :lisp)
+      (scaled-idx :u32))
+     ((temp :u32)))
   (fmrs temp val)
   (str temp (:@ v scaled-idx)))
 
 
-(define-arm-vinsn misc-ref-u16  (((dest :u16))
-                                 ((v :lisp)
-                                  (scaled-idx :u32))
-                                 ())
+(define-arm-vinsn (misc-ref-u16 :predicatable)
+    (((dest :u16))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ())
   (ldrh dest (:+@ v scaled-idx)))
 
-(define-arm-vinsn misc-ref-c-u16  (((dest :u16))
-                                   ((v :lisp)
-                                    (idx :u32const))
-                                   ())
+(define-arm-vinsn (misc-ref-c-u16 :predicatable)
+    (((dest :u16))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (ldrh dest (:+@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
 
-(define-arm-vinsn misc-set-c-u16  (((val :u16))
-                                   ((v :lisp)
-                                    (idx :u32const))
-                                   ())
+(define-arm-vinsn (misc-set-c-u16 :predicatable)
+    (((val :u16))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (strh val (:+@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
 
-(define-arm-vinsn misc-set-u16 (((val :u16))
-                                ((v :lisp)
-                                 (scaled-idx :s32)))
+(define-arm-vinsn (misc-set-u16 :predicatable)
+    (((val :u16))
+     ((v :lisp)
+      (scaled-idx :s32)))
   (strh val (:+@ v scaled-idx)))
 
@@ -226 +252 @@
   (ldrsh dest (:@ v scaled-idx)))
 
-(define-arm-vinsn misc-ref-c-s16  (((dest :s16))
-                                   ((v :lisp)
-                                    (idx :u32const))
-                                   ())
+(define-arm-vinsn (misc-ref-c-s16 :predicatable)
+    (((dest :s16))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (ldrsh dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
 
 
-(define-arm-vinsn misc-set-c-s16  (((val :s16))
-                                   ((v :lisp)
-                                    (idx :u32const))
-                                   ())
+(define-arm-vinsn (misc-set-c-s16 :predicatable)
+    (((val :s16))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (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)))
+(define-arm-vinsn (misc-set-s16 :predicatable)
+    (((val :s16))
+     ((v :lisp)
+      (scaled-idx :s32)))
   (strh val (:@ v scaled-idx)))
 
-(define-arm-vinsn misc-ref-u8  (((dest :u8))
-                                ((v :lisp)
-                                 (scaled-idx :u32))
-                                ())
+(define-arm-vinsn (misc-ref-u8 :predicatable)
+    (((dest :u8))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ())
   (ldrb dest (:@ v scaled-idx)))
 
-(define-arm-vinsn misc-ref-c-u8  (((dest :u8))
-                                  ((v :lisp)
-                                   (idx :u32const))
-                                  ())
+(define-arm-vinsn (misc-ref-c-u8 :predicatable)
+    (((dest :u8))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (ldrb dest (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
 
-(define-arm-vinsn misc-set-c-u8  (((val :u8))
-                                  ((v :lisp)
-                                   (idx :u32const))
-                                  ())
+(define-arm-vinsn (misc-set-c-u8 :predicatable)
+    (((val :u8))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (strb val (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
 
-(define-arm-vinsn misc-set-u8  (((val :u8))
-                                ((v :lisp)
-                                 (scaled-idx :u32))
-                                ())
+(define-arm-vinsn (misc-set-u8 :predicatable)
+    (((val :u8))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ())
   (strb val (:@ v scaled-idx)))
 
-(define-arm-vinsn misc-ref-s8  (((dest :s8))
-                                ((v :lisp)
-                                 (scaled-idx :u32))
-                                ())
+(define-arm-vinsn (misc-ref-s8 :predicatable)
+    (((dest :s8))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ())
   (ldrsb dest (:@ v scaled-idx)))
 
-(define-arm-vinsn misc-ref-c-s8  (((dest :s8))
-                                  ((v :lisp)
-                                   (idx :u32const))
-                                  ())
+(define-arm-vinsn (misc-ref-c-s8 :predicatable)
+    (((dest :s8))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (ldrsb dest (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
 
-(define-arm-vinsn misc-set-c-s8  (((val :s8))
-                                  ((v :lisp)
-                                   (idx :u32const))
-                                  ())
+(define-arm-vinsn (misc-set-c-s8 :predicatable)
+    (((val :s8))
+     ((v :lisp)
+      (idx :u32const))
+     ())
   (strb val (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
 
-(define-arm-vinsn misc-set-s8  (((val :s8))
-                                ((v :lisp)
-                                 (scaled-idx :u32))
-                                ())
+(define-arm-vinsn (misc-set-s8 :predicatable)
+    (((val :s8))
+     ((v :lisp)
+      (scaled-idx :u32))
+     ())
   (strb val (:@ v scaled-idx)))
 
-#+notyet
-(define-arm-vinsn misc-ref-c-bit (((dest :u8))
-                                  ((v :lisp)
-                                   (idx :u32const))
-                                  ())
-  (lwz dest (:apply + arm::misc-data-offset (:apply ash idx -5)) v)
-  (rlwinm dest dest (:apply 1+ (:apply logand idx #x1f)) 31 31))
-
-#+notyet
-(define-arm-vinsn misc-ref-c-bit-fixnum (((dest :imm))
-                                         ((v :lisp)
-                                          (idx :u32const))
-                                         ((temp :u32)))
-  (lwz temp (:apply + arm::misc-data-offset (:apply ash idx -5)) v)
-  (rlwinm dest 
-          temp
-          (:apply + 1 arm::fixnumshift (:apply logand idx #x1f)) 
-          (- arm::least-significant-bit arm::fixnumshift)
-          (- arm::least-significant-bit arm::fixnumshift)))
-
-
-(define-arm-vinsn misc-ref-node  (((dest :lisp))
-                                  ((v :lisp)
-                                   (scaled-idx :s32))
-                                  ())
+
+(define-arm-vinsn (misc-ref-c-bit :predicatable)
+    (((dest :u8))
+     ((v :lisp)
+      (idx :u32const))
+     ())
+  (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx -5)))))
+  (mov dest (:lsr dest (:$ (:apply logand idx #x1f))))
+  (and dest dest (:$ 1)))
+
+(define-arm-vinsn (misc-ref-c-bit-fixnum :predicatable)
+    (((dest :imm))
+     ((v :lisp)
+      (idx :u32const))
+     ((temp :u32)))
+  (ldr temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx -5)))))
+  (mov temp (:ror temp (:$ (:apply logand #x1f (:apply - (:apply logand idx #x1f) arm::fixnumshift)))))
+  (and dest temp (:$ arm::fixnumone)))
+
+
+(define-arm-vinsn (misc-ref-node :predicatable)
+    (((dest :lisp))
+     ((v :lisp)
+      (scaled-idx :s32))
+     ())
   (ldr dest (:@ v scaled-idx)))
 
 
-
-
-(define-arm-vinsn misc-ref-c-node (((dest :lisp))
-                                   ((v :lisp)
-                                    (idx :s16const))
-                                   ())
+(define-arm-vinsn (misc-ref-c-node :predicatable)
+    (((dest :lisp))
+     ((v :lisp)
+      (idx :s16const))
+     ())
   (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
-(define-arm-vinsn misc-set-node (()
-                                 ((val :lisp)
-                                  (v :lisp)
-                                  (scaled-idx :u32)))
+(define-arm-vinsn (misc-set-node :predicatable)
+    (()
+     ((val :lisp)
+      (v :lisp)
+      (scaled-idx :u32)))
   (str val (:@ v scaled-idx)))
 
 ;;; This should only be used for initialization (when the value being
 ;;; stored is known to be older than the vector V.)
-(define-arm-vinsn misc-set-c-node (()
-                                   ((val :lisp)
-                                    (v :lisp)
-                                    (idx :s16const))
-                                   ())
+(define-arm-vinsn (misc-set-c-node :predicatable)
+    (()
+     ((val :lisp)
+      (v :lisp)
+      (idx :s16const))
+     ())
   (str val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
 
 
-(define-arm-vinsn misc-element-count-fixnum (((dest :imm))
-                                             ((v :lisp))
-                                             ((temp :u32)))
+(define-arm-vinsn (misc-element-count-fixnum :predicatable)
+    (((dest :imm))
+     ((v :lisp))
+     ((temp :u32)))
   (ldr temp (:@ v (:$ arm::misc-header-offset)))
   (bic temp temp (:$ arm::subtag-mask))
@@ -360 +399 @@
   (uuo-error-vector-bounds (:? hs) idx v))
 
-(define-arm-vinsn 2d-unscaled-index (((dest :imm)
-                                      (dim1 :u32))
-                                     ((dim1 :u32)
-                                      (i :imm)
-                                      (j :imm)))
+(define-arm-vinsn (2d-unscaled-index :predicatable)
+    (((dest :imm)
+      (dim1 :u32))
+     ((dim1 :u32)
+      (i :imm)
+      (j :imm)))
   (mul dim1 i dim1)
   (add dest dim1 j))
@@ -370 +410 @@
 ;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
 
-(define-arm-vinsn 3d-unscaled-index (((dest :imm)
-                                      (dim1 :u32)
-                                      (dim2 :u32))
-                                     ((dim1 :u32)
-                                      (dim2 :u32)
-                                      (i :imm)
-                                      (j :imm)
-                                      (k :imm)))
+(define-arm-vinsn (3d-unscaled-index :predicatable)
+    (((dest :imm)
+      (dim1 :u32)
+      (dim2 :u32))
+     ((dim1 :u32)
+      (dim2 :u32)
+      (i :imm)
+      (j :imm)
+      (k :imm)))
   (mul dim1 dim1 dim2)
   (mul dim2 j dim2)
@@ -385 +426 @@
 
 
-(define-arm-vinsn 2d-dim1 (((dest :u32))
-                           ((header :lisp)))
+(define-arm-vinsn (2d-dim1 :predicatable)
+    (((dest :u32))
+     ((header :lisp)))
   (ldr dest (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
   (mov dest (:asr dest (:$ arm::fixnumshift))))
@@ -392 +434 @@
 
 
-(define-arm-vinsn 3d-dims (((dim1 :u32)
-                            (dim2 :u32))
-                           ((header :lisp)))
+(define-arm-vinsn (3d-dims :predicatable)
+    (((dim1 :u32)
+      (dim2 :u32))
+     ((header :lisp)))
   (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))))))
@@ -431 +474 @@
   (mov dim2 (:asr dim2 (:$ arm::fixnumshift))))
 
-(define-arm-vinsn array-data-vector-ref (((dest :lisp))
-                                         ((header :lisp)))
+(define-arm-vinsn (array-data-vector-ref :predicatable)
+    (((dest :lisp))
+     ((header :lisp)))
   (ldr dest (:@ header (:$ arm::arrayH.data-vector))))
   
@@ -460 +504 @@
 
   
-(define-arm-vinsn node-slot-ref  (((dest :lisp))
-                                  ((node :lisp)
-                                   (cellno :u32const)))
+(define-arm-vinsn (node-slot-ref :predicatable)
+    (((dest :lisp))
+     ((node :lisp)
+      (cellno :u32const)))
   (ldr dest (:@ node (:$ (:apply + arm::misc-data-offset (:apply ash cellno 2))))))
 
@@ -479 +524 @@
 ;;; Untagged memory reference & assignment.
 
-(define-arm-vinsn mem-ref-c-fullword (((dest :u32))
-                                      ((src :address)
-                                       (index :s16const)))
+(define-arm-vinsn (mem-ref-c-fullword :predicatable)
+    (((dest :u32))
+     ((src :address)
+      (index :s16const)))
   (ldr dest (:@ src (:$ index))))
 
 
-(define-arm-vinsn mem-ref-c-signed-fullword (((dest :s32))
-                                             ((src :address)
-                                              (index :s16const)))
+(define-arm-vinsn (mem-ref-c-signed-fullword :predicatable)
+    (((dest :s32))
+     ((src :address)
+      (index :s16const)))
   (ldr dest (:@ src (:$ index))))
 
-(define-arm-vinsn mem-ref-c-natural (((dest :u32))
-                                     ((src :address)
-                                      (index :s16const)))
+
+(define-arm-vinsn (mem-ref-c-natural :predicatable)
+    (((dest :u32))
+     ((src :address)
+      (index :s16const)))
   (ldr dest (:@ src (:$ index))))
   
 
-(define-arm-vinsn mem-ref-fullword (((dest :u32))
-                                    ((src :address)
-                                     (index :s32)))
+(define-arm-vinsn (mem-ref-fullword :predicatable)
+    (((dest :u32))
+     ((src :address)
+      (index :s32)))
   (ldr dest (:@ src index)))
 
-(define-arm-vinsn mem-ref-signed-fullword (((dest :u32))
-                                           ((src :address)
-                                            (index :s32)))
+(define-arm-vinsn (mem-ref-signed-fullword :predicatable)
+    (((dest :u32))
+     ((src :address)
+      (index :s32)))
   (ldr dest (:@ src index)))
 
-(define-arm-vinsn mem-ref-natural (((dest :u32))
-                                   ((src :address)
-                                    (index :s32)))
+(define-arm-vinsn (mem-ref-natural :predicatable)
+    (((dest :u32))
+     ((src :address)
+      (index :s32)))
   (ldr dest (:@ src index)))
 
 
-(define-arm-vinsn mem-ref-c-u16 (((dest :u16))
-                                 ((src :address)
-                                  (index :s16const)))
+(define-arm-vinsn (mem-ref-c-u16 :predicatable)
+    (((dest :u16))
+     ((src :address)
+      (index :s16const)))
   (ldrh dest (:@ src (:$ index))))
 
 
-(define-arm-vinsn mem-ref-u16 (((dest :u16))
-                               ((src :address)
-                                (index :s32)))
+(define-arm-vinsn (mem-ref-u16 :predicatable)
+    (((dest :u16))
+     ((src :address)
+      (index :s32)))
   (ldrh dest (:@ src index)))
 
 
 
-(define-arm-vinsn mem-ref-c-s16 (((dest :s16))
-                                 ((src :address)
-                                  (index :s16const)))
+(define-arm-vinsn (mem-ref-c-s16 :predicatable)
+    (((dest :s16))
+     ((src :address)
+      (index :s16const)))
   (ldrsh dest (:@ src (:$ index))))
 
-(define-arm-vinsn mem-ref-s16 (((dest :s16))
-                               ((src :address)
-                                (index :s32)))
+(define-arm-vinsn (mem-ref-s16 :predicatable)
+    (((dest :s16))
+     ((src :address)
+      (index :s32)))
   (ldrsh dest (:@ src index)))
 
-(define-arm-vinsn mem-ref-c-u8 (((dest :u8))
-                                ((src :address)
-                                 (index :s16const)))
+(define-arm-vinsn (mem-ref-c-u8 :predicatable)
+    (((dest :u8))
+     ((src :address)
+      (index :s16const)))
   (ldrb dest (:@ src (:$ index))))
 
-(define-arm-vinsn mem-ref-u8 (((dest :u8))
-                              ((src :address)
-                               (index :s32)))
+(define-arm-vinsn (mem-ref-u8 :predicatable)
+    (((dest :u8))
+     ((src :address)
+      (index :s32)))
   (ldrb dest (:@ src index)))
 
-(define-arm-vinsn mem-ref-c-s8 (((dest :s8))
-                                ((src :address)
-                                 (index :s16const)))
+(define-arm-vinsn (mem-ref-c-s8 :predicatable)
+    (((dest :s8))
+     ((src :address)
+      (index :s16const)))
   (ldrsb dest (:@ src (:$ index))))
 
-(define-arm-vinsn mem-ref-s8 (((dest :s8))
-                              ((src :address)
-                               (index :s32)))
+(define-arm-vinsn (mem-ref-s8 :predicatable)
+    (((dest :s8))
+     ((src :address)
+      (index :s32)))
   (ldrsb dest (:@ src index)))
 
-#+notyet
-(define-arm-vinsn mem-ref-c-bit (((dest :u8))
-                                 ((src :address)
-                                  (byte-index :s16const)
-                                  (bit-shift :u8const)))
-  (lbz dest byte-index src)
-  (rlwinm dest dest bit-shift 31 31))
-
-
-#+notyet
-(define-arm-vinsn mem-ref-c-bit-fixnum (((dest :lisp))
-                                        ((src :address)
-                                         (byte-index :s16const)
-                                         (bit-shift :u8const))
-                                        ((byteval :u8)))
-  (lbz byteval byte-index src)
-  (rlwinm dest byteval bit-shift 29 29))
-
-(define-arm-vinsn mem-ref-bit (((dest :u8))
-                               ((src :address)
-                                (bit-index :lisp))
-                               ((byte-index :s16)
-                                (bit-shift :u8)))
+(define-arm-vinsn (mem-ref-c-bit :predicatable)
+    (((dest :u8))
+     ((src :address)
+      (byte-index :s16const)
+      (bit-shift :u8const)))
+  (ldrb dest (:@ src (:$ byte-index)))
+  (mov dest (:lsr dest (:$ bit-shift)))
+  (and dest dest (:$ 1)))
+
+
+(define-arm-vinsn (mem-ref-c-bit-fixnum :predicatable)
+    (((dest :lisp))
+     ((src :address)
+      (byte-index :s16const)
+      (bit-shift :u8const))
+     ((byteval :u8)))
+  (ldrb byteval (:@ src (:$ byte-index)))
+  (mov byteval (:lsr byteval (:$ bit-shift)))
+  (and byteval byteval (:$ 1))
+  (mov dest (:lsr byteval (:$ arm::fixnumshift))))
+
+(define-arm-vinsn (mem-ref-bit :predicatable)
+    (((dest :u8))
+     ((src :address)
+      (bit-index :lisp))
+     ((byte-index :s16)
+      (bit-shift :u8)))
 
   (mov byte-index (:lsr bit-index (:$ arm::fixnumshift)))
@@ -586 +650 @@
 
 
-(define-arm-vinsn mem-ref-bit-fixnum (((dest :lisp))
-                                      ((src :address)
-                                       (bit-index :lisp))
-                                      ((byte-index :s16)
-                                       (bit-shift :u8)))
+(define-arm-vinsn (mem-ref-bit-fixnum :predicatable)
+    (((dest :lisp))
+     ((src :address)
+      (bit-index :lisp))
+     ((byte-index :s16)
+      (bit-shift :u8)))
   (mov byte-index (:lsr bit-index (:$ arm::fixnumshift)))
   (and bit-shift byte-index (:$ 7))
@@ -598 +663 @@
   (and dest dest (:lsl byte-index (:$ arm::fixnumshift))))
 
-(define-arm-vinsn mem-ref-c-double-float (((dest :double-float))
-                                          ((src :address)
-                                           (index :s16const))
-                                          ((low (:u32 #.arm::imm0))
-                                           (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (mem-ref-c-double-float :predicatable)
+    (((dest :double-float))
+     ((src :address)
+      (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))
-                                        ((low (:u32 #.arm::imm0))
-                                         (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (mem-ref-double-float :predicatable)
+    (((dest :double-float))
+     ((src :address)
+      (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))
-                                          ((low (:u32 #.arm::imm0))
-                                           (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (mem-set-c-double-float :predicatable)
+    (()
+     ((val :double-float)
+      (src :address)
+      (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)) ; imm2, I presume
-                                        ((low (:u32 #.arm::imm0))
-                                         (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (mem-set-double-float :predicatable)
+    (()
+     ((val :double-float)
+      (src :address)
+      (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))
-                                          ((temp :u32)))
+(define-arm-vinsn (mem-ref-c-single-float :predicatable)
+    (((dest :single-float))
+     ((src :address)
+      (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))
-                                        ((temp :u32)))
+(define-arm-vinsn (mem-ref-single-float :predicatable)
+    (((dest :single-float))
+     ((src :address)
+      (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))
-                                          ((temp :u32)))
+(define-arm-vinsn (mem-set-c-single-float :predicatable)
+    (()
+     ((val :single-float)
+      (src :address)
+      (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))
-                                        ((temp :u32)))
+(define-arm-vinsn (mem-set-single-float :predicatable)
+    (()
+     ((val :single-float)
+      (src :address)
+      (index :s32))
+     ((temp :u32)))
   (fmrs temp src)
   (str temp (:@ src (:$ index))))
 
 
-(define-arm-vinsn mem-set-c-address (()
-                                     ((val :address)
-                                      (src :address)
-                                      (index :s16const)))
+(define-arm-vinsn (mem-set-c-address :predicatable)
+    (()
+     ((val :address)
+      (src :address)
+      (index :s16const)))
   (str val (:@ src (:$ index))))
 
-(define-arm-vinsn mem-set-address (()
-                                   ((val :address)
-                                    (src :address)
-                                    (index :s32)))
+(define-arm-vinsn (mem-set-address :predicatable)
+    (()
+     ((val :address)
+      (src :address)
+      (index :s32)))
   (str val (:@ src index)))
 
-(define-arm-vinsn mem-set-c-fullword (()
-                                      ((val :u32)
-                                       (src :address)
-                                       (index :s16const)))
+(define-arm-vinsn (mem-set-c-fullword :predicatable)
+    (()
+     ((val :u32)
+      (src :address)
+      (index :s16const)))
   (str val (:@ src (:$ index))))
 
-(define-arm-vinsn mem-set-fullword (()
-                                    ((val :u32)
-                                     (src :address)
-                                     (index :s32)))
+(define-arm-vinsn (mem-set-fullword :predicatable)
+    (()
+     ((val :u32)
+      (src :address)
+      (index :s32)))
   (str val (:@ src index)))
 
-(define-arm-vinsn mem-set-c-halfword (()
-                                      ((val :u16)
-                                       (src :address)
-                                       (index :s16const)))
+(define-arm-vinsn (mem-set-c-halfword :predicatable)
+    (()
+     ((val :u16)
+      (src :address)
+      (index :s16const)))
   (strh val (:@ src (:$ index))))
 
-(define-arm-vinsn mem-set-halfword (()
-                                    ((val :u16)
-                                     (src :address)
-                                     (index :s32)))
+(define-arm-vinsn (mem-set-halfword :predicatable)
+    (()
+     ((val :u16)
+      (src :address)
+      (index :s32)))
   (strh val (:@ src index)))
 
-(define-arm-vinsn mem-set-c-byte (()
-                                  ((val :u16)
-                                   (src :address)
-                                   (index :s16const)))
+(define-arm-vinsn (mem-set-c-byte :predicatable)
+    (()
+     ((val :u16)
+      (src :address)
+      (index :s16const)))
   (strb val (:@ src (:$ index))))
 
-(define-arm-vinsn mem-set-byte (()
-                                ((val :u8)
-                                 (src :address)
-                                 (index :s32)))
+(define-arm-vinsn (mem-set-byte :predicatable)
+    (()
+     ((val :u8)
+      (src :address)
+      (index :s32)))
   (strb val (:@ src index)))
 
-(define-arm-vinsn mem-set-c-bit-0 (()
-                                   ((src :address)
-                                    (byte-index :s16const)
-                                    (mask :u8const))
-                                   ((val :u8)))
+(define-arm-vinsn (mem-set-c-bit-0 :predicatable)
+    (()
+     ((src :address)
+      (byte-index :s16const)
+      (mask :u8const))
+     ((val :u8)))
   (ldrb val (:@ src (:$ byte-index)))
   (bic val val (:$ mask))
@@ -721 +803 @@
 
 
-(define-arm-vinsn mem-set-c-bit-1 (()
-                                   ((src :address)
-                                    (byte-index :s16const)
-                                    (mask :u8const))
-                                   ((val :u8)))
+(define-arm-vinsn (mem-set-c-bit-1 :predicatable)
+    (()
+     ((src :address)
+      (byte-index :s16const)
+      (mask :u8const))
+     ((val :u8)))
   (ldrb val (:@ src (:$ byte-index)))
   (orr val val (:$ mask))
@@ -768 +851 @@
 ;;; Tag and subtag extraction, comparison, checking, trapping ...
 
-(define-arm-vinsn extract-tag (((tag :u8)) 
-                               ((object :lisp)) 
-                               ())
+(define-arm-vinsn (extract-tag :predicatable)
+    (((tag :u8)) 
+     ((object :lisp)) 
+     ())
   (and tag object (:$ arm::tagmask)))
 
-(define-arm-vinsn extract-tag-fixnum (((tag :imm))
-                                      ((object :lisp)))
+(define-arm-vinsn (extract-tag-fixnum :predicatable)
+    (((tag :imm))
+     ((object :lisp)))
   (mov tag (:lsl object (:$ arm::fixnumshift)))
   (and tag object (:$ (ash arm::tagmask arm::fixnumshift))))
 
-(define-arm-vinsn extract-fulltag (((tag :u8))
-                                   ((object :lisp))
-                                   ())
+(define-arm-vinsn (extract-fulltag :predicatable)
+    (((tag :u8))
+     ((object :lisp))
+     ())
   (and tag object (:$ arm::fulltagmask)))
 
 
-(define-arm-vinsn extract-fulltag-fixnum (((tag :imm))
-                                          ((object :lisp)))
+(define-arm-vinsn (extract-fulltag-fixnum :predicatable)
+    (((tag :imm))
+     ((object :lisp)))
   (mov tag (:lsl object (:$ arm::fixnumshift)))
   (and tag tag (:$ (ash arm::fulltagmask arm::fixnumshift))))
@@ -1026 +1113 @@
 
 
-(define-arm-vinsn box-fixnum (((dest :imm))
-                              ((src :s32)))
+(define-arm-vinsn (box-fixnum :predicatable)
+    (((dest :imm))
+     ((src :s32)))
   (mov dest (:lsl src (:$ arm::fixnumshift))))
 
-(define-arm-vinsn fixnum->signed-natural (((dest :s32))
-                                          ((src :imm)))
+(define-arm-vinsn (fixnum->signed-natural :predicatable)
+    (((dest :s32))
+     ((src :imm)))
   (mov dest (:asr src (:$ arm::fixnumshift))))
 
-(define-arm-vinsn fixnum->unsigned-natural (((dest :u32))
-                                            ((src :imm)))
+(define-arm-vinsn (fixnum->unsigned-natural :predicatable)
+    (((dest :u32))
+     ((src :imm)))
   (mov dest (:lsr src (:$ arm::fixnumshift))))
 
@@ -1115 +1205 @@
   (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u8)))
 
-(define-arm-vinsn %unbox-u8 (((dest :u8))
-                             ((src :lisp)))
+(define-arm-vinsn (%unbox-u8 :predicatable)
+    (((dest :u8))
+     ((src :lisp)))
   (mov dest (:$ #xff))
   (and dest dest (:lsr src (:$ arm::fixnumshift))))
@@ -1143 +1234 @@
 
 
-(define-arm-vinsn fixnum->double (((dest :double-float))
-                                  ((src :lisp))
-                                  ((imm :s32)
-                                   (temp :single-float)))
+(define-arm-vinsn (fixnum->double :predicatable)
+    (((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)))
+(define-arm-vinsn (fixnum->single :predicatable)
+    (((dest :single-float))
+     ((src :lisp))
+     ((imm :s32)))
   (mov imm (:asr src (:$ arm::fixnumshift)))
   (fmsr dest imm)
@@ -1159 +1252 @@
 
 
-(define-arm-vinsn shift-left-variable-word (((dest :u32))
-                                            ((src :u32)
-                                             (sh :u32)))
+(define-arm-vinsn (shift-left-variable-word :predicatable)
+    (((dest :u32))
+     ((src :u32)
+      (sh :u32)))
   (mov dest (:lsl src sh)))
 
-(define-arm-vinsn u32logandc2 (((dest :u32))
-                               ((x :u32)
-                                (y :u32)))
+(define-arm-vinsn (u32logandc2 :predicatable)
+    (((dest :u32))
+     ((x :u32)
+      (y :u32)))
   (bic dest x y))
 
-(define-arm-vinsn u32logior (((dest :u32))
-                             ((x :u32)
-                              (y :u32)))
+(define-arm-vinsn (u32logior :predicatable)
+    (((dest :u32))
+     ((x :u32)
+      (y :u32)))
   (orr dest x y))
 
@@ -1181 +1277 @@
   (orreq dest src mask))
 
-(define-arm-vinsn complement-shift-count (((dest :u32))
-                                          ((src :u32)))
+(define-arm-vinsn (complement-shift-count :predicatable)
+    (((dest :u32))
+     ((src :u32)))
   (rsb dest src (:$ 32)))
 
-(define-arm-vinsn extract-lowbyte (((dest :u32))
-                                   ((src :lisp)))
+(define-arm-vinsn (extract-lowbyte :predicatable)
+    (((dest :u32))
+     ((src :lisp)))
   (and dest src (:$ arm::subtag-mask)))
 
@@ -1276 +1374 @@
   (uuo-error-reg-not-xtype (:? ne) object (:$ tagval)))
   
-(define-arm-vinsn subtract-constant (((dest :imm))
-                                     ((src :imm)
-                                      (const :s16const)))
+(define-arm-vinsn (subtract-constant :predicatable)
+    (((dest :imm))
+     ((src :imm)
+      (const :s16const)))
   (sub dest src (:$ const)))
 
@@ -1304 +1403 @@
 
 
-(define-arm-vinsn extract-variable-bit-fixnum (((dest :lisp))
-                                               ((src :u32)
-                                                (bitnum :u8))
-                                               ((temp :u32)))
+(define-arm-vinsn (extract-variable-bit-fixnum :predicatable)
+    (((dest :lisp))
+     ((src :u32)
+      (bitnum :u8))
+     ((temp :u32)))
   (mov temp (:lsr src bitnum))
   (mov dest (:$ arm::fixnumone))
@@ -1429 +1529 @@
   (orrne dest src (:$ (:apply ash 1 bitnum))))
 
-(define-arm-vinsn set-constant-arm-bit-to-1 (((dest :u32))
-                                             ((src :u32)
-                                              (bitnum :u8const)))
+(define-arm-vinsn (set-constant-arm-bit-to-1 :predicatable)
+    (((dest :u32))
+     ((src :u32)
+      (bitnum :u8const)))
   (orr dest src (:$ (:apply ash 1 bitnum))))
 
 
-(define-arm-vinsn set-constant-arm-bit-to-0 (((dest :u32))
-                                             ((src :u32)
-                                              (bitnum :u8const)))
+(define-arm-vinsn (set-constant-arm-bit-to-0 :predicatable)
+    (((dest :u32))
+     ((src :u32)
+      (bitnum :u8const)))
   (bic dest src (:$ (:apply ash 1 bitnum))))
 
@@ -1465 +1567 @@
 ;;; Operations on lists and cons cells
 
-(define-arm-vinsn %cdr (((dest :lisp))
-                        ((src :lisp)))
+(define-arm-vinsn (%cdr :predicatable)
+    (((dest :lisp))
+     ((src :lisp)))
   (ldr dest (:@ src (:$ arm::cons.cdr))))
 
-(define-arm-vinsn %car (((dest :lisp))
-                        ((src :lisp)))
+(define-arm-vinsn (%car :predicatable)
+    (((dest :lisp))
+     ((src :lisp)))
   (ldr dest (:@ src (:$ arm::cons.car))))
 
-(define-arm-vinsn %set-car (()
-                            ((cell :lisp)
-                             (new :lisp)))
+(define-arm-vinsn (%set-car :predicatable)
+    (()
+     ((cell :lisp)
+      (new :lisp)))
   (str cell (:@ new (:$ arm::cons.car))))
 
-(define-arm-vinsn %set-cdr (()
-                            ((cell :lisp)
-                             (new :lisp)))
+(define-arm-vinsn (%set-cdr :predicatable)
+    (()
+     ((cell :lisp)
+      (new :lisp)))
   (str cell (:@ new (:$ arm::cons.cdr))))
 
 
-(define-arm-vinsn load-adl (()
-                            ((n :u32const)))
+(define-arm-vinsn (load-adl :predicatable)
+    (()
+     ((n :u32const)))
   (mov nargs (:$ (:apply logand #x00ff0000 n)))
   ((:not (:pred = 0 (:apply logand #xff000000 n)))
@@ -1494 +1601 @@
    (orr nargs nargs (:$ (:apply logand #x000000ff n)))))
                             
-(define-arm-vinsn set-nargs (()
-                             ((n :s16const)))
+(define-arm-vinsn (set-nargs :predicatable)
+    (()
+     ((n :s16const)))
   (mov nargs (:$ (:apply ash n arm::word-shift))))
 
-(define-arm-vinsn scale-nargs (()
-                               ((nfixed :s16const)))
+(define-arm-vinsn (scale-nargs :predicatable)
+    (()
+     ((nfixed :s16const)))
   ((:pred > nfixed 0)
    (add nargs nargs (:$ (:apply - (:apply ash nfixed arm::word-shift))))))
@@ -1505 +1614 @@
 
 
-(define-arm-vinsn (vpush-register :push :node :vsp)
+(define-arm-vinsn (vpush-register :push :node :vsp :predicatable)
+    
     (()
      ((reg :lisp)))
   (str reg (:@! vsp (:$ (- arm::node-size)))))
 
-(define-arm-vinsn (vpush-register-arg :push :node :vsp :outgoing-argument)
+(define-arm-vinsn (vpush-register-arg :push :node :vsp :outgoing-argument :predicatable)
+    
     (()
      ((reg :lisp)))
   (str reg (:@! vsp (:$ (- arm::node-size)))))
 
-(define-arm-vinsn (vpush-xyz :push :node :vsp) (() ())
+(define-arm-vinsn (vpush-xyz :push :node :vsp :predicatable)
+    (() ())
   (stmdb (:! vsp) (arg_z arg_y arg_x)))
 
-(define-arm-vinsn (vpush-yz :push :node :vsp) (() ())
+(define-arm-vinsn (vpush-yz :push :node :vsp :predicatable)
+    (() ())
   (stmdb (:! vsp) (arg_z arg_y)))
 
@@ -1540 +1653 @@
 
 
-(define-arm-vinsn (vpop-register :pop :node :vsp)
+(define-arm-vinsn (vpop-register :pop :node :vsp :predicatable)
+    
     (((dest :lisp))
      ())
@@ -1557 +1671 @@
 
 
-(define-arm-vinsn copy-node-gpr (((dest :lisp))
-                                 ((src :lisp)))
+(define-arm-vinsn (copy-node-gpr :predicatable)
+    (((dest :lisp))
+     ((src :lisp)))
   ((:not (:pred =
                 (:apply %hard-regspec-value dest)
@@ -1564 +1679 @@
    (mov dest src)))
 
-(define-arm-vinsn copy-gpr (((dest t))
-                            ((src t)))
+(define-arm-vinsn (copy-gpr :predicatable)
+    (((dest t))
+     ((src t)))
   ((:not (:pred =
                 (:apply %hard-regspec-value dest)
@@ -1572 +1688 @@
 
 
-(define-arm-vinsn copy-fpr (((dest :double-float))
-                            ((src :double-float)))
+(define-arm-vinsn (double-to-double :predicatable)
+    (((dest :double-float))
+     ((src :double-float)))
   ((:not (:pred =
                 (:apply %hard-regspec-value dest)
@@ -1579 +1696 @@
    (fcpyd dest src)))
 
-(define-arm-vinsn vcell-ref (((dest :lisp))
-                             ((vcell :lisp)))
+(define-arm-vinsn (single-to-single :predicatable)
+    (((dest :single-float))
+     ((src :single-float)))
+  ((:not (:pred =
+                (:apply %hard-regspec-value dest)
+                (:apply %hard-regspec-value src)))
+   (fcpys dest src)))
+
+(define-arm-vinsn (vcell-ref :predicatable)
+    (((dest :lisp))
+     ((vcell :lisp)))
   (ldr dest (:@ vcell (:$ arm::misc-data-offset))))
 
@@ -1598 +1724 @@
   (str closed (:@ dest (:$ arm::value-cell.value))))
 
-(define-arm-vinsn make-stack-vcell (((dest :lisp))
-                                    ((closed :lisp))
-                                    ((header :u32)))
+(define-arm-vinsn (make-stack-vcell :predicatable)
+    (((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)))
@@ -1606 +1733 @@
   (add dest sp (:$ arm::fulltag-misc)))
 
-(define-arm-vinsn make-stack-cons (((dest :lisp))
-                                   ((car :lisp) (cdr :lisp))
-                                   ((header (:u32 #.arm::imm0))
-                                    (zero (:u32 #.arm::imm1))))
+(define-arm-vinsn (make-stack-cons :predicatable)
+    (((dest :lisp))
+     ((car :lisp) (cdr :lisp))
+     ((header (:u32 #.arm::imm0))
+      (zero (:u32 #.arm::imm1))))
   (mov header (:$ arm::subtag-simple-vector))
   (mov zero (:$ 0))
@@ -1626 +1754 @@
 
 
-(define-arm-vinsn %closure-code% (((dest :lisp))
-                                  ())
+(define-arm-vinsn (%closure-code% :predicatable)
+    (((dest :lisp))
+     ())
   (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)))
+(define-arm-vinsn (single-float-bits :predicatable)
+    (((dest :u32))
+     ((src :lisp)))
   (ldr dest (:@ src (:$ arm::single-float.value))))
 
@@ -1670 +1800 @@
 
 
-(define-arm-vinsn ref-interrupt-level (((dest :imm))
-                                       ()
-                                       ((temp :u32)))
+(define-arm-vinsn (ref-interrupt-level :predicatable)
+    (((dest :imm))
+     ()
+     ((temp :u32)))
   (ldr temp (:@ rcontext (:$ arm::tcr.tlb-pointer)))
   (ldr dest (:@ temp (:$ arm::INTERRUPT-LEVEL-BINDING-INDEX))))
@@ -1678 +1809 @@
                          
 ;;; Unconditional (pc-relative) branch
-(define-arm-vinsn (jump :jump) (()
-                                ((label :label)))
+(define-arm-vinsn (jump :jump :predicatable)
+    (()
+     ((label :label)))
   (b label))
 
@@ -1712 +1844 @@
 
 
-(define-arm-vinsn lisp-word-ref (((dest t))
-                                 ((base t)
-                                  (offset t)))
+(define-arm-vinsn (lisp-word-ref :predicatable)
+    (((dest t))
+     ((base t)
+      (offset t)))
   (ldr dest (:@ base offset)))
 
-(define-arm-vinsn lisp-word-ref-c (((dest t))
-                                   ((base t)
-                                    (offset :s16const)))
+(define-arm-vinsn (lisp-word-ref-c :predicatable)
+    (((dest t))
+     ((base t)
+      (offset :s16const)))
   (ldr dest (:@ base (:$ offset))))
 
@@ -1725 +1859 @@
 
 ;; Load an unsigned, 32-bit constant into a destination register.
-(define-arm-vinsn (lri :constant-ref) (((dest :imm))
-                                       ((intval :u32const))
-                                       ())
+(define-arm-vinsn (lri :constant-ref :predicatable)
+    (((dest :imm))
+     ((intval :u32const))
+     ())
   ((:pred arm::encode-arm-immediate intval)
    (mov dest (:$ intval)))
@@ -1751 +1886 @@
 
 
-(define-arm-vinsn alloc-eabi-c-frame (()
-                                      ((n-c-args :u16const))
-                                      ((header :u32)
-                                       (size :imm)
-                                       (prevsp :imm)))
+(define-arm-vinsn (alloc-eabi-c-frame :predicatable)
+    (()
+     ((n-c-args :u16const))
+     ((header :u32)
+      (size :imm)
+      (prevsp :imm)))
   (mov header (:$ (:apply ash (:apply + 1 (:apply logandc2 (:apply + 4 4 1 n-c-args) 1)) arm::num-subtag-bits)))
   (mov size (:lsr header (:$ (- arm::num-subtag-bits arm::word-shift))))
@@ -1764 +1900 @@
   (str prevsp (:@ sp (:$ 4))))
 
-(define-arm-vinsn alloc-variable-c-frame (()
-                                          ((n-c-args :lisp))
-                                          ((header :u32)
-                                           (size :imm)
-                                           (prevsp :imm)))
+(define-arm-vinsn (alloc-variable-c-frame :predicatable)
+    (()
+     ((n-c-args :lisp))
+     ((header :u32)
+      (size :imm)
+      (prevsp :imm)))
   (add size n-c-args (:$ (ash (+ 4 1) arm::word-shift)))
   (bic size size (:$ arm::fixnumone))
@@ -1785 +1922 @@
 ;;; might as well exploit the fact that we stored the previous sp at
 ;;; offset 4 in the C frame.
-(define-arm-vinsn (discard-c-frame :csp :pop :discard) (()
-                                                        ())
+(define-arm-vinsn (discard-c-frame :csp :pop :discard :predicatable)
+    (()
+     ())
   (ldr sp (:@ sp (:$ 4))))
 
 
-(define-arm-vinsn gpr-to-single-float (((dest :single-float))
-                                       ((src :u32)))
+(define-arm-vinsn (gpr-to-single-float :predicatable)
+    (((dest :single-float))
+     ((src :u32)))
   (fmsr dest src))
 
-(define-arm-vinsn gpr-pair-to-double-float (((dest :double-float))
-                                            ((low :u32)
-                                             (high :u32)))
+(define-arm-vinsn (gpr-pair-to-double-float :predicatable)
+    (((dest :double-float))
+     ((low :u32)
+      (high :u32)))
   (fmdrr dest low high))
 
 
-(define-arm-vinsn set-eabi-c-arg (()
-                             ((argval :u32)
-                              (argnum :u16const)))
+(define-arm-vinsn (set-eabi-c-arg :predicatable)
+    (()
+     ((argval :u32)
+      (argnum :u16const)))
   (str argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
 
 
-(define-arm-vinsn set-single-eabi-c-arg (()
-                                    ((argval :single-float)
-                                     (argnum :u16const)))
+(define-arm-vinsn (set-single-eabi-c-arg :predicatable)
+    (()
+     ((argval :single-float)
+      (argnum :u16const)))
   (fsts argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
 
-(define-arm-vinsn set-double-eabi-c-arg (()
-                                         ((argval :double-float)
-                                          (argnum :u16const)))
+(define-arm-vinsn (set-double-eabi-c-arg :predicatable)
+    (()
+     ((argval :double-float)
+      (argnum :u16const)))
   (fstd argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
 
 
 
-(define-arm-vinsn (load-nil :constant-ref) (((dest t))
-                                            ())
+(define-arm-vinsn (load-nil :constant-ref :predicatable)
+    (((dest t))
+     ())
   (mov dest (:$ arm::nil-value)))
 
-(define-arm-vinsn (load-t :constant-ref) (((dest t))
-                                          ())
+(define-arm-vinsn (load-t :constant-ref :predicatable)
+    (((dest t))
+     ())
   (mov dest (:$ arm::nil-value))
   (add dest dest (:$ arm::t-offset)))
@@ -1829 +1974 @@
 
 
-(define-arm-vinsn (ref-constant :constant-ref) (((dest :lisp))
-                                                ((src :s16const)))
+(define-arm-vinsn (ref-constant :constant-ref :predicatable)
+    (((dest :lisp))
+     ((src :s16const)))
   (ldr dest (:@ fn (:$ (:apply + arm::misc-data-offset (:apply ash (:apply + src 2) 2))))))
 
-(define-arm-vinsn ref-indexed-constant (((dest :lisp))
-                                        ((idxreg :s32)))
+(define-arm-vinsn (ref-indexed-constant :predicatable)
+    (((dest :lisp))
+     ((idxreg :s32)))
   (ldr dest (:@ arm::fn idxreg)))
 
@@ -1915 +2062 @@
   (bic allocptr allocptr (:$ arm::fulltagmask)))
 
-(define-arm-vinsn (vstack-discard :vsp :pop :discard) (()
-                                                       ((nwords :u32const)))
+(define-arm-vinsn (vstack-discard :vsp :pop :discard :predicatable)
+    (()
+     ((nwords :u32const)))
   ((:not (:pred = nwords 0))
    (add vsp vsp (:$ (:apply ash nwords arm::word-shift)))))
 
 
-(define-arm-vinsn lcell-load (((dest :lisp))
-                              ((cell :lcell)
-                               (top :lcell)))
+(define-arm-vinsn (lcell-load :predicatable)
+    (((dest :lisp))
+     ((cell :lcell)
+      (top :lcell)))
   (ldr dest (:@ vsp (:$ (:apply - 
-                    (:apply - (:apply calc-lcell-depth top) 4)
-                    (:apply calc-lcell-offset cell))))))
-
-(define-arm-vinsn vframe-load (((dest :lisp))
-                               ((frame-offset :u16const)
-                                (cur-vsp :u16const)))
+                                (:apply - (:apply calc-lcell-depth top) 4)
+                                (:apply calc-lcell-offset cell))))))
+
+(define-arm-vinsn (vframe-load :predicatable)
+    (((dest :lisp))
+     ((frame-offset :u16const)
+      (cur-vsp :u16const)))
   (ldr dest (:@ vsp (:$ (:apply - (:apply - cur-vsp 4) frame-offset)))))
 
-(define-arm-vinsn lcell-store (()
-                               ((src :lisp)
-                                (cell :lcell)
-                                (top :lcell)))
+(define-arm-vinsn (lcell-store :predicatable)
+    (()
+     ((src :lisp)
+      (cell :lcell)
+      (top :lcell)))
   (str src (:@ vsp (:$ (:apply - 
-                   (:apply - (:apply calc-lcell-depth top) 4)
-                   (:apply calc-lcell-offset cell))))))
-
-(define-arm-vinsn vframe-store (()
-                                ((src :lisp)
-                                 (frame-offset :u16const)
-                                 (cur-vsp :u16const)))
+                               (:apply - (:apply calc-lcell-depth top) 4)
+                               (:apply calc-lcell-offset cell))))))
+
+(define-arm-vinsn (vframe-store :predicatable)
+    (()
+     ((src :lisp)
+      (frame-offset :u16const)
+      (cur-vsp :u16const)))
   (str src (:@ vsp (:$ (:apply - (:apply - cur-vsp 4) frame-offset)))))
 
-(define-arm-vinsn load-vframe-address (((dest :imm))
-                                       ((offset :s16const)))
+(define-arm-vinsn (load-vframe-address :predicatable)
+    (((dest :imm))
+     ((offset :s16const)))
   (add dest vsp (:$ offset)))
 
-(define-arm-vinsn copy-lexpr-argument (()
-                                       ()
-                                       ((temp :lisp)))
+(define-arm-vinsn (copy-lexpr-argument :predicatable)
+    (()
+     ()
+     ((temp :lisp)))
   (ldr temp (:@ vsp nargs))
   (str temp (:@! vsp (:$ (- arm::node-size)))))
@@ -1960 +2114 @@
 
 ;;; Treat the low 8 bits of VAL as an unsigned integer; set RESULT to the equivalent fixnum.
-(define-arm-vinsn u8->fixnum (((result :imm)) 
-                              ((val :u8)) 
-                              ())
+(define-arm-vinsn (u8->fixnum :predicatable)
+    (((result :imm)) 
+     ((val :u8)) 
+     ())
   (mov result (:lsl val (:$ 24)))
   (mov result (:lsr result (:$ (- 24 arm::fixnumshift)))))
 
 ;;; Treat the low 8 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
-(define-arm-vinsn s8->fixnum (((result :imm)) 
-                              ((val :s8)) 
-                              ())
+(define-arm-vinsn (s8->fixnum :predicatable)
+    (((result :imm)) 
+     ((val :s8)) 
+     ())
   (mov result (:lsr val (:$ 24)))
   (mov result (:asr val (:$ (- 24 arm::fixnumshift)))))
@@ -1975 +2131 @@
 
 ;;; Treat the low 16 bits of VAL as an unsigned integer; set RESULT to the equivalent fixnum.
-(define-arm-vinsn u16->fixnum (((result :imm)) 
-                               ((val :u16)) 
-                               ())
+(define-arm-vinsn (u16->fixnum :predicatable)
+    (((result :imm)) 
+     ((val :u16)) 
+     ())
   (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.
-(define-arm-vinsn s16->fixnum (((result :imm)) 
-                               ((val :s16)) 
-                               ())
+(define-arm-vinsn (s16->fixnum :predicatable)
+    (((result :imm)) 
+     ((val :s16)) 
+     ())
   (mov result (:lsl val (:$ 16)))
   (mov result (:asr result (:$ (- 16 arm::fixnumshift)))))
 
-(define-arm-vinsn fixnum->s16 (((result :s16))
-                               ((src :imm)))
+(define-arm-vinsn (fixnum->s16 :predicatable)
+    (((result :s16))
+     ((src :imm)))
   (mov result (:asr src (:$ arm::fixnumshift))))
 
@@ -2038 +2197 @@
   :done)
 
-(define-arm-vinsn u16->u32 (((dest :u32))
-                            ((src :u16)))
+(define-arm-vinsn (u16->u32 :predicatable)
+    (((dest :u32))
+     ((src :u16)))
   (mov dest (:$ #xff))
   (orr dest dest (:$ #xff00))
   (and dest dest src))
 
-(define-arm-vinsn u8->u32 (((dest :u32))
-                           ((src :u8)))
+(define-arm-vinsn (u8->u32 :predicatable)
+    (((dest :u32))
+     ((src :u8)))
   (and dest src (:$ #xff)))
 
 
-(define-arm-vinsn s16->s32 (((dest :s32))
-                            ((src :s16)))
+(define-arm-vinsn (s16->s32 :predicatable)
+    (((dest :s32))
+     ((src :s16)))
   (mov dest (:lsl src (:$ 16)))
   (mov dest (:asr src (:$ 16))))
 
-(define-arm-vinsn s8->s32 (((dest :s32))
-                           ((src :s8)))
+(define-arm-vinsn (s8->s32 :predicatable)
+    (((dest :s32))
+     ((src :s8)))
   (mov dest (:lsl src (:$ 24)))
   (mov dest (:asr src (:$ 24))))
@@ -2103 +2266 @@
 
 ;;; "dest" is preallocated, presumably on a stack somewhere.
-(define-arm-vinsn store-double (()
-                                ((dest :lisp)
-                                 (source :double-float))
-                                ((low (:u32 #.arm::imm0))
-                                 (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (store-double :predicatable)
+    (()
+     ((dest :lisp)
+      (source :double-float))
+     ((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))
-                              ((low (:u32 #.arm::imm0))
-                               (high (:u32 #.arm::imm1))))
+(define-arm-vinsn (get-double :predicatable)
+    (((target :double-float))
+     ((source :lisp))
+     ((low (:u32 #.arm::imm0))
+      (high (:u32 #.arm::imm1))))
   (ldrd low (:@ source (:$ arm::double-float.value)))
   (fmdrr target low high))
@@ -2139 +2304 @@
   (fcvtsd result arg))
 
-(define-arm-vinsn store-single (()
-                                ((dest :lisp)
-                                 (source :single-float))
-                                ((temp :u32)))
+(define-arm-vinsn double-to-single (((result :double-float))
+                                    ((arg :single-float)))
+  (fcvtds result arg))
+
+(define-arm-vinsn (store-single :predicatable)
+    (()
+     ((dest :lisp)
+      (source :single-float))
+     ((temp :u32)))
   (fmrs temp source)
   (str temp (:@ dest (:$ arm::single-float.value))))
 
-(define-arm-vinsn get-single (((target :single-float))
-                              ((source :lisp))
-                              ((temp :u32)))
+(define-arm-vinsn (get-single :predicatable)
+    (((target :single-float))
+     ((source :lisp))
+     ((temp :u32)))
   (ldr temp (:@ source (:$ arm::single-float.value)))
   (fmsr target temp))
@@ -2155 +2326 @@
 
 
-(define-arm-vinsn character->fixnum (((dest :lisp))
-                                     ((src :lisp))
-                                     ())
+(define-arm-vinsn (character->fixnum :predicatable)
+    (((dest :lisp))
+     ((src :lisp))
+     ())
   (bic dest src (:$ arm::subtag-mask))
   (mov dest (:lsr dest (:$ (- arm::charcode-shift arm::fixnumshift)))))
 
-(define-arm-vinsn character->code (((dest :u32))
-                                   ((src :lisp)))
+(define-arm-vinsn (character->code :predicatable)
+    (((dest :u32))
+     ((src :lisp)))
   (mov dest (:lsr src (:$ arm::charcode-shift))))
 
@@ -2183 +2356 @@
 
 ;;; src is known to be a code for which CODE-CHAR returns non-nil.
-(define-arm-vinsn code-char->char (((dest :lisp))
-                                   ((src :imm))
-                                   ())
+(define-arm-vinsn (code-char->char :predicatable)
+    (((dest :lisp))
+     ((src :imm))
+     ())
   (mov dest (:lsl src (:$ (- arm::charcode-shift arm::fixnum-shift))))
   (orr dest dest (:$ arm::subtag-character)))
 
-(define-arm-vinsn u32->char (((dest :lisp))
-                             ((src :u32))
-                             ())
+(define-arm-vinsn (u32->char :predicatable)
+    (((dest :lisp))
+     ((src :u32))
+     ())
   (mov dest (:lsl src (:$ arm::charcode-shift)))
   (orr dest dest (:$ arm::subtag-character)))
@@ -2197 +2372 @@
 ;; ... Macptrs ...
 
-(define-arm-vinsn deref-macptr (((addr :address))
-                                ((src :lisp))
-                                ())
+(define-arm-vinsn (deref-macptr :predicatable)
+    (((addr :address))
+     ((src :lisp))
+     ())
   (ldr addr (:@ src (:$ arm::macptr.address))))
 
-(define-arm-vinsn set-macptr-address (()
-                                      ((addr :address)
-                                       (src :lisp))
-                                      ())
+(define-arm-vinsn (set-macptr-address :predicatable)
+    (()
+     ((addr :address)
+      (src :lisp))
+     ())
   (str addr (:@ src (:$ arm::macptr.address))))
 
@@ -2225 +2402 @@
   (str address (:@ dest (:$ arm::macptr.address))))
 
-(define-arm-vinsn macptr->stack (((dest :lisp))
-                                 ((address :address))
-                                 ((header :u32)))
+(define-arm-vinsn (macptr->stack :predicatable)
+    (((dest :lisp))
+     ((address :address))
+     ((header :u32)))
   (mov header (:$ arm::subtag-macptr))
   (orr header header (:$ (ash arm::macptr.element-count arm::num-subtag-bits)))
@@ -2239 +2417 @@
 
   
-(define-arm-vinsn adjust-stack-register (()
-                                         ((reg t)
-                                          (amount :s16const)))
+(define-arm-vinsn (adjust-stack-register :predicatable)
+    (()
+     ((reg t)
+      (amount :s16const)))
   (add reg reg (:$ amount)))
 
-(define-arm-vinsn adjust-vsp (()
-                              ((amount :s16const)))
+(define-arm-vinsn (adjust-vsp :predicatable)
+    (()
+     ((amount :s16const)))
   (add vsp vsp (:$ amount)))
 
-(define-arm-vinsn adjust-sp (()
-                             ((amount :s16const)))
+(define-arm-vinsn (adjust-sp :predicatable)
+    (()
+     ((amount :s16const)))
   (add sp sp (:$ amount)))
 
 ;; Arithmetic on fixnums & unboxed numbers
 
-(define-arm-vinsn u32-lognot (((dest :u32))
-                              ((src :u32))
-                              ())
+(define-arm-vinsn (u32-lognot :predicatable)
+    (((dest :u32))
+     ((src :u32))
+     ())
   (mvn dest src))
 
-(define-arm-vinsn fixnum-lognot (((dest :imm))
-                                 ((src :imm))
-                                 ((temp :u32)))
+(define-arm-vinsn (fixnum-lognot :predicatable)
+    (((dest :imm))
+     ((src :imm))
+     ((temp :u32)))
   (mvn temp src)
   (bic dest temp (:$ arm::fixnummask)))
@@ -2294 +2477 @@
                                                   
                                        
-(define-arm-vinsn negate-fixnum-no-ovf (((dest :lisp))
-                                        ((src :imm)))
+(define-arm-vinsn (negate-fixnum-no-ovf :predicatable)
+    (((dest :lisp))
+     ((src :imm)))
   
   (rsb dest src (:$ 0)))
   
 
-(define-arm-vinsn logior-immediate (((dest :imm))
-                               ((src :imm)
-                                (imm :u32const)))
+(define-arm-vinsn (logior-immediate :predicatable)
+    (((dest :imm))
+     ((src :imm)
+      (imm :u32const)))
   (orr dest src (:$ imm)))
 
                            
                            
-(define-arm-vinsn %logior2 (((dest :imm))
-                            ((x :imm)
-                             (y :imm))
-                            ())
+(define-arm-vinsn (%logior2 :predicatable)
+    (((dest :imm))
+     ((x :imm)
+      (y :imm))
+     ())
   (orr dest x y))
 
-(define-arm-vinsn logand-immediate (((dest :imm))
-                               ((src :imm)
-                                (imm :u32const)))
+(define-arm-vinsn (logand-immediate :predicatable)
+    (((dest :imm))
+     ((src :imm)
+      (imm :u32const)))
   (and dest src (:$ imm)))
 
 
-(define-arm-vinsn %logand2 (((dest :imm))
-                            ((x :imm)
-                             (y :imm))
-                            ())
+(define-arm-vinsn (%logand2 :predicatable)
+    (((dest :imm))
+     ((x :imm)
+      (y :imm))
+     ())
   (and dest x y))
 
-(define-arm-vinsn logxor-immediate (((dest :imm))
-                                    ((src :imm)
-                                     (imm :u32const)))
+(define-arm-vinsn (logxor-immediate :predicatable)
+    (((dest :imm))
+     ((src :imm)
+      (imm :u32const)))
   (eor dest src (:$ imm)))
                                     
@@ -2333 +2522 @@
                                
 
-(define-arm-vinsn %logxor2 (((dest :imm))
-                            ((x :imm)
-                             (y :imm))
-                            ())
+(define-arm-vinsn (%logxor2 :predicatable)
+    (((dest :imm))
+     ((x :imm)
+      (y :imm))
+     ())
   (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)))
+(define-arm-vinsn (%ilsl :predicatable)
+    (((dest :imm))
+     ((count :imm)
+      (src :imm))
+     ((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)))
+(define-arm-vinsn (%ilsl-c :predicatable)
+    (((dest :imm))
+     ((count :u8const)
+      (src :imm)))
   ((:pred = count 0)
    (mov dest src))
@@ -2357 +2549 @@
 
 
-(define-arm-vinsn %ilsr-c (((dest :imm))
-                           ((count :u8const)
-                            (src :imm))
-                           ((temp :s32)))
+(define-arm-vinsn (%ilsr-c :predicatable)
+    (((dest :imm))
+     ((count :u8const)
+      (src :imm))
+     ((temp :s32)))
   (mov temp (:lsr src (:$ count)))
   (bic dest temp (:$ arm::fixnummask)))
 
 
-(define-arm-vinsn %iasr (((dest :imm))
-                         ((count :imm)
-                          (src :imm))
-                         ((temp :s32)))
+(define-arm-vinsn (%iasr :predicatable)
+    (((dest :imm))
+     ((count :imm)
+      (src :imm))
+     ((temp :s32)))
   (mov temp (:asr count (:$ arm::fixnumshift)))
   (mov temp (:asr src temp))
@@ -2383 +2577 @@
    (bic dest temp (:$ arm::fixnummask))))
 
-(define-arm-vinsn %ilsr (((dest :imm))
-                         ((count :imm)
-                          (src :imm))
-                         ((temp :s32)))
+(define-arm-vinsn (%ilsr :predicatable)
+    (((dest :imm))
+     ((count :imm)
+      (src :imm))
+     ((temp :s32)))
   (mov temp (:asr count (:$ arm::fixnumshift)))
   (mov temp (:lsr src temp))
@@ -2392 +2587 @@
 
 
-(define-arm-vinsn %ilsr-c (((dest :imm))
-                           ((count :u8const)
-                            (src :imm))
-                           ((temp :s32)))
+(define-arm-vinsn (%ilsr-c :predicatable)
+    (((dest :imm))
+     ((count :u8const)
+      (src :imm))
+     ((temp :s32)))
   ((:pred = count 0)
    (mov dest src))
@@ -2402 +2598 @@
    (bic dest temp (:$ arm::fixnummask))))
 
-(define-arm-vinsn natural-shift-left (((dest :u32))
-                                      ((src :u32)
-                                       (count :u8const)))
+(define-arm-vinsn (natural-shift-left :predicatable)
+    (((dest :u32))
+     ((src :u32)
+      (count :u8const)))
   ((:pred = count 0)
    (mov dest src))
@@ -2410 +2607 @@
    (mov dest (:lsl src (:$ count)))))
 
-(define-arm-vinsn natural-shift-right (((dest :u32))
-                                       ((src :u32)
-                                        (count :u8const)))
+(define-arm-vinsn (natural-shift-right :predicatable)
+    (((dest :u32))
+     ((src :u32)
+      (count :u8const)))
   ((:pred = count 0)
    (mov dest src))
@@ -2464 +2662 @@
   
   
-(define-arm-vinsn sign-extend-halfword (((dest :imm))
-                                        ((src :imm)))
+(define-arm-vinsn (sign-extend-halfword :predicatable)
+    (((dest :imm))
+     ((src :imm)))
   (mov dest (:lsl src (:$ (- 16 arm::fixnumshift))))
   (mov dest (:asr dest (:$ (- 16 arm::fixnumshift)))))
@@ -2472 +2671 @@
                             
 
-(define-arm-vinsn fixnum-add (((dest t))
-                              ((x t)
-                               (y t)))
+(define-arm-vinsn (fixnum-add :predicatable)
+    (((dest t))
+     ((x t)
+      (y t)))
   (add dest x y))
 
@@ -2532 +2732 @@
 
 ;;;  (setq dest (- x y))
-(define-arm-vinsn fixnum-sub (((dest t))
-                              ((x t)
-                               (y t)))
+(define-arm-vinsn (fixnum-sub :predicatable)
+    (((dest t))
+     ((x t)
+      (y t)))
   (sub dest x y))
 
-(define-arm-vinsn fixnum-sub-from-constant (((dest :imm))
-                                            ((x :s16const)
-                                             (y :imm)))
+(define-arm-vinsn (fixnum-sub-from-constant :predicatable)
+    (((dest :imm))
+     ((x :s16const)
+      (y :imm)))
   (rsb dest y (:$ (:apply ash x arm::fixnumshift))))
 
@@ -2596 +2798 @@
 
 ;;; This is, of course, also "subtract-immediate."
-(define-arm-vinsn add-immediate (((dest t))
-                                 ((src t)
-                                  (imm :s32const)))
+(define-arm-vinsn (add-immediate :predicatable)
+    (((dest t))
+     ((src t)
+      (imm :s32const)))
   (add dest src (:$ imm)))
 
-(define-arm-vinsn multiply-fixnums (((dest :imm))
-                                    ((a :imm)
-                                     (b :imm))
-                                    ((unboxed :s32)))
+(define-arm-vinsn (multiply-fixnums :predicatable)
+    (((dest :imm))
+     ((a :imm)
+      (b :imm))
+     ((unboxed :s32)))
   (mov unboxed (:asr b (:$ arm::fixnumshift)))
   (mul dest a unboxed))
@@ -2612 +2816 @@
 ;;; Mask out the code field of a base character; the result
 ;;; should be EXACTLY = to subtag-base-char
-(define-arm-vinsn mask-base-char (((dest :u32))
-                                  ((src :imm)))
+(define-arm-vinsn (mask-base-char :predicatable)
+    (((dest :u32))
+     ((src :imm)))
   (and dest src (:$ arm::subtag-mask)))
 
@@ -2687 +2892 @@
   (uuo-error-udf (:? ne) sym))
 
-(define-arm-vinsn (temp-push-unboxed-word :push :word :sp)
+(define-arm-vinsn (temp-push-unboxed-word :push :word :sp :predicatable)
+    
     (()
      ((w :u32))
@@ -2696 +2902 @@
   (str w (:@ sp (:$ 4))))
 
-(define-arm-vinsn (temp-pop-unboxed-word :pop :word :sp)
+(define-arm-vinsn (temp-pop-unboxed-word :pop :word :sp :predicatable)
+    
     (((w :u32))
      ())
@@ -2702 +2909 @@
   (add sp sp (:$ arm::dnode-size)))
 
-(define-arm-vinsn (temp-push-double-float :push :doubleword :sp)
+(define-arm-vinsn (temp-push-double-float :push :doubleword :sp :predicatable)
+    
     (()
      ((d :double-float))
@@ -2711 +2919 @@
   (fstd d (:@ sp (:$ 8))))
 
-(define-arm-vinsn (temp-pop-double-float :pop :doubleword :sp)
+(define-arm-vinsn (temp-pop-double-float :pop :doubleword :sp :predicatable)
+    
     (()
      ((d :double-float)))
@@ -2718 +2927 @@
 
 
-(define-arm-vinsn (temp-push-single-float :push :word :tsp)
+(define-arm-vinsn (temp-push-single-float :push :word :tsp :predicatable)
+    
     (()
      ((s :single-float))
@@ -2728 +2938 @@
 
 
-(define-arm-vinsn (temp-pop-single-float :pop :word :sp)
+(define-arm-vinsn (temp-pop-single-float :pop :word :sp :predicatable)
+    
     (()
      ((s :single-float)))
@@ -2736 +2947 @@
 
 
-(define-arm-vinsn %current-frame-ptr (((dest :imm))
-                                      ())
+(define-arm-vinsn (%current-frame-ptr :predicatable)
+    (((dest :imm))
+     ())
   (mov dest arm::sp))
 
-(define-arm-vinsn %current-tcr (((dest :imm))
-                                ())
+(define-arm-vinsn (%current-tcr :predicatable)
+    (((dest :imm))
+     ())
   (mov dest rcontext))
 
@@ -2753 +2966 @@
    (bl .SPunbind)))
 
-(define-arm-vinsn zero-double-float-register (((dest :double-float))
-                                              ()
-                                              ((low (:u32 #.arm::imm0))))
+(define-arm-vinsn (zero-double-float-register :predicatable)
+    (((dest :double-float))
+     ()
+     ((low (:u32 #.arm::imm0))))
   (mov low (:$ 0))
   (fmdrr dest low low))
 
-(define-arm-vinsn zero-single-float-register (((dest :single-float))
-                                              ()
-                                              ((temp :imm)))
+(define-arm-vinsn (zero-single-float-register :predicatable)
+    (((dest :single-float))
+     ()
+     ((temp :imm)))
   (mov temp (:$ 0))
   (fmsr dest temp))
 
-(define-arm-vinsn load-double-float-constant (((dest :double-float))
-                                              ((high :u32)
-                                               (low :u32)))
+(define-arm-vinsn (load-double-float-constant :predicatable)
+    (((dest :double-float))
+     ((high :u32)
+      (low :u32)))
   (fmdrr dest low high))
 
-(define-arm-vinsn load-single-float-constant    (((dest :single-float))
-                                                 ((src t)))
+(define-arm-vinsn (load-single-float-constant :predicatable)
+    (((dest :single-float))
+     ((src t)))
   (fmsr dest src))
 
-(define-arm-vinsn load-indexed-node (((node :lisp))
-                                     ((base :lisp)
-                                      (offset :s16const)))
+(define-arm-vinsn (load-indexed-node :predicatable)
+    (((node :lisp))
+     ((base :lisp)
+      (offset :s16const)))
   (ldr node (:@ base (:$ offset))))
 
@@ -2915 +3133 @@
 
 
-(define-arm-vinsn (jump-return-pc :jumpLR)
+(define-arm-vinsn (jump-return-pc :jumpLR :predicatable)
     (()
      ())
   (bx lr))
 
-(define-arm-vinsn (restore-full-lisp-context :lispcontext :pop :csp :lrRestore)
+(define-arm-vinsn (restore-full-lisp-context :lispcontext :pop :csp :lrRestore :predicatable)
     (()
      ())
@@ -2929 +3147 @@
 
 
-(define-arm-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
+(define-arm-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR :predicatable)
     (() 
      ())
@@ -3048 +3266 @@
   (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
 
-(define-arm-vinsn %schar8 (((char :imm))
-                           ((str :lisp)
-                            (idx :imm))
-                           ((imm :u32)))
+(define-arm-vinsn (%schar8 :predicatable)
+    (((char :imm))
+     ((str :lisp)
+      (idx :imm))
+     ((imm :u32)))
   (mov imm (:lsr idx (:$ arm::fixnumshift)))
   (add imm imm (:$ arm::misc-data-offset))
@@ -3058 +3277 @@
   (orr char imm (:$ arm::subtag-character)))
 
-(define-arm-vinsn %schar32 (((char :imm))
-                            ((str :lisp)
-                             (idx :imm))
-                            ((imm :u32)))
+(define-arm-vinsn (%schar32 :predicatable)
+    (((char :imm))
+     ((str :lisp)
+      (idx :imm))
+     ((imm :u32)))
   (add imm idx (:$ arm::misc-data-offset))
   (ldr imm (:@ str imm))
@@ -3068 +3288 @@
 
 
-(define-arm-vinsn %set-schar8 (()
-                               ((str :lisp)
-                                (idx :imm)
-                                (char :imm))
-                               ((imm :u32)
-                                (imm1 :u32)))
+(define-arm-vinsn (%set-schar8 :predicatable)
+    (()
+     ((str :lisp)
+      (idx :imm)
+      (char :imm))
+     ((imm :u32)
+      (imm1 :u32)))
   (mov imm (:lsr idx (:$ arm::fixnumshift)))
   (add imm imm (:$ arm::misc-data-offset))
@@ -3079 +3300 @@
   (strb imm1 (:@ str imm)))
 
-(define-arm-vinsn %set-schar32 (()
-                                ((str :lisp)
-                                 (idx :imm)
-                                 (char :imm))
-                                ((imm :u32)
-                                 (imm1 :u32)))
+(define-arm-vinsn (%set-schar32 :predicatable)
+    (()
+     ((str :lisp)
+      (idx :imm)
+      (char :imm))
+     ((imm :u32)
+      (imm1 :u32)))
   (add imm idx (:$ arm::misc-data-offset))
   (mov imm1 (:lsr char (:$ arm::charcode-shift)))
   (str imm1 (:@ str imm)))
 
-(define-arm-vinsn %set-scharcode8 (()
-                                   ((str :lisp)
-                                    (idx :imm)
-                                    (code :imm))
-                                   ((imm :u32)
-                                    (imm1 :u32)))
+(define-arm-vinsn (%set-scharcode8 :predicatable)
+    (()
+     ((str :lisp)
+      (idx :imm)
+      (code :imm))
+     ((imm :u32)
+      (imm1 :u32)))
   (mov imm (:lsr idx (:$ arm::fixnumshift)))
   (add imm imm (:$ arm::misc-data-offset))
@@ -3101 +3324 @@
 
 
-(define-arm-vinsn %set-scharcode32 (()
-                                    ((str :lisp)
-                                     (idx :imm)
-                                     (code :imm))
-                                    ((imm :u32)
-                                     (imm1 :u32)))
+(define-arm-vinsn (%set-scharcode32 :predicatable)
+    (()
+     ((str :lisp)
+      (idx :imm)
+      (code :imm))
+     ((imm :u32)
+      (imm1 :u32)))
   (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)))
+(define-arm-vinsn (%scharcode8 :predicatable)
+    (((code :imm))
+     ((str :lisp)
+      (idx :imm))
+     ((imm :u32)))
   (mov imm (:lsr idx (:$ arm::fixnumshift)))
   (add imm imm (:$ arm::misc-data-offset))
@@ -3120 +3345 @@
   (mov code (:lsl imm (:$ arm::fixnumshift))))
 
-(define-arm-vinsn %scharcode32 (((code :imm))
-                                ((str :lisp)
-                                 (idx :imm))
-                                ((imm :u32)))
+(define-arm-vinsn (%scharcode32 :predicatable)
+    (((code :imm))
+     ((str :lisp)
+      (idx :imm))
+     ((imm :u32)))
   (add imm idx (:$ arm::misc-data-offset))
   (ldr imm (:@ str imm))
@@ -3140 +3366 @@
   (uuo-eep-unresolved (:? eq) dest src))
                  
-(define-arm-vinsn %natural+ (((dest :u32))
-                             ((x :u32) (y :u32)))
+(define-arm-vinsn (%natural+ :predicatable)
+    (((dest :u32))
+     ((x :u32) (y :u32)))
   (add dest x y))
 
-(define-arm-vinsn %natural+-c (((dest :u32))
-                               ((x :u32) (y :u16const)))
+(define-arm-vinsn (%natural+-c :predicatable)
+    (((dest :u32))
+     ((x :u32) (y :u16const)))
   (add dest x (:$ y)))
 
-(define-arm-vinsn %natural- (((dest :u32))
-                             ((x :u32) (y :u32)))
+(define-arm-vinsn (%natural- :predicatable)
+    (((dest :u32))
+     ((x :u32) (y :u32)))
   (sub dest x y))
 
-(define-arm-vinsn %natural--c (((dest :u32))
-                               ((x :u32) (y :u16const)))
+(define-arm-vinsn (%natural--c :predicatable)
+    (((dest :u32))
+     ((x :u32) (y :u16const)))
   (sub dest x (:$ y)))
 
-(define-arm-vinsn %natural-logior (((dest :u32))
-                                   ((x :u32) (y :u32)))
+(define-arm-vinsn (%natural-logior :predicatable)
+    (((dest :u32))
+     ((x :u32) (y :u32)))
   (orr dest x y))
 
-(define-arm-vinsn %natural-logior-c (((dest :u32))
-                                     ((x :u32) (c :u32const)))
+(define-arm-vinsn (%natural-logior-c :predicatable)
+    (((dest :u32))
+     ((x :u32) (c :u32const)))
   (orr dest x (:$ c)))
 
-(define-arm-vinsn %natural-logxor (((dest :u32))
-                                   ((x :u32) (y :u32)))
+(define-arm-vinsn (%natural-logxor :predicatable)
+    (((dest :u32))
+     ((x :u32) (y :u32)))
   (eor dest x y))
 
-(define-arm-vinsn %natural-logxor-c (((dest :u32))
-                                     ((x :u32) (c :u32const)))
+(define-arm-vinsn (%natural-logxor-c :predicatable)
+    (((dest :u32))
+     ((x :u32) (c :u32const)))
   (eor dest x (:$ c)))
 
-(define-arm-vinsn %natural-logand (((dest :u32))
-                                   ((x :u32) (y :u32)))
+(define-arm-vinsn (%natural-logand :predicatable)
+    (((dest :u32))
+     ((x :u32) (y :u32)))
   (and dest x y))
 
@@ -3199 +3434 @@
 
 
-(define-arm-vinsn disable-interrupts (((dest :lisp))
-                                      ()
-                                      ((temp :imm)
-                                       (temp2 :imm)))
+(define-arm-vinsn (disable-interrupts :predicatable)
+    (((dest :lisp))
+     ()
+     ((temp :imm)
+      (temp2 :imm)))
   (ldr temp2 (:@ rcontext (:$ arm::tcr.tlb-pointer)))
   (mov temp (:$ -4))
@@ -3208 +3444 @@
   (str temp (:@ temp2 (:$ arm::interrupt-level-binding-index))))
 
-(define-arm-vinsn load-character-constant (((dest :lisp))
-                                           ((code :u32const)))
+(define-arm-vinsn (load-character-constant :predicatable)
+    (((dest :lisp))
+     ((code :u32const)))
   (mov dest (:$ arm::subtag-character))
   ((:pred logtest #xff code)
@@ -3274 +3511 @@
 (define-arm-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
 
-(define-arm-vinsn (tail-funcall-vsp :jumpLR) (() ())
+(define-arm-vinsn (tail-funcall-vsp :jumpLR :predicatable) (() ())
   (ldmia (:! sp) (imm0 vsp fn lr))
   (ba .SPfuncall))
@@ -3487 +3724 @@
   (uuo-interrupt-now (:? ne))
   :done)
+
+(define-arm-vinsn test-fixnum  (((dest :crf))
+                                ((src :lisp)))
+  (tst src (:$ arm::fixnummask)))
+                  
   
 

branches/arm/compiler/ARM/arm2.lisp

@@ -35 +35 @@
 (defparameter *arm2-half-fixnum-type* '(signed-byte 29))
 (defparameter *arm2-target-half-fixnum-type* nil)
+(defparameter *arm2-operator-supports-u8-target* ())
+
 
 
@@ -49 +51 @@
      ,@body))
 
+
+(defun arm2-emit-vinsn (vlist name vinsn-table &rest vregs)
+  (arm2-update-regmap (apply #'%emit-vinsn vlist name vinsn-table vregs)))
 
 (defmacro with-arm-local-vinsn-macros ((segvar &optional vreg-var xfer-var) &body body)
@@ -62 +67 @@
                     (unless ,template-temp
                       (warn "VINSN \"~A\" not defined" ,template-name-var))
-                    `(arm2-update-regmap (%emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var)))))
+                    `(arm2-emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var))))
        (macrolet ((<- (,retvreg-var)
                     `(arm2-copy-register ,',segvar ,',vreg-var ,,retvreg-var))
@@ -513 +518 @@
 
 (defun arm2-update-regmap (vinsn)
-  (if (vinsn-attribute-p vinsn :call :jump)
+  (if (vinsn-attribute-p vinsn :call)
     (arm2-invalidate-regmap)
     (setq *arm2-gpr-locations-valid-mask* (logandc2 *arm2-gpr-locations-valid-mask* (vinsn-gprs-set vinsn))))
@@ -560 +565 @@
               (setq mask (logandc2 mask (ash 1 i)))))))))))
 
+(defun arm2-copy-regmap (mask from to)
+  (dotimes (i 16)
+    (when (logbitp i mask)
+      (setf (svref to i) (copy-list (svref from i))))))
+
+(defmacro with-arm2-saved-regmap ((mask map) &body body)
+  `(let* ((,mask *arm2-gpr-locations-valid-mask*)
+          (,map (make-array 16 :initial-element nil)))
+    (declare (dynamic-extent ,map))
+    (arm2-copy-regmap ,mask *arm2-gpr-locations* ,map)
+    ,@body))
 
 (defun arm2-generate-pc-source-map (debug-info)
@@ -2746 +2762 @@
                 (let* ((copy (if (eq (hard-regspec-class pushed-reg)
                                      hard-reg-class-fpr)
-                               (! copy-fpr popped-reg pushed-reg)
+                               (if (eql (get-regspec-mode pushed-reg)
+                                        hard-reg-class-fpr-mode-single)
+                                 (! single-to-single popped-reg pushed-reg)
+                                 (! double-to-double popped-reg pushed-reg))
                                (! copy-gpr popped-reg pushed-reg))))
                   (remove-dll-node copy)
@@ -3090 +3109 @@
             arm::slot-unbound-marker))))))
 
+(defun arm2-acode-operator-supports-u8 (form)
+  (setq form (acode-unwrapped-form-value form))
+  (when (acode-p form)
+    (let* ((operator (acode-operator form)))
+      (if (member operator *arm2-operator-supports-u8-target*)
+        (values operator (acode-operand 1 form))))))
+
+(defun arm2-compare-u8 (seg vreg xfer form u8constant cr-bit true-p u8-operator)
+  (with-arm-local-vinsn-macros (seg vreg xfer)
+    (with-imm-target () (u8 :u8)
+      (with-crf-target () crf
+        (if (and (eql u8-operator (%nx1-operator lisptag))
+                 (eql 0 u8constant)
+                 (eql cr-bit arm::arm-cond-eq))
+          (let* ((formreg (arm2-one-untargeted-reg-form seg form arm::arg_z)))
+            (! test-fixnum crf formreg))
+          (progn
+           (arm2-use-operator u8-operator seg u8 nil form)
+           (! compare-immediate crf u8 u8constant))))
+      ;; Flags set.  Branch or return a boolean value ?
+      (regspec-crf-gpr-case 
+       (vreg dest)
+       (^ cr-bit true-p)
+       (progn
+         (ensuring-node-target (target dest)
+           (if (not true-p)
+             (setq cr-bit (logxor 1 cr-bit)))
+           (! cond->boolean target cr-bit))
+         (^))))))
 
 ;;; There are other cases involving constants that are worth exploiting.
 (defun arm2-compare (seg vreg xfer i j cr-bit true-p)
   (with-arm-local-vinsn-macros (seg vreg xfer)
-    (let* ((jconst (arm2-constant-for-compare-p j))
+    (let* ((iu8 (let* ((i-fixnum (acode-fixnum-form-p i)))
+                  (if (typep i-fixnum '(unsigned-byte 8))
+                    i-fixnum)))
+           (ju8 (let* ((j-fixnum (acode-fixnum-form-p j)))
+                  (if (typep j-fixnum '(unsigned-byte 8))
+                    j-fixnum)))
+           (u8 (or iu8 ju8))
+           (other-u8 (if iu8 j (if ju8 i)))
+           (jconst (arm2-constant-for-compare-p j))
            (iconst (arm2-constant-for-compare-p i))
            (boolean (backend-crf-p vreg)))
-      (if (and boolean (or iconst jconst))
-        (let* ((reg (arm2-one-untargeted-reg-form seg (if jconst i j) arm::arg_z)))
-          (! compare-immediate vreg reg (or jconst iconst))
-          (unless (or jconst (eq cr-bit arm::arm-cond-eq))
-            (setq cr-bit (arm2-cr-bit-for-reversed-comparison cr-bit)))
-          (^ cr-bit true-p))
-        (if (and (eq cr-bit arm::arm-cond-eq) 
-                 (or jconst iconst))
-          (arm2-test-reg-%izerop 
-           seg 
-           vreg 
-           xfer 
-           (arm2-one-untargeted-reg-form 
-            seg 
-            (if jconst i j) 
-            arm::arg_z) 
-           cr-bit 
-           true-p 
-           (or jconst iconst))
-          (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i arm::arg_y j arm::arg_z)
-            (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))
+      (multiple-value-bind (u8-operator u8-operand) (if other-u8 (arm2-acode-operator-supports-u8 other-u8))
+        (if u8-operator
+          (arm2-compare-u8 seg vreg xfer u8-operand u8 (if (and iu8 (not (eq cr-bit arm::arm-cond-eq))) (logxor 1 cr-bit) cr-bit) true-p u8-operator)
+          (if (and boolean (or iconst jconst))
+            (let* ((reg (arm2-one-untargeted-reg-form seg (if jconst i j) arm::arg_z)))
+              (! compare-immediate vreg reg (or jconst iconst))
+              (unless (or jconst (eq cr-bit arm::arm-cond-eq))
+                (setq cr-bit (arm2-cr-bit-for-reversed-comparison cr-bit)))
+              (^ cr-bit true-p))
+            (if (and (eq cr-bit arm::arm-cond-eq) 
+                     (or jconst iconst))
+              (arm2-test-reg-%izerop 
+               seg 
+               vreg 
+               xfer 
+               (arm2-one-untargeted-reg-form 
+                seg 
+                (if jconst i j) 
+                arm::arg_z) 
+               cr-bit 
+               true-p 
+               (or jconst iconst))
+              (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i arm::arg_y j arm::arg_z)
+                (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))))
 
 
@@ -3392 +3451 @@
                   (if (and src-fpr dest-fpr)
                     (unless (eql dest-fpr src-fpr)
-                      (! copy-fpr dest src))))))))))))
+                      (case src-mode
+                        (#.hard-reg-class-fpr-mode-single
+                         (case dest-mode
+                           (#.hard-reg-class-fpr-mode-single
+                            (! single-to-single dest src))
+                           (#.hard-reg-class-fpr-mode-double
+                            (! single-to-double dest src))))
+                        (#.hard-reg-class-fpr-mode-double
+                         (case dest-mode
+                           (#.hard-reg-class-fpr-mode-single
+                            (! double-to-single dest src))
+                           (#.hard-reg-class-fpr-mode-double
+                            (! double-to-double dest src))))))))))))))))
   
 (defun arm2-unreachable-store (&optional vreg)
@@ -4786 +4857 @@
          (vp (vinsn-variable-parts vinsn))
          (nvp (vinsn-template-nvp template))
+         (predicate (vinsn-annotation vinsn))
          (unique-labels ())
          (operand-insert-functions arm::*arm-vinsn-insert-functions*))
@@ -4826 +4898 @@
                          (operands (cdr f)))
                     (setf (arm::lap-instruction-opcode insn) (car f))
+                    (when predicate
+                      (funcall (svref operand-insert-functions
+                                      (arm::encode-vinsn-field-type :cond))
+                               insn
+                               predicate))
                     (dolist (op operands (append-dll-node insn current))
                       (let* ((insert-function (svref operand-insert-functions (car op))))
@@ -5396 +5473 @@
         (arm2-test-reg-%izerop seg vreg xfer target cr-bit true-p 0)))))
 
-
+(pushnew (%nx1-operator lisptag) *arm2-operator-supports-u8-target*)
 (defarm2 arm2-lisptag lisptag (seg vreg xfer node)
   (if (null vreg)
     (arm2-form seg vreg xfer node)
-    (progn
-      (ensuring-node-target (target vreg) 
-        (! extract-tag-fixnum target (arm2-one-untargeted-reg-form seg node arm::arg_z)))
+    (let* ((reg (arm2-one-untargeted-reg-form seg node arm::arg_z)))
+      (unboxed-other-case (vreg :u8)
+        (! extract-tag vreg reg)
+        (ensuring-node-target (target vreg) 
+          (! extract-tag-fixnum target reg)))
       (^))))
 
+(pushnew (%nx1-operator fulltag) *arm2-operator-supports-u8-target*)
 (defarm2 arm2-fulltag fulltag (seg vreg xfer node)
   (if (null vreg)
     (arm2-form seg vreg xfer node)
-    (progn
+    (let* ((reg (arm2-one-untargeted-reg-form seg node arm::arg_z)))
+      (unboxed-other-case (vreg :u8)
+       (! extract-fulltag vreg reg)
       (ensuring-node-target (target vreg) 
-        (! extract-fulltag-fixnum target (arm2-one-untargeted-reg-form seg node arm::arg_z)))
+        (! extract-fulltag-fixnum target reg)))
       (^))))
 
+
+(pushnew (%nx1-operator typecode) *arm2-operator-supports-u8-target*)
 (defarm2 arm2-typecode typecode (seg vreg xfer node)
   (if (null vreg)
     (arm2-form seg vreg xfer node)
-    (let* ((reg (arm2-one-untargeted-reg-form seg node (if (eq (hard-regspec-value vreg) arm::arg_z) 
-                                                         arm::arg_y arm::arg_z))))
+    (let* ((reg (arm2-one-untargeted-reg-form seg node arm::arg_z)))
+      (unboxed-other-case (vreg :u8)
+      (! extract-typecode vreg reg)                          
       (ensuring-node-target (target vreg) 
-        (! extract-typecode-fixnum target reg ))
+        (! extract-typecode-fixnum target reg )))
       (^))))
 
@@ -5814 +5899 @@
         (<- arm::arg_z)
         (^)))))
-      
+
+;;; If exactly one vinsn references LAB and that vinsn is a conditional
+;;; branch, it's a forward branch.  If every vinsn between the branch
+;;; and label can be predicated, do so and remove both the branch and
+;;; the label.
+;;; "predicate" is being used as a verb here - "to make predicated".
+(defun arm2-predicate-block (labelnum)
+  (let* ((lab (aref *backend-labels* labelnum))
+         (refs (vinsn-label-refs lab))
+         (branch (car refs)))
+    (if (and (vinsn-attribute-p branch :branch)
+             (null (cdr refs)))
+      (when (do* ((next (dll-node-succ branch) (dll-node-succ next))
+                  (vinsn-p nil))
+                 ((eq next lab) (return vinsn-p))
+              (if (typep next 'vinsn-label)
+                (unless (typep (vinsn-label-id next) 'vinsn-note)
+                  (return))
+                (progn
+                  (unless (and (typep next 'vinsn)
+                               (null (vinsn-annotation next))
+                               (vinsn-attribute-p next :predicatable)
+                               (or (eq lab (dll-node-succ next))
+                                   (not (vinsn-attribute-p next :jump :call :subprim-call :jumpLR))))
+                    (return))
+                  (setq vinsn-p t))))
+        (multiple-value-bind (branch-true-p branch-condition cond-operand-index)
+            (let* ((branch-instr (car (vinsn-template-body (vinsn-template branch))))
+                   (values (vinsn-variable-parts branch))
+                   (operands (cdr branch-instr)))
+              (dolist (op operands (values nil nil nil))
+                (cond ((eql (car op) (arm::encode-vinsn-field-type :cond))
+                       (return (values t (svref values (cadr op)) (cadr op))))
+                      ((eql (car op) (arm::encode-vinsn-field-type :negated-cond))
+                       (return (values nil (svref values (cadr op)) (cadr op)))))))
+          (when branch-condition
+            (let* ((condition (if branch-true-p (logxor 1 branch-condition) branch-condition)))
+              (do* ((next (dll-node-succ branch) (dll-node-succ next)))
+                   ((eq next lab)
+                    (remove-dll-node branch)
+                    (remove-dll-node lab)
+                    t)
+                (cond ((typep next 'vinsn-label))
+                      ((vinsn-attribute-p next :jump)
+                       (setf (vinsn-template next)
+                             (need-vinsn-template 'cbranch-true
+                                                  (backend-p2-vinsn-templates
+                                                   *target-backend*))
+                             (svref (vinsn-variable-parts next) cond-operand-index)
+                             condition))
+                      (t (setf (vinsn-annotation next) condition)))))))))))
+
 
 (defarm2 arm2-if if (seg vreg xfer testform true false &aux test-val)
@@ -5837 +5973 @@
                                     need-else
                                     (arm2-single-valued-form-p true) 
-                                    (arm2-single-valued-form-p false))))
+                                    (arm2-single-valued-form-p false)))
+           (saved-reg-mask 0)
+           (saved-reg-map (make-array 16 :initial-element nil)))
+      (declare (dynamic-extent saved-reg-map))
       (if (eq 0 xfer) 
         (setq xfer nil))
@@ -5844 +5983 @@
           (let ((merge-else-branch-label (if (nx-null false) (arm2-find-nilret-label))))
             (arm2-conditional-form seg (arm2-make-compound-cd 0 falselabel) testform)
+            (arm2-copy-regmap (setq saved-reg-mask *arm2-gpr-locations-valid-mask*)
+                              *arm2-gpr-locations*
+                              saved-reg-map)
             (arm2-form seg result endlabel true)
             (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
@@ -5849 +5991 @@
               (progn
                 (@ falselabel)
+                (arm2-predicate-block falselabel)
                 (if (nx-null false) (@ (arm2-record-nilret-label)))
-                (arm2-form seg result nil false)))
+                (let* ((*arm2-gpr-locations-valid-mask* saved-reg-mask)
+                       (*arm2-gpr-locations* saved-reg-map))
+                  (arm2-form seg result nil false))))
             (@ endlabel)
+            (arm2-predicate-block endlabel)
             (<- result)
             (^)))
@@ -5865 +6011 @@
                   (if true-is-goto 0 falselabel) 
                   (if true-is-goto xfer (arm2-cd-merge xfer falselabel))))) 
-           testform)  
+           testform)
+          (arm2-copy-regmap (setq saved-reg-mask *arm2-gpr-locations-valid-mask*)
+                            *arm2-gpr-locations*
+                            saved-reg-map)
           (if true-is-goto
             (arm2-unreachable-store)
@@ -5883 +6032 @@
               (progn
                 (@ falselabel)
+                (arm2-predicate-block falselabel)
                 (when need-else
                   (if true-cleanup-label
                     (arm2-mvpass seg false)
-                    (arm2-form seg vreg xfer false))
+                    (let* ((*arm2-gpr-locations-valid-mask* saved-reg-mask)
+                           (*arm2-gpr-locations* saved-reg-map)) 
+                      (arm2-form seg vreg xfer false)))
                   (setq false-stack (arm2-encode-stack))))))
           (when true-cleanup-label
@@ -5904 +6056 @@
             (multiple-value-setq (*arm2-undo-count* *arm2-cstack* *arm2-vstack* *arm2-top-vstack-lcell*) 
               (arm2-decode-stack entry-stack)))
-          (@ endlabel))))))
+          (@ endlabel)
+          (arm2-predicate-block endlabel))))))
 
 (defarm2 arm2-or or (seg vreg xfer forms)

branches/arm/compiler/vinsn.lisp

@@ -264 +264 @@
     :discard                            ; adjusts a stack pointer
     :sp
-    :unconditional                      ; all instructions are implicitly unconditional
+    :predicatable                       ; all instructions can be predicated, no instructions set or test condition codes.
     ))
 

branches/arm/level-0/ARM/arm-misc.lisp

@@ -846 +846 @@
 );#+later
 
-
+(defarmlapfunction xchgl ((newval arg_y) (ptr arg_z))
+  (unbox-fixnum imm0 newval)
+  @again
+  (macptr-ptr imm2 ptr)
+  (ldrex imm1 (:@ imm2))
+  (strex imm2 imm0 (:@ imm2))
+  (cmp imm2 (:$ 0))
+  (bne @again)
+  (box-fixnum arg_z imm1)
+  (bx lr))
+                          
 
 ; end of arm-misc.lisp

branches/arm/level-0/l0-misc.lisp

@@ -219 +219 @@
 
 
-;;; Returns six values.
+;;; Returns six values on most platforms, 4 on ARM.
 ;;;   sp free
 ;;;   sp used
 ;;;   vsp free
 ;;;   vsp used
-;;;   tsp free
-;;;   tsp used
+;;;   tsp free  (not on ARM)
+;;;   tsp used  (not on ARM)
 (defun %thread-stack-space (&optional (thread *current-lisp-thread*))
   (when (eq thread *current-lisp-thread*)
@@ -347 +347 @@
           (let* ((processes (all-processes)))
             (dolist (thread-info stack-used-by-thread)
-              (destructuring-bind (thread sp-free sp-used vsp-free vsp-used tsp-free tsp-used)
+              (destructuring-bind (thread sp-free sp-used vsp-free vsp-used #-arm-target tsp-free #-arm-target tsp-used)
                   thread-info
                 (let* ((process (dolist (p processes)
@@ -355 +355 @@
                     (let ((sp-total (+ sp-used sp-free))
                           (vsp-total (+ vsp-used vsp-free))
+                          #-arm-target
                           (tsp-total (+ tsp-used tsp-free)))
                       (format t "~%~a(~d)~%  cstack:~12T~10D (~DK)  ~33T~10D (~DK)  ~54T~10D (~DK)~
-                               ~%  vstack:~12T~10D (~DK)  ~33T~10D (~DK)  ~54T~10D (~DK)~
-                               ~%  tstack:~12T~10D (~DK)  ~33T~10D (~DK)  ~54T~10D (~DK)"
+                               ~%  vstack:~12T~10D (~DK)  ~33T~10D (~DK)  ~54T~10D (~DK)"
                               (process-name process)
                               (process-serial-number process)
                               sp-total (k sp-total) sp-free (k sp-free) sp-used (k sp-used)
-                              vsp-total (k vsp-total) vsp-free (k vsp-free) vsp-used (k vsp-used)
+                              vsp-total (k vsp-total) vsp-free (k vsp-free) vsp-used  (k vsp-used))
+                      #-arm-target
+                      (format t
+                               "~%  tstack:~12T~10D (~DK)  ~33T~10D (~DK)  ~54T~10D (~DK)"
+
                               tsp-total (k tsp-total) tsp-free (k tsp-free) tsp-used (k tsp-used)))))))))))))