!!!Forth83 Benchmarks
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 }]
!! 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 |
| 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 |
| 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 |
!! 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 ;
}}}