1: \ divspeed.fs
2: \
3: \ Measure speed of division words in gforth.
4: \
5: \ Krishna Myneni, 2006-10-26;
6: \ Revisions:
7: \ 2006-10-28 change DIVIDEND for 32-bit systems;
8: \ add tests for */ and M*/ ae, km
9: (
10: In the development version of gforth, code has been added to test for division
11: by zero in the division words. We want to measure the performance penalty
12: introduced by these tests. Words to be checked are:
13:
14: /
15: MOD
16: /MOD
17: */
18: */MOD
19: FM/MOD
20: SM/REM
21: UM/MOD
22: M*/
23: )
24:
25: : ms@ ( -- u | return time in ms) cputime d+ 1 1000 m*/ d>s ;
26: : ?allot ( u -- a ) here swap allot ;
27: : table ( v1 v2 ... vn n <name> -- | create a table of singles )
28: create dup cells ?allot over 1- cells + swap
29: 0 ?do dup >r ! r> 1 cells - loop drop ;
30:
31: 1 31 lshift 1- constant DIVIDEND
32: DIVIDEND negate s>d 2constant D_DIVIDEND
33: 10000000 constant N
34:
35: \ Some helpful macros
36: variable xt
37: s" :noname [ xt @ >name name>string ] 2literal type ms@" 2constant s1
38:
39: : get-xt ( "op" -- ) bl word find 0= ABORT" Unknown word!" xt ! ;
40:
41: : testA ( "op" -- )
42: get-xt s1 evaluate
43: s" DIVIDEND N 1 DO dup I" evaluate xt @ compile,
44: s" drop LOOP drop ;" evaluate ; immediate
45:
46: : testB ( "op" -- )
47: get-xt s1 evaluate
48: s" DIVIDEND N 1 DO dup I" evaluate xt @ compile,
49: s" 2drop LOOP drop ;" evaluate ; immediate
50:
51: : testC ( "op" -- )
52: get-xt s1 evaluate
53: s" D_DIVIDEND N 1 DO 2dup I" evaluate xt @ compile,
54: s" 2drop LOOP 2drop ;" evaluate ; immediate
55:
56: : testD ( "op" -- )
57: get-xt s1 evaluate
58: s" DIVIDEND s>d N 1 DO 2dup I" evaluate xt @ compile,
59: s" 2drop LOOP 2drop ;" evaluate ; immediate
60:
61: : testE ( "op" -- )
62: get-xt s1 evaluate
63: s" D_DIVIDEND N 1 DO 2dup I" evaluate xt @ compile,
64: s" drop LOOP 2drop ;" evaluate ; immediate
65:
66: : testF ( "op" -- )
67: get-xt s1 evaluate
68: s" D_DIVIDEND N 1 DO 2dup 1 I" evaluate xt @ compile,
69: s" 2drop LOOP 2drop ;" evaluate ; immediate
70:
71: \ The tests return the start time in ms
72:
73: testA /
74: testA MOD
75: testB /MOD
76: testE */
77: testC */MOD
78: testC FM/MOD
79: testC SM/REM
80: testD UM/MOD ( testC causes overflow for UM/MOD )
81: testF M*/
82: 9 table tests
83:
84: : .elapsed ( starttime -- ) ms@ 9 emit swap - 4 .r ." ms" ;
85:
86: : run-tests
87: cr ." Speed Tests:"
88: 9 0 DO cr I cells tests + @ execute .elapsed LOOP cr ;
89:
90:
91: run-tests
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>