\ : -rot rot rot ; \ Your Forth may need this.
25 constant maxnumbers
variable exchanges
create array maxnumbers cells allot
\ To access array.
: array[]
( index -- address) \ A stack comment. An index is on the stack when this word
\ is called; it leaves an address on the stack.
cells array + ;
: ?swap ( n2 n1 -- larger smaller )
dup >r \ Save copy of top number on return-stack.
2dup max -rot min \ Put in order using max and min.
dup r> <> \ Compare new top of stack to original.
exchanges +! ( Increment exchanges if swap was performed.) ;
: swapcells ( adr -- )
dup 2@ \ Fetch 2 consecutive numbers from memory; 1st one is on top.
?swap rot ( Bring adr. to top.) 2! ( Store 2 numbers.) ;
: bubblesort ( last -- )
1- 0 max \ Decrement last, but don't let it be less than zero.
begin
0 exchanges ! \ Set number of exchanges to 0.
dup 0 \ i will range from 0 to last-1
?do i array[] swapcells
loop exchanges @ 0=
until \ Stop when there were no exchanges.
drop ( Discard last.) ;
: getnum ( -- n) \ Get integer from keyboard.
0. \ Push initial value on stack; a double-length number.
pad 16 accept \ Accept up to 16 characters.
pad swap >number 2drop d>s ( Convert double to single.) ;
: main
cr cr cr ." Bubblesort in Forth." cr ." You may enter up to " maxnumbers .
." numbers. Enter 0 when you're finished."
0 \ Number of entries.
begin
cr ." Enter an integer in the range 1 to 32000 > "
getnum 2dup ( count num count num)
swap array[] ! ( count num) tuck ( num count num)
1 min + \ Increment the count if 0 wasn't entered.
( num count) tuck maxnumbers = swap 0= or
until \ Stop when count = maxnumbers or 0 was entered.
dup bubblesort cr
0 ?do i array[] @ . cr
loop ;
main