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


\ -----------------------------------------------------------------------------
\   Multiplikation als Primitive
\ ----------------------------------------------------------------------------- 

: t-* ( n1 n2 -- n ) * $FFFF and ;

: t-*-ra ( -- )

  zweikonstanten? if zweikonstanten t-* ergebnismerken exit then
  
  \ Hier noch prüfen, ob einer der Operanden eine Konstante ist --> Abkürzungen und Schübe !

  state-nos @ literal@pc+ = if t-swap-intern then  \ Kommutativ - falls NOS Konstante ist, nach oben holen.
  
  einekonstante?
  not if else
    einekonstante  \ Alle Konstanten von -2 bis +7 werden hier "abgekürzt", außerdem jene, die durch Schübe dargestellt werden können.
    
    dup $FFFE  =  if ergebnismerken t-xor-ra 1 ergebnismerken t-+-ra t-shl-ra  exit then
    dup $FFFF  =  if ergebnismerken t-xor-ra 1 ergebnismerken t-+-ra           exit then
    dup     0  =  if eliminiere-tos ergebnismerken                             exit then
    dup     1  =  if drop                                                      exit then
    dup     3  =  if drop t-dup-ra t-shl-ra t-+-ra                             exit then
    dup     5  =  if drop t-dup-ra t-shl-ra t-shl-ra t-+-ra                    exit then
    dup     6  =  if drop t-shl-ra t-dup-ra t-shl-ra t-+-ra                    exit then
    dup     7  =  if drop t-dup-ra t-shl-ra t-shl-ra t-shl-ra t-swap-ra t---ra exit then
    
    dup $0002  =  if drop  1 ergebnismerken t-lshift-ra  exit then
    dup $0004  =  if drop  2 ergebnismerken t-lshift-ra  exit then
    dup $0008  =  if drop  3 ergebnismerken t-lshift-ra  exit then
                                                         
    dup $0010  =  if drop  4 ergebnismerken t-lshift-ra  exit then
    dup $0020  =  if drop  5 ergebnismerken t-lshift-ra  exit then
    dup $0040  =  if drop  6 ergebnismerken t-lshift-ra  exit then
    dup $0080  =  if drop  7 ergebnismerken t-lshift-ra  exit then
                                                         
    dup $0100  =  if drop  8 ergebnismerken t-lshift-ra  exit then
    dup $0200  =  if drop  9 ergebnismerken t-lshift-ra  exit then
    dup $0400  =  if drop 10 ergebnismerken t-lshift-ra  exit then    
    dup $0800  =  if drop 11 ergebnismerken t-lshift-ra  exit then
                                                         
    dup $1000  =  if drop 12 ergebnismerken t-lshift-ra  exit then
    dup $2000  =  if drop 13 ergebnismerken t-lshift-ra  exit then
    dup $4000  =  if drop 14 ergebnismerken t-lshift-ra  exit then
    dup $8000  =  if drop 15 ergebnismerken t-lshift-ra  exit then
    
    ergebnismerken \ Andere Konstanten müssen "klassisch" geschoben werden...    
    false shift-vorspann !
  then  
  
  \ Tatsächlich eine Multiplikation schreiben.
  
  expect-two-elements
  expect-nos-in-register
  expect-tos-in-register
  
  make-tos-changeable
  t-swap-intern
  make-tos-changeable
  t-swap-intern
  
  befreie-tos
  get-free-register state-tos ! \ In diesem Register wird das Ergebnis entstehen
  
  \ Multipliziere nun 3OS mit NOS und lege das Ergebnis in TOS.
  
  \   mov #0, tos
  \ - rrc 3os               \ Ein Bit rausrotieren, Zufallsbit reinrotieren
  \   jnc +                 \ War es eine 1 ?
  \     add nos, tos        \  Wenn ja, dann addieren.
  \ + add nos, nos          \ Links schieben
  \   jnz -                 \ Alle Bits verbraucht ?
  
  $4300 state-tos @ or image,
  $1000 state-3os @ or image,
  $2801 image,
  $5000 state-tos @ or state-nos @ 8 lshift or image,
  $5000 state-nos @ or state-nos @ 8 lshift or image,
  $2000 $3FF 4 - or image,
 
  eliminiere-nos
  eliminiere-nos 
;

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

target
  : negate ( n -- -n ) -1 * inline 1-foldable ;
host
