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


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\  4. Teil: Der Cross-Kompilierende Registerallokator
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

false variable kanonischer-rückfall

\ -----------------------------------------------------------------------------
\   Die Schnittstelle zum Rest der Welt
\ -----------------------------------------------------------------------------

: insertprimitive ( token -- )

  dup hostonly> t@ if t-name. ."  is available on host only." cr quit then

  dup primitive-ra> t@ ?dup if ( ." RA-Primitive" cr ) execute drop exit else ( ." Primitive räumt auf" cr ) tidyup-ra then

  
  \ Als Maschinensprache definierte Primitiven inline einfügen.
  
  dup registerusage> t@ registerusage bis! \ Zur bisherigen Registerverwendung hinzuverodern
  
    ."  inp " dup hex. cr
  code>
  begin
    dup t@ retopcode <>     \ ... bis zum Ret einfügen.
  while
    dup t@ image,           \ Opcodes der Primitive ...
    4 +
  repeat
  drop
;

: compileliteral ( n -- )

  \ Das übernimmt nun fortan der Registerallokator.
  
  befreie-tos           \ Das oberste Element freischieben
  state-tos cell+ !      \ Vermerke die Konstante im RA
  literal@pc+ state-tos ! \ Vermerke den neuen Status  

\  $8324  image, \ sub.w #2h, r4
\  $40B4  image, \ mov.w #2Ah, 0h(r4)
\         image,
\  $0000  image,
;

: ergebnismerken ( x -- ) compileliteral ;

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



\ Dies hier wird schon nicht mehr durch den RA geschickt:

: compilecalltotoken ( token -- )
  $12B0 image, \ Call-Opcode
  addrintarget> t@ image, \ Zieladresse
;

\ -----------------------------------------------------------------------------
\  Helferlein für den RA über Sprünge hinweg
\ -----------------------------------------------------------------------------


: savesnapshot ( t-addr -- )

  state-tos @ over kanon-tos + t!
  state-nos @ over kanon-nos + t!
  state-3os @ over kanon-3os + t!
  state-4os @ over kanon-4os + t!
  state-5os @ over kanon-5os + t!
  state-6os @ over kanon-6os + t!

  state-tor @ over kanon-tor + t!
  state-nor @ over kanon-nor + t!
  state-3or @ over kanon-3or + t!
  state-4or @ over kanon-4or + t!

  drop
;

: loadsnapshot ( t-addr -- )

  dup kanon-tos + t@  state-tos !
  dup kanon-nos + t@  state-nos !
  dup kanon-3os + t@  state-3os !
  dup kanon-4os + t@  state-4os !
  dup kanon-5os + t@  state-5os !
  dup kanon-6os + t@  state-6os !

  dup kanon-tor + t@  state-tor !
  dup kanon-nor + t@  state-nor !
  dup kanon-3or + t@  state-3or !
  dup kanon-4or + t@  state-4or !

  drop
;

\ -----------------------------------------------------------------------------
\  Kurze Sprünge einfügen
\ -----------------------------------------------------------------------------

0 variable zuletzteinenunbedingtensprung

64 constant maxjumps  \ Maximale Zahl von gepufferten Vorwärtssprüngen
maxjumps 8 * buffer: jumpcollection
jumpcollection maxjumps 8 * 0 fill

: showjumps ( -- )
  maxjumps 0 do
    i 8 * jumpcollection + @
    if
      ." Destination: " i 8 * jumpcollection + @ hex.
      ." Opcode location: " i 8 * jumpcollection + 4 + @ hex. cr
    then
  loop
;

: resolvejumps ( host-style-addr -- )

  maxjumps 0 do
    i 8 * jumpcollection + @ over =
    if
      \ Sprungopcode liegt schon im Speicher, muss nur noch den Offset berechnen und dazuverodern.

      dup 8 + t@  ( Zieladresse-im-Target )
      
        \ dup ." Zieladresse im Target" hex. cr
      
      i 8 * jumpcollection + 4 + @ ( Zieladresse-im-Target Opcodeadresse )
      dup >r
      - 2 - shr $3FF and     \ Offset berechnen
      r@ image@ or r> image!  \ Zum vorgefertigten Opcode dazuverodern

      \ Aus der Liste löschen:
      0   i 8 * jumpcollection +       !
      0   i 8 * jumpcollection +  4 +  !

    then
  loop
  drop
;

: collectjump ( opcode-location unresolved-host-style-destination )
  \ Suche die erste freie Stelle

  jumpcollection
  begin
    dup @ 0<>
  while
    8 +
  repeat
  >r

  ( opcode-location unresolved-host-style-destination R: addr-der-ersten-freien-stelle )
  r@     ! \ unresolved-host-style-destination
  r> 4 + ! \ opcode-location
    
   \ showjumps
;


\ Agenda: Probe, ob Sprungweite zu groß wird einfügen !

: destinationknown ( host-style-addr -- host-style-addr false | target-destination-addr true )
  dup 8 + t@ ?dup
  if \ Adresse bereits zugeordnet
    ( host-style-addr target-destination-addr )
    nip true exit
  else \ Adresse noch nicht zugeordnet
    false
  then
;

: otherdestinationsbefore? ( host-style-destination -- ? )
    
  maxjumps 0 do
    i 8 * jumpcollection + @
    ?dup if   \ 0 bedeutet: Leere Stelle,
      over u<= \ Gibt es einen unbehandelten Vorwärtssprung, der vor unserem Ziel einspringt ?      
      if unloop drop true exit then
    then
  loop
  drop false
;  
  
  
0 variable hs-destination  \ Temporär...

: compilebranch ( host-style-destination -- false | host-style-destination true )

  dup hs-destination !
  
  \ ." Compilebranch" cr
  destinationknown if  \ Unbedingte Rückwärtssprünge stets einfügen  
  
                     kanonischer-rückfall @ if
                       tidyup-ra
                     else
                       \ Rückwärtssprünge haben den Snapshot schon gesetzt. Muss diesen also holen und den RA-Zustand vor dem Sprung anpassen.
                       
                         
                                   kanonischer-zustand @          \ Merken ! Wir müssen ihn später wieder herstellen können.
                      hs-destination @ 12 + t-dictionary + kanonischer-zustand !  \ Setze den Zustand "als den Kanonischen"...
                                     tidyup-ra                      \ Räume in den gewünschten Zustand auf
                                   kanonischer-zustand !             \ Schließlich wieder der kanonische kanonische Zustand.
                       
                     then
    
                     ( target-destination-addr )
                     org @ ( destination opcode-addr ) \ h.s
                     - 2 - shr $3FF and $3C00 or image,          
                     
                     true zuletzteinenunbedingtensprung !
                     
                   else \ Bei unbedingten Vorwärtssprüngen prüfen, ob sie samt des übersprungenen Codeblocks entfernt werden können
                   
                     dup otherdestinationsbefore?
                     if
                       kanonischer-rückfall @ if
                       tidyup-ra
                     else                         
                       \ Vorwärtssprünge setzen den Snapshot an der Zielstelle auf ihre eigenen Bedürfnisse.
                        alle-vorhandenen-elemente-in-register-laden  \ Alles, was nun im RA ist, soll in Registern sein
                        dup 12 + savesnapshot                         \ Vermerke die Registerbelegung für später
                     then                         
                       
                       ( host-style-destination )
                       org @ swap collectjump
                       $3C00 image,   \ Leeren Sprungbefehl bereitlegen, Ziel wird später nachgefügt.
                       
                       true zuletzteinenunbedingtensprung !
                     else
                       \ Es ist ein Vorwärtssprung, der samt des Blocks weggelassen werden könnte.
               \        ." Unbedingten Vorwärtssprung weglassen !" cr
                       true exit \ Signal zum Überspringen geben.
                     then
                   then
  false                   
;




: compile-0-branch ( host-style-destination -- )
 \ ." Compile 0 branch" cr
 
  dup hs-destination !

  destinationknown if
                     kanonischer-rückfall @ if
                       tidyup-nullprobe
                     else
                       \ Rückwärtssprünge kennen ihr Ziel schon...
                       
                                   kanonischer-zustand @          \ Merken ! Wir müssen ihn später wieder herstellen können.
                      hs-destination @ 12 + t-dictionary + kanonischer-zustand !  \ Setze den Zustand "als den Kanonischen"...
                                     tidyup-nullprobe               \ Räume in den gewünschten Zustand auf
                                   kanonischer-zustand !             \ Schließlich wieder der kanonische kanonische Zustand.                       
                                                          
                     then
                     ( target-destination-addr )
                     org @ ( destination opcode-addr )
                     - 2 - shr $3FF and $2400 or image,                     
                   else
                   
                     kanonischer-rückfall @ if                   
                       tidyup-nullprobe
                     else
                       \ Ein Vorwärtssprung mit Nullprobe wird vorbereitet.
                       nullprobe-schreiben-und-alle-vorhandenen-elemente-in-register-laden
                       dup 12 + savesnapshot                         \ Vermerke die Registerbelegung für später
                     then
                     
                     
                     ( host-style-destination )
                     org @ swap collectjump
                     $2400 image,   \ Leeren Sprungbefehl bereitlegen, Ziel wird später nachgefügt.
                   then
;

: flagschreiber ( -- )
  flagtrampolin @ ?dup if execute 0 flagtrampolin ! 0 sprungtrampolin ! then
;

: compile-0-branch-trampolin ( host-style-destination -- )

 \ ." Flag-Sprung-Trampolin in Aktion." cr

  \ flagschreiber \ Zunächst einmal nichts besonderes unternehmen.

  \ Benötige zwei neue Aufräumer, die sich um dem Stack vor dem Vergleich kümmern:
  \ Einen für Einfach- und einen für Doppelt-Vergleiche.
  \ Der passende Sprung und die nötigen Opcodes werden dann von jedem Vergleich selbst gewählt.
  \ CMP-Opcodes sind natürlich besonders schön, weil sie dann keinen Registerwechsel brauchen.
  \ Hier wird am Ende nur noch der Sprungbefehl vervollständigt.
  \ Fürs Sprungtrampolin muss damit gelten: ( -- Sprungopcode )
 
  dup hs-destination !
 
  \ Erstmal ein Doppelt-Vergleich zur Probe einbauen !
   
  destinationknown if
  \ ." rück"
                     kanonischer-rückfall @ if
                       tidyup-bisaufzwei-sprungtrampolin ( host-style-destination opcode ) >r
                     else
                       \ Rückwärtssprünge kennen ihr Ziel schon...
                       
                                   kanonischer-zustand @          \ Merken ! Wir müssen ihn später wieder herstellen können.
                      hs-destination @ 12 + t-dictionary +  kanonischer-zustand !  \ Setze den Zustand "als den Kanonischen"...
                      tidyup-bisaufzwei-sprungtrampolin >r          \ Räume in den gewünschten Zustand auf
                                   kanonischer-zustand !             \ Schließlich wieder der kanonische kanonische Zustand.                       
                                                          
                     then
                       
                     ( target-destination-addr )
                     org @ ( destination opcode-addr )
                     - 2 - shr $3FF and r> or image,                     
                   else
  \ ." vor"         
                     kanonischer-rückfall @ if
                       tidyup-bisaufzwei-sprungtrampolin ( host-style-destination opcode ) >r
                     else
                       \ Ein Vorwärtssprung mit dem gewünschten Vergleich wird vorbereitet.
                       vergleich-schreiben-und-alle-vorhandenen-elemente-in-register-laden >r
                       dup 12 + savesnapshot                         \ Vermerke die Registerbelegung für später                       
                     then
                     
                     ( host-style-destination )
                     org @ swap collectjump
                     r> image,   \ Leeren Sprungbefehl bereitlegen, Ziel wird später nachgefügt.
                   then
    \               ." Sprungtrampolin-Branch fertig" cr 
;

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

true variable inlining

: inline? ( token -- ? ) \ Alles, was genau einmal benutzt wird, soll inline eingefügt werden.
  dup inline> t@          \ Ist es als "stets inline" markiert ?
  swap usage> t@ 1 =       \ Oder wird es nur einmal verwendet ?
  inlining @ and or         \ Um das große Einfügen auch mal probeweise abstellen zu können.
;

: tos-konstant-false? ( -- ? )
  \ Ist TOS konstant false, wird aus 0-branch ein branch.
  
  state-tos @ literal?
  state-tos cell+ @ 0=
  and  
;

: tos-konstant-true? ( -- ? )
  \ Ist TOS konstant true, kann ein 0-branch weggelassen werden
  
  state-tos @ literal?
  state-tos cell+ @ 0<>
  and  
;

\ : d ." Probestelle: " .s cr cura cr ;

: vorsprung-unterwegs ( ziel start -- ziel ) \ Der Start ist immer ein Sprung. Das Ziel ist auf jeden Fall eine Sprungstelle.

  \  Untersuche nun alle Sprünge in dem Bereich und eliminiere ihre Ziel-Aufräumstellen, damit diese die weitere Optimierung nicht stören.
  \ ." Vorsprung unterwegs  " .s cr
  
  \ Schleife über die Felder
  \ Elemente auf branch und 0-branch prüfen
  \ Deren Zielelemente herauspräparieren
  \ Und durch signal-nop ersetzen.
   
  begin  
    \ dup hex. dup t@ hex. cr
    
    dup t@ dup signal-branch = swap signal-0branch = or
    if \ Dies sind Sprünge.
      dup cell+ t@      \ Hole ihre Host-Zieladresse
      signal-nop swap t! \ und eliminiere den Aufräumpunkt an dieser Adresse.
    then
    
    2dup u>
  while  
    12 +
  repeat
  drop
    
;

: t-fill ( addr len c -- )
  rot
  t-dictionary +
  -rot
  fill
;

: adresszuordnungputzen ( token -- ) \ In einer Definition, die (erneut?) inline eingefügt werden soll, alle Target-Adressen löschen und Sprünge reaktivieren.
    code> >r
  
    begin    
    r@ t@
    0 r@ 8 + t! \ Target-Adress-Zuordnung löschen
         case
           signal-nop          of  signal-branchtarget r@ t!   r@ 12 +  btarget-len 0 t-fill    r> btarget-len + >r  endof \ Alle Sprungziele reaktivieren  
           signal-branchtarget of                              r@ 12 +  btarget-len 0 t-fill    r> btarget-len + >r  endof
           
           signal-ret       of  rdrop exit                       endof  \ Fertig ? Inneren Interpreter beenden.
           signal-data      of  r@ 4 + t@ aligned r> + >r        endof   \ Datenblock überspringen, länger als die anderen Signaltoken.
           signal-data-addr of  r@ 4 + t@ aligned r> + >r        endof   \ Datenblock mit Adresse auch überspringen, länger als die anderen Signaltoken.                      
         endcase
     r> 12 + >r  \ Alle Einträge bestehen aus drei Werten.
    again      
;


: t-inlinedata ( addr len -- )
  begin
    dup
  while
    2 - 
    swap
    dup th@ image,
    2 +
    swap
  repeat
  2drop
;

: curasnapshotgesetzt? ( t-addr -- ? )
  8 + t@ 0<> \ Die Null kommt im RA nie vor, kann also dagegen prüfen.
;


: crosscompiledefinition ( token -- )
  \ ."  ccd " dup hex. cr

  \ Entlanghangeln und als Objektcode einfügen.

    code> >r
  
    begin
    \ .s
    \ Aktuelle Target-Adresse dieses Bausteins vermerken:
    org @   r@ 8 +   t!
    
    r@ t@
    r> 4 + >r
         case
         
           signal-nop     of  r> btarget-len + >r              endof \ Eliminierte Sprungziel-Aufräumstellen gar nicht behandeln. Den Cura-Snapshot überspringen.
           signal-ret     of  rdrop                      exit  endof \ Fertig ? Inneren Interpreter beenden.           
           
           dup signal-branchtarget <> if false zuletzteinenunbedingtensprung ! then \ Um später auf unbedingte Sprünge treffende Branchtargets zu erkennen.
           
           \ Mit aktivem RA in die Sprünge laufen. Vielleicht kann ich ja diesen Sprung in Abhängigkeit von TOS eliminieren ?
           
           
           signal-0branch of r@ t@ 
            \ ." Nullbranch" cr
                             flagtrampolin @ if ( ." Trampolin" cr ) compile-0-branch-trampolin \ Ein Sprung, der aus einem Flag gespeist wird, kann nie wegoptimiert werden.
                             else
                               \ ." Ohne Trampolin" cr
                                   tos-konstant-false?             \ Sollte TOS nun konstant false sein, muss der Sprung unbedingt stattfinden.
                                     if 
                                 \    ." In unbedingt" cr
                                       eliminiere-tos
                                       compilebranch  if r> 4 -  vorsprung-unterwegs  4 + >r then  \ Umgewandelt in einen unbedingten Sprung. Agenda: Beim "Vorspringen" alle Sprünge unterwegs prüfen und ihre Aufräumstellen eliminieren.
                                     else 
                                       tos-konstant-true?            \ Sollte TOS konstant true sein, wird der Sprung nie ausgeführt. Lasse ihn weg, entferne die Aufräumstelle.
                                       if
                                  \     ." weglassen" cr
                                         eliminiere-tos                \ RA nicht aufräumen in diesem Falle
                                         signal-nop swap t!            \ An der Zieladresse muss eine Aufräumstelle sein. Ersetze sie durch ein NOP.
                                       else
                                   \    ." tatsächlich" cr
                                         compile-0-branch
                                       then
                                     
                                     then         
                             then \ Flagtrampolin
                          endof \ Bedingte Sprünge
                          
           flagschreiber \ Alle anderen Sachen können mit einem Flag nichts anfangen, muss also den Vergleich tatsächlich kompilieren.
                                                                          
           signal-branch  of  r@ t@  compilebranch  if r> 4 -  vorsprung-unterwegs  4 + >r then            endof \ Unbedingte Sprünge Agenda: Beim "Vorspringen" alle Sprünge unterwegs prüfen und ihre Aufräumstellen eliminieren.
                                
           signal-token   of  r@ t@             
           
                                 dup ramallot> t@
                                 if                                   
                                   \ Dieses Token ist ein Puffer oder eine Variable. Muss nun die Target-Adresse als Literal einfügen !
                                   addrintarget> t@ compileliteral                                   
                                 else
                                     dup inline? if 
                                                   dup primitive> t@ if insertprimitive else dup adresszuordnungputzen recurse then
                                                 else tidyup-ra compilecalltotoken then    
                                 then                
                                                 
                                                 
                          endof \ Token anspringen oder einfügen

           signal-literal of  r@ t@  compileliteral            endof \ Literal holen und liegenlassen

           \ Adress-Datenblöcke benötigen kein Aufräumen zuvor. Muss nur die Adresse auf den Datenstack legen, die kann anschließend weiterbenutzt werden.
           
           signal-data-addr of  
                                befreie-tos                     \ Adresse des Datenblocks auf den Stack legen
                                literal@pc+ state-tos !          \ Dafür den Zustand von TOS auf Konstante setzen
                                org @ 2 + state-tos 4 + !         \ und die richtige Adresse dort hinterlegen. Plus 2 für den Sprung-Opcode, der direkt folgt.
                                r@ t@ ( Länge ) 2/ $3C00 or image, \ Sprung über den Datenblock generieren, hier direkt.
                                                                          
                                r@ 8 + ( Adresse ) r@ t@ ( Adresse Länge ) t-inlinedata  \ Datenblock inline einfügen
                                r@ t@ aligned r> + >r                                     \ Datenblock überspringen      
                            endof                          
                       
           signal-data      of  tidyup-ra
                                r@ 8 + ( Adresse ) r@ t@ ( Adresse Länge ) t-inlinedata  \ Datenblock inline einfügen
                                r@ t@ aligned r> + >r                                     \ Datenblock überspringen      
                            endof                       
                       
                       
           signal-branchtarget of
           
                              kanonischer-rückfall @ if                                   
                                tidyup-ra          \ Zunächst einmal den RA aufräumen, damit der Kontrollfluss passt.
                              else   
                                   
                                 \ Nun viel raffinierter. 
           
                                 r@ curasnapshotgesetzt?
                                 if \ Für diese Stelle existiert bereits ein Snapshot, für den nun Kontrollfluss-Vereinigungs-Vorbereitung nötig ist.

                                   \ War das letzte Signal ein unbedingter Sprung ? Wenn ja, laufe ich hier nie vorbei und muss nicht aufräumen.
                                   \ Es gibt natürlich noch den unsinnigen Fall, dass der Sprung direkt hierher kommt...
                                   \ Aber dann ist dies der Ziel von dem Sprung selbst und es muss auch nichts aufgreäumt oder angepasst werden.
                                   
                       zuletzteinenunbedingtensprung @ if
                         r@ 8 + loadsnapshot \ Gesicherten Cura-Snapshot laden
                       else
                                                                                                          
                                   kanonischer-zustand @          \ Merken ! Wir müssen ihn später wieder herstellen können.
                                     r@ 8 + t-dictionary + kanonischer-zustand !  \ Setze den Zustand "als den Kanonischen"...
                                     tidyup-ra                      \ Räume in den gewünschten Zustand auf
                                   kanonischer-zustand !             \ Schließlich wieder der kanonische kanonische Zustand.
                       then          
                                 
                                 
                                 else \ Noch kein Snapshot angelegt. Alles in Register laden und den aktuellen Zustand vermerken.

                                   alle-vorhandenen-elemente-in-register-laden  \ Alles, was nun im RA ist, soll in Registern sein
                                   r@ 8 + savesnapshot                           \ Vermerke die Registerbelegung für später
                                 
                                 then
                                 
                               then \ Ohne kanonischen Rückfall
                                       
                                       
                                 org @   r@ 4 +   t! \ Dann muss allerdings auch die ORG-Stelle angepasst werden.           
                                 r@ 4 - resolvejumps  \ Gibt es noch unaufgelöste Vorwärtssprünge zu dieser Stelle ? Falls ja, werden sie nun eingefügt.
           
                                 r> btarget-len + >r    \ Den Cura-Snapshot überspringen
                                                                  
                                 false zuletzteinenunbedingtensprung !
                               endof
                               
         endcase
         r> 8 + >r
    again      
;

: t-crosstoken-irq ( token -- )
  
  org @ over addrintarget> t! \ Die Adresse im Target in der Primitive vermerken, damit sie angesprungen werden kann
  
  0 registerusage ! \ Noch wurden keine Register verwendet.
  
\  dup t-seetoken

  dup

    dup primitive> t@
    if insertprimitive
    else
      \ ." Unprimitive Definition" drop
      crosscompiledefinition
    then

    tidyup-ra
      
  registerusage> registerusage @ swap t! \ Die verwendeten Register vermerken.  
;

: t-crosstoken ( token -- )
  org @ hex. dup t-name. cr  \ Wohin wird es kompiliert ?
  
  t-crosstoken-irq
  retopcode image,
;



: variableninit ( -- )
  \ Geht das Dictionary einmal komplett durch schreibt die Initialisierungswerte in die Variablen.
    
  t-dictionaryend
  begin 
  
    dup raminit> t@ 0<
    if
      dup usage> t@ 0 >
      if
        \ ." Variable : "
        \ dup addrintarget> t@ hex. \ Die Adresse der Variablen im Ziel
        \ ." Anfangswert: "
        \ dup raminit> t@ $FFFF and hex. \ Der Initialisierungswert, der später geschrieben werden muss
        
        
        \ An dieser Stelle nun mov #..., &... Opcodes konstruieren, natürlich mit Konstantengenerator.
                
        dup raminit> t@ $FFFF and  \ Der Initialisierungswert, der später geschrieben werden muss
        $40B2 konstantengenerator   \ Natürlich kurze Konstanten optimieren
        dup addrintarget> t@ image,  \ Die Adresse der Variablen im Ziel
                
      then    
    then

    t-dictionarybefore
  until
  drop    
;

: reset-vorspann ( definition -- definition )
  \ Disable Watchdog, strictly necessary for real chips

  $40B2 image,  \ mov.w #5A80h, &120h
  $5A80 image,
  $0120 image,

  \ Prepare stack pointers
  
  $4031 image,  \ mov.w #const, r1
  initialreturnstack   kanonischer-rückfall @ not if 4 2* - then   image,    \ Registerallokation über Kontrollfluss hinweg kann zum "temporär ungedeckten" Nachladen von Registern führen

  $4034 image,  \ mov.w #const, r4
  initialdatastack     kanonischer-rückfall @ not if 6 2* - then   image,
  
  \ Initialise variables  
  variableninit
;

: reset-nachspann ( definition -- definition )
  $3FFF image, \ - jmp -   Endlosschleife als Falle
;


: unkanonisch? ( register -- ? ) \ Kommt dieser Register im kanonischen Grundzustand vor ? Wenn ja, braucht er nicht gesichert zu werden :-)
  
  dup kanonischer-zustand @ kanon-tos + @ = if drop false exit then
  dup kanonischer-zustand @ kanon-nos + @ = if drop false exit then
  dup kanonischer-zustand @ kanon-3os + @ = if drop false exit then
  dup kanonischer-zustand @ kanon-4os + @ = if drop false exit then
  dup kanonischer-zustand @ kanon-5os + @ = if drop false exit then
  dup kanonischer-zustand @ kanon-6os + @ = if drop false exit then
  
  dup kanonischer-zustand @ kanon-tor + @ = if drop false exit then
  dup kanonischer-zustand @ kanon-nor + @ = if drop false exit then
  dup kanonischer-zustand @ kanon-3or + @ = if drop false exit then
  dup kanonischer-zustand @ kanon-4or + @ = if drop false exit then
      
  drop
  true
;



0 variable registersicherung
0 variable stellensicherung

\ Wenn Elemente auf Grund des kanonischen Rückfalls grundsätzlich im Register liegen, müssen diese Register nicht mehr separat gesichert zu werden.

: irq-push ( -- ) \ ." Push " registersicherung @ hex. cr \ exit

  registersicherung @
  
    5 unkanonisch? if   dup 1  5 lshift and if $1205 image, then   then
    6 unkanonisch? if   dup 1  6 lshift and if $1206 image, then   then
    7 unkanonisch? if   dup 1  7 lshift and if $1207 image, then   then
    8 unkanonisch? if   dup 1  8 lshift and if $1208 image, then   then
    9 unkanonisch? if   dup 1  9 lshift and if $1209 image, then   then
   10 unkanonisch? if   dup 1 10 lshift and if $120A image, then   then
   11 unkanonisch? if   dup 1 11 lshift and if $120B image, then   then
   12 unkanonisch? if   dup 1 12 lshift and if $120C image, then   then
   13 unkanonisch? if   dup 1 13 lshift and if $120D image, then   then
   14 unkanonisch? if   dup 1 14 lshift and if $120E image, then   then
   15 unkanonisch? if   dup 1 15 lshift and if $120F image, then   then

  drop
;

: irq-pop ( -- ) \ ." Pop " registersicherung @ hex. cr \ exit

  registersicherung @

   15 unkanonisch? if   dup 1 15 lshift and if $413F image, then   then
   14 unkanonisch? if   dup 1 14 lshift and if $413E image, then   then
   13 unkanonisch? if   dup 1 13 lshift and if $413D image, then   then
   12 unkanonisch? if   dup 1 12 lshift and if $413C image, then   then
   11 unkanonisch? if   dup 1 11 lshift and if $413B image, then   then
   10 unkanonisch? if   dup 1 10 lshift and if $413A image, then   then
    9 unkanonisch? if   dup 1  9 lshift and if $4139 image, then   then
    8 unkanonisch? if   dup 1  8 lshift and if $4138 image, then   then
    7 unkanonisch? if   dup 1  7 lshift and if $4137 image, then   then
    6 unkanonisch? if   dup 1  6 lshift and if $4136 image, then   then
    5 unkanonisch? if   dup 1  5 lshift and if $4135 image, then   then
    
  drop
;
   
: irq-vorspann  ( definition -- definition )  dup vector> t@ $FFFE = if reset-vorspann  else irq-push               then ;
: irq-nachspann ( definition -- definition )  dup vector> t@ $FFFE = if reset-nachspann else irq-pop   $1300 image, then ;

: targetimage-vector ( definition -- definition )
  \ Eintrag in der Vektor-Tabelle anlegen
  org @ over vector> t@ image!  \ Vector table entry
  
  org @ stellensicherung ! \ Vermerken, wohin org nach Ende der Probekompilation zurückgesetzt werden muss
    
    dup t-crosstoken-irq \ Einmal zur Probe kompilieren, um zu sehen, welche Register dabei verwendet werden.
    dup registerusage> t@ registersicherung ! \ Die verwendeten Register merken
 
  \ Jetzt kennen wir den Registerbedarf und müssen die Kompilation zurücknehmen, damit der Interrupt-Rahmen geschrieben werden kann.
 
  dup adresszuordnungputzen
  stellensicherung @ org !
      
  \ Interrupt-Vorspann schreiben     
  \ Hier kommt für den Reset-Vektor etwas anderes hin als für andere Vektoren, später.
  irq-vorspann
      
  \ Den Inhalt des Vektors schreiben - das kann, muss aber nicht Inline sein, falls die Definition in mehreren Vektoren verwendet wird.
  org @ hex. dup t-name. cr  \ Wohin wird es kompiliert ?
  dup t-crosstoken-irq
      
  \ Interrupt-Nachspann schreiben      
  irq-nachspann 
;

: variablenprobe ( -- )
  variablenpointer @ stackarea u>= if ." Ram full." cr quit then
;

: speicherbedarf ( -- )
    cr org @ flashstart -       ." Speicherbedarf Flash ohne Vektortabelle " u. ." Bytes." cr
 variablenpointer @ ramstart -  ." Speicherbedarf RAM ohne Stacks " u. ." Bytes." cr
;

: crosscompile ( -- )
  clearmemory        \ Speicher putzen
  flashstart org !    \ Anfangsadresse passend setzen
  init-ra              \ Den Registerallokator in den Urzustand zurückversetzen
  cr cr

  t-dictionaryend
  begin 
  
    dup vector> t@ 0<>
    if
    
      targetimage-vector
      
    else \ Nein, es ist kein Interrupt-Vektor.
        dup usage> t@ 0<>
        if \ Diese Definition wird mindestens einmal verwendet.
           \ Soll sie kompiliert werden, oder muss an dieser Stelle Speicher angefordert werden ?
          
          dup ramallot> t@ 0<>
          if \ Speicher anfordern und Adresse im Target vermerken
          
            \ ." Speicher anfordern !"      
            variablenpointer @ over addrintarget> t! \ Vermerke die RAM-Adresse in dem Feld der "Target-Adresse" der Primitive.        
            dup ramallot> t@ variablenpointer +! variablenprobe \ RAM-Adresse im Target weiterrücken
         
          else \ Normal kompilieren      
            dup inline? not
            if dup ( .s ) t-crosstoken then
          then
        then
    then
    t-dictionarybefore
  until
  drop
  speicherbedarf
;

