home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd6.lzh / TST / permutations.tst < prev    next >
Text File  |  1989-12-21  |  1KB  |  55 lines
  1. .( Loading Permutation benchmark...) cr
  2.  
  3. \ A heavily recursive permutation program written by Denny Brown
  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. 4 constant cell
  10.  
  11. : cells ( n -- m)  cell * ;
  12. : align ( -- ) here cell 1- and allot ;
  13.  
  14. : exchange ( x y -- ) dup @ rot dup @ >r ! r> swap ! ;
  15.  
  16. : array ( size -- )
  17.   create
  18.     1+ cells allot immediate
  19.   does> ( index array -- element)
  20.     [compile] literal compile + ;
  21.  
  22. 10 constant permrange
  23. align permrange array permarray
  24. variable pctr
  25.  
  26. : initialize-array ( -- )
  27.   8 1 do i 1- i permarray ! loop ;
  28.  
  29. : permute ( n -- )
  30.   1 pctr +!
  31.   dup 1 = not
  32.   if dup 1- dup recurse
  33.     begin
  34.       dup 0>
  35.     while
  36.       over permarray over permarray exchange
  37.       over 1- recurse
  38.       over permarray over permarray exchange
  39.       1-
  40.     repeat
  41.     drop
  42.   then
  43.   drop ;
  44.  
  45. : permutations ( -- )
  46.   0 pctr !
  47.   6 1 do
  48.     initialize-array
  49.     7 permute
  50.   loop
  51.   pctr @ 43300 = not abort" permutations: wrong result" ;
  52.  
  53. forth only
  54.   
  55.