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

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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*))
Note: See TracChangeset for help on using the changeset viewer.