Changeset 13741


Ignore:
Timestamp:
May 27, 2010, 11:50:14 PM (9 years ago)
Author:
gb
Message:

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

Location:
branches/arm/compiler/ARM
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/compiler/ARM/arm-arch.lisp

    r13715 r13741  
    3737  (let* ((value (get-arm-register name)))
    3838    (and value (< value 16) value)))
    39                      
     39
     40(defun get-arm-sfpr (name)
     41  (let* ((value (get-arm-register name)))
     42    (and value (logbitp 5 value) (logand #x1f value))))
     43
     44(defun get-arm-dfpr (name)
     45  (let* ((value (get-arm-register name)))
     46    (and value (logbitp 6 value) (logand #x0f value))))
     47 
    4048
    4149;;; This allows redefinition, which might be helpful while
     
    96104(defarmgpr pc r15)
    97105
     106
     107
    98108;;; Calling sequence may pass additional arguments in temp registers.
    99109;;; "nfn" (new function) is always passed; it's the new value of "fn".
     
    107117(defarmgpr nargs imm2)
    108118
     119(defmacro defarmsfpr (name val)
     120  `(defconstant ,name (define-arm-register ',name ',val)))
     121
     122(defarmsfpr s0 32)
     123(defarmsfpr s1 33)
     124(defarmsfpr s2 34)
     125(defarmsfpr s3 35)
     126(defarmsfpr s4 36)
     127(defarmsfpr s5 37)
     128(defarmsfpr s6 38)
     129(defarmsfpr s7 39)
     130(defarmsfpr s8 40)
     131(defarmsfpr s9 41)
     132(defarmsfpr s10 42)
     133(defarmsfpr s11 43)
     134(defarmsfpr s12 44)
     135(defarmsfpr s13 45)
     136(defarmsfpr s14 46)
     137(defarmsfpr s15 47)
     138(defarmsfpr s16 48)
     139(defarmsfpr s17 49)
     140(defarmsfpr s18 50)
     141(defarmsfpr s19 51)
     142(defarmsfpr s20 52)
     143(defarmsfpr s21 53)
     144(defarmsfpr s22 54)
     145(defarmsfpr s23 55)
     146(defarmsfpr s24 56)
     147(defarmsfpr s25 57)
     148(defarmsfpr s26 58)
     149(defarmsfpr s27 59)
     150(defarmsfpr s28 60)
     151(defarmsfpr s29 61)
     152(defarmsfpr s30 62)
     153(defarmsfpr s31 63)
     154
     155;;; The first 16 double-float registers overlap pairs of single-float
     156;;; registers (d0 overlaps s0-s1, d15 overlaps s30-s31, etc.)
     157
     158(defmacro defarmdfpr (name val)
     159  `(defconstant ,name (define-arm-register ',name ',val)))
     160
     161(defarmdfpr d0 64)
     162(defarmdfpr d1 65)
     163(defarmdfpr d2 66)
     164(defarmdfpr d3 67)
     165(defarmdfpr d4 68)
     166(defarmdfpr d5 69)
     167(defarmdfpr d6 70)
     168(defarmdfpr d7 71)
     169(defarmdfpr d8 72)
     170(defarmdfpr d9 73)
     171(defarmdfpr d10 74)
     172(defarmdfpr d11 75)
     173(defarmdfpr d12 76)
     174(defarmdfpr d13 77)
     175(defarmdfpr d14 78)
     176(defarmdfpr d15 79)
    109177
    110178
     
    218286(eval-when (:compile-toplevel :load-toplevel :execute)
    219287(defparameter *arm-subprims-shift* 8)
    220 (defparameter *arm-subprims-base* (ash 4 12) )
     288(defparameter *arm-subprims-base* (ash 9 12) )
    221289)
    222290(defvar *arm-subprims*)
     
    229297             (ccl::make-subprimitive-info :name (string name)
    230298                                          :offset (prog1 origin
     299                                                    (when (= origin #x10000)
     300                                                      (setq step (ash 1 10)))
    231301                                                    (incf origin step)))))
    232302    (macrolet ((defarmsubprim (name)
     
    449519(defconstant target-most-negative-fixnum (ash -1 (1- (- nbits-in-word nfixnumtagbits))))
    450520(defconstant target-most-positive-fixnum (1- (ash 1 (1- (- nbits-in-word nfixnumtagbits)))))
     521(defconstant fixnumone (ash 1 fixnumshift))
     522
    451523
    452524
     
    13131385  al)
    13141386
    1315 (defconstant arm-cond-eq 0)
    1316 (def
    13171387 
    13181388(provide "ARM-ARCH")
  • branches/arm/compiler/ARM/arm-asm.lisp

    r13736 r13741  
    9494(eval-when (:compile-toplevel :load-toplevel :execute)
    9595
    96 (ccl::defenum (:prefix "ARM-OPERAND-TYPE-")
    97   rd                                    ; destination register in bits 12:15
    98   rn                                    ; unshifted source/base reg in 16:19
    99   shifter                               ; composite operand for ALU ops
    100   mem12                                 ; 12-bit address for LDR/STR/LDRB/STB
    101   reglist
    102   rnw                                   ; rn, with optional writeback.
    103   uuoA                                  ; GPR in UUO bits 8:11
    104   uuo-unary                             ; constant in UUO bits 12:15
    105   uuoB                                  ; GPR in UUO bits 12:15
    106   rm
    107   b
    108   subprim
    109   mem8
    110 )
    111 
    112 (defparameter *arm-operand-type-names*
    113   `((:rd . ,arm-operand-type-rd)
    114     (:rn . ,arm-operand-type-rn)
    115     (:shifter . ,arm-operand-type-shifter)
    116     (:mem12 . ,arm-operand-type-mem12)
    117     (:reglist . ,arm-operand-type-reglist)
    118     (:rnw . ,arm-operand-type-rnw)
    119     (:uuoA . ,arm-operand-type-uuoA)
    120     (:uuo-unary . ,arm-operand-type-uuo-unary)
    121     (:uuoB . ,arm-operand-type-uuoB)
    122     (:rm . ,arm-operand-type-rm)
    123     (:b . ,arm-operand-type-b)
    124     (:subprim . ,arm-operand-type-subprim)
    125     (:mem8 . ,arm-operand-type-mem8)
     96(defparameter *arm-operand-types*
     97  #(:rd                                 ; destination register in bits 12:15
     98    :rn                                 ; unshifted source/base reg in 16:19
     99    :shifter                            ; composite operand for ALU ops
     100    :mem12                              ; 12-bit address for LDR/STR/LDRB/STB
     101    :reglist
     102    :rnw                                ; rn, with optional writeback.
     103    :uuoA                               ; GPR in UUO bits 8:11
     104    :uuo-unary                          ; constant in UUO bits 12:15
     105    :uuoB                               ; GPR in UUO bits 12:15
     106    :rm
     107    :b
     108    :subprim
     109    :mem8
     110    :dd
     111    :dm
     112    :sd
     113    :sm
     114    :dn
     115    :sn
     116    :rde
     117    :rs
    126118    ))
    127119
    128 
    129 
    130 
    131 (defun encode-arm-operand-type (name)
    132   (or (cdr (assoc name *arm-operand-type-names* :test #'eq))
     120(defun %encode-arm-operand-type (name)
     121  (or (position name *arm-operand-types* :test #'eq)
    133122      (error "Unknown ARM operand type name ~s." name)))
     123
     124(defmacro encode-arm-operand-type (name)
     125  (%encode-arm-operand-type name))
    134126
    135127(ccl::defenum (:prefix "ARM-INSTRUCTION-FLAG-")
     
    172164
    173165(defmacro define-arm-instruction (name operand-type-names value mask-list flag-names)
    174   `(%define-arm-instruction ,(string-downcase name) ,value ',mask-list ,(%encode-arm-instruction-flag flag-names) ',(mapcar #'encode-arm-operand-type operand-type-names) ))
     166  `(%define-arm-instruction ,(string-downcase name) ,value ',mask-list ,(%encode-arm-instruction-flag flag-names) ',(mapcar #'%encode-arm-operand-type operand-type-names) ))
    175167
    176168(defparameter *arm-instruction-table*
     
    185177     (:prefer-separate-cond))
    186178   (define-arm-instruction uuo-error-wrong-nargs ()
    187      #x07f000f1
     179     #x07f001f8
    188180     #x0fffffff
    189181     (:prefer-separate-cond))
    190182   (define-arm-instruction uuo-gc-trap ()
    191      #x07f001f2
     183     #x07f002f0
    192184     #x0fffffff
    193185     (:prefer-separate-cond))
    194186   (define-arm-instruction uuo-debug-trap ()
    195      #x07f002f3
     187     #x07f002f0
    196188     #x0fffffff
    197189     (:prefer-separate-cond))
    198190   (define-arm-instruction uuo-interrupt-now ()
    199      #x07f003f4
     191     #x07f003f0
    200192     #x0fffffff
    201193     (:prefer-separate-cond))
    202194   (define-arm-instruction uuo-suspend-now ()
    203      #x07f004f05
     195     #x07f004f0
    204196     #x0fffffff
    205197     (:prefer-separate-cond))
     
    232224;;; Unary UUOs
    233225   (define-arm-instruction uuo-error-unbound (:uuoA)
    234      #x07f000f1
     226     #x07f000f9
    235227     #x0ffff0ff
    236228     (:prefer-separate-cond))
    237229   (define-arm-instruction uuo-cerror-unbound (:uuoA)
    238      #x07f010f1
     230     #x07f010f9
    239231     #x0ffff0ff
    240232     (:prefer-separate-cond))
    241233   (define-arm-instruction uuo-error-not-callable (:uuoA)
    242      #x07f020f1
     234     #x07f020f9
    243235     #x0ffff0ff
    244236     (:prefer-separate-cond))
     
    248240     (:prefer-separate-cond))
    249241   (define-arm-instruction uuo-error-no-throw-tag (:uuoA)
    250      #x07f040f1
     242     #x07f040f9
    251243     #x0ffff0ff
    252244     (:prefer-separate-cond))
    253 
     245   (define-arm-instruction uuo-error-udf-call (:uuoA)
     246     #x07f050f9
     247     #x0ffff0ff
     248     (:prefer-separate-cond))
     249   (define-arm-instruction uuo-error-udf (:uuoA)
     250     #x07f060f9
     251     #x0ffff0ff
     252     (:prefer-separate-cond))
     253   
    254254;;; Binary UUOs
    255255   (define-arm-instruction uuo-error-vector-bounds (:uuoA :uuoB)
     
    261261     #x0fff00ff
    262262     (:prefer-separate-cond))
    263 
     263   (define-arm-instruction uuo-error-integer-divide-by-zero (:uuoA :uuoB)
     264     #x07f200ff
     265     #x0fff00ff
     266     (:prefer-separate-cond))
     267   (define-arm-instruction uuo-error-slot-unbound (:uuoA :uuoB)
     268     #x07f300ff
     269     #x0fff00ff
     270     (:prefer-separate-cond))
    264271
    265272   (define-arm-instruction and (:rd :rn :shifter)
     
    484491     #x0e3000f0
    485492     ())
    486 
     493   (define-arm-instruction ldrd  (:rde :mem8)
     494     #x000000d0
     495     #x0e3000f0
     496     ())
     497   (define-arm-instruction strd  (:rde :mem8)
     498     #x000000f0
     499     #x0e3000f0
     500     ())
     501
     502   (define-arm-instruction mul (:rd :rm :rs)
     503     #x00000090
     504     #x0ff000f0
     505     ())
     506   (define-arm-instruction muls (:rd :rm :rs)
     507     #x00100090
     508     #x0ff000f0
     509     ())
     510   
    487511   (define-arm-instruction stm (:rnw :reglist)
    488512     #x08800000
     
    545569     #x012fff30
    546570     #x0ffffff0
     571     ())
     572
     573;;; VFP instructions
     574   (define-arm-instruction fabsd (:dd :dm)
     575     #x0eb00bc0
     576     #x0ff00ff0
     577     ())
     578   (define-arm-instruction fabss (:sd :sm)
     579     #x0eb00ac0
     580     #x0fb00fb0
     581     ())
     582   (define-arm-instruction faddd (:dd :dn :dm)
     583     #x0e300b00
     584     #x0ff00ff0
     585     ())
     586   (define-arm-instruction fadds (:sd :sn :sm)
     587     #x0e300a00
     588     #x0f300f50
     589     ())
     590   (define-arm-instruction fmsr (:sn :rd)
     591     #x0e000a10
     592     #x0ff00f90
     593     ())
     594   (define-arm-instruction fmrs (:rd :sn)
     595     #x0e100a10
     596     #x0ff00f90
     597     ())
     598   (define-arm-instruction fmrrd (:rd :rn :dm)
     599     #x0e500b10
     600     #x0ff00ff0
     601     ())
     602   (define-arm-instruction fmdrr (:dm :rd :rn)
     603     #x0e400b10
     604     #x0ff00ff0
     605     ())
     606   (define-arm-instruction fsitod (:dd :sm)
     607     #x0eb80bc0
     608     #x0fff0fc0
     609     ())
     610   (define-arm-instruction fsitos (:sd :sm)
     611     #x0eb80ac0
     612     #x0fff0fc0
     613     ())
     614   (define-arm-instruction fcmped (:dd :dm)
     615     #x0eb40bc0
     616     #x0fff0fc0
     617     ())
     618   (define-arm-instruction fcmpes (:dd :dm)
     619     #x0eb40ac0
     620     #x0fff0fc0
     621     ())
     622   (define-arm-instruction fmstat ()
     623     #x0ef1fa10
     624     #x0fffffff
     625     ())
     626   (define-arm-instruction fsubd (:dd :dn :dm)
     627     #x0e300b40
     628     #x0ff00fc0
     629     ())
     630   (define-arm-instruction fsubs (:sd :sn :sm)
     631     #x0e300a40
     632     #x0ff00fc0
     633     ())
     634   (define-arm-instruction fmuld (:dd :dn :dm)
     635     #x0e200b00
     636     #x0ff00ff0
     637     ())
     638   (define-arm-instruction fmuls (:sd :sn :sm)
     639     #x0e200a00
     640     #x0ff00ff0
     641     ())
     642   (define-arm-instruction fdivd (:dd :dn :dm)
     643     #x0e800b00
     644     #x0ff00ff0
     645     ())
     646   (define-arm-instruction fdivs (:sd :sn :sm)
     647     #x0e800a00
     648     #x0ff00ff0
     649     ())
     650   (define-arm-instruction fcpyd (:dd :dm)
     651     #x0eb00b40
     652     #x0fb00ff0
     653     ())
     654   (define-arm-instruction fcpyd (:sd :sm)
     655     #x0eb00b40
     656     #x0fb00fc0
     657     ())
     658   (define-arm-instruction fcvtsd (:sd :dm)
     659     #x0eb70bc0
     660     #x0fbf0fc0
    547661     ())
    548662   ))
     
    667781  (or (get-arm-gpr form)
    668782      (error "Expected an ARM general-purpose register, got ~s" form)))
     783
     784(defun need-arm-sfpr (form)
     785  (or (get-arm-sfpr form)
     786      (error "Expected an ARM single FP register, got ~s" form)))
     787
     788(defun need-arm-dfpr (form)
     789  (or (get-arm-sfpr form)
     790      (error "Expected an ARM double FP register, got ~s" form)))
    669791
    670792(defun encode-arm-shift-type (op)
     
    9431065    (set-addressing-mode instruction mode constant-index))))
    9441066
    945 
    946        
     1067(defun parse-dd-operand (form instruction)
     1068  (set-field-value instruction (byte 4 12) (need-arm-dfpr form)))
     1069
     1070(defun parse-dm-operand (form instruction)
     1071  (set-field-value instruction (byte 4 0) (need-arm-dfpr form)))
     1072
     1073(defun parse-sd-operand (form instruction)
     1074  (let* ((val (need-arm-sfpr form)))
     1075    (set-field-value instruction (byte 4 12) (ash val -1))
     1076    (set-field-value instruction (byte 1 22) (logand val 1))))
     1077
     1078(defun parse-sm-operand (form instruction)
     1079  (let* ((val (need-arm-sfpr form)))
     1080    (set-field-value instruction (byte 4 0) (ash val -1))
     1081    (set-field-value instruction (byte 1 5) (logand val 1))))
     1082
     1083(defun parse-dn-operand (form instruction)
     1084  (set-field-value instruction (byte 4 16) (need-arm-dfpr form)))       
    9471085                             
    948          
    949 
     1086(defun parse-sn-operand (form instruction)
     1087  (let* ((val (need-arm-sfpr form)))
     1088    (set-field-value instruction (byte 4 16) (ash val -1))
     1089    (set-field-value instruction (byte 1 7) (logand val 1))))
     1090
     1091(defun parse-rde-operand (form instruction)
     1092  (let* ((val (need-arm-gpr form)))
     1093    (when (oddp val)
     1094      (error "Register must be even-numbered: ~s." form))
     1095    (set-field-value instruction (byte 4 12) val)))
     1096
     1097(defun parse-rs-operand (form instruction)
     1098  (set-field-value instruction (byte 4 8) (need-arm-gpr form)))
     1099 
    9501100(defparameter *arm-operand-parsers*
    9511101    #(parse-rd-operand
     
    9621112      parse-subprim-operand
    9631113      parse-m8-operand
     1114      parse-dd-operand
     1115      parse-dm-operand
     1116      parse-sd-operand
     1117      parse-sm-operand
     1118      parse-dn-operand
     1119      parse-sn-operand
     1120      parse-rde-operand
     1121      parse-rs-operand
    9641122      ))
    9651123
     
    11021260    (ccl::append-dll-node w1 primary )
    11031261    (let* ((n (set-element-addresses 0 primary)))
    1104       (setf (lap-instruction-opcode w1) n)
     1262      (setf (lap-instruction-opcode w1) (ash n (- arm::word-shift)))
    11051263      (set-element-addresses n constant-pool)))
    11061264  ;; Now fix up label references.  Recall that the PC value at some
     
    11871345
    11881346
     1347(eval-when (:compile-toplevel :load-toplevel :execute)
    11891348(defparameter *vinsn-field-types*
    11901349  #(:cond
     
    12061365    :application
    12071366    :local-label
    1208     ))
     1367    :dd
     1368    :dm
     1369    :sd
     1370    :sm
     1371    :dn
     1372    :sn
     1373    )))
    12091374
    12101375(defmacro encode-vinsn-field-type (name)
     
    12261391      vinsn-parse-subprim-operand
    12271392      vinsn-parse-m8-operand
     1393      vinsn-parse-dd-operand
     1394      vinsn-parse-dm-operand
     1395      vinsn-parse-sd-operand
     1396      vinsn-parse-sm-operand
     1397      vinsn-parse-dn-operand
     1398      vinsn-parse-sn-operand
     1399      vinsn-parse-rde-operand
     1400      vinsn-parse-rs-operand
    12281401      ))
    12291402
     
    12361409           (set-avi-opcode-field avi bytespec (need-arm-gpr form))))))
    12371410
     1411(defun vinsn-arg-or-dfpr (avi form vinsn-params encoded-type bytespec)
     1412  (let* ((p (position form vinsn-params)))
     1413    (cond (p
     1414           (add-avi-operand avi encoded-type p)
     1415           nil)
     1416          (t           
     1417           (set-avi-opcode-field avi bytespec (need-arm-dfpr form))))))
     1418
     1419(defun vinsn-arg-or-sfpr (avi form vinsn-params encoded-type top4 low1)
     1420  (let* ((p (position form vinsn-params)))
     1421    (cond (p
     1422           (add-avi-operand avi encoded-type p)
     1423           nil)
     1424          (t
     1425           (let* ((val (need-arm-sfpr form)))
     1426             (set-avi-opcode-field avi top4 (ash val -1))
     1427             (set-avi-opcode-field avi low1 (logand val 1)))))))
     1428
     1429(defun simplify-arm-vinsn-application (form params)
     1430  (labels ((simplify-operand (op)
     1431             (if (atom op)
     1432               (if (typep form 'fixnum)
     1433                 op
     1434                 (if (constantp op)
     1435                   (eval op)
     1436                   (let* ((p (position op params)))
     1437                     (if p
     1438                       (list p)
     1439                       (error "Unknown operand: ~s" op)))))
     1440               (if (eq (car op) :apply)
     1441                 `(,(cadr op) ,@(mapcar #'simplify-operand (cddr op)))))))
     1442    `(,(cadr form) ,@(mapcar #'simplify-operand (cddr form)))))
     1443
    12381444(defun vinsn-arg-or-constant (avi form vinsn-params encoded-type bytespec)
    12391445  (let* ((p (position form vinsn-params)))
     
    12411447           (add-avi-operand avi encoded-type p)
    12421448           nil)
     1449          ((typep form 'keyword)
     1450           (add-avi-operand avi encoded-type form)
     1451           nil)
    12431452          ((and (consp form) (eq (car form) :apply))
    1244            (add-avi-operand avi encoded-type (simplify-application form vinsn-params))
     1453           (add-avi-operand avi encoded-type (simplify-arm-vinsn-application form vinsn-params))
    12451454           nil)
    12461455          (t
     
    13001509
    13011510(defun vinsn-parse-m12-operand (avi value vinsn-params)
     1511  (when (typep value 'keyword)
     1512    (setq value `(:@ arm::pc (:$ ,value))))
    13021513  (destructuring-bind (op rn index) value     ; no (:@ reg) sugar
    13031514    (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 16))
     
    13501561               (destructuring-bind (marker reg) value
    13511562                 (if (eq marker :!)
    1352                    (set-avi-opcode-field avi (byte 1 21) 1))
    1353                    (error "Unrecognized writeback indicator in ~s." value)
     1563                   (set-avi-opcode-field avi (byte 1 21) 1)
     1564                   (error "Unrecognized writeback indicator in ~s." value))
    13541565                 reg))))
    13551566    (vinsn-arg-or-gpr avi rn vinsn-params  (encode-vinsn-field-type :rn) (byte 4 16))))
     
    13781589          ((typep value 'keyword)
    13791590           (add-avi-operand avi (encode-vinsn-field-type :local-label) value))
     1591          ((arm-subprimitive-address value)
     1592           (add-avi-operand avi (encode-vinsn-field-type :subprim) value))
    13801593          (t
    13811594           (error "Unknown branch target: ~s." value)))))
     
    14341647              (set-opcode-value-from-addressing-mode (avi-opcode avi) mode constant-index))))))
    14351648
    1436              
    1437 
    1438 
    1439                                      
     1649(defun vinsn-parse-dd-operand (avi value vinsn-params)
     1650  (vinsn-arg-or-dfpr avi value vinsn-params (encode-vinsn-field-type :dd) (byte 4 12)))
     1651
     1652(defun vinsn-parse-dm-operand (avi value vinsn-params)
     1653  (vinsn-arg-or-dfpr avi value vinsn-params (encode-vinsn-field-type :dm) (byte 4 0)))
     1654
     1655(defun vinsn-parse-sd-operand (avi value vinsn-params)
     1656  (vinsn-arg-or-sfpr avi value vinsn-params (encode-vinsn-field-type :sd) (byte 4 12) (byte 1 22)))
     1657
     1658(defun vinsn-parse-sm-operand (avi value vinsn-params)
     1659  (vinsn-arg-or-sfpr avi value vinsn-params (encode-vinsn-field-type :sm) (byte 4 0) (byte 1 5)))
     1660
     1661(defun vinsn-parse-dn-operand (avi value vinsn-params)
     1662  (vinsn-arg-or-dfpr avi value vinsn-params (encode-vinsn-field-type :dn) (byte 4 16)))
     1663
     1664(defun vinsn-parse-sn-operand (avi value vinsn-params)
     1665  (vinsn-arg-or-sfpr avi value vinsn-params (encode-vinsn-field-type :sn) (byte 4 16) (byte 1 7)))
     1666
     1667(defun vinsn-parse-rde-operand (avi value vinsn-params)
     1668  (let* ((val (get-arm-gpr value)))
     1669    (when (and val (oddp val))
     1670      (error "Register ~s must be even-numbered." value)))
     1671  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rd) (byte 4 12)))
     1672
     1673(defun vinsn-parse-rs-operand (avi value vinsn-params)
     1674  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rs) (byte 4 8)))
     1675
    14401676(defun vinsn-simplify-instruction (form vinsn-params)
    14411677  (destructuring-bind (name . opvals) form
    1442     (multiple-value-bind (template cond explicit-cond) (lookup-arm-instruction name)
    1443       (unless template
    1444         (error "Unknown ARM instruction - ~s" form))
    1445       (let* ((cond-indicator (and (consp (car opvals))
    1446                                   (keywordize (caar opvals))))
    1447              (avi (make-arm-vinsn-instruction (arm-instruction-template-val template))))
    1448         (when (or (eq cond-indicator :?)
    1449                   (eq cond-indicator :~))
    1450           (let* ((condform (pop opvals)))
    1451             (destructuring-bind (cond-name) (cdr condform)
    1452               (let* ((p (position cond-name vinsn-params)))
    1453                 (if p
    1454                   (if explicit-cond
    1455                     (error "Can't use ~s with explicit condition name." condform)
    1456                     (progn
    1457                       (add-avi-operand avi (if (eq cond-indicator :?)
    1458                                              (encode-vinsn-field-type :cond)
    1459                                              (encode-vinsn-field-type :negated-cond))
    1460                                        p)
    1461                       (setq cond nil)))
    1462                   (let* ((c (need-arm-condition-name cond-name)))
    1463                     (when (eq cond-indicator :~)
    1464                       (if (< c 14)
    1465                         (setq c (logxor c 1))
    1466                         (error "Invalid explicit condition ~s." condform)))
    1467                     (if (and explicit-cond (not (eql c cond)))
    1468                       (error "Can't use explicit condition and :? : ~s" condform)
    1469                       (setq cond c))))))))
    1470         (let* ((optypes (arm-instruction-template-operand-types template))
    1471                (n (length optypes)))
    1472           (unless (= n (length opvals))
    1473             (error "ARM ~a instructions require ~d operands, but ~d were provided in ~s." (arm-instruction-template-name template) n (length opvals) form))
    1474           (dotimes (i n)
    1475             (let* ((optype (pop optypes))
    1476                    (opval (pop opvals)))
    1477               (funcall (svref *arm-vinsn-operand-parsers* optype)
    1478                        avi opval vinsn-params)))
    1479           (when cond
    1480             (set-avi-opcode-field avi (byte 4 28) cond))
    1481           (avi-head avi))))))
     1678    (case name
     1679      ((:code :data) form)
     1680      (:word (destructuring-bind (val) opvals
     1681               (let* ((p (position val vinsn-params)))
     1682                 (list name (if p (list p) (eval val))))))
     1683      (t
     1684       (multiple-value-bind (template cond explicit-cond) (lookup-arm-instruction name)
     1685         (unless template
     1686           (error "Unknown ARM instruction - ~s" form))
     1687         (let* ((cond-indicator (and (consp (car opvals))
     1688                                     (keywordize (caar opvals))))
     1689                (avi (make-arm-vinsn-instruction (arm-instruction-template-val template))))
     1690           (when (or (eq cond-indicator :?)
     1691                     (eq cond-indicator :~))
     1692             (let* ((condform (pop opvals)))
     1693               (destructuring-bind (cond-name) (cdr condform)
     1694                 (let* ((p (position cond-name vinsn-params)))
     1695                   (if p
     1696                     (if explicit-cond
     1697                       (error "Can't use ~s with explicit condition name." condform)
     1698                       (progn
     1699                         (add-avi-operand avi (if (eq cond-indicator :?)
     1700                                                (encode-vinsn-field-type :cond)
     1701                                                (encode-vinsn-field-type :negated-cond))
     1702                                          p)
     1703                         (setq cond nil)))
     1704                     (let* ((c (need-arm-condition-name cond-name)))
     1705                       (when (eq cond-indicator :~)
     1706                         (if (< c 14)
     1707                           (setq c (logxor c 1))
     1708                           (error "Invalid explicit condition ~s." condform)))
     1709                       (if (and explicit-cond (not (eql c cond)))
     1710                         (error "Can't use explicit condition and :? : ~s" condform)
     1711                         (setq cond c))))))))
     1712           (let* ((optypes (arm-instruction-template-operand-types template))
     1713                  (n (length optypes)))
     1714             (unless (= n (length opvals))
     1715               (error "ARM ~a instructions require ~d operands, but ~d were provided in ~s." (arm-instruction-template-name template) n (length opvals) form))
     1716             (dotimes (i n)
     1717               (let* ((optype (pop optypes))
     1718                      (opval (pop opvals)))
     1719                 (funcall (svref *arm-vinsn-operand-parsers* optype)
     1720                          avi opval vinsn-params)))
     1721             (when cond
     1722               (set-avi-opcode-field avi (byte 4 28) cond))
     1723             (avi-head avi))))))))
    14821724         
    14831725
     1726(defparameter *arm-vinsn-insert-functions*
     1727    #(vinsn-insert-rd-operand
     1728      vinsn-insert-rn-operand
     1729      vinsn-insert-shifter-operand
     1730      vinsn-insert-m12-operand
     1731      vinsn-insert-reglist-operand
     1732      vinsn-insert-rnw-operand
     1733      vinsn-insert-uuoa-operand
     1734      vinsn-insert-uuo-unary-operand
     1735      vinsn-insert-uuob-operand
     1736      vinsn-insert-rm-operand
     1737      vinsn-insert-b-operand
     1738      vinsn-insert-subprim-operand
     1739      vinsn-insert-m8-operand
     1740      vinsn-insert-dd-operand
     1741      vinsn-insert-dm-operand
     1742      vinsn-insert-sd-operand
     1743      vinsn-insert-sm-operand
     1744      vinsn-insert-dn-operand
     1745      vinsn-insert-sn-operand
     1746      vinsn-insert-rde-operand
     1747      vinsn-insert-rs-operand
     1748      ))
    14841749
    14851750(provide "ARM-ASM")
  • branches/arm/compiler/ARM/arm-backend.lisp

    r13715 r13741  
    3232;;; evaluable at macroexpansion time.
    3333(defun %define-arm-vinsn (backend vinsn-name results args temps body)
    34   (let* ((opcode-vector (backend-lap-opcodes backend))
    35          (opcode-lookup (backend-lookup-opcode backend))
    36          (opcode-expander (backend-lookup-macro backend))
    37          (backend-name (backend-name backend))
    38          (arch-name (backend-target-arch-name backend))
     34  (let* ((arch-name (backend-target-arch-name backend))
    3935         (template-hash (backend-p2-template-hash-name backend))
    4036         (name-list ())
     
    9894        (dolist (name non-hybrid-results)
    9995          (add-spec-name name)))
    100       (break)
    101       #+notyet
    10296      (let* ((k -1))
    10397        (declare (fixnum k))
     
    169163                               (if (keywordp opname)
    170164                                 form
    171                                  (let* ((name (string opname))
    172                                         (opnum (funcall opcode-lookup name)))
    173                                    (if (and (not opnum) opcode-expander)
    174                                      (let* ((expander (funcall opcode-expander name)))
    175                                        (if expander
    176                                          (simplify-form (funcall expander form nil))
    177                                          (error "Unknown ~A instruction in ~s" backend-name form)))
    178                                      (let* ((opcode (if (< -1 opnum (length opcode-vector))
    179                                                       (svref opcode-vector opnum)
    180                                                       (error "~& Invalid ~A opcode: ~s" backend-name name)))
    181                                             (opvals (mapcar #'simplify-operand opvals)))
    182                                        (setf (assq opnum opcode-alist) name)
    183                                        (let* ((operands (opcode-vinsn-operands opcode))
    184                                               (nmin (opcode-min-vinsn-args opcode))
    185                                               (nmax (opcode-max-vinsn-args opcode))
    186                                               (nhave (length opvals)))
    187                                          (declare (fixnum nmin nmax nhave))
    188                                          (if (= nhave nmax)
    189                                            `(,opnum ,@opvals)
    190                                            (if (> nhave nmax)
    191                                              (error "Too many operands in ~s (~a accepts at most ~d)"
    192                                                     (cdr w) name nmax)
    193                                              (if (= nhave nmin)
    194                                                (let* ((newops ()))
    195                                                  (dolist (op operands `(,opnum ,@(nreverse newops)))
    196                                                    (let* ((flags (operand-flags op)))
    197                                                      (unless (logbitp operand-fake flags)
    198                                                        (push (if (logbitp operand-optional flags)
    199                                                                0
    200                                                                (pop opvals))
    201                                                              newops)))))
    202                                                (error "Too few operands in ~s : (~a requires at least ~d)"
    203                                                       (cdr w) name nmin))))))))))))))
     165                                 (arm::vinsn-simplify-instruction form name-list)))))))
    204166                (let* ((template (make-vinsn-template
    205167                                  :name vinsn-name
  • branches/arm/compiler/ARM/arm-disassemble.lisp

    r13735 r13741  
    2828(defun arm-gpr-name (regno)
    2929  `(:gpr ,regno))
     30
     31(defun arm-fprd-name (regno)
     32  `(:double ,regno))
     33
     34(defun arm-fprs-name (regno)
     35  `(:single ,regno))
    3036
    3137
     
    210216                      (if u :@+ :@-)) ,rn ,rm)))))))
    211217
     218(defun extract-arm-dd-operand (opcodes i)
     219  (let* ((opcode (adi-opcode (svref opcodes i))))
     220    (arm-fprd-name (ldb (byte 4 12) opcode))))
     221
     222(defun extract-arm-dm-operand (opcodes i)
     223  (let* ((opcode (adi-opcode (svref opcodes i))))
     224    (arm-fprd-name (ldb (byte 4 0) opcode))))
     225
     226(defun extract-arm-sd-operand (opcodes i)
     227  (let* ((opcode (adi-opcode (svref opcodes i))))
     228    (arm-fprs-name (logior (ash (ldb (byte 4 12) opcode) 1)
     229                           (ldb (byte 1 22) opcode)))))
     230
     231(defun extract-arm-sm-operand (opcodes i)
     232  (let* ((opcode (adi-opcode (svref opcodes i))))
     233    (arm-fprs-name (logior (ash (ldb (byte 4 0) opcode) 1)
     234                           (ldb (byte 1 5) opcode)))))
     235
     236(defun extract-arm-dn-operand (opcodes i)
     237  (let* ((opcode (adi-opcode (svref opcodes i))))
     238    (arm-fprd-name (ldb (byte 4 16) opcode))))
     239
     240(defun extract-arm-sn-operand (opcodes i)
     241  (let* ((opcode (adi-opcode (svref opcodes i))))
     242    (arm-fprd-name (logior (ash (ldb (byte 4 16) opcode) 1)
     243                           (ldb (byte 1 7) opcode)))))
     244
     245
    212246(defparameter *arm-operand-extract-functions*
    213247  #(extract-arm-rd-operand
     
    224258    extract-arm-subprim-operand
    225259    extract-arm-m8-operand
     260    extract-arm-dd-operand
     261    extract-arm-dm-operand
     262    extract-arm-sd-operand
     263    extract-arm-sm-operand
     264    extract-arm-dn-operand
     265    extract-arm-sn-operand
    226266    ))
    227267
     
    319359                           (:? (format stream "(:? ~a)" (cadr operand)))
    320360                           (:gpr (format stream "~a" (svref *arm-gpr-names* (cadr operand))))
     361                           (:single (format stream "s~d" (cadr operand)))
     362                           (:double (format stream "d~d" (cadr operand)))
    321363                           (:reglist (format stream "~a"
    322364                                             (mapcar (lambda (r)
  • branches/arm/compiler/ARM/arm-lap.lisp

    r13715 r13741  
    127127      (:data
    128128       (setq current (svref sections 1)))
    129       (:text
     129      (:code
    130130       (setq current (svref sections 0)))
    131131      (:section
    132132       (setq current (svref sections
    133133                            (ecase arg
    134                               (:text 0)
     134                              (:code 0)
    135135                              (:data 1)))))
    136136      (:word
  • branches/arm/compiler/ARM/arm-vinsns.lisp

    r13713 r13741  
    4848                                           )
    4949                                          ())
    50   (mov  dest (:lsr idx 1))
     50  (mov  dest (:lsr idx (:$ 1)))
    5151  (add dest dest (:$ arm::misc-data-offset)))
    5252
     
    5555                                          )
    5656                                         ())
    57   (mov dest (:lsr idx 2))
     57  (mov dest (:lsr idx (:$ 2)))
    5858  (add dest dest (:$ arm::misc-data-offset)))
    5959
     
    6565  (add dest dest (:$ arm::misc-dfloat-offset)))
    6666
     67#+notyet
    6768(define-arm-vinsn scale-1bit-misc-index (((word-index :u32)
    6869                                          (bitnum :u8)) ; (unsigned-byte 5)
     
    135136                                          ((v :lisp)
    136137                                           (scaled-idx :u32))
    137                                           ())
    138   (lfsx dest v scaled-idx))
     138                                          ((temp :u32)))
     139  (ldr temp (:@ v scaled-idx))
     140  (fmsr dest temp))
    139141
    140142(define-arm-vinsn misc-ref-c-single-float  (((dest :single-float))
    141143                                            ((v :lisp)
    142144                                             (idx :u32const))
    143                                             ())
    144   (lfs dest (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
     145                                            ((temp :u32)))
     146  (ldr temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2)))))
     147  (fmsr dest temp))
    145148
    146149(define-arm-vinsn misc-ref-double-float  (((dest :double-float))
    147150                                          ((v :lisp)
    148151                                           (scaled-idx :u32))
    149                                           ())
    150   (lfdx dest v scaled-idx))
     152                                          ((low (:u32 #.arm::imm0))
     153                                           (high (:u32 #.arm::imm1))))
     154  (ldrd low (:@ v scaled-idx))
     155  (fmdrr dest low high))
    151156
    152157
     
    154159                                            ((v :lisp)
    155160                                             (idx :u32const))
    156                                             ())
    157   (lfd dest (:apply + arm::misc-dfloat-offset (:apply ash idx 3)) v))
     161                                            ((low (:u32 #.arm::imm0))
     162                                             (high (:u32 #.arm::imm1))))
     163  (ldrd low (:@ v (:$ idx)))
     164  (fmdrr dest low high))
    158165
    159166(define-arm-vinsn misc-set-c-double-float (((val :double-float))
    160167                                           ((v :lisp)
    161                                             (idx :u32const)))
    162   (stfd val (:apply + arm::misc-dfloat-offset (:apply ash idx 3)) v))
     168                                            (idx :u32const))
     169                                           ((low (:u32 #.arm::imm0))
     170                                            (high (:u32 #.arm::imm1))))
     171  (fmrrd low high val)
     172  (strd low (:@ v (:$ (:apply + arm::misc-dfloat-offset (:apply ash idx 3))))))
    163173
    164174(define-arm-vinsn misc-set-double-float (()
    165175                                         ((val :double-float)
    166176                                          (v :lisp)
    167                                           (scaled-idx :u32)))
    168   (stfdx val v scaled-idx))
    169 
    170 (define-arm-vinsn misc-set-c-single-float (((val :single-float))
    171                                            ((v :lisp)
    172                                             (idx :u32const)))
    173   (stfs val (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
     177                                          (scaled-idx :u32))
     178                                         ((low (:u32 #.arm::imm0))
     179                                          (high (:u32 #.arm::imm1))))
     180  (fmrrd low high val)
     181  (strd low (:@ v scaled-idx)))
     182
     183(define-arm-vinsn misc-set-c-single-float (()
     184                                           ((val :single-float)
     185                                            (v :lisp)
     186                                            (idx :u32const))
     187                                           ((temp :u32)))
     188  (fmrs temp val)
     189  (str temp (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
    174190
    175191
     
    178194                                         ((val :single-float)
    179195                                          (v :lisp)
    180                                           (scaled-idx :u32)))
    181   (stfsx val v scaled-idx))
     196                                          (scaled-idx :u32))
     197                                         ((temp :u32)))
     198  (fmrs temp val)
     199  (str temp (:@ v scaled-idx)))
    182200
    183201
     
    198216                                    (idx :u32const))
    199217                                   ())
    200   (strh val (:+@ v (:apply + arm::misc-data-offset (:apply ash idx 1)))))
     218  (strh val (:+@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
    201219
    202220(define-arm-vinsn misc-set-u16 (((val :u16))
     
    209227                                  (scaled-idx :u32))
    210228                                 ())
    211   (lhax dest v scaled-idx))
     229  (ldrsh dest (:@ v scaled-idx)))
    212230
    213231(define-arm-vinsn misc-ref-c-s16  (((dest :s16))
     
    215233                                    (idx :u32const))
    216234                                   ())
    217   (lha dest (:apply + arm::misc-data-offset (:apply ash idx 1)) v))
     235  (ldrsh dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
    218236
    219237
     
    222240                                    (idx :u32const))
    223241                                   ())
    224   (sth val (:apply + arm::misc-data-offset (:apply ash idx 1)) v))
     242  (strh val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 1))))))
    225243
    226244(define-arm-vinsn misc-set-s16 (((val :s16))
    227245                                ((v :lisp)
    228246                                 (scaled-idx :s32)))
    229   (sthx val v scaled-idx))
     247  (strh val (:@ v scaled-idx)))
    230248
    231249(define-arm-vinsn misc-ref-u8  (((dest :u8))
     
    233251                                 (scaled-idx :u32))
    234252                                ())
    235   (lbzx dest v scaled-idx))
     253  (ldrb dest (:@ v scaled-idx)))
    236254
    237255(define-arm-vinsn misc-ref-c-u8  (((dest :u8))
     
    239257                                   (idx :u32const))
    240258                                  ())
    241   (lbz dest (:apply + arm::misc-data-offset idx) v))
     259  (ldrb dest (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
    242260
    243261(define-arm-vinsn misc-set-c-u8  (((val :u8))
     
    245263                                   (idx :u32const))
    246264                                  ())
    247   (stb val (:apply + arm::misc-data-offset idx) v))
     265  (strb val (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
    248266
    249267(define-arm-vinsn misc-set-u8  (((val :u8))
     
    251269                                 (scaled-idx :u32))
    252270                                ())
    253   (stbx val v scaled-idx))
     271  (strb val (:@ v scaled-idx)))
    254272
    255273(define-arm-vinsn misc-ref-s8  (((dest :s8))
     
    257275                                 (scaled-idx :u32))
    258276                                ())
    259   (lbzx dest v scaled-idx)
    260   (extsb dest dest))
     277  (ldrsb dest (:@ v scaled-idx)))
    261278
    262279(define-arm-vinsn misc-ref-c-s8  (((dest :s8))
     
    264281                                   (idx :u32const))
    265282                                  ())
    266   (lbz dest (:apply + arm::misc-data-offset idx) v)
    267   (extsb dest dest))
     283  (ldrsb dest (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
    268284
    269285(define-arm-vinsn misc-set-c-s8  (((val :s8))
     
    271287                                   (idx :u32const))
    272288                                  ())
    273   (stb val (:apply + arm::misc-data-offset idx) v))
     289  (strb val (:@ v (:$ (:apply + arm::misc-data-offset idx)))))
    274290
    275291(define-arm-vinsn misc-set-s8  (((val :s8))
     
    277293                                 (scaled-idx :u32))
    278294                                ())
    279   (stbx val v scaled-idx))
    280 
     295  (strb val (:@ v scaled-idx)))
     296
     297#+notyet
    281298(define-arm-vinsn misc-ref-c-bit (((dest :u8))
    282299                                  ((v :lisp)
     
    286303  (rlwinm dest dest (:apply 1+ (:apply logand idx #x1f)) 31 31))
    287304
     305#+notyet
    288306(define-arm-vinsn misc-ref-c-bit-fixnum (((dest :imm))
    289307                                         ((v :lisp)
     
    302320                                   (scaled-idx :s32))
    303321                                  ())
    304   (lwzx dest v scaled-idx))
     322  (ldr dest (:@ v scaled-idx)))
    305323
    306324
     
    311329                                    (idx :s16const))
    312330                                   ())
    313   (lwz dest (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
     331  (ldr dest (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
    314332
    315333(define-arm-vinsn misc-set-node (()
     
    317335                                  (v :lisp)
    318336                                  (scaled-idx :u32)))
    319   (stwx val v scaled-idx))
     337  (str val (:@ v scaled-idx)))
    320338
    321339;;; This should only be used for initialization (when the value being
     
    326344                                    (idx :s16const))
    327345                                   ())
    328   (stw val (:apply + arm::misc-data-offset (:apply ash idx 2)) v))
     346  (str val (:@ v (:$ (:apply + arm::misc-data-offset (:apply ash idx 2))))))
    329347
    330348
     
    332350                                             ((v :lisp))
    333351                                             ((temp :u32)))
    334   (lwz temp arm::misc-header-offset v)
    335   (rlwinm dest
    336           temp
    337           (- arm::nbits-in-word (- arm::num-subtag-bits arm::fixnumshift))
    338           (- arm::num-subtag-bits arm::fixnumshift)
    339           (- arm::least-significant-bit arm::fixnumshift)))
     352  (ldr temp (:@ v (:$ arm::misc-header-offset)))
     353  (bic temp temp (:$ arm::subtag-mask))
     354  (mov dest (:lsr temp (:$ (- arm::num-subtag-bits arm::fixnum-shift)))))
    340355
    341356(define-arm-vinsn check-misc-bound (()
     
    343358                                     (v :lisp))
    344359                                    ((temp :u32)))
    345   (lwz temp arm::misc-header-offset v)
    346   (rlwinm temp
    347           temp
    348           (- arm::nbits-in-word (- arm::num-subtag-bits arm::fixnumshift))
    349           (- arm::num-subtag-bits arm::fixnumshift)
    350           (- arm::least-significant-bit arm::fixnumshift))
    351   (twlge idx temp))
     360  (ldr temp (:@ v (:$ arm::misc-header-offset)))
     361  (bic temp temp (:$ arm::subtag-mask))
     362  (cmp idx (:lsr temp (:$ (- arm::num-subtag-bits arm::fixnum-shift))))
     363  (uuo-error-vector-bounds (:? hs) idx v))
    352364
    353365(define-arm-vinsn 2d-unscaled-index (((dest :imm)
     
    356368                                      (i :imm)
    357369                                      (j :imm)))
    358   (mullw dim1 i dim1)
     370  (mul dim1 i dim1)
    359371  (add dest dim1 j))
    360372
    361373;; dest <- (+ (* i dim1 dim2) (* j dim2) k)
     374
    362375(define-arm-vinsn 3d-unscaled-index (((dest :imm)
    363376                                      (dim1 :u32)
     
    368381                                      (j :imm)
    369382                                      (k :imm)))
    370   (mullw dim1 dim1 dim2)
    371   (mullw dim2 j dim2)
    372   (mullw dim1 i dim1)
     383  (mul dim1 dim1 dim2)
     384  (mul dim2 j dim2)
     385  (mul dim1 i dim1)
    373386  (add dim2 dim1 dim2)
    374387  (add dest dim2 k))
     
    377390(define-arm-vinsn 2d-dim1 (((dest :u32))
    378391                           ((header :lisp)))
    379   (lwz dest (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
    380   (srawi dest dest arm::fixnumshift))
     392  (ldr dest (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
     393  (mov dest (:asr dest (:$ arm::fixnumshift))))
     394
     395
    381396
    382397(define-arm-vinsn 3d-dims (((dim1 :u32)
    383398                            (dim2 :u32))
    384399                           ((header :lisp)))
    385   (lwz dim1 (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
    386   (lwz dim2 (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))) header)
    387   (srawi dim1 dim1 arm::fixnumshift)
    388   (srawi dim2 dim2 arm::fixnumshift))
     400  (ldr dim1 (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
     401  (ldr dim2 (:@ header (:$ (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))))))
     402  (mov dim1 (:asr dim1 (:$ arm::fixnumshift)))
     403  (mov dim2 (:asr dim2 (:$ arm::fixnumshift))))
    389404
    390405;; Return dim1 (unboxed)
     
    393408                                   (j :imm)
    394409                                   (header :lisp)))
    395   (lwz dim (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)) header)
    396   (twlge i dim)
    397   (lwz dim (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
    398   (twlge j dim)
    399   (srawi dim dim arm::fixnumshift))
     410  (ldr dim (:@ header (:$ (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)))))
     411  (cmp i dim)
     412  (uuo-error-array-bounds (:? hs) i header)
     413  (ldr dim (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
     414  (cmp j dim)
     415  (uuo-error-array-bounds (:? hs) j header)
     416  (mov dim (:asr dim (:$ arm::fixnumshift))))
    400417
    401418(define-arm-vinsn check-3d-bound (((dim1 :u32)
     
    405422                                   (k :imm)
    406423                                   (header :lisp)))
    407   (lwz dim1 (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)) header)
    408   (twlge i dim1)
    409   (lwz dim1 (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))) header)
    410   (twlge j dim1)
    411   (lwz dim2 (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))) header)
    412   (twlge k dim2)
    413   (srawi dim1 dim1 arm::fixnumshift)
    414   (srawi dim2 dim2 arm::fixnumshift))
     424  (ldr dim1 (:@ header (:$ (+ arm::misc-data-offset (* 4 arm::arrayH.dim0-cell)))))
     425  (cmp i dim1)
     426  (uuo-error-array-bounds (:? hs) i header)
     427  (ldr dim1 (:@ header (:$ (+ arm::misc-data-offset (* 4 (1+ arm::arrayH.dim0-cell))))))
     428  (cmp j dim1)
     429  (uuo-error-array-bounds (:? hs) i header)
     430  (ldr dim2 (:@ header (:$ (+ arm::misc-data-offset (* 4 (+ 2 arm::arrayH.dim0-cell))))))
     431  (cmp k dim2)
     432  (uuo-error-array-bounds (:? hs) i header)
     433  (mov dim1 (:asr dim1 (:$ arm::fixnumshift)))
     434  (mov dim2 (:asr dim2 (:$ arm::fixnumshift))))
    415435
    416436(define-arm-vinsn array-data-vector-ref (((dest :lisp))
    417437                                         ((header :lisp)))
    418   (lwz dest arm::arrayH.data-vector header))
     438  (ldr dest (:@ header (:$ arm::arrayH.data-vector))))
    419439 
    420440
     441#+can-encode-array-rank-trap
    421442(define-arm-vinsn check-arrayH-rank (()
    422443                                     ((header :lisp)
    423444                                      (expected :u32const))
    424445                                     ((rank :imm)))
    425   (lwz rank arm::arrayH.rank header)
    426   (twi 27 rank (:apply ash expected arm::fixnumshift)))
    427 
     446  (ldr rank (:@ header (:$ arm::arrayH.rank)))
     447  (cmp rank (:apply ash expected arm::fixnumshift))
     448  (uuo-error-bad-array-rank (:? ne) expected header))
     449
     450#+can-remember-what-this-means
    428451(define-arm-vinsn check-arrayH-flags (()
    429452                                      ((header :lisp)
     
    443466                                  ((node :lisp)
    444467                                   (cellno :u32const)))
    445   (lwz dest (:apply + arm::misc-data-offset (:apply ash cellno 2)) node))
     468  (ldr dest (:@ node (:$ (:apply + arm::misc-data-offset (:apply ash cellno 2))))))
    446469
    447470
     
    451474                               (index :lisp))
    452475                              ((scaled :u32)))
    453   (la scaled arm::misc-data-offset index)
    454   (lwzx dest instance scaled)
    455   (tweqi dest arm::slot-unbound-marker))
     476  (add scaled index (:$ arm::misc-data-offset))
     477  (ldr dest (:@ instance scaled))
     478  (cmp dest (:$ arm::slot-unbound-marker))
     479  (uuo-error-slot-unbound (:? eq) instance index))
    456480
    457481
     
    461485                                      ((src :address)
    462486                                       (index :s16const)))
    463   (lwz dest index src))
     487  (ldr dest (:@ src (:$ index))))
    464488
    465489
     
    467491                                             ((src :address)
    468492                                              (index :s16const)))
    469   (lwz dest index src))
     493  (ldr dest (:@ src (:$ index))))
    470494
    471495(define-arm-vinsn mem-ref-c-natural (((dest :u32))
    472496                                     ((src :address)
    473497                                      (index :s16const)))
    474   (lwz dest index src))
     498  (ldr dest (:@ src (:$ index))))
    475499 
    476500
     
    478502                                    ((src :address)
    479503                                     (index :s32)))
    480   (lwzx dest src index))
     504  (ldr dest (:@ src index)))
    481505
    482506(define-arm-vinsn mem-ref-signed-fullword (((dest :u32))
    483507                                           ((src :address)
    484508                                            (index :s32)))
    485   (lwzx dest src index))
     509  (ldr dest (:@ src index)))
    486510
    487511(define-arm-vinsn mem-ref-natural (((dest :u32))
    488512                                   ((src :address)
    489513                                    (index :s32)))
    490   (lwzx dest src index))
     514  (ldr dest (:@ src index)))
    491515
    492516
     
    494518                                 ((src :address)
    495519                                  (index :s16const)))
    496   (lhz dest index src))
     520  (ldrh dest (:@ src (:$ index))))
    497521
    498522
     
    500524                               ((src :address)
    501525                                (index :s32)))
    502   (lhzx dest src index))
     526  (ldrh dest (:@ src index)))
    503527
    504528
     
    507531                                 ((src :address)
    508532                                  (index :s16const)))
    509   (lha dest index src))
     533  (ldrsh dest (:@ src (:$ index))))
    510534
    511535(define-arm-vinsn mem-ref-s16 (((dest :s16))
    512536                               ((src :address)
    513537                                (index :s32)))
    514   (lhax dest src index))
     538  (ldrsh dest (:@ src index)))
    515539
    516540(define-arm-vinsn mem-ref-c-u8 (((dest :u8))
    517541                                ((src :address)
    518542                                 (index :s16const)))
    519   (lbz dest index src))
     543  (ldrb dest (:@ src (:$ index))))
    520544
    521545(define-arm-vinsn mem-ref-u8 (((dest :u8))
    522546                              ((src :address)
    523547                               (index :s32)))
    524   (lbzx dest src index))
     548  (ldrb dest (:@ src index)))
    525549
    526550(define-arm-vinsn mem-ref-c-s8 (((dest :s8))
    527551                                ((src :address)
    528552                                 (index :s16const)))
    529   (lbz dest index src)
    530   (extsb dest dest))
     553  (ldrsb dest (:@ src (:$ index))))
    531554
    532555(define-arm-vinsn mem-ref-s8 (((dest :s8))
    533556                              ((src :address)
    534557                               (index :s32)))
    535   (lbzx dest src index)
    536   (extsb dest dest))
    537 
     558  (ldrsb dest (:@ src index)))
     559
     560#+notyet
    538561(define-arm-vinsn mem-ref-c-bit (((dest :u8))
    539562                                 ((src :address)
     
    543566  (rlwinm dest dest bit-shift 31 31))
    544567
     568
     569#+notyet
    545570(define-arm-vinsn mem-ref-c-bit-fixnum (((dest :lisp))
    546571                                        ((src :address)
     
    551576  (rlwinm dest byteval bit-shift 29 29))
    552577
     578#+notyet
    553579(define-arm-vinsn mem-ref-bit (((dest :u8))
    554580                               ((src :address)
     
    562588  (rlwnm dest dest bit-shift 31 31))
    563589
    564 
     590#+notyet
    565591(define-arm-vinsn mem-ref-bit-fixnum (((dest :lisp))
    566592                                      ((src :address)
     
    580606(define-arm-vinsn mem-ref-c-double-float (((dest :double-float))
    581607                                          ((src :address)
    582                                            (index :s16const)))
    583   (lfd dest index src))
     608                                           (index :s16const))
     609                                          ((low (:u32 #.arm::imm0))
     610                                           (high (:u32 #.arm::imm1))))
     611  (ldrd low (:@ src (:$ index)))
     612  (fmdrr dest low high))
    584613
    585614(define-arm-vinsn mem-ref-double-float (((dest :double-float))
    586615                                        ((src :address)
    587                                          (index :s32)))
    588   (lfdx dest src index))
     616                                         (index :s32))
     617                                        ((low (:u32 #.arm::imm0))
     618                                         (high (:u32 #.arm::imm1))))
     619  (ldrd low (:@ src  index))
     620  (fmdrr dest low high))
    589621
    590622(define-arm-vinsn mem-set-c-double-float (()
    591623                                          ((val :double-float)
    592624                                           (src :address)
    593                                            (index :s16const)))
    594   (stfd val index src))
     625                                           (index :s16const))
     626                                          ((low (:u32 #.arm::imm0))
     627                                           (high (:u32 #.arm::imm1))))
     628  (fmrrd low high src)
     629  (strd low (:@ src (:$ index))))
    595630
    596631(define-arm-vinsn mem-set-double-float (()
    597632                                        ((val :double-float)
    598633                                         (src :address)
    599                                          (index :s32)))
    600   (stfdx val src index))
     634                                         (index :s32)) ; imm2, I presume
     635                                        ((low (:u32 #.arm::imm0))
     636                                         (high (:u32 #.arm::imm1))))
     637  (fmrrd low high src)
     638  (strd low (:@ src index)))
    601639
    602640(define-arm-vinsn mem-ref-c-single-float (((dest :single-float))
    603641                                          ((src :address)
    604                                            (index :s16const)))
    605   (lfs dest index src))
     642                                           (index :s16const))
     643                                          ((temp :u32)))
     644  (ldr temp (:@ src (:$ index)))
     645  (fmsr dest temp))
    606646
    607647(define-arm-vinsn mem-ref-single-float (((dest :single-float))
    608648                                        ((src :address)
    609                                          (index :s32)))
    610   (lfsx dest src index))
     649                                         (index :s32))
     650                                        ((temp :u32)))
     651  (ldr temp (:@ src index))
     652  (fmsr dest temp))
    611653
    612654(define-arm-vinsn mem-set-c-single-float (()
    613655                                          ((val :single-float)
    614656                                           (src :address)
    615                                            (index :s16const)))
    616   (stfs val index src))
     657                                           (index :s16const))
     658                                          ((temp :u32)))
     659  (fmrs temp src)
     660  (str temp (:@ src (:$ index))))
    617661
    618662(define-arm-vinsn mem-set-single-float (()
    619663                                        ((val :single-float)
    620664                                         (src :address)
    621                                          (index :s32)))
    622   (stfsx val src index))
     665                                         (index :s32))
     666                                        ((temp :u32)))
     667  (fmrs temp src)
     668  (str temp (:@ src (:$ index))))
    623669
    624670
     
    627673                                      (src :address)
    628674                                      (index :s16const)))
    629   (stw val index src))
     675  (str val (:@ src (:$ index))))
    630676
    631677(define-arm-vinsn mem-set-address (()
     
    633679                                    (src :address)
    634680                                    (index :s32)))
    635   (stwx val src index))
     681  (str val (:@ src index)))
    636682
    637683(define-arm-vinsn mem-set-c-fullword (()
     
    639685                                       (src :address)
    640686                                       (index :s16const)))
    641   (stw val index src))
     687  (str val (:@ src (:$ index))))
    642688
    643689(define-arm-vinsn mem-set-fullword (()
     
    645691                                     (src :address)
    646692                                     (index :s32)))
    647   (stwx val src index))
     693  (str val (:@ src index)))
    648694
    649695(define-arm-vinsn mem-set-c-halfword (()
     
    651697                                       (src :address)
    652698                                       (index :s16const)))
    653   (sth val index src))
     699  (strh val (:@ src (:$ index))))
    654700
    655701(define-arm-vinsn mem-set-halfword (()
     
    657703                                     (src :address)
    658704                                     (index :s32)))
    659   (sthx val src index))
     705  (strh val (:@ src index)))
    660706
    661707(define-arm-vinsn mem-set-c-byte (()
     
    663709                                   (src :address)
    664710                                   (index :s16const)))
    665   (stb val index src))
     711  (strb val (:@ src (:$ index))))
    666712
    667713(define-arm-vinsn mem-set-byte (()
     
    669715                                 (src :address)
    670716                                 (index :s32)))
    671   (stbx val src index))
    672 
     717  (strb val (:@ src index)))
     718
     719#+later
    673720(define-arm-vinsn mem-set-c-bit-0 (()
    674721                                   ((src :address)
     
    681728  (stb val byte-index src))
    682729
     730#+later
    683731(define-arm-vinsn mem-set-c-bit-1 (()
    684732                                   ((src :address)
     
    690738  (stb val byte-index src))
    691739
     740#+later
    692741(define-arm-vinsn mem-set-c-bit (()
    693742                                 ((src :address)
     
    738787                                      ((object :lisp)))
    739788  (and tag object (:$ arm::tagmask))
    740   (mov tag (:lsl$ tag arm::fixnumshift)))
     789  (mov tag (:lsl tag (:$ arm::fixnumshift))))
    741790
    742791(define-arm-vinsn extract-fulltag (((tag :u8))
     
    749798                                          ((object :lisp)))
    750799  (and tag object (:$ arm::fulltagmask))
    751   (mov tag (:lsl$ tag arm::fixnumshift)))
     800  (mov tag (:lsl tag (:$ arm::fixnumshift))))
    752801
    753802(define-arm-vinsn extract-typecode (((code :u8))
     
    756805  (and code object (:$ arm::tagmask))
    757806  (cmp code (:$ arm::tag-misc))
    758   (ldrbeq code (:@$ object arm::misc-subtag-offset)))
     807  (ldrbeq code (:@ object (:$ arm::misc-subtag-offset))))
    759808
    760809(define-arm-vinsn extract-typecode-fixnum (((code :imm))
     
    763812  (and subtag object (:$ arm::tagmask))
    764813  (cmp subtag (:$ arm::tag-misc))
    765   (ldrbeq subtag (:@$ object arm::misc-subtag-offset))
    766   (mov code (:lsl$ subtag arm::fixnumshift)))
     814  (ldrbeq subtag (:@ object (:$ arm::misc-subtag-offset)))
     815  (mov code (:lsl subtag (:$ arm::fixnumshift))))
    767816
    768817
     
    781830  (beq :got-it)
    782831  (cmp tag (:$ arm::tag-misc))
    783   (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
     832  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    784833  (cmp tag (:$ arm::subtag-bignum))
    785834  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::xtype-integer))
     
    791840  (and tag object (:$ arm::tagmask))
    792841  (cmp tag (:$ arm::tag-misc))
    793   (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
     842  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    794843  (cmp tag (:$ arm::subtag-simple-vector))
    795844  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::subtag-simple-vector)))
     
    800849  (and tag object (:$ arm::tagmask))
    801850  (cmp tag (:$ arm::tag-misc))
    802   (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
     851  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    803852  (cmp tag (:$ arm::subtag-simple-base-string))
    804853  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::subtag-simple-base-string)))
     
    810859  (and tag object (:$ arm::tagmask))
    811860  (cmp tag (:$ arm::tag-misc))
    812   (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
     861  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    813862  (cmp tag (:$ arm::max-real-subtag))
    814863  (uuo-cerror-reg-not-xtype (:? hi) object (:$ arm::xtype-real)))
     
    819868  (and tag object (:$ arm::tagmask))
    820869  (cmp tag (:$ arm::tag-misc))
    821   (ldrbeq tag (:+@$ object arm::misc-subtag-offset))
     870  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
    822871  (cmp tag (:$ arm::max-numeric-subtag))
    823872  (uuo-cerror-reg-not-xtype (:? hi) object (:$ arm::xtype-number)))
     
    834883                                  ((object :lisp))
    835884                                  ((tag :u8)))
    836   (and tag object (:$ arm::lisptagmask))
     885  (and tag object (:$ arm::tagmask))
    837886  (cmp tag (:$ arm::tag-misc))
    838887  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     
    853902                              ((tag :u32)))
    854903  (mov tag (:lsl object (:$ (- arm::nbits-in-word (+ 8 arm::fixnumshift)))))
    855   (mov tag (:asr tag (- arm::nbits-in-word (+ 8 arm::fixnumshift))))
     904  (mov tag (:asr tag (:$ (- arm::nbits-in-word (+ 8 arm::fixnumshift)))))
    856905  (cmp object (:lsl tag (:$ arm::fixnumshift)))
    857906  (uuo-cerror-reg-not-xtype (:? ne)  object (:$ arm::xtype-s8)))
     
    859908
    860909(define-arm-vinsn require-u8 (()
    861                               ((object :lisp)))
    862   (tst object (:$ (lognot (ash #xff arm::fixnumshift))))
     910                              ((object :lisp))
     911                              ((temp :u32)))
     912  (mov temp (:$ (lognot (ash #xff arm::fixnumshift))))
     913  (tst object temp)
    863914  (uuo-cerror-reg-not-xtype (:? ne) object (:$ arm::xtype-u8)))
    864915
     
    890941  (ldreq header (:@ src (:$ arm::misc-header-offset)))
    891942  (cmpeq tag header)
    892   (uuo-cerror-object-not-xtype (:? ne) src (:$ arm::xtype-s32))
     943  (uuo-cerror-reg-not-xtype (:? ne) src (:$ arm::xtype-s32))
    893944  :got-it)
    894945
     
    898949                               ((temp :u32)))
    899950  :again
    900   (test src (:$ (logior (ash 1 (1- arm::nbits-in-word)) arm::tagmask)))
     951  (tst src (:$ (logior (ash 1 (1- arm::nbits-in-word)) arm::tagmask)))
    901952  (beq :got-it)
    902953  (and temp src (:$ arm::tagmask))
     
    905956  (cmp temp (:$ arm::subtag-bignum))
    906957  (bne :bad-if-ne)
    907   (ldr temp (:@ src arm::misc-header-offset))
     958  (ldr temp (:@ src (:$ arm::misc-header-offset)))
    908959  (mov temp (:lsr temp (:$ arm::num-subtag-bits)))
    909960  (cmp temp (:$ 2))
     
    930981  (ldreq header (:@ src (:$ arm::misc-header-offset)))
    931982  (andeq tag header (:$ arm::subtag-mask))
    932   (cmp tag (:$ arm::subtag_bignum))
    933   (move header (:lsr header (:$ arm::num-subtag-bits)))
     983  (cmp tag (:$ arm::subtag-bignum))
     984  (mov header (:lsr header (:$ arm::num-subtag-bits)))
    934985  (bne :bad-if-ne)
    935986  (cmp header (:$ 1))
     
    9491000  (beq :got-it)
    9501001  (cmp temp (:$ arm::tag-misc))
    951   (ldreq header (:@ src (:$ arm::misc-header-offset0)))
     1002  (ldreq header (:@ src (:$ arm::misc-header-offset)))
    9521003  (andeq temp src (:$ arm::subtag-mask))
    9531004  (moveq header (:lsr header (:$ arm::num-subtag-bits)))
     
    10131064  (cmp temp (:$ arm::tag-misc))
    10141065  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
    1015   (ldr dest (:+@$ src arm::misc-header-offset))
    1016   (ldr temp (:$ arm::subtag-bignum))
     1066  (ldr dest (:@ src (:$ arm::misc-header-offset)))
     1067  (mov temp (:$ arm::subtag-bignum))
    10171068  (orr temp temp (:$ (ash 1 arm::num-subtag-bits)))
    10181069  (cmp dest temp)
    10191070  (bne :maybe-two-digit)
    1020   (ldr dest (:+@$ src arm::misc-data-offset))
     1071  (ldr dest (:@ src (:$ arm::misc-data-offset)))
    10211072  (tst dest (:$ 31))
    10221073  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
     
    10251076  (add temp temp (:$ (ash 1 arm::num-subtag-bits)))
    10261077  (cmp dest temp)
    1027   (ldreq temp (:+@$ src (+ arm::misc-data-offset 4)))
     1078  (ldreq temp (:@ src (:$ (+ arm::misc-data-offset 4))))
    10281079  (cmpeq temp (:$ 0))
    1029   (ldreq dest (:+@$ src arm::misc-data-offset))
     1080  (ldreq dest (:@ src (:$ arm::misc-data-offset)))
    10301081  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-u32))
    1031   :got-it))
     1082  :got-it)
    10321083
    10331084;;; an object is of type (SIGNED-BYTE 32) iff
     
    10391090                             ((tag :u32)))
    10401091  (ands tag src (:$ arm::tagmask))
    1041   (mov dest (:asr$ src arm::fixnumshift))
     1092  (mov dest (:asr src (:$ arm::fixnumshift)))
    10421093  (beq :got-it)
    10431094  (mov dest (:$ arm::subtag-bignum))
    10441095  (orr dest dest (:$ (ash 1 arm::num-subtag-bits)))
    10451096  (cmp tag (:$ arm::tag-misc))
    1046   (ldreq tag (:+@ src (:$ arm::misc-header-offset)))
     1097  (ldreq tag (:@ src (:$ arm::misc-header-offset)))
    10471098  (cmpeq dest tag)
    1048   (ldreq dest (:+@ src (:$ arm::misc-data-offset)))
     1099  (ldreq dest (:@ src (:$ arm::misc-data-offset)))
    10491100  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-s32))
    1050   :got-it))
     1101  :got-it)
    10511102
    10521103
     
    10831134                            ((src :lisp)))
    10841135  (mov dest (:lsl dest (:$ (- 24 arm::fixnumshift))))
    1085   (mov dest (:$ asr dest (:$ 24)))
     1136  (mov dest (:asr dest (:$ 24)))
    10861137  (cmp src (:lsl dest (:$ arm::fixnumshift)))
    10871138  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::xtype-s8)))
     
    10921143  (cmp dest (:$ arm::subtag-character))
    10931144  (mov dest (:lsr src (:$ arm::charcode-shift)))
    1094   (uuo-error-object-not-xtype (:? ne) src (:$ arm::subtag-character)))
     1145  (uuo-error-reg-not-xtype (:? ne) src (:$ arm::subtag-character)))
    10951146
    10961147
     
    11011152  (uuo-error-reg-not-xtype (:? hi) src (:$ arm::xtype-bit)))
    11021153
     1154#+later
    11031155(define-arm-vinsn unbox-bit-bit0 (((dest :u32))
    11041156                                  ((src :lisp))
     
    11101162  :got-it)
    11111163
    1112 (define-arm-vinsn fixnum->fpr (((dest :double-float))
    1113                                ((src :lisp))
    1114                                ((imm :s32)))
    1115   (stfd arm::fp-s32conv -8 arm::sp)
    1116   (srawi imm src arm::fixnumshift)
    1117   (xoris imm imm #x8000)
    1118   (stw imm -4 arm::sp)
    1119   (lfd dest -8 arm::sp)
    1120   (fsub dest dest arm::fp-s32conv))
     1164(define-arm-vinsn fixnum->double (((dest :double-float))
     1165                                  ((src :lisp))
     1166                                  ((imm :s32)
     1167                                   (temp :single-float)))
     1168  (mov imm (:asr src (:$ arm::fixnumshift)))
     1169  (fmsr temp imm)
     1170  (fsitod dest temp))
     1171
     1172(define-arm-vinsn fixnum->single (((dest :single-float))
     1173                                  ((src :lisp))
     1174                                  ((imm :s32)))
     1175  (mov imm (:asr src (:$ arm::fixnumshift)))
     1176  (fmsr dest imm)
     1177  (fsitos dest dest))
    11211178
    11221179
     
    11241181                                             ((src :u32)
    11251182                                              (sh :u32)))
    1126   (srw dest src sh))
     1183  (mov dest (:lsr src sh)))
    11271184
    11281185(define-arm-vinsn u32logandc2 (((dest :u32))
    11291186                               ((x :u32)
    11301187                                (y :u32)))
    1131   (andc dest x y))
     1188  (bic dest x y))
    11321189
    11331190(define-arm-vinsn u32logior (((dest :u32))
    11341191                             ((x :u32)
    11351192                              (y :u32)))
    1136   (or dest x y))
    1137 
    1138 (define-arm-vinsn rotate-left-variable-word (((dest :u32))
    1139                                              ((src :u32)
    1140                                               (rot :u32)))
    1141   (rlwnm dest src rot 0 31))
     1193  (orr dest x y))
    11421194
    11431195(define-arm-vinsn complement-shift-count (((dest :u32))
    11441196                                          ((src :u32)))
    1145   (subfic dest src 32))
     1197  (rsb dest src (:$ 32)))
    11461198
    11471199(define-arm-vinsn extract-lowbyte (((dest :u32))
    11481200                                   ((src :lisp)))
    1149   (clrlwi dest src (- arm::nbits-in-word arm::num-subtag-bits)))
    1150 
    1151 ;;; Set DEST to the difference between the low byte of SRC and BYTEVAL.
    1152 (define-arm-vinsn extract-compare-lowbyte (((dest :u32))
    1153                                            ((src :lisp)
    1154                                             (byteval :u8const)))
    1155   (clrlwi dest src (- arm::nbits-in-word arm::num-subtag-bits))
    1156   (subi dest dest byteval))
    1157 
    1158 
    1159 ;;; Set the "EQ" bit in condition-register field CRF if object is
    1160 ;;; a fixnum.  Leave the object's tag in TAG.
    1161 ;;; This is a little easier if CRF is CR0.
    1162 (define-arm-vinsn eq-if-fixnum (((crf :crf)
    1163                                  (tag :u8))
    1164                                 ((object :lisp))
    1165                                 ())
    1166   ((:eq crf 0)
    1167    (clrlwi. tag object (- arm::nbits-in-word arm::nlisptagbits)))
    1168   ((:not (:eq crf 0))
    1169    (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1170    (cmpwi crf tag arm::tag-fixnum)))
     1201  (and dest src (:$ arm::subtag-mask)))
     1202
    11711203
    11721204
    11731205
    11741206(define-arm-vinsn trap-unless-fixnum (()
    1175                                       ((object :lisp))
    1176                                       ((tag :u8)))
    1177   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1178   (twnei tag arm::tag-fixnum))
     1207                                      ((object :lisp)))
     1208  (tst object (:$ arm::fixnummask))
     1209  (uuo-error-reg-not-lisptag (:? ne) object (:$ arm::tag-fixnum)))
    11791210
    11801211(define-arm-vinsn trap-unless-list (()
    11811212                                    ((object :lisp))
    11821213                                    ((tag :u8)))
    1183   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1184   (twnei tag arm::tag-list))
     1214  (ands tag object (:$ arm::tagmask))
     1215  (cmp tag (:$ arm::tag-list))
     1216  (uuo-error-reg-not-lisptag (:? ne) object (:$ arm::tag-list)))
    11851217
    11861218(define-arm-vinsn trap-unless-single-float (()
    11871219                                            ((object :lisp))
    1188                                             ((tag :u8)
    1189                                              (crf :crf)))
    1190   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1191   (cmpwi crf tag arm::tag-misc)
    1192   (bne crf :do-trap)
    1193   (lbz tag arm::misc-subtag-offset object)
    1194   :do-trap
    1195   (twnei tag arm::subtag-single-float))
     1220                                            ((tag :u8)))
     1221  (and tag object (:$ arm::tagmask))
     1222  (cmp tag (:$ arm::tag-misc))
     1223  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     1224  (cmp tag (:$ arm::subtag-single-float))
     1225  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-single-float)))
    11961226
    11971227(define-arm-vinsn trap-unless-double-float (()
    11981228                                            ((object :lisp))
    1199                                             ((tag :u8)
    1200                                              (crf :crf)))
    1201   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1202   (cmpwi crf tag arm::tag-misc)
    1203   (bne crf :do-trap)
    1204   (lbz tag arm::misc-subtag-offset object)
    1205   :do-trap
    1206   (twnei tag arm::subtag-double-float))
     1229                                            ((tag :u8)))
     1230  (and tag object (:$ arm::tagmask))
     1231  (cmp tag (:$ arm::tag-misc))
     1232  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     1233  (cmp tag (:$ arm::subtag-double-float))
     1234  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-double-float)))
    12071235
    12081236
    12091237(define-arm-vinsn trap-unless-array-header (()
    12101238                                            ((object :lisp))
    1211                                             ((tag :u8)
    1212                                              (crf :crf)))
    1213   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1214   (cmpwi crf tag arm::tag-misc)
    1215   (bne crf :do-trap)
    1216   (lbz tag arm::misc-subtag-offset object)
    1217   :do-trap
    1218   (twnei tag arm::subtag-arrayH))
     1239                                            ((tag :u8)))
     1240  (and tag object (:$ arm::tagmask))
     1241  (cmp tag (:$ arm::tag-misc))
     1242  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     1243  (cmp tag (:$ arm::subtag-arrayH))
     1244  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-arrayH)))
    12191245
    12201246(define-arm-vinsn trap-unless-macptr (()
    12211247                                      ((object :lisp))
    1222                                       ((tag :u8)
    1223                                        (crf :crf)))
    1224   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1225   (cmpwi crf tag arm::tag-misc)
    1226   (bne crf :do-trap)
    1227   (lbz tag arm::misc-subtag-offset object)
    1228   :do-trap
    1229   (twnei tag arm::subtag-macptr))
     1248                                      ((tag :u8)))
     1249  (and tag object (:$ arm::tagmask))
     1250  (cmp tag (:$ arm::tag-misc))
     1251  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     1252  (cmp tag (:$ arm::subtag-macptr))
     1253  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-macptr)))
    12301254
    12311255
     
    12341258                                       ((object :lisp))
    12351259                                       ((tag :u8)))
    1236   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1237   (twnei tag arm::tag-misc))
    1238 
    1239 (define-arm-vinsn trap-unless-fulltag= (()
    1240                                         ((object :lisp)
    1241                                          (tagval :u16const))
    1242                                         ((tag :u8)))
    1243   (clrlwi tag object (- arm::nbits-in-word arm::ntagbits))
    1244   (twnei tag tagval))
    1245 
    1246 (define-arm-vinsn trap-unless-lowbyte= (()
    1247                                         ((object :lisp)
    1248                                          (tagval :u16const))
    1249                                         ((tag :u8)))
    1250   (clrlwi tag object (- arm::nbits-in-word 8))
    1251   (twnei tag tagval))
     1260  (and tag object (:$ arm::tagmask))
     1261  (cmp tag (:$ arm::tag-misc))
     1262  (uuo-error-reg-not-lisptag (:? ne) object (:$ arm::tag-misc)))
     1263
     1264
    12521265
    12531266(define-arm-vinsn trap-unless-character (()
    12541267                                         ((object :lisp))
    12551268                                         ((tag :u8)))
    1256   (clrlwi tag object (- arm::nbits-in-word 8))
    1257   (twnei tag arm::subtag-character))
     1269  (and tag object (:$ arm::subtag-mask))
     1270  (cmp tag (:$ arm::subtag-character))
     1271  (uuo-error-reg-not-xtype (:? ne) object (:$ arm::subtag-character)))
    12581272
    12591273(define-arm-vinsn trap-unless-cons (()
    12601274                                    ((object :lisp))
    12611275                                    ((tag :u8)))
    1262   (clrlwi tag object (- arm::nbits-in-word arm::ntagbits))
    1263   (twnei tag arm::fulltag-cons))
     1276  (and tag object (:$ arm::fulltagmask))
     1277  (cmp tag (:$ arm::fulltag-cons))
     1278  (uuo-error-reg-not-fulltag (:? ne) object (:$ arm::fulltag-cons)))
    12641279
    12651280(define-arm-vinsn trap-unless-typecode= (()
    12661281                                         ((object :lisp)
    12671282                                          (tagval :u16const))
    1268                                          ((tag :u8)
    1269                                           (crf :crf)))
    1270   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    1271   (cmpwi crf tag arm::tag-misc)
    1272   (bne crf :do-trap)
    1273   (lbz tag arm::misc-subtag-offset object)
    1274   :do-trap
    1275   (twnei tag tagval))
     1283                                         ((tag :u8)))
     1284  (and tag object (:$ arm::tagmask))
     1285  (cmp tag (:$ arm::tag-misc))
     1286  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     1287  (cmp tag (:$ tagval))
     1288  (uuo-error-reg-not-xtype (:? ne) object (:$ tagval)))
    12761289 
    12771290(define-arm-vinsn subtract-constant (((dest :imm))
    12781291                                     ((src :imm)
    12791292                                      (const :s16const)))
    1280   (subi dest src const))
    1281 
    1282 (define-arm-vinsn trap-unless-numeric-type (()
    1283                                             ((object :lisp)
    1284                                              (maxtype :u16const))
    1285                                             ((crf0 (:crf 0))
    1286                                              (tag :u8)
    1287                                              (crfX :crf)))
    1288   (clrlwi. tag object (- arm::nbits-in-word arm::nlisptagbits))
    1289   (cmpwi tag arm::tag-misc)
    1290   (beq+ crf0 :fixnum)
    1291   (bne crfX :scale-tag)
    1292   (lbz tag arm::misc-subtag-offset object)
    1293   :scale-tag
    1294   (subi tag tag arm::min-numeric-subtag)
    1295   (twlgti tag (:apply - maxtype arm::min-numeric-subtag))
    1296   :fixnum)
     1293  (sub dest src (:$ const)))
     1294
    12971295
    12981296
    12991297;; Bit-extraction & boolean operations
    13001298
    1301 (eval-when (:compile-toplevel :execute)
    1302   (assert (= arm::t-offset #b10001))) ; ARM-bits 31 and 27 set
    13031299
    13041300;; For some mind-numbing reason, IBM decided to call the most significant
     
    13111307;; 31.))
    13121308
     1309#+later
    13131310(define-arm-vinsn extract-variable-bit (((dest :u8))
    13141311                                        ((src :u32)
     
    13181315  (extrwi dest dest 1 0))
    13191316
    1320 
     1317#+later
    13211318(define-arm-vinsn extract-variable-bit-fixnum (((dest :imm))
    13221319                                               ((src :u32)
     
    13371334;; between T and NIL) or 0.
    13381335
     1336#+later
    13391337(define-arm-vinsn lowbit->truth (((dest :lisp)
    13401338                                  (bits :u32))
     
    13441342  (addi dest bits (:apply target-nil-value)))
    13451343
     1344#+later
    13461345(define-arm-vinsn invert-lowbit (((bits :u32))
    13471346                                 ((bits :u32))
     
    13511350                           
    13521351
    1353 ;; Some of the obscure-looking instruction sequences - which map some relation
    1354 ;; to ARM bit 31 of some register - were found by the GNU SuperOptimizer.
    1355 ;; Some of them use extended-precision instructions (which may cause interlocks
    1356 ;; on some superscalar ARMs, if I remember correctly.)  In general, sequences
    1357 ;; that GSO found that -don't- do extended precision are longer and/or use
    1358 ;; more temporaries.
    1359 ;; On the 604, the penalty for using an instruction that uses the CA bit is
    1360 ;; "at least" one cycle: it can't complete execution until all "older" instructions
    1361 ;; have.  That's not horrible, especially given that the alternative is usually
    1362 ;; to use more instructions (and, more importantly, more temporaries) to avoid
    1363 ;; using extended-precision.
    1364 
    1365 
    1366 (define-arm-vinsn eq0->bit31 (((bits :u32))
    1367                               ((src (t (:ne bits)))))
    1368   (cntlzw bits src)
    1369   (srwi bits bits 5))                   ; bits = 0000...000X
    1370 
    1371 (define-arm-vinsn ne0->bit31 (((bits :u32))
    1372                               ((src (t (:ne bits)))))
    1373   (cntlzw bits src)
    1374   (slw bits src bits)
    1375   (srwi bits bits 31))                  ; bits = 0000...000X
    1376 
    1377 (define-arm-vinsn lt0->bit31 (((bits :u32))
    1378                               ((src (t (:ne bits)))))
    1379   (srwi bits src 31))                   ; bits = 0000...000X
    1380 
    1381 
     1352(define-arm-vinsn eq0->boolean (((dest t))
     1353                                ((src t)))
     1354  (cmp src (:$ 0))
     1355  (mov dest (:$ arm::nil-value))
     1356  (addeq dest dest (:$ arm::t-offset)))               
     1357
     1358
     1359(define-arm-vinsn ne0->boolean (((dest t))
     1360                                ((src t)))
     1361  (cmp src (:$ 0))
     1362  (mov dest (:$ arm::nil-value))
     1363  (addne dest dest (:$ arm::t-offset)))
     1364
     1365(define-arm-vinsn lt0->boolean (((dest t))
     1366                                ((src t)))
     1367  (cmp src (:$ 0))
     1368  (mov dest (:$ arm::nil-value))
     1369  (addmi dest dest (:$ arm::t-offset)))               
     1370
     1371
     1372#+later
    13821373(define-arm-vinsn ge0->bit31 (((bits :u32))
    13831374                              ((src (t (:ne bits)))))
     
    13851376  (xori bits bits 1))                   ; bits = 0000...000X
    13861377
    1387 
     1378#+later
    13881379(define-arm-vinsn le0->bit31 (((bits :u32))
    13891380                              ((src (t (:ne bits)))))
     
    13921383  (srwi bits bits 31))                  ; bits = 0000...000X
    13931384
     1385#+later
    13941386(define-arm-vinsn gt0->bit31 (((bits :u32))
    13951387                              ((src (t (:ne bits)))))
     
    13981390  (srwi bits bits 31))                  ; bits = 0000...000X
    13991391
     1392#+later
    14001393(define-arm-vinsn ne->bit31 (((bits :u32))
    14011394                             ((x t)
     
    14071400  (srwi bits bits 31))                  ; bits = 0000...000X
    14081401
     1402#+later
    14091403(define-arm-vinsn fulltag->bit31 (((bits :u32))
    14101404                                  ((lispobj :lisp)
     
    14161410  (srwi bits bits 5))
    14171411
    1418 
     1412#+later
    14191413(define-arm-vinsn eq->bit31 (((bits :u32))
    14201414                             ((x t)
     
    14241418  (srwi bits bits 5))                   ; bits = 0000...000X
    14251419
     1420#+later
    14261421(define-arm-vinsn eqnil->bit31 (((bits :u32))
    14271422                                ((x t)))
     
    14301425  (srwi bits bits 5))
    14311426
     1427#+later
    14321428(define-arm-vinsn ne->bit31 (((bits :u32))
    14331429                             ((x t)
     
    14381434  (xori bits bits 1))
    14391435
     1436#+later
    14401437(define-arm-vinsn nenil->bit31 (((bits :u32))
    14411438                                ((x t)))
     
    14451442  (xori bits bits 1))
    14461443
     1444#+later
    14471445(define-arm-vinsn lt->bit31 (((bits :u32))
    14481446                             ((x (t (:ne bits)))
     
    14551453  (srwi bits bits 31))                  ; bits = 0000...000X
    14561454
     1455#+later
    14571456(define-arm-vinsn ltu->bit31 (((bits :u32))
    14581457                              ((x :u32)
     
    14621461  (neg bits bits))
    14631462
     1463#+later
    14641464(define-arm-vinsn le->bit31 (((bits :u32))
    14651465                             ((x (t (:ne bits)))
     
    14721472  (srwi bits bits 31))                  ; bits = 0000...000X
    14731473
     1474#+later
    14741475(define-arm-vinsn leu->bit31  (((bits :u32))
    14751476                               ((x :u32)
     
    14781479  (addze bits arm::rzero))
    14791480
     1481#+later
    14801482(define-arm-vinsn gt->bit31 (((bits :u32))
    14811483                             ((x (t (:ne bits)))
     
    14881490  (srwi bits bits 31))                  ; bits = 0000...000X
    14891491
     1492#+later
    14901493(define-arm-vinsn gtu->bit31 (((bits :u32))
    14911494                              ((x :u32)
     
    14951498  (neg bits bits))
    14961499
     1500#+later
    14971501(define-arm-vinsn ge->bit31 (((bits :u32))
    14981502                             ((x (t (:ne bits)))
     
    15041508  (srwi bits bits 31))                  ; bits = 0000...000X
    15051509
     1510#+later
    15061511(define-arm-vinsn geu->bit31 (((bits :u32))
    15071512                              ((x :u32)
     
    15171522;;; MFCR takes three cycles and waits for previous instructions to complete.
    15181523;;; Of course, using a CR field costs us something as well.
     1524#+later
    15191525(define-arm-vinsn crbit->bit31 (((bits :u32))
    15201526                                ((crf :crf)
     
    15251531
    15261532
    1527 (define-arm-vinsn compare (((crf :crf))
     1533(define-arm-vinsn compare (()
    15281534                           ((arg0 t)
    15291535                            (arg1 t))
    15301536                           ())
    1531   (cmpw crf arg0 arg1))
    1532 
    1533 (define-arm-vinsn compare-to-nil (((crf :crf))
     1537  (cmp arg0 arg1))
     1538
     1539(define-arm-vinsn compare-to-nil (()
    15341540                                  ((arg0 t)))
    1535   (cmpwi crf arg0 (:apply target-nil-value)))
    1536 
    1537 (define-arm-vinsn compare-logical (((crf :crf))
     1541  (cmp arg0 (:$ arm::nil-value)))
     1542
     1543(define-arm-vinsn compare-logical (
    15381544                                   ((arg0 t)
    15391545                                    (arg1 t))
    15401546                                   ())
    1541   (cmplw crf arg0 arg1))
    1542 
    1543 (define-arm-vinsn double-float-compare (((crf :crf))
     1547  (cmp  arg0 arg1))
     1548
     1549(define-arm-vinsn double-float-compare (()
    15441550                                        ((arg0 :double-float)
    15451551                                         (arg1 :double-float))
    15461552                                        ())
    1547   (fcmpo crf arg0 arg1))
     1553  (fcmped arg0 arg1)
     1554  (fmstat))
    15481555             
    15491556
     
    15711578                                   ((x :single-float)
    15721579                                    (y :single-float))
    1573                                    ((crf (:crf 4))))
     1580                                   ())
    15741581  (fadds result x y))
    15751582
     
    15931600
    15941601
    1595 (define-arm-vinsn compare-unsigned (((crf :crf))
     1602(define-arm-vinsn compare-unsigned (()
    15961603                                    ((arg0 :imm)
    15971604                                     (arg1 :imm))
    15981605                                    ())
    1599   (cmplw crf arg0 arg1))
    1600 
    1601 (define-arm-vinsn compare-signed-s16const (((crf :crf))
     1606  (cmp arg0 arg1))
     1607
     1608(define-arm-vinsn compare-signed-s16const (()
    16021609                                           ((arg0 :imm)
    16031610                                            (imm :s16const))
    16041611                                           ())
    1605   (cmpwi crf arg0 imm))
    1606 
    1607 (define-arm-vinsn compare-unsigned-u16const (((crf :crf))
     1612  (cmp arg0 (:$ imm)))
     1613
     1614(define-arm-vinsn compare-unsigned-u16const (()
    16081615                                             ((arg0 :u32)
    16091616                                              (imm :u16const))
    16101617                                             ())
    1611   (cmplwi crf arg0 imm))
     1618  (cmp arg0 (:$ imm)))
    16121619
    16131620
     
    16151622;; Extract a constant bit (0-31) from src; make it be bit 31 of dest.
    16161623;; Bitnum is treated mod 32.
     1624#+later
    16171625(define-arm-vinsn extract-constant-arm-bit (((dest :u32))
    16181626                                            ((src :imm)
     
    16221630
    16231631
     1632#+later
    16241633(define-arm-vinsn set-constant-arm-bit-to-variable-value (((dest :u32))
    16251634                                                          ((src :u32)
     
    16281637  (rlwimi dest bitval (:apply - 32 bitnum) bitnum bitnum))
    16291638
     1639#+later
    16301640(define-arm-vinsn set-constant-arm-bit-to-1 (((dest :u32))
    16311641                                             ((src :u32)
     
    16361646   (ori dest src (:apply ash #x8000 (:apply - (:apply - bitnum 16))))))
    16371647
     1648#+later
    16381649(define-arm-vinsn set-constant-arm-bit-to-0 (((dest :u32))
    16391650                                             ((src :u32)
     
    16411652  (rlwinm dest src 0 (:apply logand #x1f (:apply 1+ bitnum)) (:apply logand #x1f (:apply 1- bitnum))))
    16421653
    1643  
     1654
     1655#+later
    16441656(define-arm-vinsn insert-bit-0 (((dest :u32))
    16451657                                ((src :u32)
     
    16541666;;; I think ...
    16551667;;; Actually, it'd be "unbox, then subtract from 30".
     1668#+later
    16561669(define-arm-vinsn extract-variable-non-insane-bit (((dest :u32))
    16571670                                                   ((src :imm)
     
    16661679(define-arm-vinsn %cdr (((dest :lisp))
    16671680                        ((src :lisp)))
    1668   (ldr dest (:+@$ src arm::cons.cdr)))
     1681  (ldr dest (:@ src (:$ arm::cons.cdr))))
    16691682
    16701683(define-arm-vinsn %car (((dest :lisp))
    16711684                        ((src :lisp)))
    1672   (ldr dest (:+@$ src arm::cons.car)))
     1685  (ldr dest (:@ src (:$ arm::cons.car))))
    16731686
    16741687(define-arm-vinsn %set-car (()
    16751688                            ((cell :lisp)
    16761689                             (new :lisp)))
    1677   (str dest (:+@$ src arm::cons.car)))
     1690  (str cell (:@ new (:$ arm::cons.car))))
    16781691
    16791692(define-arm-vinsn %set-cdr (()
    16801693                            ((cell :lisp)
    16811694                             (new :lisp)))
    1682   (str dest (:+@$ src arm::cons.cdr)))
    1683 
     1695  (str cell (:@ new (:$ arm::cons.cdr))))
     1696
     1697#+later
    16841698(define-arm-vinsn load-adl (()
    16851699                            ((n :u32const)))
     
    16891703(define-arm-vinsn set-nargs (()
    16901704                             ((n :s16const)))
    1691   (li nargs (:apply ash n arm::word-shift)))
     1705  (mov nargs (:$ (:apply ash n arm::word-shift))))
    16921706
    16931707(define-arm-vinsn scale-nargs (()
    16941708                               ((nfixed :s16const)))
    16951709  ((:pred > nfixed 0)
    1696    (add nargs narg (:$ (:apply - (:apply ash nfixed arm::word-shift))))))
     1710   (add nargs nargs (:$ (:apply - (:apply ash nfixed arm::word-shift))))))
    16971711                           
    16981712
     
    17011715    (()
    17021716     ((reg :lisp)))
    1703   (str reg (:+@! vsp (:$ (- arm::node-size)))))
     1717  (str reg (:@! vsp (:$ (- arm::node-size)))))
    17041718
    17051719(define-arm-vinsn (vpush-register-arg :push :node :vsp :outgoing-argument)
    17061720    (()
    17071721     ((reg :lisp)))
    1708   (str reg (:+@! vsp (:$ (- arm::node-size)))))
     1722  (str reg (:@! vsp (:$ (- arm::node-size)))))
    17091723
    17101724(define-arm-vinsn (vpop-register :pop :node :vsp)
     
    17341748                (:apply %hard-regspec-value dest)
    17351749                (:apply %hard-regspec-value src)))
    1736    (fmr dest src)))
     1750   (fcpyd dest src)))
    17371751
    17381752(define-arm-vinsn vcell-ref (((dest :lisp))
    17391753                             ((vcell :lisp)))
    1740   (lwz dest arm::misc-data-offset vcell))
     1754  (ldr dest (:@ vcell (:$ arm::misc-data-offset))))
    17411755
    17421756
     
    17441758                              ((closed (:lisp :ne dest)))
    17451759                              ((header :u32)))
    1746   (li header arm::value-cell-header)
    1747   (la arm::allocptr (- arm::fulltag-misc arm::value-cell.size) arm::allocptr)
    1748   (twllt arm::allocptr arm::allocbase)
    1749   (stw header arm::misc-header-offset arm::allocptr)
    1750   (mr dest arm::allocptr)
    1751   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    1752   (stw closed arm::value-cell.value dest))
    1753 
    1754 (define-arm-vinsn make-tsp-vcell (((dest :lisp))
    1755                                   ((closed :lisp))
    1756                                   ((header :u32)))
    1757   (li header arm::value-cell-header)
    1758   (stwu arm::tsp -16 arm::tsp)
    1759   (stw arm::tsp 4 arm::tsp)
    1760   (stfd arm::fp-zero 8 arm::tsp)
    1761   (stw arm::rzero 4 arm::tsp)
    1762   (stw header (+ 8 arm::fulltag-misc arm::value-cell.header) arm::tsp)
    1763   (stw closed (+ 8 arm::fulltag-misc arm::value-cell.value) arm::tsp)
    1764   (la dest (+ 8 arm::fulltag-misc) arm::tsp))
    1765 
    1766 (define-arm-vinsn make-tsp-cons (((dest :lisp))
    1767                                  ((car :lisp) (cdr :lisp))
    1768                                  ())
    1769   (stwu arm::tsp -16 arm::tsp)
    1770   (stw arm::tsp 4 arm::tsp)
    1771   (stfd arm::fp-zero 8 arm::tsp)
    1772   (stw arm::rzero 4 arm::tsp)
    1773   (stw car (+ 8 arm::fulltag-cons arm::cons.car) arm::tsp)
    1774   (stw cdr (+ 8 arm::fulltag-cons arm::cons.cdr) arm::tsp)
    1775   (la dest (+ 8 arm::fulltag-cons) arm::tsp))
     1760  (mov header (:$ arm::subtag-value-cell))
     1761  (orr header header (:$ (ash arm::value-cell.element-count arm::num-subtag-bits)))
     1762  (sub allocptr allocptr (:$ (- arm::value-cell.size arm::fulltag-misc)))
     1763  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
     1764  (cmp allocptr dest)
     1765  (uuo-alloc-trap (:? lo))
     1766  (str header (:@ allocptr (:$ arm::misc-header-offset)))
     1767  (mov dest allocptr)
     1768  (bic allocptr allocptr (:$ arm::fulltagmask))
     1769  (str closed (:@ dest (:$ arm::value-cell.value))))
     1770
     1771(define-arm-vinsn make-stack-vcell (((dest :lisp))
     1772                                    ((closed :lisp))
     1773                                    ((header :u32)))
     1774  (mov header (:$ arm::subtag-value-cell))
     1775  (orr header header (:$ (ash arm::value-cell.element-count arm::num-subtag-bits)))
     1776  (stmdb (:! sp) (closed header)))
     1777
     1778(define-arm-vinsn make-stack-cons (((dest :lisp))
     1779                                   ((car :lisp) (cdr :lisp))
     1780                                   ((header (:u32 #.arm::imm0))
     1781                                    (zero (:u32 #.arm::imm1))))
     1782  (mov header (:$ arm::subtag-simple-vector))
     1783  (mov zero (:$ 0))
     1784  (orr header header (:$ (ash 3 arm::num-subtag-bits)))
     1785  ((:pred <
     1786          (:apply %hard-regspec-value cdr)
     1787          (:apply %hard-regpsec-value car))
     1788   (stmdb (:! sp) (car cdr zero header)))
     1789  ((:not (:pred <
     1790                (:apply %hard-regspec-value cdr)
     1791                (:apply %hard-regpsec-value car)))
     1792   (stmdb (:! sp) (cdr car zero header))
     1793   (str car (:@ sp (:$ 12)))
     1794   (str cdr (:@ sp (:$ 8))))
     1795  (add dest sp (:$ (+ arm::dnode-size arm::fulltag-cons))))
    17761796
    17771797
    17781798(define-arm-vinsn %closure-code% (((dest :lisp))
    17791799                                  ())
    1780   (lwz dest (:apply + arm::symbol.vcell (arm::nrs-offset %closure-code%) (:apply target-nil-value)) 0))
     1800  (mov dest (:$ arm::nil-value))
     1801  (ldr dest (:@ dest (:$ (:apply + arm::symbol.vcell (arm::nrs-offset %closure-code%))))))
    17811802
    17821803
    17831804(define-arm-vinsn single-float-bits (((dest :u32))
    17841805                                     ((src :lisp)))
    1785   (lwz dest arm::single-float.value src))
     1806  (ldr dest (:@ src (:$ arm::single-float.value))))
    17861807
    17871808(define-arm-vinsn (call-subprim :call :subprim-call) (()
     
    18221843                                       ()
    18231844                                       ((temp :u32)))
    1824   (lwz temp arm::tcr.tlb-pointer arm::rcontext)
    1825   (lwz dest arm::INTERRUPT-LEVEL-BINDING-INDEX temp))
     1845  (ldr temp (:@ rcontext (:$ arm::tcr.tlb-pointer)))
     1846  (ldr dest (:@ temp (:$ arm::INTERRUPT-LEVEL-BINDING-INDEX))))
    18261847
    18271848                         
     
    18871908(define-arm-vinsn (discard-temp-frame :tsp :pop :discard) (()
    18881909                                                           ())
    1889   (lwz arm::tsp 0 arm::tsp))
     1910  (ldr arm::tsp (:@ arm::tsp (:$ 0))))
    18901911
    18911912
     
    18971918  (mov header (:$ (:apply ash (:apply + 1 (:apply logandc2 (:apply + 4 1 n-c-args) 1)) arm::num-subtag-bits)))
    18981919  (mov size (:lsr header (:$ (- arm::num-subtag-bits arm::word-shift))))
    1899   (orr header (:$ arm::subtag-u32-vector))
     1920  (orr header header (:$ arm::subtag-u32-vector))
    19001921  (mov prevsp sp)
    19011922  (add size size (:$ arm::node-size))
     
    19361957  (str argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    19371958
     1959#+notyet
    19381960(define-arm-vinsn set-single-c-arg (()
    19391961                                    ((argval :single-float)
     
    19411963  (fsts argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    19421964
     1965#+notyet
    19431966(define-arm-vinsn set-double-c-arg (()
    19441967                                    ((argval :double-float)
     
    19571980  (add dest dest (:$ arm::t-offset)))
    19581981
    1959 (define-arm-vinsn set-eq-bit (((dest :crf))
    1960                               ())
    1961   (creqv (:apply + arm::arm-eq-bit dest)
    1962          (:apply + arm::arm-eq-bit dest)
    1963          (:apply + arm::arm-eq-bit dest)))
     1982
    19641983
    19651984(define-arm-vinsn (ref-constant :constant-ref) (((dest :lisp))
     
    19691988(define-arm-vinsn ref-indexed-constant (((dest :lisp))
    19701989                                        ((idxreg :s32)))
    1971   (lwzx dest arm::fn idxreg))
     1990  (ldr dest (:@ arm::fn idxreg)))
    19721991
    19731992
    19741993(define-arm-vinsn cons (((dest :lisp))
    19751994                        ((newcar :lisp)
    1976                          (newcdr :lisp)))
    1977   (la arm::allocptr (- arm::fulltag-cons arm::cons.size) arm::allocptr)
    1978   (twllt arm::allocptr arm::allocbase)
    1979   (stw newcdr arm::cons.cdr arm::allocptr)
    1980   (stw newcar arm::cons.car arm::allocptr)
    1981   (mr dest arm::allocptr)
    1982   (clrrwi arm::allocptr arm::allocptr arm::ntagbits))
     1995                         (newcdr :lisp))
     1996                        ((allocbase :imm)))
     1997  (sub allocptr allocptr (:$ (- arm::cons.size arm::fulltag-cons)))
     1998  (ldr allocbase (:@ rcontext (:$ arm::tcr.save-allocbase)))
     1999  (cmp allocptr allocbase)
     2000  (uuo-alloc-trap (:? lo))
     2001  (str newcdr (:@ allocptr (:$ arm::cons.cdr)))
     2002  (str newcar (:@ allocptr (:$ arm::cons.car)))
     2003  (mov dest allocptr)
     2004  (bic allocptr allocptr (:$ arm::fulltagmask)))
    19832005
    19842006
     
    19892011                                 (nbytes :u32const))
    19902012                                ((immtemp0 :u32)
    1991                                  (nodetemp :lisp)
    1992                                  (crf :crf)))
    1993   (la arm::allocptr (:apply - arm::fulltag-misc
    1994                             (:apply logand (lognot 7)
    1995                                     (:apply + (+ 7 4) nbytes)))
    1996       arm::allocptr)
    1997   (twllt arm::allocptr arm::allocbase)
    1998   (stw Rheader arm::misc-header-offset arm::allocptr)
    1999   (mr dest arm::allocptr)
    2000   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
     2013                                 (nodetemp :lisp)))
     2014 
     2015  (sub allocptr allocptr (:$ (:apply logand #xff
     2016                                 (:apply -
     2017                                    (:apply logand (lognot 7)
     2018                                    (:apply + (+ 7 4) nbytes))
     2019                                    arm::fulltag-misc))))
     2020  ((:pred > (:apply -
     2021                    (:apply logand (lognot 7)
     2022                            (:apply + (+ 7 4) nbytes))
     2023                    arm::fulltag-misc) #xff)
     2024   (sub allocptr allocptr (:$ (:apply logand #xff00
     2025                                 (:apply -
     2026                                    (:apply logand (lognot 7)
     2027                                    (:apply + (+ 7 4) nbytes))
     2028                                    arm::fulltag-misc)))))
     2029  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2030  (cmp allocptr dest)
     2031  (uuo-alloc-trap (:? lo))
     2032  (str Rheader (:@ allocptr (:$ arm::misc-header-offset)))
     2033  (mov dest allocptr)
     2034  (bic allocptr allocptr (:$ arm::fulltagmask))
    20012035  ((:not (:pred = nbytes 0))
    2002    (li immtemp0 (:apply + arm::misc-data-offset nbytes))
     2036   (mov immtemp0 (:$ (:apply + arm::misc-data-offset nbytes)))
    20032037   :loop
    2004    (subi immtemp0 immtemp0 4)
    2005    (cmpwi crf immtemp0 arm::misc-data-offset)
    2006    (lwz nodetemp 0 arm::vsp)
    2007    (la arm::vsp 4 arm::vsp)   
    2008    (stwx nodetemp dest immtemp0)
    2009    (bne crf :loop)))
     2038   (sub immtemp0 immtemp0 (:$ 4))
     2039   (cmp immtemp0 (:$ arm::misc-data-offset))
     2040   (ldr nodetemp (:@+ vsp (:$ arm::node-size)))
     2041   (str nodetemp (:@ dest immtemp0))
     2042   (bne :loop)))
    20102043
    20112044;; allocate a small (phys size <= 32K bytes) misc obj of known size/subtag
     
    20132046                                     ((Rheader :u32)
    20142047                                      (nbytes :u32const)))
    2015   (la arm::allocptr (:apply - arm::fulltag-misc
    2016                             (:apply logand (lognot 7)
    2017                                     (:apply + (+ 7 4) nbytes)))
    2018       arm::allocptr)
    2019   (twllt arm::allocptr arm::allocbase)
    2020   (stw Rheader arm::misc-header-offset arm::allocptr)
    2021   (mr dest arm::allocptr)
    2022   (clrrwi arm::allocptr arm::allocptr arm::ntagbits))
     2048  (sub allocptr allocptr (:$ (:apply
     2049                              logand #xff
     2050                              (:apply - (:apply logand (lognot 7)
     2051                                                (:apply + (+ 7 4) nbytes))))))
     2052  ((:pred > (:apply -
     2053                    (:apply logand (lognot 7)
     2054                            (:apply + (+ 7 4) nbytes))
     2055                    arm::fulltag-misc) #xff)
     2056   (sub allocptr allocptr (:$ (:apply logand #xff00
     2057                                 (:apply -
     2058                                    (:apply logand (lognot 7)
     2059                                    (:apply + (+ 7 4) nbytes))
     2060                                    arm::fulltag-misc)))))
     2061  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2062  (cmp allocptr dest)
     2063  (uuo-alloc-trap (:? lo))
     2064  (str Rheader (:@ allocptr (:$ arm::misc-header-offset)))
     2065  (mov dest allocptr)
     2066  (bic allocptr allocptr (:$ arm::fulltagmask)))
    20232067
    20242068(define-arm-vinsn (vstack-discard :vsp :pop :discard) (()
    20252069                                                       ((nwords :u32const)))
    20262070  ((:not (:pred = nwords 0))
    2027    (la arm::vsp (:apply ash nwords arm::word-shift) arm::vsp)))
     2071   (add vsp vsp (:$ (:apply ash nwords arm::word-shift)))))
    20282072
    20292073
     
    20312075                              ((cell :lcell)
    20322076                               (top :lcell)))
    2033   (lwz dest (:apply -
     2077  (ldr dest (:@ vsp (:$ (:apply -
    20342078                    (:apply - (:apply calc-lcell-depth top) 4)
    2035                     (:apply calc-lcell-offset cell)) arm::vsp))
     2079                    (:apply calc-lcell-offset cell))))))
    20362080
    20372081(define-arm-vinsn vframe-load (((dest :lisp))
    20382082                               ((frame-offset :u16const)
    20392083                                (cur-vsp :u16const)))
    2040   (lwz dest (:apply - (:apply - cur-vsp 4) frame-offset) arm::vsp))
     2084  (ldr dest (:@ vsp (:$ (:apply - (:apply - cur-vsp 4) frame-offset)))))
    20412085
    20422086(define-arm-vinsn lcell-store (()
     
    20442088                                (cell :lcell)
    20452089                                (top :lcell)))
    2046   (stw src (:apply -
     2090  (str src (:@ vsp (:$ (:apply -
    20472091                   (:apply - (:apply calc-lcell-depth top) 4)
    2048                    (:apply calc-lcell-offset cell)) arm::vsp))
     2092                   (:apply calc-lcell-offset cell))))))
    20492093
    20502094(define-arm-vinsn vframe-store (()
     
    20522096                                 (frame-offset :u16const)
    20532097                                 (cur-vsp :u16const)))
    2054   (stw src (:apply - (:apply - cur-vsp 4) frame-offset) arm::vsp))
     2098  (str src (:@ vsp (:$ (:apply - (:apply - cur-vsp 4) frame-offset)))))
    20552099
    20562100(define-arm-vinsn load-vframe-address (((dest :imm))
    20572101                                       ((offset :s16const)))
    2058   (la dest offset arm::vsp))
     2102  (add dest vsp (:$ offset)))
    20592103
    20602104(define-arm-vinsn copy-lexpr-argument (()
    20612105                                       ()
    20622106                                       ((temp :lisp)))
    2063   (lwzx temp arm::vsp nargs)
    2064   (stwu temp -4 arm::vsp))
     2107  (ldr temp (:@ vsp nargs))
     2108  (str temp (:@! vsp (:$ (- arm::node-size)))))
    20652109
    20662110;;; Boxing/unboxing of integers.
     
    20702114                              ((val :u8))
    20712115                              ())
    2072   (rlwinm result val arm::fixnumshift (- arm::nbits-in-word (+ 8 arm::fixnumshift)) (- arm::least-significant-bit arm::fixnumshift)))
     2116  (mov result (:lsr val (:$ 24)))
     2117  (mov result (:lsr val (:$ (- 24 arm::fixnumshift)))))
    20732118
    20742119;;; Treat the low 8 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
     
    20762121                              ((val :s8))
    20772122                              ())
    2078   (extlwi result val 8 (- arm::nbits-in-word 8))
    2079   (srawi result result (- (- arm::nbits-in-word 8) arm::fixnumshift)))
     2123  (mov result (:lsr val (:$ 24)))
     2124  (mov result (:asr val (:$ (- 24 arm::fixnumshift)))))
    20802125
    20812126
     
    20842129                               ((val :u16))
    20852130                               ())
    2086   (rlwinm result val arm::fixnumshift (- arm::nbits-in-word (+ 16 arm::fixnumshift)) (- arm::least-significant-bit arm::fixnumshift)))
     2131  (mov result (:lsl val (:$ 16)))
     2132  (mov result (:lsr result (:$ (- 16 arm::fixnumshift)))))
    20872133
    20882134;;; Treat the low 16 bits of VAL as a signed integer; set RESULT to the equivalent fixnum.
     
    21082154  (mov temp (:$ arm::subtag-bignum))
    21092155  (orr temp temp (:$ (ash 1 arm::num-subtag-bits)))
    2110   (add arm::allocptr arm::allocptr (:$ (- arm::fulltag-misc 8)))
    2111   (ldr result (:@ rcontext (:$ arm::tcr.save_allocbase)))
     2156  (add allocptr allocptr (:$ (- arm::fulltag-misc 8)))
     2157  (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
    21122158  (cmp allocptr result)
    2113   (uuo-alloc-trap-one (:? lo))
     2159  (uuo-alloc-trap (:? lo))
    21142160  (str temp (:@ allocptr (:$ arm::misc-header-offset)))
    21152161  (mov result allocptr)
     
    21222168(define-arm-vinsn u32->integer (((result :lisp))
    21232169                                ((src :u32))
    2124                                 ((crf (:crf 0)) ; a casualty
    2125                                  (temp :s32)
     2170                                ((temp :s32)
    21262171                                 (size :u32)))
    2127   (clrrwi. temp src (- arm::least-significant-bit arm::nfixnumtagbits))
    2128   (slwi result src arm::fixnumshift)
    2129   (beq+ crf :done)
    2130   (cmpwi src 0)
    2131   (li temp arm::one-digit-bignum-header)
    2132   (li size (- 8 arm::fulltag-misc))
    2133   (bgt :common)
    2134   (li temp arm::two-digit-bignum-header)
    2135   (li size (- 16 arm::fulltag-misc))
    2136   :common
    2137   (sub arm::allocptr arm::allocptr size)
    2138   (twllt arm::allocptr arm::allocbase)
    2139   (stw temp arm::misc-header-offset arm::allocptr)
    2140   (mr result arm::allocptr)
    2141   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    2142   (stw src arm::misc-data-offset result)
     2172  (tst src (:$ #xe0000000))
     2173  (moveq result (:lsr src (:$ arm::fixnumshift)))
     2174  (beq :done)
     2175  (cmp src (:$ 0))
     2176  (mov temp (:$ arm::subtag-bignum))
     2177  (movgt size (:$ (- (* 2 arm::dnode-size) arm::fulltag-misc)))
     2178  (orrgt temp temp (:$ (ash 2 arm::num-subtag-bits)))
     2179  (movlt size (:$ (- (* 1 arm::dnode-size) arm::fulltag-misc)))
     2180  (orrlt temp temp (:$ (ash 1 arm::num-subtag-bits)))
     2181  (sub allocptr allocptr size)
     2182  (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2183  (cmp allocptr result)
     2184  (uuo-alloc-trap (:? lo))
     2185  (str temp (:@ allocptr (:$ arm::misc-header-offset)))
     2186  (mov result allocptr)
     2187  (bic allocptr allocptr (:$ arm::fulltagmask))
     2188  (str src (:@ result (:$ arm::misc-data-offset)))
    21432189  :done)
    21442190
    21452191(define-arm-vinsn u16->u32 (((dest :u32))
    21462192                            ((src :u16)))
    2147   (clrlwi dest src 16))
     2193  (mov dest (:$ #xff))
     2194  (orr dest dest (:$ #xff00))
     2195  (and dest dest src))
    21482196
    21492197(define-arm-vinsn u8->u32 (((dest :u32))
    21502198                           ((src :u8)))
    2151   (clrlwi dest src 24))
     2199  (and dest src (:$ #xff)))
    21522200
    21532201
    21542202(define-arm-vinsn s16->s32 (((dest :s32))
    21552203                            ((src :s16)))
    2156   (extsh dest src))
     2204  (mov dest (:lsl src (:$ 16)))
     2205  (mov dest (:asr src (:$ 16))))
    21572206
    21582207(define-arm-vinsn s8->s32 (((dest :s32))
    21592208                           ((src :s8)))
    2160   (extsb dest src))
     2209  (mov dest (:lsl src (:$ 24)))
     2210  (mov dest (:asr src (:$ 24))))
    21612211
    21622212
     
    21672217(define-arm-vinsn double->heap (((result :lisp)) ; tagged as a double-float
    21682218                                ((fpreg :double-float))
    2169                                 ((header-temp :u32)))
    2170   (li header-temp (arch::make-vheader arm::double-float.element-count arm::subtag-double-float))
    2171   (la arm::allocptr (- arm::fulltag-misc arm::double-float.size) arm::allocptr)
    2172   (twllt arm::allocptr arm::allocbase)
    2173   (stw header-temp arm::misc-header-offset arm::allocptr)
    2174   (mr result arm::allocptr)
    2175   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    2176   (stfd fpreg arm::double-float.value result)  )
     2219                                ((header-temp (:u32 #.arm::imm0))
     2220                                 (high (:u32 #.arm::imm1))))
     2221  (mov header-temp (:$ arm::subtag-double-float))
     2222  (orr header-temp header-temp (:$ (ash arm::double-float.element-count arm::num-subtag-bits)))
     2223  (sub allocptr allocptr (:$ (- arm::double-float.size arm::fulltag-misc)))
     2224  (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2225  (cmp allocptr result)
     2226  (uuo-alloc-trap (:? lo))
     2227  (str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
     2228  (mov result allocptr)
     2229  (bic allocptr allocptr (:$ arm::fulltagmask))
     2230  (fmrrd header-temp high fpreg)
     2231  (strd header-temp (:@ result (:$ arm::double-float.value))))
    21772232
    21782233
     
    21842239                                ((fpreg :single-float))
    21852240                                ((header-temp :u32)))
    2186   (li header-temp (arch::make-vheader arm::single-float.element-count arm::subtag-single-float))
    2187   (la arm::allocptr (- arm::fulltag-misc arm::single-float.size) arm::allocptr)
    2188   (twllt arm::allocptr arm::allocbase)
    2189   (stw header-temp arm::misc-header-offset arm::allocptr)
    2190   (mr result arm::allocptr)
    2191   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    2192   (stfs fpreg arm::single-float.value result))
     2241  (mov header-temp (:$ arm::subtag-single-float))
     2242  (orr header-temp header-temp (:$ (ash arm::single-float.element-count arm::num-subtag-bits)))
     2243  (sub allocptr allocptr (:$ (- arm::single-float.size arm::fulltag-misc)))
     2244  (ldr result (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2245  (cmp allocptr result)
     2246  (uuo-alloc-trap (:? lo))
     2247  (str header-temp (:@ allocptr (:$ arm::misc-header-offset)))
     2248  (mov result allocptr)
     2249  (bic allocptr allocptr (:$ arm::fulltagmask))
     2250  (fmrs header-temp fpreg)
     2251  (str header-temp (:@ result (:$ arm::single-float.value))))
     2252
    21932253
    21942254
     
    21972257                                ((dest :lisp)
    21982258                                 (source :double-float))
    2199                                 ())
    2200   (stfd source arm::double-float.value dest))
     2259                                ((low (:u32 #.arm::imm0))
     2260                                 (high (:u32 #.arm::imm1))))
     2261  (fmrrd low high source)
     2262  (str low (:@ dest (:$ arm::double-float.value))))
    22012263
    22022264(define-arm-vinsn get-double (((target :double-float))
    22032265                              ((source :lisp))
    2204                               ())
    2205   (lfd target arm::double-float.value source))
     2266                              ((low (:u32 #.arm::imm0))
     2267                               (high (:u32 #.arm::imm1))))
     2268  (ldrd low (:@ source (:$ arm::double-float.value)))
     2269  (fmdrr target low high))
    22062270
    22072271;;; Extract a double-float value, typechecking in the process.
     
    22112275(define-arm-vinsn get-double? (((target :double-float))
    22122276                               ((source :lisp))
    2213                                ((tag :u8)))
    2214   (and tag source (:$ arm::tagmask))
    2215   (cmp tag (:$ arm::tag-misc))
    2216   (ldrbeq tag (:@ source (:$ arm::misc-subtag-offset)))
    2217   (cmp tag (:$ arm::subtag-double-float))
     2277                               ((low (:u32 #.arm::imm0))
     2278                                (high (:u32 #.arm::imm1))))
     2279  (and low source (:$ arm::tagmask))
     2280  (cmp low (:$ arm::tag-misc))
     2281  (ldrbeq low (:@ source (:$ arm::misc-subtag-offset)))
     2282  (cmp imm0 (:$ arm::subtag-double-float))
    22182283  (uuo-error-reg-not-xtype (:? ne) source (:$ arm::subtag-double-float))
    2219   (ldrd imm0 imm1 (:@ source (:$ arm::double-float.value)))
    2220   (fmrrd target imm0 imm1))
     2284  (ldrd imm0 (:@ source (:$ arm::double-float.value)))
     2285  (fmdrr target imm0 imm1))
    22212286 
    22222287
    22232288(define-arm-vinsn double-to-single (((result :single-float))
    22242289                                    ((arg :double-float)))
    2225   (frsp result arg))
     2290  (fcvtsd result arg))
    22262291
    22272292(define-arm-vinsn store-single (()
    22282293                                ((dest :lisp)
    22292294                                 (source :single-float))
    2230                                 ())
    2231   (stfs source arm::single-float.value dest))
     2295                                ((temp :u32)))
     2296  (fmrs temp source)
     2297  (str temp (:@ dest (:$ arm::single-float.value))))
    22322298
    22332299(define-arm-vinsn get-single (((target :single-float))
    22342300                              ((source :lisp))
    2235                               ())
    2236   (lfs target arm::single-float.value source))
     2301                              ((temp :u32)))
     2302  (ldr temp (:@ source (:$ arm::single-float.value)))
     2303  (fmsr target temp))
    22372304
    22382305;;; ... of characters ...
     
    22532320                                ((src :imm))
    22542321                                ((temp :u32)
    2255                                  (crf0 (:crf 0))))
    2256   (srwi temp src (+ arm::fixnumshift 1))
    2257   (cmplwi temp (ash #xffff -1))
    2258   (srwi temp src (+ arm::fixnumshift 11))
     2322                                 (temp2 :u32)))
     2323  (mov temp2 (:$ #x7f00))
     2324  (mov temp (:lsr src (:$ (+ arm::fixnumshift 1))))
     2325  (orr temp2 temp2 (:$ #xff))
     2326  (cmp temp temp2)
     2327  (mov temp (:lsr src (:$ (+ arm::fixnumshift 11))))
    22592328  (beq :bad)
    2260   (cmpwi temp 27)
    2261   (slwi dest src (- arm::charcode-shift arm::fixnumshift))
    2262   (bne+ :ok)
     2329  (cmp temp (:$ 27))
     2330  (mov dest (:lsr src (:$ (- arm::charcode-shift arm::fixnumshift))))
    22632331  :bad
    2264   (li dest (:apply target-nil-value))
    2265   (b :done)
    2266   :ok
    2267   (addi dest dest arm::subtag-character)
    2268   :done)
     2332  (moveq dest (:$ arm::nil-value))
     2333  (addne dest dest (:$ arm::subtag-character)))
    22692334
    22702335;;; src is known to be a code for which CODE-CHAR returns non-nil.
     
    22982363                                ((address :address))
    22992364                                ((header :u32)))
    2300   (li header (logior (ash arm::macptr.element-count arm::num-subtag-bits) arm::subtag-macptr))
    2301   (la arm::allocptr (- arm::fulltag-misc arm::macptr.size) arm::allocptr)
    2302   (twllt arm::allocptr arm::allocbase)
    2303   (stw header arm::misc-header-offset arm::allocptr)
    2304   (mr dest arm::allocptr)
    2305   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
     2365  (mov header (:$ arm::subtag-macptr))
     2366  (orr header header (:$ (ash arm::macptr.element-count arm::num-subtag-bits)))
     2367  (sub allocptr allocptr (:$ (- arm::macptr.size arm::fulltag-misc)))
     2368  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2369  (cmp allocptr dest)
     2370  (uuo-alloc-trap (:? lo))
     2371  (str header (:@ allocptr (:$ arm::misc-header-offset)))
     2372  (mov dest allocptr)
     2373  (bic allocptr allocptr (:$ arm::fulltagmask))
    23062374  ;; It's not necessary to zero out the domain/type fields, since newly
    23072375  ;; heap-allocated memory's guaranteed to be 0-filled.
    2308   (stw address arm::macptr.address dest))
     2376  (str address (:@ dest (:$ arm::macptr.address))))
    23092377
    23102378(define-arm-vinsn macptr->stack (((dest :lisp))
    23112379                                 ((address :address))
    23122380                                 ((header :u32)))
    2313   (li header arm::macptr-header)
    2314   (stwu arm::tsp (- (+ 8 arm::macptr.size)) arm::tsp)
    2315   (stw arm::tsp 4 arm::tsp)
    2316   (stw header (+ 8 arm::fulltag-misc arm::macptr.header) arm::tsp)
    2317   (stw address (+ 8 arm::fulltag-misc arm::macptr.address) arm::tsp)
    2318   ;; It -is- necessary to zero out the domain/type fields here, since
    2319   ;; stack-allocated memory isn't guaranteed to be 0-filled.
    2320   (stfd arm::fp-zero (+ 8 arm::fulltag-misc arm::macptr.domain) arm::tsp)
    2321   (la dest (+ 8 arm::fulltag-misc) arm::tsp))
     2381  (mov header (:$ arm::subtag-macptr))
     2382  (orr header header (:$ (ash arm::macptr.element-count arm::num-subtag-bits)))
     2383  (str header (:@! sp (:$ (- arm::macptr.size))))
     2384  (mov header (:$ 0))
     2385  (str header  (:@ sp (:$ (+ arm::fulltag-misc arm::macptr.domain))))
     2386  (str header  (:@ sp (:$ (+ arm::fulltag-misc arm::macptr.type))))
     2387  (str address (:@ sp (:$ (+ arm::fulltag-misc arm::macptr.address))))
     2388  (add dest sp (:$ arm::fulltag-misc)))
     2389
    23222390
    23232391 
     
    23292397(define-arm-vinsn adjust-vsp (()
    23302398                              ((amount :s16const)))
    2331   (la arm::vsp amount arm::vsp))
     2399  (add vsp vsp (:$ amount)))
    23322400
    23332401(define-arm-vinsn adjust-sp (()
    23342402                             ((amount :s16const)))
    2335   (la arm::sp amount arm::sp))
     2403  (add sp sp (:$ amount)))
    23362404
    23372405;; Arithmetic on fixnums & unboxed numbers
     
    23532421                                                 ((unboxed :s32)
    23542422                                                  (header :u32)))
    2355   (nego. dest src)
    2356   (bns+ :done)
    2357   (mtxer arm::rzero)
    2358   (srawi unboxed dest arm::fixnumshift)
    2359   (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
    2360   (li header arm::one-digit-bignum-header)
    2361   (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
    2362   (twllt arm::allocptr arm::allocbase)
    2363   (stw header arm::misc-header-offset arm::allocptr)
    2364   (mr dest arm::allocptr)
    2365   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    2366   (stw unboxed arm::misc-data-offset dest)
     2423  (rsbs dest src (:$ 0))
     2424  (bvc :done)
     2425  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
     2426  (eor unboxed unboxed (:$ #xc0000000))
     2427  (mov header (:$ arm::subtag-bignum))
     2428  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
     2429  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
     2430  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2431  (cmp allocptr dest)
     2432  (uuo-alloc-trap (:? lo))
     2433  (str header (:@ allocptr (:$ arm::misc-header-offset)))
     2434  (mov dest allocptr)
     2435  (bic allocptr allocptr (:$ arm::fulltagmask))
     2436  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
    23672437  :done)
    23682438
     
    23702440                                              ((src :imm))
    23712441                                              )
    2372   (nego. arm::arg_z src)
    2373   (bsola- .SPfix-overflow)
    2374   :done)
     2442  (rsbs arm::arg_z src (:$ 0))
     2443  (blvs .SPfix-overflow))
    23752444 
    23762445                                                 
     
    23792448                                        ((src :imm)))
    23802449 
    2381   (neg dest src))
     2450  (rsb dest src (:$ 0)))
    23822451 
    23832452
    2384 (define-arm-vinsn logior-high (((dest :imm))
     2453(define-arm-vinsn logior-immediate (((dest :imm))
    23852454                               ((src :imm)
    2386                                 (high :u16const)))
    2387   (oris dest src high))
    2388 
    2389 (define-arm-vinsn logior-low (((dest :imm))
    2390                               ((src :imm)
    2391                                (low :u16const)))
    2392   (ori dest src low))
     2455                                (imm :u32const)))
     2456  (orr dest src (:$ imm)))
     2457
     2458
    23932459
    23942460                           
     
    23982464                             (y :imm))
    23992465                            ())
    2400   (or dest x y))
    2401 
    2402 (define-arm-vinsn logand-high (((dest :imm))
     2466  (orr dest x y))
     2467
     2468(define-arm-vinsn logand-immediate (((dest :imm))
    24032469                               ((src :imm)
    2404                                 (high :u16const))
    2405                                ((crf0 (:crf 0))))
    2406   (andis. dest src high))
    2407 
    2408 (define-arm-vinsn logand-low (((dest :imm))
    2409                               ((src :imm)
    2410                                (low :u16const))
    2411                               ((crf0 (:crf 0))))
    2412   (andi. dest src low))
     2470                                (imm :u32const)))
     2471  (and dest src (:$ imm)))
    24132472
    24142473
     
    24192478  (and dest x y))
    24202479
    2421 (define-arm-vinsn clear-left (((dest :imm))
    2422                               ((src :imm)
    2423                                (nbits :s8const)))
    2424   (rlwinm dest src 0 (:apply 1+ nbits) 31))
    2425 
    2426 (define-arm-vinsn clear-right (((dest :imm))
    2427                                ((src :imm)
    2428                                 (nbits :s8const)))
    2429   (rlwinm dest src 0 0 (:apply - 31 nbits)))
     2480(define-arm-vinsn logxor-immediate (((dest :imm))
     2481                                    ((src :imm)
     2482                                     (imm :u32const)))
     2483  (eor dest src (:$ imm)))
     2484                                   
    24302485
    24312486                               
    2432 (define-arm-vinsn logxor-high (((dest :imm))
    2433                                ((src :imm)
    2434                                 (high :u16const)))
    2435   (xoris dest src high))
    2436 
    2437 (define-arm-vinsn logxor-low (((dest :imm))
    2438                               ((src :imm)
    2439                                (low :u16const)))
    2440   (xori dest src low))
    2441 
    2442                            
    24432487
    24442488(define-arm-vinsn %logxor2 (((dest :imm))
     
    24462490                             (y :imm))
    24472491                            ())
    2448   (xor dest x y))
    2449 
     2492  (eor dest x y))
     2493
     2494;;; ARM register shifts shift by the low byte of RS.
    24502495(define-arm-vinsn %ilsl (((dest :imm))
    24512496                         ((count :imm)
    24522497                          (src :imm))
    2453                          ((temp :u32)
    2454                           (crx :crf)))
    2455   (cmpwi crx count (ash 31 arm::fixnumshift))
    2456   (srwi temp count arm::fixnumshift)
    2457   (slw dest src temp)
    2458   (ble+ crx :foo)
    2459   (li dest 0)
    2460   :foo)
    2461 
     2498                         ((temp :u32)))
     2499  (mov temp (:asr count (:$ arm::fixnumshift)))
     2500  (mov dest (:lsl src temp)))
     2501
     2502;;; Shift by a constant = -> shift by 32.  Don't do that.
    24622503(define-arm-vinsn %ilsl-c (((dest :imm))
    24632504                           ((count :u8const)
    24642505                            (src :imm)))
    2465                                         ; Hard to use armmacroinstructions that expand into expressions involving variables.
    2466   (rlwinm dest src count 0 (:apply - arm::least-significant-bit count)))
     2506  ((:pred = count 0)
     2507   (mov dest src))
     2508  ((:not (:pred = count 0))
     2509   (mov dest (:lsl src (:$ (:apply logand count 31))))))
    24672510
    24682511
     
    24702513                           ((count :u8const)
    24712514                            (src :imm))
    2472                            (temp :s32))
     2515                           ((temp :s32)))
    24732516  (mov temp (:lsr src (:$ count)))
    2474   (bic test src (:$ fixnummask)))
     2517  (bic dest temp (:$ arm::fixnummask)))
    24752518
    24762519
     
    24792522                          (src :imm))
    24802523                         ((temp :s32)))
    2481   (cmp count (:$ (ash 31 arm::fixnumshift)))
    24822524  (mov temp (:asr count (:$ arm::fixnumshift)))
    24832525  (mov temp (:asr src temp))
    2484   (movgt temp (:asr src (:$ 31)))
    2485   (bic test temp (:$ arm::fixnummask)))
     2526  (bic dest temp (:$ arm::fixnummask)))
    24862527
    24872528(define-arm-vinsn %iasr-c (((dest :imm))
     
    24892530                            (src :imm))
    24902531                           ((temp :s32)))
    2491   (mov temp (:asr src (:$ count)))
    2492   (bic dest src (:$ arm::fixnummask)))
     2532  ((:pred = count 0)
     2533   (mov dest src))
     2534  ((:not (:pred = count 0))
     2535   (mov temp (:asr src (:$ count)))
     2536   (bic dest src (:$ arm::fixnummask))))
    24932537
    24942538(define-arm-vinsn %ilsr (((dest :imm))
    24952539                         ((count :imm)
    24962540                          (src :imm))
    2497                          ((temp :s32)
    2498                           (crx :crf)))
    2499   (cmpwi crx count (ash 31 arm::fixnumshift))
    2500   (srwi temp count arm::fixnumshift)
    2501   (srw temp src temp)
    2502   (clrrwi dest temp arm::fixnumshift)
    2503   (ble+ crx :foo)
    2504   (li dest 0)
    2505   :foo 
    2506   )
    2507 
    2508 #+maybe
     2541                         ((temp :s32)))
     2542  (mov temp (:asr count (:$ arm::fixnumshift)))
     2543  (mov temp (:lsr src temp))
     2544  (bic dest temp (:$ arm::fixnummask)))
     2545
     2546
    25092547(define-arm-vinsn %ilsr-c (((dest :imm))
    25102548                           ((count :u8const)
    25112549                            (src :imm))
    25122550                           ((temp :s32)))
    2513   (rlwinm temp src (:apply - 32 count) count 31)
    2514   (clrrwi dest temp arm::fixnumshift))
     2551  ((:pred = count 0)
     2552   (mov dest src))
     2553  ((:not (:pred = count 0))
     2554   (mov temp (:lsr src (:$ count)))
     2555   (bic dest temp (:$ arm::fixnummask))))
    25152556
    25162557(define-arm-vinsn natural-shift-left (((dest :u32))
    25172558                                      ((src :u32)
    25182559                                       (count :u8const)))
    2519   (rlwinm dest src count 0 (:apply - 31 count)))
     2560  ((:pred = count 0)
     2561   (mov dest src))
     2562  ((:not (:pred = count 0))
     2563   (mov dest (:lsl src (:$ count)))))
    25202564
    25212565(define-arm-vinsn natural-shift-right (((dest :u32))
    25222566                                       ((src :u32)
    25232567                                        (count :u8const)))
    2524   (rlwinm dest src (:apply - 32 count) count 31))
     2568  ((:pred = count 0)
     2569   (mov dest src))
     2570  ((:not (:pred = count 0))
     2571   (mov dest (:lsr src (:$ count)))))
    25252572
    25262573
     
    25302577                                               (type-error :u8const))
    25312578                                              ((tag :u8)
    2532                                                (flags :u32)
    2533                                                (crf :crf)))
    2534   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    2535   (cmpwi crf tag arm::tag-misc)
    2536   (bne crf :bad)
    2537   (lbz tag arm::misc-subtag-offset object)
    2538   (cmpwi crf tag arm::subtag-arrayH)
    2539   (bne crf :bad)
    2540   (lwz tag arm::arrayH.rank object)
    2541   (cmpwi crf tag (ash 2 arm::fixnumshift))
    2542   (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags arm::fixnumshift)))
    2543        
    2544   (lwz flags arm::arrayH.flags object)
    2545   (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags arm::fixnumshift)))
    2546   (bne crf :bad)
    2547   (cmpw crf tag flags)
    2548   (beq crf :good)
    2549   :bad
    2550   (uuo_interr type-error object)
    2551   :good)
     2579                                               (flags :u32)))
     2580  (and tag object (:$ arm::tagmask))
     2581  (cmp tag (:$ arm::tag-misc))
     2582  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     2583  (cmp tag (:$ arm::subtag-arrayH))
     2584  (bne :bad-if-ne)
     2585  (ldr tag (:@ object (:$ arm::arrayH.rank)))
     2586  (cmp tag (:$ (ash 2 arm::fixnumshift)))
     2587  (bne :bad-if-ne)
     2588  (mov tag (:$ (:apply ash (:apply logand expected-flags #xff00) arm::fixnumshift)))
     2589  (orr tag tag (:$ (:apply ash (:apply logand expected-flags #x00ff) arm::fixnumshift)))
     2590  (ldr flags (:@ object (:$ arm::arrayH.flags)))
     2591  (cmp tag flags)
     2592  :bad-if-ne
     2593  (uuo-error-reg-not-xtype (:? ne) object (:$ type-error)))
    25522594
    25532595(define-arm-vinsn trap-unless-simple-array-3 (()
    25542596                                              ((object :lisp)
    2555                                                (expected-flags :u32const)
     2597                                               (expected-flags :u16const)
    25562598                                               (type-error :u8const))
    25572599                                              ((tag :u8)
    2558                                                (flags :u32)
    2559                                                (crf :crf)))
    2560   (clrlwi tag object (- arm::nbits-in-word arm::nlisptagbits))
    2561   (cmpwi crf tag arm::tag-misc)
    2562   (bne crf :bad)
    2563   (lbz tag arm::misc-subtag-offset object)
    2564   (cmpwi crf tag arm::subtag-arrayH)
    2565   (bne crf :bad)
    2566   (lwz tag arm::arrayH.rank object)
    2567   (cmpwi crf tag (ash 3 arm::fixnumshift))
    2568   (lis tag (:apply ldb (byte 16 16) (:apply ash expected-flags arm::fixnumshift)))
    2569        
    2570   (lwz flags arm::arrayH.flags object)
    2571   (ori tag tag (:apply ldb (byte 16 0) (:apply ash expected-flags arm::fixnumshift)))
    2572   (bne crf :bad)
    2573   (cmpw crf tag flags)
    2574   (beq crf :good)
    2575   :bad
    2576   (uuo_interr type-error object)
    2577   :good)
     2600                                               (flags :u32)))
     2601  (and tag object (:$ arm::tagmask))
     2602  (cmp tag (:$ arm::tag-misc))
     2603  (ldrbeq tag (:@ object (:$ arm::misc-subtag-offset)))
     2604  (cmp tag (:$ arm::subtag-arrayH))
     2605  (bne :bad-if-ne)
     2606  (ldr tag (:@ object (:$ arm::arrayH.rank)))
     2607  (cmp tag (:$ (ash 3 arm::fixnumshift)))
     2608  (bne :bad-if-ne)
     2609  (mov tag (:$ (:apply ash (:apply logand expected-flags #xff00) arm::fixnumshift)))
     2610  (orr tag tag (:$ (:apply ash (:apply logand expected-flags #x00ff) arm::fixnumshift)))
     2611  (ldr flags (:@ object (:$ arm::arrayH.flags)))
     2612  (cmp tag flags)
     2613  :bad-if-ne
     2614  (uuo-error-reg-not-xtype (:? ne) object (:$ type-error)))
    25782615 
    25792616 
     
    25822619(define-arm-vinsn sign-extend-halfword (((dest :imm))
    25832620                                        ((src :imm)))
    2584   (slwi dest src (- 16 arm::fixnumshift))
    2585   (srawi dest dest (- 16 arm::fixnumshift)))
    2586 
    2587 (define-arm-vinsn s32-highword (((dest :imm))
    2588                                 ((src :s32))
    2589                                 ((temp :s32)))
    2590   (srawi temp src 16)
    2591   (slwi dest temp arm::fixnumshift))
     2621  (mov dest (:lsl src (:$ (- 16 arm::fixnumshift))))
     2622  (mov dest (:asr dest (:$ (- 16 arm::fixnumshift)))))
     2623
    25922624
    25932625                           
     
    26022634                                           ((x :imm)
    26032635                                            (y :imm))
    2604                                            ((cr0 (:crf 0))))
    2605   (addo. arm::arg_z x y)
    2606   (bsola- .SPfix-overflow))
     2636                                           ())
     2637  (adds arm::arg_z x y)
     2638  (blvs .SPfix-overflow))
    26072639
    26082640(define-arm-vinsn fixnum-add-overflow-inline (((dest :lisp))
    26092641                                              ((x :imm)
    26102642                                               (y :imm))
    2611                                               ((cr0 (:crf 0))
    2612                                                (unboxed :s32)
     2643                                              ((unboxed :s32)
    26132644                                               (header :u32)))
    2614   (addo. dest x y)
    2615   (bns+ cr0 :done)
    2616   (mtxer arm::rzero)
    2617   (srawi unboxed dest arm::fixnumshift)
    2618   (li header arm::one-digit-bignum-header)
    2619   (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
    2620   (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
    2621   (twllt arm::allocptr arm::allocbase)
    2622   (stw header arm::misc-header-offset arm::allocptr)
    2623   (mr dest arm::allocptr)
    2624   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    2625   (stw unboxed arm::misc-data-offset dest)
     2645  (adds dest x y)
     2646  (bvc :done)
     2647  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
     2648  (mov header (:$ arm::subtag-bignum))
     2649  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
     2650  (eor unboxed unboxed (:$ #xc0000000))
     2651  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
     2652  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2653  (cmp allocptr dest)
     2654  (uuo-alloc-trap (:? lo))
     2655  (str header (:@ allocptr (:$ arm::misc-header-offset)))
     2656  (mov dest allocptr)
     2657  (bic allocptr allocptr (:$ arm::fulltagmask))
     2658  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
    26262659  :done)
    26272660
     
    26302663                                                    (y :imm)
    26312664                                                    (target :label))
    2632                                                    ((cr0 (:crf 0))
    2633                                                     (unboxed :s32)
     2665                                                   ((unboxed :s32)
    26342666                                                    (header :u32)))
    2635   (addo. dest x y)
    2636   (bns+ cr0 target)
    2637   (mtxer arm::rzero)
    2638   (srawi unboxed dest arm::fixnumshift)
    2639   (li header arm::one-digit-bignum-header)
    2640   (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
    2641   (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
    2642   (twllt arm::allocptr arm::allocbase)
    2643   (stw header arm::misc-header-offset arm::allocptr)
    2644   (mr dest arm::allocptr)
    2645   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    2646   (stw unboxed arm::misc-data-offset dest)
     2667  (adds dest x y)
     2668  (bvc target)
     2669  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
     2670  (mov header (:$ arm::subtag-bignum))
     2671  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
     2672  (eor unboxed unboxed (:$ #xc0000000))
     2673  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
     2674  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocptr)))
     2675  (cmp allocptr dest)
     2676  (uuo-alloc-trap (:? lo))
     2677  (str header (:@ allocptr (:$ arm::misc-header-offset)))
     2678  (mov dest allocptr)
     2679  (bic allocptr allocptr (:$ arm::fulltagmask))
     2680  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
    26472681  (b target))
    26482682 
     
    26542688                              ((x t)
    26552689                               (y t)))
    2656   (subf dest y x))
     2690  (sub dest x y))
    26572691
    26582692(define-arm-vinsn fixnum-sub-from-constant (((dest :imm))
    26592693                                            ((x :s16const)
    26602694                                             (y :imm)))
    2661   (subfic dest y (:apply ash x arm::fixnumshift)))
     2695  (rsb dest y (:$ (:apply ash x arm::fixnumshift))))
    26622696
    26632697
     
    26672701                                           ((x :imm)
    26682702                                            (y :imm)))
    2669   (subo. arm::arg_z x y)
    2670   (bsola- .SPfix-overflow))
     2703  (subs arm::arg_z x y)
     2704  (blvs .SPfix-overflow))
    26712705
    26722706(define-arm-vinsn fixnum-sub-overflow-inline (((dest :lisp))
     
    26762710                                               (unboxed :s32)
    26772711                                               (header :u32)))
    2678   (subo. dest x y)
    2679   (bns+ cr0 :done)
    2680   (mtxer arm::rzero)
    2681   (srawi unboxed dest arm::fixnumshift)
    2682   (li header arm::one-digit-bignum-header)
    2683   (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
    2684   (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
    2685   (twllt arm::allocptr arm::allocbase)
    2686   (stw header arm::misc-header-offset arm::allocptr)
    2687   (mr dest arm::allocptr)
    2688   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    2689   (stw unboxed arm::misc-data-offset dest)
     2712  (subs dest x y)
     2713  (bvc :done)
     2714  (mov unboxed (:asr dest (:$ arm::fixnumshift)))
     2715  (mov header (:$ arm::subtag-bignum))
     2716  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
     2717  (eor unboxed unboxed (:$ #xc0000000))
     2718  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
     2719  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2720  (cmp allocptr dest)
     2721  (uuo-alloc-trap (:? lo))
     2722  (str header (:@ allocptr (:$ arm::misc-header-offset)))
     2723  (mov dest allocptr)
     2724  (bic allocptr allocptr (:$ arm::fulltagmask))
     2725  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
    26902726  :done)
    26912727
     
    26942730                                                    (y :imm)
    26952731                                                    (target :label))
    2696                                                    ((cr0 (:crf 0))
    2697                                                     (unboxed :s32)
     2732                                                   ((unboxed :s32)
    26982733                                                    (header :u32)))
    2699   (subo. dest x y)
    2700   (bns+ cr0 target)
    2701   (mtxer arm::rzero)
    2702   (srawi unboxed dest arm::fixnumshift)
    2703   (li header arm::one-digit-bignum-header)
    2704   (xoris unboxed unboxed (logand #xffff (ash #xffff (- 32 16 arm::fixnumshift))))
    2705   (la arm::allocptr (- arm::fulltag-misc 8) arm::allocptr)
    2706   (twllt arm::allocptr arm::allocbase)
    2707   (stw header arm::misc-header-offset arm::allocptr)
    2708   (mr dest arm::allocptr)
    2709   (clrrwi arm::allocptr arm::allocptr arm::ntagbits)
    2710   (stw unboxed arm::misc-data-offset dest)
     2734  (subs dest x y)
     2735  (bvc target)
     2736  (mov unboxed (:asr dest (:$ arm::fixnumshift0)))
     2737  (mov header (:$ arm::subtag-bignum))
     2738  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
     2739  (eor unboxed unboxed (:$ #xc0000000))
     2740  (sub allocptr allocptr (:$ (- arm::dnode-size arm::fulltag-misc)))
     2741  (ldr dest (:@ rcontext (:$ arm::tcr.save-allocbase)))
     2742  (cmp allocptr dest)
     2743  (uuo-alloc-trap (:? lo))
     2744  (str header (:@ allocptr (:$ arm::misc-header-offset)))
     2745  (mov dest allocptr)
     2746  (bic allocptr allocptr (:$ arm::fulltagmask))
     2747  (str unboxed (:@ dest (:$ arm::misc-data-offset)))
    27112748  (b target))
    27122749
     
    27142751(define-arm-vinsn add-immediate (((dest t))
    27152752                                 ((src t)
    2716                                   (upper :u32const)
    2717                                   (lower :u32const)))
    2718   ((:not (:pred = upper 0))
    2719    (addis dest src upper)
    2720    ((:not (:pred = lower 0))
    2721     (addi dest dest lower)))
    2722   ((:and (:pred = upper 0) (:not (:pred = lower 0)))
    2723    (addi dest src lower)))
    2724 
    2725 ;This must unbox one reg, but hard to tell which is better.
    2726 ;(The one with the smaller absolute value might be)
     2753                                  (imm :s32const)))
     2754  (add dest src (:$ imm)))
     2755
    27272756(define-arm-vinsn multiply-fixnums (((dest :imm))
    27282757                                    ((a :imm)
    27292758                                     (b :imm))
    27302759                                    ((unboxed :s32)))
    2731   (srawi unboxed b arm::fixnumshift)
    2732   (mullw dest a unboxed))
    2733 
    2734 (define-arm-vinsn multiply-immediate (((dest :imm))
    2735                                       ((boxed :imm)
    2736                                        (const :s16const)))
    2737   (mulli dest boxed const))
     2760  (mov unboxed (:asr b (:$ arm::fixnumshift)))
     2761  (mul dest a unboxed))
     2762
     2763
    27382764
    27392765;;; Mask out the code field of a base character; the result
     
    27412767(define-arm-vinsn mask-base-char (((dest :u32))
    27422768                                  ((src :imm)))
    2743   (clrlwi dest src (- arm::nbits-in-word arm::charcode-shift)))
     2769  (and dest src (:$ arm::subtag-mask)))
    27442770
    27452771;;; Set dest (of type :s32!) to 0 iff VAL is an istruct of type TYPE
     
    27472773                                 ((val :lisp)
    27482774                                  (type :lisp))
    2749                                  ((crf :crf)
    2750                                   (temp :lisp)))
    2751   (clrlwi dest val (- arm::nbits-in-word arm::nlisptagbits))
    2752   (cmpwi crf dest arm::tag-misc)
    2753   (li dest -1)
    2754   (bne crf :done)
    2755   (lbz dest arm::misc-subtag-offset val)
    2756   (cmpwi crf dest arm::subtag-istruct)
    2757   (bne crf :done)
    2758   (lwz temp arm::misc-data-offset val)
    2759   (subf dest type temp)
    2760   :done)
     2775                                 ((temp :lisp)))
     2776  (and dest val (:$ arm::tagmask))
     2777  (cmp dest (:$ arm::tag-misc))
     2778  (ldrbeq dest (:@ val (:$ arm::misc-subtag-offset)))
     2779  (cmp dest (:$ arm::subtag-istruct))
     2780  (movne dest (:$ -1))
     2781  (ldreq temp (:@ val (:$ arm::misc-data-offset)))
     2782  (subeq dest type temp))
    27612783 
    27622784 
     
    27712793                                           ((table :imm)
    27722794                                            (idx :imm)))
    2773   (lwz idx arm::symbol.binding-index src)
    2774   (lwz table arm::tcr.tlb-limit arm::rcontext)
    2775   (cmpw idx table)
    2776   (lwz table arm::tcr.tlb-pointer arm::rcontext)
    2777   (bge :symbol)
    2778   (lwzx dest table idx)
    2779   (cmpwi dest arm::subtag-no-thread-local-binding)
    2780   (bne :done)
    2781   :symbol
    2782   (lwz dest arm::symbol.vcell src)
    2783   :done
    2784   (tweqi dest arm::unbound-marker))
     2795  (ldr idx (:@ src (:$ arm::symbol.binding-index)))
     2796  (ldr table (:@ rcontext (:$ arm::tcr.tlb-limit)))
     2797  (cmp idx table)
     2798  (ldr table (:@ rcontext (:$ arm::tcr.tlb-pointer)))
     2799  (movhs idx (:$ 0))
     2800  (ldr dest (:@ table idx))
     2801  (cmp dest (:$ arm::subtag-no-thread-local-binding))
     2802  (ldreq dest (:@ src (:$ arm::symbol.vcell)))
     2803  (cmp dest (:$ arm::unbound-marker))
     2804  (uuo-error-unbound (:? eq) src))
    27852805
    27862806(define-arm-vinsn (%ref-symbol-value :call :subprim-call)
     
    27932813                                            ((table :imm)
    27942814                                             (idx :imm)))
    2795   (lwz idx arm::symbol.binding-index src)
    2796   (lwz table arm::tcr.tlb-limit arm::rcontext)
    2797   (cmpw idx table)
    2798   (lwz table arm::tcr.tlb-pointer arm::rcontext)
    2799   (bge :symbol)
    2800   (lwzx dest table idx)
    2801   (cmpwi dest arm::subtag-no-thread-local-binding)
    2802   (bne :done)
    2803   :symbol
    2804   (lwz dest arm::symbol.vcell src)
    2805   :done
    2806   )
     2815  (ldr idx (:@ src (:$ arm::symbol.binding-index)))
     2816  (ldr table (:@ rcontext (:$ arm::tcr.tlb-limit)))
     2817  (cmp idx table)
     2818  (ldr table (:@ rcontext (:$ arm::tcr.tlb-pointer)))
     2819  (movhs idx (:$ 0))
     2820  (ldr dest (:@ table idx))
     2821  (cmp dest (:$ arm::subtag-no-thread-local-binding))
     2822  (ldreq dest (:@ src (:$ arm::symbol.vcell))))
    28072823
    28082824(define-arm-vinsn (setq-special :call :subprim-call)
     
    28172833                                   ((crf :crf)
    28182834                                    (tag :u32)))
    2819   (lwz val arm::symbol.fcell sym)
    2820   (clrlwi tag val (- 32 arm::nlisptagbits))
    2821   (cmpwi crf tag arm::tag-misc)
    2822   (bne- crf :bad)
    2823   (lbz tag arm::misc-subtag-offset val)
    2824   (cmpwi crf tag arm::subtag-function)
    2825   (beq+ crf :good)
    2826   :bad
    2827   (uuo_interr arch::error-udf sym)
    2828   :good)
     2835  (ldr val (:@ sym (:$ arm::symbol.fcell)))
     2836  (and tag val (:$ arm::tagmask))
     2837  (cmp tag (:$ arm::tag-misc))
     2838  (ldrbeq tag (:@ val (:$ arm::misc-subtag-offset)))
     2839  (cmp tag (:$ arm::subtag-function))
     2840  (uuo-error-udf (:? ne) sym))
    28292841
    28302842(define-arm-vinsn (temp-push-unboxed-word :push :word :sp)
     
    28352847  (orr header header (:$ (ash 1 arm::num-subtag-bits)))
    28362848  (str header (:@ sp (:$ (- arm::dnode-size))))
    2837   (str w (:@ sp 4)))
     2849  (str w (:@ sp (:$ 4))))
    28382850
    28392851(define-arm-vinsn (temp-pop-unboxed-word :pop :word :sp)
     
    28432855  (add sp sp (:$ arm::dnode-size)))
    28442856
     2857#+notyet
    28452858(define-arm-vinsn (temp-push-double-float :push :doubleword :sp)
    28462859    (()
     
    28522865  (fstd d (:@ sp (:$ 8))))
    28532866
     2867#+notyet
    28542868(define-arm-vinsn (temp-pop-double-float :pop :doubleword :sp)
    28552869    (()
     
    28582872  (add sp sp (:$ (* 2 arm::dnode-size))))
    28592873
     2874#+notyet
    28602875(define-arm-vinsn (temp-push-single-float :push :word :tsp)
    28612876    (()
     
    28672882  (fsts s (:@ sp (:$ 4))))
    28682883
     2884#+notyet
    28692885(define-arm-vinsn (temp-pop-single-float :pop :word :sp)
    28702886    (()
     
    28812897(define-arm-vinsn %current-tcr (((dest :imm))
    28822898                                ())
    2883   (mov dest arm::rcontext))
     2899  (mov dest rcontext))
    28842900
    28852901(define-arm-vinsn (dpayback :call :subprim-call) (()
     
    28932909
    28942910(define-arm-vinsn zero-double-float-register (((dest :double-float))
    2895                                               ())
    2896   (fmr dest arm::fp-zero))
     2911                                              ()
     2912                                              ((temp t)))
     2913  (mov temp (:$ 0))
     2914  (fmsr dest temp))
    28972915
    28982916(define-arm-vinsn zero-single-float-register (((dest :single-float))
    2899                                               ())
    2900   (fmr dest arm::fp-zero))
     2917                                              ()
     2918                                              ((temp t)))
     2919  (mov temp (:$ 0))
     2920  (fmdrr dest temp temp))
    29012921
    29022922(define-arm-vinsn load-double-float-constant (((dest :double-float))
     
    29172937                                     ((n :u16const)))
    29182938  (cmp nargs (:$ (:apply ash n 2)))
    2919   (uuo-error-wrong-nargs (:ne)))
     2939  (uuo-error-wrong-nargs (:? ne)))
    29202940
    29212941(define-arm-vinsn check-min-nargs (()
    29222942                                   ((min :u16const)))
    29232943  (cmp nargs (:$ (:apply ash min 2)))
    2924   (uuo-error-wrong-nargs (:lo)))
     2944  (uuo-error-wrong-nargs (:? lo)))
    29252945
    29262946
     
    29282948                                   ((max :u16const)))
    29292949  (cmp nargs (:$ (:apply ash max 2)))
    2930   (uuo-error-wrong-nargs (:hi)))
     2950  (uuo-error-wrong-nargs (:? hi)))
    29312951
    29322952;;; Save context and establish FN.  The current VSP is the the
     
    29362956                                         ((imm :u32)))
    29372957  (mov imm (:$ arm::lisp-frame-marker))
    2938   (stmdb (:! sp) (imm vsp fn lr)))
     2958  (stmdb (:! sp) (imm vsp fn lr))
     2959  (mov fn nfn))
    29392960
    29402961
     
    29452966  (add imm vsp (:$ nbytes-vpushed))
    29462967  (mov imm0 (:$ arm::lisp-frame-marker))
    2947   (stmdb (:! sp) (imm0 imm fn lr)))
     2968  (stmdb (:! sp) (imm0 imm fn lr))
     2969  (mov fn nfn))
    29482970
    29492971
     
    29542976                                           ((imm :u32)))
    29552977  (stwu arm::sp (- arm::lisp-frame.size) arm::sp)
    2956   (stw arm::rzero arm::lisp-frame.savefn arm::sp)
    2957   (stw arm::loc-pc arm::lisp-frame.savelr arm::sp)
    2958   (stw arm::vsp arm::lisp-frame.savevsp arm::sp)
     2978  (str arm::rzero (:@ arm::sp (:$ arm::lisp-frame.savefn)))
     2979  (str arm::loc-pc (:@ arm::sp (:$ arm::lisp-frame.savelr)))
     2980  (str vsp (:@ arm::sp (:$ arm::lisp-frame.savevsp)))
    29592981  (mr arm::fn arm::nfn)
    29602982  ;; Do a stack-probe ...
    2961   (lwz imm arm::tcr.cs-limit arm::rcontext)
     2983  (ldr imm (:@ rcontext (:$ arm::tcr.cs-limit)))
    29622984  (twllt arm::sp imm))
    29632985 
     
    29803002      (arg-temp :u32)))
    29813003  ((:pred >= min-fixed $numarmargregs)
    2982    (stwu arm::arg_x -4 arm::vsp)   
    2983    (stwu arm::arg_y -4 arm::vsp)   
    2984    (stwu arm::arg_z -4 arm::vsp))
     3004   (stwu arm::arg_x -4 vsp)   
     3005   (stwu arm::arg_y -4 vsp)   
     3006   (stwu arm::arg_z -4 vsp))
    29853007  ((:pred = min-fixed 2)                ; at least 2 args
    29863008   (cmplwi crfx nargs (ash 2 arm::word-shift))
    29873009   (beq crfx :yz2)                      ; skip arg_x if exactly 2
    2988    (stwu arm::arg_x -4 arm::vsp)
     3010   (stwu arm::arg_x -4 vsp)
    29893011   :yz2
    2990    (stwu arm::arg_y -4 arm::vsp)
    2991    (stwu arm::arg_z -4 arm::vsp))
     3012   (stwu arm::arg_y -4 vsp)
     3013   (stwu arm::arg_z -4 vsp))
    29923014  ((:pred = min-fixed 1)                ; at least one arg
    29933015   (cmplwi crfx nargs (ash 2 arm::word-shift))
    29943016   (blt crfx :z1)                       ; branch if exactly one
    29953017   (beq crfx :yz1)                      ; branch if exactly two
    2996    (stwu arm::arg_x -4 arm::vsp)
     3018   (stwu arm::arg_x -4 vsp)
    29973019   :yz1
    2998    (stwu arm::arg_y -4 arm::vsp)   
     3020   (stwu arm::arg_y -4 vsp)   
    29993021   :z1
    3000    (stwu arm::arg_z -4 arm::vsp))
     3022   (stwu arm::arg_z -4 vsp))
    30013023  ((:pred = min-fixed 0)
    30023024   (cmplwi crfx nargs (ash 2 arm::word-shift))
     
    30063028   (blt crfx :z0)                       ; one
    30073029                                        ; Three or more ...
    3008    (stwu arm::arg_x -4 arm::vsp)
     3030   (stwu arm::arg_x -4 vsp)
    30093031   :yz0
    3010    (stwu arm::arg_y -4 arm::vsp)
     3032   (stwu arm::arg_y -4 vsp)
    30113033   :z0
    3012    (stwu arm::arg_z -4 arm::vsp)
     3034   (stwu arm::arg_z -4 vsp)
    30133035   :none
    30143036   )
    30153037  ((:pred = min-fixed 0)
    3016    (stwu nargs -4 arm::vsp))
     3038   (stwu nargs -4 vsp))
    30173039  ((:not (:pred = min-fixed 0))
    30183040   (subi arg-temp nargs (:apply ash min-fixed arm::word-shift))
    3019    (stwu arg-temp -4 arm::vsp))
    3020   (add entry-vsp arm::vsp nargs)
     3041   (stwu arg-temp -4 vsp))
     3042  (add entry-vsp vsp nargs)
    30213043  (la entry-vsp 4 entry-vsp)
    30223044  (bl .SPlexpr-entry))
     
    30463068(define-arm-vinsn restore-cleanup-context (()
    30473069                                           ())
    3048   (ldr lr (:@ sp (:$ arm::lisp-frame.savelr))
     3070  (ldr lr (:@ sp (:$ arm::lisp-frame.savelr)))
    30493071  (add sp sp (:$ arm::lisp-frame.size)))
    30503072
     
    30563078  (bne :done)
    30573079  ((:pred >= min 3)
    3058    (str arg_x (:@! vsp (:$ (- arm::node-size))))
     3080   (str arg_x (:@! vsp (:$ (- arm::node-size)))))
    30593081  ((:pred >= min 2)
    30603082   (mov arg_x arg_y))
    30613083  ((:pred >= min 1)
    30623084   (mov arg_y arg_z))
    3063   (move arm::arg_z (:$ arm::nil-value))
     3085  (mov arm::arg_z (:$ arm::nil-value))
    30643086  :done)
    30653087
    30663088(define-arm-vinsn default-2-args (()
    30673089                                  ((min :u16const)))
    3068   (cmp nargs (:apply ash (:apply 1+ min) 2))
     3090  (cmp nargs (:$ (:apply ash (:apply 1+ min) 2)))
    30693091  (bgt :done)
    30703092  (beq :one)
     
    30833105   (str arg_x (:@! vsp (:$ (- arm::node-size)))))
    30843106  ((:pred >= min 1)
    3085    (move arg_x arg_y))
    3086   (mr arm::arg_y arm::arg_z)
     3107   (mov arg_x arg_y))
     3108  (mov arm::arg_y arm::arg_z)
    30873109  :last
    30883110  (mov arg_z (:$ arm::nil-value))
     
    31603182                            (idx :imm))
    31613183                           ((imm :u32)))
    3162   (mov imm (:$ lsr idx (:$ arm::fixnumshift)))
     3184  (mov imm (:lsr idx (:$ arm::fixnumshift)))
    31633185  (add imm imm (:$ arm::misc-data-offset))
    31643186  (ldrb imm (:@ str imm))
     
    31823204                               ((imm :u32)
    31833205                                (imm1 :u32)))
    3184   (mov imm (:lsr (:$ idx arm::fixnumshift)))
     3206  (mov imm (:lsr idx (:$ arm::fixnumshift)))
    31853207  (add imm imm (:$ arm::misc-data-offset))
    3186   (mov imm1 (:lst char (:$ arm::charcode-shift)))
     3208  (mov imm1 (:lsr char (:$ arm::charcode-shift)))
    31873209  (strb imm1 (:@ str imm)))
    31883210
     
    32153237                                    ((imm :u32)
    32163238                                     (imm1 :u32)))
    3217   (addi imm idx arm::misc-data-offset)
    3218   (srwi imm1 code arm::fixnumshift)
    3219   (stwx imm1 str imm)
    3220   )
     3239  (add imm idx (:$ arm::misc-data-offset))
     3240  (mov imm1 (:lsr code (:$ arm::fixnumshift)))
     3241  (str imm1 (:@ str imm)))
    32213242
    32223243(define-arm-vinsn %scharcode8 (((code :imm))
    32233244                               ((str :lisp)
    32243245                                (idx :imm))
    3225                                ((imm :u32)
    3226                                 (cr0 (:crf 0))))
    3227   (srwi imm idx arm::fixnumshift)
    3228   (addi imm imm arm::misc-data-offset)
    3229   (lbzx imm str imm)
    3230   (slwi code imm arm::fixnumshift))
     3246                               ((imm :u32)))
     3247  (mov imm (:lsr idx (:$ arm::fixnumshift)))
     3248  (add imm imm (:$ arm::misc-data-offset))
     3249  (ldrb imm (:@ str imm))
     3250  (mov code (:lsl imm (:$ arm::fixnumshift))))
    32313251
    32323252(define-arm-vinsn %scharcode32 (((code :imm))
    32333253                                ((str :lisp)
    32343254                                 (idx :imm))
    3235                                 ((imm :u32)
    3236                                  (cr0 (:crf 0))))
    3237   (addi imm idx arm::misc-data-offset)
    3238   (lwzx imm str imm)
    3239   (slwi code imm arm::fixnumshift))
     3255                                ((imm :u32)))
     3256  (add imm idx (:$ arm::misc-data-offset))
     3257  (ldr imm (:@ str imm))
     3258  (mov code (:lsl imm (:$ arm::fixnumshift))))
    32403259
    32413260;;; Clobbers LR
    3242 (define-arm-vinsn (%debug-trap :call :subprim-call) (()
     3261(define-arm-vinsn %debug-trap (()
    32433262                                                     ())
    3244   (bl .SPbreakpoint)
    3245   )
    3246 
    3247 
     3263  (uuo-debug-trap))
     3264
     3265
     3266#+notyet
    32483267(define-arm-vinsn eep.address (((dest t))
    32493268                               ((src (:lisp (:ne dest )))))
    3250   (lwz dest (+ (ash 1 2) arm::misc-data-offset) src)
     3269  (ldr dest (:@ src (:$ (+ (ash 1 2) arm::misc-data-offset))))
    32513270  (tweqi dest (:apply target-nil-value)))
    32523271                 
     
    32573276(define-arm-vinsn %natural+-c (((dest :u32))
    32583277                               ((x :u32) (y :u16const)))
    3259   (addi dest x y))
     3278  (add dest x (:$ y)))
    32603279
    32613280(define-arm-vinsn %natural- (((dest :u32))
     
    32653284(define-arm-vinsn %natural--c (((dest :u32))
    32663285                               ((x :u32) (y :u16const)))
    3267   (subi dest x y))
     3286  (sub dest x (:$ y)))
    32683287
    32693288(define-arm-vinsn %natural-logior (((dest :u32))
    32703289                                   ((x :u32) (y :u32)))
    3271   (or dest x y))
     3290  (orr dest x y))
    32723291
    32733292(define-arm-vinsn %natural-logior-c (((dest :u32))
    3274                                      ((x :u32) (high :u16const) (low :u16const)))
    3275   ((:not (:pred = high 0))
    3276    (oris dest x high))
    3277   ((:not (:pred = low 0))
    3278    (ori dest x low)))
     3293                                     ((x :u32) (c :u32const)))
     3294  (orr dest x (:$ c)))
    32793295
    32803296(define-arm-vinsn %natural-logxor (((dest :u32))
    32813297                                   ((x :u32) (y :u32)))
    3282   (xor dest x y))
     3298  (eor dest x y))
    32833299
    32843300(define-arm-vinsn %natural-logxor-c (((dest :u32))
    3285                                      ((x :u32) (high :u16const) (low :u16const)))
    3286   ((:not (:pred = high 0))
    3287    (xoris dest x high))
    3288   ((:not (:pred = low 0))
    3289    (xori dest x low)))
     3301                                     ((x :u32) (c :u32const)))
     3302  (eor dest x (:$ c)))
    32903303
    32913304(define-arm-vinsn %natural-logand (((dest :u32))
     
    32933306  (and dest x y))
    32943307
    3295 (define-arm-vinsn %natural-logand-high-c (((dest :u32))
    3296                                           ((x :u32) (high :u16const))
    3297                                           ((cr0 (:crf 0))))
    3298   (andis. dest x high))
    3299 
    3300 (define-arm-vinsn %natural-logand-low-c (((dest :u64))
    3301                                          ((x :u64) (low :u16const))
    3302                                          ((cr0 (:crf 0))))
    3303   (andi. dest x low))
    3304 
    3305 (define-arm-vinsn %natural-logand-mask-c (((dest :u32))
    3306                                           ((x :u32)
    3307                                            (start :u8const)
    3308                                            (end :u8const)))
    3309   (rlwinm dest x 0 start end))
     3308(define-arm-vinsn %natural-logand-c (((dest :u32))
     3309                                          ((x :u32) (c :u16const))
     3310                                     )
     3311  (and dest x (:$ c)))
     3312
     3313
     3314
     3315
     3316
    33103317
    33113318(define-arm-vinsn disable-interrupts (((dest :lisp))
     
    33133320                                      ((temp :imm)
    33143321                                       (temp2 :imm)))
    3315   (lwz temp2 arm::tcr.tlb-pointer arm::rcontext)
    3316   (li temp -4)
    3317   (lwz dest arm::interrupt-level-binding-index temp2)
    3318   (stw temp arm::interrupt-level-binding-index temp2))
     3322  (ldr temp2 (:@ rcontext (:$ arm::tcr.tlb-pointer)))
     3323  (mov temp (:$ -4))
     3324  (ldr dest (:@ temp2 (:$ arm::interrupt-level-binding-index)))
     3325  (str temp (:@ temp2 (:$ arm::interrupt-level-binding-index))))
    33193326
    33203327(define-arm-vinsn load-character-constant (((dest :lisp))
    33213328                                           ((code :u32const)))
    3322   (ori dest arm::rzero (:apply logior (:apply ash (:apply logand #xff code) arm::charcode-shift) arm::subtag-character))
    3323   ((:not (:pred = 0 (:apply ldb (byte 16 8) code)))
    3324    (oris dest dest (:apply ldb (byte 16 8) code))))
     3329  (mov dest (:$ arm::subtag-character))
     3330  ((:pred logtest #xff code)
     3331   (orr dest dest (:$ (:apply ash (:apply logand code #xff) 8))))
     3332  ((:pred logtest #xff00 code)
     3333   (orr dest dest (:$ (:apply ash (:apply ldb (byte 8 8) code) 16))))
     3334  ((:pred logtest #xff000 code)
     3335   (orr dest dest (:$ (:apply ash (:apply ldb (byte 8 16) code) 24)))))
    33253336
    33263337
     
    33383349                (:apply %hard-regspec-value dest)
    33393350                (:apply %hard-regspec-value src)))
    3340    (mr dest src))
     3351   (mov dest src))
    33413352  (b :done)
    33423353  :nilsym
     
    35333544(define-arm-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
    35343545
     3546#+notyet
    35353547(define-arm-vinsn bind-interrupt-level-0-inline (()
    35363548                                                 ()
     
    35393551                                                  (link :imm)
    35403552                                                  (temp :imm)))
    3541   (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
    3542   (lwz value arm::interrupt-level-binding-index tlb)
    3543   (lwz link arm::tcr.db-link arm::rcontext)
     3553  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
     3554  (ldr value (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3555  (ldr link (:@ rcontext (:$ arm::tcr.db-link)))
    35443556  (cmpwi value 0)
    35453557  (li temp arm::interrupt-level-binding-index)
    3546   (stwu value -4 arm::vsp)
    3547   (stwu temp -4 arm::vsp)
    3548   (stwu link -4 arm::vsp)
    3549   (stw arm::rzero arm::interrupt-level-binding-index tlb)
    3550   (stw arm::vsp  arm::tcr.db-link arm::rcontext)
     3558  (stwu value -4 vsp)
     3559  (stwu temp -4 vsp)
     3560  (stwu link -4 vsp)
     3561  (str arm::rzero (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3562  (str vsp  (:@ rcontext (:$ arm::tcr.db-link)))
    35513563  (beq+ :done)
    35523564  (mr nargs value)
    35533565  (bgt :do-trap)
    3554   (lwz nargs arm::tcr.interrupt-pending arm::rcontext)
     3566  (ldr nargs (:@ rcontext (:$ arm::tcr.interrupt-pending)))
    35553567  :do-trap
    35563568  (twgti nargs 0)
     
    35683580                                                   (newvalue :imm)
    35693581                                                   (idx :imm)))
    3570   (li newvalue (ash -1 arm::fixnumshift))
    3571   (li idx arm::interrupt-level-binding-index)
    3572   (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
    3573   (lwz oldvalue arm::interrupt-level-binding-index tlb)
    3574   (lwz link arm::tcr.db-link arm::rcontext)
    3575   (stwu oldvalue -4 arm::vsp)
    3576   (stwu idx -4 arm::vsp)
    3577   (stwu link -4 arm::vsp)
    3578   (stw newvalue arm::interrupt-level-binding-index tlb)
    3579   (stw arm::vsp  arm::tcr.db-link arm::rcontext)
    3580   :done)
     3582  (mov newvalue (:$ (ash -1 arm::fixnumshift)))
     3583  (mov idx (:$ arm::interrupt-level-binding-index))
     3584  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
     3585  (ldr oldvalue (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3586  (ldr link (:@ rcontext (:$ arm::tcr.db-link)))
     3587  (str oldvalue (:@! vsp (:$ (- arm::node-size))))
     3588  (str idx (:@! vsp (:$ (- arm::node-size))))
     3589  (str link (:@! vsp (:$ (- arm::node-size))))
     3590  (str newvalue (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3591  (str vsp  (:@ rcontext (:$ arm::tcr.db-link))))
    35813592
    35823593(define-arm-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
     
    35843595(define-arm-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
    35853596
     3597#+notyet
    35863598(define-arm-vinsn unbind-interrupt-level-inline (()
    35873599                                                 ()
     
    35923604                                                  (crf0 :crf)
    35933605                                                  (crf1 :crf)))
    3594   (lwz tlb arm::tcr.tlb-pointer arm::rcontext)
    3595   (lwz value arm::interrupt-level-binding-index tlb)
    3596   (lwz link arm::tcr.db-link arm::rcontext)
     3606  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
     3607  (ldr value (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3608  (ldr link (:@ rcontext (:$ arm::tcr.db-link)))
    35973609  (cmpwi crf1 value 0)
    3598   (lwz value 8 link)
    3599   (lwz link 0 link)
     3610  (ldr value (:@ link (:$ 8)))
     3611  (ldr link (:@ link (:$ 0)))
    36003612  (cmpwi crf0 value 0)
    3601   (stw value arm::interrupt-level-binding-index tlb)
    3602   (stw link arm::tcr.db-link arm::rcontext)
     3613  (str value (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3614  (str link (:@ rcontext (:$ arm::tcr.db-link)))
    36033615  (bge crf1 :done)
    36043616  (blt crf0 :done)
    36053617  (mr save-nargs nargs)
    3606   (lwz nargs arm::tcr.interrupt-pending arm::rcontext)
     3618  (ldr nargs (:@ rcontext (:$ arm::tcr.interrupt-pending)))
    36073619  (twgti nargs 0)
    36083620  (mr nargs save-nargs)
     
    36143626                                            ((arg :lisp)
    36153627                                             (lab :label))
    3616                                             ((cr0 (:crf 0))
    3617                                              (tag :u8)))
    3618   (clrlwi. tag arg (- arm::nbits-in-word arm::nlisptagbits))
    3619   (bne cr0 lab))
     3628                                            ())
     3629  (tst arg (:$ arm::fixnummask))
     3630  (bne lab))
     3631
     3632
     3633
    36203634
    36213635(define-arm-vinsn branch-unless-both-args-fixnums (()
     
    36253639                                                   ((tag :u8)))
    36263640  (orr tag arg0 arg1)
    3627   (tst tag (:$ arm::tagmask))
     3641  (tst tag (:$ arm::fixnummask))
    36283642  (bne lab))
    36293643
    36303644;;; In case arm::*arm-opcodes* was changed since this file was compiled.
     3645#+maybe-never
    36313646(queue-fixup
    36323647 (fixup-vinsn-templates *arm-vinsn-templates* arm::*arm-opcode-numbers*))
  • branches/arm/compiler/ARM/arm2.lisp

    r13714 r13741  
    503503      (setf (uvref function (1+ 2)) (aref imms i)))
    504504    (setf (uvref function (+ numimms 1)) bits)
    505     (let* ((maxpc (arm-lap-encode-regsave-info (arm-lap-do-labels)))
    506            (code-vector-size (+ traceback-size (ash maxpc -2) prefix-size)))
    507       (let* ((code-vector (%alloc-misc code-vector-size
     505    (let* ((code-vector-size (arm::arm-finalize code data))
     506           (code-vector (%alloc-misc code-vector-size
    508507                                     (if cross-compiling
    509508                                       target::subtag-xcode-vector
    510509                                       target::subtag-code-vector)))
    511              (j 0))
    512         (dotimes (i prefix-size)
    513           (setf (uvref code-vector i) (pop prefix)))
    514         (arm-lap-resolve-labels)
    515         (do-dll-nodes (insn *lap-instructions*)
    516           (arm-lap-generate-instruction code-vector i insn)
    517           (incf i))
    518         (unless (eql 0 traceback-size)
    519           (add-traceback-table code-vector i traceback-string))
    520         (setf (uvref function 0) code-vector)
    521         (%make-code-executable code-vector)
    522         function))))
     510           (j 0))
     511      (dotimes (i prefix-size)
     512        (setf (uvref code-vector i) (pop prefix)))
     513      (arm-lap-resolve-labels)
     514      (do-dll-nodes (insn *lap-instructions*)
     515        (arm-lap-generate-instruction code-vector i insn)
     516        (incf i))
     517      (setf (uvref function 1) code-vector)
     518      (%make-code-executable code-vector)
     519      function)))
    523520     
    524521   
     
    816813           (reg-vars ()))
    817814      (declare (type (unsigned-byte 16) nargs))
    818       (! save-lr)
    819815      (if (<= nargs $numarmargregs)       ; caller didn't vpush anything
    820         (if *arm2-open-code-inline*
    821           (! save-lisp-context-vsp)
    822           (! save-lisp-context-vsp-ool))
     816        (! save-lisp-context-vsp)
    823817        (let* ((offset (* (the fixnum (- nargs $numarmargregs)) *arm2-target-node-size*)))
    824818          (declare (fixnum offset))
    825           (if *arm2-open-code-inline*
    826             (! save-lisp-context-offset offset)
    827             (! save-lisp-context-offset-ool offset))))
     819          (! save-lisp-context-offset offset)))
    828820      (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
    829821        (let* ((nstackargs (length stack-args)))
     
    47774769  (or (eq cd $backend-return) (arm2-mvpass-p cd)))
    47784770
    4779 (defun arm2-expand-note (note)
     4771(defun arm2-expand-note (note header)
    47804772  (let* ((lab (vinsn-note-label note)))
    47814773    (case (vinsn-note-class note)
    47824774      ((:begin-variable-scope :end-variable-scope
    47834775        :source-location-begin :source-location-end)
    4784        (setf (vinsn-label-info lab) (emit-lap-label lab))))))
     4776       (setf (vinsn-label-info lab) (arm::emit-lap-label header lab))))))
    47854777
    47864778(defun arm2-expand-vinsns (header current sections)
     
    47914783          (when (or t (vinsn-label-refs v) (null id))
    47924784            (setf (vinsn-label-info v) (arm::emit-lap-label current v)))
    4793           (arm2-expand-note id)))
     4785          (arm2-expand-note current id)))
    47944786      (setq current (arm2-expand-vinsn v current sections))))
    47954787  ;;; This doesn't have too much to do with anything else that's
     
    53375329    (let* ((fixval (or fix1 fix2))
    53385330           (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
    5339            (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
    5340            (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
    5341            (otherform (if (or high low) (if fix1 form2 form1))))
     5331           (ok-imm (and unboxed-fixval
     5332                        (arm::encode-arm-immediate unboxed-fixval)))
     5333           (otherform (if ok-imm (if fix1 form2 form1))))
    53425334      (if otherform
    53435335        (let* ((other-reg (arm2-one-untargeted-reg-form seg otherform arm::arg_z)))
    53445336          (when vreg
    5345             (ensuring-node-target (target vreg)
    5346               (if high
    5347                 (! logior-high target other-reg high)
    5348                 (! logior-low target other-reg low)))))
     5337            (ensuring-node-target (target vreg)
     5338              (! logior-immediate target other-reg unboxed-fixval))))
    53495339        (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
    53505340          (if vreg (ensuring-node-target (target vreg) (! %logior2 target r1 r2)))))   
    53515341      (^))))
    53525342
    5353 ;;; in a lot of (typical ?) cases, it might be possible to use a
    5354 ;;; rotate-and-mask instead of andi./andis.
    53555343
    53565344(defarm2 arm2-%ilogand2 %ilogand2 (seg vreg xfer form1 form2)
     
    53605348      (arm2-use-operator (%nx1-operator fixnum) seg vreg xfer (logand fix1 fix2))
    53615349      (let* ((fixval (or fix1 fix2))
    5362              (fixlen (if fixval (integer-length fixval)))
    5363              (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
    5364              (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
    5365              (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
    5366              (otherform (if (or high low) (if fix1 form2 form1))))
     5350             (unboxed-fixval (if fixval (ash fixval arm::fixnum-shift)))
     5351             (ok-imm (and unboxed-fixval
     5352                          (or (arm::encode-arm-immediate unboxed-fixval)
     5353                              (arm::encode-arm-immediate
     5354                               (logand #xffffffff (lognot unboxed-fixval))))))
     5355                                                                 
     5356             (otherform (if ok-imm (if fix1 form2 form1))))
    53675357        (if otherform
    53685358          (let* ((other-reg (arm2-one-untargeted-reg-form seg otherform arm::arg_z)))
    53695359            (when vreg
    5370               (ensuring-node-target (target vreg)
    5371                 (if high
    5372                   (! logand-high target other-reg high)
    5373                   (! logand-low target other-reg low)))))
    5374           (if (and fixval (= fixlen (logcount fixval)))
    5375             (let* ((nbits (- *arm2-target-bits-in-word*
    5376                              (1+ (+ *arm2-target-fixnum-shift* fixlen))))
    5377                    (otherreg (arm2-one-untargeted-reg-form seg (if fix1 form2 form1) arm::arg_z)))
    5378            
    5379               (if vreg (ensuring-node-target (target vreg)
    5380                          (if (> fixval 0)
    5381                            (! clear-left target otherreg nbits)
    5382                            (! clear-right target otherreg (+ fixlen
    5383                                                              *arm2-target-fixnum-shift*))))))
    5384          
     5360              (ensuring-node-target (target vreg)
     5361                (! logand-immediate target other-reg unboxed-fixval))))
    53855362            (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
    5386               (if vreg (ensuring-node-target (target vreg) (! %logand2 target r1 r2))))))
     5363              (if vreg (ensuring-node-target (target vreg) (! %logand2 target r1 r2)))))
    53875364        (^)))))
    53885365
     
    77787755(defarm2 arm2-%setf-double-float %setf-double-float (seg vref xfer fnode fval)
    77797756  (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg fnode arm::arg_z))
    7780   (let* ((target ($ arm::fp1 :class :fpr :mode :double-float))
     7757  (let* ((target ($ arm::d0 :class :fpr :mode :double-float))
    77817758         (node ($ arm::arg_z)))
    77827759    (arm2-one-targeted-reg-form seg fval target)
     
    77907767(defarm2 arm2-%setf-short-float %setf-short-float (seg vreg xfer fnode fval)
    77917768  (arm2-vpush-register seg (arm2-one-untargeted-reg-form seg fnode arm::arg_z))
    7792   (let* ((target ($ arm::fp1 :class :fpr :mode :single-float))
     7769  (let* ((target ($ arm::s0 :class :fpr :mode :single-float))
    77937770         (freg ($ arm::arg_z)))
    77947771    (arm2-one-targeted-reg-form seg fval target)
Note: See TracChangeset for help on using the changeset viewer.