home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd6.lzh / TST / matrix_mult.tst < prev    next >
Text File  |  1989-12-21  |  1KB  |  52 lines
  1. .( Loading Matrix Multiplication benchmark...) cr
  2.  
  3. \ A classical benchmark of an O(n**3) algorithm; Matrix Multiplication
  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. variable seed
  15.  
  16. : initiate-seed ( -- )  74755 seed ! ;
  17. : random  ( -- n )  seed @ 1309 * 13849 + 65535 and dup seed ! ;
  18.  
  19. 40 constant rowsize
  20. rowsize rowsize * cells constant matsize
  21.  
  22. align create ima   rowsize 1+ dup * cells allot
  23. align create imb   rowsize 1+ dup * cells allot
  24. align create imr   rowsize 1+ dup * cells allot
  25.  
  26. : initiate-matrix ( m[rowsize+1][rowsize+1] -- )
  27.   dup matsize + swap do
  28.     random dup 120 / 120 * - 60 - i !
  29.   cell +loop ;
  30.  
  31. : innerproduct ( a[r][*] b[*][c] -- result)
  32.   0 rowsize 0 do
  33.     >r over @ over @ * r> + >r
  34.     cell + swap rowsize cells + swap
  35.     r>
  36.   loop
  37.   swap drop swap drop ;
  38.  
  39. : matrix-mult  ( -- )
  40.   initiate-seed
  41.   ima initiate-matrix
  42.   imb initiate-matrix 
  43.   imr ima matsize + ima do
  44.     imb rowsize cells + imb do
  45.       j i innerproduct over ! cell + 
  46.     cell +loop
  47.   rowsize cells +loop
  48.  drop ;
  49.  
  50. forth only
  51.  
  52.