[gforth] / gforth / bubble.fs

gforth: gforth/bubble.fs

1 :	anton	1.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 :
12 :			variable seed ( -- addr)
13 :
14 :			: initiate-seed ( -- ) 74755 seed ! ;
15 :			: random ( -- n ) seed @ 1309 * 13849 + 65535 and dup seed ! ;
16 :
17 :			6000 constant elements ( -- int)
18 :
19 :			align create list elements cells allot
20 :
21 :			: initiate-list ( -- )
22 :			list elements cells + list do random i ! cell +loop
23 :			;
24 :
25 :			: dump-list ( -- )
26 :			list elements cells + list do i @ . cell +loop cr
27 :			;
28 :
29 :			: verify-list ( -- )
30 :			list elements 1- cells mybounds do
31 :			i 2@ > abort" bubble-sort: not sorted"
32 :			cell +loop
33 :			;
34 :
35 :			: bubble ( -- )
36 :			\ ." bubbling..." cr
37 :			1 elements 1 do
38 :			list elements i - cells mybounds do
39 :			i 2@ > if i 2@ swap i 2! then
40 :			cell +loop
41 :			loop
42 :			;
43 :
44 :			: bubble-sort ( -- )
45 :			initiate-seed
46 :			initiate-list
47 :			bubble
48 :			verify-list
49 :			;
50 :
51 :			: bubble-with-flag ( -- )
52 :			1 elements 1 do
53 :			-1 list elements i - cells mybounds do
54 :			i 2@ > if i 2@ swap i 2! drop 0 then
55 :			cell +loop
56 :			if leave then
57 :			loop
58 :			;
59 :
60 :			: bubble-sort-with-flag ( -- )
61 :			initiate-seed
62 :			initiate-list
63 :			bubble-with-flag
64 :			verify-list
65 :			;
66 :
67 :			: main ( -- )
68 :			bubble-sort
69 :			\ bubble-sort-with-flag
70 :			;
71 :
72 :

CVS Admin

gforth: gforth/bubble.fs

ViewCVS and CVS Help