Annotation of gforth/bubble.fs, revision 1.1

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: 
        !            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: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>