: over swap dup rot rot ;
: rem over over / * - ;

1 2 
begin
  over 4000000 < 
while
  over 2 rem 0 = if
    over mem @ + mem swap !
  else fi
  dup rot +
repeat

mem @ .