Changeset 13821


Ignore:
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:
1 edited

Legend:

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

    r13796 r13821  
    8181  (bx lr))
    8282
    83 #+notyet
    8483(defarmlapfunction %copy-ivector-to-ivector ((src 4)
    8584                                             (src-byte-offset 0)
     
    8786                                             (dest-byte-offset arg_y)
    8887                                             (nbytes arg_z))
    89   (ldr temp0 (:@ vsp (:$ src)))
    90   (cmp nbytes (:$ 0))
    91   (cmpw cr2 temp0 dest)   ; source and dest same?
    92   (rlwinm imm3 nbytes 0 (- 30 arm::fixnum-shift) 31) 
    93   (lwz imm0 src-byte-offset vsp)
    94   (rlwinm imm1 imm0 0 (- 30 arm::fixnum-shift) 31)
    95   (or imm3 imm3 imm1)
    96   (unbox-fixnum imm0 imm0)
    97   (la imm0 arm::misc-data-offset imm0)
    98   (unbox-fixnum imm2 dest-byte-offset)
    99   (rlwimi imm1 imm2 0 30 31)
    100   (or imm3 imm3 imm1)
    101   (cmpwi cr1 imm3 0)  ; is everybody multiple of 4?
    102   (la imm2 arm::misc-data-offset imm2)
    103   (beq cr2 @SisD)   ; source and dest same
    104   @fwd
    105   (beq :cr1 @wtest)
    106   (b @test)
    107 
    108   @loop
    109   (subi nbytes nbytes '1)
    110   (cmpwi cr0 nbytes 0)
    111   (lbzx imm3 temp0 imm0)
    112   (addi imm0 imm0 1)
    113   (stbx imm3 dest imm2)
    114   (addi imm2 imm2 1)
    115   @test
    116   (bne cr0 @loop)
    117   (mr arg_z dest)
    118   (la vsp 8 vsp)
    119   (bx lr)
    120 
    121   @words      ; source and dest different - words
    122   (subi nbytes nbytes '4) 
    123   (cmpwi cr0 nbytes 0)
    124   (lwzx imm3 temp0 imm0)
    125   (addi imm0 imm0 4)
    126   (stwx imm3 dest imm2)
    127   (addi imm2 imm2 4)
    128   @wtest
    129   (bgt cr0 @words)
    130   @done
    131   (mr arg_z dest)
    132   (la vsp 8 vsp)
    133   (bx lr)
    134 
    135   @SisD
    136   (cmpw cr2 imm0 imm2) ; cmp src and dest
    137   (bgt cr2 @fwd)
    138   ;(B @bwd)
     88  (let ((rsrc temp0)
     89        (scaled-src-idx imm1)
     90        (scaled-dest-idx imm2)
     91        (val imm0)
     92        (nwords dest-byte-offset))
     93    (cmp nbytes (:$ 0))
     94    (vpop1 scaled-src-idx)
     95    (mov scaled-src-idx (:lsr scaled-src-idx (:$ arm::fixnumshift)))
     96    (mov val scaled-src-idx)
     97    (add scaled-src-idx scaled-src-idx (:$ arm::misc-data-offset))
     98    (vpop1 rsrc)
     99    (beq @done)
     100    (cmp rsrc dest)
     101    (mov scaled-dest-idx (:lsr dest-byte-offset (:$ arm::fixnumshift)))
     102    (orr val val scaled-dest-idx)
     103    (add scaled-dest-idx scaled-dest-idx (:$ arm::misc-data-offset))
     104    (beq @SisD)
     105    @fwd
     106    (tst val (:$ 3))
     107    (bne @loop)
     108    ;; src and dest offsets are word-aligned. Copy words.
     109    (b @wtest)
     110    @words                              ; source and dest different - words
     111    (sub nbytes nbytes '4) 
     112    (ldr val (:@ rsrc scaled-src-idx))
     113    (add scaled-src-idx scaled-src-idx '1)
     114    (str val (:@ dest scaled-dest-idx))
     115    (add scaled-dest-idx scaled-dest-idx '1)
     116    @wtest
     117    (cmp nbytes '4)
     118    (bge @words)
     119    (cmp nbytes '0)
     120    (b @test)
     121    @loop
     122    (subs nbytes nbytes '1)
     123    (ldrb val (:@ temp0 scaled-src-idx))
     124    (add scaled-src-idx scaled-src-idx (:$ 1))
     125    (strb val (:@ dest scaled-dest-idx))
     126    (add scaled-dest-idx scaled-dest-idx (:$ 1))
     127    @test
     128    (bne  @loop)
     129    @done
     130    (mov arg_z dest)
     131    (bx lr)
     132
     133    @SisD
     134    (cmp scaled-src-idx scaled-dest-idx) ; cmp src and dest
     135    (beq @done)
     136    (bgt @fwd)
     137
    139138 
    140139
    141   ; Copy backwards when src & dest are the same and we're sliding down
    142   @bwd ; ok
    143   (unbox-fixnum imm3 nbytes)
    144   (add imm0 imm0 imm3)
    145   (add imm2 imm2 imm3)
    146   (b @test2)
    147   @loop2
    148   (subi nbytes nbytes '1)
    149   (cmpwi cr0 nbytes 0)
    150   (subi imm0 imm0 1)
    151   (lbzx imm3 temp0 imm0)
    152   (subi imm2 imm2 1)
    153   (stbx imm3 dest imm2)
    154   @test2
    155   (bne cr0 @loop2)
    156   (b @done))
     140                                        ; Copy backwards when src & dest are the same and we're sliding down
     141    @bwd
     142    (add scaled-src-idx scaled-src-idx (:lsr nbytes (:$ arm::fixnumshift)))
     143    (add scaled-dest-idx scaled-dest-idx (:lsr nbytes (:$ arm::fixnumshift)))
     144    @loop2
     145    (sub scaled-src-idx scaled-src-idx (:$ 1))
     146    (sub scaled-dest-idx scaled-dest-idx (:$ 1))
     147    (subs nbytes nbytes '1)
     148    (ldrb val (:@ rsrc scaled-src-idx))
     149    (strb val (:@ dest scaled-dest-idx))
     150    @test2
     151    (bne @loop2)
     152    (b @done)))
    157153
    158154
     
    422418
    423419
    424 #+notyet                                ;needs ARM subprim ?
     420
    425421(defarmlapfunction %atomic-incf-node ((by arg_x) (node arg_y) (disp arg_z))
    426   (check-nargs 3)
    427   (unbox-fixnum imm1 disp)
    428   @again
    429   (lrarx arg_z node imm1)
    430   (add arg_z arg_z by)
    431   (strcx. arg_z node imm1)
    432   (bne- @again)
    433   (isync)
    434   (bx lr))
     422  (ba .SPatomic-incf-node))
    435423
    436424#+notyet                                ;needs ARM subprim ?
     
    757745  (bx lr))
    758746
     747
     748
     749(defarmlapfunction %%tcr-interrupt ((target arg_z))
     750  (check-nargs 1)
     751  (uuo-kernel-service (:$  arch::error-interrupt))
     752  (box-fixnum arg_z imm0)
     753  (bx lr))
     754
     755(defarmlapfunction %suspend-tcr ((target arg_z))
     756  (check-nargs 1)
     757  (uuo-kernel-service (:$ arch::error-suspend))
     758  (mov arg_z 'nil)
     759  (cmp imm0 (:$ 0))
     760  (addne arg_z arg_z (:$ arm::t-offset))
     761  (bx lr))
     762
     763(defarmlapfunction %suspend-other-threads ()
     764  (check-nargs 0)
     765  (uuo-kernel-service (:$ arch::error-suspend-all))
     766  (mov arg_z 'nil)
     767  (cmp imm0 (:$ 0))
     768  (addne arg_z arg_z (:$ arm::t-offset))
     769  (bx lr))
     770
     771(defarmlapfunction %resume-tcr ((target arg_z))
     772  (check-nargs 1)
     773  (uuo-kernel-service (:$ arch::error-resume))
     774  (mov arg_z 'nil)
     775  (cmp imm0 (:$ 0))
     776  (addne arg_z arg_z (:$ arm::t-offset))
     777  (bx lr))
     778
     779(defarmlapfunction %resume-other-threads ()
     780  (check-nargs 0)
     781  (uuo-kernel-service (:$ arch::error-resume-all))
     782  (mov arg_z 'nil)
     783  (bx lr))
     784
     785(defarmlapfunction %kill-tcr ((target arg_z))
     786  (check-nargs 1)
     787  (uuo-kernel-service (:$ arch::error-kill))
     788  (mov arg_z 'nil)
     789  (cmp imm0 (:$ 0))
     790  (addne arg_z arg_z (:$ arm::t-offset))
     791  (bx lr))
     792
    759793#+later
    760794(progn
    761 
    762 (defarmlapfunction %%tcr-interrupt ((target arg_z))
    763   (check-nargs 1)
    764   (uuo_interr arch::error-interrupt rzero)
    765   (box-fixnum arg_z imm0)
    766   (bx lr))
    767 
    768 (defarmlapfunction %suspend-tcr ((target arg_z))
    769   (check-nargs 1)
    770   (uuo_interr arch::error-suspend rzero)
    771   (ne0->boolean arg_z imm0 imm1)
    772   (bx lr))
    773 
    774 (defarmlapfunction %suspend-other-threads ()
    775   (check-nargs 0)
    776   (uuo_interr arch::error-suspend-all rzero)
    777   (li arg_z nil)
    778   (bx lr))
    779 
    780 (defarmlapfunction %resume-tcr ((target arg_z))
    781   (check-nargs 1)
    782   (uuo_interr arch::error-resume rzero)
    783   (ne0->boolean arg_z imm0 imm1)
    784   (bx lr))
    785 
    786 (defarmlapfunction %resume-other-threads ()
    787   (check-nargs 0)
    788   (uuo_interr arch::error-resume-all rzero)
    789   (li arg_z nil)
    790   (bx lr))
    791 
    792 (defarmlapfunction %kill-tcr ((target arg_z))
    793   (check-nargs 1)
    794   (uuo_interr arch::error-kill rzero)
    795   (ne0->boolean arg_z imm0 imm1)
    796   (bx lr))
    797 
    798795(defarmlapfunction %atomic-pop-static-cons ()
    799796  (li imm0 (+ (target-nil-value) (arm::kernel-global static-conses)))
     
    856853  (li arg_z nil)
    857854  (bx lr))
    858 ); #+later
     855);#+later
     856
    859857
    860858
Note: See TracChangeset for help on using the changeset viewer.