\
\    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/>.
\


\ -----------------------------------------------------------------------------
\   Rechnungen und Logik mit zwei Operanden, für die es Opcodes im Prozessor gibt
\ -----------------------------------------------------------------------------

: doppeltoperand-nichtkommutativ ( opcode -- )
     
     tos-bytesperre t-swap-intern tos-bytesperre t-swap-intern
     
     state-tos 2@ 2>r
     
       dup $9000 = \ CMP-Opcodes benötigen im Zweifelsfalle keine Elementkopie, weil sie das Ziel nicht verändern.
       if
         state-nos @ fetchworddestination? not if expect-nos-in-register then \ Der besondere Fall, dass NOS eine Speicherstelle oder ein @Register-Fetch ist, kann in den CMP-Opcodes nach der Bytesperre direkt behandelt werden.
         state-tos @ operand-for-double or  \ Kann damit alles mögliche in den Opcode einbauen !
         eliminiere-tos
         
         state-tos @ $F and or  \ Register für den Zieloperanden setzen
         state-tos @ fetchworddestination? if $0080 or then \ Und bei Bedarf auch das "Index-Bit"         
         
         2r> indexed? if swap konstantengenerator else drop image, then \ Adresse oder Literal anfügen, falls nötig
         
         state-tos @ fetchworddestination? if state-tos cell+ @ image, then \ Falls es eine Speicherstelle gewesen ist, gleich noch die absolute Adresse anfügen.
       else
         expect-nos-in-register \ NOS wird nun in jedem Fall verändert. 
         t-swap-intern make-tos-changeable t-swap-intern \ NOS bei Bedarf via Elementkopie duplizieren 
         
         state-tos @ operand-for-double or  \ Kann damit alles mögliche in den Opcode einbauen !
         eliminiere-tos
         state-tos @ or
         
         2r> indexed? if swap konstantengenerator else drop image, then \ Adresse oder Literal anfügen, falls nötig
       then
;

: doppeltoperand-kommutativ ( opcode -- )

    \ Der Tausch findet nur statt, wenn es mindestens einen Register gibt. Es werden also nie zwei "unknowns" vertauscht.
    \ Wenn TOS ein Register ist, umtauschen. So kann ich möglichst viele "Sonderfälle" als Quelloperand verwenden, und den Register in NOS behalten.
    
    state-tos @ reg15 u<= if t-swap-intern then \ Versuche einen Register als Zieloperanden zu bekommen
       
    doppeltoperand-nichtkommutativ
;

\ -----------------------------------------------------------------------------
\ Kommutative Helferlein, umgebaut, so dass nach Wunsch auch direkt ein Sprung folgen kann
\ -----------------------------------------------------------------------------

: t-+    ( n1 n2 -- n3 ) + $FFFF and ;

: t-+-ra-flag   ( -- )          $5000 doppeltoperand-kommutativ ;
: t-+-ra-sprung ( -- Opcode )   $5000 doppeltoperand-kommutativ eliminiere-tos $2400 ; \ jz-Opcode

: t-+-ra        ( -- )          zweikonstanten? if zweikonstanten t-+ ergebnismerken else 
                                    ['] t-+-ra-flag     flagtrampolin !
                                    ['] t-+-ra-sprung sprungtrampolin !
                                  then ;
                         
' t-+  ' t-+-ra  t-prim-ra: +  t-inline  2 t-foldable

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

\ Der bis = or Opcode setzt keine Flags.

: t-or    ( n1 n2 -- n3 ) or ;
: t-or-ra ( -- ) zweikonstanten? if zweikonstanten t-or ergebnismerken else $D000 doppeltoperand-kommutativ then ;
' t-or  ' t-or-ra  t-prim-ra: or  t-inline  2 t-foldable

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

: t-xor    ( n1 n2 -- n3 ) xor ;

: t-xor-ra-flag   ( -- )        $E000 doppeltoperand-kommutativ ;
: t-xor-ra-sprung ( -- Opcode ) $E000 doppeltoperand-kommutativ eliminiere-tos $2400 ; \ jz-Opcode

: t-xor-ra        ( -- )        zweikonstanten? if zweikonstanten t-xor ergebnismerken else 
                                  ['] t-xor-ra-flag     flagtrampolin !
                                  ['] t-xor-ra-sprung sprungtrampolin !
                                then ;
                         
' t-xor  ' t-xor-ra  t-prim-ra: xor  t-inline  2 t-foldable

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

: t-and    ( n1 n2 -- n3 ) and ;

: t-and-ra-flag   ( -- )        $F000 doppeltoperand-kommutativ ;
: t-and-ra-sprung ( -- Opcode ) $F000 doppeltoperand-kommutativ eliminiere-tos $2400 ; \ jz-Opcode

: t-and-ra        ( -- )        zweikonstanten? if zweikonstanten t-and ergebnismerken else 
                                  ['] t-and-ra-flag     flagtrampolin !
                                  ['] t-and-ra-sprung sprungtrampolin !
                                then ;
                         
' t-and  ' t-and-ra  t-prim-ra: and  t-inline  2 t-foldable
                         
\ -----------------------------------------------------------------------------                                                 
\ Nichtkommutative Helferlein
\ -----------------------------------------------------------------------------

: t--      ( n1 n2 -- n3 ) - $FFFF and ;

: t---ra-flag   ( -- )          $8000 doppeltoperand-nichtkommutativ ;
: t---ra-sprung ( -- Opcode )   $8000 doppeltoperand-nichtkommutativ eliminiere-tos $2400 ; \ jz-Opcode

: t---ra        ( -- )          zweikonstanten? if zweikonstanten t-- ergebnismerken else 
                                    ['] t---ra-flag     flagtrampolin !
                                    ['] t---ra-sprung sprungtrampolin !
                                  then ;
                         
' t--  ' t---ra  t-prim-ra: -  t-inline  2 t-foldable

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

\ Der bic Opcode setzt keine Flags.

: t-bic    ( n1 n2 -- n3 ) bic ;
: t-bic-ra ( -- ) zweikonstanten? if zweikonstanten t-bic ergebnismerken else $C000 doppeltoperand-nichtkommutativ then ;
' t-bic  ' t-bic-ra  t-prim-ra: bic  t-inline  2 t-foldable

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

target

: not -1 xor inline 1-foldable ;

: 1+   1 +   inline 1-foldable ;
: 1-   1 -   inline 1-foldable ;
: 2+   2 +   inline 1-foldable ;
: 2-   2 -   inline 1-foldable ;

host

\ -----------------------------------------------------------------------------
\  Lange Helferlein für Doppeltzahlen, hübsch zusammengesetzt:
\ -----------------------------------------------------------------------------

: t-d+    ( low1 high1 low2 high2 -- low high ) 2>r 16l16h->32 2r> 16l16h->32 + 32->16l16h ;
: t-d+-ra ( -- ) t->r-ra t-swap-intern t->r-ra
                 $5000 doppeltoperand-kommutativ
                 t-r>-ra t-r>-ra
                 $6000 doppeltoperand-kommutativ ;
' t-d+  ' t-d+-ra  t-prim-ra: d+  t-inline  4 t-foldable

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

: t-d-    ( low1 high1 low2 high2 -- low high ) 2>r 16l16h->32 2r> 16l16h->32 - 32->16l16h ;
: t-d--ra ( -- ) t->r-ra t-swap-intern t->r-ra
                 $8000 doppeltoperand-nichtkommutativ
                 t-r>-ra t-r>-ra
                 $7000 doppeltoperand-nichtkommutativ ;
' t-d-  ' t-d--ra  t-prim-ra: d-  t-inline  4 t-foldable

