home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd6.lzh / TST / bubble_sort.tst < prev    next >
Text File  |  1989-12-21  |  1KB  |  70 lines
  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 Matin Freamen,
  7. \ Johns Hopkins University/Applied Physics Laboratory.
  8.  
  9.  
  10. 4 constant cell
  11.  
  12. : cells ( n -- m)  cell * ;
  13. : align ( -- ) here cell 1- and allot ;
  14.  
  15. : exchange ( x y -- ) dup @ rot dup @ >r ! r> swap ! ;
  16.  
  17. variable seed
  18.  
  19. : initiate-seed ( -- )  74755 seed ! ;
  20. : random  ( -- n )  seed @ 1309 * 13849 + 65535 and dup seed ! ;
  21.  
  22. 500 constant elements
  23.  
  24. align create list elements 1+ cells allot
  25.  
  26. : initiate-list ( -- )
  27.   list elements cells + list do random i ! cell +loop ;
  28.  
  29. : dump-list ( -- )
  30.   list elements cells + list do i @ . cell +loop cr ;
  31.  
  32. : verify-list ( -- )
  33.   list elements 1- cells + list do
  34.     i @ i cell + @ > abort" bubble-sort: not sorted"
  35.   cell +loop ;    
  36.  
  37. : bubble ( -- )
  38.   1 elements 1- do
  39.     list i cells + list do
  40.       i @ i cell + @ >
  41.       if i i cell + exchange then
  42.     cell +loop 
  43.   -1 +loop ;
  44.  
  45. : bubble-sort ( -- )
  46.   initiate-seed
  47.   initiate-list
  48.   bubble
  49.   verify-list ;
  50.  
  51. : bubble-with-flag
  52.   1 elements 1- do
  53.     true
  54.     list i cells + list do
  55.       i @ i cell + @ >
  56.       if i i cell + exchange
  57.        drop false
  58.       then
  59.     cell +loop 
  60.     if leave then
  61.   -1 +loop ;
  62.   
  63. : bubble-sort-with-flag ( -- )
  64.   initiate-seed
  65.   initiate-list
  66.   bubble-with-flag
  67.   verify-list ;
  68.  
  69. forth only
  70.