Annotation of gforth/bubble.fs, revision 1.2
1.1 anton 1: \ .( Loading Bubble Sort benchmark...) cr
2:
3: \ A classical benchmark of an O(n**2) algorithm; Bubble sort
4: \
5: \ Part of the programs gathered by John Hennessy for the MIPS
6: \ RISC project at Stanford. Translated to forth by Marty Fraeman
7: \ Johns Hopkins University/Applied Physics Laboratory.
8:
9: \ MM forth2c doesn't have it !
10: : mybounds over + swap ;
11:
1.2 ! jwilke 12: 1 cells Constant cell
! 13:
1.1 anton 14: variable seed ( -- addr)
15:
16: : initiate-seed ( -- ) 74755 seed ! ;
17: : random ( -- n ) seed @ 1309 * 13849 + 65535 and dup seed ! ;
18:
19: 6000 constant elements ( -- int)
20:
21: align create list elements cells allot
22:
23: : initiate-list ( -- )
24: list elements cells + list do random i ! cell +loop
25: ;
26:
27: : dump-list ( -- )
28: list elements cells + list do i @ . cell +loop cr
29: ;
30:
31: : verify-list ( -- )
32: list elements 1- cells mybounds do
33: i 2@ > abort" bubble-sort: not sorted"
34: cell +loop
35: ;
36:
37: : bubble ( -- )
38: \ ." bubbling..." cr
39: 1 elements 1 do
40: list elements i - cells mybounds do
41: i 2@ > if i 2@ swap i 2! then
42: cell +loop
43: loop
44: ;
45:
46: : bubble-sort ( -- )
47: initiate-seed
48: initiate-list
49: bubble
50: verify-list
51: ;
52:
53: : bubble-with-flag ( -- )
54: 1 elements 1 do
55: -1 list elements i - cells mybounds do
56: i 2@ > if i 2@ swap i 2! drop 0 then
57: cell +loop
58: if leave then
59: loop
60: ;
61:
62: : bubble-sort-with-flag ( -- )
63: initiate-seed
64: initiate-list
65: bubble-with-flag
66: verify-list
67: ;
68:
69: : main ( -- )
70: bubble-sort
71: \ bubble-sort-with-flag
72: ;
73:
74:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>