File: bench.fth

package info (click to toggle)
pforth 21-11
  • links: PTS
  • area: main
  • in suites: lenny, squeeze, wheezy
  • size: 820 kB
  • ctags: 873
  • sloc: ansic: 5,050; makefile: 102
file content (190 lines) | stat: -rw-r--r-- 3,994 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
\ @(#) 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
\
\ 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