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). 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.
-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 Answer 1
I see some things that could be improved with this code.
Fix exetime
The exetime word is defined like this:
: exetime utime 2>r quicksort execute utime 2r> d- ." dtime " . cr ;
There are a number of problems with that. First, the formatting is not very good. I'd prefer to see a stack comment, for example. Second, this should probably take a parameter so that any word can be timed (this appears to be the intent from run). Third, that last . should be d. to display the entire delta time rather than just half of it.
: exetime ( fp -- )
utime 2>r execute utime 2r> d- ." dtime " d. cr
;
Use smaller words
Again using exetime as an example, there are actually two things done by the word as defined. The first is that it calculates a delta time, and the second is that it prints that time. I'd make those separate words.
Follow Forth convention
It's common to use prefixes to simplify code. For example, everywhere ssrt is used, it's followed by @. For that reason, I'd define and use word like these:
: @ssrt ssrt @ ;
: @size size @ ;
: !size size ! ;
Define and use common idioms
A number of cases in the code there is a sequence like this: size @ . but there is a common idiom for that and it's built in to many Forth implementations. If it's not, it's easy to define:
: ? ( a -- ) @ . ;
It would be used like this: size ?. Alternatively, one could use the prefix idiom which is associated with a particular value:
: ?size ( -- ) size @ . ;
Eliminate unused variables
The logs variable is defined but never used. This needlessly clutters the code.
Simplify control structure
Instead of using begin .. while .. repeat, it's often the case that one can use begin .. until instead and simplify the code. Using the refactored smaller words as suggested above, here's what run looks like now:
: run ( fp )
>r
begin
copy-array
array-limits r@ exetime
." size " ?size ." dtime " d. cr
size2x total-size > until
rdrop
;
These are the refactored words:
: exetime ( fp -- ) utime 2>r execute utime 2r> d- ;
: copy-array ( -- ) data @ ssrt @ size @ cells move ;
: array-limits ( -- alo ahi ) ssrt @ dup size @ cells + swap ;
: @size ( -- n ) size @ ;
: ?size ( -- ) @size . ;
: size2x ( -- n ) size @ 2 * dup size ! ;
Make sure comments don't lie
The shuffle word starts like this:
: shuffle ( n a -- )
However, that's not correct. It should instead be:
: shuffle ( n1 n2 a -- )
Use refactoring to improve speed
The code currently contains this:
: median_of_3 ( n0 n1 n2 -- n )
>r 2dup > if swap then
r> 2dup > if swap then drop
2dup < if swap then drop
;
However, in addition to being somewhat opaque, it's not as fast as it could be. Refactoring into smaller chunks improves both readability and speed:
\ arrange top two stack values to assure n0 <= n1
: lohi ( n0 n1 -- n0 n1 ) 2dup > if swap then ;
\ arrange top three stack values to assure n0 <= n1 <= n2
: 3sort ( n0 n1 n2 -- n0 n1 n2 ) lohi >r lohi r> lohi ;
\ extract median value from top 3 items on stack
: median_of_3 ( n0 n1 n2 -- n1 ) 3sort drop nip ;
Be aware of non-standard extensions
The code uses the non-standard extensions:
rdrop -rot utime
It is not hard to write replacements for the first two if needed:
: rdrop r> drop ;
: -rot rot rot ;
Since utime is only used in the test code, perhaps it's not as critical. There is no standard replacement.