[pforth] / fth / bench.fth

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