Return to optcmove.fs CVS log

Up to [gforth] / gforth / arch / misc

added

    1: \ optimized cmove to use cell wide @ and !
    2: \ (C) Jens Wilke, PUBLIC DOMAIN
    3: 
    4: : (cmove)  ( c_from c_to u -- )
    5:  bounds ?DO  dup c@ I c! 1+  LOOP  drop ;
    6: 
    7: : cmove ( c_from c_to u -- )
    8:   \ check whether optimization makes sense
    9:   dup 20 u< IF (cmove) EXIT THEN
   10:   over [ 1 cells 1- ] Literal and >r
   11:   rot dup [ 1 cells 1- ] Literal and
   12:   dup r> <> 
   13:   \ relative cell offset is not identical fallback to (cmove)
   14:   IF drop -rot (cmove) EXIT THEN
   15:   ?dup 
   16:   IF    ( c_to u c_from u2 )
   17:         [ 1 cells ] Literal swap -
   18:         >r -rot r> tuck - >r >r 2dup r> (cmove) r>
   19:   ELSE  -rot
   20:   THEN
   21:   >r aligned swap aligned swap r>
   22:   2dup dup [ 1 cells 1- ] Literal and dup >r - + >r
   23:   [ 1 cells 2 = [IF] ]
   24:     1
   25:   [ [THEN] ]
   26:   [ 1 cells 4 = [IF] ]
   27:     2
   28:   [ [THEN] ]
   29:   [ 1 cells 8 = [IF] ]
   30:     3
   31:   [ [THEN] ]
   32:   tuck rshift -rot rshift swap bounds
   33:   DO dup @ I cells ! cell+ LOOP
   34:   r> r> (cmove) ;