Changeset 13927

Timestamp:

Jul 6, 2010, 9:05:27 AM (14 years ago)

Author:

Gary Byers

Message:

arm-bignum.lisp: BIGNUM-ADD-LOOP-+.
arm-utils.lisp: %ALLOCATE-LIST.
arm-misc.lisp, l0-misc.lisp, Makefile: use futexes on ARM Linux.

Location:

branches/arm

Files:

• level-0/ARM/arm-bignum.lisp (modified) (1 diff)
• level-0/ARM/arm-misc.lisp (modified) (2 diffs)
• level-0/ARM/arm-utils.lisp (modified) (2 diffs)
• level-0/l0-misc.lisp (modified) (1 diff)
• lisp-kernel/linuxarm/Makefile (modified) (2 diffs)

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

@@ -488 +488 @@
     (bx lr)))
 
-;; same as above but with initial a index and finishes
-#+notyet
+;; same as above but with initial a index and finishes, and is actually called.
 (defarmlapfunction bignum-add-loop-+ ((init-a 0)(aptr arg_x)(bptr arg_y)(length arg_z))
-  (let ((idx imm0)        
-        (count imm1)
-        (x imm2)
-        (y imm3)
-        (aidx imm4))
-    (li idx arm::misc-data-offset)
-    (ldr aidx vsp (:$ init-a))
-    (addi aidx aidx arm::misc-data-offset)
-    (li count 0)
+  (let ((count temp0)
+        (carry temp1)
+        (x imm0)
+        (y imm1)
+        (aidx imm2)
+        (idx y))
+    (ldr aidx (:@ vsp (:$ init-a)))
+    (add aidx aidx (:$ arm::misc-data-offset))
+    (mov count (:$ 0))
     ; initialize carry 0
-    (addc x rzero rzero)
+    (mov carry (:$ 0))
     @loop
     (ldr x (:@ aptr aidx))
+    (add idx count (:$ arm::misc-data-offset))
     (ldr y (:@ bptr idx))
-    (adde x x y)
+    (add x x y)
+    (adds x x (:asr carry (:$ arm::fixnumshift)))
+    (movcc carry (:$ 0))
+    (movcs carry (:$ arm::fixnumone))
     (str x (:@ aptr aidx))
-    (addi count count '1)
-    (cmpw count length)
-    (addi idx idx '1)
-    (addi aidx aidx '1)
+    (add count count '1)
+    (cmp count length)
+    (add aidx aidx '1)
     (blt @loop)
     (ldr x (:@ aptr aidx))  ; add carry into next one
-    (adde x x  rzero)
+    (add x x (:asr carry (:$ arm::fixnumshift)))
     (str x (:@ aptr aidx))
     (add vsp vsp (:$ 4))

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

@@ -415 +415 @@
   (ba .SPatomic-incf-node))
 
-#+notyet                                ;needs ARM subprim ?
 (defarmlapfunction %atomic-incf-ptr ((ptr arg_z))
   (macptr-ptr imm1 ptr)
   @again
-  (lrarx imm0 0 imm1)
-  (addi imm0 imm0 1)
-  (strcx. imm0 0 imm1)
-  (bne @again)
-  (isync)
+  (ldrex imm0 (:@ imm1))
+  (add imm0 imm0 (:$ 1))
+  (strex imm2 imm0 (:@ imm1))
+  (cmp imm2 (:$ 0))
+  (bne @again)
   (box-fixnum arg_z imm0)
   (bx lr))
 
-#+notyet                                ;needs ARM subprim ?
+
 (defarmlapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
   (macptr-ptr imm1 ptr)
-  (unbox-fixnum imm2 by)
-  @again
-  (lrarx imm0 0 imm1)
-  (add imm0 imm0 imm2)
-  (strcx. imm0 0 imm1)
-  (bne @again)
-  (isync)
+  @again
+  (ldrex imm0 (:@ imm1))
+  (add imm0 imm0 (:asr by (:$ arm::fixnumshift)))
+  (strex imm2 imm0 (:@ imm1))
+  (bne @again)
   (box-fixnum arg_z imm0)
   (bx lr))
 
-#+notyet                                ;needs ARM subprim
 (defarmlapfunction %atomic-decf-ptr ((ptr arg_z))
   (macptr-ptr imm1 ptr)
   @again
-  (lrarx imm0 0 imm1)
-  (subi imm0 imm0 1)
-  (strcx. imm0 0 imm1)
-  (bne @again)
-  (isync)
+  (ldrex imm0 (:@ imm1))
+  (sub imm0 imm0 (:$ 1))
+  (strex imm2 imm0 (:@ imm1))
+  (cmp imm2 (:$ 0))
+  (bne @again)
   (box-fixnum arg_z imm0)
   (bx lr))
 
-#+notyet                                ;Needs ARM subprim ?
 (defarmlapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
   (macptr-ptr imm1 ptr)
   @again
-  (lrarx imm0 0 imm1)
-  (cmpri cr1 imm0 0)
-  (subi imm0 imm0 1)
+  (ldrex imm0 (:@ imm1))
+  (cmp imm0 (:$ 0))
+  (sub imm0 imm0 (:$ 1))
   (beq @done)
-  (strcx. imm0 0 imm1)
-  (bne @again)
-  (isync)
+  (strex imm2 imm0 (:@ imm1))
+  (cmp imm2 (:$ 0))
+  (bne @again)
   (box-fixnum arg_z imm0)
   (bx lr)
   @done
-  (li imm1 arm::reservation-discharge)
+  (clrex)
   (box-fixnum arg_z imm0)
-  (strcx. rzero rzero imm1)
-  (bx lr))
-
-#+notyet                                ;guess why not ?
+  (bx lr))
+
+
 (defarmlapfunction %atomic-swap-ptr ((ptr arg_y) (newval arg_z))
-  (sync)
   (macptr-ptr imm1 ptr)
+  @again
   (unbox-fixnum imm2 arg_z)
-  @again
-  (lrarx imm0 0 imm1)
-  (strcx. imm2 0 imm1)
-  (bne @again)
-  (isync)
+  (ldrex imm0 (:@ imm1))
+  (strex imm2 imm2 (:@ imm1))
+  (cmp imm2 (:$ 0))
+  (bne @again)
   (box-fixnum arg_z imm0)
   (bx lr))
@@ -486 +479 @@
 ;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
 ;;; was equal to OLDVAL.  Return the old value
-#+notyet                                 ;still
 (defarmlapfunction %ptr-store-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
   (macptr-ptr imm0 ptr)
-  (unbox-fixnum imm1 expected-oldval)
+  @again
+  (ldrex imm1 (:@ imm0))
+  (cmp imm1 (:asr expected-oldval (:$ arm::fixnumshift)))
   (unbox-fixnum imm2 newval)
-  @again
-  (lrarx imm3 0 imm0)
-  (cmpr imm3 imm1)
-  (bne- @done)
-  (strcx. imm2 0 imm0)
-  (bne- @again)
-  (isync)
-  (box-fixnum arg_z imm3)
+  (bne @done)
+  (strex imm2 imm2 (:@ imm0))
+  (cmp imm2 (:$ 0))
+  (bne @again)
+  (box-fixnum arg_z imm1)
   (bx lr)
   @done
-  (li imm0 arm::reservation-discharge)
-  (box-fixnum arg_z imm3)
-  (strcx. rzero 0 imm0)
+  (clrex)
+  (box-fixnum arg_z imm1)
   (bx lr))
 

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

@@ -318 +318 @@
   (bx lr))
 
+
+;;; Make a list.  This can be faster than doing so by doing CONS
+;;; repeatedly, since the latter strategy might triger the GC several
+;;; times if N is large.
+(defarmlapfunction %allocate-list ((initial-element arg_y) (nconses arg_z))
+  (check-nargs 2)
+  (build-lisp-frame)
+  (mov fn nfn)
+  (uuo-kernel-service (:? al) (:$ arch::error-allocate-list))
+  (vpush1 arg_z)
+  (vpush1 arg_y)
+  (set-nargs 2)
+  (ba .SPnvalret))
+
 #+notyet                                ;trap encoding
 (progn
@@ -426 +440 @@
   (error "watching objects not supported on ARM yet"))
 
-;;; Make a list.  This can be faster than doing so by doing CONS
-;;; repeatedly, since the latter strategy might triger the GC several
-;;; times if N is large.
-(defarmlapfunction %allocate-list ((initial-element arg_y) (nconses arg_z))
-  (check-nargs 2)
-  (save-lisp-context)
-  (uuo_interr arch::error-allocate-list rzero)
-  (vpush arg_z)
-  (vpush arg_y)
-  (set-nargs 2)
-  (ba .SPnvalret))
+
   
 (defarmlapfunction %ensure-static-conses ()

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

@@ -20 +20 @@
 
 ;;; Bootstrapping for futexes
-#+(and linux-target x86-target)
+#+(and linux-target (or x86-target arm-target))
 (eval-when (:compile-toplevel :execute)
   (pushnew :futex *features*))

branches/arm/lisp-kernel/linuxarm/Makefile

@@ -23 +23 @@
 ASFLAGS =
 M4FLAGS = -DLINUX -DARM
-CDEFINES = -DLINUX -DARM -D_REENTRANT -D_GNU_SOURCE -DDISABLE_EGC -DGC_INTEGRITY_CHECKING
+CDEFINES = -DLINUX -DARM -D_REENTRANT -D_GNU_SOURCE -DDISABLE_EGC -DGC_INTEGRITY_CHECKING -DUSE_FUTEX
 CDEBUG = -g
 COPT = #-O2
@@ -43 +43 @@
 
 # Likewise, some versions of GAS may need a "-a32" flag, to force the
+
 # output file to be 32-bit compatible.