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>