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

Fix space invaders hashtable and array usage for 0.80.

cvs
Chris Double 2006-01-13 12:58:11 +00:00
parent 64e326e56d
commit bb9ff1cc7b
1 changed files with 96 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

192
contrib/space-invaders/cpu-8080.factor
View File

@ -1,4 +1,4 @@
USING: kernel lists math sequences errors vectors prettyprint io unparser namespaces USING: kernel lists math sequences errors vectors prettyprint io namespaces arrays
words parser hashtables lazy parser-combinators kernel-internals strings ; words parser hashtables lazy parser-combinators kernel-internals strings ;
IN: cpu-8080 IN: cpu-8080
@ -558,18 +558,18 @@ C: cpu ( cpu -- cpu )
#! where the 1st item is the getter and the 2nd is the setter #! where the 1st item is the getter and the 2nd is the setter
#! for that register. #! for that register.
H{ H{
[[ "A" { cpu-a set-cpu-a } ]] { "A" { cpu-a set-cpu-a } }
[[ "B" { cpu-b set-cpu-b } ]] { "B" { cpu-b set-cpu-b } }
[[ "C" { cpu-c set-cpu-c } ]] { "C" { cpu-c set-cpu-c } }
[[ "D" { cpu-d set-cpu-d } ]] { "D" { cpu-d set-cpu-d } }
[[ "E" { cpu-e set-cpu-e } ]] { "E" { cpu-e set-cpu-e } }
[[ "H" { cpu-h set-cpu-h } ]] { "H" { cpu-h set-cpu-h } }
[[ "L" { cpu-l set-cpu-l } ]] { "L" { cpu-l set-cpu-l } }
[[ "AF" { cpu-af set-cpu-af } ]] { "AF" { cpu-af set-cpu-af } }
[[ "BC" { cpu-bc set-cpu-bc } ]] { "BC" { cpu-bc set-cpu-bc } }
[[ "DE" { cpu-de set-cpu-de } ]] { "DE" { cpu-de set-cpu-de } }
[[ "HL" { cpu-hl set-cpu-hl } ]] { "HL" { cpu-hl set-cpu-hl } }
[[ "SP" { cpu-sp set-cpu-sp } ]] { "SP" { cpu-sp set-cpu-sp } }
} hash ; } hash ;
@ -577,14 +577,14 @@ C: cpu ( cpu -- cpu )
#! Given a string containing a flag name, return a vector #! Given a string containing a flag name, return a vector
#! where the 1st item is a word that tests that flag. #! where the 1st item is a word that tests that flag.
H{ H{
[[ "NZ" { flag-nz? } ]] { "NZ" { flag-nz? } }
[[ "NC" { flag-nc? } ]] { "NC" { flag-nc? } }
[[ "PO" { flag-po? } ]] { "PO" { flag-po? } }
[[ "PE" { flag-pe? } ]] { "PE" { flag-pe? } }
[[ "Z" { flag-z? } ]] { "Z" { flag-z? } }
[[ "C" { flag-c? } ]] { "C" { flag-c? } }
[[ "P" { flag-p? } ]] { "P" { flag-p? } }
[[ "M" { flag-m? } ]] { "M" { flag-m? } }
} hash ; } hash ;
SYMBOL: $1 SYMBOL: $1
@ -699,81 +699,81 @@ SYMBOL: $4
: patterns ( -- hashtable ) : patterns ( -- hashtable )
#! table of code quotation patterns for each type of instruction. #! table of code quotation patterns for each type of instruction.
H{ H{
[[ "NOP" [ drop ] ]] { "NOP" [ drop ] }
[[ "RET-NN" [ ret-from-sub ] ]] { "RET-NN" [ ret-from-sub ] }
[[ "RST-0" [ 0 swap (emulate-RST) ] ]] { "RST-0" [ 0 swap (emulate-RST) ] }
[[ "RST-8" [ 8 swap (emulate-RST) ] ]] { "RST-8" [ 8 swap (emulate-RST) ] }
[[ "RST-10H" [ HEX: 10 swap (emulate-RST) ] ]] { "RST-10H" [ HEX: 10 swap (emulate-RST) ] }
[[ "RST-18H" [ HEX: 18 swap (emulate-RST) ] ]] { "RST-18H" [ HEX: 18 swap (emulate-RST) ] }
[[ "RST-20H" [ HEX: 20 swap (emulate-RST) ] ]] { "RST-20H" [ HEX: 20 swap (emulate-RST) ] }
[[ "RST-28H" [ HEX: 28 swap (emulate-RST) ] ]] { "RST-28H" [ HEX: 28 swap (emulate-RST) ] }
[[ "RST-30H" [ HEX: 30 swap (emulate-RST) ] ]] { "RST-30H" [ HEX: 30 swap (emulate-RST) ] }
[[ "RST-38H" [ HEX: 38 swap (emulate-RST) ] ]] { "RST-38H" [ HEX: 38 swap (emulate-RST) ] }
[[ "RET-F|FF" [ dup $1 [ 6 over inc-cycles ret-from-sub ] [ drop ] if ] ]] { "RET-F|FF" [ dup $1 [ 6 over inc-cycles ret-from-sub ] [ drop ] if ] }
[[ "CP-N" [ [ cpu-a ] keep [ next-byte ] keep sub-byte drop ] ]] { "CP-N" [ [ cpu-a ] keep [ next-byte ] keep sub-byte drop ] }
[[ "CP-R" [ [ cpu-a ] keep [ $1 ] keep sub-byte drop ] ]] { "CP-R" [ [ cpu-a ] keep [ $1 ] keep sub-byte drop ] }
[[ "CP-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep sub-byte drop ] ]] { "CP-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep sub-byte drop ] }
[[ "OR-N" [ [ cpu-a ] keep [ next-byte ] keep [ or-byte ] keep set-cpu-a ] ]] { "OR-N" [ [ cpu-a ] keep [ next-byte ] keep [ or-byte ] keep set-cpu-a ] }
[[ "OR-R" [ [ cpu-a ] keep [ $1 ] keep [ or-byte ] keep set-cpu-a ] ]] { "OR-R" [ [ cpu-a ] keep [ $1 ] keep [ or-byte ] keep set-cpu-a ] }
[[ "OR-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ or-byte ] keep set-cpu-a ] ]] { "OR-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ or-byte ] keep set-cpu-a ] }
[[ "XOR-N" [ [ cpu-a ] keep [ next-byte ] keep [ xor-byte ] keep set-cpu-a ] ]] { "XOR-N" [ [ cpu-a ] keep [ next-byte ] keep [ xor-byte ] keep set-cpu-a ] }
[[ "XOR-R" [ [ cpu-a ] keep [ $1 ] keep [ xor-byte ] keep set-cpu-a ] ]] { "XOR-R" [ [ cpu-a ] keep [ $1 ] keep [ xor-byte ] keep set-cpu-a ] }
[[ "XOR-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ xor-byte ] keep set-cpu-a ] ]] { "XOR-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ xor-byte ] keep set-cpu-a ] }
[[ "AND-N" [ [ cpu-a ] keep [ next-byte ] keep [ and-byte ] keep set-cpu-a ] ]] { "AND-N" [ [ cpu-a ] keep [ next-byte ] keep [ and-byte ] keep set-cpu-a ] }
[[ "AND-R" [ [ cpu-a ] keep [ $1 ] keep [ and-byte ] keep set-cpu-a ] ]] { "AND-R" [ [ cpu-a ] keep [ $1 ] keep [ and-byte ] keep set-cpu-a ] }
[[ "AND-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ and-byte ] keep set-cpu-a ] ]] { "AND-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ and-byte ] keep set-cpu-a ] }
[[ "ADC-R,N" [ [ $1 ] keep [ next-byte ] keep [ add-byte-with-carry ] keep $2 ] ]] { "ADC-R,N" [ [ $1 ] keep [ next-byte ] keep [ add-byte-with-carry ] keep $2 ] }
[[ "ADC-R,R" [ [ $1 ] keep [ $3 ] keep [ add-byte-with-carry ] keep $2 ] ]] { "ADC-R,R" [ [ $1 ] keep [ $3 ] keep [ add-byte-with-carry ] keep $2 ] }
[[ "ADC-R,(RR)" [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte-with-carry ] keep $2 ] ]] { "ADC-R,(RR)" [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte-with-carry ] keep $2 ] }
[[ "ADD-R,N" [ [ $1 ] keep [ next-byte ] keep [ add-byte ] keep $2 ] ]] { "ADD-R,N" [ [ $1 ] keep [ next-byte ] keep [ add-byte ] keep $2 ] }
[[ "ADD-R,R" [ [ $1 ] keep [ $3 ] keep [ add-byte ] keep $2 ] ]] { "ADD-R,R" [ [ $1 ] keep [ $3 ] keep [ add-byte ] keep $2 ] }
[[ "ADD-RR,RR" [ [ $1 ] keep [ $3 ] keep [ add-word ] keep $2 ] ]] { "ADD-RR,RR" [ [ $1 ] keep [ $3 ] keep [ add-word ] keep $2 ] }
[[ "ADD-R,(RR)" [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte ] keep $2 ] ]] { "ADD-R,(RR)" [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte ] keep $2 ] }
[[ "SBC-R,N" [ [ $1 ] keep [ next-byte ] keep [ sub-byte-with-carry ] keep $2 ] ]] { "SBC-R,N" [ [ $1 ] keep [ next-byte ] keep [ sub-byte-with-carry ] keep $2 ] }
[[ "SBC-R,R" [ [ $1 ] keep [ $3 ] keep [ sub-byte-with-carry ] keep $2 ] ]] { "SBC-R,R" [ [ $1 ] keep [ $3 ] keep [ sub-byte-with-carry ] keep $2 ] }
[[ "SBC-R,(RR)" [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ sub-byte-with-carry ] keep $2 ] ]] { "SBC-R,(RR)" [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ sub-byte-with-carry ] keep $2 ] }
[[ "SUB-R" [ [ cpu-a ] keep [ $1 ] keep [ sub-byte ] keep set-cpu-a ] ]] { "SUB-R" [ [ cpu-a ] keep [ $1 ] keep [ sub-byte ] keep set-cpu-a ] }
[[ "SUB-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ sub-byte ] keep set-cpu-a ] ]] { "SUB-(RR)" [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ sub-byte ] keep set-cpu-a ] }
[[ "SUB-N" [ [ cpu-a ] keep [ next-byte ] keep [ sub-byte ] keep set-cpu-a ] ]] { "SUB-N" [ [ cpu-a ] keep [ next-byte ] keep [ sub-byte ] keep set-cpu-a ] }
[[ "CPL" [ (emulate-CPL) ] ]] { "CPL" [ (emulate-CPL) ] }
[[ "DAA" [ (emulate-DAA) ] ]] { "DAA" [ (emulate-DAA) ] }
[[ "RLA" [ (emulate-RLA) ] ]] { "RLA" [ (emulate-RLA) ] }
[[ "RRA" [ (emulate-RRA) ] ]] { "RRA" [ (emulate-RRA) ] }
[[ "CCF" [ carry-flag swap cpu-f-bitxor= ] ]] { "CCF" [ carry-flag swap cpu-f-bitxor= ] }
[[ "SCF" [ carry-flag swap cpu-f-bitor= ] ]] { "SCF" [ carry-flag swap cpu-f-bitor= ] }
[[ "RLCA" [ (emulate-RLCA) ] ]] { "RLCA" [ (emulate-RLCA) ] }
[[ "RRCA" [ (emulate-RRCA) ] ]] { "RRCA" [ (emulate-RRCA) ] }
[[ "HALT" [ drop ] ]] { "HALT" [ drop ] }
[[ "DI" [ [ 255 interrupt-flag - ] swap cpu-f-bitand ] ]] { "DI" [ [ 255 interrupt-flag - ] swap cpu-f-bitand ] }
[[ "EI" [ [ interrupt-flag ] swap cpu-f-bitor ] ]] { "EI" [ [ interrupt-flag ] swap cpu-f-bitor ] }
[[ "POP-RR" [ [ pop-sp ] keep $2 ] ]] { "POP-RR" [ [ pop-sp ] keep $2 ] }
[[ "PUSH-RR" [ [ $1 ] keep push-sp ] ]] { "PUSH-RR" [ [ $1 ] keep push-sp ] }
[[ "INC-R" [ [ $1 ] keep [ inc-byte ] keep $2 ] ]] { "INC-R" [ [ $1 ] keep [ inc-byte ] keep $2 ] }
[[ "DEC-R" [ [ $1 ] keep [ dec-byte ] keep $2 ] ]] { "DEC-R" [ [ $1 ] keep [ dec-byte ] keep $2 ] }
[[ "INC-RR" [ [ $1 ] keep [ inc-word ] keep $2 ] ]] { "INC-RR" [ [ $1 ] keep [ inc-word ] keep $2 ] }
[[ "DEC-RR" [ [ $1 ] keep [ dec-word ] keep $2 ] ]] { "DEC-RR" [ [ $1 ] keep [ dec-word ] keep $2 ] }
[[ "DEC-(RR)" [ [ $1 ] keep [ read-byte ] keep [ dec-byte ] keep [ $1 ] keep write-byte ] ]] { "DEC-(RR)" [ [ $1 ] keep [ read-byte ] keep [ dec-byte ] keep [ $1 ] keep write-byte ] }
[[ "INC-(RR)" [ [ $1 ] keep [ read-byte ] keep [ inc-byte ] keep [ $1 ] keep write-byte ] ]] { "INC-(RR)" [ [ $1 ] keep [ read-byte ] keep [ inc-byte ] keep [ $1 ] keep write-byte ] }
[[ "JP-NN" [ [ cpu-pc ] keep [ read-word ] keep set-cpu-pc ] ]] { "JP-NN" [ [ cpu-pc ] keep [ read-word ] keep set-cpu-pc ] }
[[ "JP-F|FF,NN" [ [ $1 ] keep swap [ [ next-word ] keep [ set-cpu-pc ] keep [ cpu-cycles ] keep swap 5 + swap set-cpu-cycles ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] if ] ]] { "JP-F|FF,NN" [ [ $1 ] keep swap [ [ next-word ] keep [ set-cpu-pc ] keep [ cpu-cycles ] keep swap 5 + swap set-cpu-cycles ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] if ] }
[[ "JP-(RR)" [ [ $1 ] keep set-cpu-pc ] ]] { "JP-(RR)" [ [ $1 ] keep set-cpu-pc ] }
[[ "CALL-NN" [ (emulate-CALL) ] ]] { "CALL-NN" [ (emulate-CALL) ] }
[[ "CALL-F|FF,NN" [ [ $1 ] keep swap [ 7 over inc-cycles (emulate-CALL) ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] if ] ]] { "CALL-F|FF,NN" [ [ $1 ] keep swap [ 7 over inc-cycles (emulate-CALL) ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] if ] }
[[ "LD-RR,NN" [ [ next-word ] keep $2 ] ]] { "LD-RR,NN" [ [ next-word ] keep $2 ] }
[[ "LD-RR,RR" [ [ $3 ] keep $2 ] ]] { "LD-RR,RR" [ [ $3 ] keep $2 ] }
[[ "LD-R,N" [ [ next-byte ] keep $2 ] ]] { "LD-R,N" [ [ next-byte ] keep $2 ] }
[[ "LD-(RR),N" [ [ next-byte ] keep [ $1 ] keep write-byte ] ]] { "LD-(RR),N" [ [ next-byte ] keep [ $1 ] keep write-byte ] }
[[ "LD-(RR),R" [ [ $3 ] keep [ $1 ] keep write-byte ] ]] { "LD-(RR),R" [ [ $3 ] keep [ $1 ] keep write-byte ] }
[[ "LD-R,R" [ [ $3 ] keep $2 ] ]] { "LD-R,R" [ [ $3 ] keep $2 ] }
[[ "LD-R,(RR)" [ [ $3 ] keep [ read-byte ] keep $2 ] ]] { "LD-R,(RR)" [ [ $3 ] keep [ read-byte ] keep $2 ] }
[[ "LD-(NN),RR" [ [ $1 ] keep [ next-word ] keep write-word ] ]] { "LD-(NN),RR" [ [ $1 ] keep [ next-word ] keep write-word ] }
[[ "LD-(NN),R" [ [ $1 ] keep [ next-word ] keep write-byte ] ]] { "LD-(NN),R" [ [ $1 ] keep [ next-word ] keep write-byte ] }
[[ "LD-RR,(NN)" [ [ next-word ] keep [ read-word ] keep $2 ] ]] { "LD-RR,(NN)" [ [ next-word ] keep [ read-word ] keep $2 ] }
[[ "LD-R,(NN)" [ [ next-word ] keep [ read-byte ] keep $2 ] ]] { "LD-R,(NN)" [ [ next-word ] keep [ read-byte ] keep $2 ] }
[[ "OUT-(N),R" [ [ $1 ] keep [ next-byte ] keep write-port ] ]] { "OUT-(N),R" [ [ $1 ] keep [ next-byte ] keep write-port ] }
[[ "IN-R,(N)" [ [ next-byte ] keep [ read-port ] keep set-cpu-a ] ]] { "IN-R,(N)" [ [ next-byte ] keep [ read-port ] keep set-cpu-a ] }
[[ "EX-(RR),RR" [ [ $1 ] keep [ read-word ] keep [ $3 ] keep [ $1 ] keep [ write-word ] keep $4 ] ]] { "EX-(RR),RR" [ [ $1 ] keep [ read-word ] keep [ $3 ] keep [ $1 ] keep [ write-word ] keep $4 ] }
[[ "EX-RR,RR" [ [ $1 ] keep [ $3 ] keep [ $2 ] keep $4 ] ]] { "EX-RR,RR" [ [ $1 ] keep [ $3 ] keep [ $2 ] keep $4 ] }
} ; } ;
: 8-bit-registers ( -- parser ) : 8-bit-registers ( -- parser )