home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
OSK
/
EFFO
/
pd6.lzh
/
TST
/
bubble_sort.tst
< prev
next >
Wrap
Text File
|
1989-12-21
|
1KB
|
70 lines
.( Loading Bubble Sort benchmark...) cr
\ A classical benchmark of an O(n**2) algorithm; Bubble sort
\
\ Part of the programs gathered by John Hennessy for the MIPS
\ RISC project at Stanford. Translated to forth by Matin Freamen,
\ Johns Hopkins University/Applied Physics Laboratory.
4 constant cell
: cells ( n -- m) cell * ;
: align ( -- ) here cell 1- and allot ;
: exchange ( x y -- ) dup @ rot dup @ >r ! r> swap ! ;
variable seed
: initiate-seed ( -- ) 74755 seed ! ;
: random ( -- n ) seed @ 1309 * 13849 + 65535 and dup seed ! ;
500 constant elements
align create list elements 1+ cells allot
: initiate-list ( -- )
list elements cells + list do random i ! cell +loop ;
: dump-list ( -- )
list elements cells + list do i @ . cell +loop cr ;
: verify-list ( -- )
list elements 1- cells + list do
i @ i cell + @ > abort" bubble-sort: not sorted"
cell +loop ;
: bubble ( -- )
1 elements 1- do
list i cells + list do
i @ i cell + @ >
if i i cell + exchange then
cell +loop
-1 +loop ;
: bubble-sort ( -- )
initiate-seed
initiate-list
bubble
verify-list ;
: bubble-with-flag
1 elements 1- do
true
list i cells + list do
i @ i cell + @ >
if i i cell + exchange
drop false
then
cell +loop
if leave then
-1 +loop ;
: bubble-sort-with-flag ( -- )
initiate-seed
initiate-list
bubble-with-flag
verify-list ;
forth only