File:  [gforth] / gforth / matrix.fs
Revision 1.2: download - view: text, annotated - select for diffs
Sun Mar 28 16:10:03 1999 UTC (20 years, 7 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, v0-6-2, v0-6-1, v0-6-0, v0-5-0, HEAD
minor bugfixes

    1: \ .( Loading Matrix Multiplication benchmark...) cr
    2: \ NOTE: This version needs 0.5MB data space
    3: 
    4: \ A classical benchmark of an O(n**3) algorithm; Matrix Multiplication
    5: \
    6: \ Part of the programs gathered by John Hennessy for the MIPS
    7: \ RISC project at Stanford. Translated to forth by  Marty Fraeman,
    8: \ Johns Hopkins University/Applied Physics Laboratory.
    9: 
   10: \ MM forth2c doesn't have it !
   11: : mybounds  over + swap ;
   12: 
   13: variable seed
   14: 
   15: : initiate-seed ( -- )  74755 seed ! ;
   16: : random  ( -- n )  seed @ 1309 * 13849 + 65535 and dup seed ! ;
   17: 
   18: 200 constant row-size
   19: row-size cells constant row-byte-size
   20: 
   21: row-size row-size * constant mat-size
   22: mat-size cells constant mat-byte-size
   23: 
   24: align create ima mat-byte-size allot
   25: align create imb mat-byte-size allot
   26: align create imr mat-byte-size allot
   27: 
   28: : initiate-matrix ( m[row-size][row-size] -- )
   29:   mat-byte-size mybounds do
   30:     random dup 120 / 120 * - 60 - i !
   31:   cell +loop
   32: ;
   33: 
   34: : innerproduct ( a[row][*] b[*][column] -- int)
   35:   0 row-size 0 do
   36:     >r over @ over @ * r> + >r
   37:     swap cell+ swap row-byte-size +
   38:     r>
   39:   loop
   40:   >r 2drop r>
   41: ;
   42: 
   43: : main  ( -- )
   44:   initiate-seed
   45:   ima initiate-matrix
   46:   imb initiate-matrix 
   47:   imr ima mat-byte-size mybounds do
   48:     imb row-byte-size mybounds do
   49:       j i innerproduct over ! cell+ 
   50:     cell +loop
   51:   row-size cells +loop
   52:   drop
   53: ;
   54: 
   55: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>