To make a long story short, I must revive my Forth. It is rusty; last time I did anything serious in Forth was 30 years ago (man, I am old). As an exercise, I translated an STL-like implementation of `qsort`. It works (if you want to test it, install [gforth][1]). It performs well comparing to SDCC-compiled native C (I don't have Keil license). I know where my bottlenecks are.

I am mostly interested in how readable the code is; how much did I sin against Forth spirit; if there are modern Forth coding conventions, how does this code fare.

<!-- language: lang-none -->

    -1 cells constant -cell
    : cell- -cell + ;

    : xchg ( a0 a1 -- ) 2dup @ >r @ swap ! r> swap ! ;

    : unguarded_linear_insert ( last val -- )
        >r
        begin cell- dup @ dup r@ > while over cell+ ! repeat
        drop r> swap cell+ !
    ;

    : unguarded_insertion_sort ( first last -- )
        >r
        begin dup r@ <> while dup dup @ unguarded_linear_insert cell+ repeat
        drop rdrop
    ;

    : linear_insert ( first last val -- )
        >r over @ r@ swap <
        if
            begin 2dup <> while cell- dup @ over cell+ ! repeat
            drop r> swap !
        else
            r> unguarded_linear_insert drop
        then
    ;

    : insertion_sort ( first last -- )
        2dup <>
        if
            >r
            dup begin cell+ dup r@ <> while 2dup dup @ linear_insert repeat
            rdrop
        then
        2drop
    ;


    : unguarded_partition ( l f p -- cut )
        >r swap cell-
        begin dup @ r@ > while cell- repeat swap
        begin dup @ r@ < while cell+ repeat swap
        begin 2dup < while
            2dup xchg cell- swap cell+ swap
            begin dup @ r@ > while cell- repeat swap
            begin dup @ r@ < while cell+ repeat swap
        repeat
        swap drop begin dup @ r@ < while cell+ repeat
        rdrop
    ;

    : median_of_3 ( n0 n1 n2 -- n )
        >r 2dup > if swap then
        r> 2dup > if swap then drop
           2dup < if swap then drop
    ;

    : pivot ( l f len -- l f p )
        2 / -cell and over +          ( l f m )
        @ >r over cell- @ over @ r>
        median_of_3
    ;

    : quicksort_loop ( l f t -- )
        begin dup >r -rot 2dup - dup r@ > while
            pivot
            >r 2dup r> unguarded_partition
            >r 2dup + r@ swap r> 2 * < if
                rot over r> recurse swap else
                dup -rot swap r> recurse then
            rot
        repeat
        rdrop 2drop 2drop
    ;

    : quicksort ( l f )
        2dup 2 cells quicksort_loop
        dup 2 cells + dup -rot insertion_sort
        swap unguarded_insertion_sort
    ;

    \ Testing and benchmarking

    include random.fs
    0 random

    : shuffle ( n a -- )
        >r dup
        begin ?dup while 1- 2dup cells r@ + swap rnd swap mod cells r@ + xchg repeat
        rdrop 2drop
    ;

    : fill-i ( n a -- )
        >r
        begin ?dup while 1- dup dup cells r@ + ! repeat
        rdrop
    ;

    : fill-ir ( n a )
        begin 2dup ! cell+ swap 1- ?dup while swap repeat drop
    ;

    1024 1024 * constant total-size
    variable data total-size cells allocate throw data !
    total-size data @ fill-i
    total-size data @ shuffle
    variable ssrt total-size cells allocate throw ssrt !

    : exetime  utime 2>r quicksort execute  utime 2r> d- ." dtime " . cr ;

    variable size 16 size !
    variable logs  4 logs !

    : run ( fp )
        >r
        begin total-size size @ >= while
            data @ ssrt @ size @ cells move
            ssrt @ size @ cells + ssrt @
            size @ . cr
            .s cr
            r@ hex. cr
            r@ exetime
            size @ . size @ m*/
            size @ 2 * size !
        repeat
        rdrop
    ;

    ' quicksort run
    bye


  [1]: https://www.gnu.org/software/gforth/