Initial space invaders commit.
Chris Double
parent
18eb2b5e94
commit
296be06d06
File diff suppressed because it is too large
Load Diff
|
|
@ -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 ;
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
Loading…
Reference in New Issue