space invaders: Reimplemented a bunch of instructions in a clearer manner, following the 8080 data sheet.

Added left, right and fire.

contrib/space-invaders/cpu.factor

@@ -4,6 +4,12 @@ IN: cpu-8080
 
 TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles port1 port2i port2o port3o port4lo port4hi port5o ram display ;
 
+: valid-byte? ( b -- )
+  dup 0 >= swap HEX: FF <= and not [ "Invalid byte" throw ] when ;
+
+: valid-word? ( w -- )
+  dup 0 >= swap HEX: FFFF <= and not [ "Invalid word" throw ] when ;
+
 : carry-flag        HEX: 01 ; inline
 : add-sub-flag      HEX: 02 ; inline
 : subtraction-flag  HEX: 02 ; inline
@@ -62,21 +68,59 @@ TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles port1 port2i port
   #! Set the value of the 16-bit pseudo register HL
   >r >word< r> tuck set-cpu-l set-cpu-h ;
 
+: flag-set? ( flag cpu -- bool )
+  cpu-f bitand 0 = not ;
+
+: flag-clear? ( flag cpu -- bool )
+  cpu-f bitand 0 = ;
+
+: flag-nz? ( cpu -- bool )
+  #! Test flag status
+  cpu-f zero-flag bitand 0 = ;
+
+: flag-z? ( cpu -- bool )
+  #! Test flag status
+  cpu-f zero-flag bitand 0 = not ;
+
+: flag-nc? ( cpu -- bool )
+  #! Test flag status
+  cpu-f carry-flag bitand 0 = ;
+
+: flag-c? ( cpu -- bool )
+  #! Test flag status
+  cpu-f carry-flag bitand 0 = not ;
+
+: flag-po? ( cpu -- bool )
+  #! Test flag status
+  cpu-f parity-flag bitand 0 =  ;
+
+: flag-pe? ( cpu -- bool )
+  #! Test flag status
+  cpu-f parity-flag bitand 0 = not ;
+
+: flag-p? ( cpu -- bool )
+  #! Test flag status
+  cpu-f sign-flag bitand 0 = ;
+
+: flag-m? ( cpu -- bool )
+  #! Test flag status
+  cpu-f sign-flag bitand 0 = not ;
+
 : read-byte ( addr cpu -- byte )
   #! Read one byte from memory at the specified address.
   #! The address is 16-bit, but if a value greater than
   #! 0xFFFF is provided then return a default value.
-  cpu-ram 2dup length < [
+  over HEX: FFFF <= [
-    nth
+    cpu-ram nth
   ] [
     2drop HEX: FF
-  ] ifte ;
+  ] ifte dup valid-byte? ;
 
 : read-word ( addr cpu -- word )  
   #! Read a 16-bit word from memory at the specified address.
   #! The address is 16-bit, but if a value greater than
   #! 0xFFFF is provided then return a default value.
-  [ read-byte ] 2keep >r 1 + r> read-byte 8 shift bitor ;
+  [ read-byte ] 2keep >r 1 + r> read-byte 8 shift bitor dup valid-word? ;
  
 : next-byte ( cpu -- byte )
   #! Return the value of the byte at PC, and increment PC.
@@ -107,7 +151,9 @@ TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles port1 port2i port
 
 : write-byte ( value addr cpu -- )
   #! Write a byte to the specified memory address.
-  over dup HEX: 2000 < swap HEX: FFFF >= or [
+  pick valid-byte? 
+  over valid-word?
+  over dup HEX: 2000 < swap HEX: FFFF > or [
     3drop
   ] [
     3dup cpu-ram set-nth
@@ -117,6 +163,7 @@ TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles port1 port2i port
 
 : write-word ( value addr cpu -- )
   #! Write a 16-bit word to the specified memory address.
+  pick valid-word?
   >r >r >word< r> r> [ write-byte ] 2keep >r 1 + r> write-byte ;
 
 : read-port ( port cpu -- byte )
@@ -128,11 +175,12 @@ TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles port1 port2i port
     { [ over 2 = ] [ nip [ cpu-port2i HEX: 8F bitand ] keep cpu-port1 HEX: 70 bitand bitor ] }
     { [ over 3 = ] [ nip [ cpu-port4hi 8 shift ] keep [ cpu-port4lo bitor ] keep cpu-port2o shift -8 shift HEX: FF bitand ] }
     { [ t ] [ 2drop 0 ] }    
-  } cond ;
+  } cond dup valid-byte? ;
 
 : write-port ( value port cpu -- )
   #! Write a byte to the hardware port, where 'port' is
   #! an 8-bit value.  
+  pick valid-byte?
 !  3dup drop "OUT to " write unparse write " value " write unparse print 
   {
     { [ over 2 = ] [ nip set-cpu-port2o ] }
@@ -171,6 +219,52 @@ TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles port1 port2i port
   #! F |= quot call 
   [ cpu-f swap call bitxor ] keep set-cpu-f ; inline
 
+: set-flag ( cpu flag -- )
+  swap cpu-f-bitor= ;
+
+: clear-flag ( cpu flag -- )
+   bitnot HEX: FF bitand swap cpu-f-bitand= ;
+
+: update-zero-flag ( result cpu -- )
+  #! If the result of an instruction has the value 0, this
+  #! flag is set, otherwise it is reset.
+  swap HEX: FF bitand 0 = [ zero-flag set-flag ] [ zero-flag clear-flag ] ifte ;
+
+: update-sign-flag ( result cpu -- )
+  #! If the most significant bit of the result 
+  #! has the value 1 then the flag is set, otherwise
+  #! it is reset.
+  swap HEX: 80 bitand 0 = [ sign-flag clear-flag ] [ sign-flag set-flag ] ifte ;
+
+: update-parity-flag ( result cpu -- )
+  #! If the modulo 2 sum of the bits of the result
+  #! is 0, (ie. if the result has even parity) this flag
+  #! is set, otherwise it is reset.
+  swap HEX: FF bitand 2 mod 0 = [ parity-flag set-flag ] [ parity-flag clear-flag ] ifte ;
+: update-carry-flag ( result cpu -- )
+  #! If the instruction resulted in a carry (from addition) 
+  #! or a borrow (from subtraction or a comparison) out of the
+  #! 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 ;
+
+: update-half-carry-flag ( result cpu -- )
+  #! 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.
+  swap HEX: 10 bitand 0 = [ half-carry-flag clear-flag ] [ half-carry-flag set-flag ] ifte ;
+
+: update-flags ( result cpu -- )
+  2dup update-half-carry-flag
+  2dup update-carry-flag
+  2dup update-parity-flag
+  2dup update-sign-flag
+  update-zero-flag ;
+
+: update-flags-no-carry ( result cpu -- )
+  2dup update-half-carry-flag
+  2dup update-parity-flag
+  2dup update-sign-flag
+  update-zero-flag ;
+
 : trigger-zero-flag ( n cpu -- )
   #! Given the value n, set the zero flag if required.
   swap HEX: FF bitand 0 = [ [ zero-flag ] swap cpu-f-bitor ] [ drop ] ifte ;
@@ -208,34 +302,79 @@ TUPLE: cpu b c d e f h l a pc sp halted? last-interrupt cycles port1 port2i port
   #! cpu-f ^= value
   [ cpu-f bitxor ] keep set-cpu-f ;
 
-: add-byte-to-a ( carry? n cpu -- )
+: add-byte ( lhs rhs cpu -- result )
-  #! Adds 'n' to the 'a' register. 'carry?' is try if
+  #! Add rhs to lhs
-  #! the carry flag should be considered in the add.
+  >r + r> [ update-flags ] 2keep drop HEX: FF bitand ;
-  over >r
-  [ cpu-a + swap [ 1 + ] when ] keep ( x cpu )
-  flag3-flag flag5-flag bitor over cpu-f-bitand= ( x cpu )  
-  over HEX: FF bitand 0 = [ zero-flag over cpu-f-bitor= ] when
-  over HEX: 80 bitand 0 = not [ sign-flag over cpu-f-bitor= ] when
-  over HEX: 100 >= [ carry-flag over cpu-f-bitor= ] when
-  r> swapd ( cpu x n )
-  [ pick cpu-a bitxor bitxor HEX: 10 bitand 0 = not [ half-carry-flag over cpu-f-bitor= ] when ] 2keep
-  [ bitxor ] 2keep ( cpu x^n x n )
-  >r pick cpu-a r> bitxor ( cpu x^n x a^n )
-  bitnot HEX: FF bitand ( cpu x^n x ~a^n )
-  swapd bitand HEX: 80 bitand 0 = not [ overflow-flag pick cpu-f-bitor= ] when 
-  HEX: FF bitand swap set-cpu-a ;
 
-: add-words ( hl rr cpu ) 
+: add-carry ( result cpu -- result )
-  >r 2dup + r>      ( hl rr x cpu )
+  #! Add the effect of the carry flag to the result
-  flag3-flag flag5-flag bitor sign-flag bitor 
+  flag-c? [ 1 + ] when ;
-  zero-flag bitor parity-flag bitor over cpu-f-bitand= ( hl rr x cpu )
+
-  over HEX: FFFF > [ carry-flag over cpu-f-bitor= ] when ( hl rr x cpu )
+: add-byte-with-carry ( lhs rhs cpu -- result )
-  swap >r ( hl rr cpu )
+  #! Add rhs to lhs plus carry.
-  rot HEX: FFF bitand ( rr cpu hl )
+  >r + r> [ add-carry ] keep [ update-flags ] 2keep drop HEX: FF bitand ;
-  rot HEX: FFF bitand ( cpu hl rr )
+
-  + HEX: FFF > [ half-carry-flag over cpu-f-bitor= ] when ( cpu )
+: sub-carry ( result cpu -- result ) 
-  r> ( cpu x )
+  #! Subtract the effect of the carry flag from the result
-  HEX: FFFF bitand swap set-cpu-hl ;
+  flag-c? [ 1 - ] when ;
+
+: sub-byte ( lhs rhs cpu -- result )
+  #! Subtract rhs from lhs
+  >r - r> [ update-flags ] 2keep drop HEX: FF bitand ;
+
+: sub-byte-with-carry ( lhs rhs cpu -- result )
+  #! Subtract rhs from lhs and take carry into account
+  >r - r> [ sub-carry ] keep [ update-flags ] 2keep drop HEX: FF bitand ;
+ 
+: inc-byte ( byte cpu -- result )
+  #! Increment byte by one. Note that carry flag is not affected
+  #! by this operation.
+  >r 1 + r> [ update-flags-no-carry ] 2keep drop HEX: FF bitand ;
+
+: dec-byte ( byte cpu -- result )
+  #! Decrement byte by one. Note that carry flag is not affected
+  #! by this operation.
+  >r 1 - r> [ update-flags-no-carry ] 2keep drop HEX: FF bitand ;
+
+: inc-word ( w cpu -- w )
+  #! Increment word by one. Note that no flags are modified.
+  drop 1 + HEX: FFFF bitand ;
+
+: dec-word ( w cpu -- w )
+  #! Decrement word by one. Note that no flags are modified.
+  drop 1 - HEX: FFFF bitand ;
+
+: add-word ( lhs rhs cpu -- result )
+  #! 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.
+  >r + r> over HEX: FFFF > [ carry-flag over set-flag ] when drop HEX: FFFF bitand ;
+
+: bit3or ( lhs rhs -- 0|1 )
+  #! bitor bit 3 of the two numbers on the stack
+  BIN: 00001000 bitand -3 shift >r
+  BIN: 00001000 bitand -3 shift r> 
+  bitor ;
+
+: and-byte ( lhs rhs cpu -- result )
+  #! Logically and rhs to lhs. The carry flag is cleared and
+  #! the half carry is set to the ORing of bits 3 of the operands.
+  [ drop bit3or ] 3keep ( bit3or lhs rhs cpu )
+  >r bitand r> [ update-flags ] 2keep 
+  [ carry-flag clear-flag ] keep
+  rot 0 = [ half-carry-flag set-flag ] [ half-carry-flag clear-flag ] ifte
+  HEX: FF bitand ;
+
+: xor-byte ( lhs rhs cpu -- result )
+  #! Logically xor rhs to lhs. The carry and half-carry flags are cleared.
+  >r bitxor r> [ update-flags ] 2keep 
+  [ half-carry-flag carry-flag bitor clear-flag ] keep
+  drop HEX: FF bitand ;
+
+: or-byte ( lhs rhs cpu -- result )
+  #! Logically or rhs to lhs. The carry and half-carry flags are cleared.
+  >r bitor r> [ update-flags ] 2keep 
+  [ half-carry-flag carry-flag bitor clear-flag ] keep
+  drop HEX: FF bitand ;
 
 : flags ( seq -- seq )
   [ 0 [ execute bitor ] reduce ] map ;
@@ -538,6 +677,7 @@ SYMBOL: psz-vector
 
 : call-sub ( addr cpu -- )
   #! Call the address as a subroutine.
+  over valid-word?
   dup push-pc 
   >r HEX: FFFF bitand r> set-cpu-pc ;
 
@@ -546,7 +686,8 @@ SYMBOL: psz-vector
   [ cpu-a psz nth bitor ] keep ( v cpu -- )
   set-cpu-f ;
 
-: dec-byte ( b cpu -- b )
+: dec-byte-old ( b cpu -- b )
+  over valid-byte?
   [ 
     cpu-f 
     zero-flag sign-flag half-carry-flag overflow-flag bitor bitor bitor 
@@ -559,24 +700,7 @@ SYMBOL: psz-vector
   [ swap HEX: 7F = [ [ overflow-flag ] swap cpu-f-bitor ] [ drop ] ifte ] 2keep
   [ swap HEX: 80 bitand 0 = not [ [ sign-flag ] swap cpu-f-bitor ] [ drop ] ifte ] 2keep
   [ swap HEX: 00 = [ [ zero-flag ] swap cpu-f-bitor ] [ drop ] ifte ] 2keep 
-  drop ;
+  drop dup valid-byte? ;
-
-: inc-byte ( b cpu -- b )
-  >r 1 + HEX: FF bitand r> 
-  [ [ add-sub-flag zero-flag sign-flag half-carry-flag overflow-flag bitor bitor bitor bitor 255 swap - ] swap cpu-f-bitand ] keep
-  [ swap HEX: 0F bitand 0 = [ [ half-carry-flag ] swap cpu-f-bitor ] [ drop ] ifte ]  2keep
-  [ swap HEX: 80 =  [ [ overflow-flag ] swap cpu-f-bitor ] [ drop ] ifte ]  2keep
-  [ swap HEX: 80 bitand 0 = not [ [ sign-flag ] swap cpu-f-bitor ] [ drop ] ifte ]  2keep
-  [ swap 0 = [ [ zero-flag ] swap cpu-f-bitor ] [ drop ] ifte ]  2keep
-  drop ;
-
-: inc-word ( w cpu -- w )
-  #! TODO: Flags?
-  drop 1 + HEX: FFFF bitand ;
-
-: dec-word ( w cpu -- w )
-  #! TODO: Flags?
-  drop 1 - HEX: FFFF bitand ;
 
 : ret-from-sub ( cpu -- )
   [ pop-pc ] keep set-cpu-pc ;
@@ -588,8 +712,9 @@ SYMBOL: psz-vector
   
 SYMBOL: cf
 
-: sub-byte ( cf n cpu -- x ) 
+: sub-byte-old ( cf n cpu -- x ) 
   #! Subtracts 'n' from the 'a' register. 'cf' is carry flag settings.
+  over valid-byte?
   pick cf set
   [ rot drop cpu-a swap - HEX: FF bitand ] 3keep  ( x cf n cpu )
   rot 0 = not [ >r >r 1 - HEX: FF bitand r> r> ] when ( x n cpu )
@@ -600,7 +725,7 @@ SYMBOL: cf
   [ swap over cpu-a >= ( n cpu >=  ) rot cf get bitor 0 = not and [ [ carry-flag ] swap cpu-f-bitor ] [ drop ] ifte ] 3keep
   [ dup >r cpu-a bitxor bitxor HEX: 10 bitand r> swap 0 = not [ [ half-carry-flag ] swap cpu-f-bitor ] [ drop ] ifte ] 3keep
   [ dup >r cpu-a swapd bitxor swap r> dup >r cpu-a bitxor bitand HEX: 80 bitand r> swap 0 = not [ [ overflow-flag ] swap cpu-f-bitor ] [ drop ] ifte ] 3keep
-  drop nip  ;
+  drop nip  dup valid-byte? ;
 
 : interrupt ( number cpu -- )
   #! Perform a hardware interrupt
@@ -789,37 +914,6 @@ C: cpu ( -- cpu )
     [[ "SP" { cpu-sp set-cpu-sp } ]]
   }} hash ;
 
-: flag-nz? ( cpu -- bool )
-  #! Test flag status
-  cpu-f zero-flag bitand 0 = ;
-
-: flag-z? ( cpu -- bool )
-  #! Test flag status
-  cpu-f zero-flag bitand 0 = not ;
-
-: flag-nc? ( cpu -- bool )
-  #! Test flag status
-  cpu-f carry-flag bitand 0 = ;
-
-: flag-c? ( cpu -- bool )
-  #! Test flag status
-  cpu-f carry-flag bitand 0 = not ;
-
-: flag-po? ( cpu -- bool )
-  #! Test flag status
-  cpu-f parity-flag bitand 0 =  ;
-
-: flag-pe? ( cpu -- bool )
-  #! Test flag status
-  cpu-f parity-flag bitand 0 = not ;
-
-: flag-p? ( cpu -- bool )
-  #! Test flag status
-  cpu-f sign-flag bitand 0 = ;
-
-: flag-m? ( cpu -- bool )
-  #! Test flag status
-  cpu-f sign-flag bitand 0 = not ;
 
 : flag-lookup ( string -- vector )
   #! Given a string containing a flag name, return a vector
@@ -905,26 +999,23 @@ SYMBOL: $4
   [ add-sub-flag half-carry-flag bitor ] swap cpu-f-bitor ;
 
 : (emulate-DAA) ( cpu -- )  
-  dup cpu-a HEX: 0F bitand 9 > ( cpu test1 )
+  #! The eight bit number in the accumulator is
-  over cpu-f half-carry-flag bitand 0 = not ( cpu test1 test2 )
+  #! adjusted to form two four-bit binary-coded-decimal
-  or [
+  #! digits.
-    [ cpu-a 6 + HEX: FF bitand ] keep 
+  [
-    [ set-cpu-a ] keep
+    dup half-carry-flag swap flag-set? swap 
-    [ [ half-carry-flag ] swap cpu-f-bitor ] keep
+    cpu-a BIN: 1111 bitand 9 > or [ 6 ] [ 0 ] ifte 
-  ] [
+  ] keep 
-    [ [ 255 half-carry-flag - ] swap cpu-f-bitand ] keep
+  [ cpu-a + ] keep
-  ] ifte ( cpu )
+  [ update-flags ] 2keep  
-  dup cpu-a HEX: 9F > ( cpu test1 )
+  [ swap HEX: FF bitand swap set-cpu-a ] keep 
-  over cpu-f carry-flag bitand 0 = not ( cpu test1 test2 )
+  [
-  or [
+    dup carry-flag swap flag-set? swap 
-    [ cpu-a HEX: 60 + HEX: FF bitand ] keep 
+    cpu-a -4 shift BIN: 1111 bitand 9 > or [ 96 ] [ 0 ] ifte 
-    [ set-cpu-a ] keep
+  ] keep 
-    [ [ carry-flag ] swap cpu-f-bitor ] keep    
+  [ cpu-a + ] keep
-  ] [
+  [ update-flags ] 2keep  
-    [ [ 255 carry-flag - ] swap cpu-f-bitand ] keep
+  swap HEX: FF bitand swap set-cpu-a ;
-  ] ifte 
-  set-flags-psz ;
-
   
 : patterns ( -- hashtable )
   #! table of code quotation patterns for each type of instruction.
@@ -940,32 +1031,31 @@ SYMBOL: $4
     [[ "RST-30H"      [ drop "RST 30H Not Implemented" throw ] ]]
     [[ "RST-38H"      [ drop "RST 38H Not Implemented" throw ] ]]
     [[ "RET-F|FF"      [ dup $1 [ 6 over inc-cycles ret-from-sub ] [ drop ] ifte ] ]]
-    [[ "CP-N"      [ [ next-byte ] keep 0 -rot sub-byte drop  ] ]]
+    [[ "CP-N"      [ [ next-byte ] keep 0 -rot sub-byte-old drop  ] ]]
-    [[ "CP-R"      [ [ $1 ] keep 0 -rot sub-byte drop ] ]]
+    [[ "CP-R"      [ [ $1 ] keep 0 -rot sub-byte-old drop ] ]]
-    [[ "CP-(RR)"      [ [ $1 ] keep [ read-byte ] keep 0 -rot sub-byte drop ] ]]
+    [[ "CP-(RR)"      [ [ $1 ] keep [ read-byte ] keep 0 -rot sub-byte-old drop ] ]]
-    [[ "OR-N"      [ [ next-byte ] keep [ read-byte unit ] keep [ cpu-a-bitor ] keep clear-and-set-flags-psz ] ]]
+    [[ "OR-N"      [ [ cpu-a ] keep [ next-byte ] keep [ or-byte ] keep set-cpu-a ] ]]
-    [[ "OR-R"      [ [ dup [ $1 ] cons swap cpu-a-bitor ] keep clear-and-set-flags-psz ] ]]
+    [[ "OR-R"      [ [ cpu-a ] keep [ $1 ] keep [ or-byte ] keep set-cpu-a ] ]]
-    [[ "OR-(RR)"      [ [ $1 ] keep [ read-byte unit ] keep [ cpu-a-bitor ] keep clear-and-set-flags-psz ] ]]
+    [[ "OR-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ or-byte ] keep set-cpu-a  ] ]]
-    [[ "XOR-N"      [ [ next-byte ] keep [ read-byte unit ] keep [ cpu-a-bitxor ] keep clear-and-set-flags-psz ] ]]
+    [[ "XOR-N"      [ [ cpu-a ] keep [ next-byte ] keep [ xor-byte ] keep set-cpu-a ] ]]
-    [[ "XOR-R"      [ [ $1 ] keep [ cpu-a-bitxor= ] keep clear-and-set-flags-psz ] ]]
+    [[ "XOR-R"      [ [ cpu-a ] keep [ $1 ] keep [ xor-byte ] keep set-cpu-a ] ]]
-    [[ "XOR-(RR)"   [ [ $1 ] keep [ read-byte ] keep [ cpu-a-bitxor= ] keep clear-and-set-flags-psz ] ]]
+    [[ "XOR-(RR)"   [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ xor-byte ] keep set-cpu-a  ] ]]
-    [[ "AND-A"      [ clear-and-set-flags-psz  ] ]]
+    [[ "AND-N"      [ [ cpu-a ] keep [ next-byte ] keep [ and-byte ] keep set-cpu-a  ] ]]
-    [[ "AND-N"      [ [ dup [ next-byte ] cons swap cpu-a-bitand ] keep clear-and-set-flags-psz  ] ]]
+    [[ "AND-R"      [ [ cpu-a ] keep [ $1 ] keep [ and-byte ] keep set-cpu-a ] ]]
-    [[ "AND-R"      [ [ dup [ $1 ] cons swap cpu-a-bitand ] keep clear-and-set-flags-psz ] ]]
+    [[ "AND-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ and-byte ] keep set-cpu-a  ] ]]
-    [[ "AND-(RR)"      [ [ $1 ] keep [ read-byte unit ] keep [ cpu-a-bitand ] keep clear-and-set-flags-psz ] ]]
+    [[ "ADC-R,N"      [ [ $1 ] keep [ next-byte ] keep [ add-byte-with-carry ] keep $2 ] ]]
-    [[ "ADC-R,N"      [ drop "ADC-R,N Not Implemented" throw ] ]]
+    [[ "ADC-R,R"      [ [ $1 ] keep [ $3 ] keep [ add-byte-with-carry ] keep $2 ] ]]
-    [[ "ADC-R,R"      [ drop "ADC-R,R Not Implemented" throw ] ]]
+    [[ "ADC-R,(RR)"      [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte-with-carry ] keep $2 ] ]]
-    [[ "ADC-R,(RR)"      [ drop "ADC-R,(RR) Not Implemented" throw ] ]]
+    [[ "ADD-R,N"      [ [ $1 ] keep [ next-byte ] keep [ add-byte ] keep $2 ] ]]
-    [[ "ADD-R,N"      [ [ f swap next-byte ] keep add-byte-to-a ] ]]
+    [[ "ADD-R,R"      [ [ $1 ] keep [ $3 ] keep [ add-byte ] keep $2 ] ]]
-    [[ "ADD-R,R"      [ [ f swap $3 ] keep add-byte-to-a ] ]]
+    [[ "ADD-RR,RR"    [ [ $1 ] keep [ $3 ] keep [ add-word ] keep $2 ] ]]
-    [[ "ADD-RR,RR"    [ [ $1 ] keep [ $3 ] keep add-words ] ]]
+    [[ "ADD-R,(RR)"    [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ add-byte ] keep $2   ]  ]]
-    [[ "ADD-R,(RR)"    [ [ f swap $3 ] keep [ read-byte ] keep add-byte-to-a  ]  ]]
+    [[ "SBC-R,N"      [ [ $1 ] keep [ next-byte ] keep [ sub-byte-with-carry ] keep $2 ] ]]
-    [[ "SBC-R,N"      [ [ cpu-f carry-flag bitand ] keep [ next-byte ] keep [ sub-byte ] keep set-cpu-a ] ]]
+    [[ "SBC-R,R"      [ [ $1 ] keep [ $3 ] keep [ sub-byte-with-carry ] keep $2 ] ]]
-    [[ "SBC-R,R"      [ drop "SBC-R,R Not Implemented" throw ] ]]
+    [[ "SBC-R,(RR)"      [ [ $1 ] keep [ $3 ] keep [ read-byte ] keep [ sub-byte-with-carry ] keep $2 ] ]]
-    [[ "SBC-R,(RR)"      [ drop "SBC-R,(RR) Not Implemented" throw ] ]]
+    [[ "SUB-R"      [ [ cpu-a ] keep [ $1 ] keep [ sub-byte ] keep set-cpu-a ] ]]
-    [[ "SUB-R"      [ drop "SUB-R Not Implemented" throw ] ]]
+    [[ "SUB-(RR)"      [ [ cpu-a ] keep [ $1 ] keep [ read-byte ] keep [ sub-byte ] keep set-cpu-a ] ]]
-    [[ "SUB-(RR)"      [ drop "SUB-(RR) Not Implemented" throw ] ]]
+    [[ "SUB-N"      [ [ cpu-a ] keep [ next-byte ] keep [ sub-byte ] keep set-cpu-a ] ]]
-    [[ "SUB-N"      [ [ next-byte ] keep 0 -rot [ sub-byte ] keep set-cpu-a ] ]]
     [[ "CPL"          [ (emulate-CPL) ]               ]]
     [[ "DAA"          [ (emulate-DAA) ]               ]]
     [[ "RLA"          [ (emulate-RLA) ]               ]]
@@ -1224,11 +1314,6 @@ SYMBOL: $4
   "n" token sp <&
   just [ 0 empty-vector swons  ] <@ ;
 
-: AND-A-instruction  ( -- parser )
-  "AND-A" "AND" complex-instruction
-  "A" token  [ register-lookup ] <@ sp <&>
-  just [ uncons swons ] <@ ;
-
 : AND-R-instruction  ( -- parser )
   "AND-R" "AND" complex-instruction
   8-bit-registers sp <&> just [ uncons swons ] <@ ;
@@ -1489,7 +1574,6 @@ SYMBOL: $4
   HALT-instruction <|> 
   DI-instruction <|> 
   EI-instruction <|> 
-  AND-A-instruction <|> 
   AND-N-instruction <|> 
   AND-R-instruction <|> 
   AND-(RR)-instruction <|> 

contrib/space-invaders/gui.factor

@@ -65,6 +65,9 @@ M: key-down-event handle-si-event ( cpu event -- quit? )
     { [ 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 ] }
+    { [ dup "LCTRL" = ] [ drop [ cpu-port1 HEX: 10 bitor ] keep set-cpu-port1 f ] }
+    { [ dup "LEFT" = ] [ drop [ cpu-port1 HEX: 20 bitor ] keep set-cpu-port1 f ] }
+    { [ dup "RIGHT" = ] [ drop [ cpu-port1 HEX: 40 bitor ] keep set-cpu-port1 f ] }
     { [ t ] [ . drop f ] }
   } cond ;
 
@@ -74,6 +77,9 @@ M: key-up-event handle-si-event ( cpu event -- quit? )
     { [ 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 ] }
+    { [ dup "LCTRL" = ] [ drop [ cpu-port1 255 HEX: 10 - bitand ] keep set-cpu-port1 f ] }
+    { [ dup "LEFT" = ] [ drop [ cpu-port1 255 HEX: 20 - bitand ] keep set-cpu-port1 f ] }
+    { [ dup "RIGHT" = ] [ drop [ cpu-port1 255 HEX: 40 - bitand ] keep set-cpu-port1 f ] }
     { [ t ] [ . drop f ] }
   } cond ;
 
@@ -119,7 +125,7 @@ M: key-up-event handle-si-event ( cpu event -- quit? )
 
 : display ( -- )
   224 256 0 SDL_HWSURFACE [ 
-   test-cpu [ do-video-update ] over set-cpu-display
+   test-cpu [ do-video-update ] over set-cpu-display dup
    <event> event-loop
     SDL_Quit
   ] with-screen ;

contrib/space-invaders/tests.factor

@@ -264,14 +264,14 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
 { 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-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-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-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-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-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-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 } "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
@@ -535,10 +535,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         drop
 ] unit-test
 
-[ emulate-INC_B HEX: 01 f t f f f  
+[ emulate-INC_B HEX: 01 f t f f  
-                HEX: 00 t f t f f 
+                HEX: 00 t f t f 
-                HEX: 80 f t t t t 
+                HEX: 80 f t t t 
-                HEX: 90 f t t f t 
+                HEX: 90 f t t t 
 ] [
   <cpu> 4 0 pick cpu-ram set-nth
         HEX: 00 over set-cpu-b
@@ -548,7 +548,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -558,7 +557,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -568,7 +566,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -578,15 +575,14 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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  
+[ emulate-DEC_B HEX: FF f t t t  
-                HEX: 00 t f f f f 
+                HEX: 00 t f f f 
-                HEX: 7F f t t t f 
+                HEX: 7F f t t f 
-                HEX: 8F f t t f t 
+                HEX: 8F f t t t 
 ] [
   <cpu> 5 0 pick cpu-ram set-nth
         HEX: 00 over set-cpu-b
@@ -596,7 +592,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -606,7 +601,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -616,7 +610,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -626,7 +619,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -762,10 +754,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         drop
 ] unit-test
 
-[ emulate-INC_C HEX: 01 f t f f f  
+[ emulate-INC_C HEX: 01 f t f f  
-                HEX: 00 t f t f f 
+                HEX: 00 t f t f 
-                HEX: 80 f t t t t 
+                HEX: 80 f t t t 
-                HEX: 90 f t t f t 
+                HEX: 90 f t t t 
 ] [
   <cpu> HEX: 0C 0 pick cpu-ram set-nth
         HEX: 00 over set-cpu-c
@@ -775,7 +767,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -785,7 +776,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -795,7 +785,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -805,15 +794,14 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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  
+[ emulate-DEC_C HEX: FF f t t t  
-                HEX: 00 t f f f f 
+                HEX: 00 t f f f 
-                HEX: 7F f t t t f 
+                HEX: 7F f t t f 
-                HEX: 8F f t t f t 
+                HEX: 8F f t t t 
 ] [
   <cpu> HEX: 0D 0 pick cpu-ram set-nth
         HEX: 00 over set-cpu-c
@@ -823,7 +811,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -833,7 +820,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -843,7 +829,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -853,7 +838,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -927,10 +911,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         drop
 ] unit-test
 
-[ emulate-INC_D HEX: 01 f t f f f  
+[ emulate-INC_D HEX: 01 f t f f  
-                HEX: 00 t f t f f 
+                HEX: 00 t f t f 
-                HEX: 80 f t t t t 
+                HEX: 80 f t t t 
-                HEX: 90 f t t f t 
+                HEX: 90 f t t t 
 ] [
   <cpu> HEX: 14 0 pick cpu-ram set-nth
         HEX: 00 over set-cpu-d
@@ -940,7 +924,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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: 14 1 pick cpu-ram set-nth
         HEX: FF over set-cpu-d
@@ -950,7 +933,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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: 14 2 pick cpu-ram set-nth
         HEX: 7F over set-cpu-d
@@ -960,7 +942,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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: 14 3 pick cpu-ram set-nth
         HEX: 8F over set-cpu-d
@@ -970,15 +951,14 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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_D HEX: FF f t t f t  
+[ emulate-DEC_D HEX: FF f t t t  
-                HEX: 00 t f f f f 
+                HEX: 00 t f f f 
-                HEX: 7F f t t t f 
+                HEX: 7F f t t f 
-                HEX: 8F f t t f t 
+                HEX: 8F f t t t 
 ] [
   <cpu> HEX: 15 0 pick cpu-ram set-nth
         HEX: 00 over set-cpu-d
@@ -988,7 +968,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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: 15 1 pick cpu-ram set-nth
         HEX: 01 over set-cpu-d
@@ -998,7 +977,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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: 15 2 pick cpu-ram set-nth
         HEX: 80 over set-cpu-d
@@ -1008,7 +986,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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: 15 3 pick cpu-ram set-nth
         HEX: 90 over set-cpu-d
@@ -1018,7 +995,6 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ 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
@@ -1166,10 +1142,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
 ] unit-test
 
 
-[ emulate-SUB_n HEX: FF t f t t t f
+[ emulate-SUB_n HEX: FF f t t t
-                HEX: 00 t t f f f f
+                HEX: 00 t f f f
-                HEX: DA t f t f f f
+                HEX: DA f t f f
-                HEX: 7F t f f f t t
+                HEX: 7F f f f t
 ] [
   <cpu> HEX: D6 0 pick cpu-ram set-nth
         HEX: 01 1 pick cpu-ram set-nth
@@ -1178,12 +1154,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ read-instruction instructions nth car dup ] keep 
         [ swap execute ] keep
         [ cpu-a ] keep
-        [ cpu-f subtraction-flag bitand 0 = not ] keep
         [ cpu-f zero-flag bitand 0 = not ] keep
         [ cpu-f sign-flag bitand 0 = not ] keep
         [ cpu-f carry-flag bitand 0 = not ] keep
         [ cpu-f half-carry-flag bitand 0 = not ] keep
-        [ cpu-f overflow-flag bitand 0 = not ] keep
         HEX: D6 2 pick cpu-ram set-nth
         HEX: 02 3 pick cpu-ram set-nth
         HEX: 02 over set-cpu-a
@@ -1191,12 +1165,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ read-instruction instructions nth car ] keep 
         [ swap execute ] keep
         [ cpu-a ] keep
-        [ cpu-f subtraction-flag bitand 0 = not ] keep
         [ cpu-f zero-flag bitand 0 = not ] keep
         [ cpu-f sign-flag bitand 0 = not ] keep
         [ cpu-f carry-flag bitand 0 = not ] keep
         [ cpu-f half-carry-flag bitand 0 = not ] keep
-        [ cpu-f overflow-flag bitand 0 = not ] keep
         HEX: D6 4 pick cpu-ram set-nth
         HEX: 25 5 pick cpu-ram set-nth
         HEX: FF over set-cpu-a
@@ -1204,12 +1176,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ read-instruction instructions nth car ] keep 
         [ swap execute ] keep
         [ cpu-a ] keep
-        [ cpu-f subtraction-flag bitand 0 = not ] keep
         [ cpu-f zero-flag bitand 0 = not ] keep
         [ cpu-f sign-flag bitand 0 = not ] keep
         [ cpu-f carry-flag bitand 0 = not ] keep
         [ cpu-f half-carry-flag bitand 0 = not ] keep
-        [ cpu-f overflow-flag bitand 0 = not ] keep
         HEX: D6 6 pick cpu-ram set-nth
         HEX: 01 7 pick cpu-ram set-nth
         HEX: 80 over set-cpu-a
@@ -1217,19 +1187,17 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ read-instruction instructions nth car ] keep 
         [ swap execute ] keep
         [ cpu-a ] keep
-        [ cpu-f subtraction-flag bitand 0 = not ] keep
         [ cpu-f zero-flag bitand 0 = not ] keep
         [ cpu-f sign-flag bitand 0 = not ] keep
         [ cpu-f carry-flag bitand 0 = not ] keep
         [ cpu-f half-carry-flag bitand 0 = not ] keep
-        [ cpu-f overflow-flag bitand 0 = not ] keep
          drop
 ] unit-test
 
-[ emulate-SBC_A,n HEX: FE t f t t t f
+[ emulate-SBC_A,n HEX: FE f t t t
-                HEX: FF t f t t t f
+                HEX: FF f t t t
-                HEX: D9 t f t f f f
+                HEX: D9 f t f f
-                HEX: 7E t f f f t t
+                HEX: 7E f f f t
 ] [
   <cpu> HEX: DE 0 pick cpu-ram set-nth
         HEX: 01 1 pick cpu-ram set-nth
@@ -1238,12 +1206,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ read-instruction instructions nth car dup ] keep 
         [ swap execute ] keep
         [ cpu-a ] keep
-        [ cpu-f subtraction-flag bitand 0 = not ] keep
         [ cpu-f zero-flag bitand 0 = not ] keep
         [ cpu-f sign-flag bitand 0 = not ] keep
         [ cpu-f carry-flag bitand 0 = not ] keep
         [ cpu-f half-carry-flag bitand 0 = not ] keep
-        [ cpu-f overflow-flag bitand 0 = not ] keep
         HEX: DE 2 pick cpu-ram set-nth
         HEX: 02 3 pick cpu-ram set-nth
         HEX: 02 over set-cpu-a
@@ -1251,12 +1217,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ read-instruction instructions nth car ] keep 
         [ swap execute ] keep
         [ cpu-a ] keep
-        [ cpu-f subtraction-flag bitand 0 = not ] keep
         [ cpu-f zero-flag bitand 0 = not ] keep
         [ cpu-f sign-flag bitand 0 = not ] keep
         [ cpu-f carry-flag bitand 0 = not ] keep
         [ cpu-f half-carry-flag bitand 0 = not ] keep
-        [ cpu-f overflow-flag bitand 0 = not ] keep
         HEX: DE 4 pick cpu-ram set-nth
         HEX: 25 5 pick cpu-ram set-nth
         HEX: FF over set-cpu-a
@@ -1264,12 +1228,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ read-instruction instructions nth car ] keep 
         [ swap execute ] keep
         [ cpu-a ] keep
-        [ cpu-f subtraction-flag bitand 0 = not ] keep
         [ cpu-f zero-flag bitand 0 = not ] keep
         [ cpu-f sign-flag bitand 0 = not ] keep
         [ cpu-f carry-flag bitand 0 = not ] keep
         [ cpu-f half-carry-flag bitand 0 = not ] keep
-        [ cpu-f overflow-flag bitand 0 = not ] keep
         HEX: DE 6 pick cpu-ram set-nth
         HEX: 01 7 pick cpu-ram set-nth
         HEX: 80 over set-cpu-a
@@ -1277,12 +1239,10 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
         [ read-instruction instructions nth car ] keep 
         [ swap execute ] keep
         [ cpu-a ] keep
-        [ cpu-f subtraction-flag bitand 0 = not ] keep
         [ cpu-f zero-flag bitand 0 = not ] keep
         [ cpu-f sign-flag bitand 0 = not ] keep
         [ cpu-f carry-flag bitand 0 = not ] keep
         [ cpu-f half-carry-flag bitand 0 = not ] keep
-        [ cpu-f overflow-flag bitand 0 = not ] keep
          drop
 ] unit-test
 
@@ -1299,3 +1259,56 @@ USING: kernel cpu-8080 test lazy parser-combinators math hashtables lists sequen
 	[ cpu-hl ] keep
         drop
 ] unit-test
+
+[ emulate-ADD_A,(HL) HEX: 51
+] [
+  <cpu> HEX: 86 0 pick cpu-ram set-nth
+        HEX: 01 over set-cpu-a
+        HEX: 2001 over set-cpu-hl
+	HEX: 50 HEX: 2001 pick cpu-ram set-nth
+        236 over set-cpu-f
+        [ read-instruction instructions nth car dup ] keep 
+        [ swap execute ] keep
+        [ cpu-a ] keep
+        drop
+] unit-test
+
+[ emulate-SCF 1 1 t
+] [
+  <cpu> HEX: 37 0 pick cpu-ram set-nth
+        carry-flag over set-cpu-f
+        [ read-instruction instructions nth car dup ] keep 
+        [ swap execute ] keep
+        [ cpu-f ] keep
+	HEX: 37 1 pick cpu-ram set-nth
+        0 over set-cpu-f
+        [ read-instruction instructions nth car ] keep 
+        [ swap execute ] keep
+        [ cpu-f ] keep	
+        drop
+	256 [ <cpu> [ set-cpu-f ] keep [ emulate-SCF ] keep cpu-f carry-flag bitand 0 = not ] map [ ] all?
+] unit-test
+
+[ emulate-INC_(HL) HEX: 00 
+                   HEX: 01 
+                   HEX: 80 ] [
+  <cpu> HEX: 34 0 pick cpu-ram set-nth
+        HEX: 3500 over set-cpu-hl
+	HEX: FF HEX: 3500 pick cpu-ram set-nth
+        [ read-instruction instructions nth car dup ] keep 
+        [ swap execute ] keep
+        HEX: 3500 over cpu-ram nth swap
+	HEX: 34 1 pick cpu-ram set-nth
+        HEX: 3500 over set-cpu-hl
+	HEX: 00 HEX: 3500 pick cpu-ram set-nth
+        [ read-instruction instructions nth car ] keep 
+        [ swap execute ] keep
+        HEX: 3500 over cpu-ram nth swap
+	HEX: 34 2 pick cpu-ram set-nth
+        HEX: 3500 over set-cpu-hl 
+	HEX: 7F HEX: 3500 pick cpu-ram set-nth
+        [ read-instruction instructions nth car ] keep 
+        [ swap execute ] keep
+        HEX: 3500 over cpu-ram nth swap
+	drop
+] unit-test