Changeset 13913

Timestamp:

Jul 2, 2010, 9:49:22 PM (14 years ago)

Author:

Gary Byers

Message:

Add/fix things.

Location:

branches/arm/level-0/ARM

Files:

• arm-bignum.lisp (modified) (8 diffs)
• arm-def.lisp (modified) (1 diff)
• arm-float.lisp (modified) (1 diff)
• arm-misc.lisp (modified) (2 diffs)
• arm-numbers.lisp (modified) (1 diff)
• arm-pred.lisp (modified) (2 diffs)

branches/arm/level-0/ARM/arm-bignum.lisp

@@ -301 +301 @@
 ;;; 
 
-#+notyet
 (defarmlapfunction %subtract-with-borrow-1 ((a-h 4) (a-l 0) (b-h arg_x) (b-l
 arg_y) (borrow-in arg_z))
   (let ((a imm0)
         (b imm1)
-        (temp imm2)
-        (c imm3))
-    (ldr temp0 vsp (:$ a-h))
-    (ldr temp1 vsp (:$ a-l))
-    (compose-digit a temp0 temp1)
+        (temp imm0)
+        (c imm2)
+        (rzero temp2))
+    (mov rzero (:$ 0))
+    (ldr temp0 (:@ vsp (:$ a-h)))
+    (ldr temp1 (:@ vsp (:$ a-l)))
     (compose-digit b b-h b-l)
     (unbox-fixnum c borrow-in)
-    (li temp -1)
-    (addc temp c temp)
-    (subfe a b a)
-    (addze c rzero)
+    (mov temp (:$ -1))
+    (adds temp c temp)
+    (compose-digit a temp0 temp1)
+    (rsbs a b a)
+    (adc c rzero rzero)
     (box-fixnum c c)
     (digit-h temp0 a)
     (digit-l temp1 a)
-    (vpush temp0)
-    (vpush temp1)
-    (vpush c)
+    (vpush1 temp0)
+    (vpush1 temp1)
+    (vpush1 c)
     (add temp0 vsp (:$ 20))
     (set-nargs 3)
@@ -328 +329 @@
 
 
-#+notyet
 (defarmlapfunction %subtract-one ((a-h arg_y)(a-l arg_z))
   (let ((a imm0))
     (compose-digit a a-h a-l)
-    (subi a a 1)
+    (sub a a (:$ 1))
     (digit-h temp0 a)
-    (vpush temp0)
+    (vpush1 temp0)
     (digit-l temp0 a)
-    (vpush temp0)
+    (vpush1 temp0)
     (add temp0 vsp (:$ 8))
     (set-nargs 2)
@@ -358 +358 @@
 
 
-#+notyet
+
 (defarmlapfunction %multiply-and-add-1 ((x-high 8)
                                         (x-low 4)
@@ -368 +368 @@
         (y imm1)
         (carry-in imm2)
-        (lo imm3)
-        (hi imm4))
+        (lo x)
+        (hi y))
     (compose-digit carry-in carry-in-high carry-in-low)
-    (vpop temp0)
+    (vpop1 temp0)
     (compose-digit y temp0 y-low)
-    (vpop temp0)
-    (vpop temp1)
+    (vpop1 temp0)
+    (vpop1 temp1)
     (compose-digit x temp1 temp0)
-    (mullw lo x y)
-    (mulhwu hi x y)
-    (addc lo lo carry-in)
-    (addze hi hi)
+    (umull lo hi x y)
+    (adds lo lo carry-in)
+    (adc hi hi (:$ 0))
     (digit-h temp0 hi)
     (digit-l temp1 hi)
     (digit-h temp2 lo)
-    (digit-l temp3 lo)
-    (vpush temp0)
-    (vpush temp1)
-    (vpush temp2)
-    (vpush temp3)
+    (digit-l arg_z lo)
+    (vpush1 temp0)
+    (vpush1 temp1)
+    (vpush1 temp2)
+    (vpush1 arg_z)
     (set-nargs 4)
     (add temp0 vsp (:$ 16))
@@ -577 +576 @@
     (bx lr)))
 
-;; she do tolerate len = jidx
-#+notyet
-(defarmlapfunction bignum-shift-left-loop ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (jidx arg_z))
-  (let ((y imm0)
-        (idx imm1)
-        (bits imm2)
-        (rbits imm3)
-        (x imm4)
-        (iidx temp0)
-        (resptr temp1))
-    (li iidx 0)
-    (ldr bits vsp (:$ nbits))
-    (ldr resptr vsp (:$ result))
-    (unbox-fixnum bits bits)
-    (subfic rbits bits 32)    
-    ;(dbg)
-    (ldr imm4 bignum (:$ arm::misc-data-offset))
-    (slw imm4 imm4 bits)
-    (add y jidx (:$ (+ arm::misc-data-offset -4)))  
-    (str imm4 (:@ y resptr)) 
-     
-    (cmpw len jidx)
-    (beq @done)
-    @loop
-    (addi idx iidx arm::misc-data-offset)
-    (ldr x (:@ bignum idx))
-    (srw x x rbits)
-    (addi idx idx '1)
-    (ldr y (:@ bignum idx))
-    (slw y y bits)
-    (or x x y)
-    (addi idx jidx arm::misc-data-offset)
-    (str x (:@ resptr idx))
-    (addi jidx jidx '1)    
-    (cmpw jidx len)
-    (addi iidx iidx '1)
-    (blt @loop)    
-    @done
-    ; do first - lo order
-       
-    ; do last - hi order    
-    (addi idx iidx arm::misc-data-offset)
-    ;(dbg t)
-    (ldr y (:@ bignum idx))
-    (sraw y y rbits)
-    (addi idx len arm::misc-data-offset)
-    (str y (:@ resptr idx))
-    (add vsp vsp (:$ 8))
-    (bx lr)))
+
 
 
@@ -1208 +1159 @@
     (rsb shift shift (:$ 32))
     (mov x (:asr x shift))
-    (add i i '4)                    ;sic
+    (add i i '4)                        ;sic
     (ldr y (:@ bignum (:asr i (:$ 2))))
     (rsb shift shift (:$ 32))
@@ -1219 +1170 @@
     (blt @loop)    
     @done
-    ; do first - lo order
+                                        ; do first - lo order
        
-    ; do last - hi order    
-    ;(dbg t)
+                                        ; do last - hi order    
+                                        ;(dbg t)
     (ldr y (:@ bignum (:asr i (:$ 2))))
     (mov y (:asr y shift))
     (add x len (:$ arm::misc-data-offset))
     (str y (:@ resptr x))    
+    (bx lr)))
+
+(defarmlapfunction bignum-shift-right-loop-1 ((nbits 4)(result 0) (bignum arg_x) (len arg_y) (iidx arg_z))
+  (let ((y imm0)
+        (x imm1)
+        (shift imm2)
+        (idx imm2)
+        (jidx temp0)
+        (resptr temp1)
+        (boxed-shift temp2))
+    (vpop1 resptr)
+    (vpop1 boxed-shift)
+    (mov jidx '0)
+    (cmp jidx len)
+    (bge @done)
+    @loop
+    (add idx iidx (:$ arm::misc-data-offset))
+    (ldr x (:@ bignum idx))
+    (unbox-fixnum shift boxed-shift)
+    (mov x (:lsr x shift))
+    (add idx iidx (:$ (+ arm::misc-data-offset 4)))
+    (ldr y (:@ bignum idx))
+    (unbox-fixnum shift boxed-shift)
+    (rsb shift shift (:$ 32))
+    (mov y (:lsl y shift))
+    (orr x x y)
+    (add idx jidx (:$ arm::misc-data-offset))
+    (str x (:@ resptr idx))
+    (add jidx jidx '1)
+    (cmp jidx len)
+    (add iidx iidx '1)
+    (blt @loop)
+    @done
+    (add idx iidx (:$ arm::misc-data-offset))
+    (ldr x (:@ bignum idx))
+    (unbox-fixnum shift boxed-shift)
+    (mov x (:asr x shift))
+    (add idx jidx (:$ arm::misc-data-offset))
+    (str x (:@ resptr idx))
     (bx lr)))
 
@@ -1262 +1252 @@
   (ba .SPnvalret))
 
+;;; Karatsuba multiplication stuff. NYI.
+;;; Copy the limb SRC points to to where DEST points.
+(defarmlapfunction copy-limb ((src arg_y) (dest arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Return T iff LIMB contains 0.
+(defarmlapfunction limb-zerop ((limb arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Return -1,0,1 according to whether the contents of Y are
+;;; <,=,> the contents of Z.
+(defarmlapfunction compare-limbs ((y arg_y) (z arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Add a fixnum to the limb LIMB points to.  Ignore overflow.
+(defarmlapfunction add-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Store a fixnum value where LIMB points.
+(defarmlapfunction copy-fixnum-to-limb ((fixnum arg_y) (limb arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Increment a "LIMB VECTOR" (bignum) by a small amount.  The caller
+;;; knows that carries will only propagate for a word or two.
+(defarmlapfunction mpn-incr-u ((limb arg_y) (fixby arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Store XP-YP at WP; return carry (0 or 1).
+;;; wp, xp, yp: word-aligned, unboxed ptrs (fixnums)
+;;; size: boxed fixnum
+;;; returns boxed carry
+(defarmlapfunction mpn-sub-n ((wp 8) (xp arg_x) (yp arg_y) (size arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Store XP+YP at WP; return carry (0 or 1).
+;;; wp, xp, yp = word-aligned, unboxed macptrs (fixnums).
+;;; size = boxed fixnum
+;;; result = boxed carry
+(defarmlapfunction mpn-add-n ((wp 0) (xp arg_x)
+                                (yp arg_y) (size arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Add the single limb LIMB to S1P (propagating carry.)  Store the
+;;; result at RP.  RP and S1P may be the same place, so check for
+;;; that and do nothing after carry stops propagating.  Return carry.
+(defarmlapfunction mpn-add-1 ((rp-offset 0) (s1p arg_x) 
+                                (size arg_y) (limb arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Multiply the limb vector S1 by the single limb at LIMBPTR, storing
+;;; the result at RES.  Store the "carry out" (high word of last 64-bit
+;;; partial product) at the limb RESULT.
+;;; res, s1, limbptr, result:
+;;;   unboxed, word-aligned ptrs (fixnums).  size: boxed fixnum
+;;; It'd be hard to transliterate the GMP code here; the GMP version
+;;; uses lots more immediate registers than we can easily use in LAP
+;;; (and is much more aggressively pipelined).
+(defarmlapfunction mpn-mul-1 ((res-offset 4)
+                                (s1-offset 0)
+                                (size arg_x)
+                                (limbptr arg_y)
+                                (result arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; multiply s1*limb and add result to res
+;;; res, s1, limbptr, result:
+;;;   unboxed, word-aligned ptrs (fixnums).
+;;; size: boxed fixnum
+;;; limbptr: source "limb".
+;;; result: carry out (high word of product).
+(defarmlapfunction mpn-addmul-1 ((res-offset 4)
+                                   (s1-offset 0)
+                                   (size arg_x)
+                                   (limbptr arg_y)
+                                   (result arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Multiply the UN-word limb vector at UP and the VN-word limb vector
+;;; at VP, store the result at RP.
+(defarmlapfunction mpn-mul-basecase ((rp-offset 4)
+                                       (up-offset 0)
+                                       (un arg_x)
+                                       (vp arg_y)
+                                       (vn arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; left-shift src by 1 bit, storing result at res.  Return
+;;; the bit that was shifted out.
+(defarmlapfunction mpn-lshift-1 ((resptr arg_x) (s1ptr arg_y) (size-arg arg_z))
+  (uuo-debug-trap (:? al)))
+
+;;; Do a 32x32=64 unsigned multiply of the words at X and Y.  Store
+;;; result (low word first) at RESULT.
+(defarmlapfunction umulppm ((x arg_x) (y arg_y) (result arg_z))
+  (uuo-debug-trap (:? al)))
+
 
 ; End of arm-bignum.lisp

branches/arm/level-0/ARM/arm-def.lisp

@@ -141 +141 @@
 (defarmlapfunction %%frame-backlink ((p arg_z))
   (check-nargs 1)
-  (add arg_z p (:$ arm::lisp-frame.size))
-  (bx lr))
+  (ldr imm0 (:@ p))
+  (cmp imm0 (:$ arm::lisp-frame-marker))
+  (addeq arg_z p (:$ arm::lisp-frame.size))
+  (bxeq lr)
+  (cmp imm0 (:$ arm::stack-alloc-marker))
+  (and imm1 imm0 (:$ arm::fulltagmask))
+  (addeq arg_z p '2)
+  (bxeq lr)
+  (cmp imm1 (:$ arm::fulltag-immheader))
+  (beq @imm)
+  (cmp imm1 (:$ arm::fulltag-nodeheader))
+  (movne arg_z (:$ 0))
+  (bxne lr)
+  (header-length imm0 imm0)
+  
+  (add imm0 imm0 (:$ (* 2 arm::node-size)))
+  (bic imm0 imm0 (:$ arm::node-size))
+  (add arg_z p imm0)
+  (bx lr)
+  @imm
+  (extract-lowbyte imm1 imm0)
+  (mov imm0 (:lsr imm0 (:$ arm::num-subtag-bits)))
+  (cmp imm1 (:$ arm::max-32-bit-ivector-subtag))
+  (bhi @8)
+  (mov imm0 (:lsl imm0 (:$ arm::word-shift)))
+  @align
+  (add imm0 imm0 (:$ (+ 4 7)))
+  (bic imm0 imm0 (:$ arm::fulltagmask))
+  (add arg_z p imm0)
+  (bx lr)
+  @8
+  (cmp imm1 (:$ arm::max-8-bit-ivector-subtag))
+  (bls @align)
+  (cmp imm1 (:$ arm::max-16-bit-ivector-subtag))
+  (movls imm0 (:lsl imm0 (:$ 1)))
+  (bls @align)
+  (cmp imm1 (:$ arm::subtag-double-float))
+  (moveq imm0 (:lsl imm0 (:$ 3)))
+  (beq @align)
+  (add imm0 imm0 (:$ 7))
+  (mov imm0 (:lsr imm0 (:$ 3)))
+  (b @align))
+ 
+  
+  
 
 

branches/arm/level-0/ARM/arm-float.lisp

@@ -270 +270 @@
 
 (defun %sf-check-exception-1 (operation op0 fp-status)
+  (declare (ignore operation op0 fp-status)))
+
+(defun %df-check-exception-1 (operation op0 fp-status)
   (declare (ignore operation op0 fp-status)))
 

branches/arm/level-0/ARM/arm-misc.lisp

@@ -153 +153 @@
 
   
-#+notyet
+
 (defarmlapfunction %copy-gvector-to-gvector ((src (* 1 arm::node-size))
                                              (src-element 0)
@@ -159 +159 @@
                                              (dest-element arg_y)
                                              (nelements arg_z))
-  (subi nelements nelements '1)
-  (cmpri nelements 0)
-  (ldr imm0 src-element vsp)
-  (ldr temp0 src vsp)
-  (la vsp '2 vsp)
-  (cmpr cr1 temp0 dest)
-  (cmpri cr2 src-element dest-element)
-  (la imm0 arm::misc-data-offset imm0)
-  (la imm1 arm::misc-data-offset dest-element)
-  (bne cr1 @test)
+  (ldr temp2 (:@ vsp (:$ src-element)))
+  (ldr temp0 (:@ vsp (:$ src)))
+  (add vsp vsp '2)
+  (cmp temp0 dest)
+  (add imm0 temp2 (:$ arm::misc-data-offset))
+  (add imm1 dest-element (:$ arm::misc-data-offset))
+  (bne @test)
   ;; Maybe overlap, or maybe nothing to do.
-  (beq cr2 @done)                       ; same vectors, same offsets
-  (blt cr2 @back)                       ; copy backwards, avoid overlap
+  (cmp temp2 dest-element)
+  (beq @done)                       ; same vectors, same offsets
+  (blt @back)                       ; copy backwards, avoid overlap
   (b @test)
   @loop
-  (subi nelements nelements '1)
-  (cmpri nelements 0)
-  (ldrx temp1 temp0 imm0)
-  (addi imm0 imm0 '1)
-  (strx temp1 dest imm1)
-  (addi imm1 imm1 '1)
+  (ldr temp1 (:@ temp0 imm0))
+  (add imm0 imm0 '1)
+  (str temp1 (:@ dest imm1))
+  (add imm1 imm1 '1)
   @test
+  (subs nelements nelements '1)
   (bge @loop)
   @done
-  (mr arg_z dest)
+  (mov arg_z dest)
   (bx lr)
   @back
-  ;; We decremented NELEMENTS by 1 above.
   (add imm1 nelements imm1)
   (add imm0 nelements imm0)
   (b @back-test)
   @back-loop
-  (subi nelements nelements '1)
-  (cmpri nelements 0)
-  (ldrx temp1 temp0 imm0)
-  (subi imm0 imm0 '1)
-  (strx temp1 dest imm1)
-  (subi imm1 imm1 '1)
+  (sub imm0 imm0 '1)
+  (ldr temp1 (:@ temp0 imm0))
+  (sub imm1 imm1 '1)
+  (str temp1 (:@ dest imm1))
   @back-test
+  (subs nelements nelements '1)
   (bge @back-loop)
-  (mr arg_z dest)
+  (mov arg_z dest)
   (bx lr))
   

branches/arm/level-0/ARM/arm-numbers.lisp

@@ -107 +107 @@
 
 ;;; DOES round to even
-#+notyet
+
 (defarmlapfunction %round-nearest-double-float->fixnum ((arg arg_z))
-  (get-double-float fp0 arg)
-  (fctiw fp0 fp0)
-  (stwu tsp -16 tsp)
-  (stw tsp 4 tsp)
-  (stfd fp0 8 tsp)
-  (lwz imm0 (+ 8 4) tsp)
-  (lwz tsp 0 tsp)
-  (box-fixnum arg_z imm0)  
-  (blr))
-
-
-
-#+notyet
+  (get-double-float d0 arg)
+  (ftosid s2 d0)
+  (fmrs imm0 s2)
+  (box-fixnum arg_z imm0)
+  (bx lr))
+
+
+
 (defarmlapfunction %round-nearest-short-float->fixnum ((arg arg_z))
-  (get-single-float fp0 arg)
-  (fctiw fp0 fp0)
-  (stwu tsp -16 tsp)
-  (stw tsp 4 tsp)
-  (stfd fp0 8 tsp)
-  (lwz imm0 (+ 8 4) tsp)
-  (lwz tsp 0 tsp)
-  (box-fixnum arg_z imm0)  
-  (blr))
+  (get-single-float s0 arg imm0)
+  (ftosis s2 s0)
+  (fmrs imm0 s2)
+  (box-fixnum arg_z imm0)
+  (bx lr))
 
 

branches/arm/level-0/ARM/arm-pred.lisp

@@ -151 +151 @@
   (vpush1 y)
   (build-lisp-frame imm0)
+  (mov fn nfn)
   (mov x temp0)
   (mov y temp1)
@@ -178 +179 @@
   (bne @lose)
   @hairy
+  (set-nargs 2)
   (ldr fname (:@ nfn 'hairy-equal))
   (ldr nfn (:@ fname (:$ arm::symbol.fcell)))