Index: /branches/arm/compiler/ARM/arm-vinsns.lisp
===================================================================
--- /branches/arm/compiler/ARM/arm-vinsns.lisp	(revision 13713)
+++ /branches/arm/compiler/ARM/arm-vinsns.lisp	(revision 13713)
@@ -0,0 +1,3635 @@
+;;;-*- Mode: Lisp; Package: CCL -*-
+;;;
+;;;   Copyright (C) 2010 Clozure Associates
+;;;   Copyright (C) 1994-2001 Digitool, Inc
+;;;   This file is part of Clozure CL.  
+;;;
+;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
+;;;   License , known as the LLGPL and distributed with Clozure CL as the
+;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
+;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
+;;;   conflict, the preamble takes precedence.  
+;;;
+;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
+;;;
+;;;   The LLGPL is also available online at
+;;;   http://opensource.franz.com/preamble.html
+
+
+(in-package "CCL")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require "VINSN")
+  (require "ARM-BACKEND"))
+
+(eval-when (:compile-toplevel :execute)
+  (require "ARMENV"))
+
+(defmacro define-arm-vinsn (vinsn-name (results args &optional temps) &body body)
+  (%define-vinsn *arm-backend* vinsn-name results args temps body))
+
+
+;;; Index "scaling" and constant-offset misc-ref vinsns.
+
+(define-arm-vinsn scale-node-misc-index (((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
+                                           )
+                                          ())
+  (add dest idx (:$ arm::misc-data-offset)))
+
+(define-arm-vinsn scale-16bit-misc-index (((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
+                                          )
+                                         ())
+  (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
+                                           )
+                                          ())
+  (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
+                                          )
+                                         )
+  ;; Logically, we want to:
+  ;; 1) Unbox the index by shifting it right 2 bits.
+  ;; 2) Shift (1) right 5 bits
+  ;; 3) Scale (2) by shifting it left 2 bits.
+  ;; We get to do all of this with one instruction
+  (rlwinm word-index idx (- arm::nbits-in-word 5) 5 (- arm::least-significant-bit arm::fixnum-shift))
+  (addi word-index word-index arm::misc-data-offset) ; Hmmm. Also one instruction, but less impressive somehow.
+  (extrwi bitnum idx 5 (- arm::nbits-in-word (+ arm::fixnum-shift 5))))
+
+
+
+(define-arm-vinsn misc-ref-u32  (((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))
+                                   ())
+  (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))
+                                ())
+  (ldr dest (:+@ v  scaled-idx)))
+
+(define-arm-vinsn misc-ref-c-s32  (((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)))
+  (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)))
+  (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)))
+  (str val (:+@ v scaled-idx)))
+
+(define-arm-vinsn misc-set-s32 (()
+                                ((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))
+                                          ())
+  (lfsx dest v scaled-idx))
+
+(define-arm-vinsn misc-ref-c-single-float  (((dest :single-float))
+                                            ((v :lisp)
+                                             (idx :u32const))
+                                            ())
+  (lfs dest (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
+
+(define-arm-vinsn misc-ref-double-float  (((dest :double-float))
+                                          ((v :lisp)
+                                           (scaled-idx :u32))
+                                          ())
+  (lfdx dest v scaled-idx))
+
+
+(define-arm-vinsn misc-ref-c-double-float  (((dest :double-float))
+                                            ((v :lisp)
+                                             (idx :u32const))
+                                            ())
+  (lfd dest (:apply + arm::misc-dfloat-offset (:apply ash idx 3)) v))
+
+(define-arm-vinsn misc-set-c-double-float (((val :double-float))
+                                           ((v :lisp)
+                                            (idx :u32const)))
+  (stfd val (:apply + arm::misc-dfloat-offset (:apply ash idx 3)) v))
+
+(define-arm-vinsn misc-set-double-float (()
+                                         ((val :double-float)
+                                          (v :lisp)
+                                          (scaled-idx :u32)))
+  (stfdx val v scaled-idx))
+
+(define-arm-vinsn misc-set-c-single-float (((val :single-float))
+                                           ((v :lisp)
+                                            (idx :u32const)))
+  (stfs val (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
+
+
+
+(define-arm-vinsn misc-set-single-float (()
+                                         ((val :single-float)
+                                          (v :lisp)
+                                          (scaled-idx :u32)))
+  (stfsx val v scaled-idx))
+
+
+(define-arm-vinsn misc-ref-u16  (((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))
+                                   ())
+  (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))
+                                   ())
+  (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)))
+  (strh val (:+@ v scaled-idx)))
+
+(define-arm-vinsn misc-ref-s16  (((dest :s16))
+                                 ((v :lisp)
+                                  (scaled-idx :u32))
+                                 ())
+  (lhax dest v scaled-idx))
+
+(define-arm-vinsn misc-ref-c-s16  (((dest :s16))
+                                   ((v :lisp)
+                                    (idx :u32const))
+                                   ())
+  (lha dest (:apply + arm::misc-data-offset (:apply ash idx 1)) v))
+
+
+(define-arm-vinsn misc-set-c-s16  (((val :s16))
+                                   ((v :lisp)
+                                    (idx :u32const))
+                                   ())
+  (sth val (:apply + arm::misc-data-offset (:apply ash idx 1)) v))
+
+(define-arm-vinsn misc-set-s16 (((val :s16))
+                                ((v :lisp)
+                                 (scaled-idx :s32)))
+  (sthx val v scaled-idx))
+
+(define-arm-vinsn misc-ref-u8  (((dest :u8))
+                                ((v :lisp)
+                                 (scaled-idx :u32))
+                                ())
+  (lbzx dest v scaled-idx))
+
+(define-arm-vinsn misc-ref-c-u8  (((dest :u8))
+                                  ((v :lisp)
+                                   (idx :u32const))
+                                  ())
+  (lbz dest (:apply + arm::misc-data-offset idx) v))
+
+(define-arm-vinsn misc-set-c-u8  (((val :u8))
+                                  ((v :lisp)
+                                   (idx :u32const))
+                                  ())
+  (stb val (:apply + arm::misc-data-offset idx) v))
+
+(define-arm-vinsn misc-set-u8  (((val :u8))
+                                ((v :lisp)
+                                 (scaled-idx :u32))
+                                ())
+  (stbx val v scaled-idx))
+
+(define-arm-vinsn misc-ref-s8  (((dest :s8))
+                                ((v :lisp)
+                                 (scaled-idx :u32))
+                                ())
+  (lbzx dest v scaled-idx)
+  (extsb dest dest))
+
+(define-arm-vinsn misc-ref-c-s8  (((dest :s8))
+                                  ((v :lisp)
+                                   (idx :u32const))
+                                  ())
+  (lbz dest (:apply + arm::misc-data-offset idx) v)
+  (extsb dest dest))
+
+(define-arm-vinsn misc-set-c-s8  (((val :s8))
+                                  ((v :lisp)
+                                   (idx :u32const))
+                                  ())
+  (stb val (:apply + arm::misc-data-offset idx) v))
+
+(define-arm-vinsn misc-set-s8  (((val :s8))
+                                ((v :lisp)
+                                 (scaled-idx :u32))
+                                ())
+  (stbx val v scaled-idx))
+
+(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))
+
+(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))
+                                  ())
+  (lwzx dest v scaled-idx))
+
+
+
+
+(define-arm-vinsn misc-ref-c-node (((dest :lisp))
+                                   ((v :lisp)
+                                    (idx :s16const))
+                                   ())
+  (lwz dest (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
+
+(define-arm-vinsn misc-set-node (()
+                                 ((val :lisp)
+                                  (v :lisp)
+                                  (scaled-idx :u32)))
+  (stwx 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))
+                                   ())
+  (stw val (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
+
+
+(define-arm-vinsn misc-element-count-fixnum (((dest :imm))
+                                             ((v :lisp))
+                                             ((temp :u32)))
+  (lwz temp arm::misc-header-offset v)
+  (rlwinm dest 
+          temp 
+          (- arm::nbits-in-word (- arm::num-subtag-bits arm::fixnumshift))
+          (- arm::num-subtag-bits arm::fixnumshift) 
+          (- arm::least-significant-bit arm::fixnumshift)))
+
+(define-arm-vinsn check-misc-bound (()
+                                    ((idx :imm)
+                                     (v :lisp))
+                                    ((temp :u32)))
+  (lwz temp arm::misc-header-offset v)
+  (rlwinm temp 
+          temp 
+          (- arm::nbits-in-word (- arm::num-subtag-bits arm::fixnumshift))
+          (- arm::num-subtag-bits arm::fixnumshift) 
+          (- arm::least-significant-bit arm::fixnumshift))
+  (twlge idx temp))
+
+(define-arm-vinsn 2d-unscaled-index (((dest :imm)
+                                      (dim1 :u32))
+                                     ((dim1 :u32)
+                                      (i :imm)
+                                      (j :imm)))
+  (mullw dim1 i dim1)
+  (add dest dim1 j))
+
+;; 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)))
+  (mullw dim1 dim1 dim2)
+  (mullw dim2 j dim2)
+  (mullw dim1 i dim1)
+  (add dim2 dim1 dim2)
+  (add dest dim2 k))
+
+
+(define-arm-vinsn 2d-dim1 (((dest :u32))
+                           ((header :lisp)))
+  (lwz dest (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
+  (srawi dest dest arm::fixnumshift))
+
+(define-arm-vinsn 3d-dims (((dim1 :u32)
+                            (dim2 :u32))
+                           ((header :lisp)))
+  (lwz dim1 (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
+  (lwz dim2 (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))) header)
+  (srawi dim1 dim1 arm::fixnumshift)
+  (srawi dim2 dim2 arm::fixnumshift))
+
+;; Return dim1 (unboxed)
+(define-arm-vinsn check-2d-bound (((dim :u32))
+                                  ((i :imm)
+                                   (j :imm)
+                                   (header :lisp)))
+  (lwz dim (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)) header)
+  (twlge i dim)
+  (lwz dim (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
+  (twlge j dim)
+  (srawi dim dim arm::fixnumshift))
+
+(define-arm-vinsn check-3d-bound (((dim1 :u32)
+                                   (dim2 :u32))
+                                  ((i :imm)
+                                   (j :imm)
+                                   (k :imm)
+                                   (header :lisp)))
+  (lwz dim1 (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)) header)
+  (twlge i dim1)
+  (lwz dim1 (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
+  (twlge j dim1)
+  (lwz dim2 (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))) header)
+  (twlge k dim2)
+  (srawi dim1 dim1 arm::fixnumshift)
+  (srawi dim2 dim2 arm::fixnumshift))
+
+(define-arm-vinsn array-data-vector-ref (((dest :lisp))
+                                         ((header :lisp)))
+  (lwz dest arm::arrayH.data-vector header))
+  
+
+(define-arm-vinsn check-arrayH-rank (()
+                                     ((header :lisp)
+                                      (expected :u32const))
+                                     ((rank :imm)))
+  (lwz rank arm::arrayH.rank header)
+  (twi 27 rank (:apply ash expected arm::fixnumshift)))
+
+(define-arm-vinsn check-arrayH-flags (()
+                                      ((header :lisp)
+                                       (expected :u16const))
+                                      ((flags :imm)
+                                       (xreg :u32)))
+  (lis xreg (:apply ldb (byte 16 16) (:apply ash expected arm::fixnumshift)))
+  (ori xreg xreg (:apply ldb (byte 16 0) (:apply ash expected arm::fixnumshift)))
+  (lwz flags arm::arrayH.flags header)
+  (tw 27 flags xreg))
+
+  
+
+
+  
+(define-arm-vinsn node-slot-ref  (((dest :lisp))
+                                  ((node :lisp)
+                                   (cellno :u32const)))
+  (lwz dest (:apply + arm::misc-data-offset (:apply ash cellno 2)) node))
+
+
+
+(define-arm-vinsn  %slot-ref (((dest :lisp))
+                              ((instance (:lisp (:ne dest)))
+                               (index :lisp))
+                              ((scaled :u32)))
+  (la scaled arm::misc-data-offset index)
+  (lwzx dest instance scaled)
+  (tweqi dest arm::slot-unbound-marker))
+
+
+;;; Untagged memory reference & assignment.
+
+(define-arm-vinsn mem-ref-c-fullword (((dest :u32))
+                                      ((src :address)
+                                       (index :s16const)))
+  (lwz dest index src))
+
+
+(define-arm-vinsn mem-ref-c-signed-fullword (((dest :s32))
+                                             ((src :address)
+                                              (index :s16const)))
+  (lwz dest index src))
+
+(define-arm-vinsn mem-ref-c-natural (((dest :u32))
+                                     ((src :address)
+                                      (index :s16const)))
+  (lwz dest index src))
+  
+
+(define-arm-vinsn mem-ref-fullword (((dest :u32))
+                                    ((src :address)
+                                     (index :s32)))
+  (lwzx dest src index))
+
+(define-arm-vinsn mem-ref-signed-fullword (((dest :u32))
+                                           ((src :address)
+                                            (index :s32)))
+  (lwzx dest src index))
+
+(define-arm-vinsn mem-ref-natural (((dest :u32))
+                                   ((src :address)
+                                    (index :s32)))
+  (lwzx dest src index))
+
+
+(define-arm-vinsn mem-ref-c-u16 (((dest :u16))
+                                 ((src :address)
+                                  (index :s16const)))
+  (lhz dest index src))
+
+
+(define-arm-vinsn mem-ref-u16 (((dest :u16))
+                               ((src :address)
+                                (index :s32)))
+  (lhzx dest src index))
+
+
+
+(define-arm-vinsn mem-ref-c-s16 (((dest :s16))
+                                 ((src :address)
+                                  (index :s16const)))
+  (lha dest index src))
+
+(define-arm-vinsn mem-ref-s16 (((dest :s16))
+                               ((src :address)
+                                (index :s32)))
+  (lhax dest src index))
+
+(define-arm-vinsn mem-ref-c-u8 (((dest :u8))
+                                ((src :address)
+                                 (index :s16const)))
+  (lbz dest index src))
+
+(define-arm-vinsn mem-ref-u8 (((dest :u8))
+                              ((src :address)
+                               (index :s32)))
+  (lbzx dest src index))
+
+(define-arm-vinsn mem-ref-c-s8 (((dest :s8))
+                                ((src :address)
+                                 (index :s16const)))
+  (lbz dest index src)
+  (extsb dest dest))
+
+(define-arm-vinsn mem-ref-s8 (((dest :s8))
+                              ((src :address)
+                               (index :s32)))
+  (lbzx dest src index)
+  (extsb dest dest))
+
+(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))
+
+(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)))
+  (srwi byte-index bit-index (+ arm::fixnumshift 3))
+  (extrwi bit-shift bit-index 3 27)
+  (addi bit-shift bit-shift 29)
+  (lbzx dest src byte-index)
+  (rlwnm dest dest bit-shift 31 31))
+
+
+(define-arm-vinsn mem-ref-bit-fixnum (((dest :lisp))
+                                      ((src :address)
+                                       (bit-index :lisp))
+                                      ((byte-index :s16)
+                                       (bit-shift :u8)))
+  (srwi byte-index bit-index (+ arm::fixnumshift 3))
+  (extrwi bit-shift bit-index 3 27)
+  (addi bit-shift bit-shift 27)
+  (lbzx byte-index src byte-index)
+  (rlwnm dest
+         byte-index
+         bit-shift
+         (- arm::least-significant-bit arm::fixnum-shift)
+         (- arm::least-significant-bit arm::fixnum-shift)))
+
+(define-arm-vinsn mem-ref-c-double-float (((dest :double-float))
+                                          ((src :address)
+                                           (index :s16const)))
+  (lfd dest index src))
+
+(define-arm-vinsn mem-ref-double-float (((dest :double-float))
+                                        ((src :address)
+                                         (index :s32)))
+  (lfdx dest src index))
+
+(define-arm-vinsn mem-set-c-double-float (()
+                                          ((val :double-float)
+                                           (src :address)
+                                           (index :s16const)))
+  (stfd val index src))
+
+(define-arm-vinsn mem-set-double-float (()
+                                        ((val :double-float)
+                                         (src :address)
+                                         (index :s32)))
+  (stfdx val src index))
+
+(define-arm-vinsn mem-ref-c-single-float (((dest :single-float))
+                                          ((src :address)
+                                           (index :s16const)))
+  (lfs dest index src))
+
+(define-arm-vinsn mem-ref-single-float (((dest :single-float))
+                                        ((src :address)
+                                         (index :s32)))
+  (lfsx dest src index))
+
+(define-arm-vinsn mem-set-c-single-float (()
+                                          ((val :single-float)
+                                           (src :address)
+                                           (index :s16const)))
+  (stfs val index src))
+
+(define-arm-vinsn mem-set-single-float (()
+                                        ((val :single-float)
+                                         (src :address)
+                                         (index :s32)))
+  (stfsx val src index))
+
+
+(define-arm-vinsn mem-set-c-address (()
+                                     ((val :address)
+                                      (src :address)
+                                      (index :s16const)))
+  (stw val index src))
+
+(define-arm-vinsn mem-set-address (()
+                                   ((val :address)
+                                    (src :address)
+                                    (index :s32)))
+  (stwx val src index))
+
+(define-arm-vinsn mem-set-c-fullword (()
+                                      ((val :u32)
+                                       (src :address)
+                                       (index :s16const)))
+  (stw val index src))
+
+(define-arm-vinsn mem-set-fullword (()
+                                    ((val :u32)
+                                     (src :address)
+                                     (index :s32)))
+  (stwx val src index))
+
+(define-arm-vinsn mem-set-c-halfword (()
+                                      ((val :u16)
+                                       (src :address)
+                                       (index :s16const)))
+  (sth val index src))
+
+(define-arm-vinsn mem-set-halfword (()
+                                    ((val :u16)
+                                     (src :address)
+                                     (index :s32)))
+  (sthx val src index))
+
+(define-arm-vinsn mem-set-c-byte (()
+                                  ((val :u16)
+                                   (src :address)
+                                   (index :s16const)))
+  (stb val index src))
+
+(define-arm-vinsn mem-set-byte (()
+                                ((val :u8)
+                                 (src :address)
+                                 (index :s32)))
+  (stbx val src index))
+
+(define-arm-vinsn mem-set-c-bit-0 (()
+                                   ((src :address)
+                                    (byte-index :s16const)
+                                    (mask-begin :u8const)
+                                    (mask-end :u8const))
+                                   ((val :u8)))
+  (lbz val byte-index src)
+  (rlwinm val val 0 mask-begin mask-end)
+  (stb val byte-index src))
+
+(define-arm-vinsn mem-set-c-bit-1 (()
+                                   ((src :address)
+                                    (byte-index :s16const)
+                                    (mask :u8const))
+                                   ((val :u8)))
+  (lbz val byte-index src)
+  (ori val val mask)
+  (stb val byte-index src))
+
+(define-arm-vinsn mem-set-c-bit (()
+                                 ((src :address)
+                                  (byte-index :s16const)
+                                  (bit-index :u8const)
+                                  (val :imm))
+                                 ((byteval :u8)))
+  (lbz byteval byte-index src)
+  (rlwimi byteval val (:apply logand 31 (:apply - 29 bit-index)) bit-index bit-index)
+  (stb byteval byte-index src))
+
+;;; Hey, they should be happy that it even works.  Who cares how big it is or how
+;;; long it takes ...
+#+later
+(define-arm-vinsn mem-set-bit (()
+                               ((src :address)
+                                (bit-index :lisp)
+                                (val :lisp))
+                               ((bit-shift :u32)
+                                (mask :u32)
+                                (byte-index :u32)))
+  (cmplwi crf val (ash 1 arm::fixnumshift))
+  (extrwi bit-shift bit-index 3 27)
+  (li mask #x80)
+  (srw mask mask bit-shift)
+  (ble+ crf :got-it)
+  (uuo_interr arch::error-object-not-bit src)
+  :got-it
+  (srwi bit-shift bit-index (+ 3 arm::fixnumshift))
+  (lbzx bit-shift src bit-shift)
+  (beq crf :set)
+  (andc mask bit-shift mask)
+  (b :done)
+  :set
+  (or mask bit-shift mask)
+  :done
+  (srwi bit-shift bit-index (+ 3 arm::fixnumshift))
+  (stbx mask src bit-shift))
+     
+;;; Tag and subtag extraction, comparison, checking, trapping ...
+
+(define-arm-vinsn extract-tag (((tag :u8)) 
+                               ((object :lisp)) 
+                               ())
+  (and tag object (:$ arm::tagmask)))
+
+(define-arm-vinsn extract-tag-fixnum (((tag :imm))
+                                      ((object :lisp)))
+  (and tag object (:$ arm::tagmask))
+  (mov tag (:lsl$ tag arm::fixnumshift)))
+
+(define-arm-vinsn extract-fulltag (((tag :u8))
+                                   ((object :lisp))
+                                   ())
+  (and tag object (:$ arm::fulltagmask)))
+
+
+(define-arm-vinsn extract-fulltag-fixnum (((tag :imm))
+                                          ((object :lisp)))
+  (and tag object (:$ arm::fulltagmask))
+  (mov tag (:lsl$ tag arm::fixnumshift)))
+
+(define-arm-vinsn extract-typecode (((code :u8))
+                                    ((object :lisp))
+                                    ())
+  (and code object (:$ arm::tagmask))
+  (cmp code (:$ arm::tag-misc))
+  (ldrbeq code (:@$ object arm::misc-subtag-offset)))
+
+(define-arm-vinsn extract-typecode-fixnum (((code :imm))
+                                           ((object (:lisp (:ne code))))
+                                           ((subtag :u8)))
+  (and subtag object (:$ arm::tagmask))
+  (cmp subtag (:$ arm::tag-misc))
+  (ldrbeq subtag (:@$ object arm::misc-subtag-offset))
+  (mov code (:lsl$ subtag arm::fixnumshift)))
+
+
+;;; Can we assume that an error handler can retry this without our
+;;; emitting a branch ?  I'd like to think so.
+(define-arm-vinsn require-fixnum (()
+                                  ((object :lisp))
+                                  ())
+  (tst object (:$ arm::tagmask))
+  (uuo-cerror-reg-not-lisptag (:? ne) object (:$ arm::tag-fixnum)))
+
+(define-arm-vinsn require-integer (()
+                                   ((object :lisp))
+                                   ((tag :u8)))
+  (ands tag object (:$ arm::tagmask))
+  (beq :got-it)
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (cmp tag (:$ arm::subtag-bignum))
+  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::xtype-integer))
+  :got-it)
+
+(define-arm-vinsn require-simple-vector (()
+                                         ((object :lisp))
+                                         ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (cmp tag (:$ arm::subtag-simple-vector))
+  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::subtag-simple-vector)))
+
+(define-arm-vinsn require-simple-string (()
+                                         ((object :lisp))
+                                         ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (cmp tag (:$ arm::subtag-simple-base-string))
+  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::subtag-simple-base-string)))
+
+  
+(define-arm-vinsn require-real (()
+                                ((object :lisp))
+                                ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (cmp tag (:$ arm::max-real-subtag))
+  (uuo-cerror-reg-not-xtype (:? hi) object (:$ arm::xtype-real)))
+
+(define-arm-vinsn require-number (()
+                                  ((object :lisp))
+                                  ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
+  (cmp tag (:$ arm::max-numeric-subtag))
+  (uuo-cerror-reg-not-xtype (:? hi) object (:$ arm::xtype-number)))
+
+
+(define-arm-vinsn require-list (()
+                                ((object :lisp))
+                                ((tag :u8)))
+  (and tag object (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-list))
+  (uuo-cerror-reg-not-lisptag (:? ne) object (:$ arm::tag-list)))
+
+(define-arm-vinsn require-symbol (()
+                                  ((object :lisp))
+                                  ((tag :u8)))
+  (and tag object (:$ arm::lisptagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
+  (cmpeq tag (:$ arm::subtag-symbol))
+  (cmpne object (:$ arm::nil-value))
+  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::subtag-symbol)))
+
+(define-arm-vinsn require-character (()
+                                     ((object :lisp))
+                                     ((tag :u8)))
+  (and tag object (:$ arm::subtag-mask))
+  (cmp tag (:$ arm::subtag-character))
+  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::subtag-character)))
+
+
+(define-arm-vinsn require-s8 (()
+                              ((object :lisp))
+                              ((tag :u32)))
+  (mov tag (:lsl object (:$ (- arm::nbits-in-word (+ 8 arm::fixnumshift)))))
+  (mov tag (:asr tag (- arm::nbits-in-word (+ 8 arm::fixnumshift))))
+  (cmp object (:lsl tag (:$ arm::fixnumshift)))
+  (uuo-cerror-reg-not-xtype (:? ne)  object (:$ arm::xtype-s8)))
+
+
+(define-arm-vinsn require-u8 (()
+                              ((object :lisp)))
+  (tst object (:$ (lognot (ash #xff arm::fixnumshift))))
+  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::xtype-u8)))
+
+(define-arm-vinsn require-s16 (()
+                               ((object :lisp))
+                               ( (tag :u32)))
+  (mov tag (:lsl object (:$ (- arm::nbits-in-word (+ 16 arm::fixnumshift)))))
+  (mov tag (:asr tag (:$ (- arm::nbits-in-word 16))))
+  (cmp object (:lsl tag (:$ arm::fixnumshift)))
+  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::xtype-s16)))
+
+(define-arm-vinsn require-u16 (()
+                               ((object :lisp))
+                               ((tag :u32)))
+  (mov tag (:$ (lognot (ash #xff arm::fixnumshift))))
+  (bic tag tag (:$ (ash #xff (+ 8 arm::fixnumshift))))
+  (tst object tag)
+  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::xtype-u16)))
+
+(define-arm-vinsn require-s32 (()
+                               ((src :lisp))
+                               ((tag :u32)
+                                (header :u32)))
+  (ands tag src (:$ arm::tagmask))
+  (beq :got-it)
+  (cmp tag (:$ arm::tag-misc))
+  (mov tag (:$ arm::subtag-bignum))
+  (orr tag tag (:$ (ash 1 arm::num-subtag-bits)))
+  (ldreq header (:@ src (:$ arm::misc-header-offset)))
+  (cmpeq tag header)
+  (uuo-cerror-object-not-xtype (:? ne) src (:$ arm::xtype-s32))
+  :got-it)
+
+
+(define-arm-vinsn require-u32 (()
+                               ((src :lisp))
+                               ((temp :u32)))
+  :again
+  (test src (:$ (logior (ash 1 (1- arm::nbits-in-word)) arm::tagmask)))
+  (beq :got-it)
+  (and temp src (:$ arm::tagmask))
+  (cmp temp (:$ arm::tag-misc))
+  (ldrbeq temp (:@ src (:$ arm::misc-data-offset)))
+  (cmp temp (:$ arm::subtag-bignum))
+  (bne :bad-if-ne)
+  (ldr temp (:@ src arm::misc-header-offset))
+  (mov temp (:lsr temp (:$ arm::num-subtag-bits)))
+  (cmp temp (:$ 2))
+  (beq :two)
+  (cmp temp (:$ 1))
+  (bne :bad-if-ne)
+  (ldr temp (:@ src (:$ arm::misc-data-offset)))
+  (tst temp (:$ (ash 1 31)))
+  (b :bad-if-ne)
+  :two
+  (ldr temp (:@ src (:$ (+ 4 arm::misc-data-offset))))
+  (cmp temp (:$ 0))
+  :bad-if-ne
+  (uuo-cerror-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
+  :got-it)
+
+(define-arm-vinsn require-s64 (()
+                               ((src :lisp))
+                               ((tag :u32)
+                                (header :u32)))
+  (ands tag src (:$ arm::tag-mask))
+  (beq :got-it)
+  (cmp tag (:$ arm::tag-misc))
+  (ldreq header (:@ src (:$ arm::misc-header-offset)))
+  (andeq tag header (:$ arm::subtag-mask))
+  (cmp tag (:$ arm::subtag_bignum))
+  (move header (:lsr header (:$ arm::num-subtag-bits)))
+  (bne :bad-if-ne)
+  (cmp header (:$ 1))
+  (beq :got-it)
+  (cmp header (:$ 2))
+  :bad-if-ne
+  (uuo-cerror-reg-not-xtype src (:$ arm::xtype-s64))
+  :got-it)
+
+(define-arm-vinsn require-u64 (()
+                               ((src :lisp))
+                               ((temp :u32)
+                                (header :u32)))
+  :again
+  (tst src (:$ (logior (ash 1 31) arm::fixnum-mask)))
+  (and temp src (:$ arm::fixnum-mask))
+  (beq :got-it)
+  (cmp temp (:$ arm::tag-misc))
+  (ldreq header (:@ src (:$ arm::misc-header-offset0)))
+  (andeq temp src (:$ arm::subtag-mask))
+  (moveq header (:lsr header (:$ arm::num-subtag-bits)))
+  (cmpeq temp (:$ arm::subtag-bignum))
+  (bne :bad-if-ne)
+  (cmp header (:$ 3))
+  (ldreq temp (:@ src (:$ (+ arm::misc-data-offset 8))))
+  (beq :three)
+  (cmp header (:$ 2))
+  (ldreq temp (:@ src (:$ (+ arm::misc-data-offset 4))))
+  (beq :sign-of-highword)
+  (cmp header (:$ 1))
+  (ldr temp (:@ src (:$ arm::misc-data-offset)))
+  (bne :bad-if-ne)
+  :sign-of-highword
+  (tst temp (:$ (ash 1 31)))
+  (b :bad-if-ne)
+  :three
+  (cmp temp (:$ 0))
+  :bad-if-ne
+  (uuo-cerror-reg-not-xtype (:? ne) src (:$ arm::xtype-s64))
+  :got-it)
+
+
+
+
+(define-arm-vinsn require-char-code (()
+                                     ((object :lisp)))
+  (tst object (:$ arm::fixnum-mask))
+  (bne :bad)
+  (cmp object (:$ (ash char-code-limit arm::fixnumshift)))
+  (bls :got-it)
+  :bad
+  (uuo-error-reg-not-xtype (:? al) object (:$ arm::xtype-char-code))
+  :got-it)
+
+
+(define-arm-vinsn box-fixnum (((dest :imm))
+                              ((src :s32)))
+  (mov dest (:lsl src (:$ arm::fixnumshift))))
+
+(define-arm-vinsn fixnum->signed-natural (((dest :s32))
+                                          ((src :imm)))
+  (mov dest (:asr src (:$ arm::fixnumshift))))
+
+(define-arm-vinsn fixnum->unsigned-natural (((dest :u32))
+                                            ((src :imm)))
+  (mov dest (:lsr src (:$ arm::fixnumshift))))
+
+;;; An object is of type (UNSIGNED-BYTE 32) iff
+;;;  a) it's of type (UNSIGNED-BYTE 30) (e.g., an unsigned fixnum)
+;;;  b) it's a bignum of length 1 and the 0'th digit is positive
+;;;  c) it's a bignum of length 2 and the sign-digit is 0.
+
+(define-arm-vinsn unbox-u32 (((dest :u32))
+                             ((src :lisp))
+                             ((temp :u32)))
+                             
+  (tst src (:$ #x80000003))
+  (mov dest (:lsr src (:$ arm::fixnumshift)))
+  (beq :got-it)
+  (and temp src (:$ arm::tagmask))
+  (cmp temp (:$ arm::tag-misc))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
+  (ldr dest (:+@$ src arm::misc-header-offset))
+  (ldr temp (:$ arm::subtag-bignum))
+  (orr temp temp (:$ (ash 1 arm::num-subtag-bits)))
+  (cmp dest temp)
+  (bne :maybe-two-digit)
+  (ldr dest (:+@$ src arm::misc-data-offset))
+  (tst dest (:$ 31))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
+  (b  :got-it)
+  :maybe-two-digit
+  (add temp temp (:$ (ash 1 arm::num-subtag-bits)))
+  (cmp dest temp)
+  (ldreq temp (:+@$ src (+ arm::misc-data-offset 4)))
+  (cmpeq temp (:$ 0))
+  (ldreq dest (:+@$ src arm::misc-data-offset))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
+  :got-it))
+
+;;; an object is of type (SIGNED-BYTE 32) iff
+;;; a) it's a fixnum
+;;; b) it's a bignum with exactly one digit.
+
+(define-arm-vinsn unbox-s32 (((dest :s32))
+                             ((src :lisp))
+                             ((tag :u32)))
+  (ands tag src (:$ arm::tagmask))
+  (mov dest (:asr$ src arm::fixnumshift))
+  (beq :got-it)
+  (mov dest (:$ arm::subtag-bignum))
+  (orr dest dest (:$ (ash 1 arm::num-subtag-bits)))
+  (cmp tag (:$ arm::tag-misc))
+  (ldreq tag (:+@ src (:$ arm::misc-header-offset)))
+  (cmpeq dest tag)
+  (ldreq dest (:+@ src (:$ arm::misc-data-offset)))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-s32))
+  :got-it))
+
+
+
+(define-arm-vinsn unbox-u16 (((dest :u16))
+                             ((src :lisp)))
+  (mov dest (:lsl src (:$ (- 16 arm::fixnumshift))))
+  (mov dest (:lsr dest (:$ 16)))
+  (cmp src (:lsl dest (:$ arm::fixnumshift)))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u16)))
+
+(define-arm-vinsn unbox-s16 (((dest :s16))
+                             ((src :lisp)))
+  (mov dest (:lsl src (:$ (- arm::nbits-in-word (+ 16 arm::fixnumshift)))))
+  (mov dest (:asr dest (:$ 16)))
+  (cmp src (:lsl dest (:$ arm::fixnumshift)))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-s16)))
+
+  
+  
+(define-arm-vinsn unbox-u8 (((dest :u8))
+                            ((src :lisp)))
+  (mov dest (:lsl dest (:$ (- 24 arm::fixnumshift))))
+  (mov dest (:asr dest (:$ 24)))
+  (cmp src (:lsl dest (:$ arm::fixnumshift)))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u8)))
+
+(define-arm-vinsn %unbox-u8 (((dest :u8))
+                             ((src :lisp)))
+  (mov dest (:$ #xff))
+  (and dest dest (:lsr src (:$ arm::fixnumshift))))
+
+(define-arm-vinsn unbox-s8 (((dest :s8))
+                            ((src :lisp)))
+  (mov dest (:lsl dest (:$ (- 24 arm::fixnumshift))))
+  (mov dest (:$ asr dest (:$ 24)))
+  (cmp src (:lsl dest (:$ arm::fixnumshift)))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-s8)))
+
+(define-arm-vinsn unbox-base-char (((dest :u32))
+                                   ((src :lisp)))
+  (and dest src (:$ arm::subtag-mask))
+  (cmp dest (:$ arm::subtag-character))
+  (mov dest (:lsr src (:$ arm::charcode-shift)))
+  (uuo-error-object-not-xtype (:? ne) src (:$ arm::subtag-character)))
+
+
+(define-arm-vinsn unbox-bit (((dest :u32))
+                             ((src :lisp)))
+  (cmp src (:$ arm::fixnumone))
+  (mov dest (:lsr src (:$ arm::fixnumshift)))
+  (uuo-error-reg-not-xtype (:? hi) src (:$ arm::xtype-bit)))
+
+(define-arm-vinsn unbox-bit-bit0 (((dest :u32))
+                                  ((src :lisp))
+                                  ((crf :crf)))
+  (cmplwi crf src (ash 1 arm::fixnumshift))
+  (rlwinm dest src (- 32 (1+ arm::fixnumshift)) 0 0)
+  (ble+ crf :got-it)
+  (uuo_interr arch::error-object-not-bit src)
+  :got-it)
+
+(define-arm-vinsn fixnum->fpr (((dest :double-float))
+                               ((src :lisp))
+                               ((imm :s32)))
+  (stfd arm::fp-s32conv -8 arm::sp)
+  (srawi imm src arm::fixnumshift)
+  (xoris imm imm #x8000)
+  (stw imm -4 arm::sp)
+  (lfd dest -8 arm::sp)
+  (fsub dest dest arm::fp-s32conv))
+
+
+(define-arm-vinsn shift-right-variable-word (((dest :u32))
+                                             ((src :u32)
+                                              (sh :u32)))
+  (srw dest src sh))
+
+(define-arm-vinsn u32logandc2 (((dest :u32))
+                               ((x :u32)
+                                (y :u32)))
+  (andc dest x y))
+
+(define-arm-vinsn u32logior (((dest :u32))
+                             ((x :u32)
+                              (y :u32)))
+  (or dest x y))
+
+(define-arm-vinsn rotate-left-variable-word (((dest :u32))
+                                             ((src :u32)
+                                              (rot :u32)))
+  (rlwnm dest src rot 0 31))
+
+(define-arm-vinsn complement-shift-count (((dest :u32))
+                                          ((src :u32)))
+  (subfic dest src 32))
+
+(define-arm-vinsn extract-lowbyte (((dest :u32))
+                                   ((src :lisp)))
+  (clrlwi dest src (- arm::nbits-in-word arm::num-subtag-bits)))
+
+;;; Set DEST to the difference between the low byte of SRC and BYTEVAL.
+(define-arm-vinsn extract-compare-lowbyte (((dest :u32))
+                                           ((src :lisp)
+                                            (byteval :u8const)))
+  (clrlwi dest src (- arm::nbits-in-word arm::num-subtag-bits))
+  (subi dest dest byteval))
+
+
+;;; Set the "EQ" bit in condition-register field CRF if object is
+;;; a fixnum.  Leave the object's tag in TAG.
+;;; This is a little easier if CRF is CR0.
+(define-arm-vinsn eq-if-fixnum (((crf :crf)
+                                 (tag :u8))
+                                ((object :lisp))
+                                ())
+  ((:eq crf 0)
+   (clrlwi. tag object (- arm::nbits-in-word arm::nlisptagbits)))
+  ((:not (:eq crf 0))
+   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+   (cmpwi crf tag arm::tag-fixnum)))
+
+
+
+(define-arm-vinsn trap-unless-fixnum (()
+                                      ((object :lisp))
+                                      ((tag :u8)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (twnei tag arm::tag-fixnum))
+
+(define-arm-vinsn trap-unless-list (()
+                                    ((object :lisp))
+                                    ((tag :u8)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (twnei tag arm::tag-list))
+
+(define-arm-vinsn trap-unless-single-float (()
+                                            ((object :lisp))
+                                            ((tag :u8)
+                                             (crf :crf)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi crf tag arm::tag-misc)
+  (bne crf :do-trap)
+  (lbz tag arm::misc-subtag-offset object)
+  :do-trap
+  (twnei tag arm::subtag-single-float))
+
+(define-arm-vinsn trap-unless-double-float (()
+                                            ((object :lisp))
+                                            ((tag :u8)
+                                             (crf :crf)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi crf tag arm::tag-misc)
+  (bne crf :do-trap)
+  (lbz tag arm::misc-subtag-offset object)
+  :do-trap
+  (twnei tag arm::subtag-double-float))
+
+
+(define-arm-vinsn trap-unless-array-header (()
+                                            ((object :lisp))
+                                            ((tag :u8)
+                                             (crf :crf)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi crf tag arm::tag-misc)
+  (bne crf :do-trap)
+  (lbz tag arm::misc-subtag-offset object)
+  :do-trap
+  (twnei tag arm::subtag-arrayH))
+
+(define-arm-vinsn trap-unless-macptr (()
+                                      ((object :lisp))
+                                      ((tag :u8)
+                                       (crf :crf)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi crf tag arm::tag-misc)
+  (bne crf :do-trap)
+  (lbz tag arm::misc-subtag-offset object)
+  :do-trap
+  (twnei tag arm::subtag-macptr))
+
+
+
+(define-arm-vinsn trap-unless-uvector (()
+                                       ((object :lisp))
+                                       ((tag :u8)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (twnei tag arm::tag-misc))
+
+(define-arm-vinsn trap-unless-fulltag= (()
+                                        ((object :lisp)
+                                         (tagval :u16const))
+                                        ((tag :u8)))
+  (clrlwi tag object (- arm::nbits-in-word arm::ntagbits))
+  (twnei tag tagval))
+
+(define-arm-vinsn trap-unless-lowbyte= (()
+                                        ((object :lisp)
+                                         (tagval :u16const))
+                                        ((tag :u8)))
+  (clrlwi tag object (- arm::nbits-in-word 8))
+  (twnei tag tagval))
+
+(define-arm-vinsn trap-unless-character (()
+                                         ((object :lisp))
+                                         ((tag :u8)))
+  (clrlwi tag object (- arm::nbits-in-word 8))
+  (twnei tag arm::subtag-character))
+
+(define-arm-vinsn trap-unless-cons (()
+                                    ((object :lisp))
+                                    ((tag :u8)))
+  (clrlwi tag object (- arm::nbits-in-word arm::ntagbits))
+  (twnei tag arm::fulltag-cons))
+
+(define-arm-vinsn trap-unless-typecode= (()
+                                         ((object :lisp)
+                                          (tagval :u16const))
+                                         ((tag :u8)
+                                          (crf :crf)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi crf tag arm::tag-misc)
+  (bne crf :do-trap)
+  (lbz tag arm::misc-subtag-offset object)
+  :do-trap
+  (twnei tag tagval))
+  
+(define-arm-vinsn subtract-constant (((dest :imm))
+                                     ((src :imm)
+                                      (const :s16const)))
+  (subi dest src const))
+
+(define-arm-vinsn trap-unless-numeric-type (()
+                                            ((object :lisp)
+                                             (maxtype :u16const))
+                                            ((crf0 (:crf 0))
+                                             (tag :u8)
+                                             (crfX :crf)))
+  (clrlwi. tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi tag arm::tag-misc)
+  (beq+ crf0 :fixnum)
+  (bne crfX :scale-tag)
+  (lbz tag arm::misc-subtag-offset object)
+  :scale-tag
+  (subi tag tag arm::min-numeric-subtag)
+  (twlgti tag (:apply - maxtype arm::min-numeric-subtag))
+  :fixnum)
+
+
+;; Bit-extraction & boolean operations
+
+(eval-when (:compile-toplevel :execute)
+  (assert (= arm::t-offset #b10001))) ; ARM-bits 31 and 27 set
+
+;; For some mind-numbing reason, IBM decided to call the most significant
+;; bit in a 32-bit word "bit 0" and the least significant bit "bit 31"
+;; (this despite the fact that it's essentially a big-endian architecture
+;; (it was exclusively big-endian when this decision was made.))
+;; We'll probably be least confused if we consistently use this backwards
+;; bit ordering (letting things that have a "sane" bit-number worry about
+;; it at compile-time or run-time (subtracting the "sane" bit number from
+;; 31.))
+
+(define-arm-vinsn extract-variable-bit (((dest :u8))
+                                        ((src :u32)
+                                         (bitnum :u8))
+                                        ())
+  (rotlw dest src bitnum)
+  (extrwi dest dest 1 0))
+
+
+(define-arm-vinsn extract-variable-bit-fixnum (((dest :imm))
+                                               ((src :u32)
+                                                (bitnum :u8))
+                                               ((temp :u32)))
+  (rotlw temp src bitnum)
+  (rlwinm dest
+          temp 
+          (1+ arm::fixnumshift) 
+          (- arm::least-significant-bit arm::fixnumshift)
+          (- arm::least-significant-bit arm::fixnumshift)))
+
+
+;; Sometimes we try to extract a single bit from some source register
+;; into a destination bit (typically 31, sometimes fixnum bit 0 = 29).
+;; If we copy bit 0 (whoops, I mean "bit 31") to bit 4 (aka 27) in a
+;; given register, we get a value that's either 17 (the arithmetic difference
+;; between T and NIL) or 0.
+
+(define-arm-vinsn lowbit->truth (((dest :lisp)
+                                  (bits :u32))
+                                 ((bits :u32))
+                                 ())
+  (rlwimi bits bits (- arm::least-significant-bit 27) 27 27) ; bits = 0000...X000X
+  (addi dest bits (:apply target-nil-value)))
+
+(define-arm-vinsn invert-lowbit (((bits :u32))
+                                 ((bits :u32))
+                                 ())
+  (xori bits bits 1))
+
+                           
+
+;; Some of the obscure-looking instruction sequences - which map some relation
+;; to ARM bit 31 of some register - were found by the GNU SuperOptimizer.
+;; Some of them use extended-precision instructions (which may cause interlocks
+;; on some superscalar ARMs, if I remember correctly.)  In general, sequences
+;; that GSO found that -don't- do extended precision are longer and/or use
+;; more temporaries.
+;; On the 604, the penalty for using an instruction that uses the CA bit is
+;; "at least" one cycle: it can't complete execution until all "older" instructions
+;; have.  That's not horrible, especially given that the alternative is usually
+;; to use more instructions (and, more importantly, more temporaries) to avoid
+;; using extended-precision.
+
+
+(define-arm-vinsn eq0->bit31 (((bits :u32))
+                              ((src (t (:ne bits)))))
+  (cntlzw bits src)
+  (srwi bits bits 5))                   ; bits = 0000...000X
+
+(define-arm-vinsn ne0->bit31 (((bits :u32))
+                              ((src (t (:ne bits)))))
+  (cntlzw bits src)
+  (slw bits src bits)
+  (srwi bits bits 31))                  ; bits = 0000...000X
+
+(define-arm-vinsn lt0->bit31 (((bits :u32))
+                              ((src (t (:ne bits)))))
+  (srwi bits src 31))                   ; bits = 0000...000X
+
+
+(define-arm-vinsn ge0->bit31 (((bits :u32))
+                              ((src (t (:ne bits)))))
+  (srwi bits src 31)       
+  (xori bits bits 1))                   ; bits = 0000...000X
+
+
+(define-arm-vinsn le0->bit31 (((bits :u32))
+                              ((src (t (:ne bits)))))
+  (neg bits src)
+  (orc bits bits src)
+  (srwi bits bits 31))                  ; bits = 0000...000X
+
+(define-arm-vinsn gt0->bit31 (((bits :u32))
+                              ((src (t (:ne bits)))))
+  (subi bits src 1)       
+  (nor bits bits src)
+  (srwi bits bits 31))                  ; bits = 0000...000X
+
+(define-arm-vinsn ne->bit31 (((bits :u32))
+                             ((x t)
+                              (y t))
+                             ((temp :u32)))
+  (subf temp x y)
+  (cntlzw bits temp)
+  (slw bits temp bits)
+  (srwi bits bits 31))                  ; bits = 0000...000X
+
+(define-arm-vinsn fulltag->bit31 (((bits :u32))
+                                  ((lispobj :lisp)
+                                   (tagval :u8const))
+                                  ())
+  (clrlwi bits lispobj (- arm::nbits-in-word arm::ntagbits))
+  (subi bits bits tagval)
+  (cntlzw bits bits)
+  (srwi bits bits 5))
+
+
+(define-arm-vinsn eq->bit31 (((bits :u32))
+                             ((x t)
+                              (y t)))
+  (subf bits x y)
+  (cntlzw bits bits)
+  (srwi bits bits 5))                   ; bits = 0000...000X
+
+(define-arm-vinsn eqnil->bit31 (((bits :u32))
+                                ((x t)))
+  (subi bits x (:apply target-nil-value))
+  (cntlzw bits bits)
+  (srwi bits bits 5))
+
+(define-arm-vinsn ne->bit31 (((bits :u32))
+                             ((x t)
+                              (y t)))
+  (subf bits x y)
+  (cntlzw bits bits)
+  (srwi bits bits 5)
+  (xori bits bits 1))
+
+(define-arm-vinsn nenil->bit31 (((bits :u32))
+                                ((x t)))
+  (subi bits x (:apply target-nil-value))
+  (cntlzw bits bits)
+  (srwi bits bits 5)
+  (xori bits bits 1))
+
+(define-arm-vinsn lt->bit31 (((bits :u32))
+                             ((x (t (:ne bits)))
+                              (y (t (:ne bits)))))
+
+  (xor bits x y)
+  (srawi bits bits 31)
+  (or bits bits x)
+  (subf bits y bits)
+  (srwi bits bits 31))                  ; bits = 0000...000X
+
+(define-arm-vinsn ltu->bit31 (((bits :u32))
+                              ((x :u32)
+                               (y :u32)))
+  (subfc bits y x)
+  (subfe bits bits bits)
+  (neg bits bits))
+
+(define-arm-vinsn le->bit31 (((bits :u32))
+                             ((x (t (:ne bits)))
+                              (y (t (:ne bits)))))
+
+  (xor bits x y)
+  (srawi bits bits 31)
+  (nor bits bits y)
+  (add bits bits x)
+  (srwi bits bits 31))                  ; bits = 0000...000X
+
+(define-arm-vinsn leu->bit31  (((bits :u32))
+                               ((x :u32)
+                                (y :u32)))
+  (subfc bits x y)
+  (addze bits arm::rzero))
+
+(define-arm-vinsn gt->bit31 (((bits :u32))
+                             ((x (t (:ne bits)))
+                              (y (t (:ne bits)))))
+
+  (eqv bits x y)
+  (srawi bits bits 31)
+  (and bits bits x)
+  (subf bits bits y)
+  (srwi bits bits 31))                  ; bits = 0000...000X
+
+(define-arm-vinsn gtu->bit31 (((bits :u32))
+                              ((x :u32)
+                               (y :u32)))
+  (subfc bits x y)
+  (subfe bits bits bits)
+  (neg bits bits))
+
+(define-arm-vinsn ge->bit31 (((bits :u32))
+                             ((x (t (:ne bits)))
+                              (y (t (:ne bits)))))
+  (eqv bits x y)
+  (srawi bits bits 31)
+  (andc bits bits x)
+  (add bits bits y)
+  (srwi bits bits 31))                  ; bits = 0000...000X
+
+(define-arm-vinsn geu->bit31 (((bits :u32))
+                              ((x :u32)
+                               (y :u32)))
+  (subfc bits y x)
+  (addze bits arm::rzero))
+
+
+;;; there are big-time latencies associated with MFCR on more heavily
+;;; pipelined processors; that implies that we should avoid this like
+;;; the plague.
+;;; GSO can't find anything much quicker for LT or GT, even though
+;;; MFCR takes three cycles and waits for previous instructions to complete.
+;;; Of course, using a CR field costs us something as well.
+(define-arm-vinsn crbit->bit31 (((bits :u32))
+                                ((crf :crf)
+                                 (bitnum :crbit))
+                                ())
+  (mfcr bits)                           ; Suffer.
+  (rlwinm bits bits (:apply + 1  bitnum (:apply ash crf 2)) 31 31)) ; bits = 0000...000X
+
+
+(define-arm-vinsn compare (((crf :crf))
+                           ((arg0 t)
+                            (arg1 t))
+                           ())
+  (cmpw crf arg0 arg1))
+
+(define-arm-vinsn compare-to-nil (((crf :crf))
+                                  ((arg0 t)))
+  (cmpwi crf arg0 (:apply target-nil-value)))
+
+(define-arm-vinsn compare-logical (((crf :crf))
+                                   ((arg0 t)
+                                    (arg1 t))
+                                   ())
+  (cmplw crf arg0 arg1))
+
+(define-arm-vinsn double-float-compare (((crf :crf))
+                                        ((arg0 :double-float)
+                                         (arg1 :double-float))
+                                        ())
+  (fcmpo crf arg0 arg1))
+              
+
+(define-arm-vinsn double-float+-2 (((result :double-float))
+                                   ((x :double-float)
+                                    (y :double-float)))
+  (faddd result x y))
+
+(define-arm-vinsn double-float--2 (((result :double-float))
+                                   ((x :double-float)
+                                    (y :double-float)))
+  (fsubd result x y))
+
+(define-arm-vinsn double-float*-2 (((result :double-float))
+                                   ((x :double-float)
+                                    (y :double-float)))
+  (fmuld result x y))
+
+(define-arm-vinsn double-float/-2 (((result :double-float))
+                                   ((x :double-float)
+                                    (y :double-float)))
+  (fdivd result x y))
+
+(define-arm-vinsn single-float+-2 (((result :single-float))
+                                   ((x :single-float)
+                                    (y :single-float))
+                                   ((crf (:crf 4))))
+  (fadds result x y))
+
+(define-arm-vinsn single-float--2 (((result :single-float))
+                                   ((x :single-float)
+                                    (y :single-float)))
+  (fsubs result x y))
+
+(define-arm-vinsn single-float*-2 (((result :single-float))
+                                   ((x :single-float)
+                                    (y :single-float)))
+  (fmuls result x y))
+
+(define-arm-vinsn single-float/-2 (((result :single-float))
+                                   ((x :single-float)
+                                    (y :single-float)))
+  (fdivs result x y))
+
+
+
+
+
+(define-arm-vinsn compare-unsigned (((crf :crf))
+                                    ((arg0 :imm)
+                                     (arg1 :imm))
+                                    ())
+  (cmplw crf arg0 arg1))
+
+(define-arm-vinsn compare-signed-s16const (((crf :crf))
+                                           ((arg0 :imm)
+                                            (imm :s16const))
+                                           ())
+  (cmpwi crf arg0 imm))
+
+(define-arm-vinsn compare-unsigned-u16const (((crf :crf))
+                                             ((arg0 :u32)
+                                              (imm :u16const))
+                                             ())
+  (cmplwi crf arg0 imm))
+
+
+
+;; Extract a constant bit (0-31) from src; make it be bit 31 of dest.
+;; Bitnum is treated mod 32.
+(define-arm-vinsn extract-constant-arm-bit (((dest :u32))
+                                            ((src :imm)
+                                             (bitnum :u16const))
+                                            ())
+  (rlwinm dest src (:apply + 1 bitnum) 31 31))
+
+
+(define-arm-vinsn set-constant-arm-bit-to-variable-value (((dest :u32))
+                                                          ((src :u32)
+                                                           (bitval :u32) ; 0 or 1
+                                                           (bitnum :u8const)))
+  (rlwimi dest bitval (:apply - 32 bitnum) bitnum bitnum))
+
+(define-arm-vinsn set-constant-arm-bit-to-1 (((dest :u32))
+                                             ((src :u32)
+                                              (bitnum :u8const)))
+  ((:pred < bitnum 16)
+   (oris dest src (:apply ash #x8000 (:apply - bitnum))))
+  ((:pred >= bitnum 16)
+   (ori dest src (:apply ash #x8000 (:apply - (:apply - bitnum 16))))))
+
+(define-arm-vinsn set-constant-arm-bit-to-0 (((dest :u32))
+                                             ((src :u32)
+                                              (bitnum :u8const)))
+  (rlwinm dest src 0 (:apply logand #x1f (:apply 1+ bitnum)) (:apply logand #x1f (:apply 1- bitnum))))
+
+  
+(define-arm-vinsn insert-bit-0 (((dest :u32))
+                                ((src :u32)
+                                 (val :u32)))
+  (rlwimi dest val 0 0 0))
+  
+;;; The bit number is boxed and wants to think of the least-significant bit as 0.
+;;; Imagine that.
+;;; To turn the boxed, lsb-0 bitnumber into an unboxed, msb-0 rotate count,
+;;; we (conceptually) unbox it, add arm::fixnumshift to it, subtract it from
+;;; 31, and add one.  This can also be done as "unbox and subtract from 28",
+;;; I think ...
+;;; Actually, it'd be "unbox, then subtract from 30".
+(define-arm-vinsn extract-variable-non-insane-bit (((dest :u32))
+                                                   ((src :imm)
+                                                    (bit :imm))
+                                                   ((temp :u32)))
+  (srwi temp bit arm::fixnumshift)
+  (subfic temp temp (- 32 arm::fixnumshift))
+  (rlwnm dest src temp 31 31))
+                                               
+;;; Operations on lists and cons cells
+
+(define-arm-vinsn %cdr (((dest :lisp))
+                        ((src :lisp)))
+  (ldr dest (:+@$ src arm::cons.cdr)))
+
+(define-arm-vinsn %car (((dest :lisp))
+                        ((src :lisp)))
+  (ldr dest (:+@$ src arm::cons.car)))
+
+(define-arm-vinsn %set-car (()
+                            ((cell :lisp)
+                             (new :lisp)))
+  (str dest (:+@$ src arm::cons.car)))
+
+(define-arm-vinsn %set-cdr (()
+                            ((cell :lisp)
+                             (new :lisp)))
+  (str dest (:+@$ src arm::cons.cdr)))
+
+(define-arm-vinsn load-adl (()
+                            ((n :u32const)))
+  (lis nargs (:apply ldb (byte 16 16) n))
+  (ori nargs nargs (:apply ldb (byte 16 0) n)))
+                            
+(define-arm-vinsn set-nargs (()
+                             ((n :s16const)))
+  (li nargs (:apply ash n arm::word-shift)))
+
+(define-arm-vinsn scale-nargs (()
+                               ((nfixed :s16const)))
+  ((:pred > nfixed 0)
+   (add nargs narg (:$ (:apply - (:apply ash nfixed arm::word-shift))))))
+                           
+
+
+(define-arm-vinsn (vpush-register :push :node :vsp)
+    (()
+     ((reg :lisp)))
+  (str reg (:+@! vsp (:$ (- arm::node-size)))))
+
+(define-arm-vinsn (vpush-register-arg :push :node :vsp :outgoing-argument)
+    (()
+     ((reg :lisp)))
+  (str reg (:+@! vsp (:$ (- arm::node-size)))))
+
+(define-arm-vinsn (vpop-register :pop :node :vsp)
+    (((dest :lisp))
+     ())
+  (ldr dest (:@+ vsp (:$ arm::node-size))))
+
+
+(define-arm-vinsn copy-node-gpr (((dest :lisp))
+                                 ((src :lisp)))
+  ((:not (:pred =
+                (:apply %hard-regspec-value dest)
+                (:apply %hard-regspec-value src)))
+   (mov dest src)))
+
+(define-arm-vinsn copy-gpr (((dest t))
+                            ((src t)))
+  ((:not (:pred =
+                (:apply %hard-regspec-value dest)
+                (:apply %hard-regspec-value src)))
+   (mov dest src)))
+
+
+(define-arm-vinsn copy-fpr (((dest :double-float))
+                            ((src :double-float)))
+  ((:not (:pred =
+                (:apply %hard-regspec-value dest)
+                (:apply %hard-regspec-value src)))
+   (fmr dest src)))
+
+(define-arm-vinsn vcell-ref (((dest :lisp))
+                             ((vcell :lisp)))
+  (lwz dest arm::misc-data-offset vcell))
+
+
+(define-arm-vinsn make-vcell (((dest :lisp))
+                              ((closed (:lisp :ne dest)))
+                              ((header :u32)))
+  (li header arm::value-cell-header)
+  (la arm::allocptr (- arm::fulltag-misc arm::value-cell.size) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stw closed arm::value-cell.value dest))
+
+(define-arm-vinsn make-tsp-vcell (((dest :lisp))
+                                  ((closed :lisp))
+                                  ((header :u32)))
+  (li header arm::value-cell-header)
+  (stwu arm::tsp -16 arm::tsp)
+  (stw arm::tsp 4 arm::tsp)
+  (stfd arm::fp-zero 8 arm::tsp)
+  (stw arm::rzero 4 arm::tsp)
+  (stw header (+ 8 arm::fulltag-misc arm::value-cell.header) arm::tsp)
+  (stw closed (+ 8 arm::fulltag-misc arm::value-cell.value) arm::tsp)
+  (la dest (+ 8 arm::fulltag-misc) arm::tsp))
+
+(define-arm-vinsn make-tsp-cons (((dest :lisp))
+                                 ((car :lisp) (cdr :lisp))
+                                 ())
+  (stwu arm::tsp -16 arm::tsp)
+  (stw arm::tsp 4 arm::tsp)
+  (stfd arm::fp-zero 8 arm::tsp)
+  (stw arm::rzero 4 arm::tsp)
+  (stw car (+ 8 arm::fulltag-cons arm::cons.car) arm::tsp)
+  (stw cdr (+ 8 arm::fulltag-cons arm::cons.cdr) arm::tsp)
+  (la dest (+ 8 arm::fulltag-cons) arm::tsp))
+
+
+(define-arm-vinsn %closure-code% (((dest :lisp))
+                                  ())
+  (lwz dest (:apply + arm::symbol.vcell (arm::nrs-offset %closure-code%) (:apply target-nil-value)) 0))
+
+
+(define-arm-vinsn single-float-bits (((dest :u32))
+                                     ((src :lisp)))
+  (lwz dest arm::single-float.value src))
+
+(define-arm-vinsn (call-subprim :call :subprim-call) (()
+                                                      ((spno :s32const)))
+  (bl spno))
+
+(define-arm-vinsn (jump-subprim :jumpLR) (()
+                                          ((spno :s32const)))
+  (ba spno))
+
+;;; Same as "call-subprim", but gives us a place to 
+;;; track args, results, etc.
+(define-arm-vinsn (call-subprim-0 :call :subprim-call) (((dest t))
+                                                        ((spno :s32const)))
+  (bl spno))
+
+(define-arm-vinsn (call-subprim-1 :call :subprim-call) (((dest t))
+                                                        ((spno :s32const)
+                                                         (z t)))
+  (bl spno))
+  
+(define-arm-vinsn (call-subprim-2 :call :subprim-call) (((dest t))
+                                                        ((spno :s32const)
+                                                         (y t)
+                                                         (z t)))
+  (bl spno))
+
+(define-arm-vinsn (call-subprim-3 :call :subprim-call) (((dest t))
+                                                        ((spno :s32const)
+                                                         (x t)
+                                                         (y t)
+                                                         (z t)))
+  (bl spno))
+
+
+
+(define-arm-vinsn ref-interrupt-level (((dest :imm))
+                                       ()
+                                       ((temp :u32)))
+  (lwz temp arm::tcr.tlb-pointer arm::rcontext)
+  (lwz dest arm::INTERRUPT-LEVEL-BINDING-INDEX temp))
+
+                         
+;;; Unconditional (pc-relative) branch
+(define-arm-vinsn (jump :jump) (()
+                                ((label :label)))
+  (b label))
+
+(define-arm-vinsn (call-label :call) (()
+                                      ((label :label)))
+  (bl label))
+
+;;; just like JUMP, only (implicitly) asserts that the following 
+;;; code is somehow reachable.
+(define-arm-vinsn (non-barrier-jump :xref) (()
+                                            ((label :label)))
+  (b label))
+
+
+(define-arm-vinsn (cbranch-true :branch) (()
+                                          ((label :label)
+                                           (crbit :u8const)))
+  (b (:? crbit) label))
+
+(define-arm-vinsn (cbranch-false :branch) (()
+                                           ((label :label)
+                                            (crbit :u8const)))
+  (b (:~ crbit) label))
+
+
+
+
+(define-arm-vinsn lisp-word-ref (((dest t))
+                                 ((base t)
+                                  (offset t)))
+  (ldr dest (:@ base offset)))
+
+(define-arm-vinsn lisp-word-ref-c (((dest t))
+                                   ((base t)
+                                    (offset :s16const)))
+  (ldr dest (:@ base (:$ offset))))
+
+  
+
+;; Load an unsigned, 32-bit constant into a destination register.
+(define-arm-vinsn (lri :constant-ref) (((dest :imm))
+                                       ((intval :u32const))
+                                       ())
+  ((:pred arm::encode-arm-immediate intval)
+   (mov dest (:$ intval)))
+  ((:not (:pred arm::encode-arm-immediate intval))
+   ((:pred arm::encode-arm-immediate (:apply lognot intval))
+    (mvn dest (:$ (:apply lognot intval))))
+   ((:not (:pred arm::encode-arm-immediate (:apply lognot intval)))
+    (:section :data)
+    :const
+    (:word intval)
+    (:section :text)
+    (ldr dest :const))))
+
+
+#+notyet
+(define-arm-vinsn (discard-temp-frame :tsp :pop :discard) (()
+                                                           ())
+  (lwz arm::tsp 0 arm::tsp))
+
+
+(define-arm-vinsn alloc-c-frame (()
+                                 ((n-c-args :u16const))
+                                 ((header :u32)
+                                  (size :imm)
+                                  (prevsp :imm)))
+  (mov header (:$ (:apply ash (:apply + 1 (:apply logandc2 (:apply + 4 1 n-c-args) 1)) arm::num-subtag-bits)))
+  (mov size (:lsr header (:$ (- arm::num-subtag-bits arm::word-shift))))
+  (orr header (:$ arm::subtag-u32-vector))
+  (mov prevsp sp)
+  (add size size (:$ arm::node-size))
+  (str header (:-@! sp size))
+  (str prevsp (:@ sp (:$ 4))))
+
+(define-arm-vinsn alloc-variable-c-frame (()
+                                          ((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))
+  (add size size (:$ arm::fixnumone))
+  (mov prevsp sp)
+  (mov header (:lsl size (:$ (- arm::num-subtag-bits arm::fixnumshift))))
+  (add size size (:$ arm::fixnumone))
+  (orr header header (:$ arm::subtag-u32-vector))
+  (str header (:-@! sp size))
+  (str prevsp (:@ sp (:$ 4))))
+
+
+
+;;; We should rarely have to do this - (#_foo x y (if .. (return-from ...)))
+;;; is one of the few cases that I can think of - but if we ever do, we
+;;; 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) (()
+                                                        ())
+  (ldr sp (:@ sp (:$ 4))))
+
+
+
+
+(define-arm-vinsn set-c-arg (()
+                             ((argval :u32)
+                              (argnum :u16const)))
+  (str argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
+
+(define-arm-vinsn set-single-c-arg (()
+                                    ((argval :single-float)
+                                     (argnum :u16const)))
+  (fsts argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
+
+(define-arm-vinsn set-double-c-arg (()
+                                    ((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))
+                                            ())
+  (mov dest (:$ arm::nil-value)))
+
+(define-arm-vinsn (load-t :constant-ref) (((dest t))
+                                          ())
+  (mov dest (:$ arm::nil-value))
+  (add dest dest (:$ arm::t-offset)))
+
+(define-arm-vinsn set-eq-bit (((dest :crf))
+                              ())
+  (creqv (:apply + arm::arm-eq-bit dest)
+	 (:apply + arm::arm-eq-bit dest)
+	 (:apply + arm::arm-eq-bit dest)))
+
+(define-arm-vinsn (ref-constant :constant-ref) (((dest :lisp))
+                                                ((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)))
+  (lwzx dest arm::fn idxreg))
+
+
+(define-arm-vinsn cons (((dest :lisp))
+                        ((newcar :lisp)
+                         (newcdr :lisp)))
+  (la arm::allocptr (- arm::fulltag-cons arm::cons.size) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw newcdr arm::cons.cdr arm::allocptr)
+  (stw newcar arm::cons.car arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits))
+
+
+
+;; subtag had better be a ARM-NODE-SUBTAG of some sort!
+(define-arm-vinsn %arm-gvector (((dest :lisp))
+                                ((Rheader :u32) 
+                                 (nbytes :u32const))
+                                ((immtemp0 :u32)
+                                 (nodetemp :lisp)
+                                 (crf :crf)))
+  (la arm::allocptr (:apply - arm::fulltag-misc
+                            (:apply logand (lognot 7)
+                                    (:apply + (+ 7 4) nbytes)))
+      arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw Rheader arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  ((:not (:pred = nbytes 0))
+   (li immtemp0 (:apply + arm::misc-data-offset nbytes))
+   :loop
+   (subi immtemp0 immtemp0 4)
+   (cmpwi crf immtemp0 arm::misc-data-offset)
+   (lwz nodetemp 0 arm::vsp)
+   (la arm::vsp 4 arm::vsp)   
+   (stwx nodetemp dest immtemp0)
+   (bne crf :loop)))
+
+;; allocate a small (phys size <= 32K bytes) misc obj of known size/subtag
+(define-arm-vinsn %alloc-misc-fixed (((dest :lisp))
+                                     ((Rheader :u32)
+                                      (nbytes :u32const)))
+  (la arm::allocptr (:apply - arm::fulltag-misc
+                            (:apply logand (lognot 7)
+                                    (:apply + (+ 7 4) nbytes)))
+      arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw Rheader arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits))
+
+(define-arm-vinsn (vstack-discard :vsp :pop :discard) (()
+                                                       ((nwords :u32const)))
+  ((:not (:pred = nwords 0))
+   (la arm::vsp (:apply ash nwords arm::word-shift) arm::vsp)))
+
+
+(define-arm-vinsn lcell-load (((dest :lisp))
+                              ((cell :lcell)
+                               (top :lcell)))
+  (lwz dest (:apply - 
+                    (:apply - (:apply calc-lcell-depth top) 4)
+                    (:apply calc-lcell-offset cell)) arm::vsp))
+
+(define-arm-vinsn vframe-load (((dest :lisp))
+                               ((frame-offset :u16const)
+                                (cur-vsp :u16const)))
+  (lwz dest (:apply - (:apply - cur-vsp 4) frame-offset) arm::vsp))
+
+(define-arm-vinsn lcell-store (()
+                               ((src :lisp)
+                                (cell :lcell)
+                                (top :lcell)))
+  (stw src (:apply - 
+                   (:apply - (:apply calc-lcell-depth top) 4)
+                   (:apply calc-lcell-offset cell)) arm::vsp))
+
+(define-arm-vinsn vframe-store (()
+                                ((src :lisp)
+                                 (frame-offset :u16const)
+                                 (cur-vsp :u16const)))
+  (stw src (:apply - (:apply - cur-vsp 4) frame-offset) arm::vsp))
+
+(define-arm-vinsn load-vframe-address (((dest :imm))
+                                       ((offset :s16const)))
+  (la dest offset arm::vsp))
+
+(define-arm-vinsn copy-lexpr-argument (()
+                                       ()
+                                       ((temp :lisp)))
+  (lwzx temp arm::vsp nargs)
+  (stwu temp -4 arm::vsp))
+
+;;; Boxing/unboxing of integers.
+
+;;; 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)) 
+                              ())
+  (rlwinm result val arm::fixnumshift (- arm::nbits-in-word (+ 8 arm::fixnumshift)) (- arm::least-significant-bit 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)) 
+                              ())
+  (extlwi result val 8 (- arm::nbits-in-word 8))
+  (srawi result result (- (- arm::nbits-in-word 8) arm::fixnumshift)))
+
+
+;;; 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)) 
+                               ())
+  (rlwinm result val arm::fixnumshift (- arm::nbits-in-word (+ 16 arm::fixnumshift)) (- arm::least-significant-bit 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)) 
+                               ())
+  (mov result (:lsl val (:$ 16)))
+  (mov result (:asr result (:$ (- 16 arm::fixnumshift)))))
+
+(define-arm-vinsn fixnum->s16 (((result :s16))
+                               ((src :imm)))
+  (mov result (:asr src (:$ arm::fixnumshift))))
+
+;;; A signed 32-bit untagged value can be at worst a 1-digit bignum.
+;;; There should be something very much like this that takes a stack-consed
+;;; bignum result ...
+(define-arm-vinsn s32->integer (((result :lisp))
+                                ((src :s32))
+                                ((temp :s32)))        
+  (adds temp src src)
+  (addsvc result temp temp)
+  (bvc :done)
+  (mov temp (:$ arm::subtag-bignum))
+  (orr temp temp (:$ (ash 1 arm::num-subtag-bits)))
+  (add arm::allocptr arm::allocptr (:$ (- arm::fulltag-misc 8)))
+  (ldr result (:@ rcontext (:$ arm::tcr.save_allocbase)))
+  (cmp allocptr result)
+  (uuo-alloc-trap-one (:? lo))
+  (str temp (:@ allocptr (:$ arm::misc-header-offset)))
+  (mov result allocptr)
+  (bic allocptr allocptr (:$ arm::fulltagmask))
+  (str src (:@ result (:$ arm::misc-data-offset)))
+  :done)
+
+
+;;; An unsigned 32-bit untagged value can be either a 1 or a 2-digit bignum.
+(define-arm-vinsn u32->integer (((result :lisp))
+                                ((src :u32))
+                                ((crf (:crf 0)) ; a casualty
+                                 (temp :s32)
+                                 (size :u32)))
+  (clrrwi. temp src (- arm::least-significant-bit arm::nfixnumtagbits))
+  (slwi result src arm::fixnumshift)
+  (beq+ crf :done)
+  (cmpwi src 0)
+  (li temp arm::one-digit-bignum-header)
+  (li size (- 8 arm::fulltag-misc))
+  (bgt :common)
+  (li temp arm::two-digit-bignum-header)
+  (li size (- 16 arm::fulltag-misc))
+  :common
+  (sub arm::allocptr arm::allocptr size)
+  (twllt arm::allocptr arm::allocbase)
+  (stw temp arm::misc-header-offset arm::allocptr)
+  (mr result arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stw src arm::misc-data-offset result)
+  :done)
+
+(define-arm-vinsn u16->u32 (((dest :u32))
+                            ((src :u16)))
+  (clrlwi dest src 16))
+
+(define-arm-vinsn u8->u32 (((dest :u32))
+                           ((src :u8)))
+  (clrlwi dest src 24))
+
+
+(define-arm-vinsn s16->s32 (((dest :s32))
+                            ((src :s16)))
+  (extsh dest src))
+
+(define-arm-vinsn s8->s32 (((dest :s32))
+                           ((src :s8)))
+  (extsb dest src))
+
+
+;;; ... of floats ...
+
+;;; Heap-cons a double-float to store contents of FPREG.  Hope that we don't do
+;;; this blindly.
+(define-arm-vinsn double->heap (((result :lisp)) ; tagged as a double-float
+                                ((fpreg :double-float)) 
+                                ((header-temp :u32)))
+  (li header-temp (arch::make-vheader arm::double-float.element-count arm::subtag-double-float))
+  (la arm::allocptr (- arm::fulltag-misc arm::double-float.size) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header-temp arm::misc-header-offset arm::allocptr)
+  (mr result arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stfd fpreg arm::double-float.value result)  )
+
+
+;;; This is about as bad as heap-consing a double-float.  (In terms of
+;;; verbosity).  Wouldn't kill us to do either/both out-of-line, but
+;;; need to make visible to compiler so unnecessary heap-consing can
+;;; be elided.
+(define-arm-vinsn single->node (((result :lisp)) ; tagged as a single-float
+                                ((fpreg :single-float))
+                                ((header-temp :u32)))
+  (li header-temp (arch::make-vheader arm::single-float.element-count arm::subtag-single-float))
+  (la arm::allocptr (- arm::fulltag-misc arm::single-float.size) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header-temp arm::misc-header-offset arm::allocptr)
+  (mr result arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stfs fpreg arm::single-float.value result))
+
+
+;;; "dest" is preallocated, presumably on a stack somewhere.
+(define-arm-vinsn store-double (()
+                                ((dest :lisp)
+                                 (source :double-float))
+                                ())
+  (stfd source arm::double-float.value dest))
+
+(define-arm-vinsn get-double (((target :double-float))
+                              ((source :lisp))
+                              ())
+  (lfd target arm::double-float.value source))
+
+;;; Extract a double-float value, typechecking in the process.
+;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
+;;; instead of replicating it ..
+
+(define-arm-vinsn get-double? (((target :double-float))
+                               ((source :lisp))
+                               ((tag :u8)))
+  (and tag source (:$ arm::tagmask))
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ source (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-double-float))
+  (uuo-error-reg-not-xtype (:? ne) source (:$ arm::subtag-double-float))
+  (ldrd imm0 imm1 (:@ source (:$ arm::double-float.value)))
+  (fmrrd target imm0 imm1))
+  
+
+(define-arm-vinsn double-to-single (((result :single-float))
+                                    ((arg :double-float)))
+  (frsp result arg))
+
+(define-arm-vinsn store-single (()
+                                ((dest :lisp)
+                                 (source :single-float))
+                                ())
+  (stfs source arm::single-float.value dest))
+
+(define-arm-vinsn get-single (((target :single-float))
+                              ((source :lisp))
+                              ())
+  (lfs target arm::single-float.value source))
+
+;;; ... of characters ...
+
+
+(define-arm-vinsn character->fixnum (((dest :lisp))
+                                     ((src :lisp))
+                                     ())
+  (bic dest src (:$ arm::subtag-mask))
+  (mov dest (:lsr dest (:$ (- arm::ncharcodebits arm::fixnumshift)))))
+
+(define-arm-vinsn character->code (((dest :u32))
+                                   ((src :lisp)))
+  (mov dest (:lsr src (:$ arm::charcode-shift))))
+
+
+(define-arm-vinsn fixnum->char (((dest :lisp))
+                                ((src :imm))
+                                ((temp :u32)
+                                 (crf0 (:crf 0))))
+  (srwi temp src (+ arm::fixnumshift 1))
+  (cmplwi temp (ash #xffff -1))
+  (srwi temp src (+ arm::fixnumshift 11))
+  (beq :bad)
+  (cmpwi temp 27)
+  (slwi dest src (- arm::charcode-shift arm::fixnumshift))
+  (bne+ :ok)
+  :bad
+  (li dest (:apply target-nil-value))
+  (b :done)
+  :ok
+  (addi dest dest arm::subtag-character)
+  :done)
+
+;;; src is known to be a code for which CODE-CHAR returns non-nil.
+(define-arm-vinsn code-char->char (((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))
+                             ())
+  (mov dest (:lsl src (:$ arm::charcode-shift)))
+  (orr dest dest (:$ arm::subtag-character)))
+
+;; ... Macptrs ...
+
+(define-arm-vinsn deref-macptr (((addr :address))
+                                ((src :lisp))
+                                ())
+  (ldr addr (:@ src (:$ arm::macptr.address))))
+
+(define-arm-vinsn set-macptr-address (()
+                                      ((addr :address)
+                                       (src :lisp))
+                                      ())
+  (str addr (:@ src (:$ arm::macptr.address))))
+
+
+(define-arm-vinsn macptr->heap (((dest :lisp))
+                                ((address :address))
+                                ((header :u32)))
+  (li header (logior (ash arm::macptr.element-count arm::num-subtag-bits) arm::subtag-macptr))
+  (la arm::allocptr (- arm::fulltag-misc arm::macptr.size) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  ;; It's not necessary to zero out the domain/type fields, since newly
+  ;; heap-allocated memory's guaranteed to be 0-filled.
+  (stw address arm::macptr.address dest))
+
+(define-arm-vinsn macptr->stack (((dest :lisp))
+                                 ((address :address))
+                                 ((header :u32)))
+  (li header arm::macptr-header)
+  (stwu arm::tsp (- (+ 8 arm::macptr.size)) arm::tsp)
+  (stw arm::tsp 4 arm::tsp)
+  (stw header (+ 8 arm::fulltag-misc arm::macptr.header) arm::tsp)
+  (stw address (+ 8 arm::fulltag-misc arm::macptr.address) arm::tsp)
+  ;; It -is- necessary to zero out the domain/type fields here, since
+  ;; stack-allocated memory isn't guaranteed to be 0-filled.
+  (stfd arm::fp-zero (+ 8 arm::fulltag-misc arm::macptr.domain) arm::tsp)
+  (la dest (+ 8 arm::fulltag-misc) arm::tsp))
+
+  
+(define-arm-vinsn adjust-stack-register (()
+                                         ((reg t)
+                                          (amount :s16const)))
+  (add reg reg (:$ amount)))
+
+(define-arm-vinsn adjust-vsp (()
+                              ((amount :s16const)))
+  (la arm::vsp amount arm::vsp))
+
+(define-arm-vinsn adjust-sp (()
+                             ((amount :s16const)))
+  (la arm::sp amount arm::sp))
+
+;; Arithmetic on fixnums & unboxed numbers
+
+(define-arm-vinsn u32-lognot (((dest :u32))
+                              ((src :u32))
+                              ())
+  (mvn dest src))
+
+(define-arm-vinsn fixnum-lognot (((dest :imm))
+                                 ((src :imm))
+                                 ((temp :u32)))
+  (mvn temp src)
+  (bic dest temp (:$ arm::fixnummask)))
+
+
+(define-arm-vinsn negate-fixnum-overflow-inline (((dest :lisp))
+                                                 ((src :imm))
+                                                 ((unboxed :s32)
+                                                  (header :u32)))
+  (nego. dest src)
+  (bns+ :done)
+  (mtxer arm::rzero)
+  (srawi unboxed dest arm::fixnumshift)
+  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
+  (li header arm::one-digit-bignum-header)
+  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stw unboxed arm::misc-data-offset dest)
+  :done)
+
+(define-arm-vinsn negate-fixnum-overflow-ool (()
+                                              ((src :imm))
+                                              )
+  (nego. arm::arg_z src)
+  (bsola- .SPfix-overflow)
+  :done)
+  
+                                                  
+                                       
+(define-arm-vinsn negate-fixnum-no-ovf (((dest :lisp))
+                                        ((src :imm)))
+  
+  (neg dest src))
+  
+
+(define-arm-vinsn logior-high (((dest :imm))
+                               ((src :imm)
+                                (high :u16const)))
+  (oris dest src high))
+
+(define-arm-vinsn logior-low (((dest :imm))
+                              ((src :imm)
+                               (low :u16const)))
+  (ori dest src low))
+
+                           
+                           
+(define-arm-vinsn %logior2 (((dest :imm))
+                            ((x :imm)
+                             (y :imm))
+                            ())
+  (or dest x y))
+
+(define-arm-vinsn logand-high (((dest :imm))
+                               ((src :imm)
+                                (high :u16const))
+                               ((crf0 (:crf 0))))
+  (andis. dest src high))
+
+(define-arm-vinsn logand-low (((dest :imm))
+                              ((src :imm)
+                               (low :u16const))
+                              ((crf0 (:crf 0))))
+  (andi. dest src low))
+
+
+(define-arm-vinsn %logand2 (((dest :imm))
+                            ((x :imm)
+                             (y :imm))
+                            ())
+  (and dest x y))
+
+(define-arm-vinsn clear-left (((dest :imm))
+                              ((src :imm)
+                               (nbits :s8const)))
+  (rlwinm dest src 0 (:apply 1+ nbits) 31))
+
+(define-arm-vinsn clear-right (((dest :imm))
+                               ((src :imm)
+                                (nbits :s8const)))
+  (rlwinm dest src 0 0 (:apply - 31 nbits)))
+
+                               
+(define-arm-vinsn logxor-high (((dest :imm))
+                               ((src :imm)
+                                (high :u16const)))
+  (xoris dest src high))
+
+(define-arm-vinsn logxor-low (((dest :imm))
+                              ((src :imm)
+                               (low :u16const)))
+  (xori dest src low))
+
+                           
+
+(define-arm-vinsn %logxor2 (((dest :imm))
+                            ((x :imm)
+                             (y :imm))
+                            ())
+  (xor dest x y))
+
+(define-arm-vinsn %ilsl (((dest :imm))
+                         ((count :imm)
+                          (src :imm))
+                         ((temp :u32)
+                          (crx :crf)))
+  (cmpwi crx count (ash 31 arm::fixnumshift))
+  (srwi temp count arm::fixnumshift)
+  (slw dest src temp)
+  (ble+ crx :foo)
+  (li dest 0)
+  :foo)
+
+(define-arm-vinsn %ilsl-c (((dest :imm))
+                           ((count :u8const)
+                            (src :imm)))
+                                        ; Hard to use armmacroinstructions that expand into expressions involving variables.
+  (rlwinm dest src count 0 (:apply - arm::least-significant-bit count)))
+
+
+(define-arm-vinsn %ilsr-c (((dest :imm))
+                           ((count :u8const)
+                            (src :imm))
+                           (temp :s32))
+  (mov temp (:lsr src (:$ count)))
+  (bic test src (:$ fixnummask)))
+
+
+(define-arm-vinsn %iasr (((dest :imm))
+                         ((count :imm)
+                          (src :imm))
+                         ((temp :s32)))
+  (cmp count (:$ (ash 31 arm::fixnumshift)))
+  (mov temp (:asr count (:$ arm::fixnumshift)))
+  (mov temp (:asr src temp))
+  (movgt temp (:asr src (:$ 31)))
+  (bic test temp (:$ arm::fixnummask)))
+
+(define-arm-vinsn %iasr-c (((dest :imm))
+                           ((count :u8const)
+                            (src :imm))
+                           ((temp :s32)))
+  (mov temp (:asr src (:$ count)))
+  (bic dest src (:$ arm::fixnummask)))
+
+(define-arm-vinsn %ilsr (((dest :imm))
+                         ((count :imm)
+                          (src :imm))
+                         ((temp :s32)
+                          (crx :crf)))
+  (cmpwi crx count (ash 31 arm::fixnumshift))
+  (srwi temp count arm::fixnumshift)
+  (srw temp src temp)
+  (clrrwi dest temp arm::fixnumshift)
+  (ble+ crx :foo)
+  (li dest 0)
+  :foo  
+  )
+
+#+maybe
+(define-arm-vinsn %ilsr-c (((dest :imm))
+                           ((count :u8const)
+                            (src :imm))
+                           ((temp :s32)))
+  (rlwinm temp src (:apply - 32 count) count 31)
+  (clrrwi dest temp arm::fixnumshift))
+
+(define-arm-vinsn natural-shift-left (((dest :u32))
+                                      ((src :u32)
+                                       (count :u8const)))
+  (rlwinm dest src count 0 (:apply - 31 count)))
+
+(define-arm-vinsn natural-shift-right (((dest :u32))
+                                       ((src :u32)
+                                        (count :u8const)))
+  (rlwinm dest src (:apply - 32 count) count 31))
+
+
+(define-arm-vinsn trap-unless-simple-array-2 (()
+                                              ((object :lisp)
+                                               (expected-flags :u32const)
+                                               (type-error :u8const))
+                                              ((tag :u8)
+                                               (flags :u32)
+                                               (crf :crf)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi crf tag arm::tag-misc)
+  (bne crf :bad)
+  (lbz tag arm::misc-subtag-offset object)
+  (cmpwi crf tag arm::subtag-arrayH)
+  (bne crf :bad) 
+  (lwz tag arm::arrayH.rank object)
+  (cmpwi crf tag (ash 2 arm::fixnumshift))
+  (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags arm::fixnumshift)))
+       
+  (lwz flags arm::arrayH.flags object)
+  (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags arm::fixnumshift)))
+  (bne crf :bad)
+  (cmpw crf tag flags)
+  (beq crf :good)
+  :bad
+  (uuo_interr type-error object)
+  :good)
+
+(define-arm-vinsn trap-unless-simple-array-3 (()
+                                              ((object :lisp)
+                                               (expected-flags :u32const)
+                                               (type-error :u8const))
+                                              ((tag :u8)
+                                               (flags :u32)
+                                               (crf :crf)))
+  (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi crf tag arm::tag-misc)
+  (bne crf :bad)
+  (lbz tag arm::misc-subtag-offset object)
+  (cmpwi crf tag arm::subtag-arrayH)
+  (bne crf :bad) 
+  (lwz tag arm::arrayH.rank object)
+  (cmpwi crf tag (ash 3 arm::fixnumshift))
+  (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags arm::fixnumshift)))
+       
+  (lwz flags arm::arrayH.flags object)
+  (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags arm::fixnumshift)))
+  (bne crf :bad)
+  (cmpw crf tag flags)
+  (beq crf :good)
+  :bad
+  (uuo_interr type-error object)
+  :good)
+  
+  
+  
+  
+(define-arm-vinsn sign-extend-halfword (((dest :imm))
+                                        ((src :imm)))
+  (slwi dest src (- 16 arm::fixnumshift))
+  (srawi dest dest (- 16 arm::fixnumshift)))
+
+(define-arm-vinsn s32-highword (((dest :imm))
+                                ((src :s32))
+                                ((temp :s32)))
+  (srawi temp src 16)
+  (slwi dest temp arm::fixnumshift))
+
+                            
+
+(define-arm-vinsn fixnum-add (((dest t))
+                              ((x t)
+                               (y t)))
+  (add dest x y))
+
+
+(define-arm-vinsn fixnum-add-overflow-ool (()
+                                           ((x :imm)
+                                            (y :imm))
+                                           ((cr0 (:crf 0))))
+  (addo. arm::arg_z x y)
+  (bsola- .SPfix-overflow))
+
+(define-arm-vinsn fixnum-add-overflow-inline (((dest :lisp))
+                                              ((x :imm)
+                                               (y :imm))
+                                              ((cr0 (:crf 0))
+                                               (unboxed :s32)
+                                               (header :u32)))
+  (addo. dest x y)
+  (bns+ cr0 :done)
+  (mtxer arm::rzero)
+  (srawi unboxed dest arm::fixnumshift)
+  (li header arm::one-digit-bignum-header)
+  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
+  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stw unboxed arm::misc-data-offset dest)
+  :done)
+
+(define-arm-vinsn fixnum-add-overflow-inline-skip (((dest :lisp))
+                                                   ((x :imm)
+                                                    (y :imm)
+                                                    (target :label))
+                                                   ((cr0 (:crf 0))
+                                                    (unboxed :s32)
+                                                    (header :u32)))
+  (addo. dest x y)
+  (bns+ cr0 target)
+  (mtxer arm::rzero)
+  (srawi unboxed dest arm::fixnumshift)
+  (li header arm::one-digit-bignum-header)
+  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
+  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stw unboxed arm::misc-data-offset dest)
+  (b target))
+  
+
+  
+
+;;;  (setq dest (- x y))
+(define-arm-vinsn fixnum-sub (((dest t))
+                              ((x t)
+                               (y t)))
+  (subf dest y x))
+
+(define-arm-vinsn fixnum-sub-from-constant (((dest :imm))
+                                            ((x :s16const)
+                                             (y :imm)))
+  (subfic dest y (:apply ash x arm::fixnumshift)))
+
+
+
+
+(define-arm-vinsn fixnum-sub-overflow-ool (()
+                                           ((x :imm)
+                                            (y :imm)))
+  (subo. arm::arg_z x y)
+  (bsola- .SPfix-overflow))
+
+(define-arm-vinsn fixnum-sub-overflow-inline (((dest :lisp))
+                                              ((x :imm)
+                                               (y :imm))
+                                              ((cr0 (:crf 0))
+                                               (unboxed :s32)
+                                               (header :u32)))
+  (subo. dest x y)
+  (bns+ cr0 :done)
+  (mtxer arm::rzero)
+  (srawi unboxed dest arm::fixnumshift)
+  (li header arm::one-digit-bignum-header)
+  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
+  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stw unboxed arm::misc-data-offset dest)
+  :done)
+
+(define-arm-vinsn fixnum-sub-overflow-inline-skip (((dest :lisp))
+                                                   ((x :imm)
+                                                    (y :imm)
+                                                    (target :label))
+                                                   ((cr0 (:crf 0))
+                                                    (unboxed :s32)
+                                                    (header :u32)))
+  (subo. dest x y)
+  (bns+ cr0 target)
+  (mtxer arm::rzero)
+  (srawi unboxed dest arm::fixnumshift)
+  (li header arm::one-digit-bignum-header)
+  (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
+  (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
+  (twllt arm::allocptr arm::allocbase)
+  (stw header arm::misc-header-offset arm::allocptr)
+  (mr dest arm::allocptr)
+  (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
+  (stw unboxed arm::misc-data-offset dest)
+  (b target))
+
+;;; This is, of course, also "subtract-immediate."
+(define-arm-vinsn add-immediate (((dest t))
+                                 ((src t)
+                                  (upper :u32const)
+                                  (lower :u32const)))
+  ((:not (:pred = upper 0))
+   (addis dest src upper)
+   ((:not (:pred = lower 0))
+    (addi dest dest lower)))
+  ((:and (:pred = upper 0) (:not (:pred = lower 0)))
+   (addi dest src lower)))
+
+;This must unbox one reg, but hard to tell which is better.
+;(The one with the smaller absolute value might be)
+(define-arm-vinsn multiply-fixnums (((dest :imm))
+                                    ((a :imm)
+                                     (b :imm))
+                                    ((unboxed :s32)))
+  (srawi unboxed b arm::fixnumshift)
+  (mullw dest a unboxed))
+
+(define-arm-vinsn multiply-immediate (((dest :imm))
+                                      ((boxed :imm)
+                                       (const :s16const)))
+  (mulli dest boxed const))
+
+;;; 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)))
+  (clrlwi dest src (- arm::nbits-in-word arm::charcode-shift)))
+
+;;; Set dest (of type :s32!) to 0 iff VAL is an istruct of type TYPE
+(define-arm-vinsn istruct-typep (((dest :s32))
+                                 ((val :lisp)
+                                  (type :lisp))
+                                 ((crf :crf)
+                                  (temp :lisp)))
+  (clrlwi dest val (- arm::nbits-in-word arm::nlisptagbits))
+  (cmpwi crf dest arm::tag-misc)
+  (li dest -1)
+  (bne crf :done)
+  (lbz dest arm::misc-subtag-offset val)
+  (cmpwi crf dest arm::subtag-istruct)
+  (bne crf :done)
+  (lwz temp arm::misc-data-offset val)
+  (subf dest type temp)
+  :done)
+  
+  
+;; Boundp, fboundp stuff.
+(define-arm-vinsn (ref-symbol-value :call :subprim-call)
+    (((val :lisp))
+     ((sym (:lisp (:ne val)))))
+  (bl .SPspecrefcheck))
+
+(define-arm-vinsn ref-symbol-value-inline (((dest :lisp))
+                                           ((src (:lisp (:ne dest))))
+                                           ((table :imm)
+                                            (idx :imm)))
+  (lwz idx arm::symbol.binding-index src)
+  (lwz table arm::tcr.tlb-limit arm::rcontext)
+  (cmpw idx table)
+  (lwz table arm::tcr.tlb-pointer arm::rcontext)
+  (bge :symbol)
+  (lwzx dest table idx)
+  (cmpwi dest arm::subtag-no-thread-local-binding)
+  (bne :done)
+  :symbol
+  (lwz dest arm::symbol.vcell src)
+  :done
+  (tweqi dest arm::unbound-marker))
+
+(define-arm-vinsn (%ref-symbol-value :call :subprim-call)
+    (((val :lisp))
+     ((sym (:lisp (:ne val)))))
+  (bl .SPspecref))
+
+(define-arm-vinsn %ref-symbol-value-inline (((dest :lisp))
+                                            ((src (:lisp (:ne dest))))
+                                            ((table :imm)
+                                             (idx :imm)))
+  (lwz idx arm::symbol.binding-index src)
+  (lwz table arm::tcr.tlb-limit arm::rcontext)
+  (cmpw idx table)
+  (lwz table arm::tcr.tlb-pointer arm::rcontext)
+  (bge :symbol)
+  (lwzx dest table idx)
+  (cmpwi dest arm::subtag-no-thread-local-binding)
+  (bne :done)
+  :symbol
+  (lwz dest arm::symbol.vcell src)
+  :done
+  )
+
+(define-arm-vinsn (setq-special :call :subprim-call)
+    (()
+     ((sym :lisp)
+      (val :lisp)))
+  (bl .SPspecset))
+
+
+(define-arm-vinsn symbol-function (((val :lisp))
+                                   ((sym (:lisp (:ne val))))
+                                   ((crf :crf)
+                                    (tag :u32)))
+  (lwz val arm::symbol.fcell sym)
+  (clrlwi tag val (- 32 arm::nlisptagbits))
+  (cmpwi crf tag arm::tag-misc)
+  (bne- crf :bad)
+  (lbz tag arm::misc-subtag-offset val)
+  (cmpwi crf tag arm::subtag-function)
+  (beq+ crf :good)
+  :bad 
+  (uuo_interr arch::error-udf sym)
+  :good)
+
+(define-arm-vinsn (temp-push-unboxed-word :push :word :sp)
+    (()
+     ((w :u32))
+     ((header :u32)))
+  (mov header (:$ arm::subtag-u32-vector))
+  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
+  (str header (:@ sp (:$ (- arm::dnode-size))))
+  (str w (:@ sp 4)))
+
+(define-arm-vinsn (temp-pop-unboxed-word :pop :word :sp)
+    (((w :u32))
+     ())
+  (ldr w (:@ sp (:$ 4)))
+  (add sp sp (:$ arm::dnode-size)))
+
+(define-arm-vinsn (temp-push-double-float :push :doubleword :sp)
+    (()
+     ((d :double-float))
+     ((header :u32)))
+  (mov header (:$ arm::subtag-double-float))
+  (orr header header (:$ (ash arm::double-float.element-count arm::num-subtag-bits)))
+  (str header (:@! sp (:$ (- (* 2 arm::dnode-size)))))
+  (fstd d (:@ sp (:$ 8))))
+
+(define-arm-vinsn (temp-pop-double-float :pop :doubleword :sp)
+    (()
+     ((d :double-float)))
+  (fldd d (:@ sp (:$ 8)))
+  (add sp sp (:$ (* 2 arm::dnode-size))))
+
+(define-arm-vinsn (temp-push-single-float :push :word :tsp)
+    (()
+     ((s :single-float))
+     ((header :u32)))
+  (mov header (:$ arm::subtag-single-float))
+  (orr header header (:$ (ash arm::single-float.element-count arm::num-subtag-bits)))
+  (str header (:@! sp (:$ (- arm::dnode-size))))
+  (fsts s (:@ sp (:$ 4))))
+
+(define-arm-vinsn (temp-pop-single-float :pop :word :sp)
+    (()
+     ((s :single-float)))
+  (flds s (:@ sp 4))
+  (add sp sp (:$ arm::dnode-size)))
+
+
+
+(define-arm-vinsn %current-frame-ptr (((dest :imm))
+                                      ())
+  (mov dest arm::sp))
+
+(define-arm-vinsn %current-tcr (((dest :imm))
+                                ())
+  (mov dest arm::rcontext))
+
+(define-arm-vinsn (dpayback :call :subprim-call) (()
+                                                  ((n :s16const))
+                                                  ((temp (:u32 #.arm::imm0))))
+  ((:pred > n 1)
+   (mov temp (:$ n))
+   (bl .SPunbind-n))
+  ((:pred = n 1)
+   (bl .SPunbind)))
+
+(define-arm-vinsn zero-double-float-register (((dest :double-float))
+                                              ())
+  (fmr dest arm::fp-zero))
+
+(define-arm-vinsn zero-single-float-register (((dest :single-float))
+                                              ())
+  (fmr dest arm::fp-zero))
+
+(define-arm-vinsn load-double-float-constant (((dest :double-float))
+                                              ((high :u32)
+                                               (low :u32)))
+  (fmdrr dest low high))
+
+(define-arm-vinsn load-single-float-constant    (((dest :single-float))
+                                                 ((src t)))
+  (fmsr dest src))
+
+(define-arm-vinsn load-indexed-node (((node :lisp))
+                                     ((base :lisp)
+                                      (offset :s16const)))
+  (ldr node (:@ base (:$ offset))))
+
+(define-arm-vinsn check-exact-nargs (()
+                                     ((n :u16const)))
+  (cmp nargs (:$ (:apply ash n 2)))
+  (uuo-error-wrong-nargs (:ne)))
+
+(define-arm-vinsn check-min-nargs (()
+                                   ((min :u16const)))
+  (cmp nargs (:$ (:apply ash min 2)))
+  (uuo-error-wrong-nargs (:lo)))
+
+
+(define-arm-vinsn check-max-nargs (()
+                                   ((max :u16const)))
+  (cmp nargs (:$ (:apply ash max 2)))
+  (uuo-error-wrong-nargs (:hi)))
+
+;;; Save context and establish FN.  The current VSP is the the
+;;; same as the caller's, e.g., no arguments were vpushed.
+(define-arm-vinsn save-lisp-context-vsp (()
+                                         ()
+                                         ((imm :u32)))
+  (mov imm (:$ arm::lisp-frame-marker))
+  (stmdb (:! sp) (imm vsp fn lr)))
+
+
+
+(define-arm-vinsn save-lisp-context-offset (()
+                                            ((nbytes-vpushed :u16const))
+                                            ((imm :imm)))
+  (add imm vsp (:$ nbytes-vpushed))
+  (mov imm0 (:$ arm::lisp-frame-marker))
+  (stmdb (:! sp) (imm0 imm fn lr)))
+
+
+
+#+later
+(define-arm-vinsn save-lisp-context-lexpr (()
+                                           ()
+                                           ((imm :u32)))
+  (stwu arm::sp (- arm::lisp-frame.size) arm::sp)
+  (stw arm::rzero arm::lisp-frame.savefn arm::sp)
+  (stw arm::loc-pc arm::lisp-frame.savelr arm::sp)
+  (stw arm::vsp arm::lisp-frame.savevsp arm::sp)
+  (mr arm::fn arm::nfn)
+  ;; Do a stack-probe ...
+  (lwz imm arm::tcr.cs-limit arm::rcontext)
+  (twllt arm::sp imm))
+  
+(define-arm-vinsn save-cleanup-context (()
+                                        ())
+  (mov temp2 (:$ 0))
+  (mov imm0 (:$ arm::lisp-frame-marker))  
+  (stmdb (:! sp) (imm0 vsp temp2 lr)))
+
+
+;; Vpush the argument registers.  We got at least "min-fixed" args;
+;; that knowledge may help us generate better code.
+#+later
+(define-arm-vinsn (save-lexpr-argregs :call :subprim-call)
+    (()
+     ((min-fixed :u16const))
+     ((crfx :crf)
+      (crfy :crf)
+      (entry-vsp (:u32 #.arm::imm0))
+      (arg-temp :u32)))
+  ((:pred >= min-fixed $numarmargregs)
+   (stwu arm::arg_x -4 arm::vsp)   
+   (stwu arm::arg_y -4 arm::vsp)   
+   (stwu arm::arg_z -4 arm::vsp))
+  ((:pred = min-fixed 2)                ; at least 2 args
+   (cmplwi crfx nargs (ash 2 arm::word-shift))
+   (beq crfx :yz2)                      ; skip arg_x if exactly 2
+   (stwu arm::arg_x -4 arm::vsp)
+   :yz2
+   (stwu arm::arg_y -4 arm::vsp)
+   (stwu arm::arg_z -4 arm::vsp))
+  ((:pred = min-fixed 1)                ; at least one arg
+   (cmplwi crfx nargs (ash 2 arm::word-shift))
+   (blt crfx :z1)                       ; branch if exactly one
+   (beq crfx :yz1)                      ; branch if exactly two
+   (stwu arm::arg_x -4 arm::vsp)
+   :yz1
+   (stwu arm::arg_y -4 arm::vsp)   
+   :z1
+   (stwu arm::arg_z -4 arm::vsp))
+  ((:pred = min-fixed 0)
+   (cmplwi crfx nargs (ash 2 arm::word-shift))
+   (cmplwi crfy nargs 0)
+   (beq crfx :yz0)                      ; exactly two
+   (beq crfy :none)                     ; exactly zero
+   (blt crfx :z0)                       ; one
+                                        ; Three or more ...
+   (stwu arm::arg_x -4 arm::vsp)
+   :yz0
+   (stwu arm::arg_y -4 arm::vsp)
+   :z0
+   (stwu arm::arg_z -4 arm::vsp)
+   :none
+   )
+  ((:pred = min-fixed 0)
+   (stwu nargs -4 arm::vsp))
+  ((:not (:pred = min-fixed 0))
+   (subi arg-temp nargs (:apply ash min-fixed arm::word-shift))
+   (stwu arg-temp -4 arm::vsp))
+  (add entry-vsp arm::vsp nargs)
+  (la entry-vsp 4 entry-vsp)
+  (bl .SPlexpr-entry))
+
+
+(define-arm-vinsn (jump-return-pc :jumpLR)
+    (()
+     ())
+  (bx lr))
+
+(define-arm-vinsn (restore-full-lisp-context :lispcontext :pop :csp :lrRestore)
+    (()
+     ())
+  (ldmia (:! sp) (imm0 vsp fn lr)))
+
+
+
+
+
+(define-arm-vinsn (popj :lispcontext :pop :csp :lrRestore :jumpLR)
+    (() 
+     ())
+  (ldmia (:! sp) (imm0 vsp fn pc)))
+
+;;; Exiting from an UNWIND-PROTECT cleanup is similar to
+;;; (and a little simpler than) returning from a function.
+(define-arm-vinsn restore-cleanup-context (()
+                                           ())
+  (ldr lr (:@ sp (:$ arm::lisp-frame.savelr))
+  (add sp sp (:$ arm::lisp-frame.size)))
+
+
+
+(define-arm-vinsn default-1-arg (()
+                                 ((min :u16const)))
+  (cmp nargs (:$ (:apply ash min 2)))
+  (bne :done)
+  ((:pred >= min 3)
+   (str arg_x (:@! vsp (:$ (- arm::node-size))))
+  ((:pred >= min 2)
+   (mov arg_x arg_y))
+  ((:pred >= min 1)
+   (mov arg_y arg_z))
+  (move arm::arg_z (:$ arm::nil-value))
+  :done)
+
+(define-arm-vinsn default-2-args (()
+                                  ((min :u16const)))
+  (cmp nargs (:apply ash (:apply 1+ min) 2))
+  (bgt :done)
+  (beq :one)
+  ;; We got "min" args; arg_y & arg_z default to nil
+  ((:pred >= min 3)
+   (str arg_x (:@! vsp (:$ (- arm::node-size)))))   
+  ((:pred >= min 2)
+   (str arg_y (:@! vsp (:$ (- arm::node-size)))))
+  ((:pred >= min 1)
+   (mov arg_x (:$ arm::nil-value)))
+  (mov arg_y (:$ arm::nil-value))
+  (b :last)
+  :one
+  ;; We got min+1 args: arg_y was supplied, arg_z defaults to nil.
+  ((:pred >= min 2)
+   (str arg_x (:@! vsp (:$ (- arm::node-size)))))
+  ((:pred >= min 1)
+   (move arg_x arg_y))
+  (mr arm::arg_y arm::arg_z)
+  :last
+  (mov arg_z (:$ arm::nil-value))
+  :done)
+
+(define-arm-vinsn default-3-args (()
+                                  ((min :u16const)))
+  (cmp nargs (:$ (:apply ash min 2)))
+  (beq :none)
+  (cmp nargs (:$ (:apply ash (:apply + 2 min) 2)))
+
+  (bgt :done)
+  (beq :two)
+  ;; The first (of three) &optional args was supplied.
+  ((:pred >= min 2)
+   (str arg_x (:@! vsp (:$ (- arm::node-size)))))
+  ((:pred >= min 1)
+   (str arg_y (:@! vsp (:$ (- arm::node-size)))))
+  (mov arg_x arg_z)
+  (b :last-2)
+  :two
+  ;; The first two (of three) &optional args were supplied.
+  ((:pred >= min 1)
+   (str arg_x (:@! vsp (:$ (- arm::node-size)))))
+  (mov arg_x arg_y)
+  (mov arg_y arg_z)
+  (b :last-1)
+  ;; None of the three &optional args was provided.
+  :none
+  ((:pred >= min 3)
+   (str arg_x (:@! vsp (:$ (- arm::node-size)))))
+  ((:pred >= min 2)
+   (str arg_y (:@! vsp (:$ (- arm::node-size)))))
+  ((:pred >= min 1)
+   (str arg_z (:@! vsp (:$ (- arm::node-size)))))
+  (mov arg_x (:$ arm::nil-value))
+  :last-2
+  (mov arg_y (:$ arm::nil-value))
+  :last-1
+  (mov arg_z (:$ arm::nil-value))
+  :done)
+
+
+
+;;; "n" is the sum of the number of required args + 
+;;; the number of &optionals.  
+(define-arm-vinsn (default-optionals :call :subprim-call) (()
+                                                           ((n :u16const)))
+  (mov imm0 (:$ (:apply ash n 2)))
+  (bl .SPdefault-optional-args))
+
+;;; fname contains a known symbol
+(define-arm-vinsn (call-known-symbol :call) (((result (:lisp arm::arg_z)))
+                                             ())
+  (ldr nfn (:@ fname (:$ arm::symbol.fcell)))
+  (ldr lr (:@ nfn (:$ arm::function.entrypoint)))
+  (blx lr))
+
+(define-arm-vinsn (jump-known-symbol :jumplr) (()
+                                               ())
+  (ldr nfn (:@ fname (:$ arm::symbol.fcell)))
+  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
+
+(define-arm-vinsn (call-known-function :call) (()
+                                               ())
+  (ldr lr (:@ nfn (:$ arm::function.entrypoint)))
+  (blx lr))
+
+(define-arm-vinsn (jump-known-function :jumplr) (()
+                                                 ())
+  (ldr pc (:@ nfn (:$ arm::function.entrypoint))))
+
+(define-arm-vinsn %schar8 (((char :imm))
+                           ((str :lisp)
+                            (idx :imm))
+                           ((imm :u32)))
+  (mov imm (:$ lsr idx (:$ arm::fixnumshift)))
+  (add imm imm (:$ arm::misc-data-offset))
+  (ldrb imm (:@ str imm))
+  (mov imm (:lsl imm (:$ arm::charcode-shift)))
+  (orr char imm (:$ arm::subtag-character)))
+
+(define-arm-vinsn %schar32 (((char :imm))
+                            ((str :lisp)
+                             (idx :imm))
+                            ((imm :u32)))
+  (add imm idx (:$ arm::misc-data-offset))
+  (ldr imm (:@ str imm))
+  (mov imm (:lsl imm (:$ arm::charcode-shift)))
+  (orr char imm (:$ arm::subtag-character)))
+
+
+(define-arm-vinsn %set-schar8 (()
+                               ((str :lisp)
+                                (idx :imm)
+                                (char :imm))
+                               ((imm :u32)
+                                (imm1 :u32)))
+  (mov imm (:lsr (:$ idx arm::fixnumshift)))
+  (add imm imm (:$ arm::misc-data-offset))
+  (mov imm1 (:lst char (:$ arm::charcode-shift)))
+  (strb imm1 (:@ str imm)))
+
+(define-arm-vinsn %set-schar32 (()
+                                ((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)))
+  (mov imm (:lsr idx (:$ arm::fixnumshift)))
+  (add imm imm (:$ arm::misc-data-offset))
+  (mov imm1 (:lsr code (:$ arm::fixnumshift)))
+  (strb imm1 (:@ str imm)))
+
+
+(define-arm-vinsn %set-scharcode32 (()
+                                    ((str :lisp)
+                                     (idx :imm)
+                                     (code :imm))
+                                    ((imm :u32)
+                                     (imm1 :u32)))
+  (addi imm idx arm::misc-data-offset)
+  (srwi imm1 code arm::fixnumshift)
+  (stwx imm1 str imm)
+  )
+
+(define-arm-vinsn %scharcode8 (((code :imm))
+                               ((str :lisp)
+                                (idx :imm))
+                               ((imm :u32)
+                                (cr0 (:crf 0))))
+  (srwi imm idx arm::fixnumshift)
+  (addi imm imm arm::misc-data-offset)
+  (lbzx imm str imm)
+  (slwi code imm arm::fixnumshift))
+
+(define-arm-vinsn %scharcode32 (((code :imm))
+                                ((str :lisp)
+                                 (idx :imm))
+                                ((imm :u32)
+                                 (cr0 (:crf 0))))
+  (addi imm idx arm::misc-data-offset)
+  (lwzx imm str imm)
+  (slwi code imm arm::fixnumshift))
+
+;;; Clobbers LR
+(define-arm-vinsn (%debug-trap :call :subprim-call) (()
+                                                     ())
+  (bl .SPbreakpoint)
+  )
+
+
+(define-arm-vinsn eep.address (((dest t))
+                               ((src (:lisp (:ne dest )))))
+  (lwz dest (+ (ash 1 2) arm::misc-data-offset) src)
+  (tweqi dest (:apply target-nil-value)))
+                 
+(define-arm-vinsn %natural+ (((dest :u32))
+                             ((x :u32) (y :u32)))
+  (add dest x y))
+
+(define-arm-vinsn %natural+-c (((dest :u32))
+                               ((x :u32) (y :u16const)))
+  (addi dest x y))
+
+(define-arm-vinsn %natural- (((dest :u32))
+                             ((x :u32) (y :u32)))
+  (sub dest x y))
+
+(define-arm-vinsn %natural--c (((dest :u32))
+                               ((x :u32) (y :u16const)))
+  (subi dest x y))
+
+(define-arm-vinsn %natural-logior (((dest :u32))
+                                   ((x :u32) (y :u32)))
+  (or dest x y))
+
+(define-arm-vinsn %natural-logior-c (((dest :u32))
+                                     ((x :u32) (high :u16const) (low :u16const)))
+  ((:not (:pred = high 0))
+   (oris dest x high))
+  ((:not (:pred = low 0))
+   (ori dest x low)))
+
+(define-arm-vinsn %natural-logxor (((dest :u32))
+                                   ((x :u32) (y :u32)))
+  (xor dest x y))
+
+(define-arm-vinsn %natural-logxor-c (((dest :u32))
+                                     ((x :u32) (high :u16const) (low :u16const)))
+  ((:not (:pred = high 0))
+   (xoris dest x high))
+  ((:not (:pred = low 0))
+   (xori dest x low)))
+
+(define-arm-vinsn %natural-logand (((dest :u32))
+                                   ((x :u32) (y :u32)))
+  (and dest x y))
+
+(define-arm-vinsn %natural-logand-high-c (((dest :u32))
+                                          ((x :u32) (high :u16const))
+                                          ((cr0 (:crf 0))))
+  (andis. dest x high))
+
+(define-arm-vinsn %natural-logand-low-c (((dest :u64))
+                                         ((x :u64) (low :u16const))
+                                         ((cr0 (:crf 0))))
+  (andi. dest x low))
+
+(define-arm-vinsn %natural-logand-mask-c (((dest :u32))
+                                          ((x :u32)
+                                           (start :u8const)
+                                           (end :u8const)))
+  (rlwinm dest x 0 start end))
+
+(define-arm-vinsn disable-interrupts (((dest :lisp))
+                                      ()
+                                      ((temp :imm)
+                                       (temp2 :imm)))
+  (lwz temp2 arm::tcr.tlb-pointer arm::rcontext)
+  (li temp -4)
+  (lwz dest arm::interrupt-level-binding-index temp2)
+  (stw temp arm::interrupt-level-binding-index temp2))
+
+(define-arm-vinsn load-character-constant (((dest :lisp))
+                                           ((code :u32const)))
+  (ori dest arm::rzero (:apply logior (:apply ash (:apply logand #xff code) arm::charcode-shift) arm::subtag-character))
+  ((:not (:pred = 0 (:apply ldb (byte 16 8) code)))
+   (oris dest dest (:apply ldb (byte 16 8) code))))
+
+
+(define-arm-vinsn %symbol->symptr (((dest :lisp))
+                                   ((src :lisp))
+                                   ((tag :u8)))
+  (cmp src (:$ arm::nil-value))
+  (and tag src (:$ arm::tagmask))
+  (beq :nilsym)
+  (cmp tag (:$ arm::tag-misc))
+  (ldrbeq tag (:@ src (:$ arm::misc-subtag-offset)))
+  (cmp tag (:$ arm::subtag-symbol))
+  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::subtag-symbol))
+  ((:not (:pred =
+                (:apply %hard-regspec-value dest)
+                (:apply %hard-regspec-value src)))
+   (mr dest src))
+  (b :done)
+  :nilsym
+  (add dest src (:$ arm::nilsym-offset))
+  :done)
+
+;;; Subprim calls.  Done this way for the benefit of VINSN-OPTIMIZE.
+(defmacro define-arm-subprim-call-vinsn ((name &rest other-attrs) spno)
+  `(define-arm-vinsn (,name :call :subprim-call ,@other-attrs) (() ())
+    (bl ,spno)))
+
+(defmacro define-arm-subprim-jump-vinsn ((name &rest other-attrs) spno)
+  `(define-arm-vinsn (,name  :jumpLR ,@other-attrs) (() ())
+    (ba ,spno)))
+
+(define-arm-subprim-jump-vinsn (restore-interrupt-level) .SPrestoreintlevel)
+
+(define-arm-subprim-call-vinsn (save-values) .SPsave-values)
+
+(define-arm-subprim-call-vinsn (recover-values)  .SPrecover-values)
+
+(define-arm-subprim-call-vinsn (add-values) .SPadd-values)
+
+(define-arm-subprim-jump-vinsn (jump-known-symbol-ool) .SPjmpsym)
+
+(define-arm-subprim-call-vinsn (call-known-symbol-ool)  .SPjmpsym)
+
+(define-arm-subprim-call-vinsn (pass-multiple-values)  .SPmvpass)
+
+(define-arm-subprim-call-vinsn (pass-multiple-values-symbol) .SPmvpasssym)
+
+(define-arm-subprim-jump-vinsn (tail-call-sym-gen) .SPtcallsymgen)
+
+(define-arm-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
+
+(define-arm-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide)
+
+(define-arm-subprim-jump-vinsn (tail-call-fn-slide) .SPtcallnfnslide)
+
+(define-arm-subprim-jump-vinsn (tail-call-sym-vsp) .SPtcallsymvsp)
+
+(define-arm-subprim-jump-vinsn (tail-call-fn-vsp) .SPtcallnfnvsp)
+
+(define-arm-subprim-call-vinsn (funcall)  .SPfuncall)
+
+(define-arm-subprim-jump-vinsn (tail-funcall-gen) .SPtfuncallgen)
+
+(define-arm-subprim-jump-vinsn (tail-funcall-slide) .SPtfuncallslide)
+
+(define-arm-subprim-jump-vinsn (tail-funcall-vsp) .SPtfuncallvsp)
+
+(define-arm-subprim-call-vinsn (spread-lexpr)  .SPspread-lexpr-z)
+
+(define-arm-subprim-call-vinsn (spread-list)  .SPspreadargz)
+
+(define-arm-subprim-call-vinsn (pop-argument-registers)  .SPvpopargregs)
+
+(define-arm-subprim-call-vinsn (getu32) .SPgetu32)
+
+(define-arm-subprim-call-vinsn (gets32) .SPgets32)
+
+(define-arm-subprim-call-vinsn (getxlong)  .SPgetXlong)
+
+(define-arm-subprim-call-vinsn (stack-cons-list)  .SPstkconslist)
+
+(define-arm-subprim-call-vinsn (list) .SPconslist)
+
+(define-arm-subprim-call-vinsn (stack-cons-list*)  .SPstkconslist-star)
+
+(define-arm-subprim-call-vinsn (list*) .SPconslist-star)
+
+(define-arm-subprim-call-vinsn (make-stack-block)  .SPmakestackblock)
+
+(define-arm-subprim-call-vinsn (make-stack-block0)  .Spmakestackblock0)
+
+(define-arm-subprim-call-vinsn (make-stack-list)  .Spmakestacklist)
+
+(define-arm-subprim-call-vinsn (make-stack-vector)  .SPmkstackv)
+
+(define-arm-subprim-call-vinsn (make-stack-gvector)  .SPstkgvector)
+
+(define-arm-subprim-call-vinsn (stack-misc-alloc)  .SPstack-misc-alloc)
+
+(define-arm-subprim-call-vinsn (stack-misc-alloc-init)  .SPstack-misc-alloc-init)
+
+(define-arm-subprim-call-vinsn (bind-nil)  .SPbind-nil)
+
+(define-arm-subprim-call-vinsn (bind-self)  .SPbind-self)
+
+(define-arm-subprim-call-vinsn (bind-self-boundp-check)  .SPbind-self-boundp-check)
+
+(define-arm-subprim-call-vinsn (bind)  .SPbind)
+
+(define-arm-subprim-jump-vinsn (nvalret :jumpLR) .SPnvalret)
+
+(define-arm-subprim-call-vinsn (nthrowvalues) .SPnthrowvalues)
+
+(define-arm-subprim-call-vinsn (nthrow1value) .SPnthrow1value)
+
+(define-arm-subprim-call-vinsn (slide-values) .SPmvslide)
+
+(define-arm-subprim-call-vinsn (macro-bind) .SPmacro-bind)
+
+(define-arm-subprim-call-vinsn (destructuring-bind-inner) .SPdestructuring-bind-inner)
+
+(define-arm-subprim-call-vinsn (destructuring-bind) .SPdestructuring-bind)
+
+(define-arm-subprim-call-vinsn (simple-keywords) .SPsimple-keywords)
+
+(define-arm-subprim-call-vinsn (keyword-args) .SPkeyword-args)
+
+(define-arm-subprim-call-vinsn (keyword-bind) .SPkeyword-bind)
+
+(define-arm-subprim-call-vinsn (stack-rest-arg) .SPstack-rest-arg)
+
+(define-arm-subprim-call-vinsn (req-stack-rest-arg) .SPreq-stack-rest-arg)
+
+(define-arm-subprim-call-vinsn (stack-cons-rest-arg) .SPstack-cons-rest-arg)
+
+(define-arm-subprim-call-vinsn (heap-rest-arg) .SPheap-rest-arg)
+
+(define-arm-subprim-call-vinsn (req-heap-rest-arg) .SPreq-heap-rest-arg)
+
+(define-arm-subprim-call-vinsn (heap-cons-rest-arg) .SPheap-cons-rest-arg)
+
+(define-arm-subprim-call-vinsn (opt-supplied-p) .SPopt-supplied-p)
+
+(define-arm-subprim-call-vinsn (gvector) .SPgvector)
+
+(define-arm-vinsn (nth-value :call :subprim-call) (((result :lisp))
+                                                   ())
+  (bl .SPnthvalue))
+
+(define-arm-subprim-call-vinsn (fitvals) .SPfitvals)
+
+(define-arm-subprim-call-vinsn (misc-alloc) .SPmisc-alloc)
+
+(define-arm-subprim-call-vinsn (misc-alloc-init) .SPmisc-alloc-init)
+
+(define-arm-subprim-call-vinsn (integer-sign) .SPinteger-sign)
+
+;;; Even though it's implemented by calling a subprim, THROW is really
+;;; a JUMP (to a possibly unknown destination).  If the destination's
+;;; really known, it should probably be inlined (stack-cleanup, value
+;;; transfer & jump ...)
+(define-arm-vinsn (throw :jump-unknown) (()
+                                         ())
+  (bl .SPthrow))
+
+(define-arm-subprim-call-vinsn (mkcatchmv) .SPmkcatchmv)
+
+(define-arm-subprim-call-vinsn (mkcatch1v) .SPmkcatch1v)
+
+(define-arm-subprim-call-vinsn (setqsym) .SPsetqsym)
+
+(define-arm-subprim-call-vinsn (ksignalerr) .SPksignalerr)
+
+(define-arm-subprim-call-vinsn (subtag-misc-ref) .SPsubtag-misc-ref)
+
+(define-arm-subprim-call-vinsn (subtag-misc-set) .SPsubtag-misc-set)
+
+(define-arm-subprim-call-vinsn (mkunwind) .SPmkunwind)
+(define-arm-subprim-call-vinsn (nmkunwind) .SPnmkunwind)
+
+
+(define-arm-subprim-call-vinsn (progvsave) .SPprogvsave)
+
+(define-arm-subprim-jump-vinsn (progvrestore) .SPprogvrestore)
+
+(define-arm-subprim-call-vinsn (eabi-syscall) .SPeabi-syscall)
+
+(define-arm-subprim-call-vinsn (misc-ref) .SPmisc-ref)
+
+(define-arm-subprim-call-vinsn (misc-set) .SPmisc-set)
+
+(define-arm-subprim-call-vinsn (gets64) .SPgets64)
+
+(define-arm-subprim-call-vinsn (getu64) .SPgetu64)
+
+(define-arm-subprim-call-vinsn (makeu64) .SPmakeu64)
+
+(define-arm-subprim-call-vinsn (makes64) .SPmakes64)
+
+
+
+
+
+(define-arm-subprim-call-vinsn (eabi-ff-call) .SPeabi-ff-call)
+
+(define-arm-subprim-call-vinsn (poweropen-ff-call) .SPpoweropen-ffcall)
+
+(define-arm-subprim-call-vinsn (poweropen-ff-callX) .SPpoweropen-ffcallX)
+
+(define-arm-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
+
+(define-arm-vinsn bind-interrupt-level-0-inline (()
+                                                 ()
+                                                 ((tlb :imm)
+                                                  (value :imm)
+                                                  (link :imm)
+                                                  (temp :imm)))
+  (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
+  (lwz value arm::interrupt-level-binding-index tlb)
+  (lwz link arm::tcr.db-link arm::rcontext)
+  (cmpwi value 0)
+  (li temp arm::interrupt-level-binding-index)
+  (stwu value -4 arm::vsp)
+  (stwu temp -4 arm::vsp)
+  (stwu link -4 arm::vsp)
+  (stw arm::rzero arm::interrupt-level-binding-index tlb)
+  (stw arm::vsp  arm::tcr.db-link arm::rcontext)
+  (beq+ :done)
+  (mr nargs value)
+  (bgt :do-trap)
+  (lwz nargs arm::tcr.interrupt-pending arm::rcontext)
+  :do-trap
+  (twgti nargs 0)
+  :done)
+                                                    
+  
+                                                   
+(define-arm-subprim-call-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
+
+(define-arm-vinsn bind-interrupt-level-m1-inline (()
+                                                  ()
+                                                  ((tlb :imm)
+                                                   (oldvalue :imm)
+                                                   (link :imm)
+                                                   (newvalue :imm)
+                                                   (idx :imm)))
+  (li newvalue (ash -1 arm::fixnumshift))
+  (li idx arm::interrupt-level-binding-index)
+  (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
+  (lwz oldvalue arm::interrupt-level-binding-index tlb)
+  (lwz link arm::tcr.db-link arm::rcontext)
+  (stwu oldvalue -4 arm::vsp)
+  (stwu idx -4 arm::vsp)
+  (stwu link -4 arm::vsp)
+  (stw newvalue arm::interrupt-level-binding-index tlb)
+  (stw arm::vsp  arm::tcr.db-link arm::rcontext)
+  :done)
+
+(define-arm-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
+
+(define-arm-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
+
+(define-arm-vinsn unbind-interrupt-level-inline (()
+                                                 ()
+                                                 ((tlb :imm)
+                                                  (link :imm)
+                                                  (value :imm)
+                                                  (save-nargs :u32)
+                                                  (crf0 :crf)
+                                                  (crf1 :crf)))
+  (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
+  (lwz value arm::interrupt-level-binding-index tlb)
+  (lwz link arm::tcr.db-link arm::rcontext)
+  (cmpwi crf1 value 0)
+  (lwz value 8 link)
+  (lwz link 0 link)
+  (cmpwi crf0 value 0)
+  (stw value arm::interrupt-level-binding-index tlb)
+  (stw link arm::tcr.db-link arm::rcontext)
+  (bge crf1 :done)
+  (blt crf0 :done)
+  (mr save-nargs nargs)
+  (lwz nargs arm::tcr.interrupt-pending arm::rcontext)
+  (twgti nargs 0)
+  (mr nargs save-nargs)
+  :done)
+  
+
+
+(define-arm-vinsn branch-unless-arg-fixnum (()
+                                            ((arg :lisp)
+                                             (lab :label))
+                                            ((cr0 (:crf 0))
+                                             (tag :u8)))
+  (clrlwi. tag arg (- arm::nbits-in-word arm::nlisptagbits))
+  (bne cr0 lab))
+
+(define-arm-vinsn branch-unless-both-args-fixnums (()
+                                                   ((arg0 :lisp)
+                                                    (arg1 :lisp)
+                                                    (lab :label))
+                                                   ((tag :u8)))
+  (orr tag arg0 arg1)
+  (tst tag (:$ arm::tagmask))
+  (bne lab))
+
+;;; In case arm::*arm-opcodes* was changed since this file was compiled.
+(queue-fixup
+ (fixup-vinsn-templates *arm-vinsn-templates* arm::*arm-opcode-numbers*))
+
+(provide "ARM-VINSNS")
+