Improved TPK

: partition ( left right -- L1 R1 L2 R2 )
    2dup  dup >r  
    begin
	    swap begin  dup r@  str> while cell+ repeat
	    swap begin  r@ over str> while cell- repeat
	    2dup <= if 2dup exchange  cell- swap  cell+ swap then
    2dup > until
    r> drop    ( L R L2 R1 )
    swap rot   ( L R1 L2 R ) ;