\
\    Mecrisp-Across - A Forth cross compiler for small MSP430 microcontrollers
\    Copyright (C) 2016  Matthias Koch
\
\    This program is free software: you can redistribute it and/or modify
\    it under the terms of the GNU General Public License as published by
\    the Free Software Foundation, either version 3 of the License, or
\    (at your option) any later version.
\
\    This program is distributed in the hope that it will be useful,
\    but WITHOUT ANY WARRANTY; without even the implied warranty of
\    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\    GNU General Public License for more details.
\
\    You should have received a copy of the GNU General Public License
\    along with this program.  If not, see <http://www.gnu.org/licenses/>.
\

\ -----------------------------------------------------------------------------
\   Speicher holen und schreiben
\ -----------------------------------------------------------------------------

\ Byte-Fetch darf nicht überall weiterverpflanzt werden, weil sonst Byte-Opcodes überall auftauchen würden... Und Forth rechnet ja intern mit 16 Bits weiter.


: t-@    ( addr -- x ) th@ ;
: t-c@   ( addr -- x ) tc@ ;



: t-@-ra ( -- ) \ Kann von einem Literal oder einem Register direkt holen. Alles andere zuvor in einen Register laden.

         expect-one-element
         state-tos @ literal?
         if
           fetchabsolute state-tos ! \ Aus dem Literal ein "Fetch Absolute" machen. Die Konstante bleibt als Adresse.
         else
           expect-tos-in-register \ Falls TOS schon im Register war, ändert sich nun nichts.    
           state-tos @ fetchbit or state-tos ! \ Vermerken, dass jetzt von dem Register geholt werden muss, was ja auch als Parameter hier und da verwendet werden kann :-)
           0 state-tos cell+ ! \ Index 0 falls das als Zieloperand irgendwo auftauchen sollte.
         then
         ;

: t-c@-ra ( -- ) \ Kann von einem Literal oder einem Register direkt holen. Alles andere zuvor in einen Register laden.

         expect-one-element
         state-tos @ literal?
         if
           fetchabsolute bytebit or state-tos ! \ Aus dem Literal ein "Fetch Absolute" machen. Die Konstante bleibt als Adresse.
         else
           expect-tos-in-register \ Falls TOS schon im Register war, ändert sich nun nichts.
           state-tos @ fetchbit bytebit or or state-tos ! \ Vermerken, dass jetzt von dem Register geholt werden muss, was ja auch als Parameter hier und da verwendet werden kann :-)         
           0 state-tos cell+ ! \ Index 0 falls das als Zieloperand irgendwo auftauchen sollte.
         then
         ;

         
' t-@   ' t-@-ra   t-prim-ra: @   t-inline         
' t-c@  ' t-c@-ra  t-prim-ra: c@  t-inline

\ Flush wird benötigt, wenn ein Lesezugriff jetzt und unbedingt stattfinden soll.

: t-flush-ra ( -- ) tos-fetchsperre ;
' nop ' t-flush-ra t-prim-ra: flush t-inline

\ -----------------------------------------------------------------------------

\ Store muss stets den indizierten Modus verwenden, weil es an diese ADRESSE hingeschrieben werden soll, nicht in einen Register.
\ Entweder das Ziel ist ein Literal, dann mit r2 einfügen, oder es muss in einem Register liegen.

: store-ra ( opcode -- ) \ Kann fast alles direkt verwenden. Nur Byte-Schreibzugriffe müssen vorher die Elemente in den RA laden, weil sie sonst den Stackpointer ungerade machen würden.

    expect-one-element \ Der Zieloperand, die Adresse, darf nicht mehr auf dem Stack liegen. Das kann nun eine Konstante sein, ein Register, oder ein Fetch...
    
    state-tos @ literal@pc+ =
    if \ Literals können als absolute Adresse direkt eingefügt werden
      $0082 or
      state-tos cell+ @
    else \ Alles andere muss zuvor in einen Register geladen werden
      expect-tos-in-register
      state-tos @ or $0080 or
      0
    then
    
    ( opcode* index )                
    swap
        
    state-nos @ operand-for-double or ( Ziel-Index Opcode-mit-Quelle )
    state-nos @ indexed? if state-nos cell+ @ swap konstantengenerator else image, then \ Quelloperand anfügen, falls vorhanden
    image,
      
    eliminiere-tos eliminiere-tos    
;    

: t-!    ( x addr -- ) th! ;           
: t-!-ra ( -- ) tos-bytesperre $4000 store-ra ;  \ Mov-Opcode
' t-!  ' t-!-ra  t-prim-ra: !  t-inline

: t-+!    ( x addr -- ) dup >r th@ + r> th! ;           
: t-+!-ra ( -- ) tos-bytesperre $5000 store-ra ;
' t-+!  ' t-+!-ra  t-prim-ra: +!  t-inline

: t-bic!    ( x addr -- ) dup >r th@ swap bic r> th! ;           
: t-bic!-ra ( -- ) tos-bytesperre $C000 store-ra ;
' t-bic!  ' t-bic!-ra  t-prim-ra: bic!  t-inline

: t-bis!    ( x addr -- ) dup >r th@ or r> th! ;           
: t-bis!-ra ( -- ) tos-bytesperre $D000 store-ra ;
' t-bis!  ' t-bis!-ra  t-prim-ra: bis!  t-inline

: t-xor!    ( x addr -- ) dup >r th@ xor r> th! ;           
: t-xor!-ra ( -- ) tos-bytesperre $E000 store-ra ;
' t-xor!  ' t-xor!-ra  t-prim-ra: xor!  t-inline


: t-c!    ( x addr -- ) tc! ;           
: t-c!-ra ( -- ) expect-two-elements $4040 store-ra ; \ Mov.b Opcode  Byte-Befehle dürfen nicht direkt vom Stack laden, weil sie sonst den Stackpointer durcheinander bringen.
' t-c!  ' t-c!-ra  t-prim-ra: c!  t-inline

: t-cbic!    ( x addr -- ) dup >r tc@ swap bic r> tc! ;           
: t-cbic!-ra ( -- ) $C040 store-ra ;
' t-cbic!  ' t-cbic!-ra  t-prim-ra: cbic!  t-inline

: t-cbis!    ( x addr -- ) dup >r tc@ or r> tc! ;           
: t-cbis!-ra ( -- ) $D040 store-ra ;
' t-cbis!  ' t-cbis!-ra  t-prim-ra: cbis!  t-inline

: t-cxor!    ( x addr -- ) dup >r tc@ xor r> tc! ;           
: t-cxor!-ra ( -- ) $E040 store-ra ;
' t-cxor!  ' t-cxor!-ra  t-prim-ra: cxor!  t-inline


\ Das Päärchen bit@ und cbit@ ist eine Mischung aus einem besonderen "Speicherschreiben-Opcode" (der aber nur liest) und einem Vergleich, der direkt in Sprünge eingepflegt werden kann.
\ Deshalb ist hier die Behandlung ziemlich aufwändig !

\ -----------------------------------------------------------------------------

: t-bit@    ( x addr -- ) th@ and 0<> $FFFF and ;           

: t-bit@-ra-flag ( -- ) tos-bytesperre befreie-tos eliminiere-tos ( Register freischaufeln ) $B000 store-ra $B322 image, befreie-tos get-free-register state-tos ! subc-tos-tos ;

: t-bit@-ra-sprung ( -- ) $B000 store-ra $2400 ; \ jz-Opcode

: t-bit@-ra ( -- )  ['] t-bit@-ra-flag     flagtrampolin !  \ Hier kann nie gefaltet werden - also stets etwas zu tun !
                    ['] t-bit@-ra-sprung sprungtrampolin !  ;

' t-bit@  ' t-bit@-ra  t-prim-ra: bit@  t-inline

\ -----------------------------------------------------------------------------

: t-cbit@    ( x addr -- ) tc@ and 0<> $FFFF and ;           

: t-cbit@-ra-flag ( -- ) befreie-tos eliminiere-tos ( Register freischaufeln ) $B040 store-ra $B322 image, befreie-tos get-free-register state-tos ! subc-tos-tos ;

: t-cbit@-ra-sprung ( -- ) $B040 store-ra $2400 ; \ jz-Opcode

: t-cbit@-ra ( -- )  ['] t-cbit@-ra-flag     flagtrampolin !  \ Hier kann nie gefaltet werden - also stets etwas zu tun !
                     ['] t-cbit@-ra-sprung sprungtrampolin !  ;

' t-cbit@  ' t-cbit@-ra  t-prim-ra: cbit@  t-inline

\ -----------------------------------------------------------------------------
