Changeset 15081


Ignore:
Timestamp:
Nov 19, 2011, 2:30:43 PM (13 years ago)
Author:
Gary Byers
Message:

Hopefully faster copying between pointers and ivectors/ivectors and
ivectors. If both source and destination are aligned on 32-bit
boundaries, we can use FLDM/FSTM instructions to load/store several
words at a time.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/level-0/ARM/arm-misc.lisp

    r15067 r15081  
    2020(in-package "CCL")
    2121
     22 
    2223;;; Copy N bytes from pointer src, starting at byte offset src-offset,
    2324;;; to ivector dest, starting at offset dest-offset.
    … …  
    2728;;; Does no arg checking of any kind.  Really.
    2829
    29 (defarmlapfunction %copy-ptr-to-ivector ((src (* 1 arm::node-size) )
    30                                          (src-byte-offset 0)
    31                                          (dest arg_x)
    32                                          (dest-byte-offset arg_y)
    33                                          (nbytes arg_z))
     30
     31(defun %copy-ptr-to-ivector (src src-byte-offset dest dest-byte-offset nbytes)
     32  (declare (fixnum src-byte-offset dest-byte-offset nbytes)
     33           (optimize (speed 3) (safety 0)))
     34  (let* ((ptr-align (logand 7 (%ptr-to-int src))))
     35    (declare (type (mod 8) ptr-align))
     36    (if (and (>= nbytes 32)
     37             (= 0 (logand nbytes 3))
     38             (= 0 (logand dest-byte-offset 3))
     39             (= 0 (logand (the fixnum (+ ptr-align src-byte-offset)) 3)))
     40      (%copy-ptr-to-ivector-32bit src src-byte-offset dest dest-byte-offset nbytes)
     41      (%copy-ptr-to-ivector-8bit src src-byte-offset dest dest-byte-offset nbytes))
     42    dest))
     43           
     44(defarmlapfunction %copy-ptr-to-ivector-8bit ((src (* 1 arm::node-size) )
     45                                               (src-byte-offset 0)
     46                                               (dest arg_x)
     47                                               (dest-byte-offset arg_y)
     48                                               (nbytes arg_z))
    3449  (let ((src-reg imm0)
    3550        (src-byteptr temp2)
    … …  
    5772    (bx lr)))
    5873
    59 (defarmlapfunction %copy-ivector-to-ptr ((src (* 1 arm::node-size))
    60                                          (src-byte-offset 0)
    61                                          (dest arg_x)
    62                                          (dest-byte-offset arg_y)
    63                                          (nbytes arg_z))
     74;;; Everything's aligned OK and NBYTES is a multiple of 4.
     75(defarmlapfunction %copy-ptr-to-ivector-32bit ((src (* 1 arm::node-size) )
     76                                               (src-byte-offset 0)
     77                                               (dest arg_x)
     78                                               (dest-byte-offset arg_y)
     79                                               (nbytes arg_z))
     80  (add imm1 vsp (:$ (* 2 arm::node-size)))
     81  (build-lisp-frame imm0 imm1)
     82  (add lr dest (:$ arm::misc-data-offset))
     83  (add lr lr (:asr dest-byte-offset (:$ arm::fixnumshift)))
     84  (ldr temp0 (:@ vsp (:$ src)))
     85  (ldr imm1 (:@ vsp (:$ src-byte-offset)))
     86  (macptr-ptr imm0 temp0)
     87  (add imm0 imm0 (:asr imm1 (:$ arm::fixnumshift)))
     88  (b @test32)
     89  @loop32
     90  (fldmias s0 (:! imm0) 8)
     91  (fstmias s0 (:! lr) 8)
     92  (sub nbytes nbytes '32)
     93  @test32
     94  (cmp nbytes '32)
     95  (bge @loop32)
     96  (add pc pc (:asr nbytes (:$ arm::fixnumshift)))
     97  (nop)
     98  (b @0)
     99  (b @4)
     100  (b @8)
     101  (b @12)
     102  (b @16)
     103  (b @20)
     104  (b @24)
     105  (b @28)
     106  (nop)
     107  @0
     108  (mov arg_z dest)
     109  (restore-lisp-frame imm0)
     110  (bx lr)
     111  @4
     112  (flds s0 (:@ imm0 (:$ 0)))
     113  (fsts s0 (:@ lr (:$ 0)))
     114  (b @0)
     115  @8
     116  (fldmias s0 imm0 2)
     117  (fstmias s0 lr 2)
     118  (b @0)
     119  @12
     120  (fldmias s0 imm0 3)
     121  (fstmias s0 lr 3)
     122  (b @0)
     123  @16
     124  (fldmias s0 imm0 4)
     125  (fstmias s0 lr 4)
     126  (b @0)
     127  @20
     128  (fldmias s0 imm0 5)
     129  (fstmias s0 lr 5)
     130  (b @0)
     131  @24
     132  (fldmias s0 imm0 6)
     133  (fstmias s0 lr 6)
     134  (b @0)
     135  @28
     136  (fldmias s0 imm0 7)
     137  (fstmias s0 lr 7)
     138  (b @0))
     139 
     140
     141(defun %copy-ivector-to-ptr (src src-byte-offset dest dest-byte-offset nbytes)
     142  (declare (fixnum src-byte-offset dest-byte-offset nbytes)
     143           (optimize (speed 3) (safety 0)))
     144  (let* ((ptr-align (logand (the (unsigned-byte 32)(%ptr-to-int dest)) 7)))
     145    (declare (type (mod 8) ptr-align))
     146    (if (or (< nbytes 32)
     147            (not (= 0 (logand nbytes 3)))
     148            (not (= 0 (logand src-byte-offset 3)))
     149            (not (= 0 (logand (the fixnum (+ ptr-align dest-byte-offset)) 3))))
     150      (%copy-ivector-to-ptr-8bit src src-byte-offset dest dest-byte-offset nbytes)
     151      (%copy-ivector-to-ptr-32bit src src-byte-offset dest dest-byte-offset nbytes))
     152    dest))
     153
     154(defarmlapfunction %copy-ivector-to-ptr-8bit ((src (* 1 arm::node-size))
     155                                              (src-byte-offset 0)
     156                                              (dest arg_x)
     157                                              (dest-byte-offset arg_y)
     158                                              (nbytes arg_z))
    64159  (ldr temp0 (:@ vsp (:$ src)))
    65160  (cmp nbytes (:$ 0))
    … …  
    81176  (bx lr))
    82177
    83 (defarmlapfunction %copy-ivector-to-ivector ((src 4)
    84                                              (src-byte-offset 0)
    85                                              (dest arg_x)
    86                                              (dest-byte-offset arg_y)
    87                                              (nbytes arg_z))
     178;;; Everything's aligned OK and NBYTES is a multiple of 4.
     179(defarmlapfunction %copy-ivector-to-ptr-32bit ((src (* 1 arm::node-size) )
     180                                               (src-byte-offset 0)
     181                                               (dest arg_x)
     182                                               (dest-byte-offset arg_y)
     183                                               (nbytes arg_z))
     184  (add imm1 vsp (:$ (* 2 arm::node-size)))
     185  (build-lisp-frame imm0 imm1)
     186  (ldr temp0 (:@ vsp (:$ src)))
     187  (ldr imm1 (:@ vsp (:$ src-byte-offset)))
     188  (add lr temp0 (:$ arm::misc-data-offset))
     189  (add lr lr (:asr imm1 (:$ arm::fixnumshift)))
     190  (macptr-ptr imm0 dest)
     191  (add imm0 imm0 (:asr dest-byte-offset (:$ arm::fixnumshift)))
     192  (b @test32)
     193  @loop32
     194  (fldmias s0 (:! lr) 8)
     195  (fstmias s0 (:! imm0) 8)
     196  (sub nbytes nbytes '32)
     197  @test32
     198  (cmp nbytes '32)
     199  (bge @loop32)
     200  (add pc pc (:asr nbytes (:$ arm::fixnumshift)))
     201  (nop)
     202  (b @0)
     203  (b @4)
     204  (b @8)
     205  (b @12)
     206  (b @16)
     207  (b @20)
     208  (b @24)
     209  (b @28)
     210  (nop)
     211  @0
     212  (mov arg_z dest)
     213  (restore-lisp-frame imm0)
     214  (bx lr)
     215  @4
     216  (flds s0 (:@ lr (:$ 0)))
     217  (fsts s0 (:@ imm0 (:$ 0)))
     218  (b @0)
     219  @8
     220  (fldmias s0 lr 2)
     221  (fstmias s0 imm0 2)
     222  (b @0)
     223  @12
     224  (fldmias s0 lr 3)
     225  (fstmias s0 imm0 3)
     226  (b @0)
     227  @16
     228  (fldmias s0 lr 4)
     229  (fstmias s0 imm0 4)
     230  (b @0)
     231  @20
     232  (fldmias s0 lr 5)
     233  (fstmias s0 imm0 5)
     234  (b @0)
     235  @24
     236  (fldmias s0 lr 6)
     237  (fstmias s0 imm0 6)
     238  (b @0)
     239  @28
     240  (fldmias s0 lr 7)
     241  (fstmias s0 imm0 7)
     242  (b @0))
     243
     244
     245(defun %copy-ivector-to-ivector (src src-byte-offset dest dest-byte-offset nbytes)
     246  (declare (fixnum src-byte-offset dest-byte-offset nbytes))
     247  (if (or (not (eq src dest))
     248          (< dest-byte-offset src-byte-offset)
     249          (>= dest-byte-offset (the fixnum (+ src-byte-offset nbytes))))
     250    (%copy-ivector-to-ivector-postincrement src src-byte-offset dest dest-byte-offset nbytes)
     251    (if (and (eq src dest)
     252             (eql src-byte-offset dest-byte-offset))
     253      dest
     254      (%copy-ivector-to-ivector-predecrement src
     255                                             (the fixnum (+ src-byte-offset nbytes))
     256                                             dest
     257                                             (the fixnum (+ dest-byte-offset nbytes))
     258                                             nbytes)))
     259  dest)
     260
     261(defun %copy-ivector-to-ivector-postincrement (src src-byte-offset dest dest-byte-offset nbytes)
     262  (declare (fixnum src-byte-offset dest-byte-offset nbytes))
     263 
     264  (cond ((or (< nbytes 8)
     265             (not (= (logand src-byte-offset 3)
     266                     (logand dest-byte-offset 3))))
     267         (%copy-ivector-to-ivector-postincrement-8bit src src-byte-offset dest dest-byte-offset nbytes))
     268        (t
     269         (let* ((prefix-size (- 4 (logand src-byte-offset 3))))
     270           (declare (fixnum prefix-size))
     271           (unless (= 4 prefix-size)
     272             (%copy-ivector-to-ivector-postincrement-8bit src src-byte-offset dest dest-byte-offset prefix-size)
     273             (incf src-byte-offset prefix-size)
     274             (incf dest-byte-offset prefix-size)
     275             (decf nbytes prefix-size)))
     276         (let* ((tail-size (logand nbytes 3))
     277                (fullword-size (- nbytes tail-size)))
     278           (declare (fixnum tail-size fullword-size))
     279           (unless (zerop fullword-size)
     280             (%copy-ivector-to-ivector-postincrement-32bit src src-byte-offset dest dest-byte-offset fullword-size))
     281           (unless (zerop tail-size)
     282             (%copy-ivector-to-ivector-postincrement-8bit src (the fixnum (+ src-byte-offset fullword-size)) dest (the fixnum (+ dest-byte-offset fullword-size)) tail-size))))))
     283
     284(defun %copy-ivector-to-ivector-predecrement (src src-byte-offset dest dest-byte-offset nbytes)
     285  (declare (fixnum src-byte-offset dest-byte-offset nbytes))
     286  (cond ((or (< nbytes 8)
     287             (not (= (logand src-byte-offset 3)
     288                     (logand dest-byte-offset 3))))
     289         (%copy-ivector-to-ivector-predecrement-8bit src src-byte-offset dest dest-byte-offset nbytes))
     290    (t
     291      (let* ((suffix-size (logand src-byte-offset 3)))
     292        (declare (fixnum suffix-size))
     293        (unless (zerop suffix-size)
     294          (%copy-ivector-to-ivector-predecrement-8bit src src-byte-offset dest dest-byte-offset suffix-size)
     295          (decf src-byte-offset suffix-size)
     296          (decf dest-byte-offset suffix-size)
     297          (decf nbytes suffix-size)))
     298      (let* ((head-size (logand nbytes 3))
     299             (fullword-size (- nbytes head-size)))
     300        (declare (fixnum head-size fullword-size))
     301        (unless (zerop fullword-size)
     302          (%copy-ivector-to-ivector-predecrement-32bit src src-byte-offset dest dest-byte-offset fullword-size))
     303        (unless (zerop head-size)
     304          (%copy-ivector-to-ivector-predecrement-8bit src (the fixnum (- src-byte-offset fullword-size)) dest (the fixnum (- dest-byte-offset fullword-size)) head-size))))
     305))
     306
     307(defarmlapfunction %copy-ivector-to-ivector-postincrement-8bit ((src 4)
     308                                                                (src-byte-offset 0)
     309                                                                (dest arg_x)
     310                                                                (dest-byte-offset arg_y)
     311                                                                (nbytes arg_z))
    88312  (let ((rsrc temp0)
    89313        (scaled-src-idx imm1)
    90314        (scaled-dest-idx imm2)
    91         (val imm0)
    92         (nwords dest-byte-offset))
     315        (val imm0))
    93316    (cmp nbytes (:$ 0))
    94317    (vpop1 scaled-src-idx)
    95318    (mov scaled-src-idx (:lsr scaled-src-idx (:$ arm::fixnumshift)))
    96     (mov val scaled-src-idx)
    97319    (add scaled-src-idx scaled-src-idx (:$ arm::misc-data-offset))
     320    (mov scaled-dest-idx (:lsr dest-byte-offset (:$ arm::fixnumshift)))
     321    (add scaled-dest-idx scaled-dest-idx (:$ arm::misc-data-offset))   
    98322    (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)
    120323    (b @test)
    121324    @loop
    122325    (subs nbytes nbytes '1)
    123     (ldrb val (:@ temp0 scaled-src-idx))
     326    (ldrb val (:@ rsrc scaled-src-idx))
    124327    (add scaled-src-idx scaled-src-idx (:$ 1))
    125328    (strb val (:@ dest scaled-dest-idx))
    126329    (add scaled-dest-idx scaled-dest-idx (:$ 1))
    127330    @test
    128     (bne  @loop)
    129     @done
     331    (bne @loop)
    130332    (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 
    138  
    139     ;; Copy backwards when src & dest are the same and we're sliding down
    140     @bwd
    141     (add scaled-src-idx scaled-src-idx (:lsr nbytes (:$ arm::fixnumshift)))
    142     (add scaled-dest-idx scaled-dest-idx (:lsr nbytes (:$ arm::fixnumshift)))
    143     @loop2
     333    (bx lr)))
     334
     335(defarmlapfunction %copy-ivector-to-ivector-postincrement-32bit ((src 4)
     336                                                                 (src-byte-offset 0)
     337                                                                 (dest arg_x)
     338                                                                 (dest-byte-offset arg_y)
     339                                                                 (nbytes arg_z))
     340  (let ((rsrc temp0)
     341        (scaled-src-idx imm1)
     342        (scaled-dest-idx imm2)
     343        (val imm0))
     344    (cmp nbytes '32)
     345    (vpop1 scaled-src-idx)
     346    (mov scaled-src-idx (:lsr scaled-src-idx (:$ arm::fixnumshift)))
     347    (add scaled-src-idx scaled-src-idx (:$ arm::misc-data-offset))
     348    (mov scaled-dest-idx (:lsr dest-byte-offset (:$ arm::fixnumshift)))
     349    (add scaled-dest-idx scaled-dest-idx (:$ arm::misc-data-offset))   
     350    (vpop1 rsrc)
     351    (build-lisp-frame imm0)             
     352    (b @test)
     353    @loop
     354    (sub nbytes nbytes '32)
     355    (cmp nbytes '32)
     356    (add lr rsrc scaled-src-idx)
     357    (fldmias s0 lr 8)
     358    (add scaled-src-idx scaled-src-idx (:$ 32))
     359    (add lr dest scaled-dest-idx)
     360    (fstmias s0 lr 8)
     361    (add scaled-dest-idx scaled-dest-idx (:$ 32))
     362    @test
     363    (bge @loop)
     364    (add pc pc (:asr nbytes (:$ arm::fixnumshift)))
     365    (nop)
     366    (b @0)
     367    (b @4)
     368    (b @8)
     369    (b @12)
     370    (b @16)
     371    (b @20)
     372    (b @24)
     373    (b @28)
     374    (nop)
     375    @4
     376    (ldr val (:@ rsrc scaled-src-idx))
     377    (str val (:@ dest scaled-dest-idx))
     378    (b @0)
     379    @8
     380    (add lr rsrc scaled-src-idx)
     381    (fldmias s0 lr 2)
     382    (add lr dest scaled-dest-idx)
     383    (fstmias s0 lr 2)
     384    (b @0)
     385    @12
     386    (add lr rsrc scaled-src-idx)
     387    (fldmias s0 lr 3)
     388    (add lr dest scaled-dest-idx)
     389    (fstmias s0 lr 3)
     390    (b @0)
     391    @16
     392    (add lr rsrc scaled-src-idx)
     393    (fldmias s0 lr 4)
     394    (add lr dest scaled-dest-idx)
     395    (fstmias s0 lr 4)
     396    (b @0)
     397    @20
     398    (add lr rsrc scaled-src-idx)
     399    (fldmias s0 lr 5)
     400    (add lr dest scaled-dest-idx)
     401    (fstmias s0 lr 5)
     402    (b @0)
     403    @24
     404    (add lr rsrc scaled-src-idx)
     405    (fldmias s0 lr 6)
     406    (add lr dest scaled-dest-idx)
     407    (fstmias s0 lr 6)
     408    (b @0)
     409    @28
     410    (add lr rsrc scaled-src-idx)
     411    (fldmias s0 lr 7)
     412    (add lr dest scaled-dest-idx)
     413    (fstmias s0 lr 7)
     414    @0
     415    (mov arg_z dest)
     416    (restore-lisp-frame imm0)
     417    (bx lr)))
     418
     419(defarmlapfunction %copy-ivector-to-ivector-predecrement-8bit ((src 4)
     420                                                               (src-byte-offset 0)
     421                                                               (dest arg_x)
     422                                                               (dest-byte-offset arg_y)
     423                                                               (nbytes arg_z))
     424  (let ((rsrc temp0)
     425        (scaled-src-idx imm1)
     426        (scaled-dest-idx imm2)
     427        (val imm0))
     428    (cmp nbytes (:$ 0))
     429    (vpop1 scaled-src-idx)
     430    (mov scaled-src-idx (:lsr scaled-src-idx (:$ arm::fixnumshift)))
     431    (add scaled-src-idx scaled-src-idx (:$ arm::misc-data-offset))
     432    (mov scaled-dest-idx (:lsr dest-byte-offset (:$ arm::fixnumshift)))
     433    (add scaled-dest-idx scaled-dest-idx (:$ arm::misc-data-offset))   
     434    (vpop1 rsrc)
     435    (b @test)
     436    @loop
    144437    (sub scaled-src-idx scaled-src-idx (:$ 1))
    145438    (sub scaled-dest-idx scaled-dest-idx (:$ 1))
    … …  
    147440    (ldrb val (:@ rsrc scaled-src-idx))
    148441    (strb val (:@ dest scaled-dest-idx))
    149     @test2
    150     (bne @loop2)
    151     (b @done)))
    152 
    153 
    154  
     442    @test
     443    (bne @loop)
     444    (mov arg_z dest)
     445    (bx lr)))
     446
     447(defarmlapfunction %copy-ivector-to-ivector-predecrement-32bit ((src 4)
     448                                                                (src-byte-offset 0)
     449                                                                (dest arg_x)
     450                                                                (dest-byte-offset arg_y)
     451                                                                (nbytes arg_z))
     452  (let ((rsrc temp0)
     453        (scaled-src-idx imm1)
     454        (scaled-dest-idx imm2)
     455        (val imm0))
     456    (cmp nbytes (:$ 32))
     457    (vpop1 scaled-src-idx)
     458    (mov scaled-src-idx (:lsr scaled-src-idx (:$ arm::fixnumshift)))
     459    (add scaled-src-idx scaled-src-idx (:$ arm::misc-data-offset))
     460    (mov scaled-dest-idx (:lsr dest-byte-offset (:$ arm::fixnumshift)))
     461    (add scaled-dest-idx scaled-dest-idx (:$ arm::misc-data-offset))   
     462    (vpop1 rsrc)
     463    (build-lisp-frame imm0)             
     464    (b @test)
     465    @loop
     466    (sub scaled-src-idx scaled-src-idx (:$ 32))
     467    (sub scaled-dest-idx scaled-dest-idx (:$ 32))
     468    (sub nbytes nbytes '32)
     469    (cmp nbytes '32)
     470    (add lr rsrc scaled-src-idx)
     471    (fldmias s0 lr 8)
     472    (add lr dest scaled-dest-idx)
     473    (fstmias s0 lr 8)
     474    @test
     475    (bge @loop)
     476    (sub scaled-src-idx scaled-src-idx (:asr nbytes (:$ arm::fixnumshift)))
     477    (sub scaled-dest-idx scaled-dest-idx (:asr nbytes (:$ arm::fixnumshift)))
     478    (add pc pc (:asr nbytes (:$ arm::fixnumshift)))
     479    (nop)
     480    (b @0)
     481    (b @4)
     482    (b @8)
     483    (b @12)
     484    (b @16)
     485    (b @20)
     486    (b @24)
     487    (b @28)
     488    (nop)
     489    @4
     490    (ldr val (:@ rsrc scaled-src-idx))
     491    (str val (:@ dest scaled-dest-idx))
     492    (b @0)
     493    @8
     494    (add lr rsrc scaled-src-idx)
     495    (fldmias s0 lr 2)
     496    (add lr dest scaled-dest-idx)
     497    (fstmias s0 lr 2)
     498    (b @0)
     499    @12
     500    (add lr rsrc scaled-src-idx)
     501    (fldmias s0 lr 3)
     502    (add lr dest scaled-dest-idx)
     503    (fstmias s0 lr 3)
     504    (b @0)
     505    @16
     506    (add lr rsrc scaled-src-idx)
     507    (fldmias s0 lr 4)
     508    (add lr dest scaled-dest-idx)
     509    (fstmias s0 lr 4)
     510    (b @0)
     511    @20
     512    (add lr rsrc scaled-src-idx)
     513    (fldmias s0 lr 5)
     514    (add lr dest scaled-dest-idx)
     515    (fstmias s0 lr 5)
     516    (b @0)
     517    @24
     518    (add lr rsrc scaled-src-idx)
     519    (fldmias s0 lr 6)
     520    (add lr dest scaled-dest-idx)
     521    (fstmias s0 lr 6)
     522    (b @0)
     523    @28
     524    (add lr rsrc scaled-src-idx)
     525    (fldmias s0 lr 7)
     526    (add lr dest scaled-dest-idx)
     527    (fstmias s0 lr 7)
     528    @0
     529    (mov arg_z dest)
     530    (restore-lisp-frame imm0)
     531    (bx lr)))
    155532
    156533(defarmlapfunction %copy-gvector-to-gvector ((src (* 1 arm::node-size))
Note: See TracChangeset for help on using the changeset viewer.