/fth/bench.fth
Forth | 198 lines | 176 code | 22 blank | 0 comment | 0 complexity | d183a4ab8403cf86a00a80fe1bbfa7c1 MD5 | raw file
- \ @(#) 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