: map-array ( ... addr u xt -- ... )
    \ executes xt ( ... x -- ... ) for every element of the array starting
    \ at addr and containing u elements
    { xt }
    cells over + swap ?do
        i @ xt execute
    1 cells +loop ;

create array 1000 cells allot   
: init  1000 0 DO I  array I cells + !  LOOP ;
init
: step  0 array 1000 ['] + map-array   drop ;
: bench  100000 0 DO step LOOP ;
bench