X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/a1f4e52df60d8f26327ed57f5a9e7b70d0a04273..8e9db35f299d8f606ba003d3cd8fa9e2c868c880:/fth/bench.fth diff --git a/fth/bench.fth b/fth/bench.fth index bd5c430..40262ec 100644 --- a/fth/bench.fth +++ b/fth/bench.fth @@ -1,198 +1,198 @@ -\ @(#) 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 - -: ( --- #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 swap drop - LOOP . ." primes " CR ; - -: SIEVE50 ." 50 iterations " CR 0 50 0 - DO 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 +\ @(#) 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 + +: ( --- #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 swap drop + LOOP . ." primes " CR ; + +: SIEVE50 ." 50 iterations " CR 0 50 0 + DO 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