Return to bubble.fs CVS log | Up to [gforth] / gforth |
Added cell definition to be ANS compatible.
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: 1 cells Constant cell 13: 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: