Changeset 13821

Timestamp:

Jun 14, 2010, 10:15:03 AM (9 years ago)

Author:

gb

Message:

Add %COPY-IVECTOR-TO-IVECTOR, %ATOMIC-INCF-NODE, things which need
the "kernel-service" UUO.

File:

• branches/arm/level-0/ARM/arm-misc.lisp (modified) (5 diffs)

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

@@ -81 +81 @@
   (bx lr))
 
-#+notyet
 (defarmlapfunction %copy-ivector-to-ivector ((src 4) 
                                              (src-byte-offset 0) 
@@ -87 +86 @@
                                              (dest-byte-offset arg_y)
                                              (nbytes arg_z))
-  (ldr temp0 (:@ vsp (:$ src)))
-  (cmp nbytes (:$ 0))
-  (cmpw cr2 temp0 dest)   ; source and dest same?
-  (rlwinm imm3 nbytes 0 (- 30 arm::fixnum-shift) 31)  
-  (lwz imm0 src-byte-offset vsp)
-  (rlwinm imm1 imm0 0 (- 30 arm::fixnum-shift) 31)
-  (or imm3 imm3 imm1)
-  (unbox-fixnum imm0 imm0)
-  (la imm0 arm::misc-data-offset imm0)
-  (unbox-fixnum imm2 dest-byte-offset)
-  (rlwimi imm1 imm2 0 30 31)
-  (or imm3 imm3 imm1)
-  (cmpwi cr1 imm3 0)  ; is everybody multiple of 4?
-  (la imm2 arm::misc-data-offset imm2)
-  (beq cr2 @SisD)   ; source and dest same
-  @fwd
-  (beq :cr1 @wtest)
-  (b @test)
-
-  @loop
-  (subi nbytes nbytes '1)
-  (cmpwi cr0 nbytes 0)
-  (lbzx imm3 temp0 imm0)
-  (addi imm0 imm0 1)
-  (stbx imm3 dest imm2)
-  (addi imm2 imm2 1)
-  @test
-  (bne cr0 @loop)
-  (mr arg_z dest)
-  (la vsp 8 vsp)
-  (bx lr)
-
-  @words      ; source and dest different - words 
-  (subi nbytes nbytes '4)  
-  (cmpwi cr0 nbytes 0)
-  (lwzx imm3 temp0 imm0)
-  (addi imm0 imm0 4)
-  (stwx imm3 dest imm2)
-  (addi imm2 imm2 4)
-  @wtest
-  (bgt cr0 @words)
-  @done
-  (mr arg_z dest)
-  (la vsp 8 vsp)
-  (bx lr)
-
-  @SisD
-  (cmpw cr2 imm0 imm2) ; cmp src and dest
-  (bgt cr2 @fwd)
-  ;(B @bwd) 
+  (let ((rsrc temp0)
+        (scaled-src-idx imm1)
+        (scaled-dest-idx imm2)
+        (val imm0)
+        (nwords dest-byte-offset))
+    (cmp nbytes (:$ 0))
+    (vpop1 scaled-src-idx)
+    (mov scaled-src-idx (:lsr scaled-src-idx (:$ arm::fixnumshift)))
+    (mov val scaled-src-idx)
+    (add scaled-src-idx scaled-src-idx (:$ arm::misc-data-offset))
+    (vpop1 rsrc)
+    (beq @done)
+    (cmp rsrc dest)
+    (mov scaled-dest-idx (:lsr dest-byte-offset (:$ arm::fixnumshift)))
+    (orr val val scaled-dest-idx)
+    (add scaled-dest-idx scaled-dest-idx (:$ arm::misc-data-offset))
+    (beq @SisD)
+    @fwd
+    (tst val (:$ 3))
+    (bne @loop)
+    ;; src and dest offsets are word-aligned. Copy words.
+    (b @wtest)
+    @words                              ; source and dest different - words 
+    (sub nbytes nbytes '4)  
+    (ldr val (:@ rsrc scaled-src-idx))
+    (add scaled-src-idx scaled-src-idx '1)
+    (str val (:@ dest scaled-dest-idx))
+    (add scaled-dest-idx scaled-dest-idx '1)
+    @wtest
+    (cmp nbytes '4)
+    (bge @words)
+    (cmp nbytes '0)
+    (b @test)
+    @loop
+    (subs nbytes nbytes '1)
+    (ldrb val (:@ temp0 scaled-src-idx))
+    (add scaled-src-idx scaled-src-idx (:$ 1))
+    (strb val (:@ dest scaled-dest-idx))
+    (add scaled-dest-idx scaled-dest-idx (:$ 1))
+    @test
+    (bne  @loop)
+    @done
+    (mov arg_z dest)
+    (bx lr)
+
+    @SisD
+    (cmp scaled-src-idx scaled-dest-idx) ; cmp src and dest
+    (beq @done)
+    (bgt @fwd)
+
   
 
-  ; Copy backwards when src & dest are the same and we're sliding down
-  @bwd ; ok
-  (unbox-fixnum imm3 nbytes)
-  (add imm0 imm0 imm3)
-  (add imm2 imm2 imm3)
-  (b @test2)
-  @loop2
-  (subi nbytes nbytes '1)
-  (cmpwi cr0 nbytes 0)
-  (subi imm0 imm0 1)
-  (lbzx imm3 temp0 imm0)
-  (subi imm2 imm2 1)
-  (stbx imm3 dest imm2)
-  @test2
-  (bne cr0 @loop2)
-  (b @done))
+                                        ; Copy backwards when src & dest are the same and we're sliding down
+    @bwd
+    (add scaled-src-idx scaled-src-idx (:lsr nbytes (:$ arm::fixnumshift)))
+    (add scaled-dest-idx scaled-dest-idx (:lsr nbytes (:$ arm::fixnumshift)))
+    @loop2
+    (sub scaled-src-idx scaled-src-idx (:$ 1))
+    (sub scaled-dest-idx scaled-dest-idx (:$ 1))
+    (subs nbytes nbytes '1)
+    (ldrb val (:@ rsrc scaled-src-idx))
+    (strb val (:@ dest scaled-dest-idx))
+    @test2
+    (bne @loop2)
+    (b @done)))
 
 
@@ -422 +418 @@
 
 
-#+notyet                                ;needs ARM subprim ?
+
 (defarmlapfunction %atomic-incf-node ((by arg_x) (node arg_y) (disp arg_z))
-  (check-nargs 3)
-  (unbox-fixnum imm1 disp)
-  @again
-  (lrarx arg_z node imm1)
-  (add arg_z arg_z by)
-  (strcx. arg_z node imm1)
-  (bne- @again)
-  (isync)
-  (bx lr))
+  (ba .SPatomic-incf-node))
 
 #+notyet                                ;needs ARM subprim ?
@@ -757 +745 @@
   (bx lr))
 
+
+
+(defarmlapfunction %%tcr-interrupt ((target arg_z))
+  (check-nargs 1)
+  (uuo-kernel-service (:$  arch::error-interrupt))
+  (box-fixnum arg_z imm0)
+  (bx lr))
+
+(defarmlapfunction %suspend-tcr ((target arg_z))
+  (check-nargs 1)
+  (uuo-kernel-service (:$ arch::error-suspend))
+  (mov arg_z 'nil)
+  (cmp imm0 (:$ 0))
+  (addne arg_z arg_z (:$ arm::t-offset))
+  (bx lr))
+
+(defarmlapfunction %suspend-other-threads ()
+  (check-nargs 0)
+  (uuo-kernel-service (:$ arch::error-suspend-all))
+  (mov arg_z 'nil)
+  (cmp imm0 (:$ 0))
+  (addne arg_z arg_z (:$ arm::t-offset))
+  (bx lr))
+
+(defarmlapfunction %resume-tcr ((target arg_z))
+  (check-nargs 1)
+  (uuo-kernel-service (:$ arch::error-resume))
+  (mov arg_z 'nil)
+  (cmp imm0 (:$ 0))
+  (addne arg_z arg_z (:$ arm::t-offset))
+  (bx lr))
+
+(defarmlapfunction %resume-other-threads ()
+  (check-nargs 0)
+  (uuo-kernel-service (:$ arch::error-resume-all))
+  (mov arg_z 'nil)
+  (bx lr))
+
+(defarmlapfunction %kill-tcr ((target arg_z))
+  (check-nargs 1)
+  (uuo-kernel-service (:$ arch::error-kill))
+  (mov arg_z 'nil)
+  (cmp imm0 (:$ 0))
+  (addne arg_z arg_z (:$ arm::t-offset))
+  (bx lr))
+
 #+later
 (progn
-
-(defarmlapfunction %%tcr-interrupt ((target arg_z))
-  (check-nargs 1)
-  (uuo_interr arch::error-interrupt rzero)
-  (box-fixnum arg_z imm0)
-  (bx lr))
-
-(defarmlapfunction %suspend-tcr ((target arg_z))
-  (check-nargs 1)
-  (uuo_interr arch::error-suspend rzero)
-  (ne0->boolean arg_z imm0 imm1)
-  (bx lr))
-
-(defarmlapfunction %suspend-other-threads ()
-  (check-nargs 0)
-  (uuo_interr arch::error-suspend-all rzero)
-  (li arg_z nil)
-  (bx lr))
-
-(defarmlapfunction %resume-tcr ((target arg_z))
-  (check-nargs 1)
-  (uuo_interr arch::error-resume rzero)
-  (ne0->boolean arg_z imm0 imm1)
-  (bx lr))
-
-(defarmlapfunction %resume-other-threads ()
-  (check-nargs 0)
-  (uuo_interr arch::error-resume-all rzero)
-  (li arg_z nil)
-  (bx lr))
-
-(defarmlapfunction %kill-tcr ((target arg_z))
-  (check-nargs 1)
-  (uuo_interr arch::error-kill rzero)
-  (ne0->boolean arg_z imm0 imm1)
-  (bx lr))
-
 (defarmlapfunction %atomic-pop-static-cons ()
   (li imm0 (+ (target-nil-value) (arm::kernel-global static-conses)))
@@ -856 +853 @@
   (li arg_z nil)
   (bx lr))
-); #+later
+);#+later
+