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
Results#
Name | System | Forth | Benchmark | Time (sec/round) | |
---|---|---|---|---|---|
Carsten Strotmann | Atari Portfolio 8088 4.92Mhz | VolksForth MS-DOS (ITC) | Integer Calc | 4.96 | |
Carsten Strotmann | Amstrad NC100 Z80 4.606Mhz | VolksForth CP/M (ITC) | Integer Calc | 6.23 | |
Martin Metz | Amstrad NC100 Z80 4.606Mhz | VolksForth CP/M (ITC) | GCD 1 | 38.1 | |
Andreas Böhm | Commodore C64 6510 | Audiogenic Forth-64 | Integer Calc | 526 | |
Andreas Böhm | Commodore C64 6510 | Audiogenic Forth-64 | Count Bits | 140.22 | |
Andreas Böhm | Commodore C64 6510 | Audiogenic Forth-64 | Sieve Bench | 18.1 | |
Andreas Böhm | Commodore C64 6510 | Audiogenic Forth-64 | GCD 1 | 215.52 | |
Andreas Böhm | Commodore C64 6510 | Audiogenic Forth-64 | GCD 2 | 84.84 | |
H. Jakob | c't 86 8086 5Mhz | Laxen/Perry F83 | Integer Calc | 9 | |
Neil Franklin | HP 100LX 80186 7.9Mhz | VolksForth 3.81.41 MS-DOS | Integer Calc | 2.8 | |
Carsten Strotmann | Atari 130XE 6502 1.79Mhz | VolksForth 3.81 | Integer Calc | 596 | |
Carsten Strotmann | Atari 130XE 6502 1.79Mhz noDMA | VolksForth 3.81 | Integer Calc | 438 | |
J. Kunz | DEC 3000-600 Alpha 21064 175Mhz | pForth | Integer Calc | 0.091 | |
J. Kunz | DEC 3000-600 Alpha 21064 175Mhz | pForth | Fibonacci 1 | 0.0038 | |
J. Kunz | DEC 3000-600 Alpha 21064 175Mhz | pForth | Fibonacci 2 | 0.00001425 | |
J. Kunz | DEC 3000-600 Alpha 21064 175Mhz | pForth | Nesting 32Mil | 22 | |
J. Kunz | DEC 3000-600 Alpha 21064 175Mhz | pForth | 6502emu | 18 | |
Ingo Soetebier | Nextstation 68040 33Mhz | pfe | Nesting 1Mil | 340 | |
KC85 Team | KC85/4 U880 4Mhz | VolksForth CP/M | Nesting 1Mil | 144 | |
Venty | Thinkpad T61, 2Ghz Core Duo | gforth-fast, Linux | Integer Calc | 0.0013 | |
Venty | Thinkpad T61, 2Ghz Core Duo | gforth, Linux | Integer Calc | 0.0019 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-fast, Linux | Nesting 32Mil | 3.9 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-fast, Linux | Sieve Bench | 0.015 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-fast, Linux | 6502emu | 1 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-dtc, Linux | Nesting 32Mil | 5.5 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-dtc, Linux | Sieve Bench | 0.025 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-dtc, Linux | 6502emu | 1.8 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-itc, Linux | Nesting 32Mil | 6.9 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-itc, Linux | Sieve Bench | 0.028 | |
Venty | Nokia N900 ARM A8 600Mhz | gforth-itc, Linux | 6502emu | 2.2 | |
Thorsten Kuphaldt | Amiga 3000 68030 25Mhz | jforth | Integer Bench | 0.24 | |
Thorsten Kuphaldt | Amiga 3000 68030 25Mhz | jforth | Nesting 1Mil | 1.32 | |
Thorsten Kuphaldt | Amiga 3000 68030 25Mhz | jforth | Memory Move | 0.67 | |
Thorsten Kuphaldt | Amiga 3000 68030 25Mhz | jforth | Sieve Bench | 0.148 | |
Thorsten Kuphaldt | Amiga 3000 68030 25Mhz | jforth | GCD 1 | 0.64 | |
Stefan Herold | Amstrad 6128+ Z80A 4Mhz | Uniforth | Integer Calc | 17 | |
Stefan Herold | Amstrad 6128+ Z80A 4Mhz | Uniforth | Fibonacci 2 | 0.23 | |
Stefan Herold | Amstrad 6128+ Z80A 4Mhz | Uniforth | Nesting 1Mil | 206 | |
Stefan Herold | Amstrad 6128+ Z80A 4Mhz | Uniforth | Sieve Bench | 12 | |
Ingo Soetebier | iBook PPC 750lx (G3) 600Mhz | OpenFirmware | Integer Calc | 0.03 | |
Ingo Soetebier | iBook PPC 750lx (G3) 600Mhz | OpenFirmware | Fibonacci 1 | 0.0026 | |
Ingo Soetebier | iBook PPC 750lx (G3) 600Mhz | OpenFirmware | Fibonacci 2 | 0.0027 | |
Ingo Soetebier | iBook PPC 750lx (G3) 600Mhz | OpenFirmware | Nesting 1Mil | 1 | |
Ingo Soetebier | iBook PPC 750lx (G3) 600Mhz | OpenFirmware | Sieve Bench | 0.031 | |
Ingo Soetebier | iBook PPC 750lx (G3) 600Mhz | OpenFirmware | GCD 1 | 0.024 | |
Michael Kalus | Rockwell R1200-14, 2Mhz 65F12 | RSC-Forth | Fibonacci 1 | 16.09 | |
Michael Kalus | Rockwell R1200-14, 2Mhz 65F12 | RSC-Forth | Fibonacci 2 | 0.05 | |
Michael Kalus | Rockwell R1200-14, 2Mhz 65F12 | RSC-Forth | Nesting 1Mil | 149 | |
Michael Kalus | Rockwell R1200-14, 2Mhz 65F12 | RSC-Forth | Integer Calc | 31 | |
Matthias Trute | Atmega16 8MHz | amForth 4.4 | Integer Calc | 1.56 | |
Matthias Trute | Atmega16 8MHz | amForth 4.4 | Fibonacci 1 | 1.46 | |
Matthias Trute | Atmega16 8MHz | amForth 4.4 | Fibonacci 2 | 0.0047 | |
Matthias Trute | Atmega16 8MHz | amForth 4.4 | Nesting 1Mil | 15.4 | |
Matthias Trute | Atmega16 8MHz | amForth 4.4 | Nesting 32Mil | 489 | |
Matthias Trute | Atmega16 8MHz | amForth 4.4 | GCD 1 | 7.12 | |
Matthias Trute | Atmega16 8MHz | amForth 4.4 | GCD 2 | 10.5 | |
Matthias Trute | Atmega16 8MHz | amForth 4.4 | Takeuchi | 0.7 |
Benchme Helper#
: beep ( -- ) \ emits an audible beep signal 7 con! ; \ this is hardware and implementation dependent : benchme ( xt n -- ) \ executes the word with the execution token 'xt' n-times dup >r \ save number of iterations beep \ signal of benchmark start 0 do dup execute loop \ execute word. word must have a neutral stack effect beep \ signal benchmark end cr r> . ." Iterations." cr \ emit message ;
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 + ; : fib1-bench 20 0 do i fib1 drop loop ;
Fibonacci 2#
: fib2 ( n1 -- n2 ) 0 1 rot 0 ?do over + swap loop drop ; : fib2-bench 20 0 do i fib2 drop loop ;
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 ; : move-bench test-CMOVE test-CMOVE> test-MOVE> test-<MOVE ;
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 ; : gcd1-bench 100 0 DO 100 0 DO j i gcd drop loop loop ;
\ 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 ; : gcd2-bench 100 0 DO 100 0 DO j i gcd2 drop loop loop ;
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 ;
simple 6502 emulator#
\ A simple 6502 emulattion benchmark cas \ only 11 opcodes are implemented. The memory layout is: \ 2kB RAM at 0000-07FF, mirrored throughout 0800-7FFF \ 16kB ROM at 8000-BFFF, mirrored at C000 decimal create ram 2048 allot : >ram $7FF and ram + ; create rom 16384 allot : >rom $3FFF and rom + ; \ 6502 registers variable reg-a variable reg-x variable reg-y variable reg-s variable reg-pc : reg-pc+ reg-pc +! ; \ 6502 flags variable flag-c variable flag-n variable cycle variable flag-z variable flag-v : cycle+ cycle +! ; hex : w@ dup c@ swap 1+ c@ 100 * or ; : cs@ c@ dup 80 and if 100 - then ; : read-byte ( address -- ) dup 8000 < if >ram c@ else >rom c@ then ; : read-word ( address -- ) dup 8000 < if >ram w@ else >rom w@ then ; : dojmp ( JMP aaaa ) reg-pc @ >rom w@ reg-pc ! 3 cycle+ ; : dolda ( LDA aa ) reg-pc @ >rom c@ ram + c@ dup dup reg-a ! flag-z ! 80 and flag-n ! 1 reg-pc+ 3 cycle+ ; : dosta ( STA aa ) reg-a @ reg-pc @ >rom c@ ram + c! 1 reg-pc+ 3 cycle+ ; : dobeq ( BEQ <aa ) flag-z @ 0= if reg-pc @ >rom cs@ 1+ reg-pc+ else 1 reg-pc+ then 3 cycle+ ; : doldai ( LDA #aa ) reg-pc @ >rom c@ dup dup reg-a ! flag-z ! 80 and flag-n ! 1 reg-pc+ 2 cycle+ ; : dodex ( DEX ) reg-x @ 1- FF and dup dup reg-x ! flag-z ! 80 and flag-n ! 2 cycle+ ; : dodey ( DEY ) reg-y @ 1- ff and dup dup reg-y ! flag-z ! 80 and flag-n ! 2 cycle+ ; : doinc ( INC aa ) reg-pc @ >rom c@ ram + dup c@ 1+ FF and dup -rot swap c! dup flag-z ! 80 and flag-n ! 1 reg-pc+ 3 cycle+ ; : doldy ( LDY aa ) reg-pc @ >rom c@ dup dup reg-y ! flag-z ! 80 and flag-n ! 1 reg-pc+ 2 cycle+ ; : doldx ( LDX #aa ) reg-pc @ >rom c@ dup dup reg-x ! flag-z ! 80 and flag-n ! 1 reg-pc+ 2 cycle+ ; : dobne ( BNE <aa ) flag-z @ if reg-pc @ >rom cs@ 1+ reg-pc+ else 1 reg-pc+ then 3 cycle+ ; : 6502emu ( cycles -- ) begin cycle @ over < while reg-pc @ >rom c@ 1 reg-pc+ dup 4C = if dojmp then dup A5 = if dolda then dup 85 = if dosta then dup F0 = if dobeq then dup D0 = if dobne then dup A9 = if doldai then dup CA = if dodex then dup 88 = if dodey then dup E6 = if doinc then dup A0 = if doldy then A2 = if doldx then repeat drop ; create testcode A9 c, 00 c, \ start: LDA #0 85 c, 08 c, \ STA 08 A2 c, 0A c, \ LDX #10 A0 c, 0A c, \ loop1: LDY #10 E6 c, 08 c, \ loop2: INC 08 88 c, \ DEY D0 c, FB c, \ BNE loop2 CA c, \ DEX D0 c, F6 c, \ BNE loop1 4C c, 00 c, 80 C, \ JMP start : init-vm 13 0 do i testcode + c@ i rom + c! loop 0 cycle ! 8000 reg-pc ! ; : bench6502 100 0 do init-vm &6502 6502emu loop ;