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

space invaders: fix half carry problem, this fixing score problem. Implemented remaining 8080 instructions.

cvs
Chris Double 2005-09-11 22:32:44 +00:00
parent dede7e0dba
commit 0f54aa9e13
2 changed files with 62 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -217,57 +217,79 @@ M: cpu write-port ( value port cpu -- )
#! higher order bit, this flag is set, otherwise it is reset. #! higher order bit, this flag is set, otherwise it is reset.
swap dup HEX: 100 >= swap 0 < or [ carry-flag set-flag ] [ carry-flag clear-flag ] ifte ; swap dup HEX: 100 >= swap 0 < or [ carry-flag set-flag ] [ carry-flag clear-flag ] ifte ;
: update-half-carry-flag ( result cpu -- ) : update-half-carry-flag ( original change-by result cpu -- )
#! If the instruction caused a carry out of bit 3 and into bit 4 of the #! If the instruction caused a carry out of bit 3 and into bit 4 of the
#! resulting value, the half carry flag is set, otherwise it is reset. #! resulting value, the half carry flag is set, otherwise it is reset.
swap HEX: 10 bitand 0 = [ half-carry-flag clear-flag ] [ half-carry-flag set-flag ] ifte ; #! The 'original' is the original value of the register being changed.
#! 'change-by' is the amount it is being added or decremented by.
#! 'result' is the result of that change.
>r bitxor bitxor HEX: 10 bitand 0 = not r>
swap [ half-carry-flag set-flag ] [ half-carry-flag clear-flag ] ifte ;
: update-flags ( result cpu -- ) : update-flags ( result cpu -- )
2dup update-half-carry-flag
2dup update-carry-flag 2dup update-carry-flag
2dup update-parity-flag 2dup update-parity-flag
2dup update-sign-flag 2dup update-sign-flag
update-zero-flag ; update-zero-flag ;
: update-flags-no-carry ( result cpu -- ) : update-flags-no-carry ( result cpu -- )
2dup update-half-carry-flag
2dup update-parity-flag 2dup update-parity-flag
2dup update-sign-flag 2dup update-sign-flag
update-zero-flag ; update-zero-flag ;
: add-byte ( lhs rhs cpu -- result ) : add-byte ( lhs rhs cpu -- result )
#! Add rhs to lhs #! Add rhs to lhs
>r + r> [ update-flags ] 2keep drop HEX: FF bitand ; >r 2dup + r> ( lhs rhs result cpu )
[ update-flags ] 2keep
[ update-half-carry-flag ] 2keep
drop HEX: FF bitand ;
: add-carry ( result cpu -- result ) : add-carry ( change-by result cpu -- change-by result )
#! Add the effect of the carry flag to the result #! Add the effect of the carry flag to the result
flag-c? [ 1 + ] when ; flag-c? [ 1 + >r 1 + r> ] when ;
: add-byte-with-carry ( lhs rhs cpu -- result ) : add-byte-with-carry ( lhs rhs cpu -- result )
#! Add rhs to lhs plus carry. #! Add rhs to lhs plus carry.
>r + r> [ add-carry ] keep [ update-flags ] 2keep drop HEX: FF bitand ; >r 2dup + r> ( lhs rhs result cpu )
[ add-carry ] keep
[ update-flags ] 2keep
[ update-half-carry-flag ] 2keep
drop HEX: FF bitand ;
: sub-carry ( result cpu -- result ) : sub-carry ( change-by result cpu -- change-by result )
#! Subtract the effect of the carry flag from the result #! Subtract the effect of the carry flag from the result
flag-c? [ 1 - ] when ; flag-c? [ 1 - >r 1 - r> ] when ;
: sub-byte ( lhs rhs cpu -- result ) : sub-byte ( lhs rhs cpu -- result )
#! Subtract rhs from lhs #! Subtract rhs from lhs
>r - r> [ update-flags ] 2keep drop HEX: FF bitand ; >r 2dup - r>
[ update-flags ] 2keep
[ update-half-carry-flag ] 2keep
drop HEX: FF bitand ;
: sub-byte-with-carry ( lhs rhs cpu -- result ) : sub-byte-with-carry ( lhs rhs cpu -- result )
#! Subtract rhs from lhs and take carry into account #! Subtract rhs from lhs and take carry into account
>r - r> [ sub-carry ] keep [ update-flags ] 2keep drop HEX: FF bitand ; >r 2dup - r>
[ sub-carry ] keep
[ update-flags ] 2keep
[ update-half-carry-flag ] 2keep
drop HEX: FF bitand ;
: inc-byte ( byte cpu -- result ) : inc-byte ( byte cpu -- result )
#! Increment byte by one. Note that carry flag is not affected #! Increment byte by one. Note that carry flag is not affected
#! by this operation. #! by this operation.
>r 1 + r> [ update-flags-no-carry ] 2keep drop HEX: FF bitand ; >r 1 2dup + r> ( lhs rhs result cpu )
[ update-flags-no-carry ] 2keep
[ update-half-carry-flag ] 2keep
drop HEX: FF bitand ;
: dec-byte ( byte cpu -- result ) : dec-byte ( byte cpu -- result )
#! Decrement byte by one. Note that carry flag is not affected #! Decrement byte by one. Note that carry flag is not affected
#! by this operation. #! by this operation.
>r 1 - r> [ update-flags-no-carry ] 2keep drop HEX: FF bitand ; >r 1 2dup - r> ( lhs rhs result cpu )
[ update-flags-no-carry ] 2keep
[ update-half-carry-flag ] 2keep
drop HEX: FF bitand ;
: inc-word ( w cpu -- w ) : inc-word ( w cpu -- w )
#! Increment word by one. Note that no flags are modified. #! Increment word by one. Note that no flags are modified.
@ -280,7 +302,7 @@ M: cpu write-port ( value port cpu -- )
: add-word ( lhs rhs cpu -- result ) : add-word ( lhs rhs cpu -- result )
#! Add rhs to lhs. Note that only the carry flag is modified #! Add rhs to lhs. Note that only the carry flag is modified
#! and only if there is a carry out of the double precision add. #! and only if there is a carry out of the double precision add.
>r + r> over HEX: FFFF > [ carry-flag over set-flag ] when drop HEX: FFFF bitand ; >r + r> over HEX: FFFF > [ carry-flag set-flag ] [ drop ] ifte HEX: FFFF bitand ;
: bit3or ( lhs rhs -- 0|1 ) : bit3or ( lhs rhs -- 0|1 )
#! bitor bit 3 of the two numbers on the stack #! bitor bit 3 of the two numbers on the stack
@ -428,6 +450,13 @@ C: cpu ( cpu -- cpu )
0 swap (load-rom) 0 swap (load-rom)
] with-stream ; ] with-stream ;
: load-rom* ( addr filename <cpu> -- )
#! Load the contents of the file into ROM, starting at
#! the specified address.
cpu-ram swap <file-reader> [
(load-rom)
] with-stream ;
: read-instruction ( cpu -- word ) : read-instruction ( cpu -- word )
#! Read the next instruction from the cpu's program #! Read the next instruction from the cpu's program
#! counter, and increment the program counter. #! counter, and increment the program counter.
@ -571,6 +600,14 @@ SYMBOL: $4
: test-rp : test-rp
{ 4 5 3 } [ 1 $2 [ $1 4 ] ] replace-patterns ; { 4 5 3 } [ 1 $2 [ $1 4 ] ] replace-patterns ;
: (emulate-RST) ( n cpu -- )
#! RST nn
[ cpu-sp 2 - dup ] keep ( sp sp cpu )
[ set-cpu-sp ] keep ( sp cpu )
[ cpu-pc ] keep ( sp pc cpu )
swapd [ write-word ] keep ( cpu )
>r 8 * r> set-cpu-pc ;
: (emulate-CALL) ( cpu -- ) : (emulate-CALL) ( cpu -- )
#! 205 - CALL nn #! 205 - CALL nn
[ next-word HEX: FFFF bitand ] keep ( addr cpu ) [ next-word HEX: FFFF bitand ] keep ( addr cpu )
@ -653,14 +690,14 @@ SYMBOL: $4
{{ {{
[[ "NOP" [ drop ] ]] [[ "NOP" [ drop ] ]]
[[ "RET-NN" [ ret-from-sub ] ]] [[ "RET-NN" [ ret-from-sub ] ]]
[[ "RST-0" [ drop "RST 0 Not Implemented" throw ] ]] [[ "RST-0" [ 0 swap (emulate-RST) ] ]]
[[ "RST-8" [ drop "RST 8 Not Implemented" throw ] ]] [[ "RST-8" [ 8 swap (emulate-RST) ] ]]
[[ "RST-10H" [ drop "RST 10H Not Implemented" throw ] ]] [[ "RST-10H" [ HEX: 10 swap (emulate-RST) ] ]]
[[ "RST-18H" [ drop "RST 18H Not Implemented" throw ] ]] [[ "RST-18H" [ HEX: 18 swap (emulate-RST) ] ]]
[[ "RST-20H" [ drop "RST 20H Not Implemented" throw ] ]] [[ "RST-20H" [ HEX: 20 swap (emulate-RST) ] ]]
[[ "RST-28H" [ drop "RST 28H Not Implemented" throw ] ]] [[ "RST-28H" [ HEX: 28 swap (emulate-RST) ] ]]
[[ "RST-30H" [ drop "RST 30H Not Implemented" throw ] ]] [[ "RST-30H" [ HEX: 30 swap (emulate-RST) ] ]]
[[ "RST-38H" [ drop "RST 38H Not Implemented" throw ] ]] [[ "RST-38H" [ HEX: 38 swap (emulate-RST) ] ]]
[[ "RET-F|FF" [ dup $1 [ 6 over inc-cycles ret-from-sub ] [ drop ] ifte ] ]] [[ "RET-F|FF" [ dup $1 [ 6 over inc-cycles ret-from-sub ] [ drop ] ifte ] ]]
[[ "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 ] ]]
@ -712,7 +749,7 @@ SYMBOL: $4
[[ "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 ] ifte ] ]] [[ "CALL-F|FF,NN" [ [ $1 ] keep swap [ 7 over inc-cycles (emulate-CALL) ] [ [ cpu-pc 2 + ] keep set-cpu-pc ] ifte ] ]]
[[ "LD-RR,NN" [ [ next-word ] keep $2 ] ]] [[ "LD-RR,NN" [ [ next-word ] keep $2 ] ]]
[[ "LD-RR,RR" [ drop "LD-RR,RR not implemented" throw ] ]] [[ "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 ] ]]

1
contrib/space-invaders/load.factor
View File

@ -7,5 +7,6 @@ USING: parser compiler words sequences io ;
"space-invaders.factor" run-file "space-invaders.factor" run-file
"cpu-8080" words [ try-compile ] each "cpu-8080" words [ try-compile ] each
"space-invaders" words [ try-compile ] each
"Use 'run' in the 'space-invaders' vocabulary to start." print "Use 'run' in the 'space-invaders' vocabulary to start." print