Changeset 13913


Ignore:
Timestamp:
Jul 3, 2010, 4:49:22 AM (9 years ago)
Author:
gb
Message:

Add/fix things.

Location:
branches/arm/level-0/ARM
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/level-0/ARM/arm-bignum.lisp

    r13906 r13913  
    301301;;;
    302302
    303 #+notyet
    304303(defarmlapfunction %subtract-with-borrow-1 ((a-h 4) (a-l 0) (b-h arg_x) (b-l
    305304arg_y) (borrow-in arg_z))
    306305  (let ((a imm0)
    307306        (b imm1)
    308         (temp imm2)
    309         (c imm3))
    310     (ldr temp0 vsp (:$ a-h))
    311     (ldr temp1 vsp (:$ a-l))
    312     (compose-digit a temp0 temp1)
     307        (temp imm0)
     308        (c imm2)
     309        (rzero temp2))
     310    (mov rzero (:$ 0))
     311    (ldr temp0 (:@ vsp (:$ a-h)))
     312    (ldr temp1 (:@ vsp (:$ a-l)))
    313313    (compose-digit b b-h b-l)
    314314    (unbox-fixnum c borrow-in)
    315     (li temp -1)
    316     (addc temp c temp)
    317     (subfe a b a)
    318     (addze c rzero)
     315    (mov temp (:$ -1))
     316    (adds temp c temp)
     317    (compose-digit a temp0 temp1)
     318    (rsbs a b a)
     319    (adc c rzero rzero)
    319320    (box-fixnum c c)
    320321    (digit-h temp0 a)
    321322    (digit-l temp1 a)
    322     (vpush temp0)
    323     (vpush temp1)
    324     (vpush c)
     323    (vpush1 temp0)
     324    (vpush1 temp1)
     325    (vpush1 c)
    325326    (add temp0 vsp (:$ 20))
    326327    (set-nargs 3)
     
    328329
    329330
    330 #+notyet
    331331(defarmlapfunction %subtract-one ((a-h arg_y)(a-l arg_z))
    332332  (let ((a imm0))
    333333    (compose-digit a a-h a-l)
    334     (subi a a 1)
     334    (sub a a (:$ 1))
    335335    (digit-h temp0 a)
    336     (vpush temp0)
     336    (vpush1 temp0)
    337337    (digit-l temp0 a)
    338     (vpush temp0)
     338    (vpush1 temp0)
    339339    (add temp0 vsp (:$ 8))
    340340    (set-nargs 2)
     
    358358
    359359
    360 #+notyet
     360
    361361(defarmlapfunction %multiply-and-add-1 ((x-high 8)
    362362                                        (x-low 4)
     
    368368        (y imm1)
    369369        (carry-in imm2)
    370         (lo imm3)
    371         (hi imm4))
     370        (lo x)
     371        (hi y))
    372372    (compose-digit carry-in carry-in-high carry-in-low)
    373     (vpop temp0)
     373    (vpop1 temp0)
    374374    (compose-digit y temp0 y-low)
    375     (vpop temp0)
    376     (vpop temp1)
     375    (vpop1 temp0)
     376    (vpop1 temp1)
    377377    (compose-digit x temp1 temp0)
    378     (mullw lo x y)
    379     (mulhwu hi x y)
    380     (addc lo lo carry-in)
    381     (addze hi hi)
     378    (umull lo hi x y)
     379    (adds lo lo carry-in)
     380    (adc hi hi (:$ 0))
    382381    (digit-h temp0 hi)
    383382    (digit-l temp1 hi)
    384383    (digit-h temp2 lo)
    385     (digit-l temp3 lo)
    386     (vpush temp0)
    387     (vpush temp1)
    388     (vpush temp2)
    389     (vpush temp3)
     384    (digit-l arg_z lo)
     385    (vpush1 temp0)
     386    (vpush1 temp1)
     387    (vpush1 temp2)
     388    (vpush1 arg_z)
    390389    (set-nargs 4)
    391390    (add temp0 vsp (:$ 16))
     
    577576    (bx lr)))
    578577
    579 ;; she do tolerate len = jidx
    580 #+notyet
    581 (defarmlapfunction bignum-shift-left-loop ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (jidx arg_z))
    582   (let ((y imm0)
    583         (idx imm1)
    584         (bits imm2)
    585         (rbits imm3)
    586         (x imm4)
    587         (iidx temp0)
    588         (resptr temp1))
    589     (li iidx 0)
    590     (ldr bits vsp (:$ nbits))
    591     (ldr resptr vsp (:$ result))
    592     (unbox-fixnum bits bits)
    593     (subfic rbits bits 32)   
    594     ;(dbg)
    595     (ldr imm4 bignum (:$ arm::misc-data-offset))
    596     (slw imm4 imm4 bits)
    597     (add y jidx (:$ (+ arm::misc-data-offset -4))) 
    598     (str imm4 (:@ y resptr))
    599      
    600     (cmpw len jidx)
    601     (beq @done)
    602     @loop
    603     (addi idx iidx arm::misc-data-offset)
    604     (ldr x (:@ bignum idx))
    605     (srw x x rbits)
    606     (addi idx idx '1)
    607     (ldr y (:@ bignum idx))
    608     (slw y y bits)
    609     (or x x y)
    610     (addi idx jidx arm::misc-data-offset)
    611     (str x (:@ resptr idx))
    612     (addi jidx jidx '1)   
    613     (cmpw jidx len)
    614     (addi iidx iidx '1)
    615     (blt @loop)   
    616     @done
    617     ; do first - lo order
    618        
    619     ; do last - hi order   
    620     (addi idx iidx arm::misc-data-offset)
    621     ;(dbg t)
    622     (ldr y (:@ bignum idx))
    623     (sraw y y rbits)
    624     (addi idx len arm::misc-data-offset)
    625     (str y (:@ resptr idx))
    626     (add vsp vsp (:$ 8))
    627     (bx lr)))
     578
    628579
    629580
     
    12081159    (rsb shift shift (:$ 32))
    12091160    (mov x (:asr x shift))
    1210     (add i i '4)                    ;sic
     1161    (add i i '4)                        ;sic
    12111162    (ldr y (:@ bignum (:asr i (:$ 2))))
    12121163    (rsb shift shift (:$ 32))
     
    12191170    (blt @loop)   
    12201171    @done
    1221     ; do first - lo order
     1172                                        ; do first - lo order
    12221173       
    1223     ; do last - hi order   
    1224     ;(dbg t)
     1174                                        ; do last - hi order   
     1175                                        ;(dbg t)
    12251176    (ldr y (:@ bignum (:asr i (:$ 2))))
    12261177    (mov y (:asr y shift))
    12271178    (add x len (:$ arm::misc-data-offset))
    12281179    (str y (:@ resptr x))   
     1180    (bx lr)))
     1181
     1182(defarmlapfunction bignum-shift-right-loop-1 ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (iidx arg_z))
     1183  (let ((y imm0)
     1184        (x imm1)
     1185        (shift imm2)
     1186        (idx imm2)
     1187        (jidx temp0)
     1188        (resptr temp1)
     1189        (boxed-shift temp2))
     1190    (vpop1 resptr)
     1191    (vpop1 boxed-shift)
     1192    (mov jidx '0)
     1193    (cmp jidx len)
     1194    (bge @done)
     1195    @loop
     1196    (add idx iidx (:$ arm::misc-data-offset))
     1197    (ldr x (:@ bignum idx))
     1198    (unbox-fixnum shift boxed-shift)
     1199    (mov x (:lsr x shift))
     1200    (add idx iidx (:$ (+ arm::misc-data-offset 4)))
     1201    (ldr y (:@ bignum idx))
     1202    (unbox-fixnum shift boxed-shift)
     1203    (rsb shift shift (:$ 32))
     1204    (mov y (:lsl y shift))
     1205    (orr x x y)
     1206    (add idx jidx (:$ arm::misc-data-offset))
     1207    (str x (:@ resptr idx))
     1208    (add jidx jidx '1)
     1209    (cmp jidx len)
     1210    (add iidx iidx '1)
     1211    (blt @loop)
     1212    @done
     1213    (add idx iidx (:$ arm::misc-data-offset))
     1214    (ldr x (:@ bignum idx))
     1215    (unbox-fixnum shift boxed-shift)
     1216    (mov x (:asr x shift))
     1217    (add idx jidx (:$ arm::misc-data-offset))
     1218    (str x (:@ resptr idx))
    12291219    (bx lr)))
    12301220
     
    12621252  (ba .SPnvalret))
    12631253
     1254;;; Karatsuba multiplication stuff. NYI.
     1255;;; Copy the limb SRC points to to where DEST points.
     1256(defarmlapfunction copy-limb ((src arg_y) (dest arg_z))
     1257  (uuo-debug-trap (:? al)))
     1258
     1259;;; Return T iff LIMB contains 0.
     1260(defarmlapfunction limb-zerop ((limb arg_z))
     1261  (uuo-debug-trap (:? al)))
     1262
     1263;;; Return -1,0,1 according to whether the contents of Y are
     1264;;; <,=,> the contents of Z.
     1265(defarmlapfunction compare-limbs ((y arg_y) (z arg_z))
     1266  (uuo-debug-trap (:? al)))
     1267
     1268;;; Add a fixnum to the limb LIMB points to.  Ignore overflow.
     1269(defarmlapfunction add-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
     1270  (uuo-debug-trap (:? al)))
     1271
     1272;;; Store a fixnum value where LIMB points.
     1273(defarmlapfunction copy-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
     1274  (uuo-debug-trap (:? al)))
     1275
     1276;;; Increment a "LIMB VECTOR" (bignum) by a small amount.  The caller
     1277;;; knows that carries will only propagate for a word or two.
     1278(defarmlapfunction mpn-incr-u ((limb arg_y) (fixby arg_z))
     1279  (uuo-debug-trap (:? al)))
     1280
     1281;;; Store XP-YP at WP; return carry (0 or 1).
     1282;;; wp, xp, yp: word-aligned, unboxed ptrs (fixnums)
     1283;;; size: boxed fixnum
     1284;;; returns boxed carry
     1285(defarmlapfunction mpn-sub-n ((wp 8) (xp arg_x) (yp arg_y) (size arg_z))
     1286  (uuo-debug-trap (:? al)))
     1287
     1288;;; Store XP+YP at WP; return carry (0 or 1).
     1289;;; wp, xp, yp = word-aligned, unboxed macptrs (fixnums).
     1290;;; size = boxed fixnum
     1291;;; result = boxed carry
     1292(defarmlapfunction mpn-add-n ((wp 0) (xp arg_x)
     1293                                (yp arg_y) (size arg_z))
     1294  (uuo-debug-trap (:? al)))
     1295
     1296;;; Add the single limb LIMB to S1P (propagating carry.)  Store the
     1297;;; result at RP.  RP and S1P may be the same place, so check for
     1298;;; that and do nothing after carry stops propagating.  Return carry.
     1299(defarmlapfunction mpn-add-1 ((rp-offset 0) (s1p arg_x)
     1300                                (size arg_y) (limb arg_z))
     1301  (uuo-debug-trap (:? al)))
     1302
     1303;;; Multiply the limb vector S1 by the single limb at LIMBPTR, storing
     1304;;; the result at RES.  Store the "carry out" (high word of last 64-bit
     1305;;; partial product) at the limb RESULT.
     1306;;; res, s1, limbptr, result:
     1307;;;   unboxed, word-aligned ptrs (fixnums).  size: boxed fixnum
     1308;;; It'd be hard to transliterate the GMP code here; the GMP version
     1309;;; uses lots more immediate registers than we can easily use in LAP
     1310;;; (and is much more aggressively pipelined).
     1311(defarmlapfunction mpn-mul-1 ((res-offset 4)
     1312                                (s1-offset 0)
     1313                                (size arg_x)
     1314                                (limbptr arg_y)
     1315                                (result arg_z))
     1316  (uuo-debug-trap (:? al)))
     1317
     1318;;; multiply s1*limb and add result to res
     1319;;; res, s1, limbptr, result:
     1320;;;   unboxed, word-aligned ptrs (fixnums).
     1321;;; size: boxed fixnum
     1322;;; limbptr: source "limb".
     1323;;; result: carry out (high word of product).
     1324(defarmlapfunction mpn-addmul-1 ((res-offset 4)
     1325                                   (s1-offset 0)
     1326                                   (size arg_x)
     1327                                   (limbptr arg_y)
     1328                                   (result arg_z))
     1329  (uuo-debug-trap (:? al)))
     1330
     1331;;; Multiply the UN-word limb vector at UP and the VN-word limb vector
     1332;;; at VP, store the result at RP.
     1333(defarmlapfunction mpn-mul-basecase ((rp-offset 4)
     1334                                       (up-offset 0)
     1335                                       (un arg_x)
     1336                                       (vp arg_y)
     1337                                       (vn arg_z))
     1338  (uuo-debug-trap (:? al)))
     1339
     1340;;; left-shift src by 1 bit, storing result at res.  Return
     1341;;; the bit that was shifted out.
     1342(defarmlapfunction mpn-lshift-1 ((resptr arg_x) (s1ptr arg_y) (size-arg arg_z))
     1343  (uuo-debug-trap (:? al)))
     1344
     1345;;; Do a 32x32=64 unsigned multiply of the words at X and Y.  Store
     1346;;; result (low word first) at RESULT.
     1347(defarmlapfunction umulppm ((x arg_x) (y arg_y) (result arg_z))
     1348  (uuo-debug-trap (:? al)))
     1349
    12641350
    12651351; End of arm-bignum.lisp
  • branches/arm/level-0/ARM/arm-def.lisp

    r13864 r13913  
    141141(defarmlapfunction %%frame-backlink ((p arg_z))
    142142  (check-nargs 1)
    143   (add arg_z p (:$ arm::lisp-frame.size))
    144   (bx lr))
     143  (ldr imm0 (:@ p))
     144  (cmp imm0 (:$ arm::lisp-frame-marker))
     145  (addeq arg_z p (:$ arm::lisp-frame.size))
     146  (bxeq lr)
     147  (cmp imm0 (:$ arm::stack-alloc-marker))
     148  (and imm1 imm0 (:$ arm::fulltagmask))
     149  (addeq arg_z p '2)
     150  (bxeq lr)
     151  (cmp imm1 (:$ arm::fulltag-immheader))
     152  (beq @imm)
     153  (cmp imm1 (:$ arm::fulltag-nodeheader))
     154  (movne arg_z (:$ 0))
     155  (bxne lr)
     156  (header-length imm0 imm0)
     157 
     158  (add imm0 imm0 (:$ (* 2 arm::node-size)))
     159  (bic imm0 imm0 (:$ arm::node-size))
     160  (add arg_z p imm0)
     161  (bx lr)
     162  @imm
     163  (extract-lowbyte imm1 imm0)
     164  (mov imm0 (:lsr imm0 (:$ arm::num-subtag-bits)))
     165  (cmp imm1 (:$ arm::max-32-bit-ivector-subtag))
     166  (bhi @8)
     167  (mov imm0 (:lsl imm0 (:$ arm::word-shift)))
     168  @align
     169  (add imm0 imm0 (:$ (+ 4 7)))
     170  (bic imm0 imm0 (:$ arm::fulltagmask))
     171  (add arg_z p imm0)
     172  (bx lr)
     173  @8
     174  (cmp imm1 (:$ arm::max-8-bit-ivector-subtag))
     175  (bls @align)
     176  (cmp imm1 (:$ arm::max-16-bit-ivector-subtag))
     177  (movls imm0 (:lsl imm0 (:$ 1)))
     178  (bls @align)
     179  (cmp imm1 (:$ arm::subtag-double-float))
     180  (moveq imm0 (:lsl imm0 (:$ 3)))
     181  (beq @align)
     182  (add imm0 imm0 (:$ 7))
     183  (mov imm0 (:lsr imm0 (:$ 3)))
     184  (b @align))
     185 
     186 
     187 
    145188
    146189
  • branches/arm/level-0/ARM/arm-float.lisp

    r13906 r13913  
    270270
    271271(defun %sf-check-exception-1 (operation op0 fp-status)
     272  (declare (ignore operation op0 fp-status)))
     273
     274(defun %df-check-exception-1 (operation op0 fp-status)
    272275  (declare (ignore operation op0 fp-status)))
    273276
  • branches/arm/level-0/ARM/arm-misc.lisp

    r13897 r13913  
    153153
    154154 
    155 #+notyet
     155
    156156(defarmlapfunction %copy-gvector-to-gvector ((src (* 1 arm::node-size))
    157157                                             (src-element 0)
     
    159159                                             (dest-element arg_y)
    160160                                             (nelements arg_z))
    161   (subi nelements nelements '1)
    162   (cmpri nelements 0)
    163   (ldr imm0 src-element vsp)
    164   (ldr temp0 src vsp)
    165   (la vsp '2 vsp)
    166   (cmpr cr1 temp0 dest)
    167   (cmpri cr2 src-element dest-element)
    168   (la imm0 arm::misc-data-offset imm0)
    169   (la imm1 arm::misc-data-offset dest-element)
    170   (bne cr1 @test)
     161  (ldr temp2 (:@ vsp (:$ src-element)))
     162  (ldr temp0 (:@ vsp (:$ src)))
     163  (add vsp vsp '2)
     164  (cmp temp0 dest)
     165  (add imm0 temp2 (:$ arm::misc-data-offset))
     166  (add imm1 dest-element (:$ arm::misc-data-offset))
     167  (bne @test)
    171168  ;; Maybe overlap, or maybe nothing to do.
    172   (beq cr2 @done)                       ; same vectors, same offsets
    173   (blt cr2 @back)                       ; copy backwards, avoid overlap
     169  (cmp temp2 dest-element)
     170  (beq @done)                       ; same vectors, same offsets
     171  (blt @back)                       ; copy backwards, avoid overlap
    174172  (b @test)
    175173  @loop
    176   (subi nelements nelements '1)
    177   (cmpri nelements 0)
    178   (ldrx temp1 temp0 imm0)
    179   (addi imm0 imm0 '1)
    180   (strx temp1 dest imm1)
    181   (addi imm1 imm1 '1)
     174  (ldr temp1 (:@ temp0 imm0))
     175  (add imm0 imm0 '1)
     176  (str temp1 (:@ dest imm1))
     177  (add imm1 imm1 '1)
    182178  @test
     179  (subs nelements nelements '1)
    183180  (bge @loop)
    184181  @done
    185   (mr arg_z dest)
     182  (mov arg_z dest)
    186183  (bx lr)
    187184  @back
    188   ;; We decremented NELEMENTS by 1 above.
    189185  (add imm1 nelements imm1)
    190186  (add imm0 nelements imm0)
    191187  (b @back-test)
    192188  @back-loop
    193   (subi nelements nelements '1)
    194   (cmpri nelements 0)
    195   (ldrx temp1 temp0 imm0)
    196   (subi imm0 imm0 '1)
    197   (strx temp1 dest imm1)
    198   (subi imm1 imm1 '1)
     189  (sub imm0 imm0 '1)
     190  (ldr temp1 (:@ temp0 imm0))
     191  (sub imm1 imm1 '1)
     192  (str temp1 (:@ dest imm1))
    199193  @back-test
     194  (subs nelements nelements '1)
    200195  (bge @back-loop)
    201   (mr arg_z dest)
     196  (mov arg_z dest)
    202197  (bx lr))
    203198 
  • branches/arm/level-0/ARM/arm-numbers.lisp

    r13903 r13913  
    107107
    108108;;; DOES round to even
    109 #+notyet
     109
    110110(defarmlapfunction %round-nearest-double-float->fixnum ((arg arg_z))
    111   (get-double-float fp0 arg)
    112   (fctiw fp0 fp0)
    113   (stwu tsp -16 tsp)
    114   (stw tsp 4 tsp)
    115   (stfd fp0 8 tsp)
    116   (lwz imm0 (+ 8 4) tsp)
    117   (lwz tsp 0 tsp)
    118   (box-fixnum arg_z imm0) 
    119   (blr))
    120 
    121 
    122 
    123 #+notyet
     111  (get-double-float d0 arg)
     112  (ftosid s2 d0)
     113  (fmrs imm0 s2)
     114  (box-fixnum arg_z imm0)
     115  (bx lr))
     116
     117
     118
    124119(defarmlapfunction %round-nearest-short-float->fixnum ((arg arg_z))
    125   (get-single-float fp0 arg)
    126   (fctiw fp0 fp0)
    127   (stwu tsp -16 tsp)
    128   (stw tsp 4 tsp)
    129   (stfd fp0 8 tsp)
    130   (lwz imm0 (+ 8 4) tsp)
    131   (lwz tsp 0 tsp)
    132   (box-fixnum arg_z imm0) 
    133   (blr))
     120  (get-single-float s0 arg imm0)
     121  (ftosis s2 s0)
     122  (fmrs imm0 s2)
     123  (box-fixnum arg_z imm0)
     124  (bx lr))
    134125
    135126
  • branches/arm/level-0/ARM/arm-pred.lisp

    r13889 r13913  
    151151  (vpush1 y)
    152152  (build-lisp-frame imm0)
     153  (mov fn nfn)
    153154  (mov x temp0)
    154155  (mov y temp1)
     
    178179  (bne @lose)
    179180  @hairy
     181  (set-nargs 2)
    180182  (ldr fname (:@ nfn 'hairy-equal))
    181183  (ldr nfn (:@ fname (:$ arm::symbol.fcell)))
Note: See TracChangeset for help on using the changeset viewer.