File: bubble.fs

package info (click to toggle)
gforth 0.7.3+dfsg-9
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 5,992 kB
  • sloc: ansic: 8,535; sh: 3,666; lisp: 1,778; makefile: 1,019; yacc: 186; sed: 141; lex: 102; awk: 21
file content (74 lines) | stat: -rw-r--r-- 1,412 bytes parent folder | download | duplicates (12)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
\ .( 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 Marty Fraeman
\ Johns Hopkins University/Applied Physics Laboratory.

\ MM forth2c doesn't have it !
: mybounds  over + swap ;

1 cells Constant cell

variable seed ( -- addr)

: initiate-seed ( -- )  74755 seed ! ;
: random  ( -- n )  seed @ 1309 * 13849 + 65535 and dup seed ! ;

6000 constant elements ( -- int)

align create list elements 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 mybounds do
    i 2@ > abort" bubble-sort: not sorted"
  cell +loop
;

: bubble ( -- )
\ ." bubbling..." cr
  1 elements 1 do
    list elements i - cells mybounds do
      i 2@ > if i 2@ swap i 2! then
    cell +loop 
  loop
;

: bubble-sort ( -- )
  initiate-seed
  initiate-list
  bubble
  verify-list
;

: bubble-with-flag ( -- )
  1 elements 1 do
    -1 list elements i - cells mybounds do
      i 2@ > if i 2@ swap i 2! drop 0 then
    cell +loop 
    if leave then
  loop
;
  
: bubble-sort-with-flag ( -- )
  initiate-seed
  initiate-list
  bubble-with-flag
  verify-list
;

: main	( -- )
	bubble-sort
\	bubble-sort-with-flag
;