File:  [gforth] / gforth / matrix.fs
Revision 1.2: download - view: text, annotated - select for diffs
Sun Mar 28 16:10:03 1999 UTC (22 years, 1 month 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>