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>