Changeset 13780


Ignore:
Timestamp:
Jun 3, 2010, 2:32:09 PM (9 years ago)
Author:
gb
Message:

Changes, from "just barely functional" to "apparently somewhat functional,
knock wood."

Location:
branches/arm/compiler
Files:
6 edited

Legend:

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

    r13758 r13780  
    2626
    2727
     28(eval-when (:compile-toplevel :load-toplevel :execute)
    2829(defvar *arm-register-names* ())
    2930
     
    5152;;; before calling this.
    5253(defun define-arm-register (name val)
    53   (let* ((value (if (typep val 'fixnum) val (get-arm-gpr val)))
     54  (let* ((value (if (typep val 'fixnum) val (get-arm-register val)))
    5455         (string (string name)))
    5556    (unless value
     
    175176(defarmdfpr d14 78)
    176177(defarmdfpr d15 79)
    177 
     178)
    178179
    179180
     
    304305      (setq *arm-subprims*
    305306            (vector
    306              (defarmsubprim .SPfix-nfn-entrypoint)
     307             (defarmsubprim .SPfix-nfn-entrypoint) ;must be first
    307308             (defarmsubprim .SPbuiltin-plus)
    308309             (defarmsubprim .SPbuiltin-minus)
     
    429430             (defarmsubprim .SPudiv32)
    430431             (defarmsubprim .SPsdiv32)
     432             (defarmsubprim .SPeabi-ff-call)
    431433             )))))
     434
    432435
    433436
     
    542545;;; set in the result.
    543546
    544 (defconstant t-offset (+ (- dnode-size fulltag-nil) fulltag-misc))
     547(defconstant t-offset (+ dnode-size (- dnode-size fulltag-nil) fulltag-misc))
    545548
    546549
     
    13601363  al)
    13611364
     1365;;; A function's entrypoint should initially reference .SPfix-nfn-entrypoint,
     1366;;; which will set it to a locative to the function's code-vector.
     1367(defparameter *function-initial-entrypoint* (ash *arm-subprims-base* (- arm::fixnumshift)))
     1368
    13621369 
    13631370(provide "ARM-ARCH")
  • branches/arm/compiler/ARM/arm-asm.lisp

    r13763 r13780  
    116116    :rde
    117117    :rs
     118    :fpaddr
    118119    ))
    119120
     
    269270     #x0fff00ff
    270271     (:prefer-separate-cond))
     272   (define-arm-instruction uuo-eep-unresolved (:uuoA :uuoB)
     273     #x07f400ff
     274     #x0fff00ff
     275     (:prefer-separate-cond))     
    271276
    272277   (define-arm-instruction and (:rd :rn :shifter)
     
    667672     #x0c000090
    668673     #x0ff000f0
    669      ())   
     674     ())
     675
     676   (define-arm-instruction fstd (:sd :fpaddr)
     677     #x0d000b00
     678     #x0f700f00
     679     ())
     680   (define-arm-instruction fsts (:sd :fpaddr)
     681     #x0d000a00
     682     #x0f300f00
     683     ())
     684   (define-arm-instruction fldd (:sd :fpaddr)
     685     #x0d100b00
     686     #x0f700f00
     687     ())     
     688   (define-arm-instruction fsts (:sd :fpaddr)
     689     #x0d100a00
     690     #x0f300f00
     691     ())
    670692   ))
    671693
     
    11071129(defun parse-rs-operand (form instruction)
    11081130  (set-field-value instruction (byte 4 8) (need-arm-gpr form)))
     1131
     1132(defun parse-fpaddr-operand (form instruction)
     1133  (if (atom form)
     1134    (error "Invalid FP address: ~s" form)
     1135    (destructuring-bind (op rn offset) form
     1136      (unless (eq (keywordize op) :@)
     1137        (error "Invalid FP addressing mode ~s in ~s." op form))
     1138      (set-field-value instruction (byte 4 16) (need-arm-gpr rn))
     1139      (unless (and (consp offset) (eq (keywordize (car offset)) :$))
     1140        (error "Invalid FP address offset ~s in ~s." offset form))
     1141      (destructuring-bind (offset-form) (cadr offset)
     1142        (let* ((offset-val (eval offset-form)))
     1143          (when (logtest offset-val 3)
     1144            (error "FP address offset ~s must be a multiple of 4 in ~s." offset form))
     1145          (if (< offset-val 0)
     1146            (setq offset-val (- offset-val))
     1147            (set-field-value instruction (byte 1 23) 1))
     1148          (set-field-value instruction (byte 8 0) (ash offset-val -3)))))))
    11091149 
    11101150(defparameter *arm-operand-parsers*
     
    11301170      parse-rde-operand
    11311171      parse-rs-operand
     1172      parse-fpaddr-operand
    11321173      ))
    11331174
     
    13891430    :dn
    13901431    :sn
     1432    :fpaddr-offset
    13911433    )))
    13921434
     
    14171459      vinsn-parse-rde-operand
    14181460      vinsn-parse-rs-operand
     1461      vinsn-parse-fpaddr-operand
    14191462      ))
    14201463
     
    16981741(defun vinsn-parse-rs-operand (avi value vinsn-params)
    16991742  (vinsn-arg-or-gpr avi value vinsn-params (encode-vinsn-field-type :rs) (byte 4 8)))
     1743
     1744(defun vinsn-parse-fpaddr-operand (avi value vinsn-params)
     1745  (destructuring-bind (op rn offset) value
     1746    (unless (eq op :@) (error "Bad FP address operand: ~s." value))
     1747    (vinsn-arg-or-gpr avi rn vinsn-params (encode-vinsn-field-type :rn) (byte 4 12))
     1748    (destructuring-bind (marker offform) offset
     1749      (unless (eq marker :$) (error "Bad FP offset: ~s" offset))
     1750      (let* ((offval (vinsn-arg-or-constant avi offform vinsn-params (encode-vinsn-field-type :fpaddr-offset) nil)))
     1751        (when offval
     1752          (if (< offval 0)
     1753            (setq offval (- offval))
     1754            (set-avi-opcode-field avi (byte 1 23) 1))
     1755          (when (logtest 3 offval)
     1756            (error "Memory offset ~s must be a multiple of 4." offval))
     1757          (set-avi-opcode-field avi (byte 8 0) (ash offval -2)))))))
    17001758
    17011759(defun vinsn-simplify-instruction (form vinsn-params)
     
    17731831    vinsn-insert-dn-operand
    17741832    vinsn-insert-sn-operand
     1833    vinsn-insert-fpaddr-offset-operand
    17751834    ))
    17761835
     
    18421901
    18431902(defun vinsn-insert-subprim-operand (instruction value)
    1844   )
     1903  (insert-shifter-constant value instruction))
    18451904
    18461905(defun vinsn-insert-data-label-operand (instruction value)
     
    18571916
    18581917(defun vinsn-insert-sd-operand (instruction value)
    1859   )
     1918  (set-field-value instruction (byte 4 12) (ash value -1))
     1919  (set-field-value instruction (byte 1 22) (logand value 1)))
    18601920
    18611921(defun vinsn-insert-sm-operand (instruction value)
    1862   )
     1922  (set-field-value instruction (byte 4 0) (ash value -1))
     1923  (set-field-value instruction (byte 1 5) (logand value 1)))
    18631924
    18641925(defun vinsn-insert-dn-operand (instruction value)
     
    18661927
    18671928(defun vinsn-insert-sn-operand (instruction value)
    1868   )
    1869    
     1929  (set-field-value instruction (byte 4 16) (ash value -1))
     1930  (set-field-value instruction (byte 1 7) (logand value 1)))
     1931
     1932(defun vinsn-insert-fpaddr-offset-operand (instruction value)
     1933  (if (< value 0)
     1934    (setq value (- value))
     1935    (set-field-value instruction (byte 1 23) value))
     1936  (set-field-value instruction (byte 8 0) (ash value -2)))
     1937
    18701938
    18711939
  • branches/arm/compiler/ARM/arm-vinsns.lisp

    r13763 r13780  
    6565  (add dest dest (:$ arm::misc-dfloat-offset)))
    6666
    67 #+notyet
     67
    6868(define-arm-vinsn scale-1bit-misc-index (((word-index :u32)
    6969                                          (bitnum :u8)) ; (unsigned-byte 5)
     
    7171                                          )
    7272                                         )
    73   ;; Logically, we want to:
    74   ;; 1) Unbox the index by shifting it right 2 bits.
    75   ;; 2) Shift (1) right 5 bits
    76   ;; 3) Scale (2) by shifting it left 2 bits.
    77   ;; We get to do all of this with one instruction
    78   (rlwinm word-index idx (- arm::nbits-in-word 5) 5 (- arm::least-significant-bit arm::fixnum-shift))
    79   (addi word-index word-index arm::misc-data-offset) ; Hmmm. Also one instruction, but less impressive somehow.
    80   (extrwi bitnum idx 5 (- arm::nbits-in-word (+ arm::fixnum-shift 5))))
     73  (mov word-index (:lsr idx (:$ arm::fixnumshift)))
     74  (and bitnum word-index (:$ 31))
     75  (mov word-index (:lsr word-index (:$ 5)))
     76  (add word-index word-index (:$ arm::misc-data-offset)))
    8177
    8278
     
    11521148  (uuo-error-reg-not-xtype (:? hi) src (:$ arm::xtype-bit)))
    11531149
    1154 #+later
    1155 (define-arm-vinsn unbox-bit-bit0 (((dest :u32))
    1156                                   ((src :lisp))
    1157                                   ((crf :crf)))
    1158   (cmplwi crf src (ash 1 arm::fixnumshift))
    1159   (rlwinm dest src (- 32 (1+ arm::fixnumshift)) 0 0)
    1160   (ble+ crf :got-it)
    1161   (uuo_interr arch::error-object-not-bit src)
    1162   :got-it)
     1150
    11631151
    11641152(define-arm-vinsn fixnum->double (((dest :double-float))
     
    11781166
    11791167
    1180 (define-arm-vinsn shift-right-variable-word (((dest :u32))
    1181                                              ((src :u32)
    1182                                               (sh :u32)))
    1183   (mov dest (:lsr src sh)))
     1168(define-arm-vinsn shift-left-variable-word (((dest :u32))
     1169                                            ((src :u32)
     1170                                             (sh :u32)))
     1171  (mov dest (:lsl src sh)))
    11841172
    11851173(define-arm-vinsn u32logandc2 (((dest :u32))
     
    11921180                              (y :u32)))
    11931181  (orr dest x y))
     1182
     1183(define-arm-vinsn set-or-clear-bit (((dest :u32))
     1184                                    ((src :u32)
     1185                                     (mask :u32)
     1186                                     (crf :crf)))
     1187  (bicne dest src mask)
     1188  (orreq dest src mask))
    11941189
    11951190(define-arm-vinsn complement-shift-count (((dest :u32))
     
    13151310  (extrwi dest dest 1 0))
    13161311
    1317 #+later
    1318 (define-arm-vinsn extract-variable-bit-fixnum (((dest :imm))
     1312
     1313(define-arm-vinsn extract-variable-bit-fixnum (((dest :lisp))
    13191314                                               ((src :u32)
    13201315                                                (bitnum :u8))
    13211316                                               ((temp :u32)))
    1322   (rotlw temp src bitnum)
    1323   (rlwinm dest
    1324           temp
    1325           (1+ arm::fixnumshift)
    1326           (- arm::least-significant-bit arm::fixnumshift)
    1327           (- arm::least-significant-bit arm::fixnumshift)))
     1317  (mov temp (:lsr src bitnum))
     1318  (mov dest (:$ arm::fixnumone))
     1319  (and dest dest (:lsl temp (:$ arm::fixnumshift))))
    13281320
    13291321
     
    13431335  (cmp arg0 (:$ arm::nil-value)))
    13441336
    1345 (define-arm-vinsn compare-logical (
     1337(define-arm-vinsn compare-logical (((crf :crf))
    13461338                                   ((arg0 t)
    13471339                                    (arg1 t))
    13481340                                   ())
    13491341  (cmp  arg0 arg1))
     1342
     1343(define-arm-vinsn compare-immediate (((crf :crf))
     1344                                     ((arg t)
     1345                                      (imm :u32const)))
     1346  (cmp arg (:$ imm)))
    13501347
    13511348(define-arm-vinsn double-float-compare (()
     
    14081405  (cmp arg0 arg1))
    14091406
    1410 (define-arm-vinsn compare-signed-s16const (((crf :crf))
    1411                                            ((arg0 :imm)
    1412                                             (imm :s16const))
    1413                                            ())
    1414   (cmp arg0 (:$ imm)))
    1415 
    1416 (define-arm-vinsn compare-unsigned-u16const (()
    1417                                              ((arg0 :u32)
    1418                                               (imm :u16const))
    1419                                              ())
    1420   (cmp arg0 (:$ imm)))
     1407
    14211408
    14221409
     
    14321419
    14331420
    1434 #+later
     1421
    14351422(define-arm-vinsn set-constant-arm-bit-to-variable-value (((dest :u32))
    14361423                                                          ((src :u32)
    14371424                                                           (bitval :u32) ; 0 or 1
    14381425                                                           (bitnum :u8const)))
    1439   (rlwimi dest bitval (:apply - 32 bitnum) bitnum bitnum))
    1440 
    1441 #+later
     1426  (cmp bitval (:$ 0))
     1427  (biceq dest src (:$ (:apply ash 1 bitnum)))
     1428  (orrne dest src (:$ (:apply ash 1 bitnum))))
     1429
    14421430(define-arm-vinsn set-constant-arm-bit-to-1 (((dest :u32))
    14431431                                             ((src :u32)
    14441432                                              (bitnum :u8const)))
    1445   ((:pred < bitnum 16)
    1446    (oris dest src (:apply ash #x8000 (:apply - bitnum))))
    1447   ((:pred >= bitnum 16)
    1448    (ori dest src (:apply ash #x8000 (:apply - (:apply - bitnum 16))))))
    1449 
    1450 #+later
     1433  (orr dest src (:$ (:apply ash 1 bitnum))))
     1434
     1435
    14511436(define-arm-vinsn set-constant-arm-bit-to-0 (((dest :u32))
    14521437                                             ((src :u32)
    14531438                                              (bitnum :u8const)))
    1454   (rlwinm dest src 0 (:apply logand #x1f (:apply 1+ bitnum)) (:apply logand #x1f (:apply 1- bitnum))))
     1439  (bic dest src (:$ (:apply ash 1 bitnum))))
    14551440
    14561441
     
    16231608  ((:pred <
    16241609          (:apply %hard-regspec-value cdr)
    1625           (:apply %hard-regpsec-value car))
     1610          (:apply %hard-regspec-value car))
    16261611   (stmdb (:! sp) (car cdr zero header)))
    16271612  ((:not (:pred <
    16281613                (:apply %hard-regspec-value cdr)
    1629                 (:apply %hard-regpsec-value car)))
     1614                (:apply %hard-regspec-value car)))
    16301615   (stmdb (:! sp) (cdr car zero header))
    16311616   (str car (:@ sp (:$ 12)))
     
    17521737
    17531738
    1754 (define-arm-vinsn alloc-c-frame (()
    1755                                  ((n-c-args :u16const))
    1756                                  ((header :u32)
    1757                                   (size :imm)
    1758                                   (prevsp :imm)))
     1739(define-arm-vinsn alloc-eabi-c-frame (()
     1740                                      ((n-c-args :u16const))
     1741                                      ((header :u32)
     1742                                       (size :imm)
     1743                                       (prevsp :imm)))
    17591744  (mov header (:$ (:apply ash (:apply + 1 (:apply logandc2 (:apply + 4 1 n-c-args) 1)) arm::num-subtag-bits)))
    17601745  (mov size (:lsr header (:$ (- arm::num-subtag-bits arm::word-shift))))
     
    17931778
    17941779
    1795 (define-arm-vinsn set-c-arg (()
     1780(define-arm-vinsn set-eabi-c-arg (()
    17961781                             ((argval :u32)
    17971782                              (argnum :u16const)))
    17981783  (str argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    17991784
    1800 #+notyet
    1801 (define-arm-vinsn set-single-c-arg (()
     1785(define-arm-vinsn set-eabi-single-c-arg (()
    18021786                                    ((argval :single-float)
    18031787                                     (argnum :u16const)))
    18041788  (fsts argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    18051789
    1806 #+notyet
    1807 (define-arm-vinsn set-double-c-arg (()
    1808                                     ((argval :double-float)
    1809                                      (argnum :u16const)))
     1790(define-arm-vinsn set-eabi-double-c-arg (()
     1791                                         ((argval :double-float)
     1792                                          (argnum :u16const)))
    18101793  (fstd argval (:@ sp (:$ (:apply + arm::dnode-size (:apply ash argnum arm::word-shift))))))
    18111794
     
    18751858  (bic allocptr allocptr (:$ arm::fulltagmask))
    18761859  ((:not (:pred = nbytes 0))
    1877    (mov immtemp0 (:$ (:apply + arm::misc-data-offset nbytes)))
     1860   (mov immtemp0 (:$ (:apply logand #xff (:apply + arm::misc-data-offset nbytes))))
     1861   ((:not (:pred = (:apply logand #xff00 (:apply + arm::misc-data-offset nbytes)) 0))
     1862    (orr immtemp0 immtemp0 (:$ (:apply logand #xff00 (:apply + arm::misc-data-offset nbytes)))))
    18781863   :loop
    18791864   (sub immtemp0 immtemp0 (:$ 4))
     
    22962281                                (imm :u32const)))
    22972282  (orr dest src (:$ imm)))
    2298 
    2299 
    23002283
    23012284                           
     
    31153098
    31163099
    3117 #+notyet
    31183100(define-arm-vinsn eep.address (((dest t))
    31193101                               ((src (:lisp (:ne dest )))))
    31203102  (ldr dest (:@ src (:$ (+ (ash 1 2) arm::misc-data-offset))))
    3121   (tweqi dest (:apply target-nil-value)))
     3103  (cmp dest (:$ arm::nil-value))
     3104  (uuo-eep-unresolved (:? eq) src dest))
    31223105                 
    31233106(define-arm-vinsn %natural+ (((dest :u32))
     
    31623145  (and dest x (:$ c)))
    31633146
     3147(define-arm-vinsn %ilogbitp-constant-bit (((dest :crf))
     3148                                          ((fixnum :imm)
     3149                                           (bitnum :u8const)))
     3150  (tst fixnum (:$ (:apply ash 1 (:apply + bitnum arm::fixnumshift)))))
     3151
     3152(define-arm-vinsn %ilogbitp-variable-bit (((dest :crf))
     3153                                          ((fixnum :imm)
     3154                                           (bitnum :u8))
     3155                                          ((mask :imm)
     3156                                           (unboxed :u8)))
     3157  (mov unboxed (:asr bitnum (:$ arm::fixnumshift)))
     3158  (mov mask (:$ arm::fixnumone))
     3159  (tst fixnum (:lsl mask unboxed)))
    31643160
    31653161
     
    34313427(define-arm-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
    34323428
    3433 #+notyet
     3429(define-arm-subprim-call-vinsn (eabi-ff-call) .SPeabi-ff-call)
     3430
    34343431(define-arm-vinsn unbind-interrupt-level-inline (()
    34353432                                                 ()
    34363433                                                 ((tlb :imm)
    34373434                                                  (link :imm)
    3438                                                   (value :imm)
    3439                                                   (save-nargs :u32)
    3440                                                   (crf0 :crf)
    3441                                                   (crf1 :crf)))
     3435                                                  (saved-value :imm)
     3436                                                  (restored-value :imm)))
    34423437  (ldr tlb (:@ rcontext (:$ arm::tcr.tlb-pointer)))
    3443   (ldr value (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3438  (ldr saved-value (:@ tlb (:$ arm::interrupt-level-binding-index)))
    34443439  (ldr link (:@ rcontext (:$ arm::tcr.db-link)))
    3445   (cmpwi crf1 value 0)
    3446   (ldr value (:@ link (:$ 8)))
     3440  (ldr restored-value (:@ link (:$ 8)))
    34473441  (ldr link (:@ link (:$ 0)))
    3448   (cmpwi crf0 value 0)
    3449   (str value (:@ tlb (:$ arm::interrupt-level-binding-index)))
     3442  (cmp restored-value (:$ 0))
     3443  (str restored-value (:@ tlb (:$ arm::interrupt-level-binding-index)))
    34503444  (str link (:@ rcontext (:$ arm::tcr.db-link)))
    3451   (bge crf1 :done)
    3452   (blt crf0 :done)
    3453   (mr save-nargs nargs)
    3454   (ldr nargs (:@ rcontext (:$ arm::tcr.interrupt-pending)))
    3455   (twgti nargs 0)
    3456   (mr nargs save-nargs)
     3445  (blt :done)
     3446  (cmp saved-value (:$ 0))
     3447  (bge :done)
     3448  (ldr link (:@ rcontext (:$ arm::tcr.interrupt-pending)))
     3449  (cmp link (:$ 0))
     3450  (uuo-interrupt-now (:? ne))
    34573451  :done)
    34583452 
  • branches/arm/compiler/ARM/arm2.lisp

    r13763 r13780  
    293293        (arm2-do-lexical-setq seg nil ea result)))))
    294294
    295 (defun arm2-reverse-cc (cc)
    296   ;                NE  NE  EQ  EQ   LE   GE   LT   GT   GE   LE   GT   LT    MI   PL   PL   MI
    297   (%cdr (assq cc '((6 . 6) (7 . 7) (15 . 12) (13 . 14) (12 . 15) (14 . 13)  (11 . 10) (10 . 11)))))
    298 
    299   ;                NE  NE  EQ  EQ   LE   GE   LT   GT   GE   LE   GT   LT    MI   PL   PL   MI
    300 (defun arm2-reverse-condition-keyword (k)
    301   (cdr (assq k '((:ne . :ne) (:eq . :eq) (:le . :ge) (:lt . :gt) (:ge . :le) (:gt . :lt)))))
     295
    302296
    303297
     
    316310    (:GE (values arm::arm-cond-ge t))))
    317311
    318 (defun acode-condition-to-arm-unsigned-cr-bit (cond)
    319   (condition-to-arm-unsigned-cr-bit cond))
    320 
    321 (defun condition-to-arm-unsigned-cr-bit (cond)
    322   (case cond
    323     (:EQ (values arm::arm-cond-eq t))
    324     (:NE (values arm::arm-cond-ne t))
    325     (:GT (values arm::arm-cond-hi t))
    326     (:LE (values arm::arm-cond-ls t))
    327     (:LT (values arm::arm-cond-lo t))
    328     (:GE (values arm::arm-cond-hs t))))
     312
     313(defun arm-cr-bit-to-arm-unsigned-cr-bit (cr-bit)
     314  (case cr-bit
     315    (#.arm::arm-cond-eq arm::arm-cond-eq)
     316    (#.arm::arm-cond-ne arm::arm-cond-ne)
     317    (#.arm::arm-cond-gt arm::arm-cond-hi)
     318    (#.arm::arm-cond-le arm::arm-cond-ls)
     319    (#.arm::arm-cond-lt arm::arm-cond-lo)
     320    (#.arm::arm-cond-ge arm::arm-cond-hs)))
    329321
    330322
     
    15011493             (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    15021494               (! misc-ref-c-bit-fixnum target src index-known-fixnum)
    1503                (with-imm-temps
    1504                    () (word-index bitnum dest)
     1495               (with-imm-temps () (word-index bitnum)
    15051496                 (if index-known-fixnum
    15061497                   (progn
     
    15081499                     (arm2-lri seg bitnum (logand index-known-fixnum #x1f)))
    15091500                   (! scale-1bit-misc-index word-index bitnum unscaled-idx))
    1510                  (! misc-ref-u32 dest src word-index)
    1511                  (! extract-variable-bit-fixnum target dest bitnum))))))))
     1501                 (let* ((dest word-index))
     1502                   (! misc-ref-u32 dest src word-index)
     1503                   (! extract-variable-bit-fixnum target dest bitnum)))))))))
    15121504    (^)))
    15131505             
     
    19781970                 (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-u8)))
    19791971                   (unless (typep constval 'bit)
    1980                      (! unbox-bit-bit0 reg result-reg))
     1972                     (! unbox-bit reg result-reg))
    19811973                   reg)))))))
    19821974                   
     
    20962088                          (! set-constant-arm-bit-to-variable-value word word unboxed-val-reg bit-number))
    20972089                        (! misc-set-c-u32 word src word-index)))
    2098                     (with-imm-temps (unboxed-val-reg) (word-index bit-number temp)
     2090                    (with-crf-target () crf
     2091                    (with-imm-temps () (word-index bit-number temp)
     2092                      (unless constval
     2093                        (! compare-immediate crf unboxed-val-reg 0))
    20992094                      (! scale-1bit-misc-index word-index bit-number unscaled-idx)
     2095                      (! lri temp 1)
     2096                      (! shift-left-variable-word bit-number temp bit-number)
     2097                      (! misc-ref-u32 temp src word-index)
    21002098                      (if constval
     2099                        (if (zerop constval)
     2100                          (! u32logandc2 temp temp bit-number)
     2101                          (! u32logior temp temp bit-number))
    21012102                        (progn
    2102                           (! lri temp #x80000000)
    2103                           (! shift-right-variable-word bit-number temp bit-number)
    2104                           (! misc-ref-u32 temp src word-index)
    2105                           (if (zerop constval)
    2106                             (! u32logandc2 temp temp bit-number)
    2107                             (! u32logior temp temp bit-number)))
    2108                         (with-imm-temps () (bitval)
    2109                           (! shift-right-variable-word bitval unboxed-val-reg bit-number)
    2110                           (! lri temp #x80000000)
    2111                           (! shift-right-variable-word bit-number temp bit-number)
    2112                           (! misc-ref-u32 temp src word-index)
    2113                           (! u32logandc2 temp temp bit-number)
    2114                           (! u32logior temp temp bitval)))
    2115                       (! misc-set-u32 temp src word-index))))))))
     2103                          (! set-or-clear-bit temp temp bit-number crf)))
     2104                      (! misc-set-u32 temp src word-index)))))))))
    21162105      (when (and vreg val-reg) (<- val-reg))
    2117       (^))))
     2106    (^))))
    21182107                   
    21192108
     
    23372326        (unless (or immp symp lfunp (typep fn 'lreg) (fixnump fn)) (compiler-bug "Well, well, well.  How could this have happened ?"))
    23382327        (when a-reg
    2339           (arm2-copy-register seg destreg a-reg))
    2340         (unless spread-p
    2341           (unless alternate-tail-call
    2342             (if nargs
    2343               (arm2-restore-nvrs seg *arm2-register-restore-ea* *arm2-register-restore-count*)
    2344               (when *arm2-register-restore-count*
    2345                 (with-imm-temps () (vsp0)
    2346                   (! fixnum-add vsp0 arm::vsp arm::nargs)
    2347                   (arm2-restore-nvrs seg *arm2-register-restore-ea* *arm2-register-restore-count* vsp0)))))))
     2328          (arm2-copy-register seg destreg a-reg)))
    23482329      (if spread-p
    23492330        (progn
    23502331          (arm2-set-nargs seg (%i- nargs 1))
    2351           (when (and tail-p *arm2-register-restore-count*)
    2352             (! copy-gpr arm::temp1 arm::vsp)) ; .SPspread-lexpr-z & .SPspreadargz preserve temp1
    23532332          (if (eq spread-p 0)
    23542333            (! spread-lexpr)
    2355             (! spread-list))
    2356           (when (and tail-p *arm2-register-restore-count*)
    2357             (arm2-restore-nvrs seg *arm2-register-restore-ea* *arm2-register-restore-count* arm::temp1)))
     2334            (! spread-list)))
    23582335        (if nargs
    23592336          (unless alternate-tail-call (arm2-set-nargs seg nargs))
     
    30753052  arglist)
    30763053
     3054(defun arm2-constant-for-compare-p (form)
     3055  (setq form (acode-unwrapped-form form))
     3056  (when (acode-p form)
     3057    (let* ((op (acode-operator form)))
     3058      (if (eql op (%nx1-operator fixnum))
     3059        (let* ((val (ash (cadr form) arm::fixnumshift)))
     3060          (if (arm::encode-arm-immediate val)
     3061            (logand val #xffffffff)
     3062            (if (arm::encode-arm-immediate (lognot val))
     3063              (logand (lognot val) #xffffffff))))
     3064        (if (eql op (%nx1-operator %unbound-marker))
     3065          arm::unbound-marker
     3066          (if (eql op (%nx1-operator %slot-unbound-marker))
     3067            arm::slot-unbound-marker))))))
    30773068
    30783069
     
    30803071(defun arm2-compare (seg vreg xfer i j cr-bit true-p)
    30813072  (with-arm-local-vinsn-macros (seg vreg xfer)
    3082     (let* ((js16 (acode-s16-constant-p j))
    3083            (is16 (acode-s16-constant-p i))
     3073    (let* ((jconst (arm2-constant-for-compare-p j))
     3074           (iconst (arm2-constant-for-compare-p i))
    30843075           (boolean (backend-crf-p vreg)))
    3085       (if (and boolean (or js16 is16))
    3086         (let* ((reg (arm2-one-untargeted-reg-form seg (if js16 i j) arm::arg_z)))
    3087           (! compare-signed-s16const vreg reg (or js16 is16))
    3088           (unless (or js16 (eq cr-bit arm::arm-cond-eq))
    3089             (setq cr-bit (- 1 cr-bit)))
     3076      (if (and boolean (or iconst jconst))
     3077        (let* ((reg (arm2-one-untargeted-reg-form seg (if jconst i j) arm::arg_z)))
     3078          (! compare-immediate vreg reg (or jconst iconst))
     3079          (unless (or jconst (eq cr-bit arm::arm-cond-eq))
     3080            (setq cr-bit (logxor cr-bit 1)))
    30903081          (^ cr-bit true-p))
    30913082        (if (and (eq cr-bit arm::arm-cond-eq)
    3092                  (or js16 is16))
     3083                 (or jconst iconst))
    30933084          (arm2-test-reg-%izerop
    30943085           seg
     
    30973088           (arm2-one-untargeted-reg-form
    30983089            seg
    3099             (if js16 i j)
     3090            (if jconst i j)
    31003091            arm::arg_z)
    31013092           cr-bit
    31023093           true-p
    3103            (or js16 is16))
     3094           (or jconst iconst))
    31043095          (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i arm::arg_y j arm::arg_z)
    31053096            (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))
    31063097
    3107 (defun arm2-natural-compare (seg vreg xfer i j cr-bit true-p)
    3108   (with-arm-local-vinsn-macros (seg vreg xfer)
    3109     (let* ((jconstant (acode-fixnum-form-p j))
    3110            (ju16 (typep jconstant '(unsigned-byte 16)))
    3111            (iconstant (acode-fixnum-form-p i))
    3112            (iu16 (typep iconstant '(unsigned-byte 16)))
    3113            (boolean (backend-crf-p vreg)))
    3114       (if (and boolean (or ju16 iu16))
    3115         (with-imm-target
    3116             () (reg :natural)
    3117             (arm2-one-targeted-reg-form seg (if ju16 i j) reg)
    3118             (! compare-unsigned-u16const vreg reg (if ju16 jconstant iconstant))
    3119             (unless (or ju16 (eq cr-bit arm::arm-cond-eq))
    3120               (setq cr-bit (- 1 cr-bit)))
    3121             (^ cr-bit true-p))
    3122         (with-imm-target ()
    3123           (ireg :natural)
    3124             (with-imm-target
    3125                 (ireg) (jreg :natural)
    3126                 (arm2-two-targeted-reg-forms seg i ireg j jreg)
    3127                 (arm2-compare-natural-registers seg vreg xfer ireg jreg cr-bit true-p)))))))
    3128 
    3129 (defun arm2-compare-natural-registers (seg vreg xfer ireg jreg cr-bit true-p)
    3130   (with-arm-local-vinsn-macros (seg vreg xfer)
    3131     (if vreg
    3132       (regspec-crf-gpr-case
    3133        (vreg dest)
    3134        (progn
    3135          (! compare-logical dest ireg jreg)
    3136          (^ cr-bit true-p))
    3137        (with-imm-temps () ((b31-reg :natural))
    3138          (ecase cr-bit
    3139            (#. arm::arm-cond-eq
    3140             (if true-p
    3141               (! eq->bit31 b31-reg ireg jreg)
    3142               (! ne->bit31 b31-reg ireg jreg)))
    3143            (#. arm::arm-cond-lt
    3144             (if true-p
    3145               (! ltu->bit31 b31-reg ireg jreg)
    3146               (! geu->bit31 b31-reg ireg jreg)))
    3147            (#. arm::arm-cond-gt
    3148             (if true-p
    3149               (! gtu->bit31 b31-reg ireg jreg)
    3150               (! leu->bit31 b31-reg ireg jreg))))
    3151          (ensuring-node-target (target dest)
    3152            (! lowbit->truth target b31-reg))
    3153          (^)))
    3154       (^))))
     3098
    31553099
    31563100(defun arm2-compare-registers (seg vreg xfer ireg jreg cr-bit true-p)
     
    31643108       (with-crf-target () crf
    31653109         (! compare crf ireg jreg)
    3166          (! cond->boolean target (if true-p cr-bit (logxor cr-bit 1)))
     3110         (ensuring-node-target (target vreg)
     3111           (! cond->boolean target (if true-p cr-bit (logxor cr-bit 1))))
    31673112         (^)))
    31683113      (^))))
     
    32213166       (if (or (arm::encode-arm-immediate zero)
    32223167               (arm::encode-arm-immediate (lognot zero)))
    3223          (! compare-signed-s16const dest reg zero)
     3168         (! compare-immediate dest reg zero)
    32243169         (with-node-target (reg) other
    32253170           (arm2-lri seg other zero)
     
    32293174       (if (or (arm::encode-arm-immediate zero)
    32303175               (arm::encode-arm-immediate (lognot zero)))
    3231          (! compare-signed-s16const crf reg zero)
     3176         (! compare-immediate crf reg (logand #xffffffff zero))
    32323177         (with-node-target (reg) other
    32333178           (arm2-lri seg other zero)
     
    34613406                   (arm2-two-targeted-reg-forms seg (%cadr form) y (%caddr form) z)
    34623407                   (arm2-open-undo $undostkblk )
    3463                    (! make-tsp-cons result y z)
     3408                   (! make-stack-cons result y z)
    34643409                   (setq val result)))
    34653410                ((eq op (%nx1-operator %consmacptr%))
     
    35883533                        (if closed-downward
    35893534                          (progn
    3590                             (! make-tsp-vcell vcell closed)
     3535                            (! make-stack-vcell vcell closed)
    35913536                            (arm2-open-undo $undostkblk))
    35923537                          (! make-vcell vcell closed))
     
    36183563            (if closed-downward
    36193564              (progn
    3620                 (! make-tsp-vcell vcell closed)
     3565                (! make-stack-vcell vcell closed)
    36213566                (arm2-open-undo $undostkblk))
    36223567              (! make-vcell vcell closed))
     
    44654410  (let* ((*arm2-vstack* *arm2-vstack*)
    44664411         (*arm2-top-vstack-lcell* *arm2-top-vstack-lcell*)
    4467          (mask *arm2-register-restore-count*)
    4468          (ea *arm2-register-restore-ea*)
    44694412         (label nil)
    44704413         (vstack nil)
    44714414         (foldp (not *arm2-open-code-inline*)))
    4472     (if (%izerop mask) (setq mask nil))
    44734415    (with-arm-local-vinsn-macros (seg)
    44744416      (progn
    44754417        (setq vstack (arm2-set-vstack (arm2-unwind-stack seg $backend-return 0 0 #x7fffff)))
    44764418        (if *arm2-returning-values*
    4477           (cond ((and mask foldp (setq label (%cdr (assq vstack *arm2-valret-labels*))))
     4419          (cond ((and foldp (setq label (%cdr (assq vstack *arm2-valret-labels*))))
    44784420                 (-> label))
    44794421                (t
    44804422                 (@ (setq label (backend-get-next-label)))
    44814423                 (push (cons vstack label) *arm2-valret-labels*)
    4482                  (when mask
    4483                    (with-imm-temps () (vsp0)
    4484                      (! fixnum-add vsp0 arm::vsp arm::nargs)
    4485                      (arm2-restore-nvrs seg ea mask vsp0)))
     4424
    44864425                 (! nvalret)))
    4487           (if (null mask)
    4488             (if *arm2-open-code-inline*
    4489               (progn
    4490                 (! restore-full-lisp-context)
    4491                 (! jump-return-pc))
    4492               (! popj))
    4493             (if (and foldp (setq label (assq *arm2-vstack* *arm2-popreg-labels*)))
    4494               (-> (cdr label))
    4495               (let* ((new-label (backend-get-next-label)))
    4496                 (@ new-label)
    4497                 (push (cons *arm2-vstack* new-label) *arm2-popreg-labels*)
    4498                 (arm2-set-vstack (arm2-restore-nvrs seg ea mask))
    4499                 (if *arm2-open-code-inline*
    4500                   (progn
    4501                     (! restore-full-lisp-context)
    4502                     (! jump-return-pc))
    4503                   (! popj))))))))
     4426          (! popj))))
    45044427    nil))
    45054428
     
    49354858          (return (+ base (ash (- idx low) shift))))))))
    49364859
    4937 (defun arm2-fixed-call-builtin (seg vreg xfer name subprim)
     4860(defun arm2-fixed-call-builtin (seg vreg xfer name)
    49384861  (with-arm-local-vinsn-macros (seg vreg xfer)
    49394862    (let* ((index (arch::builtin-function-name-offset name))
    4940            (idx-subprim (if index (arm2-builtin-index-subprim index)))
     4863           (subprim (if index
     4864                      (arm2-builtin-index-subprim index)
     4865                      (or (arm::arm-subprimitive-address name)
     4866                          (compiler-bug "Unknown builtin subprim index for ~s" name))))
    49414867           (tail-p (arm2-tailcallok xfer)))
    49424868      (when tail-p
    4943         (arm2-restore-nvrs seg *arm2-register-restore-ea* *arm2-register-restore-count*)
    49444869        (arm2-restore-full-lisp-context seg))
    4945       (if idx-subprim
    4946         (setq subprim idx-subprim)
    4947         (if index (! lri ($ arm::imm0) (ash index *arm2-target-fixnum-shift*))))
    49484870      (if tail-p
    49494871        (! jump-subprim subprim)
     
    49564878  (with-arm-local-vinsn-macros (seg)
    49574879    (arm2-one-targeted-reg-form seg form ($ arm::arg_z))
    4958     (arm2-fixed-call-builtin seg vreg xfer name (subprim-name->offset '.SPcallbuiltin1))))
     4880    (arm2-fixed-call-builtin seg vreg xfer name)))
    49594881
    49604882(defun arm2-binary-builtin (seg vreg xfer name form1 form2)
    49614883  (with-arm-local-vinsn-macros (seg)
    49624884    (arm2-two-targeted-reg-forms seg form1 ($ arm::arg_y) form2 ($ arm::arg_z))
    4963     (arm2-fixed-call-builtin seg vreg xfer name (subprim-name->offset '.SPcallbuiltin2))))
     4885    (arm2-fixed-call-builtin seg vreg xfer name)))
    49644886
    49654887(defun arm2-ternary-builtin (seg vreg xfer name form1 form2 form3)
    49664888  (with-arm-local-vinsn-macros (seg)
    49674889    (arm2-three-targeted-reg-forms seg form1 ($ arm::arg_x) form2 ($ arm::arg_y) form3 ($ arm::arg_z))
    4968     (arm2-fixed-call-builtin seg vreg xfer name (subprim-name->offset '.SPcallbuiltin3))))
     4890    (arm2-fixed-call-builtin seg vreg xfer name)))
    49694891
    49704892
     
    53665288          (when vreg
    53675289            (ensuring-node-target (target vreg)
    5368               (! logior-immediate target other-reg unboxed-fixval))))
     5290              (! logior-immediate target other-reg (logand #xffffffff unboxed-fixval)))))
    53695291        (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
    53705292          (if vreg (ensuring-node-target (target vreg) (! %logior2 target r1 r2)))))   
     
    53895311            (when vreg
    53905312              (ensuring-node-target (target vreg)
    5391                 (! logand-immediate target other-reg unboxed-fixval))))
     5313                (! logand-immediate target other-reg (logand #xffffffff unboxed-fixval)))))
    53925314            (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
    53935315              (if vreg (ensuring-node-target (target vreg) (! %logand2 target r1 r2)))))
     
    54015323    (let* ((fixval (or fix1 fix2))
    54025324           (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
    5403            (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
    5404            (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
    5405            (otherform (if (or high low) (if fix1 form2 form1))))
     5325           (ok-imm (if unboxed-fixval (arm::encode-arm-immediate unboxed-fixval)))
     5326           (otherform (if ok-imm (if fix1 form2 form1))))
    54065327      (if otherform
    54075328        (let* ((other-reg (arm2-one-untargeted-reg-form seg otherform arm::arg_z)))
    54085329          (when vreg
    5409             (ensuring-node-target (target vreg)
    5410               (if high
    5411                 (! logxor-high target other-reg high)
    5412                 (! logxor-low target other-reg low)))))
     5330            (ensuring-node-target (target vreg)
     5331              (! logxor-immediate target other-reg (logand unboxed-fixval #xffffffff)))))
    54135332        (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg form1 arm::arg_y form2 arm::arg_z)
    54145333          (if vreg (ensuring-node-target (target vreg) (! %logxor2 vreg r1 r2)))))
     
    56705589                (! branch-unless-arg-fixnum ($ arm::arg_y) (aref *backend-labels* out-of-line)) 
    56715590                (! branch-unless-both-args-fixnums ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* out-of-line)))))
    5672           (with-imm-target () (b31-reg :natural)
    5673             (if otherform
    5674               (if true-p
    5675                 (! eq0->bit31 b31-reg ($ arm::arg_z))
    5676                 (! ne0->bit31 b31-reg ($ arm::arg_z)))
    5677               (ecase cr-bit
    5678                 (#. arm::arm-cond-eq
    5679                     (if true-p
    5680                       (! eq->bit31 b31-reg ($ arm::arg_y) ($ arm::arg_z))
    5681                       (! ne->bit31 b31-reg ($ arm::arg_y) ($ arm::arg_z))))
    5682                 (#. arm::arm-cond-lt
    5683                     (if true-p
    5684                       (! lt->bit31 b31-reg ($ arm::arg_y) ($ arm::arg_z))
    5685                       (! ge->bit31 b31-reg ($ arm::arg_y) ($ arm::arg_z))))
    5686                 (#. arm::arm-cond-gt
    5687                     (if true-p
    5688                       (! gt->bit31 b31-reg ($ arm::arg_y) ($ arm::arg_z))
    5689                       (! le->bit31 b31-reg ($ arm::arg_y) ($ arm::arg_z))))))
    5690             (! lowbit->truth ($ arm::arg_z) b31-reg)
    5691             (-> done)
    5692             (@ out-of-line)
    5693             (if otherform
    5694               (arm2-lri seg ($ arm::arg_y) 0))
    5695             (let* ((index (arch::builtin-function-name-offset name))
    5696                    (idx-subprim (arm2-builtin-index-subprim index)))
    5697               (! call-subprim-2 ($ arm::arg_z) idx-subprim ($ arm::arg_y) ($ arm::arg_z)))
    5698             (@ done)
    5699             (<- ($ arm::arg_z))
    5700             (^)))))))
     5591          (with-crf-target () crf
     5592          (if otherform
     5593            (! compare-immediate crf ($ arm::arg_z) 0)
     5594            (! compare crf ($ arm::arg_y) ($ arm::arg_z)))
     5595          (! cond->boolean ($ arm::arg_z) (if true-p cr-bit (logxor cr-bit 1))))
     5596          (-> done)
     5597          (@ out-of-line)
     5598          (if otherform
     5599            (arm2-lri seg ($ arm::arg_y) 0))
     5600          (let* ((index (arch::builtin-function-name-offset name))
     5601                 (idx-subprim (arm2-builtin-index-subprim index)))
     5602            (! call-subprim-2 ($ arm::arg_z) idx-subprim ($ arm::arg_y) ($ arm::arg_z)))
     5603          (@ done)
     5604          (<- ($ arm::arg_z))
     5605          (^))))))
    57015606   
    57025607(defarm2 arm2-%word-to-int %word-to-int (seg vreg xfer form)
     
    57775682        (if fixbit
    57785683          (let* ((reg (arm2-one-untargeted-reg-form seg form arm::arg_z))
    5779                  (arm-bit (- (1- *arm2-target-bits-in-word*) (max (min (+ fixbit *arm2-target-fixnum-shift*) (1- *arm2-target-bits-in-word*)) *arm2-target-fixnum-shift*))))
    5780             (with-imm-temps () (bitreg)
    5781               (! extract-constant-arm-bit bitreg reg arm-bit)
    5782               (regspec-crf-gpr-case
     5684                 (arm-bit (min (- arm::nbits-in-word arm::fixnumshift)
     5685                               (max fixbit 0))))
     5686            (regspec-crf-gpr-case
     5687             (vreg dest)
     5688             (progn
     5689               (! %ilogbitp-constant-bit dest reg arm-bit)
     5690               (^ cr-bit true-p))
     5691             (with-crf-target () crf
     5692                (! %ilogbitp-constant-bit crf reg arm-bit)
     5693                (ensuring-node-target (target vreg)
     5694                  (! cond->boolean target (if true-p cr-bit (logxor cr-bit 1))))
     5695                (^))))
     5696          (multiple-value-bind (rbit rform) (arm2-two-untargeted-reg-forms seg bitnum arm::arg_y form arm::arg_z)
     5697            (regspec-crf-gpr-case
    57835698               (vreg dest)
    57845699               (progn
    5785                  (! compare-signed-s16const dest bitreg 0)
     5700                 (! %ilogbitp-variable-bit dest rform rbit)
    57865701                 (^ cr-bit true-p))
    5787                (progn
    5788                  (if true-p
    5789                    (! invert-lowbit bitreg))
     5702               (with-crf-target () crf
     5703                 (! %ilogbitp-variable-bit crf rform rbit)
    57905704                 (ensuring-node-target (target dest)
    5791                    (! lowbit->truth target bitreg))
    5792                  (^)))))
    5793           (multiple-value-bind (rbit rform) (arm2-two-untargeted-reg-forms seg bitnum arm::arg_y form arm::arg_z)
    5794              (with-imm-temps () (bitreg)
    5795                (! extract-variable-non-insane-bit bitreg rform rbit)
    5796                (regspec-crf-gpr-case
    5797                (vreg dest)
    5798                (progn
    5799                  (! compare-signed-s16const dest bitreg 0)
    5800                  (^ cr-bit true-p))
    5801                (progn
    5802                  (if true-p
    5803                    (! invert-lowbit bitreg))
    5804                  (ensuring-node-target (target dest)
    5805                    (! lowbit->truth target bitreg))
    5806                  (^))))))))))
     5705                  (! cond->boolean target (if true-p cr-bit (logxor cr-bit 1))))
     5706                 (^)))))))))
    58075707
    58085708(defarm2 arm2-uvref uvref (seg vreg xfer vector index)
     
    58755775                (t (subprim-name->offset '.SPcallbuiltin))))))
    58765776    (when tail-p
    5877       (arm2-restore-nvrs seg *arm2-register-restore-ea* *arm2-register-restore-count*)
    58785777      (arm2-restore-full-lisp-context seg))
    58795778    (unless idx-subprim
     
    62306129        (let* ((fixval (or fix1 fix2))
    62316130               (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
    6232                (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
    6233                (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
    6234                (otherform (if (or high low) (if fix1 form2 form1)))
     6131               (ok-imm (and unboxed-fixval (arm::encode-arm-immediate unboxed-fixval)))
     6132               (otherform (if ok-imm (if fix1 form2 form1)))
    62356133               (out-of-line (backend-get-next-label))
    62366134               (done (backend-get-next-label)))
     
    62496147                  (! branch-unless-both-args-fixnums ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* out-of-line)))))
    62506148            (if otherform
    6251               (if high
    6252                 (! logior-high ($ arm::arg_z) ($ arm::arg_z) high)
    6253                 (! logior-low ($ arm::arg_z) ($ arm::arg_z) low))
     6149              (! logior-immediate ($ arm::arg_z) ($ arm::arg_z) (logand #xffffffff unboxed-fixval))
    62546150              (! %logior2 ($ arm::arg_z) ($ arm::arg_z) ($ arm::arg_y)))
    62556151            (-> done)
     
    62786174      (arm2-use-operator (%nx1-operator fixnum) seg vreg xfer (logand fix1 fix2))
    62796175      (let* ((fixval (or fix1 fix2))
    6280              (fixlen (if fixval (integer-length fixval)))
    62816176             (unboxed-fixval (if fixval (ash fixval *arm2-target-fixnum-shift*)))
    6282              (high (if fixval (if (= unboxed-fixval (logand #xffff0000 unboxed-fixval)) (ash unboxed-fixval -16))))
    6283              (low (if fixval (unless high (if (= unboxed-fixval (logand #x0000ffff unboxed-fixval)) unboxed-fixval))))
    6284              (maskable (and fixval (= fixlen (logcount fixval))))
    6285              (otherform (if (or high low maskable) (if fix1 form2 form1)))
     6177             (ok-imm (and unboxed-fixval
     6178                          (or (arm::encode-arm-immediate unboxed-fixval)
     6179                              (arm::encode-arm-immediate (lognot unboxed-fixval)))))
     6180             (otherform (if ok-imm (if fix1 form2 form1)))
    62866181             (out-of-line (backend-get-next-label))
    62876182             (done (backend-get-next-label)))
     
    62996194                (! branch-unless-both-args-fixnums ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* out-of-line)))))
    63006195          (if otherform
    6301             (if (or high low)
    6302               (if high
    6303                 (! logand-high ($ arm::arg_z) ($ arm::arg_z) high)
    6304                 (! logand-low ($ arm::arg_z) ($ arm::arg_z) low))
    6305               (let* ((nbits (- *arm2-target-bits-in-word*
    6306                              (1+ (+ *arm2-target-fixnum-shift* fixlen)))))
    6307                 (if (> fixval 0)
    6308                   (! clear-left ($ arm::arg_z) ($ arm::arg_z)  nbits)
    6309                   (! clear-right ($ arm::arg_z) ($ arm::arg_z) (+ fixlen
    6310                                                                   *arm2-target-fixnum-shift*)))))
     6196            (! logand-immediate ($ arm::arg_z) ($ arm::arg_z) (logand #xffffffff unboxed-fixval))
    63116197            (! %logand2 ($ arm::arg_z) ($ arm::arg_z) ($ arm::arg_y)))
    63126198          (-> done)
     
    64496335                     (arm2-copy-register seg target ($ arm::arg_z)))))
    64506336              (^)))
    6451            ((and v1 (<= (integer-length v1) (- 15 *arm2-target-fixnum-shift*)))
    6452             (ensuring-node-target (target vreg)
    6453               (! fixnum-sub-from-constant target v1 (arm2-one-untargeted-reg-form seg num2 arm::arg_z)))
    6454             (^))
    64556337           (t
    64566338            (multiple-value-bind (r1 r2) (arm2-two-untargeted-reg-forms seg num1 arm::arg_y num2 arm::arg_z)
     
    64636345    (progn
    64646346      (arm2-form seg nil nil num1)
    6465       (arm2-form seg nil xfer num2)) 
    6466     (let* ((fix1 (acode-fixnum-form-p num1))
    6467            (fix2 (acode-fixnum-form-p num2))
    6468            (other (if (typep fix1 '(signed-byte 16)) num2 (if (typep fix2 '(signed-byte 16)) num1))))
    6469       (if (and fix1 fix2)
    6470         (arm2-lri seg vreg (ash (* fix1 fix2) *arm2-target-fixnum-shift*))
    6471         (if other
    6472           (! multiply-immediate vreg (arm2-one-untargeted-reg-form seg other arm::arg_z) (or fix1 fix2))
    6473           (multiple-value-bind (rx ry) (arm2-two-untargeted-reg-forms seg num1 arm::arg_y num2 arm::arg_z)
    6474             (ensuring-node-target (target vreg)
    6475               (! multiply-fixnums target rx ry)))))
     6347      (arm2-form seg nil xfer num2))
     6348    (multiple-value-bind (rx ry) (arm2-two-untargeted-reg-forms seg num1 arm::arg_y num2 arm::arg_z)
     6349      (ensuring-node-target (target vreg)
     6350        (! multiply-fixnums target rx ry))
    64766351      (^))))
    64776352
     
    66596534(defarm2 arm2-%natural<> %natural<> (seg vreg xfer cc form1 form2)
    66606535  (multiple-value-bind (cr-bit true-p) (acode-condition-to-arm-cr-bit cc)
    6661     (arm2-natural-compare seg vreg xfer form1 form2 cr-bit true-p)))
     6536    (setq cr-bit (arm-cr-bit-to-arm-unsigned-cr-bit cr-bit))
     6537    (arm2-compare seg vreg xfer form1 form2 cr-bit true-p)))
    66626538
    66636539(defarm2 arm2-double-float-compare double-float-compare (seg vreg xfer cc form1 form2)
     
    73427218                                          i ($ arm::arg_y)
    73437219                                          j ($ arm::arg_z))
    7344            (arm2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef2)))))  )
     7220           (arm2-fixed-call-builtin seg vreg xfer 'SParef2))))  )
    73457221
    73467222
     
    74007276                                         j ($ arm::arg_y)
    74017277                                         k ($ arm::arg_z))
    7402            (arm2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef3))))))
     7278           (arm2-fixed-call-builtin seg vreg xfer 'SParef3)))))
    74037279
    74047280(defarm2 arm2-%aset2 simple-typed-aset2 (seg vreg xfer typename arr i j new &optional dim0 dim1)
     
    74487324                                         j ($ arm::arg_y)
    74497325                                         new ($ arm::arg_z))
    7450            (arm2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset2))))))
     7326           (arm2-fixed-call-builtin seg vreg xfer '.SPaset2)))))
    74517327
    74527328
     
    74937369                                         new ($ arm::arg_z))
    74947370           (arm2-pop-register seg ($ arm::temp1))
    7495            (arm2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset3))))))
     7371           (arm2-fixed-call-builtin seg vreg xfer '.SPaset3)))))
    74967372
    74977373(defarm2 arm2-%aset3 simple-typed-aset3 (seg vreg xfer typename arr i j k new &optional dim0 dim1 dim2)
     
    79437819    (if (and fixnum-by (eql 0 fixnum-by))
    79447820      (arm2-form seg vreg xfer ptr)
    7945       (with-imm-target (vreg) (ptr-reg :address)
     7821      (with-imm-target () (ptr-reg :address)
    79467822        (arm2-one-targeted-reg-form seg ptr ptr-reg)
    7947         (if fixnum-by
    7948           (with-imm-target (vreg ptr-reg) (result :address)
    7949             (let* ((high (ldb (byte 16 16) fixnum-by))
    7950                    (low (ldb (byte 16 0) fixnum-by)))
    7951               (declare (type (unsigned-byte 16) high low))
    7952               (if (logbitp 15 low) (incf high))
    7953               (! add-immediate result ptr-reg high low)
    7954               (<- result)))
     7823        (if (setq fixnum-by (and fixnum-by
     7824                                 (or (arm::encode-arm-immediate fixnum-by)
     7825                                     (arm::encode-arm-immediate (- fixnum-by)))
     7826                                 fixnum-by))
     7827          (with-imm-target (ptr-reg) (result :address)
     7828            (! add-immediate result ptr-reg fixnum-by)
     7829            (<- result))
    79557830          (progn
    79567831            (unless triv-by
    79577832              (! temp-push-unboxed-word ptr-reg)
    79587833              (arm2-open-undo $undostkblk))
    7959             (with-imm-target (vreg ptr-reg) (by-reg :s32)
     7834            (with-imm-target (ptr-reg) (by-reg :s32)
    79607835              (arm2-one-targeted-reg-form seg by by-reg)
    79617836              (unless triv-by
    79627837                (! temp-pop-unboxed-word ptr-reg)
    79637838                (arm2-close-undo))
    7964               (with-imm-target (vreg ptr-reg by-reg) (result :address)
     7839              (with-imm-target (ptr-reg by-reg) (result :address)
    79657840                (! fixnum-add result ptr-reg by-reg)
    79667841                (<- result)))))
     
    81127987          (case spec
    81137988            (:double-float
    8114              (let* ((df ($ arm::fp1 :class :fpr :mode :double-float)))
     7989             (let* ((df ($ arm::d0 :class :fpr :mode :double-float)))
    81157990               (incf nfpr-args)
    81167991               (arm2-one-targeted-reg-form seg valform df )
     
    81247999                      (incf other-offset 2)))))
    81258000            (:single-float
    8126              (let* ((sf ($ arm::fp1 :class :fpr :mode :single-float)))
     8001             (let* ((sf ($ arm::s0 :class :fpr :mode :single-float)))
    81278002               (incf nfpr-args)
    81288003               (arm2-one-targeted-reg-form
     
    81808055                         (! set-eabi-c-arg reg other-offset)
    81818056                         (incf other-offset)))))))))
     8057      #+hard-float
    81828058      (do* ((fpreg arm::fp1 (1+ fpreg))
    81838059            (reloads (nreverse fp-loads) (cdr reloads)))
     
    81968072        (cond ((eq resultspec :void) (<- nil))
    81978073              ((eq resultspec :double-float)
    8198                (<- ($  arm::fp1 :class :fpr :mode :double-float)))
     8074               (<- ($  arm::d0 :class :fpr :mode :double-float)))
    81998075              ((eq resultspec :single-float)
    8200                (<- ($ arm::fp1 :class :fpr :mode :single-float)))
     8076               (<- ($ arm::s0 :class :fpr :mode :single-float)))
    82018077              ((eq resultspec :unsigned-doubleword)
    82028078               (ensuring-node-target (target vreg)
     
    83658241        (let* ((u32x (nx-u32-constant-p x))
    83668242               (u32y (nx-u32-constant-p y))
    8367                (constant (or u32x u32y)))
     8243               (constant (let* ((c (or u32x u32y)))
     8244                           (if (arm::encode-arm-immediate c)
     8245                             c
     8246                             (if (arm::encode-arm-immediate (lognot c))
     8247                               (lognot c))))))
    83688248          (if (not constant)
    83698249            (with-imm-target () (xreg :natural)
     
    83758255              (with-imm-target () (other-reg :natural)
    83768256                (arm2-one-targeted-reg-form seg other other-reg)
    8377                 (multiple-value-bind (start-bit stop-bit)
    8378                     (arm2-mask-bits constant)
    8379                   (if start-bit
    8380                     (! %natural-logand-mask-c other-reg other-reg start-bit stop-bit)
    8381                     (let* ((high (ldb (byte 16 16) constant))
    8382                            (low (ldb (byte 16 0) constant)))
    8383                       (declare (type (unsigned-byte 16) high low))
    8384                       (unless (and (= high #xffff)
    8385                                    (= low high))
    8386                         (if (= low 0)
    8387                           (! %natural-logand-high-c other-reg other-reg high)
    8388                           (if (= high 0)
    8389                             (! %natural-logand-low-c other-reg other-reg low)
    8390                             (with-imm-target (other-reg) (const-reg :natural)
    8391                               (arm2-absolute-natural seg const-reg nil constant)
    8392                               (! %natural-logand other-reg other-reg const-reg))))))))
     8257                (! logand-immediate other-reg other-reg (logand constant #xffffffff))
    83938258                (<- other-reg))))
    83948259          (^))))))
     
    84318296(defarm2 arm2-%current-frame-ptr %current-frame-ptr (seg vreg xfer)
    84328297  (cond ((arm2-tailcallok xfer)
    8433          (arm2-restore-nvrs seg *arm2-register-restore-ea* *arm2-register-restore-count*)
    84348298         (arm2-restore-full-lisp-context seg)
    84358299         (! %current-frame-ptr ($ arm::arg_z))
     
    85318395                  *arm2-reckless*)
    85328396        (! trap-unless-fixnum r))
    8533       (! fixnum->fpr dreg r)
     8397      (! fixnum->double dreg r)
    85348398      (<- dreg)
    85358399      (^))))
    85368400
    85378401(defarm2 arm2-%fixnum-to-single %fixnum-to-single (seg vreg xfer arg)
    8538   (with-fp-target () (dreg :double-float)
     8402  (with-fp-target () (dreg :single-float)
    85398403    (let* ((r (arm2-one-untargeted-reg-form seg arg arm::arg_z)))
    85408404      (unless (or (acode-fixnum-form-p arg)
    85418405                  *arm2-reckless*)
    85428406        (! trap-unless-fixnum r))
    8543       (! fixnum->fpr dreg r)
    8544       (if (single-float-reg-p vreg)
    8545         (! double-to-single vreg dreg)
    8546         (with-fp-target (dreg) (sreg :single-float)
    8547           (! double-to-single sreg dreg)
    8548           (<- sreg)))
     8407      (! fixnum->single dreg r)
     8408      (<- dreg)
    85498409      (^))))
    85508410
  • branches/arm/compiler/nx1.lisp

    r13760 r13780  
    293293
    294294(defnx1 nx1-logbitp ((logbitp)) (bitnum int &environment env)
    295   (if (and (nx-form-typep bitnum
    296                           (target-word-size-case (32 '(integer 0 29))
    297                                                  (64 '(integer 0 60))) env)
     295  (if (and (if (typep bitnum 'unsigned-byte)
     296             (setq bitnum (min bitnum
     297                               (target-word-size-case
     298                                (32 29)
     299                                (64 60))))
     300             (nx-form-typep bitnum
     301                            (target-word-size-case (32 '(integer 0 29))
     302                                                   (64 '(integer 0 60))) env))
    298303           (nx-form-typep int 'fixnum env))
    299304    (nx1-cc-binaryop (%nx1-operator %ilogbitp) :ne bitnum int)
     
    14431448    address-expression arg-specs-and-result-spec
    14441449    (ecase (backend-name *target-backend*)
    1445       (:linuxppc32 (%nx1-operator eabi-ff-call))
     1450      ((:linuxppc32 :linuxarm) (%nx1-operator eabi-ff-call))
    14461451      ((:darwinppc32 :linuxppc64 :darwinppc64) (%nx1-operator poweropen-ff-call))
    14471452      ((:darwinx8632 :linuxx8632 :win32 :solarisx8632 :freebsdx8632) (%nx1-operator i386-ff-call))
  • branches/arm/compiler/optimizers.lisp

    r13251 r13780  
    21062106      `(let* ((,typecode (typecode ,x)))
    21072107        (declare (type (unsigned-byte 8) ,typecode))
    2108         #+(or ppc32-target x8632-target)
     2108        #+(or ppc32-target x8632-target arm-target)
    21092109        (or (= ,typecode target::tag-fixnum)
    21102110         (and (>= ,typecode target::min-numeric-subtag)
Note: See TracChangeset for help on using the changeset viewer.