\ 1802opcodes2

needs 1802cycle
needs 1802regs
needs 1802io

hex

\ opcode 4N
: #LDA  ( opcode -- )
    0F and  R                  ( regaddr )
    dup  @ byte@ D!  ( regaddr )
    1 swap +! ;    

\ opcode 5N
: #STR  ( opcode -- )
    D@ swap                 ( n opcode )
    0F and   R @  byte! ;

\ opcode 60
: #IRX  ( opcode -- )
    drop
    1  X @   R +! ;

\ opcode 61 - 67
: #OUT  ( opcode -- )
    07 and                           ( port# )
    M(R(X))@                  ( port# n )
    swap output!              ( )
    1   X @  R +! ;

\ Opcode 68 is invalid for the 1802;
\ here we just choose to ignore it.
: #INVALID  ( opcode -- )
    drop ;

\ opcode 69 - 6F
: #INP  ( opcode -- )
    8 -   07 and                  ( port# )
    input@ dup                 ( n n )
    M(R(X))!                      ( n )
    D! ;

\ opcode 70
\ Note that the R(X) that gets
\ incremented is the original R(X),
\ not the new one.
: #RET  ( opcode -- )
    drop
    M(R(X))@                 ( xp )
   1  X @  R +!   ( xp ) \ incr old R(X)
    dup   0F and   P !      ( xp )
    4 rshift   X !                ( )
    set-IE ;

\ opcode 71
: #DIS  ( opcode -- )
    drop
    M(R(X))@                ( xp )
   1  X @  R +!   ( xp ) \ incr old R(X)
    dup   0F and   P !      ( xp )
    4 rshift   X !                ( )
    reset-IE ;

\ opcode 72
: #LDXA  ( opcode -- )
    drop
    M(R(X))@   D!
    1  X @   R +! ;

\ opcode 73
: #STXD  ( opcode -- )
    drop
    D@   
    M(R(X))!
    -1  X @  R +! ;

\ opcode 74
: #ADC  ( opcode -- )
    drop
    M(R(X))@
    D@  +
    DF @ if   1+   then
    dup   D!
    0100 and  DF ! ;

\ opcode 75
: #SDB  ( opcode -- )
    drop
    M(R(X))@
    D@  -
    DF @ 0= if   1-   then
    dup  D!
    0100 and   0=  DF ! ;

\ opcode 76
: #SHRC  ( opcode -- )
    drop
    D@
    dup 1 and            ( d lsb )
    DF @  >r              \ remember old DF
    DF !                        ( d ) \ lsb to DF
    2/                          ( d' )
    r> if  80 or  then  \ DF to msb
    D! ;

\ opcode 77
: #SMB  ( opcode -- )
    drop
    D@
    M(R(X))@  -
    DF @ 0= if   1-   then
    dup D!
    0100 and   0=  DF ! ;

\ opcode 78
: #SAV  ( opcode -- )
    drop
    T @
    M(R(X))! ;

\ opcode 79
: #MARK  ( opcode -- )
    drop
    X @  4 lshift
    P @  or                 ( xp )
    dup  T !                 ( xp )
    2 R @   byte!        \ store xp on stack
    P @   X !                 \ set X = P
    -1  2 R +! ;             \ decr stack ptr R2

\ opcode 7A    
: #REQ  ( opcode -- )
    drop   0 Q! ;

\ opcode 7B
: #SEQ  ( opcode -- )
    \ Important: some code expects Q
    \ to be a "clean" flag, either 0 or
    \ -1. Since this is the only place Q
    \ can be set, we should be okay.
    drop   -1 Q! ;

\ opcode 7C
: #ADCI  ( opcode -- )
    drop
    fetch-byte
    D@  +
    DF @ if   1+   then
    dup   D!
    0100 and  DF ! ;

\ opcode 7D
: #SDBI  ( opcode -- )
    drop
    fetch-byte
    D@  -
    DF @ 0= if   1-   then
    dup  D!
    0100 and   0=   DF ! ;

\ opcode 7E
: #SHLC  ( opcode -- )
    drop
    D@
    dup 0080 and     ( d msb )
    DF @  >r              \ remember old DF
    DF !                        ( d ) \ msb to DF
    2*                         ( d' )
    r> if   1 or   then  \ DF to lsb
    D! ;

\ opcode 7F
: #SMBI  ( opcode -- )
    drop
    D@
    fetch-byte  -
    DF @ 0= if   1-   then
    dup  D!
    0100 and   0=   DF ! ;

