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


\ -----------------------------------------------------------------------------
\  Primitiven neu durchdacht. Stackjongleure
\ -----------------------------------------------------------------------------

\ Primitiven müssen zwei Teile besitzen:
\  Einen zum Ausführen und einen zum Kompilieren im RA.

: t-dup     ( x -- x x ) dup ;
: t-dup-ra  ( -- ) \ exit
    expect-one-element
    tos-fetchsperre    \ Speicherstellen nicht zweimal lesen.
    befreie-tos
    state-nos 2@ state-tos 2!
;

' t-dup  ' t-dup-ra  t-prim-ra:  dup  t-inline  1 t-foldable



: t-swap-intern ( -- ) \ Falls klar ist, dass diese beiden Elemente wirklich getauscht werden sollen, egal, was sie enthalten.
  state-nos 2@ 2>r
      state-tos 2@  state-nos 2!
    2r> state-tos 2!
;    

: t-swap     ( x1 x2 -- x2 x1 ) swap ;
: t-swap-ra  ( -- )
    expect-two-elements
    \ tos-fetchsperre  \ Entfernt, denn es geht hier nur um die Anordnung der einzelnen Lesezugriffe
    t-swap-intern
;

' t-swap  ' t-swap-ra  t-prim-ra:  swap  t-inline  2 t-foldable



: t-drop    ( x -- ) drop ;
: t-drop-ra ( -- ) state-tos @ unknown = if $5324 image, else ( tos-fetchsperre ) eliminiere-tos then ;
' t-drop  ' t-drop-ra  t-prim-ra:  drop  t-inline  1 t-foldable


\ -----------------------------------------------------------------------------
\  Primitiven neu durchdacht. Returnstack.
\ -----------------------------------------------------------------------------

\ Ein kleiner, einfacher, zirkularer R-Stack fürs Target, nur, um ein paar Werte mal zwischenzuspeichern.

32 cells buffer: r-stack
0 variable r-stack-pointer

: t->r    ( x -- ) r-stack-pointer @ 1+ $1F and r-stack-pointer !
                   r-stack-pointer @ cells r-stack + ! ;                   
: t->r-ra ( -- ) expect-one-element befreie-tor state-tos 2@ state-tor 2! eliminiere-tos ; \ Ein Fetch darf in ROT mitwandern :-)
' t->r  ' t->r-ra  t-prim-ra: >r  t-inline

: t-r@    ( -- x ) r-stack-pointer @ cells r-stack + @ ;
: t-r@-ra ( -- ) expect-one-r-element befreie-tos state-tor 2@ state-tos 2! tos-fetchsperre state-tos 2@ state-tor 2!  ;  \ Jedes Fetch nur einmal durchführen. r@ käme aber sonst einem dup gleich.
' t-r@  ' t-r@-ra  t-prim-ra: r@  t-inline

: t-r>    ( -- x ) t-r@    r-stack-pointer @ 1- $1F and r-stack-pointer ! ;
: t-r>-ra ( -- ) expect-one-r-element befreie-tos state-tor 2@ state-tos 2! \ Wie r@ nur ohne Fetchsperre, damit auch einmal eine Variable oder Speicherstelle über den R-Stack wandern kann.
                 eliminiere-tor ;
' t-r>  ' t-r>-ra  t-prim-ra: r>  t-inline

\ -----------------------------------------------------------------------------
\  Zusammengesetzte Stackjongleure, direkt im Target definiert.
\ -----------------------------------------------------------------------------

\ Durch konsequentes Inlining keinen Performanceverlust !

target
  : rot   >r swap r> swap     inline  3-foldable  ;
  : -rot  rot rot             inline  3-foldable  ;
  : over  >r dup r> swap      inline  2-foldable  ;
  : nip   swap drop           inline  2-foldable  ;  
  : tuck  swap over           inline  2-foldable  ;
  : rdrop r> drop             inline              ;
  
  : 2drop drop drop           inline  2-foldable  ;
  : 2dup  over over           inline  2-foldable  ;
  : 2swap >r -rot r> -rot     inline  4-foldable  ;
host
