steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Covert cpu.8080 to use pegs

db4
Chris Double 2008-07-10 21:44:11 +12:00
parent f90ac9a691
commit 20b517d7da
1 changed files with 396 additions and 327 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

715
extra/cpu/8080/emulator/emulator.factor
View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: accessors kernel math sequences words arrays io io.files USING: accessors kernel math sequences words arrays io io.files
namespaces math.parser assocs quotations parser lexer math.parser assocs quotations parser lexer
parser-combinators tools.time io.encodings.binary sequences.deep peg peg.ebnf peg.parsers tools.time io.encodings.binary sequences.deep
symbols combinators ; symbols combinators fry namespaces ;
IN: cpu.8080.emulator IN: cpu.8080.emulator
TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ; TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles ram ;
@ -748,24 +748,15 @@ SYMBOLS: $1 $2 $3 $4 ;
#! is the getter word for that register with stack effect #! is the getter word for that register with stack effect
#! ( cpu -- value ). The second item is the setter word with #! ( cpu -- value ). The second item is the setter word with
#! stack effect ( value cpu -- ). #! stack effect ( value cpu -- ).
"A" token <EBNF
"B" token <|> main=("A" | "B" | "C" | "D" | "E" | "H" | "L") => [[ register-lookup ]]
"C" token <|> EBNF> ;
"D" token <|>
"E" token <|>
"H" token <|>
"L" token <|> [ register-lookup ] <@ ;
: all-flags ( -- parser ) : all-flags ( -- parser )
#! A parser for 16-bit flags. #! A parser for 16-bit flags.
"NZ" token <EBNF
"NC" token <|> main=("NZ" | "NC" | "PO" | "PE" | "Z" | "C" | "P" | "M") => [[ flag-lookup ]]
"PO" token <|> EBNF> ;
"PE" token <|>
"Z" token <|>
"C" token <|>
"P" token <|>
"M" token <|> [ flag-lookup ] <@ ;
: 16-bit-registers ( -- parser ) : 16-bit-registers ( -- parser )
#! A parser for 16-bit registers. On a successfull parse the #! A parser for 16-bit registers. On a successfull parse the
@ -773,23 +764,21 @@ SYMBOLS: $1 $2 $3 $4 ;
#! is the getter word for that register with stack effect #! is the getter word for that register with stack effect
#! ( cpu -- value ). The second item is the setter word with #! ( cpu -- value ). The second item is the setter word with
#! stack effect ( value cpu -- ). #! stack effect ( value cpu -- ).
"AF" token <EBNF
"BC" token <|> main=("AF" | "BC" | "DE" | "HL" | "SP") => [[ register-lookup ]]
"DE" token <|> EBNF> ;
"HL" token <|>
"SP" token <|> [ register-lookup ] <@ ;
: all-registers ( -- parser ) : all-registers ( -- parser )
#! Return a parser that can parse the format #! Return a parser that can parse the format
#! for 8 bit or 16 bit registers. #! for 8 bit or 16 bit registers.
8-bit-registers 16-bit-registers <|> ; [ 16-bit-registers , 8-bit-registers , ] choice* ;
: indirect ( parser -- parser ) : indirect ( parser -- parser )
#! Given a parser, return a parser which parses the original #! Given a parser, return a parser which parses the original
#! wrapped in brackets, representing an indirect reference. #! wrapped in brackets, representing an indirect reference.
#! eg. BC -> (BC). The value of the original parser is left in #! eg. BC -> (BC). The value of the original parser is left in
#! the parse tree. #! the parse tree.
"(" token swap &> ")" token <& ; "(" ")" surrounded-by ;
: generate-instruction ( vector string -- quot ) : generate-instruction ( vector string -- quot )
#! Generate the quotation for an instruction, given the instruction in #! Generate the quotation for an instruction, given the instruction in
@ -800,89 +789,103 @@ SYMBOLS: $1 $2 $3 $4 ;
#! Return a parser for then instruction identified by the token. #! Return a parser for then instruction identified by the token.
#! The parser return parses the token only and expects no additional #! The parser return parses the token only and expects no additional
#! arguments to the instruction. #! arguments to the instruction.
token [ [ { } clone , , \ generate-instruction , ] [ ] make ] <@ ; token [ '[ { } , generate-instruction ] ] action ;
: complex-instruction ( type token -- parser ) : complex-instruction ( type token -- parser )
#! Return a parser for an instruction identified by the token. #! Return a parser for an instruction identified by the token.
#! The instruction is expected to take additional arguments by #! The instruction is expected to take additional arguments by
#! being combined with other parsers. Then 'type' is used for a lookup #! being combined with other parsers. Then 'type' is used for a lookup
#! in a pattern hashtable to return the instruction quotation pattern. #! in a pattern hashtable to return the instruction quotation pattern.
token swap [ nip [ , \ generate-instruction , ] [ ] make ] curry <@ ; token swap [ nip '[ , generate-instruction ] ] curry action ;
: NOP-instruction ( -- parser ) : NOP-instruction ( -- parser )
"NOP" simple-instruction ; "NOP" simple-instruction ;
: RET-NN-instruction ( -- parser ) : RET-NN-instruction ( -- parser )
"RET-NN" "RET" complex-instruction [
"nn" token sp <& "RET-NN" "RET" complex-instruction ,
just [ { } clone swap curry ] <@ ; "nn" token sp hide ,
] seq* [ first { } swap curry ] action ;
: RST-0-instruction ( -- parser ) : RST-0-instruction ( -- parser )
"RST-0" "RST" complex-instruction [
"0" token sp <& "RST-0" "RST" complex-instruction ,
just [ { } clone swap curry ] <@ ; "0" token sp hide ,
] seq* [ first { } swap curry ] action ;
: RST-8-instruction ( -- parser ) : RST-8-instruction ( -- parser )
"RST-8" "RST" complex-instruction [
"8" token sp <& "RST-8" "RST" complex-instruction ,
just [ { } clone swap curry ] <@ ; "8" token sp hide ,
] seq* [ first { } swap curry ] action ;
: RST-10H-instruction ( -- parser ) : RST-10H-instruction ( -- parser )
"RST-10H" "RST" complex-instruction [
"10H" token sp <& "RST-10H" "RST" complex-instruction ,
just [ { } clone swap curry ] <@ ; "10H" token sp hide ,
] seq* [ first { } swap curry ] action ;
: RST-18H-instruction ( -- parser ) : RST-18H-instruction ( -- parser )
"RST-18H" "RST" complex-instruction [
"18H" token sp <& "RST-18H" "RST" complex-instruction ,
just [ { } clone swap curry ] <@ ; "18H" token sp hide ,
] seq* [ first { } swap curry ] action ;
: RST-20H-instruction ( -- parser ) : RST-20H-instruction ( -- parser )
"RST-20H" "RST" complex-instruction [
"20H" token sp <& "RST-20H" "RST" complex-instruction ,
just [ { } clone swap curry ] <@ ; "20H" token sp hide ,
] seq* [ first { } swap curry ] action ;
: RST-28H-instruction ( -- parser ) : RST-28H-instruction ( -- parser )
"RST-28H" "RST" complex-instruction [
"28H" token sp <& "RST-28H" "RST" complex-instruction ,
just [ { } clone swap curry ] <@ ; "28H" token sp hide ,
] seq* [ first { } swap curry ] action ;
: RST-30H-instruction ( -- parser ) : RST-30H-instruction ( -- parser )
"RST-30H" "RST" complex-instruction [
"30H" token sp <& "RST-30H" "RST" complex-instruction ,
just [ { } clone swap curry ] <@ ; "30H" token sp hide ,
] seq* [ first { } swap curry ] action ;
: RST-38H-instruction ( -- parser ) : RST-38H-instruction ( -- parser )
"RST-38H" "RST" complex-instruction [
"38H" token sp <& "RST-38H" "RST" complex-instruction ,
just [ { } clone swap curry ] <@ ; "38H" token sp hide ,
] seq* [ first { } swap curry ] action ;
: JP-NN-instruction ( -- parser ) : JP-NN-instruction ( -- parser )
"JP-NN" "JP" complex-instruction [
"nn" token sp <& "JP-NN" "JP" complex-instruction ,
just [ { } clone swap curry ] <@ ; "nn" token sp hide ,
] seq* [ first { } swap curry ] action ;
: JP-F|FF,NN-instruction ( -- parser ) : JP-F|FF,NN-instruction ( -- parser )
"JP-F|FF,NN" "JP" complex-instruction [
all-flags sp <&> "JP-F|FF,NN" "JP" complex-instruction ,
",nn" token <& all-flags sp ,
just [ first2 swap curry ] <@ ; ",nn" token hide ,
] seq* [ first2 swap curry ] action ;
: JP-(RR)-instruction ( -- parser ) : JP-(RR)-instruction ( -- parser )
"JP-(RR)" "JP" complex-instruction [
16-bit-registers indirect sp <&> "JP-(RR)" "JP" complex-instruction ,
just [ first2 swap curry ] <@ ; 16-bit-registers indirect sp ,
] seq* [ first2 swap curry ] action ;
: CALL-NN-instruction ( -- parser ) : CALL-NN-instruction ( -- parser )
"CALL-NN" "CALL" complex-instruction [
"nn" token sp <& "CALL-NN" "CALL" complex-instruction ,
just [ { } clone swap curry ] <@ ; "nn" token sp hide ,
] seq* [ first { } swap curry ] action ;
: CALL-F|FF,NN-instruction ( -- parser ) : CALL-F|FF,NN-instruction ( -- parser )
"CALL-F|FF,NN" "CALL" complex-instruction [
all-flags sp <&> "CALL-F|FF,NN" "CALL" complex-instruction ,
",nn" token <& all-flags sp ,
just [ first2 swap curry ] <@ ; ",nn" token hide ,
] seq* [ first2 swap curry ] action ;
: RLCA-instruction ( -- parser ) : RLCA-instruction ( -- parser )
"RLCA" simple-instruction ; "RLCA" simple-instruction ;
@ -918,364 +921,430 @@ SYMBOLS: $1 $2 $3 $4 ;
"RRA" simple-instruction ; "RRA" simple-instruction ;
: DEC-R-instruction ( -- parser ) : DEC-R-instruction ( -- parser )
"DEC-R" "DEC" complex-instruction 8-bit-registers sp <&> [
just [ first2 swap curry ] <@ ; "DEC-R" "DEC" complex-instruction ,
8-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: DEC-RR-instruction ( -- parser ) : DEC-RR-instruction ( -- parser )
"DEC-RR" "DEC" complex-instruction 16-bit-registers sp <&> [
just [ first2 swap curry ] <@ ; "DEC-RR" "DEC" complex-instruction ,
16-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: DEC-(RR)-instruction ( -- parser ) : DEC-(RR)-instruction ( -- parser )
"DEC-(RR)" "DEC" complex-instruction [
16-bit-registers indirect sp <&> "DEC-(RR)" "DEC" complex-instruction ,
just [ first2 swap curry ] <@ ; 16-bit-registers indirect sp ,
] seq* [ first2 swap curry ] action ;
: POP-RR-instruction ( -- parser ) : POP-RR-instruction ( -- parser )
"POP-RR" "POP" complex-instruction all-registers sp <&> [
just [ first2 swap curry ] <@ ; "POP-RR" "POP" complex-instruction ,
all-registers sp ,
] seq* [ first2 swap curry ] action ;
: PUSH-RR-instruction ( -- parser ) : PUSH-RR-instruction ( -- parser )
"PUSH-RR" "PUSH" complex-instruction all-registers sp <&> [
just [ first2 swap curry ] <@ ; "PUSH-RR" "PUSH" complex-instruction ,
all-registers sp ,
] seq* [ first2 swap curry ] action ;
: INC-R-instruction ( -- parser ) : INC-R-instruction ( -- parser )
"INC-R" "INC" complex-instruction 8-bit-registers sp <&> [
just [ first2 swap curry ] <@ ; "INC-R" "INC" complex-instruction ,
8-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: INC-RR-instruction ( -- parser ) : INC-RR-instruction ( -- parser )
"INC-RR" "INC" complex-instruction 16-bit-registers sp <&> [
just [ first2 swap curry ] <@ ; "INC-RR" "INC" complex-instruction ,
16-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: INC-(RR)-instruction ( -- parser ) : INC-(RR)-instruction ( -- parser )
"INC-(RR)" "INC" complex-instruction [
all-registers indirect sp <&> just [ first2 swap curry ] <@ ; "INC-(RR)" "INC" complex-instruction ,
all-registers indirect sp ,
] seq* [ first2 swap curry ] action ;
: RET-F|FF-instruction ( -- parser ) : RET-F|FF-instruction ( -- parser )
"RET-F|FF" "RET" complex-instruction all-flags sp <&> [
just [ first2 swap curry ] <@ ; "RET-F|FF" "RET" complex-instruction ,
all-flags sp ,
] seq* [ first2 swap curry ] action ;
: AND-N-instruction ( -- parser ) : AND-N-instruction ( -- parser )
"AND-N" "AND" complex-instruction [
"n" token sp <& "AND-N" "AND" complex-instruction ,
just [ { } clone swap curry ] <@ ; "n" token sp hide ,
] seq* [ first { } swap curry ] action ;
: AND-R-instruction ( -- parser ) : AND-R-instruction ( -- parser )
"AND-R" "AND" complex-instruction [
8-bit-registers sp <&> just [ first2 swap curry ] <@ ; "AND-R" "AND" complex-instruction ,
8-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: AND-(RR)-instruction ( -- parser ) : AND-(RR)-instruction ( -- parser )
"AND-(RR)" "AND" complex-instruction [
16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ; "AND-(RR)" "AND" complex-instruction ,
16-bit-registers indirect sp ,
] seq* [ first2 swap curry ] action ;
: XOR-N-instruction ( -- parser ) : XOR-N-instruction ( -- parser )
"XOR-N" "XOR" complex-instruction [
"n" token sp <& "XOR-N" "XOR" complex-instruction ,
just [ { } clone swap curry ] <@ ; "n" token sp hide ,
] seq* [ first { } swap curry ] action ;
: XOR-R-instruction ( -- parser ) : XOR-R-instruction ( -- parser )
"XOR-R" "XOR" complex-instruction [
8-bit-registers sp <&> just [ first2 swap curry ] <@ ; "XOR-R" "XOR" complex-instruction ,
8-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: XOR-(RR)-instruction ( -- parser ) : XOR-(RR)-instruction ( -- parser )
"XOR-(RR)" "XOR" complex-instruction [
16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ; "XOR-(RR)" "XOR" complex-instruction ,
16-bit-registers indirect sp ,
] seq* [ first2 swap curry ] action ;
: OR-N-instruction ( -- parser ) : OR-N-instruction ( -- parser )
"OR-N" "OR" complex-instruction [
"n" token sp <& "OR-N" "OR" complex-instruction ,
just [ { } clone swap curry ] <@ ; "n" token sp hide ,
] seq* [ first { } swap curry ] action ;
: OR-R-instruction ( -- parser ) : OR-R-instruction ( -- parser )
"OR-R" "OR" complex-instruction [
8-bit-registers sp <&> just [ first2 swap curry ] <@ ; "OR-R" "OR" complex-instruction ,
8-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: OR-(RR)-instruction ( -- parser ) : OR-(RR)-instruction ( -- parser )
"OR-(RR)" "OR" complex-instruction [
16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ; "OR-(RR)" "OR" complex-instruction ,
16-bit-registers indirect sp ,
] seq* [ first2 swap curry ] action ;
: CP-N-instruction ( -- parser ) : CP-N-instruction ( -- parser )
"CP-N" "CP" complex-instruction [
"n" token sp <& "CP-N" "CP" complex-instruction ,
just [ { } clone swap curry ] <@ ; "n" token sp hide ,
] seq* [ first { } swap curry ] action ;
: CP-R-instruction ( -- parser ) : CP-R-instruction ( -- parser )
"CP-R" "CP" complex-instruction [
8-bit-registers sp <&> just [ first2 swap curry ] <@ ; "CP-R" "CP" complex-instruction ,
8-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: CP-(RR)-instruction ( -- parser ) : CP-(RR)-instruction ( -- parser )
"CP-(RR)" "CP" complex-instruction [
16-bit-registers indirect sp <&> just [ first2 swap curry ] <@ ; "CP-(RR)" "CP" complex-instruction ,
16-bit-registers indirect sp ,
] seq* [ first2 swap curry ] action ;
: ADC-R,N-instruction ( -- parser ) : ADC-R,N-instruction ( -- parser )
"ADC-R,N" "ADC" complex-instruction [
8-bit-registers sp <&> "ADC-R,N" "ADC" complex-instruction ,
",n" token <& 8-bit-registers sp ,
just [ first2 swap curry ] <@ ; ",n" token hide ,
] seq* [ first2 swap curry ] action ;
: ADC-R,R-instruction ( -- parser ) : ADC-R,R-instruction ( -- parser )
"ADC-R,R" "ADC" complex-instruction [
8-bit-registers sp <&> "ADC-R,R" "ADC" complex-instruction ,
"," token <& 8-bit-registers sp ,
8-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 8-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: ADC-R,(RR)-instruction ( -- parser ) : ADC-R,(RR)-instruction ( -- parser )
"ADC-R,(RR)" "ADC" complex-instruction [
8-bit-registers sp <&> "ADC-R,(RR)" "ADC" complex-instruction ,
"," token <& 8-bit-registers sp ,
16-bit-registers indirect <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 16-bit-registers indirect ,
] seq* [ first3 append swap curry ] action ;
: SBC-R,N-instruction ( -- parser ) : SBC-R,N-instruction ( -- parser )
"SBC-R,N" "SBC" complex-instruction [
8-bit-registers sp <&> "SBC-R,N" "SBC" complex-instruction ,
",n" token <& 8-bit-registers sp ,
just [ first2 swap curry ] <@ ; ",n" token hide ,
] seq* [ first2 swap curry ] action ;
: SBC-R,R-instruction ( -- parser ) : SBC-R,R-instruction ( -- parser )
"SBC-R,R" "SBC" complex-instruction [
8-bit-registers sp <&> "SBC-R,R" "SBC" complex-instruction ,
"," token <& 8-bit-registers sp ,
8-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 8-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: SBC-R,(RR)-instruction ( -- parser ) : SBC-R,(RR)-instruction ( -- parser )
"SBC-R,(RR)" "SBC" complex-instruction [
8-bit-registers sp <&> "SBC-R,(RR)" "SBC" complex-instruction ,
"," token <& 8-bit-registers sp ,
16-bit-registers indirect <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 16-bit-registers indirect ,
] seq* [ first3 append swap curry ] action ;
: SUB-R-instruction ( -- parser ) : SUB-R-instruction ( -- parser )
"SUB-R" "SUB" complex-instruction [
8-bit-registers sp <&> "SUB-R" "SUB" complex-instruction ,
just [ first2 swap curry ] <@ ; 8-bit-registers sp ,
] seq* [ first2 swap curry ] action ;
: SUB-(RR)-instruction ( -- parser ) : SUB-(RR)-instruction ( -- parser )
"SUB-(RR)" "SUB" complex-instruction [
16-bit-registers indirect sp <&> "SUB-(RR)" "SUB" complex-instruction ,
just [ first2 swap curry ] <@ ; 16-bit-registers indirect sp ,
] seq* [ first2 swap curry ] action ;
: SUB-N-instruction ( -- parser ) : SUB-N-instruction ( -- parser )
"SUB-N" "SUB" complex-instruction [
"n" token sp <& "SUB-N" "SUB" complex-instruction ,
just [ { } clone swap curry ] <@ ; "n" token sp hide ,
] seq* [ first { } swap curry ] action ;
: ADD-R,N-instruction ( -- parser ) : ADD-R,N-instruction ( -- parser )
"ADD-R,N" "ADD" complex-instruction [
8-bit-registers sp <&> "ADD-R,N" "ADD" complex-instruction ,
",n" token <& 8-bit-registers sp ,
just [ first2 swap curry ] <@ ; ",n" token hide ,
] seq* [ first2 swap curry ] action ;
: ADD-R,R-instruction ( -- parser ) : ADD-R,R-instruction ( -- parser )
"ADD-R,R" "ADD" complex-instruction [
8-bit-registers sp <&> "ADD-R,R" "ADD" complex-instruction ,
"," token <& 8-bit-registers sp ,
8-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 8-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: ADD-RR,RR-instruction ( -- parser ) : ADD-RR,RR-instruction ( -- parser )
"ADD-RR,RR" "ADD" complex-instruction [
16-bit-registers sp <&> "ADD-RR,RR" "ADD" complex-instruction ,
"," token <& 16-bit-registers sp ,
16-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 16-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: ADD-R,(RR)-instruction ( -- parser ) : ADD-R,(RR)-instruction ( -- parser )
"ADD-R,(RR)" "ADD" complex-instruction [
8-bit-registers sp <&> "ADD-R,(RR)" "ADD" complex-instruction ,
"," token <& 8-bit-registers sp ,
16-bit-registers indirect <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 16-bit-registers indirect ,
] seq* [ first3 append swap curry ] action ;
: LD-RR,NN-instruction ( -- parser ) : LD-RR,NN-instruction ( -- parser )
#! LD BC,nn #! LD BC,nn
"LD-RR,NN" "LD" complex-instruction [
16-bit-registers sp <&> "LD-RR,NN" "LD" complex-instruction ,
",nn" token <& 16-bit-registers sp ,
just [ first2 swap curry ] <@ ; ",nn" token hide ,
] seq* [ first2 swap curry ] action ;
: LD-R,N-instruction ( -- parser ) : LD-R,N-instruction ( -- parser )
#! LD B,n #! LD B,n
"LD-R,N" "LD" complex-instruction [
8-bit-registers sp <&> "LD-R,N" "LD" complex-instruction ,
",n" token <& 8-bit-registers sp ,
just [ first2 swap curry ] <@ ; ",n" token hide ,
] seq* [ first2 swap curry ] action ;
: LD-(RR),N-instruction ( -- parser ) : LD-(RR),N-instruction ( -- parser )
"LD-(RR),N" "LD" complex-instruction [
16-bit-registers indirect sp <&> "LD-(RR),N" "LD" complex-instruction ,
",n" token <& 16-bit-registers indirect sp ,
just [ first2 swap curry ] <@ ; ",n" token hide ,
] seq* [ first2 swap curry ] action ;
: LD-(RR),R-instruction ( -- parser ) : LD-(RR),R-instruction ( -- parser )
#! LD (BC),A #! LD (BC),A
"LD-(RR),R" "LD" complex-instruction [
16-bit-registers indirect sp <&> "LD-(RR),R" "LD" complex-instruction ,
"," token <& 16-bit-registers indirect sp ,
8-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 8-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: LD-R,R-instruction ( -- parser ) : LD-R,R-instruction ( -- parser )
"LD-R,R" "LD" complex-instruction [
8-bit-registers sp <&> "LD-R,R" "LD" complex-instruction ,
"," token <& 8-bit-registers sp ,
8-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 8-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: LD-RR,RR-instruction ( -- parser ) : LD-RR,RR-instruction ( -- parser )
"LD-RR,RR" "LD" complex-instruction [
16-bit-registers sp <&> "LD-RR,RR" "LD" complex-instruction ,
"," token <& 16-bit-registers sp ,
16-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 16-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: LD-R,(RR)-instruction ( -- parser ) : LD-R,(RR)-instruction ( -- parser )
"LD-R,(RR)" "LD" complex-instruction [
8-bit-registers sp <&> "LD-R,(RR)" "LD" complex-instruction ,
"," token <& 8-bit-registers sp ,
16-bit-registers indirect <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 16-bit-registers indirect ,
] seq* [ first3 append swap curry ] action ;
: LD-(NN),RR-instruction ( -- parser ) : LD-(NN),RR-instruction ( -- parser )
"LD-(NN),RR" "LD" complex-instruction [
"nn" token indirect sp <& "LD-(NN),RR" "LD" complex-instruction ,
"," token <& "nn" token indirect sp hide ,
16-bit-registers <&> "," token hide ,
just [ first2 swap curry ] <@ ; 16-bit-registers ,
] seq* [ first2 swap curry ] action ;
: LD-(NN),R-instruction ( -- parser ) : LD-(NN),R-instruction ( -- parser )
"LD-(NN),R" "LD" complex-instruction [
"nn" token indirect sp <& "LD-(NN),R" "LD" complex-instruction ,
"," token <& "nn" token indirect sp hide ,
8-bit-registers <&> "," token hide ,
just [ first2 swap curry ] <@ ; 8-bit-registers ,
] seq* [ first2 swap curry ] action ;
: LD-RR,(NN)-instruction ( -- parser ) : LD-RR,(NN)-instruction ( -- parser )
"LD-RR,(NN)" "LD" complex-instruction [
16-bit-registers sp <&> "LD-RR,(NN)" "LD" complex-instruction ,
"," token <& 16-bit-registers sp ,
"nn" token indirect <& "," token hide ,
just [ first2 swap curry ] <@ ; "nn" token indirect hide ,
] seq* [ first2 swap curry ] action ;
: LD-R,(NN)-instruction ( -- parser ) : LD-R,(NN)-instruction ( -- parser )
"LD-R,(NN)" "LD" complex-instruction [
8-bit-registers sp <&> "LD-R,(NN)" "LD" complex-instruction ,
"," token <& 8-bit-registers sp ,
"nn" token indirect <& "," token hide ,
just [ first2 swap curry ] <@ ; "nn" token indirect hide ,
] seq* [ first2 swap curry ] action ;
: OUT-(N),R-instruction ( -- parser ) : OUT-(N),R-instruction ( -- parser )
"OUT-(N),R" "OUT" complex-instruction [
"n" token indirect sp <& "OUT-(N),R" "OUT" complex-instruction ,
"," token <& "n" token indirect sp hide ,
8-bit-registers <&> "," token hide ,
just [ first2 swap curry ] <@ ; 8-bit-registers ,
] seq* [ first2 swap curry ] action ;
: IN-R,(N)-instruction ( -- parser ) : IN-R,(N)-instruction ( -- parser )
"IN-R,(N)" "IN" complex-instruction [
8-bit-registers sp <&> "IN-R,(N)" "IN" complex-instruction ,
"," token <& 8-bit-registers sp ,
"n" token indirect <& "," token hide ,
just [ first2 swap curry ] <@ ; "n" token indirect hide ,
] seq* [ first2 swap curry ] action ;
: EX-(RR),RR-instruction ( -- parser ) : EX-(RR),RR-instruction ( -- parser )
"EX-(RR),RR" "EX" complex-instruction [
16-bit-registers indirect sp <&> "EX-(RR),RR" "EX" complex-instruction ,
"," token <& 16-bit-registers indirect sp ,
16-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 16-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: EX-RR,RR-instruction ( -- parser ) : EX-RR,RR-instruction ( -- parser )
"EX-RR,RR" "EX" complex-instruction [
16-bit-registers sp <&> "EX-RR,RR" "EX" complex-instruction ,
"," token <& 16-bit-registers sp ,
16-bit-registers <&> "," token hide ,
just [ first2 swap first2 swap >r prepend r> curry ] <@ ; 16-bit-registers ,
] seq* [ first3 append swap curry ] action ;
: 8080-generator-parser ( -- parser ) : 8080-generator-parser ( -- parser )
NOP-instruction [
RST-0-instruction <|> NOP-instruction ,
RST-8-instruction <|> RST-0-instruction ,
RST-10H-instruction <|> RST-8-instruction ,
RST-18H-instruction <|> RST-10H-instruction ,
RST-20H-instruction <|> RST-18H-instruction ,
RST-28H-instruction <|> RST-20H-instruction ,
RST-30H-instruction <|> RST-28H-instruction ,
RST-38H-instruction <|> RST-30H-instruction ,
JP-F|FF,NN-instruction <|> RST-38H-instruction ,
JP-NN-instruction <|> JP-F|FF,NN-instruction ,
JP-(RR)-instruction <|> JP-NN-instruction ,
CALL-F|FF,NN-instruction <|> JP-(RR)-instruction ,
CALL-NN-instruction <|> CALL-F|FF,NN-instruction ,
CPL-instruction <|> CALL-NN-instruction ,
CCF-instruction <|> CPL-instruction ,
SCF-instruction <|> CCF-instruction ,
DAA-instruction <|> SCF-instruction ,
RLA-instruction <|> DAA-instruction ,
RRA-instruction <|> RLA-instruction ,
RLCA-instruction <|> RRA-instruction ,
RRCA-instruction <|> RLCA-instruction ,
HALT-instruction <|> RRCA-instruction ,
DI-instruction <|> HALT-instruction ,
EI-instruction <|> DI-instruction ,
AND-N-instruction <|> EI-instruction ,
AND-R-instruction <|> AND-N-instruction ,
AND-(RR)-instruction <|> AND-R-instruction ,
XOR-N-instruction <|> AND-(RR)-instruction ,
XOR-R-instruction <|> XOR-N-instruction ,
XOR-(RR)-instruction <|> XOR-R-instruction ,
OR-N-instruction <|> XOR-(RR)-instruction ,
OR-R-instruction <|> OR-N-instruction ,
OR-(RR)-instruction <|> OR-R-instruction ,
CP-N-instruction <|> OR-(RR)-instruction ,
CP-R-instruction <|> CP-N-instruction ,
CP-(RR)-instruction <|> CP-R-instruction ,
DEC-RR-instruction <|> CP-(RR)-instruction ,
DEC-R-instruction <|> DEC-RR-instruction ,
DEC-(RR)-instruction <|> DEC-R-instruction ,
POP-RR-instruction <|> DEC-(RR)-instruction ,
PUSH-RR-instruction <|> POP-RR-instruction ,
INC-RR-instruction <|> PUSH-RR-instruction ,
INC-R-instruction <|> INC-RR-instruction ,
INC-(RR)-instruction <|> INC-R-instruction ,
LD-RR,NN-instruction <|> INC-(RR)-instruction ,
LD-R,N-instruction <|> LD-RR,NN-instruction ,
LD-R,R-instruction <|> LD-RR,RR-instruction ,
LD-RR,RR-instruction <|> LD-R,N-instruction ,
LD-(RR),N-instruction <|> LD-R,R-instruction ,
LD-(RR),R-instruction <|> LD-(RR),N-instruction ,
LD-R,(RR)-instruction <|> LD-(RR),R-instruction ,
LD-(NN),RR-instruction <|> LD-R,(RR)-instruction ,
LD-(NN),R-instruction <|> LD-(NN),RR-instruction ,
LD-RR,(NN)-instruction <|> LD-(NN),R-instruction ,
LD-R,(NN)-instruction <|> LD-RR,(NN)-instruction ,
ADC-R,N-instruction <|> LD-R,(NN)-instruction ,
ADC-R,R-instruction <|> ADC-R,(RR)-instruction ,
ADC-R,(RR)-instruction <|> ADC-R,N-instruction ,
ADD-R,N-instruction <|> ADC-R,R-instruction ,
ADD-R,R-instruction <|> ADD-R,N-instruction ,
ADD-RR,RR-instruction <|> ADD-R,(RR)-instruction ,
ADD-R,(RR)-instruction <|> ADD-R,R-instruction ,
SBC-R,N-instruction <|> ADD-RR,RR-instruction ,
SBC-R,R-instruction <|> SBC-R,N-instruction ,
SBC-R,(RR)-instruction <|> SBC-R,R-instruction ,
SUB-R-instruction <|> SBC-R,(RR)-instruction ,
SUB-(RR)-instruction <|> SUB-R-instruction ,
SUB-N-instruction <|> SUB-(RR)-instruction ,
RET-F|FF-instruction <|> SUB-N-instruction ,
RET-NN-instruction <|> RET-F|FF-instruction ,
OUT-(N),R-instruction <|> RET-NN-instruction ,
IN-R,(N)-instruction <|> OUT-(N),R-instruction ,
EX-(RR),RR-instruction <|> IN-R,(N)-instruction ,
EX-RR,RR-instruction <|> EX-(RR),RR-instruction ,
just ; EX-RR,RR-instruction ,
] choice* [ call ] action ;
: instruction-quotations ( string -- emulate-quot ) : instruction-quotations ( string -- emulate-quot )
#! Given an instruction string, return the emulation quotation for #! Given an instruction string, return the emulation quotation for
#! it. This will later be expanded to produce the disassembly and #! it. This will later be expanded to produce the disassembly and
#! assembly quotations. #! assembly quotations.
8080-generator-parser some parse call ; 8080-generator-parser parse ;
SYMBOL: last-instruction SYMBOL: last-instruction
SYMBOL: last-opcode SYMBOL: last-opcode