Initial space invaders commit.

cvs
Chris Double 2005-09-08 01:36:22 +00:00
parent 18eb2b5e94
commit 296be06d06
5 changed files with 2866 additions and 0 deletions

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,125 @@
IN: cpu-8080
USING: kernel lists sdl sdl-event sdl-gfx sdl-video math styles sequences io namespaces generic kernel-internals ;
: plot-bits ( h w byte bit -- )
dup swapd -1 * shift 1 bitand 0 = [ ( h w bit -- )
swap 8 * + surface get -rot swap black rgb pixelColor
] [
swap 8 * + surface get -rot swap white rgb pixelColor
] ifte ;
: update-display ( cpu -- )
224 [ ( cpu h -- h )
32 [ ( cpu h w -- w )
[ swap 32 * + HEX: 2400 + swap cpu-ram nth ] 3keep ( byte cpu h w )
rot >r rot ( h w byte )
[ 0 plot-bits ] 3keep
[ 1 plot-bits ] 3keep
[ 2 plot-bits ] 3keep
[ 3 plot-bits ] 3keep
[ 4 plot-bits ] 3keep
[ 5 plot-bits ] 3keep
[ 6 plot-bits ] 3keep
[ 7 plot-bits ] 3keep
drop r> -rot
] repeat
] repeat drop ;
: gui-step ( cpu -- )
[ read-instruction ] keep ( n cpu )
over get-cycles over inc-cycles
[ swap instructions dispatch ] keep
[ cpu-pc HEX: FFFF bitand ] keep
set-cpu-pc ;
: gui-frame/2 ( cpu -- )
[ gui-step ] keep
[ cpu-cycles ] keep
over 16667 < [ ( cycles cpu )
nip gui-frame/2
] [
[ >r 16667 - r> set-cpu-cycles ] keep
dup cpu-last-interrupt HEX: 10 = [
HEX: 08 over set-cpu-last-interrupt HEX: 08 swap interrupt
] [
HEX: 10 over set-cpu-last-interrupt HEX: 10 swap interrupt
] ifte
] ifte ;
: gui-frame ( cpu -- )
dup gui-frame/2 gui-frame/2 ;
GENERIC: handle-si-event ( cpu event -- quit? )
M: object handle-si-event ( cpu event -- quit? )
2drop f ;
M: quit-event handle-si-event ( cpu event -- quit? )
2drop t ;
USE: prettyprint
M: key-down-event handle-si-event ( cpu event -- quit? )
keyboard-event>binding last car ( cpu key )
{
{ [ dup "ESCAPE" = ] [ 2drop t ] }
{ [ dup "BACKSPACE" = ] [ drop [ cpu-port1 1 bitor ] keep set-cpu-port1 f ] }
{ [ dup 1 = ] [ drop [ cpu-port1 4 bitor ] keep set-cpu-port1 f ] }
{ [ t ] [ . drop f ] }
} cond ;
M: key-up-event handle-si-event ( cpu event -- quit? )
keyboard-event>binding last car ( cpu key )
{
{ [ dup "ESCAPE" = ] [ 2drop t ] }
{ [ dup "BACKSPACE" = ] [ drop [ cpu-port1 255 1 - bitand ] keep set-cpu-port1 f ] }
{ [ dup 1 = ] [ drop [ cpu-port1 255 4 - bitand ] keep set-cpu-port1 f ] }
{ [ t ] [ . drop f ] }
} cond ;
: event-loop ( cpu event -- )
dup SDL_PollEvent [
2dup handle-si-event [
2drop
] [
event-loop
] ifte
] [
[ over gui-frame ] with-surface
! [
! over update-display
! ] with-surface
event-loop
] ifte ;
: addr>xy ( addr -- x y )
#! Convert video RAM address to base X Y value
HEX: 2400 - ( n )
dup HEX: 1f bitand 8 * 255 swap - ( n y )
swap -5 shift swap ;
: plot-bits2 ( x y byte bit -- )
dup swapd -1 * shift 1 bitand 0 = [ ( x y bit -- )
- surface get -rot black rgb pixelColor
] [
- surface get -rot white rgb pixelColor
] ifte ;
: do-video-update ( value addr cpu -- )
drop addr>xy rot ( x y value )
[ 0 plot-bits2 ] 3keep
[ 1 plot-bits2 ] 3keep
[ 2 plot-bits2 ] 3keep
[ 3 plot-bits2 ] 3keep
[ 4 plot-bits2 ] 3keep
[ 5 plot-bits2 ] 3keep
[ 6 plot-bits2 ] 3keep
7 plot-bits2 ;
: display ( -- )
224 256 0 SDL_HWSURFACE [
test-cpu [ do-video-update ] over set-cpu-display
<event> event-loop
SDL_Quit
] with-screen ;

View File

@ -0,0 +1,7 @@
IN: scratchpad
USE: parser
"../parser-combinators/lazy.factor" run-file
"../parser-combinators/parser-combinators.factor" run-file
"cpu.factor" run-file
"tests.factor" run-file

View File

@ -0,0 +1,21 @@
This is a first cut at a simple space invaders emulator. The goal is
to produce an emulator, disassembler and assembler for the 8080
processor.
Running 'load.factor' will load the CPU emulation routines and runs
some tests. Run 'gui.factor' to get the SDL based GUI code.
If you are in the space-invaders directory, and have the ROM as a file
'invaders.rom' in that same directory, the following starts the GUI:
"load.factor" run-file
"gui.factor" run-file
USE: cpu-8080
display
'Backspace' inserts a coin and '1' is the one player button. It
currently stops working at the point where it displays the invaders
and I'm working on fixing this.
For more information, contact the author, Chris Double, at
chris.double@double.co.nz or from my weblog http://radio.weblogs.com/0102385

View File

@ -0,0 +1,887 @@
USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequences words ;
! Test read-byte from ROM
[ 0 ] [ HEX: 50 <cpu> read-byte ] unit-test
! Test read-byte out of RAM range
! [ HEX: FF ] [ HEX: 4001 <cpu> read-byte ] unit-test
! Test write-byte to ROM
[ 0 ] [ <cpu> 1 HEX: 1000 pick write-byte HEX: 1000 swap read-byte ] unit-test
! Test write-byte to RAM
[ 1 ] [ <cpu> 1 HEX: 2000 pick write-byte HEX: 2000 swap read-byte ] unit-test
! Test write-byte out of range
! [ HEX: FF ] [ <cpu> 1 HEX: 4001 pick write-byte HEX: 4001 swap read-byte ] unit-test
! Test write-word/read-word
[ HEX: 2021 ] [
<cpu>
HEX: 2021 HEX: 2000 pick write-word HEX: 2000 swap read-word
] unit-test
! Test AF
[ HEX: 1020 ] [
<cpu>
[ HEX: 10 swap set-cpu-a ] keep
[ HEX: 20 swap set-cpu-f ] keep
cpu-af
] unit-test
[ HEX: 10 HEX: 20 ] [
<cpu> HEX: 1020 over set-cpu-af
dup cpu-a
swap cpu-f
] unit-test
[ t t ] [
<cpu>
[ HEX: 10 swap set-cpu-a ] keep
[ HEX: 20 swap set-cpu-f ] keep
[ cpu-af ] keep
[ set-cpu-af ] keep
[ cpu-a HEX: 10 = ] keep
cpu-f HEX: 20 =
] unit-test
! Test BC
[ HEX: 1020 ] [
<cpu>
[ HEX: 10 swap set-cpu-b ] keep
[ HEX: 20 swap set-cpu-c ] keep
cpu-bc
] unit-test
[ HEX: 10 HEX: 20 ] [
<cpu> HEX: 1020 over set-cpu-bc
dup cpu-b
swap cpu-c
] unit-test
[ t t ] [
<cpu>
[ HEX: 10 swap set-cpu-b ] keep
[ HEX: 20 swap set-cpu-c ] keep
[ cpu-bc ] keep
[ set-cpu-bc ] keep
[ cpu-b HEX: 10 = ] keep
cpu-c HEX: 20 =
] unit-test
! Test DE
[ HEX: 1020 ] [
<cpu>
[ HEX: 10 swap set-cpu-d ] keep
[ HEX: 20 swap set-cpu-e ] keep
cpu-de
] unit-test
[ HEX: 10 HEX: 20 ] [
<cpu> HEX: 1020 over set-cpu-de
dup cpu-d
swap cpu-e
] unit-test
[ t t ] [
<cpu>
[ HEX: 10 swap set-cpu-d ] keep
[ HEX: 20 swap set-cpu-e ] keep
[ cpu-de ] keep
[ set-cpu-de ] keep
[ cpu-d HEX: 10 = ] keep
cpu-e HEX: 20 =
] unit-test
! Test HL
[ HEX: 1020 ] [
<cpu>
[ HEX: 10 swap set-cpu-h ] keep
[ HEX: 20 swap set-cpu-l ] keep
cpu-hl
] unit-test
[ HEX: 10 HEX: 20 ] [
<cpu> HEX: 1020 over set-cpu-hl
dup cpu-h
swap cpu-l
] unit-test
[ t t ] [
<cpu>
[ HEX: 10 swap set-cpu-h ] keep
[ HEX: 20 swap set-cpu-l ] keep
[ cpu-hl ] keep
[ set-cpu-hl ] keep
[ cpu-h HEX: 10 = ] keep
cpu-l HEX: 20 =
] unit-test
! Rom loading
[ HEX: 221 ] [
<cpu> "invaders.rom" over load-rom
HEX: 0100 swap read-word
] unit-test
: instruction-parse-test ( args type instruction -- )
>r patterns hash replace-patterns unit r>
[ instruction-quotations ] cons unit-test ;
{ } "NOP" "NOP" instruction-parse-test
{ cpu-bc set-cpu-bc } "LD-RR,NN" "LD BC,nn" instruction-parse-test
{ cpu-bc set-cpu-bc cpu-a set-cpu-a } "LD-(RR),R" "LD (BC),A" instruction-parse-test
{ cpu-bc set-cpu-bc } "INC-RR" "INC BC" instruction-parse-test
{ cpu-a set-cpu-a } "INC-R" "INC A" instruction-parse-test
{ cpu-a set-cpu-a } "DEC-R" "DEC A" instruction-parse-test
{ cpu-b set-cpu-b } "LD-R,N" "LD B,n" instruction-parse-test
{ } "RLCA" "RLCA" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-bc set-cpu-bc } "ADD-RR,RR" "ADD HL,BC" instruction-parse-test
{ cpu-a set-cpu-a cpu-bc set-cpu-bc } "LD-R,(RR)" "LD A,(BC)" instruction-parse-test
{ cpu-bc set-cpu-bc } "DEC-RR" "DEC BC" instruction-parse-test
{ cpu-c set-cpu-c } "INC-R" "INC C" instruction-parse-test
{ cpu-c set-cpu-c } "DEC-R" "DEC C" instruction-parse-test
{ cpu-c set-cpu-c } "LD-R,N" "LD C,n" instruction-parse-test
{ } "RRCA" "RRCA" instruction-parse-test
{ cpu-de set-cpu-de } "LD-RR,NN" "LD DE,nn" instruction-parse-test
{ cpu-de set-cpu-de cpu-a set-cpu-a } "LD-(RR),R" "LD (DE),A" instruction-parse-test
{ cpu-de set-cpu-de } "INC-RR" "INC DE" instruction-parse-test
{ cpu-d set-cpu-d } "INC-R" "INC D" instruction-parse-test
{ cpu-d set-cpu-d } "DEC-R" "DEC D" instruction-parse-test
{ cpu-d set-cpu-d } "LD-R,N" "LD D,n" instruction-parse-test
{ } "RLA" "RLA" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-de set-cpu-de } "ADD-RR,RR" "ADD HL,DE" instruction-parse-test
{ cpu-a set-cpu-a cpu-de set-cpu-de } "LD-R,(RR)" "LD A,(DE)" instruction-parse-test
{ cpu-de set-cpu-de } "DEC-RR" "DEC DE" instruction-parse-test
{ cpu-e set-cpu-e } "INC-R" "INC E" instruction-parse-test
{ cpu-e set-cpu-e } "DEC-R" "DEC E" instruction-parse-test
{ cpu-e set-cpu-e } "LD-R,N" "LD E,n" instruction-parse-test
{ } "RRA" "RRA" instruction-parse-test
{ cpu-hl set-cpu-hl } "LD-RR,NN" "LD HL,nn" instruction-parse-test
{ cpu-hl set-cpu-hl } "LD-(NN),RR" "LD (nn),HL" instruction-parse-test
{ cpu-hl set-cpu-hl } "INC-RR" "INC HL" instruction-parse-test
{ cpu-h set-cpu-h } "INC-R" "INC H" instruction-parse-test
{ cpu-h set-cpu-h } "DEC-R" "DEC H" instruction-parse-test
{ cpu-h set-cpu-h } "LD-R,N" "LD H,n" instruction-parse-test
{ } "DAA" "DAA" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-hl set-cpu-hl } "ADD-RR,RR" "ADD HL,HL" instruction-parse-test
{ cpu-hl set-cpu-hl } "LD-RR,(NN)" "LD HL,(nn)" instruction-parse-test
{ cpu-hl set-cpu-hl } "DEC-RR" "DEC HL" instruction-parse-test
{ cpu-l set-cpu-l } "INC-R" "INC L" instruction-parse-test
{ cpu-l set-cpu-l } "DEC-R" "DEC L" instruction-parse-test
{ cpu-l set-cpu-l } "LD-R,N" "LD L,n" instruction-parse-test
{ } "CPL" "CPL" instruction-parse-test
{ cpu-sp set-cpu-sp } "LD-RR,NN" "LD SP,nn" instruction-parse-test
{ cpu-a set-cpu-a } "LD-(NN),R" "LD (nn),A" instruction-parse-test
{ cpu-sp set-cpu-sp } "INC-RR" "INC SP" instruction-parse-test
{ cpu-hl set-cpu-hl } "INC-(RR)" "INC (HL)" instruction-parse-test
{ cpu-hl set-cpu-hl } "DEC-(RR)" "DEC (HL)" instruction-parse-test
{ cpu-hl set-cpu-hl } "LD-(RR),N" "LD (HL),n" instruction-parse-test
{ } "SCF" "SCF" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-sp set-cpu-sp } "ADD-RR,RR" "ADD HL,SP" instruction-parse-test
{ cpu-a set-cpu-a } "LD-R,(NN)" "LD A,(nn)" instruction-parse-test
{ cpu-sp set-cpu-sp } "DEC-RR" "DEC SP" instruction-parse-test
{ cpu-a set-cpu-a } "INC-R" "INC A" instruction-parse-test
{ cpu-a set-cpu-a } "DEC-R" "DEC A" instruction-parse-test
{ cpu-a set-cpu-a } "LD-R,N" "LD A,n" instruction-parse-test
{ } "CCF" "CCF" instruction-parse-test
{ cpu-b set-cpu-b cpu-b set-cpu-b } "LD-R,R" "LD B,B" instruction-parse-test
{ cpu-b set-cpu-b cpu-c set-cpu-c } "LD-R,R" "LD B,C" instruction-parse-test
{ cpu-b set-cpu-b cpu-d set-cpu-d } "LD-R,R" "LD B,D" instruction-parse-test
{ cpu-b set-cpu-b cpu-e set-cpu-e } "LD-R,R" "LD B,E" instruction-parse-test
{ cpu-b set-cpu-b cpu-h set-cpu-h } "LD-R,R" "LD B,H" instruction-parse-test
{ cpu-b set-cpu-b cpu-l set-cpu-l } "LD-R,R" "LD B,L" instruction-parse-test
{ cpu-b set-cpu-b cpu-hl set-cpu-hl } "LD-R,(RR)" "LD B,(HL)" instruction-parse-test
{ cpu-b set-cpu-b cpu-a set-cpu-a } "LD-R,R" "LD B,A" instruction-parse-test
{ cpu-c set-cpu-c cpu-b set-cpu-b } "LD-R,R" "LD C,B" instruction-parse-test
{ cpu-c set-cpu-c cpu-c set-cpu-c } "LD-R,R" "LD C,C" instruction-parse-test
{ cpu-c set-cpu-c cpu-d set-cpu-d } "LD-R,R" "LD C,D" instruction-parse-test
{ cpu-c set-cpu-c cpu-e set-cpu-e } "LD-R,R" "LD C,E" instruction-parse-test
{ cpu-c set-cpu-c cpu-h set-cpu-h } "LD-R,R" "LD C,H" instruction-parse-test
{ cpu-c set-cpu-c cpu-l set-cpu-l } "LD-R,R" "LD C,L" instruction-parse-test
{ cpu-c set-cpu-c cpu-hl set-cpu-hl } "LD-R,(RR)" "LD C,(HL)" instruction-parse-test
{ cpu-c set-cpu-c cpu-a set-cpu-a } "LD-R,R" "LD C,A" instruction-parse-test
{ cpu-d set-cpu-d cpu-b set-cpu-b } "LD-R,R" "LD D,B" instruction-parse-test
{ cpu-d set-cpu-d cpu-c set-cpu-c } "LD-R,R" "LD D,C" instruction-parse-test
{ cpu-d set-cpu-d cpu-d set-cpu-d } "LD-R,R" "LD D,D" instruction-parse-test
{ cpu-d set-cpu-d cpu-e set-cpu-e } "LD-R,R" "LD D,E" instruction-parse-test
{ cpu-d set-cpu-d cpu-h set-cpu-h } "LD-R,R" "LD D,H" instruction-parse-test
{ cpu-d set-cpu-d cpu-l set-cpu-l } "LD-R,R" "LD D,L" instruction-parse-test
{ cpu-d set-cpu-d cpu-hl set-cpu-hl } "LD-R,(RR)" "LD D,(HL)" instruction-parse-test
{ cpu-d set-cpu-d cpu-a set-cpu-a } "LD-R,R" "LD D,A" instruction-parse-test
{ cpu-e set-cpu-e cpu-b set-cpu-b } "LD-R,R" "LD E,B" instruction-parse-test
{ cpu-e set-cpu-e cpu-c set-cpu-c } "LD-R,R" "LD E,C" instruction-parse-test
{ cpu-e set-cpu-e cpu-d set-cpu-d } "LD-R,R" "LD E,D" instruction-parse-test
{ cpu-e set-cpu-e cpu-e set-cpu-e } "LD-R,R" "LD E,E" instruction-parse-test
{ cpu-e set-cpu-e cpu-h set-cpu-h } "LD-R,R" "LD E,H" instruction-parse-test
{ cpu-e set-cpu-e cpu-l set-cpu-l } "LD-R,R" "LD E,L" instruction-parse-test
{ cpu-e set-cpu-e cpu-hl set-cpu-hl } "LD-R,(RR)" "LD E,(HL)" instruction-parse-test
{ cpu-e set-cpu-e cpu-a set-cpu-a } "LD-R,R" "LD E,A" instruction-parse-test
{ cpu-h set-cpu-h cpu-b set-cpu-b } "LD-R,R" "LD H,B" instruction-parse-test
{ cpu-h set-cpu-h cpu-c set-cpu-c } "LD-R,R" "LD H,C" instruction-parse-test
{ cpu-h set-cpu-h cpu-d set-cpu-d } "LD-R,R" "LD H,D" instruction-parse-test
{ cpu-h set-cpu-h cpu-e set-cpu-e } "LD-R,R" "LD H,E" instruction-parse-test
{ cpu-h set-cpu-h cpu-h set-cpu-h } "LD-R,R" "LD H,H" instruction-parse-test
{ cpu-h set-cpu-h cpu-l set-cpu-l } "LD-R,R" "LD H,L" instruction-parse-test
{ cpu-h set-cpu-h cpu-hl set-cpu-hl } "LD-R,(RR)" "LD H,(HL)" instruction-parse-test
{ cpu-h set-cpu-h cpu-a set-cpu-a } "LD-R,R" "LD H,A" instruction-parse-test
{ cpu-l set-cpu-l cpu-b set-cpu-b } "LD-R,R" "LD L,B" instruction-parse-test
{ cpu-l set-cpu-l cpu-c set-cpu-c } "LD-R,R" "LD L,C" instruction-parse-test
{ cpu-l set-cpu-l cpu-d set-cpu-d } "LD-R,R" "LD L,D" instruction-parse-test
{ cpu-l set-cpu-l cpu-e set-cpu-e } "LD-R,R" "LD L,E" instruction-parse-test
{ cpu-l set-cpu-l cpu-h set-cpu-h } "LD-R,R" "LD L,H" instruction-parse-test
{ cpu-l set-cpu-l cpu-l set-cpu-l } "LD-R,R" "LD L,L" instruction-parse-test
{ cpu-l set-cpu-l cpu-hl set-cpu-hl } "LD-R,(RR)" "LD L,(HL)" instruction-parse-test
{ cpu-l set-cpu-l cpu-a set-cpu-a } "LD-R,R" "LD L,A" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-b set-cpu-b } "LD-(RR),R" "LD (HL),B" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-c set-cpu-c } "LD-(RR),R" "LD (HL),C" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-d set-cpu-d } "LD-(RR),R" "LD (HL),D" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-e set-cpu-e } "LD-(RR),R" "LD (HL),E" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-h set-cpu-h } "LD-(RR),R" "LD (HL),H" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-l set-cpu-l } "LD-(RR),R" "LD (HL),L" instruction-parse-test
{ } "HALT" "HALT" instruction-parse-test
{ cpu-hl set-cpu-hl cpu-a set-cpu-a } "LD-(RR),R" "LD (HL),A" instruction-parse-test
{ cpu-a set-cpu-a cpu-b set-cpu-b } "LD-R,R" "LD A,B" instruction-parse-test
{ cpu-a set-cpu-a cpu-c set-cpu-c } "LD-R,R" "LD A,C" instruction-parse-test
{ cpu-a set-cpu-a cpu-d set-cpu-d } "LD-R,R" "LD A,D" instruction-parse-test
{ cpu-a set-cpu-a cpu-e set-cpu-e } "LD-R,R" "LD A,E" instruction-parse-test
{ cpu-a set-cpu-a cpu-h set-cpu-h } "LD-R,R" "LD A,H" instruction-parse-test
{ cpu-a set-cpu-a cpu-l set-cpu-l } "LD-R,R" "LD A,L" instruction-parse-test
{ cpu-a set-cpu-a cpu-hl set-cpu-hl } "LD-R,(RR)" "LD A,(HL)" instruction-parse-test
{ cpu-a set-cpu-a cpu-a set-cpu-a } "LD-R,R" "LD A,A" instruction-parse-test
{ cpu-a set-cpu-a cpu-b set-cpu-b } "ADD-R,R" "ADD A,B" instruction-parse-test
{ cpu-a set-cpu-a cpu-c set-cpu-c } "ADD-R,R" "ADD A,C" instruction-parse-test
{ cpu-a set-cpu-a cpu-d set-cpu-d } "ADD-R,R" "ADD A,D" instruction-parse-test
{ cpu-a set-cpu-a cpu-e set-cpu-e } "ADD-R,R" "ADD A,E" instruction-parse-test
{ cpu-a set-cpu-a cpu-h set-cpu-h } "ADD-R,R" "ADD A,H" instruction-parse-test
{ cpu-a set-cpu-a cpu-l set-cpu-l } "ADD-R,R" "ADD A,L" instruction-parse-test
{ cpu-a set-cpu-a cpu-hl set-cpu-hl } "ADD-R,(RR)" "ADD A,(HL)" instruction-parse-test
{ cpu-a set-cpu-a cpu-a set-cpu-a } "ADD-R,R" "ADD A,A" instruction-parse-test
{ cpu-a set-cpu-a cpu-b set-cpu-b } "ADC-R,R" "ADC A,B" instruction-parse-test
{ cpu-a set-cpu-a cpu-c set-cpu-c } "ADC-R,R" "ADC A,C" instruction-parse-test
{ cpu-a set-cpu-a cpu-d set-cpu-d } "ADC-R,R" "ADC A,D" instruction-parse-test
{ cpu-a set-cpu-a cpu-e set-cpu-e } "ADC-R,R" "ADC A,E" instruction-parse-test
{ cpu-a set-cpu-a cpu-h set-cpu-h } "ADC-R,R" "ADC A,H" instruction-parse-test
{ cpu-a set-cpu-a cpu-l set-cpu-l } "ADC-R,R" "ADC A,L" instruction-parse-test
{ cpu-a set-cpu-a cpu-hl set-cpu-hl } "ADC-R,(RR)" "ADC A,(HL)" instruction-parse-test
{ cpu-a set-cpu-a cpu-a set-cpu-a } "ADC-R,R" "ADC A,A" instruction-parse-test
{ cpu-a set-cpu-a cpu-b set-cpu-b } "SUB-R" "SUB B" instruction-parse-test
{ cpu-a set-cpu-a cpu-c set-cpu-c } "SUB-R" "SUB C" instruction-parse-test
{ cpu-a set-cpu-a cpu-d set-cpu-d } "SUB-R" "SUB D" instruction-parse-test
{ cpu-a set-cpu-a cpu-e set-cpu-e } "SUB-R" "SUB E" instruction-parse-test
{ cpu-a set-cpu-a cpu-h set-cpu-h } "SUB-R" "SUB H" instruction-parse-test
{ cpu-a set-cpu-a cpu-l set-cpu-l } "SUB-R" "SUB L" instruction-parse-test
{ cpu-hl set-cpu-hl } "SUB-(RR)" "SUB (HL)" instruction-parse-test
{ cpu-a set-cpu-a cpu-a set-cpu-a } "SUB-R" "SUB A" instruction-parse-test
{ cpu-a set-cpu-a cpu-b set-cpu-b } "SBC-R,R" "SBC A,B" instruction-parse-test
{ cpu-a set-cpu-a cpu-c set-cpu-c } "SBC-R,R" "SBC A,C" instruction-parse-test
{ cpu-a set-cpu-a cpu-d set-cpu-d } "SBC-R,R" "SBC A,D" instruction-parse-test
{ cpu-a set-cpu-a cpu-e set-cpu-e } "SBC-R,R" "SBC A,E" instruction-parse-test
{ cpu-a set-cpu-a cpu-h set-cpu-h } "SBC-R,R" "SBC A,H" instruction-parse-test
{ cpu-a set-cpu-a cpu-l set-cpu-l } "SBC-R,R" "SBC A,L" instruction-parse-test
{ cpu-a set-cpu-a cpu-hl set-cpu-hl } "SBC-R,(RR)" "SBC A,(HL)" instruction-parse-test
{ cpu-a set-cpu-a cpu-a set-cpu-a } "SBC-R,R" "SBC A,A" instruction-parse-test
{ cpu-b set-cpu-b } "AND-R" "AND B" instruction-parse-test
{ cpu-c set-cpu-c } "AND-R" "AND C" instruction-parse-test
{ cpu-d set-cpu-d } "AND-R" "AND D" instruction-parse-test
{ cpu-e set-cpu-e } "AND-R" "AND E" instruction-parse-test
{ cpu-h set-cpu-h } "AND-R" "AND H" instruction-parse-test
{ cpu-l set-cpu-l } "AND-R" "AND L" instruction-parse-test
{ cpu-hl set-cpu-hl } "AND-(RR)" "AND (HL)" instruction-parse-test
{ cpu-a set-cpu-a } "AND-A" "AND A" instruction-parse-test
{ cpu-b set-cpu-b } "XOR-R" "XOR B" instruction-parse-test
{ cpu-c set-cpu-c } "XOR-R" "XOR C" instruction-parse-test
{ cpu-d set-cpu-d } "XOR-R" "XOR D" instruction-parse-test
{ cpu-e set-cpu-e } "XOR-R" "XOR E" instruction-parse-test
{ cpu-h set-cpu-h } "XOR-R" "XOR H" instruction-parse-test
{ cpu-l set-cpu-l } "XOR-R" "XOR L" instruction-parse-test
{ cpu-hl set-cpu-hl } "XOR-(RR)" "XOR (HL)" instruction-parse-test
{ cpu-a set-cpu-a } "XOR-R" "XOR A" instruction-parse-test
{ cpu-b set-cpu-b } "OR-R" "OR B" instruction-parse-test
{ cpu-c set-cpu-c } "OR-R" "OR C" instruction-parse-test
{ cpu-d set-cpu-d } "OR-R" "OR D" instruction-parse-test
{ cpu-e set-cpu-e } "OR-R" "OR E" instruction-parse-test
{ cpu-h set-cpu-h } "OR-R" "OR H" instruction-parse-test
{ cpu-l set-cpu-l } "OR-R" "OR L" instruction-parse-test
{ cpu-hl set-cpu-hl } "OR-(RR)" "OR (HL)" instruction-parse-test
{ cpu-a set-cpu-a } "OR-R" "OR A" instruction-parse-test
{ cpu-b set-cpu-b } "CP-R" "CP B" instruction-parse-test
{ cpu-c set-cpu-c } "CP-R" "CP C" instruction-parse-test
{ cpu-d set-cpu-d } "CP-R" "CP D" instruction-parse-test
{ cpu-e set-cpu-e } "CP-R" "CP E" instruction-parse-test
{ cpu-h set-cpu-h } "CP-R" "CP H" instruction-parse-test
{ cpu-l set-cpu-l } "CP-R" "CP L" instruction-parse-test
{ cpu-hl set-cpu-hl } "CP-(RR)" "CP (HL)" instruction-parse-test
{ cpu-a set-cpu-a } "CP-R" "CP A" instruction-parse-test
{ flag-nz? } "RET-F|FF" "RET NZ" instruction-parse-test
{ cpu-bc set-cpu-bc } "POP-RR" "POP BC" instruction-parse-test
{ flag-nz? } "JP-F|FF,NN" "JP NZ,nn" instruction-parse-test
{ } "JP-NN" "JP nn" instruction-parse-test
{ flag-nz? } "CALL-F|FF,NN" "CALL NZ,nn" instruction-parse-test
{ cpu-bc set-cpu-bc } "PUSH-RR" "PUSH BC" instruction-parse-test
{ cpu-a set-cpu-a } "ADD-R,N" "ADD A,n" instruction-parse-test
{ } "RST-0" "RST 0" instruction-parse-test
{ flag-z? } "RET-F|FF" "RET Z" instruction-parse-test
{ } "RET-NN" "RET nn" instruction-parse-test
{ flag-z? } "JP-F|FF,NN" "JP Z,nn" instruction-parse-test
{ } "CALL-NN" "CALL nn" instruction-parse-test
{ cpu-a set-cpu-a } "ADC-R,N" "ADC A,n" instruction-parse-test
{ } "RST-8" "RST 8" instruction-parse-test
{ flag-nc? } "RET-F|FF" "RET NC" instruction-parse-test
{ cpu-de set-cpu-de } "POP-RR" "POP DE" instruction-parse-test
{ flag-nc? } "JP-F|FF,NN" "JP NC,nn" instruction-parse-test
{ cpu-a set-cpu-a } "OUT-(N),R" "OUT (n),A" instruction-parse-test
{ flag-nc? } "CALL-F|FF,NN" "CALL NC,nn" instruction-parse-test
{ cpu-de set-cpu-de } "PUSH-RR" "PUSH DE" instruction-parse-test
{ } "SUB-N" "SUB n" instruction-parse-test
{ } "RST-10H" "RST 10H" instruction-parse-test
{ flag-c? } "RET-F|FF" "RET C" instruction-parse-test
{ flag-c? } "JP-F|FF,NN" "JP C,nn" instruction-parse-test
{ cpu-a set-cpu-a } "IN-R,(N)" "IN A,(n)" instruction-parse-test
{ flag-c? } "CALL-F|FF,NN" "CALL C,nn" instruction-parse-test
{ cpu-a set-cpu-a } "SBC-R,N" "SBC A,n" instruction-parse-test
{ } "RST-18H" "RST 18H" instruction-parse-test
{ flag-po? } "RET-F|FF" "RET PO" instruction-parse-test
{ cpu-hl set-cpu-hl } "POP-RR" "POP HL" instruction-parse-test
{ flag-po? } "JP-F|FF,NN" "JP PO,nn" instruction-parse-test
{ cpu-sp set-cpu-sp cpu-hl set-cpu-hl } "EX-(RR),RR" "EX (SP),HL" instruction-parse-test
{ flag-po? } "CALL-F|FF,NN" "CALL PO,nn" instruction-parse-test
{ cpu-hl set-cpu-hl } "PUSH-RR" "PUSH HL" instruction-parse-test
{ } "AND-N" "AND n" instruction-parse-test
{ } "RST-20H" "RST 20H" instruction-parse-test
{ flag-pe? } "RET-F|FF" "RET PE" instruction-parse-test
{ cpu-hl set-cpu-hl } "JP-(RR)" "JP (HL)" instruction-parse-test
{ flag-pe? } "JP-F|FF,NN" "JP PE,nn" instruction-parse-test
{ cpu-de set-cpu-de cpu-hl set-cpu-hl } "EX-RR,RR" "EX DE,HL" instruction-parse-test
{ flag-pe? } "CALL-F|FF,NN" "CALL PE,nn" instruction-parse-test
{ } "XOR-N" "XOR n" instruction-parse-test
{ } "RST-28H" "RST 28H" instruction-parse-test
{ flag-p? } "RET-F|FF" "RET P" instruction-parse-test
{ cpu-af set-cpu-af } "POP-RR" "POP AF" instruction-parse-test
{ flag-p? } "JP-F|FF,NN" "JP P,nn" instruction-parse-test
{ } "DI" "DI" instruction-parse-test
{ flag-p? } "CALL-F|FF,NN" "CALL P,nn" instruction-parse-test
{ cpu-af set-cpu-af } "PUSH-RR" "PUSH AF" instruction-parse-test
{ } "OR-N" "OR n" instruction-parse-test
{ } "RST-30H" "RST 30H" instruction-parse-test
{ flag-m? } "RET-F|FF" "RET M" instruction-parse-test
{ cpu-sp set-cpu-sp cpu-hl set-cpu-hl } "LD-RR,RR" "LD SP,HL" instruction-parse-test
{ flag-m? } "JP-F|FF,NN" "JP M,nn" instruction-parse-test
{ } "EI" "EI" instruction-parse-test
{ flag-m? } "CALL-F|FF,NN" "CALL M,nn" instruction-parse-test
{ } "CP-N" "CP n" instruction-parse-test
{ } "RST-38H" "RST 38H" instruction-parse-test
! LD-R,(RR) Testing
[ HEX: 42 ] [
<cpu> HEX: 42 HEX: 2000 pick write-byte
HEX: 2000 over set-cpu-af
dup "LD A,(AF)" instruction-quotations call
cpu-a
] unit-test
[ HEX: 42 ] [
<cpu> HEX: 42 HEX: 2000 pick write-byte
HEX: 2000 over set-cpu-bc
dup "LD A,(BC)" instruction-quotations call
cpu-a
] unit-test
[ HEX: 42 ] [
<cpu> HEX: 42 HEX: 2000 pick write-byte
HEX: 2000 over set-cpu-de
dup "LD A,(DE)" instruction-quotations call
cpu-a
] unit-test
[ HEX: 42 ] [
<cpu> HEX: 42 HEX: 2000 pick write-byte
HEX: 2000 over set-cpu-hl
dup "LD A,(HL)" instruction-quotations call
cpu-a
] unit-test
[ HEX: 42 ] [
<cpu> HEX: 42 HEX: 2000 pick write-byte
HEX: 2000 over set-cpu-sp
dup "LD A,(SP)" instruction-quotations call
cpu-a
] unit-test
! LD-RR,NN Testing
[ HEX: 1FF ] [
<cpu> HEX: 1FF HEX: 2000 pick write-word
HEX: 2000 over set-cpu-pc
dup "LD SP,nn" instruction-quotations call
cpu-sp
] unit-test
[ HEX: 1FF ] [
<cpu> HEX: 1FF HEX: 2000 pick write-word
HEX: 2000 over set-cpu-pc
dup "LD AF,nn" instruction-quotations call
cpu-af
] unit-test
[ HEX: 1FF ] [
<cpu> HEX: 1FF HEX: 2000 pick write-word
HEX: 2000 over set-cpu-pc
dup "LD BC,nn" instruction-quotations call
cpu-bc
] unit-test
[ HEX: 1FF ] [
<cpu> HEX: 1FF HEX: 2000 pick write-word
HEX: 2000 over set-cpu-pc
dup "LD DE,nn" instruction-quotations call
cpu-de
] unit-test
[ HEX: 1FF ] [
<cpu> HEX: 1FF HEX: 2000 pick write-word
HEX: 2000 over set-cpu-pc
dup "LD HL,nn" instruction-quotations call
cpu-hl
] unit-test
! Test decrement-sp
[ 2 ] [
<cpu> [ cpu-sp ] keep
[ 2 swap decrement-sp ] keep
cpu-sp -
] unit-test
! Test save-pc
[ HEX: 2000 ] [
<cpu> [ HEX: 2000 swap set-cpu-pc ] keep
[ save-pc ] keep
[ cpu-sp ] keep
read-word
] unit-test
! Test push-pc
[ HEX: 2000 ] [
<cpu> [ HEX: 2000 swap set-cpu-pc ] keep
[ push-pc ] keep
pop-pc
] unit-test
! Test some flags
[ t ] [
<cpu> zero-flag over set-cpu-f
flag-z?
] unit-test
[ f ] [
<cpu> zero-flag over set-cpu-f
flag-nz?
] unit-test
[ t ] [
<cpu> carry-flag over set-cpu-f
flag-c?
] unit-test
[ f ] [
<cpu> carry-flag over set-cpu-f
flag-nc?
] unit-test
! Test each instruction
[ emulate-NOP ] [
<cpu> 0 0 pick cpu-ram set-nth
dup read-instruction instructions nth
car dup -rot execute
] unit-test
[ emulate-LD_BC,nn 1 2 HEX: 0201 ] [
<cpu> 1 0 pick cpu-ram set-nth
1 1 pick cpu-ram set-nth
2 2 pick cpu-ram set-nth
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ cpu-b ] keep
[ cpu-bc ] keep
drop
] unit-test
[ emulate-LD_(BC),A 1 ] [
<cpu> 2 0 pick cpu-ram set-nth
1 over set-cpu-a
HEX: 2000 over set-cpu-bc
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ HEX: 2000 swap cpu-ram nth ] keep
drop
] unit-test
[ emulate-INC_BC HEX: 0001 HEX: 0100 HEX: 0000 ] [
<cpu> 3 0 pick cpu-ram set-nth
HEX: 0000 over set-cpu-bc
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-bc ] keep
3 1 pick cpu-ram set-nth
HEX: 00FF over set-cpu-bc
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-bc ] keep
3 2 pick cpu-ram set-nth
HEX: FFFF over set-cpu-bc
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-bc ] keep
drop
] unit-test
[ emulate-INC_B HEX: 01 f t f f f
HEX: 00 t f t f f
HEX: 80 f t t t t
HEX: 90 f t t f t
] [
<cpu> 4 0 pick cpu-ram set-nth
HEX: 00 over set-cpu-b
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
4 1 pick cpu-ram set-nth
HEX: FF over set-cpu-b
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
4 2 pick cpu-ram set-nth
HEX: 7F over set-cpu-b
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
4 3 pick cpu-ram set-nth
HEX: 8F over set-cpu-b
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
drop
] unit-test
[ emulate-DEC_B HEX: FF f t t f t
HEX: 00 t f f f f
HEX: 7F f t t t f
HEX: 8F f t t f t
] [
<cpu> 5 0 pick cpu-ram set-nth
HEX: 00 over set-cpu-b
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
5 1 pick cpu-ram set-nth
HEX: 01 over set-cpu-b
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
5 2 pick cpu-ram set-nth
HEX: 80 over set-cpu-b
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
5 3 pick cpu-ram set-nth
HEX: 90 over set-cpu-b
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
drop
] unit-test
[ emulate-LD_B,n 1 HEX: 0100 ] [
<cpu> 6 0 pick cpu-ram set-nth
1 1 pick cpu-ram set-nth
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ cpu-bc ] keep
drop
] unit-test
[ emulate-RLCA BIN: 00000011 1 BIN: 11111110 0 ] [
<cpu> 7 0 pick cpu-ram set-nth
19 over set-cpu-f
BIN: 10000001 over set-cpu-a
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-a ] keep
[ cpu-f ] keep
7 1 pick cpu-ram set-nth
19 over set-cpu-f
BIN: 01111111 over set-cpu-a
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-a ] keep
[ cpu-f ] keep
drop
] unit-test
[ emulate-ADD_HL,BC HEX: 04 HEX: 06 HEX: 0406 f f
HEX: 00 HEX: 00 HEX: 0000 f f
HEX: 00 HEX: 00 HEX: 0000 t t
HEX: 10 HEX: 00 HEX: 1000 f t
HEX: 10 HEX: 00 HEX: 1000 f t
] [
<cpu> 9 0 pick cpu-ram set-nth
HEX: 0102 over set-cpu-bc
HEX: 0304 over set-cpu-hl
236 over set-cpu-f
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-h ] keep
[ cpu-l ] keep
[ cpu-hl ] keep
[ cpu-f carry-flag bitand 0 = not ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
9 1 pick cpu-ram set-nth
HEX: 0000 over set-cpu-bc
HEX: 0000 over set-cpu-hl
236 over set-cpu-f
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-h ] keep
[ cpu-l ] keep
[ cpu-hl ] keep
[ cpu-f carry-flag bitand 0 = not ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
9 2 pick cpu-ram set-nth
HEX: FFFF over set-cpu-bc
HEX: 0001 over set-cpu-hl
236 over set-cpu-f
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-h ] keep
[ cpu-l ] keep
[ cpu-hl ] keep
[ cpu-f carry-flag bitand 0 = not ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
9 3 pick cpu-ram set-nth
HEX: 0FFF over set-cpu-bc
HEX: 0001 over set-cpu-hl
236 over set-cpu-f
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-h ] keep
[ cpu-l ] keep
[ cpu-hl ] keep
[ cpu-f carry-flag bitand 0 = not ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
9 4 pick cpu-ram set-nth
HEX: 0001 over set-cpu-bc
HEX: 0FFF over set-cpu-hl
236 over set-cpu-f
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-h ] keep
[ cpu-l ] keep
[ cpu-hl ] keep
[ cpu-f carry-flag bitand 0 = not ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
drop
] unit-test
[ emulate-LD_A,(BC) HEX: 42 ] [
<cpu> HEX: 0A 0 pick cpu-ram set-nth
HEX: 2000 over set-cpu-bc
HEX: 42 HEX: 2000 pick cpu-ram set-nth
HEX: 01 over set-cpu-a
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-a ] keep
drop
] unit-test
[ emulate-DEC_BC HEX: FF HEX: FF HEX: FFFF
HEX: 01 HEX: 02 HEX: 0102
HEX: FD HEX: FF HEX: FDFF
] [
<cpu> HEX: 0B 0 pick cpu-ram set-nth
HEX: 0000 over set-cpu-bc
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ cpu-c ] keep
[ cpu-bc ] keep
HEX: 0B 1 pick cpu-ram set-nth
HEX: 0103 over set-cpu-bc
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ cpu-c ] keep
[ cpu-bc ] keep
HEX: 0B 2 pick cpu-ram set-nth
HEX: FE00 over set-cpu-bc
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-b ] keep
[ cpu-c ] keep
[ cpu-bc ] keep
drop
] unit-test
[ emulate-INC_C HEX: 01 f t f f f
HEX: 00 t f t f f
HEX: 80 f t t t t
HEX: 90 f t t f t
] [
<cpu> HEX: 0C 0 pick cpu-ram set-nth
HEX: 00 over set-cpu-c
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
HEX: 0C 1 pick cpu-ram set-nth
HEX: FF over set-cpu-c
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
HEX: 0C 2 pick cpu-ram set-nth
HEX: 7F over set-cpu-c
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
HEX: 0C 3 pick cpu-ram set-nth
HEX: 8F over set-cpu-c
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
drop
] unit-test
[ emulate-DEC_C HEX: FF f t t f t
HEX: 00 t f f f f
HEX: 7F f t t t f
HEX: 8F f t t f t
] [
<cpu> HEX: 0D 0 pick cpu-ram set-nth
HEX: 00 over set-cpu-c
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
HEX: 0D 1 pick cpu-ram set-nth
HEX: 01 over set-cpu-c
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
HEX: 0D 2 pick cpu-ram set-nth
HEX: 80 over set-cpu-c
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
HEX: 0D 3 pick cpu-ram set-nth
HEX: 90 over set-cpu-c
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ flag-z? ] keep
[ flag-nz? ] keep
[ cpu-f half-carry-flag bitand 0 = not ] keep
[ cpu-f overflow-flag bitand 0 = not ] keep
[ cpu-f sign-flag bitand 0 = not ] keep
drop
] unit-test
[ emulate-LD_C,n 1 HEX: 0001 ] [
<cpu> HEX: 0E 0 pick cpu-ram set-nth
1 1 pick cpu-ram set-nth
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-c ] keep
[ cpu-bc ] keep
drop
] unit-test
[ emulate-RRCA BIN: 11000000 1 BIN: 01111111 0 ] [
<cpu> HEX: 0F 0 pick cpu-ram set-nth
19 over set-cpu-f
BIN: 10000001 over set-cpu-a
[ read-instruction instructions nth car dup ] keep
[ swap execute ] keep
[ cpu-a ] keep
[ cpu-f ] keep
HEX: 0F 1 pick cpu-ram set-nth
19 over set-cpu-f
BIN: 11111110 over set-cpu-a
[ read-instruction instructions nth car ] keep
[ swap execute ] keep
[ cpu-a ] keep
[ cpu-f ] keep
drop
] unit-test