[pforth] / fth / bench.fth

\ @(#) bench.fth 97/12/10 1.1
\ Benchmark Forth
\ by Phil Burk
\ 11/17/95
\
\ pForthV9 on Indy, compiled with gcc
\  bench1  took 15 seconds
\  bench2  took 16 seconds
\  bench3  took 17 seconds
\  bench4  took 17 seconds
\  bench5  took 19 seconds
\  sieve   took  4 seconds
\
\ Darren Gibbs reports that on an SGI Octane loaded with multiple users:
\  bench1  took 2.8sec
\  bench2  took 2.7
\  bench3  took 2.9
\  bench4  took 2.1
\  bench 5 took 2.5
\  seive   took .6
\
\ HForth on Mac Quadra 800, 68040
\  bench1  took 1.73 seconds
\  bench2  took 6.48 seconds
\  bench3  took 2.65 seconds
\  bench4  took 2.50 seconds
\  bench5  took 1.91 seconds
\  sieve   took 0.45 seconds
\
\ pForthV9 on Mac Quadra 800
\  bench1  took 40 seconds
\  bench2  took 43 seconds
\  bench3  took 43 seconds
\  bench4  took 44 seconds
\  bench5  took 42 seconds
\  sieve   took 20 seconds
\
\ pForthV9 on PB5300, 100 MHz PPC 603 based Mac Powerbook
\  bench1  took 8.6 seconds
\  bench2  took 9.0 seconds
\  bench3  took 9.7 seconds
\  bench4  took 8.8 seconds
\  bench5  took 10.3 seconds
\  sieve   took 2.3 seconds
\
\ HForth on PB5300
\  bench1  took 1.1 seconds
\  bench2  took 3.6 seconds
\  bench3  took 1.7 seconds
\  bench4  took 1.2 seconds
\  bench5  took 1.3 seconds
\  sieve   took 0.2 seconds

anew task-bench.fth

decimal

\ benchmark primitives
create #do 2000000   ,

: t1           #do @ 0      do                     loop ;
: t2  23 45    #do @ 0      do  swap               loop   2drop ;
: t3  23       #do @ 0      do  dup drop           loop drop ;
: t4  23 45    #do @ 0      do  over drop          loop 2drop ;
: t5           #do @ 0      do  23 45 + drop       loop ;
: t6  23       #do @ 0      do  >r r>              loop drop ;
: t7  23 45 67 #do @ 0      do  rot                loop 2drop drop ;
: t8           #do @ 0      do  23 2* drop         loop  ;
: t9           #do @ 10 / 0 do  23 5 /mod 2drop    loop ;
: t10     #do  #do @ 0      do  dup @ drop         loop drop ;

: foo ( noop ) ;
: t11          #do @ 0      do  foo                loop ;

\ more complex benchmarks -----------------------

\ BENCH1 - sum data ---------------------------------------
create data1 23 , 45 , 67 , 89 , 111 , 222 , 333 , 444 ,
: sum.cells ( addr num -- sum )
    0 swap \ sum
    0 DO
        over \ get address
        i cells + @ +
    LOOP
    swap drop
;

: bench1 ( -- )
    200000 0
    DO
        data1 8 sum.cells drop
    LOOP
;

\ BENCH2 - recursive factorial --------------------------
: factorial ( n -- n! )
    dup 1 >
    IF
        dup 1- recurse *
    ELSE
        drop 1
    THEN
;

: bench2 ( -- )
    200000 0
    DO
        10 factorial drop
    LOOP
;

\ BENCH3 - DEFER ----------------------------------
defer calc.answer
: answer ( n -- m )
    dup +
    $ a5a5 xor
    1000 max
;
' answer is calc.answer
: bench3
    1500000 0
    DO
        i calc.answer drop
    LOOP
;

\ BENCH4 - locals ---------------------------------
: use.locals { x1 x2 | aa bb -- result }
    x1 2* -> aa
    x2 2/ -> bb
    x1 aa *
    x2 bb * +
;

: bench4
    400000 0
    DO
        234 567 use.locals drop
    LOOP
;

\ BENCH5 - string compare -------------------------------
: match.strings { $s1 $s2 | adr1 len1 adr2 len2 -- flag }
    $s1 count -> len1 -> adr1
    $s2 count -> len2 -> adr2
    len1 len2 -
    IF
        FALSE
    ELSE
        TRUE
        len1 0
        DO
            adr1 i + c@
            adr2 i + c@ -
            IF
                drop FALSE
                leave
            THEN
        LOOP
    THEN
;

: bench5 ( -- )
    60000 0
    DO
        " This is a string. X foo"
        " This is a string. Y foo" match.strings drop
    LOOP
;

\ SIEVE OF ERATOSTHENES from BYTE magazine -----------------------

DECIMAL 8190 CONSTANT TSIZE

VARIABLE FLAGS TSIZE ALLOT

: <SIEVE>  ( --- #primes )  FLAGS TSIZE 1 FILL
 0  TSIZE 0
 DO   ( n )  I FLAGS + C@
      IF    I  DUP +  3 +   DUP I +  (  I2*+3 I3*+3 )
           BEGIN  DUP TSIZE <  ( same flag )
           WHILE  0 OVER FLAGS + C! (  i' i'' )   OVER +
           REPEAT 2DROP  1+
      THEN
 LOOP       ;

: SIEVE  ." 10 iterations " CR  0   10 0
  DO     <SIEVE> swap drop
  LOOP   . ." primes " CR ;

: SIEVE50  ." 50 iterations " CR  0   50 0
  DO     <SIEVE> swap drop
  LOOP   . ." primes " CR ;

\ 10 iterations
\ 21.5 sec  Amiga Multi-Forth  Indirect Threaded
\ 8.82 sec  Amiga 1000 running JForth
\ ~5 sec  SGI Indy running pForthV9
Commit	Line	Data
8e9db35f PB	1	\ @(#) bench.fth 97/12/10 1.1
	2	\ Benchmark Forth
	3	\ by Phil Burk
	4	\ 11/17/95
	5	\
	6	\ pForthV9 on Indy, compiled with gcc
	7	\ bench1 took 15 seconds
	8	\ bench2 took 16 seconds
	9	\ bench3 took 17 seconds
	10	\ bench4 took 17 seconds
	11	\ bench5 took 19 seconds
	12	\ sieve took 4 seconds
	13	\
	14	\ Darren Gibbs reports that on an SGI Octane loaded with multiple users:
	15	\ bench1 took 2.8sec
	16	\ bench2 took 2.7
	17	\ bench3 took 2.9
	18	\ bench4 took 2.1
	19	\ bench 5 took 2.5
	20	\ seive took .6
	21	\
	22	\ HForth on Mac Quadra 800, 68040
	23	\ bench1 took 1.73 seconds
	24	\ bench2 took 6.48 seconds
	25	\ bench3 took 2.65 seconds
	26	\ bench4 took 2.50 seconds
	27	\ bench5 took 1.91 seconds
	28	\ sieve took 0.45 seconds
	29	\
	30	\ pForthV9 on Mac Quadra 800
	31	\ bench1 took 40 seconds
	32	\ bench2 took 43 seconds
	33	\ bench3 took 43 seconds
	34	\ bench4 took 44 seconds
	35	\ bench5 took 42 seconds
	36	\ sieve took 20 seconds
	37	\
	38	\ pForthV9 on PB5300, 100 MHz PPC 603 based Mac Powerbook
	39	\ bench1 took 8.6 seconds
	40	\ bench2 took 9.0 seconds
	41	\ bench3 took 9.7 seconds
	42	\ bench4 took 8.8 seconds
	43	\ bench5 took 10.3 seconds
	44	\ sieve took 2.3 seconds
	45	\
	46	\ HForth on PB5300
	47	\ bench1 took 1.1 seconds
	48	\ bench2 took 3.6 seconds
	49	\ bench3 took 1.7 seconds
	50	\ bench4 took 1.2 seconds
	51	\ bench5 took 1.3 seconds
	52	\ sieve took 0.2 seconds
	53
	54	anew task-bench.fth
	55
	56	decimal
	57
	58	\ benchmark primitives
	59	create #do 2000000 ,
	60
	61	: t1 #do @ 0 do loop ;
	62	: t2 23 45 #do @ 0 do swap loop 2drop ;
	63	: t3 23 #do @ 0 do dup drop loop drop ;
	64	: t4 23 45 #do @ 0 do over drop loop 2drop ;
65	: t5 #do @ 0 do 23 45 + drop loop ;
66	: t6 23 #do @ 0 do >r r> loop drop ;
67	: t7 23 45 67 #do @ 0 do rot loop 2drop drop ;
68	: t8 #do @ 0 do 23 2* drop loop ;
69	: t9 #do @ 10 / 0 do 23 5 /mod 2drop loop ;
70	: t10 #do #do @ 0 do dup @ drop loop drop ;
71
72	: foo ( noop ) ;
73	: t11 #do @ 0 do foo loop ;
74
75	\ more complex benchmarks -----------------------
76
77	\ BENCH1 - sum data ---------------------------------------
78	create data1 23 , 45 , 67 , 89 , 111 , 222 , 333 , 444 ,
79	: sum.cells ( addr num -- sum )
80	0 swap \ sum
81	0 DO
82	over \ get address
83	i cells + @ +
84	LOOP
85	swap drop
86	;
87
88	: bench1 ( -- )
89	200000 0
90	DO
91	data1 8 sum.cells drop
92	LOOP
93	;
94
95	\ BENCH2 - recursive factorial --------------------------
96	: factorial ( n -- n! )
97	dup 1 >
98	IF
99	dup 1- recurse *
100	ELSE
101	drop 1
102	THEN
103	;
104
105	: bench2 ( -- )
106	200000 0
107	DO
108	10 factorial drop
109	LOOP
110	;
111
112	\ BENCH3 - DEFER ----------------------------------
113	defer calc.answer
114	: answer ( n -- m )
115	dup +
116	$ a5a5 xor
117	1000 max
118	;
119	' answer is calc.answer
120	: bench3
121	1500000 0
122	DO
123	i calc.answer drop
124	LOOP
125	;
126
127	\ BENCH4 - locals ---------------------------------
128	: use.locals { x1 x2 \| aa bb -- result }
129	x1 2* -> aa
130	x2 2/ -> bb
131	x1 aa *
132	x2 bb * +
133	;
134
135	: bench4
136	400000 0
137	DO
138	234 567 use.locals drop
139	LOOP
140	;
141
142	\ BENCH5 - string compare -------------------------------
143	: match.strings { $s1 $s2 \| adr1 len1 adr2 len2 -- flag }
144	$s1 count -> len1 -> adr1
145	$s2 count -> len2 -> adr2
146	len1 len2 -
147	IF
148	FALSE
149	ELSE
150	TRUE
151	len1 0
152	DO
153	adr1 i + c@
154	adr2 i + c@ -
155	IF
156	drop FALSE
157	leave
158	THEN
159	LOOP
160	THEN
161	;
162
163	: bench5 ( -- )
164	60000 0
165	DO
166	" This is a string. X foo"
167	" This is a string. Y foo" match.strings drop
168	LOOP
169	;
170
171	\ SIEVE OF ERATOSTHENES from BYTE magazine -----------------------
172
173	DECIMAL 8190 CONSTANT TSIZE
174
175	VARIABLE FLAGS TSIZE ALLOT
176
177	: <SIEVE> ( --- #primes ) FLAGS TSIZE 1 FILL
178	0 TSIZE 0
179	DO ( n ) I FLAGS + C@
180	IF I DUP + 3 + DUP I + ( I2+3 I3+3 )
181	BEGIN DUP TSIZE < ( same flag )
182	WHILE 0 OVER FLAGS + C! ( i' i'' ) OVER +
183	REPEAT 2DROP 1+
184	THEN
185	LOOP ;
186
187	: SIEVE ." 10 iterations " CR 0 10 0
188	DO <SIEVE> swap drop
189	LOOP . ." primes " CR ;
190
191	: SIEVE50 ." 50 iterations " CR 0 50 0
192	DO <SIEVE> swap drop
193	LOOP . ." primes " CR ;
194
195	\ 10 iterations
196	\ 21.5 sec Amiga Multi-Forth Indirect Threaded
197	\ 8.82 sec Amiga 1000 running JForth
198	\ ~5 sec SGI Indy running pForthV9