| At line 3 changed 266 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 + ; |
| |
| : fib1-bench 10000 0 do i fib1 drop loop ; |
|
| }}} |
|
| !!Fibonacci 2 |
|
| {{{ |
| : fib2 ( n1 -- n2 ) |
| dup 2 < if drop 1 else |
| dup 1- recursive |
| swap 2 - recursive + |
| then ; |
|
| : fib2-bench 10000 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 init-vm &6502 6502emu ; |
| }}} |
| the Forth Benchmarks have been moved to its own dedicated website at [https://theultimatebenchmark.org|https://theultimatebenchmark.org] |
, unless otherwise noted.