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


\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\  3. Teil: Untersuchen, was verwendet wird, um effizient zu kompilieren.
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\


\ -----------------------------------------------------------------------------
\  Callbaum verfolgen, um zu sehen, was wo verwendet wird
\ -----------------------------------------------------------------------------

: t-name. ( token-addr -- )
  4 + length-of-flags + t-dictionary + count type
;

: callbaum-trace ( token-addr -- )
  
  dup primitive> t@ ?dup \ Falls es eine bekannte Primitive ist, diese sogleich im Host ausführen.
  if drop t-name. cr
  else ( token-addr )    \ Es ist keine Primitive, sondern etwas Zusammengesetztes. Jetzt muss der "emulierende innere Interpreter" anlaufen.
  
    dup t-name. cr  \  Entweder den eigenen Namen oder den einer Primitive ausgeben.
    code> >r
  
    begin    
    r@ t@
    r> 4 + >r
         case
           signal-token   of  r@ t@  recurse  endof \ Token anspringen
           signal-ret     of  rdrop exit endof       \ Fertig ? Inneren Interpreter beenden. Achtung: So kann ich kein Exit mittendrin einfügen... Aber kann ja für Exit innendrin ein anderes Signal benutzen.
           
           signal-data       of  r@ t@ aligned r> + >r endof \ Datenblöcke überspringen
           signal-data-addr  of  r@ t@ aligned r> + >r endof \ Datenblöcke mit Adresse auch überspringen
           
           signal-branchtarget of r> btarget-len + >r endof  \ Cura-Snapshots überspringen
           signal-nop          of r> btarget-len + >r endof  \ Cura-Snapshots überspringen
           
         endcase
     r> 8 + >r  \ Alle Einträge bestehen aus drei Werten.
    again      
  then
;

: callbaum ( -- ) t' cr callbaum-trace ;
: cb callbaum ;

\ Jetzt eine Erkennung einfügen, wie oft alles verwendet wird.
\ Null mal ? --> Ein Mal, Rekursion fortsetzen
\ Mehr als Null mal ? --> Erhöhen, keine Rekursion.


\ Extraflag inline: Wird immer inline eingefügt. Ansonsten automatisch alles, was nur einmal benutzt wird, inline einfügen.


\ -----------------------------------------------------------------------------
\  Von einem Einsprungpunkt aus die Zahl der Verwendungen aktualisieren
\ -----------------------------------------------------------------------------

: entrypoint-trace ( token-addr -- )

  dup usage> t@ 1+ over usage> t! \ Diese Definition wird nun einmal mehr verwendet.
  
  \ Wie oft wurde diese Definition bisher bereits verwendet ?
  
  dup usage> t@ $FFFF and 1 u> if drop exit then \ Wenn sie nun zum zweiten Mal oder noch öfter verwendet wird, Rekursion nicht fortsetzen.
  

  dup primitive> t@ ?dup \ Falls es eine bekannte Primitive ist, diese sogleich im Host ausführen.
  if drop t-name. cr
  else ( token-addr )    \ Es ist keine Primitive, sondern etwas Zusammengesetztes. Jetzt muss der "emulierende innere Interpreter" anlaufen.
  
    dup t-name. cr  \  Entweder den eigenen Namen oder den einer Primitive ausgeben.
    code> >r
  
    begin    
    r@ t@
    r> 4 + >r
         case
         
           signal-token      of  r@ t@  recurse  endof \ Token anspringen
           signal-ret        of  rdrop exit endof       \ Fertig ? Inneren Interpreter beenden. Achtung: So kann ich kein Exit mittendrin einfügen... Aber kann ja für Exit innendrin ein anderes Signal benutzen.
           
           signal-data       of  r@ t@ aligned r> + >r endof \ Datenblöcke überspringen
           signal-data-addr  of  r@ t@ aligned r> + >r endof \ Datenblöcke mit Adresse auch überspringen
           
           signal-branchtarget of r> btarget-len + >r endof  \ Cura-Snapshots überspringen
           signal-nop          of r> btarget-len + >r endof  \ Cura-Snapshots überspringen           
           
         endcase
    r> 8 + >r  \ Alle Einträge bestehen aus zwei Werten.
    again      
  then
;

: entrypoint ( -- )
  t' cr
  dup usage> t@ $10000 + over usage> t!   \ Vermerke den Einsprungpunkt, so dass er nie inline eingefügt wird.
  entrypoint-trace
;


: vector ( irq -- ) \ Legt einen Interruptvektor bzw. den Reset-Einsprung als neue Definition an.

  t' ( irq definition )
  cr
  dup entrypoint-trace \ Zurückverfolgen, was alles verwendet wird
  
  \     over $FFFE <> if dup usage> t@ $10000 + over usage> t! then  \ Da die Registerbenutzung erst beim Kompilieren bestimmt wird, müssen alle außer dem Reset-Vektor eigenständige Definitionen werden.
  
  base @ >r hex
    over s>d <#
               # # # #
               [char] $ hold
               [char] - hold
               [char] q hold
               [char] r hold
               [char] i hold                           
             #> t-header
  r> base !
  
  $10000 t-fadenende @ usage> t!   \ Vermerke den Einsprungpunkt, so dass er nie inline eingefügt wird. Diese Definitionen müssen stets kompiliert werden.
   
  t-compile, \ Die gewünschte Definition einkompilieren. Es ist gut möglich, dass mehrere Interrupts den gleichen Handler anspringen !
  t-ret,
  
  t-fadenende @ vector> t! \ Vermerke, an welcher Stelle dieser Vektor in die Tabelle eingetragen werden soll   
;


\ -----------------------------------------------------------------------------
\  Eine Art "Disassembler" für Definitionen
\ -----------------------------------------------------------------------------

: t-seeprimitive ( token -- )
  code>
  begin
    dup t@ space space hex. cr
    dup t@ retopcode <>
  while
    4 +
  repeat
  drop
;

: t-seedata ( addr len -- ) \ Zum Anzeigen eines Datenblockes

  base @ >r hex
  begin
    dup
  while
    2 - 
    swap
    20 spaces ." $" dup th@ u.4 ."  ," cr
    2 +
    swap
  repeat
  2drop
  r> base !
  
;

: t@+ ( addr -- addr+4 data )
  dup 4 + swap t@
;

: seecurasnapshot ( t-addr -- )
  ." TOS: " t@+ hex.
  ." NOS: " t@+ hex. 
  ." 3OS: " t@+ hex. 
  ." 4OS: " t@+ hex. 
  ." 5OS: " t@+ hex. 
  ." 6OS: " t@+ hex. 
  
  ." TOR: " t@+ hex.
  ." NOR: " t@+ hex. 
  ." 3OR: " t@+ hex. 
  ." 4OR: " t@  hex. 
;

: t-seetoken ( token -- )

  ." : "
  
  dup primitive> t@ ?dup \ Falls es eine Primitive ist, kann sie nicht weiter zerlegt werden.
  if drop ( dup ) t-name. ."  ( Primitive ) ;" cr 
              ( t-seeprimitive cr )
  else ( token-addr )    \ Es ist keine Primitive, sondern etwas Zusammengesetztes. Jetzt muss der "emulierende innere Interpreter" anlaufen.

    dup t-name. cr
    code> >r
  
    begin
    r@ hex. ." : "        \ Adresse im Host
    r@ 8 + t@ hex.4 ." : " \ Adresse im Target
    
    r@ t@
    r> 4 + >r
         case
           signal-token   of  r@ t@  t-name. space endof \ Token benennen
           signal-literal of  r@ t@  ." $" hex.   endof \ Literal holen und anzeigen
           signal-branch  of  ." Branch " r@ t@  ." $" hex. endof
           signal-0branch of  ." 0-Branch " r@ t@  ." $" hex. endof
      signal-branchtarget of  ." <--   "            ( r@ 8 + seecurasnapshot ) r> btarget-len + >r endof
           signal-nop     of  ." <-- Eliminiert   " ( r@ 8 + seecurasnapshot ) r> btarget-len + >r endof
           signal-ret     of  rdrop ." ;" cr exit endof                 \ Fertig ? Inneren Interpreter beenden.
           
           signal-data    of  ." Data section:" cr           
                              r@ 8 + ( Adresse ) r@ t@ ( Adresse Länge ) t-seedata  \ Datenblock anzeigen
                              r@ t@ aligned r> + >r                                  \ Und für die weitere Tätigkeit des Disassemblers überspringen.
                          endof

           signal-data-addr of  ." Data section with Address:" cr           
                              r@ 8 + ( Adresse ) r@ t@ ( Adresse Länge ) t-seedata  \ Datenblock anzeigen
                              r@ t@ aligned r> + >r                                  \ Und für die weitere Tätigkeit des Disassemblers überspringen.
                          endof                                                    
           
           
           dup ." Falsches Signal: " hex. cr
         endcase
    r> 8 + >r  \ Alle Einträge bestehen aus drei Werten. 
    cr        
    again      
  then
;

: t-see ( -- )
  t' cr
  t-seetoken
;

' t-see t-prim: see       t-hostonly

\ -----------------------------------------------------------------------------
\  Dictionary durchgehen, alles, was verwendet wird, anzeigen.
\ -----------------------------------------------------------------------------

: t-dictionaryend ( -- addr ) \ Find the last entry in the dictionary
  t-fadenende @
  begin
    dup t@
  while
    t@
  repeat
;

: t-dictionarybefore ( addr -- addr* flag )
  dup t-fadenende @ = if true exit then
  >r

  t-fadenende @
  begin
    dup t@ r@ <>
  while
    t@
  repeat

  rdrop
  false
;

: t-listing ( -- )
  cr cr
  t-dictionaryend
  begin
    dup usage> t@ 0<> if dup t-seetoken cr then
    t-dictionarybefore
  until
  drop
;

