The ultimate Forth Benchmark

1 About

The Ultimate Benchmark is a competition held during retro computing events. The goal of this competition is not to find the fasted and most capable machine or Forth system, but to price the most active participant.

The Ultimate Benchmark started years ago during an discussion over beer at one VCFe ( http://vcfe.org ) between Hans, Dino and Carsten over wether a 6502 Forth with 1.79 Mhz (Atari 8bit) will be faster or slower than a Z80 Forth at 4 Mhz. It was benchmarked the other day, Z80 won. But we've got hooked and started benchmarking other machines, and Hans turned it into an yearly competition at VCFe in Munich. It is always fun.

If you are new to Forth, don't fear, there are plenty of Forth people around that are eager to help.

2 Rules

  • any Forth permitted
  • any Machine (Retro machines 15 years and older are preferred)
  • each participant can enter a submission for each combination of Forth-System and Machine with at least three (3) of the Benchmarks below
  • The winner will be drawn at the end of the event out of all submissions
  • the more combinations of Forth systems and retro machines one participant has submitted, the greater is the statistical chance to win

3 Forth83 Benchmarks

Below is a collection of some Benchmarks for Forth83 systems like VolksForth.

I found most of these benchmarks on

4 Results VCFe

Name System Forth Benchmark Time (sec/round) Year
Enrico/Dirk Robotron A 7150 i8086/8087 Multibus ~5Mhz VolksForth MS-DOS (ITC) Fibonacci 2 46 2017
Enrico/Dirk Robotron A 7150 i8086/8087 Multibus ~5Mhz VolksForth MS-DOS (ITC) MemMove 8 2017
Enrico/Dirk Robotron A 7150 i8086/8087 Multibus ~5Mhz VolksForth MS-DOS (ITC) GCD 1 25 2017
Enrico/Dirk Robotron A 7150 i8086/8087 Multibus ~5Mhz VolksForth MS-DOS (ITC) GCD 2 30 2017
Ralf Neumann Yodabashi Formula 1 Z80 4Mhz VolksForth CP/M (ITC) GCD 1 42 2017
Ralf Neumann Yodabashi Formula 1 Z80 4Mhz VolksForth CP/M (ITC) Takeuchi 46 2017
Ralf Neumann Yodabashi Formula 1 Z80 4Mhz VolksForth CP/M (ITC) MemMove 24 2017
Carsten Strotmann Scheider Tower AT 220 i286 10Mhz VolksForth MS-DOS (ITC) MemMove 8 (10x) 2017
Carsten Strotmann Scheider Tower AT 220 i286 10Mhz VolksForth MS-DOS (ITC) GCD 1 5 2017
Carsten Strotmann Scheider Tower AT 220 i286 10Mhz VolksForth MS-DOS (ITC) Fibonacci2 8 2017
Carsten Strotmann Amstrad NC100 Z80 4.606Mhz VolksForth CP/M (ITC) Integer Calc 6.23  
Carsten Strotmann Atari Portfolio 8088 4.92Mhz VolksForth MS-DOS (ITC) Integer Calc 4.96  
Martin Metz Amstrad NC100 Z80 4.606Mhz VolksForth CP/M (ITC) GCD 1 38.1  
Andreas Boehm Commodore C64 6510 Audiogenic Forth-64 Integer Calc 526  
Andreas Boehm Commodore C64 6510 Audiogenic Forth-64 Count Bits 140.22  
Andreas Boehm Commodore C64 6510 Audiogenic Forth-64 Sieve Bench 18.1  
Andreas Boehm Commodore C64 6510 Audiogenic Forth-64 GCD 1 215.52  
Andreas Boehm 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  
Michael Kalus MSP430FR5739, 8Mhz DCO intern MSP-EXP430FR5739 Experimenter Board CamelForth Integer Calc 100x 02'45':10  
Michael Kalus MSP430FR5739, 8Mhz DCO intern MSP-EXP430FR5739 Experimenter Board CamelForth FIB1 100x 00'46':39  
Michael Kalus MSP430FR5739, 8Mhz DCO intern MSP-EXP430FR5739 Experimenter Board CamelForth FIB2 10000x 00'16':91  
Michael Kalus MSP430FR5739, 8Mhz DCO intern MSP-EXP430FR5739 Experimenter Board CamelForth Nesting 32Mil 02'31':23  
Carsten Strotmann IBM L40S (386SX) mina (Fig-Forth) Fib2 (1000) 8s  
Carsten Strotmann IBM L40X (386SX) F83 (Laxen & Perry) Fib2 (1000) 8s  
Carsten Strotmann IBM L40X (386SX) GNU Forth 0.5.0 ec8086 Fib2 (1000) 24s  
Carsten Strotmann IBM L40X (386SX) VolksForth MS-DOS Fibonacci 1 0.36s  
Thorsten Schoeler Sinclair Spectrum+ Aber Forth (FIG-Forth) Integer 25s  
Thorsten Schoeler " " prime 11s  
Thorsten Schoeler " " Nesting 1m 3m17s  
Thorsten Schoeler " " GCD1 2m14s  
Thorsten Schoeler " " Fib2 (1000) 1m46s  
Thorsten Schoeler HX-20 Epson Forth E1.0 Fib2 (1000) 3m16s  
Thorsten Schoeler HX-20 " Nesting 32mil 2h43m49s  
Thorsten Schoeler HX-20 " Nesting 1mil 5m08s  
Thorsten Schoeler HX-20 " Integer 32tsd 1m03s  
Thorsten Schoeler HX-20 6301 614khz " Prime 23s  
Thorsten Schoeler ZX Spectrum 2+ FIG-Forth 1.1a Nesting 3m15s  
Thorsten Schoeler ZX Spectrum 2+ " MemMove 10s  
Thorsten Schoeler ZX Spectrum 2+ Spect ZX Forth 1.1 Nesting 4m13s  
Thorsten Schoeler ZX Spectrum 2+ " MemMove 28s  
Wolfgang Stief SUN SparcStation 10 TI TMS390255 OpenFirmware Integer 0,14s  
Wolfgang Stief SUN SparcStation 10 TI TMS390255 OpenFirmware Fib1 0,005s  
Wolfgang Stief SUN SparcStation 10 TI TMS390255 OpenFirmware Fib2 0,2s  
Wolfgang Stief SUN SparcStation 10 TI TMS390255 OpenFirmware Memory Move 143s  
Wolfgang Stief SUN SparcStation 10 TI TMS390255 OpenFirmware Prime 0,11s  
Wolfgang Stief SUN SparcStation 10 TI TMS390255 OpenFirmware GCD1 0,51s  
Wolfgang Stief SUN SparcStation 10 TI TMS390255 OpenFirmware GCD2 0,65s  
Wolfgang Stief SUN SparcStation 10 TI TMS390255 OpenFirmware Takeuchi 0,06s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 Integer 0,33s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 Fib1 0,014s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 Fib2 0,06s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 Nesting 32mil 9s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 Mempry Move 0,014s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 Prime 0,03s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 GCD1 0,08s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 GCD2 0,11s  
Wolfgang Stief SUN Ultra 1 200 Mhz UltraSprac OpenBoot 3.25 Takeuchi 0,009s  
Thorsten Schoeler Fignition (ATMEL) Fignition Forth fib2 (1000) 13s  
Stefan Niestegge Atari Falcom 68060 100mhz f68kans Integer 0,022s  
Stefan Niestegge Atari Falcon 68060 100mhz f68kans Fib2 0,0012s  
Stefan Niestegge Atari Falcon 68060 f68kans Countbits 0,05s  
Stefan Niestegge Atari Falcon 68060 f68kans GCD1 0,063s  
Stefan Niestegge Atari Falcon 68060 f68kans GCD2 0,067s  
Stefan Niestegge Atari Falcon 68060 f68kans Nesting 32mil 7,4s  
Thorsten Kuphaldt C64 (normal) Forth64 Nesting 1mill 6m20  
" C64 (Turbo FPGA 6502) Forth64 Nesting 1mill 25s  
" C64 (normal) Forth64 Fib2 (1000) 3m50s  
" C64 (Turbo FPGA 6502) Forth64 Fib2 (1000) 16s  
Martin Neitzel Asus EeePC 1000h (Atom N270 1.6Ghz) FreeBSD 9 FICL Bootloader Integer 0,00075s  
Martin Neitzel Asus EeePC 1000h (Atom N270 1.6Ghz) FreeBSD 9 FICL Bootloader Fib2 66s  
Martin Neitzel Asus EeePC 1000h (Atom N270 1.6Ghz) FreeBSD 9 FICL Bootloader Nesting 1mil 0.66s  
Martin Neitzel Asus EeePC 1000h (Atom N270 1.6Ghz) FreeBSD 9 FICL Bootloader Nesting 32mil 21s  
Martin Neitzel Asus EeePC 1000h (Atom N270 1.6Ghz) FreeBSD 9 FICL Bootloader GCD2 0.57s  
Sabine "Atari Frosch" Engelhardt Atari Portfolio VolksForth 3.81 Fib2 35s  
Sabine "Atari Frosch" Engelhardt Atari Portfolio VolksForth 3.81 Prime 6s  
Sabine "Atari Frosch" Engelhardt Atari Portfolio VolksForth 3.81 Takeuchi 17s  
Herbert Lange Compaq Deskpro P166 pForth V27 Integer Calc 0,052s  
Herbert Lange Compaq Deskpro P166 pForth V27 Fib1 0,061s  
Herbert Lange Compaq Deskpro P166 pForth V27 Fib2 0,001s  
Herbert Lange Compaq Deskpro P166 pForth V27 Nesting 32mil 15,42s  
Herbert Lange Compaq Deskpro P166 pForth V27 Memory Move 0,124s  
Herbert Lange Compaq Deskpro P166 pForth V27 Prime 0,007s  
Herbert Lange Compaq Deskpro P166 pForth V27 GCD1 0,002s  
Herbert Lange Apple iMac G3 400Mhz pForth V27 Integer Calc 0,013s  
Herbert Lange Apple iMac G3 400Mhz pForth V27 Fib1 0,015s  
Herbert Lange Apple iMac G3 400Mhz pForth V27 Fib2 0,001s  
Herbert Lange Apple iMac G3 400Mhz pForth V27 Nesting 32mil 4,335s  
Herbert Lange Apple iMac G3 400Mhz pForth V27 Memory Move 0,028s  
Herbert Lange Apple iMac G3 400Mhz pForth V27 Prime 0,017s  
Herbert Lange Apple iMac G3 400Mhz pForth V27 GCD1 0,063s  
Herbert Lange DEC 3000 400s pForth V27 Integer 0,123s  
Herbert Lange DEC 3000 400s pForth V27 Fib1 0,098s  
Herbert Lange DEC 3000 400s pForth V27 Fib21 0,001s  
Herbert Lange DEC 3000 400s pForth V27 Nesting 32mil 30,694s  
Herbert Lange DEC 3000 400s pForth V27 Memory Move 0,207s  
Herbert Lange DEC 3000 400s pForth V27 Prime 0,117s  
Herbert Lange DEC 3000 400s pForth V27 GCD1 0,483  
Herbert Lange SUN Ultra 1 Creator 3D pForth V27 Integer 0,049s  
Herbert Lange SUN Ultra 1 Creator 3D pForth V27 Fib1 0,052s  
Herbert Lange SUN Ultra 1 Creator 3D pForth V27 Fib2 0,001s  
Herbert Lange SUN Ultra 1 Creator 3D pForth V27 Nesting 32mil 15,631s  
Herbert Lange SUN Ultra 1 Creator 3D pForth V27 Memory Move 0,093s  
Herbert Lange SUN Ultra 1 Creator 3D pForth V27 Prime 0,060s  
Herbert Lange SUN Ultra 1 Creator 3D pForth V27 GCD1 0,022s  
Ralf Neumann mc-CP/M Z80 4Mhz FIG-Forth 1.1 Fib2 1m19s  
Ralf Neumann Prof80 CP/M Z80 6Mhz FIG-Forth 1.1 Fib2 53s  
Carsten Strotmann Zilog Super-8 20Mhz Super8 Forth Fib2 (1000) 31s  
Carsten Strotmann Zilog Super-8 20Mhz Super8 Forth Nesting 1m 20s  
Carsten Strotmann Zilog Super-8 20Mhz Super8 Forth Nesting 32m 11m02s  
Bernd Paysan Samsung Galaxy Note 2 (Exynos 4core) Gforth Fib2 (1000) 0.01s  
Thorsten Schoeler PDP11 FIG-Forth 1.3 Fib2 (1000) 37s  
Thorsten Schoeler PDP11 FIG-Forth 1.3 Fib1 (25) 36s  
Thorsten Schoeler PDP11 FIG-Forth 1.3 Nesting 1m 49s  
Norbert Kehrer Mupid II (BTX Decoder) FIG-Forth 1.1 Fib2 (1000) 210s  
Norbert Kehrer Mupid II (BTX Decoder) FIG-Forth 1.1 Nesting 1m 380s  
Norbert Kehrer Mupid II (BTX Decoder) FIG-Forth 1.1 Sieve 22s  
Norbert Kehrer Mupid II (BTX Decoder) FIG-Forth 1.1 GCD 1 205s  
Norbert Kehrer Mupid II (BTX Decoder) FIG-Forth 1.1 GCD 2 188s  
Thorsten Schoeler NCR 3150 486SX/25Mhz+FPU=Linux 2.0.0 gforth 0.3.0 Fib2 (2500) 9.2s  
Thorsten Schoeler NCR 3150 486SX/25Mhz+FPU=Linux 2.0.0 gforth 0.3.0 Nesting 1m 3s  
Thorsten Schoeler NCR 3150 486SX/25Mhz+FPU=Linux 2.0.0 gforth 0.3.0 Nesting 32m 1m35s  
Thorsten Schoeler NCR 3150 486SX/25Mhz+FPU=Linux 2.0.0 gforth 0.3.0 Fib1 1m79s  
Norbert Kehrer Mupid II (BTX Decoder) Camel Forth 1.01 Integer 68s  
Norbert Kehrer Mupid II (BTX Decoder) Camel Forth 1.01 Fib 2 (1000) 150s  
Norbert Kehrer Mupid II (BTX Decoder) Camel Forth 1.01 Nesting 1m 292s  
Norbert Kehrer Mupid II (BTX Decoder) Camel Forth 1.01 Sieve 15s  
Norbert Kehrer Mupid II (BTX Decoder) Camel Forth 1.01 GCD 1 116s  
Norbert Kehrer Mupid II (BTX Decoder) Camel Forth 1.01 GCD 2 135s  
Helfried Schuerer robotron K 1510, U 808 D (i8008), 480 kHz (auf FOSY Emulator) FOSY V1.2P 1988 (FIG) 1000 FIB2 00:00:15 15s  
Helfried Schuerer robotron K 1510, U 808 D (i8008), 480 kHz (auf FOSY Emulator) FOSY V1.2P 1988 (FIG) FIB2-BENCH 01:51:58 1h 51min 58s  
Helfried Schuerer robotron K 1510, U 808 D (i8008), 480 kHz (auf FOSY Emulator) FOSY V1.2P 1988 (FIG) Nesting 1MILLION 02:32:05 2h 32min 5s  

5 Results VCFB October 2014:

Name Geraet Forth Benchmark Messung Skalierung
Ben IBM PS/2 L40SX DX-Forth Integer 1m12s 100x
Ben IBM PS/2 L40SX DX-Forth Fib2 1m03s 10x
Ben IBM PS/2 L40SX DX-Forth GCD1 0m29s 10x
Ben IBM PS/2 L40SX DX-Forth GCD2 0m42s 10x
Thunder.Bird Amstrad PPC 512 DX-Forth Integer 4m02s 10x
Thunder.Bird Amstrad PPC 512 DX-Forth Fib2 1m45s 5x
Thunder.Bird Amstrad PPC 512 DX-Forth GCD1 0m48s 5x
Alexander Muller IBM PS/2 L40SX DX-Forth fib2 1m03s 10x
Alexander Muller IBM PS/2 L40SX DX-Forth gcd1 0m15s 5x
Alexander Muller IBM PS/2 L40SX DX-Forth integer 0m07s 10x
Alexander Muller IBM PS/2 L40SX DX-Forth takeuchi 0m04s 100x
Alexander Muller Raspberry Pi ARM 700Mhz Gforth 0.7.0 gcd1 0m04s 100x
Alexander Muller Raspberry Pi ARM 700Mhz Gforth 0.7.0 Takeuchi 0m02s 5000x
Alexander Muller Raspberry Pi ARM 700Mhz Gforth 0.7.0 Sieve 0m08s 100x
Michael Mengel Apple II UltraWarp 13Mhz Apple II v. 3.2 Fib2 0m21s 1x
Michael Mengel Apple II UltraWarp 13Mhz Apple GraForth Fib2 0m11s 1x
Michael Mengel Apple II 1Mhz Apple II v. 3.2 Fib2 3m56s 1x
Michael Mengel Apple II 1Mhz Apple GraForth Fib2 2m19s 1x

6 other Results

Name Computer Forth Benchmark Result Scale
Johan Kotlinski C64 DurexForth 1.6.1 (STC) Integer 37s 1x
Johan Kotlinski C64 DurexForth 1.6.1 (STC) Fibonacci 2 1m57s 1x
Johan Kotlinski C64 DurexForth 1.6.1 (STC) Nest 1M 17s 1x
Johan Kotlinski C64 DurexForth 1.6.1 (STC) Sieve/Prime 10s 1x
Johan Kotlinski C64 DurexForth 1.6.1 (STC) GCD 1 60s 1x
Johan Kotlinski C64 DurexForth 1.6.1 (STC) GCD 2 70s 1x

7 Benchme Helper

: benchme ( xt n -- ) \ executes the word with the execution token "xt" n-times
  dup >r              \ save number of iterations
  0 do dup execute loop \ execute word. word must have a neutral stack effect
  cr r> . ." Iterations." cr \ emit message
;

8 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
;

9 Fibonacci 1

This version uses a recursive call. Recursive calls are not standardized in early Forth systems. The word to call the current definition can have different names in your forth (recurse, self, …). Please check you system documentation (if available) or the wordlist (using WORDS or VLIST).

: fib1 ( n1 -- n2 )
    dup 2 < if drop 1 exit then
    dup  1- recursive 
    swap 2- recursive  + ;
    
: fib1-bench 1000 0 do i fib1 drop loop ;

10 Fibonacci 2

: fib2 ( n1 -- n2 )                                                                
   0 1 rot 0 do 
      over + swap loop 
   drop ;
 
: fib2-bench 1000 0 do i fib2 drop loop ;

11 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 )         

12 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 ;

13 count bits in byte

\ Forth Benchmark - count bits in byte              cas 20101204

VARIABLE cnt

HEX 
: countbits ( uu -- #bits )
  cnt off
  8 0 DO dup 01010101  and cnt +!
         2/
  LOOP drop
  0 cnt 4 bounds DO i C@ + LOOP ;

DECIMAL

: bench5
  8192 DO I countbits . LOOP ;

"BOUNDS" can be defined with:

( Convert str len to range for DO-loop )
: bounds ( str len -- str+len str )
  over + swap ;

"OFF" can be defined with:

( stores zero into address )
: OFF ( addr -- )
  0 SWAP ! ;

14 Sieve Benchmark

FIG-Forth derived systems or Forth-79 Systems require the initial value of a variable on the stack.

So instead of "VARIABLE FLAGS 0 FLAGS !" use "0 VARIABLE FLAGS".

\ 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 ;        

15 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 ;  

"D0=" compares a double integer against zero. It can be defined as:

: D0= ( d d -- f )
  + 0= ;

16 Takeuchi

( takeuchi benchmark in volksForth Forth-83 ) ( see http://en.wikipedia.org/wiki/Tak_(function) )

DECIMAL

 : 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 1000 0 DO DROP 18 12 6 tak LOOP ;  

17 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 ;

18 Collatz-Folge

Rainer Glaschick hat einen Benchmark fuer das fuer das Collatz-Problem erstellt. Die Wikipedia ueber das Collatz-Problem: https://de.wikipedia.org/wiki/Collatz-Problem

Dieser Benchmark bricht ab, wenn die Zahlen fuer ein 16bit Forth zu gross werden.

( Benchmark mit der Collatz-Funktion  V1.1 RG 2017-10-05   )
(   c[n+1] = if even(c[n]) then c[n]/2 else 3*c[n]+1 fi    )
( Da der zweite Term immer gerade ist, wird                )
(   c[n+1] = if odd(c[n]) then c[n]/2 else (3*c[n]+1)/2 fi )
( Seien r[n] der Rest und q[n] der Quotient von c[n]/2,    )
( also c[n] = 2*q[n] + r[n], somit bei r[n] = 1:           )
( (3*c[n]+1)/2 = 3*q[n] + 2                                )
( Diese Version fuer 16-bit Rechner prueft vor einem       )
( Ueberlauf und bricht die Folge ab:                       )
( Damit 3*q+2<32767 ist, muss q<10922 sein.                )

( Collatz-Schritt. Null wenn Ueberlauf )
: cn+1 		( cn -- cm )
  2 /mod swap			
  if dup 10922 < 	( kein ueberlauf ? )
    if 3 * 2 + 
    else drop 0 then
  then
;
 
( Collatz-Folge drucken                         )
( dieses Wort wird im Benchmark nicht benoetigt )
( es druckt die Collatz-Folge aus               )

: coll. 	( cn -- )
  begin dup 1 > while
    cn+1 dup .
  repeat
  drop		( always 1 )
;
 
( Collatz-Folge zaehlen. Null wenn Ueberlauf )
: ccnt 		( cn -- cnt)
  0 swap 	( cnt cn )
  begin dup 1 > while
  cn+1 dup 
	if swap 1 + swap ( zaehlen )
	else drop 0
	then
  repeat
  drop
;
 
\ Maximum fuer alle Folgen bis k bestimmen
: cmax 		( k -- max )
  0 swap	( max k )
  begin dup 0 > while
    dup ccnt 	( max k cnt )
    rot  	( k cnt max )
    max		( k max )
    swap	( max k )
    1 -		( max k-1 )
  repeat
  drop
;

( Funktionstest, Ergebniss muss die Zahl "126" sein )
32101 cmax .
." = 126 ! "
 
( Benchmark-Schleife fuer schnelle Rechner > ~200Mhz )
: bench
  99 0 do 32101 cmax drop loop
;