This page (revision-48) was last changed on 03-Feb-2023 15:21 by Stefan Haubenthal 

This page was created on 04-Dec-2010 12:59 by Carsten Strotmann

Only authorized users are allowed to rename pages.

Only authorized users are allowed to delete pages.

Page revision history

Version Date Modified Size Author Changes ... Change note
48 03-Feb-2023 15:21 163 bytes Stefan Haubenthal to previous typo
47 01-Jan-2021 10:29 164 bytes Carsten Strotmann to previous | to last
46 14-Dec-2014 21:43 35 KB Carsten Strotmann to previous | to last
45 14-Dec-2014 21:42 35 KB Carsten Strotmann to previous | to last
44 01-Nov-2014 17:28 35 KB Carsten Strotmann to previous | to last
43 01-Nov-2014 17:23 35 KB Carsten Strotmann to previous | to last
42 01-Nov-2014 17:22 35 KB Carsten Strotmann to previous | to last Results VCFB 2014
41 22-Sep-2014 19:43 33 KB Carsten Strotmann to previous | to last

Page References

Incoming links Outgoing links
Forth Benchmarks
Forth Benchmarks

Version management

Difference between version and

At line 3 changed 169 lines
Below is a collection of some Benchmarks for Forth83 systems like VolksForth.
I found most of these benchmarks on [comp.lang.forth|http://groups.google.com/group/comp.lang.forth], [Hans Bzemers|http://thebeezspeaks.blogspot.com/] [4th|http://www.xs4all.nl/~thebeez/4tH/foldtree.html] and Marcel Hendrix [benchmark collection|http://home.iae.nl/users/mhx/monsterbench.html]
[{TableOfContents }]
!!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 <url:http://www.lib.uchicago.edu/keith/crisis/benchmarks/tak/> )
: 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 ;
}}}
the Forth Benchmarks have been moved to its own dedicated website at [https://theultimatebenchmark.org|https://theultimatebenchmark.org]
This page (revision-48) was last changed on 03-Feb-2023 15:21 by Stefan Haubenthal  Top