Forth83 Benchmarks#
Below is a collection of some Benchmarks for Forth83 systems like VolksForth.
I found most of these benchmarks on comp.lang.forth, Hans Bzemers 4th and Marcel Hendrix benchmark collection
Integer Calculations #
32000 constant intMax variable intResult : DoInt 1 dup intResult dup >r ! begin dup intMax < while dup negate r@ +! 1+ dup r@ +! 1+ r@ @ over * r@ ! 1+ r@ @ over / r@ ! 1+ repeat r> drop drop ;
Fibonacci 1#
: fib1 ( n1 -- n2 ) dup 2 < if drop 1 exit then dup 1- recursive swap 2- recursive + ;
Fibonacci 2#
: fib2 ( n1 -- n2 ) dup 2 < if drop 1 else dup 1- recursive swap 2 - recursive + then ;
Forth Nesting Benchmark#
\ Forth nesting (NEXT) Benchmark cas20101204 : bottom ; : 1st bottom bottom ; : 2nd 1st 1st ; : 3rd 2nd 2nd ; : 4th 3rd 3rd ; : 5th 4th 4th ; : 6th 5th 5th ; : 7th 6th 6th ; : 8th 7th 7th ; : 9th 8th 8th ; : 10th 9th 9th ; : 11th 10th 10th ; : 12th 11th 11th ; : 13th 12th 12th ; : 14th 13th 13th ; : 15th 14th 14th ; : 16th 15th 15th ; : 17th 16th 16th ; : 18th 17th 17th ; : 19th 18th 18th ; : 20th 19th 19th ; : 21th 20th 20th ; : 22th 21th 21th ; : 23th 22th 22th ; : 24th 23th 23th ; : 25th 24th 24th ; : 32million CR ." 32 million nest/unnest operations" 25th ; : 1million CR ." 1 million nest/unnest operations" 20th ; CR .( enter 1million or 32million )
Forth Memory Move Benchmark#
\ Forth Memory Move Benchmark cas 20101204 8192 CONSTANT bufsize VARIABLE buf1 HERE bufsize 1+ allot BUF1 ! VARIABLE buf2 HERE bufsize 1+ allot BUF2 ! : test-CMOVE 49 0 DO BUF1 @ BUF2 @ bufsize CMOVE LOOP ; : test-CMOVE> 49 0 DO BUF2 @ BUF1 @ bufsize CMOVE> LOOP ; : test-MOVE> 49 0 DO BUF1 @ BUF2 @ bufsize MOVE LOOP ; : test-<MOVE 49 0 DO BUF2 @ BUF1 @ bufsize MOVE LOOP ;
count bits in byte#
\ Forth Benchmark - count bits in byte cas 20101204 VARIABLE cnt : countbits ( uu -- #bits ) cnt off 8 0 DO dup $01010101 and cnt +! 2/ LOOP drop 0 cnt 4 bounds DO i C@ + LOOP ; : bench5 8192 DO I countbits . LOOP ;
Sieve Benchmark#
\ Sieve Benchmark -- the classic Forth benchmark cas 20101204 8192 CONSTANT SIZE VARIABLE FLAGS 0 FLAGS ! SIZE ALLOT : DO-PRIME FLAGS SIZE 1 FILL ( set array ) 0 ( 0 COUNT ) SIZE 0 DO FLAGS I + C@ IF I DUP + 3 + DUP I + BEGIN DUP SIZE < WHILE 0 OVER FLAGS + C! OVER + REPEAT DROP DROP 1+ THEN LOOP . ." Primes" CR ;
Greatest Common Divisor#
\ gcd - greatest common divisor cas 20101204 : gcd ( a b -- gcd ) OVER IF BEGIN DUP WHILE 2DUP U> IF SWAP THEN OVER - REPEAT DROP ELSE DUP IF NIP ELSE 2DROP 1 THEN THEN ;
\ another gcd O(2) runtime speed cas 20101204 : gcd2 ( a b -- gcd ) 2DUP D0= IF 2DROP 1 EXIT THEN DUP 0= IF DROP EXIT THEN SWAP DUP 0= IF DROP EXIT THEN BEGIN 2DUP - WHILE 2DUP < IF OVER - ELSE SWAP OVER - SWAP THEN REPEAT NIP ;
Takeuchi#
( takeuchi benchmark in volksForth Forth-83 ) ( see http://en.wikipedia.org/wiki/Tak_(function) ) : 3dup 2 pick 2 pick 2 pick ; : tak ( x y z -- t ) over 3 pick < NEGATE IF nip nip exit then 3dup rot 1- -rot recursive >r 3dup swap 1- -rot swap recursive >r 1- -rot recursive r> swap r> -rot recursive ; : takbench ( -- ) 0 &10000 0 DO DROP &18 &12 6 tak LOOP ;