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>