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


\ -----------------------------------------------------------------------------
\   Vergleiche, die durch ihre vielfältigen Optimierungen ziemlich aufwändig geworden sind
\ ----------------------------------------------------------------------------- 

: sign16 ( s16 -- n ) [ $b236 h, ] inline ; \ sxth r6, r6 Opcode

: subc-tos-tos ( -- ) $7000 state-tos @ or state-tos @ 8 lshift or image, ;

: vergleichsvorbereitung-kommutativ ( -- ) \ Schreibt den für Vergleiche nötigen cmp-Opcode mit allen Varianten.
                    $9000 doppeltoperand-kommutativ  \ cmp Opcode
                    eliminiere-tos
;

: vergleichsvorbereitung ( -- ) \ Schreibt den für Vergleiche nötigen cmp-Opcode mit allen Varianten.
                    $9000 doppeltoperand-nichtkommutativ  \ cmp Opcode
                    eliminiere-tos
;

: tos-registerwechsel ( -- ) \ Gibt den Register frei und legt TOS in einen neuen Register.
  eliminiere-tos
  befreie-tos
  get-free-register state-tos !
;


: sprung-in-flag-verwandeln ( sprungopcode -- ) \ Schreibt die Opcodes, die nötig sind, um aus diesem sprungopcode für 0-branch ein Flag auf dem Stack zu erzeugen.
  \ ." Sprung in Flag verwandeln" cr
  tos-bytesperre
  $9000 doppeltoperand-nichtkommutativ
  tos-registerwechsel

  case
  
    $2000 of ( ." jnz " ) $B322 image, subc-tos-tos t-not-ra endof \ bit.w #2h, r2
    $2400 of ( ." jz "  ) $B322 image, subc-tos-tos          endof
    
    $2800 of ( ." jnc " ) subc-tos-tos t-not-ra  endof
    $2C00 of ( ." jc "  ) subc-tos-tos           endof          
          
    \ Für die anderen Fälle habe ich leider keine starken Optimierungen.
    \ Konstruiere stattdessen also einen Sprung-Flagsetzer...
    
    $4300 state-tos @ or image,  \ mov #0, tos
    dup 1 or image,                 \ j** +
    $4330 state-tos @ or image,  \ mov #-1, tos       
  endcase
;

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

: t-=      ( x1 x2 -- ? ) = $FFFF and ;

: t-=-ra-flag ( -- ) \ Dies ist ein Spezialfall, der so kürzer ist und deshalb bleiben sollte.
                    tos-bytesperre
                    $E000 doppeltoperand-kommutativ \ xor
                    subc-tos-tos
;                    

: t-=-ra-sprung ( -- Opcode ) vergleichsvorbereitung $2000 ; \ jnz-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

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

: t-<>     ( x1 x2 -- ? ) <> $FFFF and ;

: t-<>-ra-flag ( -- ) $2400 sprung-in-flag-verwandeln ;                    

: t-<>-ra-sprung ( -- Opcode ) vergleichsvorbereitung-kommutativ $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

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

: t-u<     ( x1 x2 -- ? ) sign16 swap sign16 swap u< $FFFF and ;

: t-u<-ra-flag ( -- ) $2C00 sprung-in-flag-verwandeln ;

: t-u<-ra-sprung ( -- Opcode ) vergleichsvorbereitung $2C00 ; \ jc-Opcode

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

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

: t-u>=     ( x1 x2 -- ? ) sign16 swap sign16 swap u>= $FFFF and ;

: t-u>=-ra-flag ( -- ) $2800 sprung-in-flag-verwandeln ;

: t-u>=-ra-sprung ( -- Opcode ) vergleichsvorbereitung $2800 ; \ jnc-Opcode

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

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

: t-<      ( x1 x2 -- ? ) sign16 swap sign16 swap < $FFFF and ;
                                    
: t-<-ra-flag ( -- ) $3400 sprung-in-flag-verwandeln ;

: t-<-ra-sprung ( -- Opcode ) vergleichsvorbereitung $3400 ; \ jl-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

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

: t->=      ( x1 x2 -- ? ) sign16 swap sign16 swap >= $FFFF and ;
                                    
: t->=-ra-flag ( -- ) $3800 sprung-in-flag-verwandeln ;

: t->=-ra-sprung ( -- Opcode ) vergleichsvorbereitung $3800 ; \ jge-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

-----------------------------------------------------------------------------

target  \ Diese hier werden vom RA sehr gut von selbst zusammengebaut... Die umgekehrten Sprünge habe ich nicht - also keine weitere Optimierung so einfach möglich.

  : 0=   0 =       inline 1-foldable ;
  : 0<   0 <       inline 1-foldable ;
  : 0<>  0 <>      inline 1-foldable ;
    
  \ Erstmal zu Testzwecken, damit beim Probieren alles stimmt:
  \ : u>=  u< not inline 2-foldable ;
  \ :  >=   < not inline 2-foldable ;
    
  : u>   swap u<   inline 2-foldable ;  
  : u<=  swap u>=  inline 2-foldable ;
  
  : >    swap <    inline 2-foldable ;  
  : <=   swap >=   inline 2-foldable ;
      
host
