Index: /branches/arm/compiler/ARM/arm-arch.lisp
===================================================================
--- /branches/arm/compiler/ARM/arm-arch.lisp	(revision 13714)
+++ /branches/arm/compiler/ARM/arm-arch.lisp	(revision 13715)
@@ -658,11 +658,10 @@
 )
 
-;;; Catch frames go on the tstack; they point to a minimal lisp-frame
-;;; on the cstack.  (The catch/unwind-protect PC is on the cstack, where
-;;; the GC expects to find it.)
+;;; Catch frames go on the cstack, below a lisp frame whose savelr
+;;; field references the catch exit point/unwind-protect cleanup code.
 (define-fixedsized-object catch-frame
-  catch-tag                             ; #<unbound> -> unwind-protect, else catch
   link                                  ; tagged pointer to next older catch frame
   mvflag                                ; 0 if single-value, 1 if uwp or multiple-value
+  catch-tag                             ; #<unbound> -> unwind-protect, else catch
   db-link                               ; value of dynamic-binding link on thread entry.
   xframe                                ; exception-frame link
@@ -1290,6 +1289,30 @@
 (defconstant xtype-s8  32)
 (defconstant xtype-u8  36)
-(defconstant xtype-bit  40)                               
-
+(defconstant xtype-bit  40)
+(defconstant xtype-rational 44)
+(defconstant xtype-real 48)
+(defconstant xtype-number 52)
+(defconstant xtype-char-code 56)
+
+;;; Condition field values.
+(ccl::defenum (:prefix "ARM-COND-")
+  eq
+  ne
+  hs
+  lo
+  mi
+  pl
+  vs
+  vc
+  hi
+  ls
+  ge
+  lt
+  gt
+  le
+  al)
+
+(defconstant arm-cond-eq 0)
+(def
   
 (provide "ARM-ARCH")
Index: /branches/arm/compiler/ARM/arm-asm.lisp
===================================================================
--- /branches/arm/compiler/ARM/arm-asm.lisp	(revision 13714)
+++ /branches/arm/compiler/ARM/arm-asm.lisp	(revision 13715)
@@ -604,5 +604,5 @@
                (< nbits 32)))
   (let* ((r (- 32 nbits))
-         (mask (1- (ash 1 r))))
+         (mask (1- (ash 1 nbits))))
     (logand #xffffffff
             (logior (ash u32 nbits)
@@ -790,5 +790,5 @@
                 (error "Can't encode ARM constant ~s." value)))))))
 
-(defun set-addressing-mode (instruction mode constant-index)
+(defun set-opcode-value-from-addressing-mode (opcode mode constant-index)
   ;; Look at mode and set P/W/U bits.  If CONSTANT-INDEX is
   ;; true, the U bit depends on the sign of the constant.
@@ -797,18 +797,25 @@
      ;; Preindexed, no writeback unless :+@! , add register operands.
      (unless constant-index
-       (set-field-value instruction (byte 1 23) 1))
+       (setq opcode (logior opcode (ash 1 23))))
      (when (eq mode :+@!)
-       (set-field-value instruction (byte 1 21) 1))
-     (set-field-value instruction (byte 1 24) 1))
+       (setq opcode (logior opcode (ash 1 21))))
+     (setq opcode (logior opcode (ash 1 24))))
     ((:-@ :-@!)
      ;; Preindexed. Leave the U bit clear, maybe set W if writeback.
      (when (eq mode :-@!)
-       (set-field-value instruction (byte 1 21) 1))
-     (set-field-value instruction (byte 1 24) 1))
+       (setq opcode (logior opcode (ash 1 21))))
+     (setq opcode (logior opcode (ash 1 24))))
     ((:@+ :@-)
      ;; Postindex; writeback is implicit (and setting P and W would
      ;; change the instruction.)
      (unless (or (eq mode :@-) constant-index)
-       (set-field-value instruction (byte 1 23) 1)))))
+       (setq opcode (logior opcode (ash 1 23))))))
+  opcode)
+
+
+(defun set-addressing-mode (instruction mode constant-index)
+  (setf (lap-instruction-opcode instruction)
+        (set-opcode-value-from-addressing-mode
+         (lap-instruction-opcode instruction) mode constant-index)))
 
 ;;; "general" address operand, as used in LDR/LDRB/STR/STRB
@@ -886,5 +893,5 @@
         (set-field-value instruction (byte 1 21) 1)
         (set-field-value instruction (byte 4 16) (need-arm-gpr rn)))
-      (error "Unrecognize writeback indicator in ~s." form))))
+      (error "Unrecognized writeback indicator in ~s." form))))
 
 (defun parse-uuoA-operand (form instruction)
@@ -977,13 +984,19 @@
         (unless template
           (error "Unknown ARM instruction - ~s" form))
-        (when (and (consp (car opvals))
-                   (eq (keywordize (caar opvals)) :?))
-          (let* ((condform (pop opvals)))
-            (destructuring-bind (q cond-name) condform
-              (declare (ignore q))
-              (let* ((c (need-arm-condition-name cond-name)))
-                (if (and explicit-cond (not (eql c cond)))
-                  (error "Can't use explicit condition and :? : ~s" condform)
-                  (setq cond c))))))
+        (let* ((cond-indicator (and (consp (car opvals))
+                                    (keywordize (caar opvals)))))
+          (when (or (eq cond-indicator :?)
+                    (eq cond-indicator :~))
+            (let* ((condform (pop opvals)))
+              (destructuring-bind (q cond-name) condform
+                (declare (ignore q))
+                (let* ((c (need-arm-condition-name cond-name)))
+                  (when (eq cond-indicator :~)
+                    (if (< c 14)
+                      (setq c (logxor c 1))
+                      (error "Invalid explicit condition ~s." condform)))
+                  (if (and explicit-cond (not (eql c cond)))
+                    (error "Can't use explicit condition and :? : ~s" condform)
+                    (setq cond c)))))))
         (let* ((optypes (arm-instruction-template-operand-types template))
                (n (length optypes)))
@@ -1117,5 +1130,357 @@
     (ash (+ (instruction-element-address last)
             (instruction-element-size last)) -2)))
-      
+
+;;; We want to be able to write vinsn templates using a (mostly) LAP-like
+;;; syntax, but ideally don't want to have to repeatedly expand those
+;;; vinsn-definition-time-invariant elements of that syntax.
+;;;
+;;; For example, if DEST is a vinsn parameter and the vinsn body
+;;; contains:
+;;;
+;;;   (ldr DEST (:@ rcontext (:$ arm::tcr.db-link)))
+;;;
+;;; then we know at definition time:
+;;;  1) the opcode of the LDR instruction (obviously)
+;;;  2) the fact that the LDR's :mem12 operand uses indexed
+;;;     addressing with an immediate operand and no writeback
+;;;  3) in this example, we also know the value of the RB field
+;;;     and the value of the immediate operand, which happens
+;;;     to be positive (setting the U bit).
+;;;
+;;;  We can apply this knowledge at definition time, and set
+;;;  the appropriate bits (U, RN, IMM12) in the opcode.
+;;;
+;;;  We don't, of course, know the value of DEST at vinsn-definition
+;;;  time, but we do know that it's the Nth vinsn parameter, so we
+;;;  can turn this example into something like:
+;;;
+;;;  `(,(augmented-opcode-for-LDR) #(rd-field) #(index-of-DEST)
+;;;
+;;; This is defined here (rather than in the compiler backend) since
+;;; it needs to know a lot about ARM instruction encoding.
+
+(defstruct (arm-vinsn-instruction (:constructor %make-arm-vinsn-instruction)
+                                  (:conc-name avi-))
+  head
+  tail)
+
+(defun make-arm-vinsn-instruction (opcode)
+  (let* ((head (list opcode)))
+    (%make-arm-vinsn-instruction :head head :tail head)))
+
+(defun add-avi-operand (instruction field-type value)
+  (let* ((tail (avi-tail instruction)))
+    (setf (avi-tail instruction)
+          (cdr (rplacd tail (cons (cons field-type value) nil))))))
+
+(defun avi-opcode (avi)
+  (car (avi-head avi)))
+
+(defun (setf avi-opcode) (new avi)
+  (setf (car (avi-head avi)) new))
+
+(defun set-avi-opcode-field (avi bytespec value)
+  (setf (avi-opcode avi)
+        (dpb value bytespec (avi-opcode avi)))
+  value)
+
+
+(defparameter *vinsn-field-types*
+  #(:cond
+    :negated-cond
+    :rn
+    :rd
+    :rm
+    :rs
+    :alu-constant
+    :shift-count                        ;shift type is always explicit
+    :mem12-offset
+    :mem8-offset
+    :reglist-bit
+    :uuoA
+    :uuo-unary
+    :uuoB
+    :label
+    :subprim
+    :application
+    :local-label
+    ))
+
+(defmacro encode-vinsn-field-type (name)
+  (or (position name *vinsn-field-types*)
+      (error "Unknown vinsn-field-type name ~s." name)))
+
+(defparameter *arm-vinsn-operand-parsers*
+    #(vinsn-parse-rd-operand
+      vinsn-parse-rn-operand
+      vinsn-parse-shifter-operand
+      vinsn-parse-m12-operand
+      vinsn-parse-reglist-operand
+      vinsn-parse-rnw-operand
+      vinsn-parse-uuoa-operand
+      vinsn-parse-uuo-unary-operand
+      vinsn-parse-uuob-operand
+      vinsn-parse-rm-operand
+      vinsn-parse-b-operand
+      vinsn-parse-subprim-operand
+      vinsn-parse-m8-operand
+      ))
+
+(defun vinsn-arg-or-gpr (avi form vinsn-params encoded-type bytespec)
+  (let* ((p (position form vinsn-params)))
+    (cond (p
+           (add-avi-operand avi encoded-type p)
+           nil)
+          (t           
+           (set-avi-opcode-field avi bytespec (need-arm-gpr form))))))
+
+(defun vinsn-arg-or-constant (avi form vinsn-params encoded-type bytespec)
+  (let* ((p (position form vinsn-params)))
+    (cond (p
+           (add-avi-operand avi encoded-type p)
+           nil)
+          ((and (consp form) (eq (car form) :apply))
+           (add-avi-operand avi encoded-type (simplify-application form vinsn-params))
+           nil)
+          (t
+           (let* ((val (eval form)))
+             (when bytespec
+               (set-avi-opcode-field avi bytespec val))
+             val)))))
+
+
+
+(defun vinsn-parse-rd-operand (avi value vinsn-params)
+  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rd) (byte 4 12)))
+
+(defun vinsn-parse-rn-operand (avi value vinsn-params)
+  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rn) (byte 4 16)))
+
+(defun vinsn-parse-shifter-operand (avi value vinsn-params)
+  (if (atom value)
+    (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
+    (ecase (car value)
+      (:$
+       (destructuring-bind (v) (cdr value)
+         (let* ((val (vinsn-arg-or-constant avi v vinsn-params (encode-vinsn-field-type :alu-constant) nil)))
+           (when val
+             (let* ((constant (encode-arm-immediate val)))
+               (if constant
+                 (set-avi-opcode-field avi (byte 1 25) 1)
+                 (let* ((op (ldb (byte 4 21) (avi-opcode avi)))
+                        (newop nil))
+                   (if (or (and (setq constant (encode-arm-immediate (lognot val)))
+                                (setq newop (svref *equivalent-complemented-opcodes* op)))
+                           (and (setq constant (encode-arm-immediate (- val)))
+                                (setq newop (svref *equivalent-negated-opcodes* op))))
+                     (progn
+                       (set-avi-opcode-field avi (byte 1 25) 1)
+                       (set-avi-opcode-field avi (byte 4 21) newop)
+                       (set-avi-opcode-field avi (byte 12 0) constant))
+                     
+                     (error "Can't encode ARM constant ~s." value)))))))))
+      (:rrx
+       (destructuring-bind (rm) (cdr value)
+         (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
+         (set-avi-opcode-field avi (byte 2 5) 3)))
+      ((:lsl :lsr :asr :ror)
+       (destructuring-bind (rm count) (cdr value)
+         (set-avi-opcode-field avi (byte 2 5) (encode-arm-shift-type (car value)))
+         (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
+         (cond
+           ((atom count)
+            (set-avi-opcode-field avi (byte 1 4) 1)
+            (vinsn-arg-or-gpr avi count vinsn-params (encode-vinsn-field-type :rs) (byte 4 8)))
+           (t
+            (unless (eq (car count) :$)
+              (error "Invalid shift count: ~s" count)
+              (destructuring-bind (countval) (cdr count)
+                (vinsn-arg-or-constant avi countval vinsn-params (encode-vinsn-field-type :shift-count) (byte 5 7)))))))))))
+
+(defun vinsn-parse-m12-operand (avi value vinsn-params)
+  (destructuring-bind (op rn index) value     ; no (:@ reg) sugar
+    (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 16))
+    (let* ((constant-index (and (consp index) (eq (car index) :$))))
+      (unless constant-index
+        (set-avi-opcode-field avi (byte 1 25) 1))
+      (cond
+        ((atom index)
+         (vinsn-arg-or-gpr avi index vinsn-params (encode-vinsn-field-type :rm) (byte 4 0)))
+        (constant-index
+         (destructuring-bind (constform) (cdr index)
+           (let* ((constval
+                   (vinsn-arg-or-constant avi constform vinsn-params (encode-vinsn-field-type :mem12-offset) nil)))
+             (when constval
+               (if (< constval 0)
+                 (setq constval (- constval))
+                 (set-avi-opcode-field avi (byte 1 23) 1))
+               (unless (typep constval '(unsigned-byte 12))
+                 (warn "constant offset too large : ~s" constval))
+               (set-avi-opcode-field avi (byte 12 0) constval)))))
+        ((eq (car index) :rrx)
+         (destructuring-bind (rm) (cdr index)
+           (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
+           (set-avi-opcode-field avi (byte 2 5) 3)))
+        (t
+         (destructuring-bind (shift-op rm shift-count) index
+           (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
+           (set-avi-opcode-field avi (byte 2 5) (encode-arm-shift-type shift-op))
+
+           (unless (and (consp shift-count)
+                        (eq (car shift-count) :$))
+             (error "Invalid shift-count: ~s" shift-count))
+           (destructuring-bind (shift-count-form) (cdr shift-count)
+             (vinsn-arg-or-constant avi shift-count-form vinsn-params (encode-vinsn-field-type :shift-count) (byte 5 7))))))
+      (setf (avi-opcode avi)
+            (set-opcode-value-from-addressing-mode (avi-opcode avi) op constant-index)))))
+
+(defun vinsn-parse-reglist-operand (avi value vinsn-params)
+  (dolist (r value)
+    (let* ((p (position r vinsn-params)))
+      (if p
+        (progn
+          (vector-push-extend (encode-vinsn-field-type :reglist-bit)
+                              field-types)
+          (vector-push-extend p field-values))
+        (let* ((bit (need-arm-gpr r)))
+          (setq opcode (logior opcode (ash 1 bit))))))))
+
+(defun vinsn-parse-rnw-operand (avi value vinsn-params)
+  (let* ((rn (if (atom value)
+               value
+               (destructuring-bind (marker reg) value
+                 (if (eq marker :!)
+                   (set-avi-opcode-field avi (byte 1 21) 1))
+                   (error "Unrecognized writeback indicator in ~s." value)
+                 reg))))
+    (vinsn-arg-or-gpr avi rn vinsn-params  (encode-vinsn-field-type :rn) (byte 4 16))))
+
+(defun vinsn-parse-uuoA-operand (avi value vinsn-params)
+  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :uuoA) (byte 4 8)))
+
+(defun vinsn-parse-uuo-unary-operand (avi value vinsn-params)
+  (when (or (atom value)
+          (not (eq (car value) :$)))
+    (error "Invalid constant syntax in ~s." value))
+  (destructuring-bind (valform) (cdr value)
+    (vinsn-arg-or-constant avi valform vinsn-params (encode-vinsn-field-type :uuo-unary) (byte 8 12))))
+
+(defun vinsn-parse-uuoB-operand (avi value vinsn-params)
+  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :uuoB) (byte 4 12)))
+
+(defun vinsn-parse-rm-operand (avi value vinsn-params)
+  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rm) (byte 4 0)))
+
+(defun vinsn-parse-b-operand (avi value vinsn-params)
+  ;; Pretty much has to be a param or a local label what else would we b to ?
+  (let* ((p (position value vinsn-params)))
+    (cond (p
+           (add-avi-operand avi (encode-vinsn-field-type :label) p))
+          ((typep value 'keyword)
+           (add-avi-operand avi (encode-vinsn-field-type :local-label) value))
+          (t
+           (error "Unknown branch target: ~s." value)))))
+
+;;; This can only appear in a BA (mov PC,(:$ addr)) instruction, which
+;;; already has bit 25 set.
+(defun vinsn-parse-subprim-operand (avi value vinsn-params)
+  (let* ((p (position value vinsn-params)))
+    (if p
+      (add-avi-operand avi (encode-vinsn-field-type :subprim) p)
+      (let* ((addr (or (arm-subprimitive-address value)
+                   (and (typep value 'integer)
+                        (>= value #x4000)
+                        (< value #x10000)
+                        (not (logtest #x7f value))))))
+        (unless addr
+          (error "Unknown ARM subprimitive address: ~s." addr))
+        (set-avi-opcode-field avi (byte 12 0) (encode-arm-immediate addr))))))
+
+(defun vinsn-parse-m8-operand (avi value vinsn-params)
+  (if (atom value)
+    (error "Invalid memory operand ~s." value)
+    (destructuring-bind (mode rn index) value
+      (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 16))
+      (let* ((constant-index (and (consp index) (eq (car index) :$))))
+        (unless constant-index
+          (set-avi-opcode-field avi (byte 25 1) 1))
+        (cond ((atom index)
+               (vinsn-arg-or-gpr avi index vinsn-params (encode-vinsn-field-type :rm) (byte 4 0)))
+              (constant-index
+               (destructuring-bind (constform) (cdr index)
+                 (let* ((constval
+                         (vinsn-arg-or-constant avi constform vinsn-params (encode-vinsn-field-type :mem8-offset) nil)))
+                   (when constval
+                     (if (< constval 0)
+                       (setq constval (- constval))
+                       (set-avi-opcode-field avi (byte 1 23) 1))
+                     (unless (typep constval '(unsigned-byte 8))
+                       (warn "constant offset too large : ~s" constval))
+                     (set-avi-opcode-field avi (byte 4 0) (ldb (byte 4 0) constval))
+                     (set-avi-opcode-field avi (byte 4 8) (ldb (byte 4 4) constval))))))
+              ((eq (car index) :rrx)
+               (destructuring-bind (rm) (cdr index)
+                 (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
+                 (set-avi-opcode-field avi (byte 2 5) 3)))
+              (t
+               (destructuring-bind (shift-op rm shift-count) index
+                 (vinsn-arg-or-gpr avi rm vinsn-params (encode-vinsn-field-type :rm) (byte 4 0))
+                 (set-avi-opcode-field avi (byte 2 5) (encode-arm-shift-type shift-op))
+                 (unless (and (consp shift-count)
+                              (eq (car shift-count) :$))
+                   (error "Invalid shift-count: ~s" shift-count))
+                 (destructuring-bind (shift-count-form) (cdr shift-count)
+                   (vinsn-arg-or-constant avi shift-count-form vinsn-params (encode-vinsn-field-type :shift-count) (byte 5 7))))))
+        (setf (avi-opcode avi)
+              (set-opcode-value-from-addressing-mode (avi-opcode avi) mode constant-index))))))
+
+              
+
+
+                                      
+(defun vinsn-simplify-instruction (form vinsn-params)
+  (destructuring-bind (name . opvals) form
+    (multiple-value-bind (template cond explicit-cond) (lookup-arm-instruction name)
+      (unless template
+        (error "Unknown ARM instruction - ~s" form))
+      (let* ((cond-indicator (and (consp (car opvals))
+                                  (keywordize (caar opvals))))
+             (avi (make-arm-vinsn-instruction (arm-instruction-template-val template))))
+        (when (or (eq cond-indicator :?)
+                  (eq cond-indicator :~))
+          (let* ((condform (pop opvals)))
+            (destructuring-bind (cond-name) (cdr condform)
+              (let* ((p (position cond-name vinsn-params)))
+                (if p
+                  (if explicit-cond
+                    (error "Can't use ~s with explicit condition name." condform)
+                    (progn
+                      (add-avi-operand avi (if (eq cond-indicator :?)
+                                             (encode-vinsn-field-type :cond)
+                                             (encode-vinsn-field-type :negated-cond))
+                                       p)
+                      (setq cond nil)))
+                  (let* ((c (need-arm-condition-name cond-name)))
+                    (when (eq cond-indicator :~)
+                      (if (< c 14)
+                        (setq c (logxor c 1))
+                        (error "Invalid explicit condition ~s." condform)))
+                    (if (and explicit-cond (not (eql c cond)))
+                      (error "Can't use explicit condition and :? : ~s" condform)
+                      (setq cond c))))))))
+        (let* ((optypes (arm-instruction-template-operand-types template))
+               (n (length optypes)))
+          (unless (= n (length opvals))
+            (error "ARM ~a instructions require ~d operands, but ~d were provided in ~s." (arm-instruction-template-name template) n (length opvals) form))
+          (dotimes (i n)
+            (let* ((optype (pop optypes))
+                   (opval (pop opvals)))
+              (funcall (svref *arm-vinsn-operand-parsers* optype)
+                       avi opval vinsn-params)))
+          (when cond
+            (set-avi-opcode-field avi (byte 4 28) cond))
+          (avi-head avi))))))
+          
+
 
 (provide "ARM-ASM")
Index: /branches/arm/compiler/ARM/arm-backend.lisp
===================================================================
--- /branches/arm/compiler/ARM/arm-backend.lisp	(revision 13714)
+++ /branches/arm/compiler/ARM/arm-backend.lisp	(revision 13715)
@@ -31,6 +31,5 @@
 ;;; This defines a template.  All expressions in the body must be
 ;;; evaluable at macroexpansion time.
-#+notyet
-(defun define-arm-vinsn (backend vinsn-name results args temps body)
+(defun %define-arm-vinsn (backend vinsn-name results args temps body)
   (let* ((opcode-vector (backend-lap-opcodes backend))
 	 (opcode-lookup (backend-lookup-opcode backend))
@@ -99,4 +98,6 @@
         (dolist (name non-hybrid-results)
           (add-spec-name name)))
+      (break)
+      #+notyet
       (let* ((k -1))
         (declare (fixnum k))
@@ -236,5 +237,5 @@
 		:lookup-macro #'false
 		:lap-opcodes arm::*arm-instruction-table*
-                :define-vinsn 'define-arm-vinsn
+                :define-vinsn '%define-arm-vinsn
                 :platform-syscall-mask (logior platform-os-linux platform-cpu-arm)
 		:p2-dispatch *arm2-specials*
Index: /branches/arm/compiler/ARM/arm-lap.lisp
===================================================================
--- /branches/arm/compiler/ARM/arm-lap.lisp	(revision 13714)
+++ /branches/arm/compiler/ARM/arm-lap.lisp	(revision 13715)
@@ -64,4 +64,5 @@
     (with-dll-node-freelist (constant-pool arm::*lap-instruction-freelist*)
       (let* ((arm::*lap-labels* ())
+             (name-cell (list name))
              (arm::*arm-constants* ())
              (*arm-lap-lfun-bits* bits)
@@ -73,6 +74,7 @@
         (dolist (form body)
           (setq current (arm-lap-form form current sections)))
-        (arm-lap-generate-code name
-                               primary
+        (rplacd name-cell (length arm::*arm-constants*))
+        (push name-cell arm::*arm-constants*)
+        (arm-lap-generate-code primary
                                (arm::arm-finalize primary  constant-pool)
                                *arm-lap-lfun-bits*)))))
@@ -84,5 +86,5 @@
 
 
-(defun arm-lap-generate-code (name seg code-vector-size bits)
+(defun arm-lap-generate-code (seg code-vector-size bits)
   (declare (fixnum code-vector-size))
   (let* ((target-backend *target-backend*)
@@ -90,5 +92,5 @@
                            (:arm (not (eq *host-backend* target-backend)))
                            (t t)))
-         (constants-size (+ 4 (length arm::*arm-constants*)))
+         (constants-size (+ 3 (length arm::*arm-constants*)))
          (constants-vector (%alloc-misc
                             constants-size
@@ -113,5 +115,4 @@
           (setf (uvref constants-vector (+ 2 k)) imm)))
       (setf (uvref constants-vector (1- constants-size)) bits ; lfun-bits
-            (uvref constants-vector (- constants-size 2)) name
             (uvref constants-vector 1) code-vector)
       #+arm-target (%make-code-executable code-vector)