[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 :	jwilke	1.2	1 cells Constant cell
13 :
14 :	anton	1.1	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 :

CVS Admin

gforth: gforth/bubble.fs

ViewCVS and CVS Help