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


\ Diese Primitiven hier laden ALLES ausnahmslos zuerst in Register, oder genauer: Lassen in Register laden.
\ Für neue besondere Adressierfälle muss ich hier also nichts mehr hinzufügen.

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

: t-not    ( n -- ~n ) not $FFFF and ;

: t-not-ra ( -- ) einekonstante? if einekonstante t-not ergebnismerken else
  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $E330 state-tos @ or image,  \ xor #-1, r...
  then
;

\ Not wird in manchen Zusammensetzungen benötigt, aber für nach außen ist es praktischer, es via -1 xor zu definieren.
\ Dies hier braucht zwar während des Kompilierens ein Element weniger im RA, kann aber nicht so gut überoptimiert werden.
\ ' t-not  ' t-not-ra  t-prim-ra: not  t-inline  1 t-foldable


: t-shl    ( n -- n<<1 ) shl $FFFF and ;
: t-shl-ra ( -- ) einekonstante? if einekonstante t-shl ergebnismerken else
  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $5000 state-tos @ or state-tos @ 8 lshift or
  image,
  then
;

: t-shr    ( n -- n>>1 ) shr ;
: t-shr-ra ( -- ) einekonstante? if einekonstante t-shr ergebnismerken else
  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $C312 image, \ bic.w #1h, r2
  $1000 state-tos @ or image,  \ rrc r...
  then
;

: t-2/    ( n -- n>>>1 ) dup shr swap $8000 and or ; \ 16-Bit-Vorzeichen beachten
: t-2/-ra ( -- ) einekonstante? if einekonstante t-2/ ergebnismerken else
  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $1100 state-tos @ or image,  \ rra r...
  then
;

' t-shl     ' t-shl-ra     t-prim-ra: shl     t-inline  1 t-foldable
' t-shl     ' t-shl-ra     t-prim-ra: 2*      t-inline  1 t-foldable
' t-shr     ' t-shr-ra     t-prim-ra: shr     t-inline  1 t-foldable
' t-2/      ' t-2/-ra      t-prim-ra: 2/      t-inline  1 t-foldable


: t-><    ( 00hl -- 00lh ) dup   $FF and 8 lshift   swap   8 rshift $FF and   or  ; \ Swap Bytes.
: t-><-ra ( -- ) einekonstante? if einekonstante t->< ergebnismerken else
  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $1080 state-tos @ or image,  \ swpb r...
  then
;

' t-><      ' t-><-ra      t-prim-ra: ><      t-inline 1-foldable

\ -----------------------------------------------------------------------------
\  Rotationen, die lassen sich auch hübsch einbauen
\ -----------------------------------------------------------------------------

: t-rol    ( x -- x* ) dup $8000 and if shl 1 or else shl then $FFFF and ;
: t-rol-ra ( -- ) einekonstante? if einekonstante t-rol ergebnismerken exit then

  expect-one-element
  expect-tos-in-register
  make-tos-changeable

  $5000 state-tos @ or state-tos @ 8 lshift or image, \ add r..., r...
  $6300 state-tos @ or image, \ addc #0, r...
;

: t-ror    ( x -- x* ) dup 1 and if shr $8000 or else shr then $FFFF and ;
: t-ror-ra ( -- ) einekonstante? if einekonstante t-ror ergebnismerken exit then
  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $C312 image, \ bic.w #1h, r2
  $1000 state-tos @ or image,  \ rrc r...
  $2802 image, \ jnc 2+
  $D030 state-tos @ or image,  \ bis.w #8000h, r...
  $8000 image,
;

' t-rol     ' t-rol-ra     t-prim-ra: rol     t-inline  1 t-foldable
' t-ror     ' t-ror-ra     t-prim-ra: ror     t-inline  1 t-foldable

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

: t-dshl    ( low1 high1 -- low high ) 16l16h->32 shl 32->16l16h ;

: t-dshl-ra ( -- ) t-swap-intern

  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $5000 state-tos @ or state-tos @ 8 lshift or
  image,

                   t-swap-intern

  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $6000 state-tos @ or state-tos @ 8 lshift or
  image,
                   ;

' t-dshl  ' t-dshl-ra  t-prim-ra: dshl  t-inline  2 t-foldable
' t-dshl  ' t-dshl-ra  t-prim-ra: d2*   t-inline  2 t-foldable

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

: t-dshr    ( low1 high1 -- low high ) 16l16h->32 shr 32->16l16h ;

: t-dshr-ra ( -- )

  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $C312 image, \ bic.w #1h, r2
  $1000 state-tos @ or image,  \ rrc r...

                   t-swap-intern

  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $1000 state-tos @ or image,  \ rrc r...

                   t-swap-intern
                   ;

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

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

: t-d2/    ( low1 high1 -- low high ) 16l16h->32 2/ 32->16l16h ;

: t-d2/-ra ( -- )

  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $1100 state-tos @ or image,  \ rra r...

                   t-swap-intern

  expect-one-element
  expect-tos-in-register
  make-tos-changeable
  $1000 state-tos @ or image,  \ rrc r...

                   t-swap-intern
                   ;

' t-d2/  ' t-d2/-ra  t-prim-ra: d2/  t-inline  2 t-foldable

\ -----------------------------------------------------------------------------
\   Stromsparmodi, benötigen keine Operanden
\   Lassen sich auch im Host während der Emulation ausführen.
\ -----------------------------------------------------------------------------

: t-lpm ( -- ) ." LPM. Press any key." cr key drop ;

: t-lpm0-ra ( -- ) tidyup-ra $D032 image,  $0018 image, ;  \ bis.w #18h, r2
: t-lpm1-ra ( -- ) tidyup-ra $D032 image,  $0058 image, ;  \ bis.w #58h, r2
: t-lpm2-ra ( -- ) tidyup-ra $D032 image,  $0098 image, ;  \ bis.w #98h, r2
: t-lpm3-ra ( -- ) tidyup-ra $D032 image,  $00D8 image, ;  \ bis.w #D8h, r2
: t-lpm4-ra ( -- ) tidyup-ra $D032 image,  $00F8 image, ;  \ bis.w #F8h, r2

: t-eint-ra ( -- ) tidyup-ra $D232 image,               ;  \ bis.w #8h, r2
: t-dint-ra ( -- ) tidyup-ra $C232 image,               ;  \ bic.w #8h, r2

\ Setzt einen besonderen "Register", welcher schließlich als Aufwach-Opcode an das Ende von Interruptvektoren gesetzt wird.
: t-wakeup-ra ( -- ) wakeup-register registerusage bis! ;

' t-lpm     ' t-lpm0-ra    t-prim-ra: lpm0    t-inline
' t-lpm     ' t-lpm1-ra    t-prim-ra: lpm1    t-inline
' t-lpm     ' t-lpm2-ra    t-prim-ra: lpm2    t-inline
' t-lpm     ' t-lpm3-ra    t-prim-ra: lpm3    t-inline
' t-lpm     ' t-lpm4-ra    t-prim-ra: lpm4    t-inline

' nop       ' t-eint-ra    t-prim-ra: eint    t-inline
' nop       ' t-dint-ra    t-prim-ra: dint    t-inline
' nop       ' t-wakeup-ra  t-prim-ra: wakeup  t-inline

