;
;    Mecrisp - A native code Forth implementation for MSP430 microcontrollers
;    Copyright (C) 2011  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/>.
;

;------------------------------------------------------------------------------
  Kapitelbirne_flash "--- Interpreter ---"  
;------------------------------------------------------------------------------  

;------------------------------------------------------------------------------
zeichenloeschen: ; Löscht das erste Zeichen im Eingabepuffer. Ganz einfach... Nur noch ein Helferlein.
;------------------------------------------------------------------------------
  ; Voraussetzung: Im Puffer ist noch mindestens ein Zeichen. Dafür gibt es hier keine Probe mehr.
 
  dec.b &Eingabepuffergesamtlaenge ; Die Länge des Puffers wird um ein Zeichen erniedrigt.
  jz + ; Sind noch Zeichen darin, die geschoben werden müssen ?  
       ; Spare Takte, falls nichts zu tun ist.
  push r10 
  push r11

  ; Ein Zeichen vorne abhängen = die anderen Zeichen nachrutschen lassen.
  mov.b &Eingabepuffergesamtlaenge, r11 ; Zahl der im Puffer noch vorhandenen Zeichen
  mov #Eingabepuffer+2, r10 ; Adresse des nächsten Zeichens, das noch verschoben werden muss.

- mov.b @r10+, -2(r10) ; Das Zeichen um eine Stelle nach vorne kopieren, dabei gleich den Pointer nachrücken.
  dec r11
  jnz -

  pop r11
  pop r10
+ ret

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar, "token"
token: ; ( -- Addr ) Kopiert aus dem Eingabestrom ein Token.
       ; Gibt einen leeren String zurück, wenn nichts mehr da ist.
;------------------------------------------------------------------------------
  pushda #32 ; Leerzeichen als Trennzeichen, parse erkennt diesen Sonderfall.
  jmp parse

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar, "parse"
parse: ; ( Zeichen -- Addr ) Nimmt aus dem Eingabestrom,
       ; bis das Trennzeichen gefunden wurde oder der Puffer leer ist. 
;------------------------------------------------------------------------------
  ; Eine ganz neue Implementation. 
  push r10

  ; Eine besondere Vorbereitung. Korrespondiert mit Querys Präparation.
  cmp.b #-1, &Eingabepuffergesamtlaenge ; Dies ist das Zeichen, dass das Zerpflücken beginnt !
  jne + 
    mov.b &Eingabepuffer, &Eingabepuffergesamtlaenge ; Die von Query gegebene Länge ein Byte vorziehen.
    mov.b #-1, &Eingabepuffer ; An der Stelle der "kleinen Länge" -1 einfügen, damit -1+1=0 Zeichen gelöscht werden. 
+ ; Fertig präpariert.


  ; Schneide zunächst die zuletzt zurückgegebenen Zeichen vorne ab.

  mov.b &Eingabepuffer, r10
  inc.b r10 ; Trennzeichen mit abschneiden. Erster Einsprung: -1 + 1 = 0.

- tst.b &Eingabepuffergesamtlaenge
  jz +

  tst.b r10
  jz +
  dec.b r10

  call #zeichenloeschen
  jmp -

+ ; Erfolgreich abgeschnitten.

  cmp.b #32, @r4 ; Ist es das Leerzeichen - Tokens ehemalige Spezialität ?
  jne +

  ; Prüfe, ob am Anfang Trennzeichen=Spaces vorkommen. Abschneiden. Nur für den von Token übernommenen Spezialfall.
- tst.b &Eingabepuffergesamtlaenge
  jz +

  cmp.b #32, &Eingabepuffer+1
  jne +

  call #zeichenloeschen
  jmp -

+ ; Abgeschnitten oder Puffer leer.
  clr.b &Eingabepuffer ; Denn die "kleine Länge" enthält nach dem Abschneiden negative Werte.

  ; Suche jetzt die Zeichen, die ich mir wünsche.
  clr r10 ; Bislang Null Zeichen gefunden.

- cmp.b @r4, Eingabepuffer+1(r10)
  je + ; Wenn Space gefunden wurde, fertig.

  ; Prüfe, ob damit die Gesamtlänge erreicht ist.
  cmp.b &Eingabepuffergesamtlaenge, r10
  jhs + ; Ende.
  
  ; Noch ist die Gesamtlänge größer als die "kleine Länge", und an der aktuellen Stelle ist
  ; etwas anderes als das Trennzeichen. Nimm also ein Zeichen dazu !

  inc r10
  jmp -
  
+ mov.b r10, &Eingabepuffer ; Die "kleine Länge" aktualisieren.  

  ; Zeichen gesammelt.
  pop r10

- mov #Eingabepuffer, @r4  
  ret

;------------------------------------------------------------------------------
;  Wortbirne Flag_sichtbar, "tib"
;------------------------------------------------------------------------------
;  decd r4 ; Nicht mehr herausgeführt, weil nach sowas wie "query type" interpret versucht, das auszuwerten.
;  jmp - 

; Ehemaliger Platz der Wortsuche

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar, "interpret"
interpret: ; Interpretiert einen String - mit Konstantenfaltung
;------------------------------------------------------------------------------
  push r10
  push r11
  ; Stack leer. Zumindest für das, was interpret tut.  
 
interpret_weitermachen:
     ; write " interpret_weitermachen"
     ; call #dots ; An dieser Stelle ist die Welt noch in Ordnung.
  call #qstacks ; Prüfe, ob die Stackgrenzen eingehalten werden.

  call #token              ; Token sucht im Puffer und gibt eine Stringadresse zurück.
  mov @r4, r10             ; Hole die Stringadresse vom Datenstack.
  ; ( Stringadresse )
  tst.b @r10               ; Prüfe die Länge des zurückgegebenen Strings.
  jne +                    ; Wenn nichts enthalten gewesen ist, bin ich fertig.
  ;writeln "Puffer leer"
  ; Ende der Interpretation, wenn nichts mehr nachgeliefert wird.
  drop ; Vergiss die Stringadresse
  pop r11
  pop r10
  ret  
  ;------------------------------------------------------------
+ ; Habe nun ein Token gefunden.
  ; Dessen Adresse ist in r10 und auf dem Datenstack.

  ;Kurzschluss mit Ausgabe: call #schreibestringmitlaenge
  ;                         jmp -


  ; Setze den Konstantenfaltungszeiger:
  tst &Konstantenfaltungszeiger ; Wenn er ungesetzt ist, wird er jetzt gesetzt.
  jne +
  mov r4, &Konstantenfaltungszeiger
  incd &Konstantenfaltungszeiger ; Damit es stimmt !! Hier ist noch etwas eigenes auf dem Stack.
+ ; Fertig gesetzt.


  ; ( Stringadresse )        Stringadresse der Wortsuche zuführen
     ; write " interpret_vor_wortsuche"
     ; dup
     ; write " < "
     ; call #schreibestringmitlaenge
     ; write " > "
     ; call #dots ; An dieser Stelle ist die Welt noch in Ordnung.
  call #wortsuche          ; Die Wortsuche prüft, ob das Token im Dictionary vorkommt
     ; write " interpret_nach_wortsuche"
     ; call #dots ; An dieser Stelle ist die Welt noch in Ordnung.
  ; ( Einsprungadresse Flags )
  tst 2(r4)            ; und gibt Null als Einsprungadresse zurück, falls es nicht gefunden werden kann.
  jne interpret_token  ; Sprung zur Tokenverarbeitung.
  
  
  ;------------------------------------------------------------
interpret_zahlen:
    ;writeln "Interpret_Zahlen"
  ; Zahlenbearbeitung. Die ist klein und ordentlich.
  ; Wenn die Wortsuche unerfolgreich bleibt, ist es ein Fall für number.
  ; ( 0 0 ) von der Wortsuche.

  drop ; Vergiss eine der Nullen, die noch von der gescheiterten Wortsuche auf dem Stack liegen.
  ; write "Number"
  mov r10, @r4             ; Darin ist doch noch die Null von der Wortsuche...  
                           ; Überschreibe sie einfach mit der Tokenadresse,
                           ; um eine Bewegung auf dem Datenstack zu sparen.

  call #number
  and @r4+, -2(r4) ; Ergebnis prüfen.
  jnz interpret_weitermachen
  
  pushda r10
  call #schreibestringmitlaenge
  ;writeln " ist unbekannt."
  writeln " is unknown."  
  br #quit  

  ;------------------------------------------------------------
interpret_token: ; Das Wort wurde gefunden. Entscheide, was zu tun ist.
  ; ( Adresse Flags ) von der Wortsuche.
  
  tst &state
  jne interpret_kompilierzustand
  
  ;writeln "Interpret_execute"
  ; Im Execute-Modus wird es gleich ausgeführt, keine Konstanten sammeln !
  clr &Konstantenfaltungszeiger
  drop
  call @r4+
  jmp interpret_weitermachen
  
  ;------------------------------------------------------------
interpret_kompilierzustand:  
  ;writeln "Interpret_kompilierzustand"
  ; Wir sind im Kompiliermodus. Hier gibt es viele Fällt und Optimierungen zu beachten.
  ; Hole die Flags des Wortes zur genaueren Untersuchung.
  ; ( Einsprungadresse Flags )
  popda r10
  ; ( Einsprungadresse )  
  to_r ; Schiebe Die Einsprungadresse auf den Returnstack. Möchte im Datenstack nur die Konstanten haben !
  
    ; Bestimme erstmal die Konstantenzahl. 
    mov &konstantenfaltungszeiger, r11
    tst r11
    jz +
    sub r4, r11
    jmp ++
+   clr r11
+   rra r11 ; Durch 2 teilen, um Zahl der Stackelemente=Konstanten zu bekommen.

    ; Habe nun in r11 die Anzahl der vorhandenen Konstanten.
  
    ; Probe auf Optimiermöglichkeiten:
    ifdef ramverwaltungeinbinden
      bit #Flag_ramallot, r10         ; Ramallot-Wörter sind immer 0-Faltbar !
      jc interpret_faltoptimierung    ; Muss zuerst geprüft werden, da Ramallot gemeinsam mit Faltbarkeit gesetzt wird.
    endif                             ; Aber die Bedeutung der letzten vier Bits die Menge des belegten Ramspeichers ist.

    bit #Flag_faltbar, r10
    jnc interpret_unoptimierbar ; Nicht optimierbar.

    ; Hier gehört die Probe auf Opcodierbarkeit hinein.
    bit #Flag_opcodierbar, r10
    jnc +        ; Opcodierbarflag gesetzt
    tst r11
    je +         ; Und mindestens 1 Konstante (=nicht Null)
    jmp interpret_opcodierbar        
+   ; Nicht opcodierbar.    
  
    ; Sind genug Konstanten für die Optimierung verfügbar ? Wie viele werden gebraucht ?
    push r10
    and #111b, r10 ; Die untersten 3 Bits geben an, wie viele Konstanten benötigt werden.
    cmp r10, r11
    pop r10 
    jlo interpret_unoptimierbar     

interpret_faltoptimierung:
      ; writeln "Faltung!"
    ; call @sp+ ; Geht das so ? Ja !  Nein. Echter Chip stürzt ab.
    pop r10
    call r10
    jmp interpret_weitermachen    
        
    
interpret_unoptimierbar:    
    ; Erstmal keine berücksichtigen.
  
    call #interpret_konstantenschreiben
  r_from
;------------------------------------------------------------  
interpret_klassisch_kompilieren:  
  ; ( Einsprungadresse ), Flags in r10
  bit #Flag_immediate, r10
  jnc interpret_einkompilieren
  call @r4+
  jmp interpret_weitermachen
  
interpret_einkompilieren:
  bit #Flag_inline, r10
  jnc +
  call #inlinekomma
  jmp interpret_weitermachen
+ call #callkomma
  jmp interpret_weitermachen  


;------------------------------------------------------------  
; Ab jetzt kommen Interpret-Helferlein.
;------------------------------------------------------------  

ByteOpcodeBit equ 040h ; Das Bit im Opcode, das angibt, ob es sich um einen Bytebefehl handelt.

;------------------------------------------------------------------------------
interpret_opcodierbar: ; Flags des Wortes in r10
                       ; Konstantenfüllstand in r11, mindestens eine Konnstante vorhanden
                       ; Einsprungadresse des Wortes auf dem Returnstack
;------------------------------------------------------------------------------
  ; Es gibt etwas zu optimieren. Habe mindestens eine Konstante parat.
  ; Prüfe hier die verschiedenen Opcodierfälle und setze sie sinnvoll um.
  
  ; Lese den Opcode aus dem Wort. Er ist nach dem ret zu finden.
  push r12
  mov 2(sp), r12 ; Hole die Einsprungadresse des Wortes !

- incd r12 ; Rücke um ein Word vor.
  cmp #4130h, -2(r12) ; Ist dort an der letzten Stelle Ret ? Dann habe ich nun die Adresse des Opcodes.
  jne -

  ; r12 enthält Adresse des Opcodes.
  mov @r12, r12 ; Hole den Opcode.
  
  ; Kann nun die Optimierfälle unterscheiden ! Kehre nie zurück - kann also mit den Flags machen, was ich will.
  and #111b, r10 ; Nur den Opcodiertyp maskieren
  
  cmp #1, r10
  jne interpret_opcodierbar_speicherschreiben
    ;------------------------------------------------------------------------------  
    ; Rechenlogik
     ;writeln "Opcodierbar-Rechenlogik"
    cmp #1, r11 ; Nur bei genau einer Konstanten optimieren. Sonst habe ich 2 oder mehr Konstanten --> Falten !
    je +
      ; writeln "Rechenlogik-execute"
      pop r12   ; Opcode brauche ich nicht
      ;call @sp+ ; Execute
      pop r10
      call r10
      jmp interpret_weitermachen
      
+   ; Rechenlogik - tatsächlich opcodieren !
    ; writeln "Rechenlogik-Opcodieren"
    pushda r12  ; Opcode
    call #komma
    call #komma ; Konstante, liegt noch auf dem Datenstack
    pushda #0   
    call #komma ; 0 - denn diese Befehle gehen add #Konstante, 0(r4)
    
    jmp interpret_opcodierbar_fertig

  
interpret_opcodierbar_speicherschreiben:
  cmp #2, r10
  jne interpret_opcodierbar_speicherlesen
    ;------------------------------------------------------------------------------
    ; Speicher schreiben
     ;writeln "Opcodierbar-Speicherschreiben"
    ; Betrachte die zwei Fälle: Genau eine Konstante und mindestens zwei Konstanten.
    cmp #1, r11
    je +
    ; Mindestens zwei Konstanten:
     ;writeln " mit mindestens zwei Konstanten"
    ; Schreibe den Befehl !
    pushda r12
    call #komma ; Opcode
    swap
    call #komma ; Konstante
    call #komma ; Adresse
    
    jmp interpret_opcodierbar_fertig
    
    
+   ; Genau eine Konstante:
     ;writeln " mit einer Konstanten"
    bis #0400h, r12 ; Opcode von @r0+ auf @r4+ umschalten.
      bit #ByteOpcodeBit, r12
      jnc +
      bic #10h, r12 ; Macht aus Befehl.b @r4+, &Adresse stattdessen Befehl.b @r4, &Adresse
+     ; Nur bei Bytebefehlen wird der Adressierungsmodus geändert.
    pushda r12
    call #komma ; Opcode
    call #komma ; Konstante

    bit #ByteOpcodeBit, r12 ; Ist das ein Byte-Schreibzugriff ? z.B. mov.b @r4+, &Adresse erhöht r4 nur um 1 !
    jnc +                   ; Dann muss ein inc r4 hinterher, um den Datenstackzeiger wieder gerade zu machen !
      ;writeln "Byte-Einkonstanten-Speicherschreiben"
    pushda #5324h ; Opcode für incd r4 = add #2, r4
    call #komma
+   ; Okay.

    jmp interpret_opcodierbar_fertig

interpret_opcodierbar_speicherlesen:
  ; Es gibt nur diese drei Fälle, also erübrigt sich hier eine Probe.
    ;------------------------------------------------------------------------------
      ;writeln "Opcodierbar-Speicherlesen"
    ; Benötige genau eine Konstante, haben mindestens eine Konstante, zerstört Konstantenstack.
    ; Brauche die Einsprungadresse nicht mehr.
    
    mov @r4+, r10 ; Hole die benötigte Konstante
    dec r11       ; Habe damit eine Konstante weniger.
    call #interpret_konstantenschreiben ; Alle, die noch da sind, schreiben.
    
    ; Bereit, um den Befehl zu schreiben.
    pushda #8324h
    call #komma ; decd r4
    pushda r12    
    call #komma ; Opcode
    pushda r10
    call #komma ; Adresse
    pushda #0
    call #komma ; 0(r4)

    bit #ByteOpcodeBit, r12 ; Ist das ein Byte-Lesezugriff ? z.B. mov.b &Adresse, @r4 ?
    jnc +                   ; Dann ist das High-Byte im Datenstack zufällig. Lösche es ! 
      ;writeln "Byte-Einkonstanten-Speicherlesen"
    pushda #43c4h ; Opcode für clr.b 1(r4) $43c4 $0001
    call #komma
    pushda #0001h ; Opcode für clr.b 1(r4) $43c4 $0001
    call #komma
+   ; Okay.

interpret_opcodierbar_fertig:
    pop r12
    incd sp
    jmp interpret_weitermachen      
          

;------------------------------------------------------------------------------
interpret_konstantenschreiben: ; Schreibe die Konstanten auf dem Datenstack.
                               ; Niemals rausführen ! Spezielle Registerabhängigkeiten !!
;------------------------------------------------------------------------------
  tst r11 ; Anzahl der zu schreibenden Konstanten
  jz + ; Keine Konstanten ? Nichts tun !

  ; Kompiliermodus, Konstanten vorhanden. Anzahl in r11.
  ; Schreibe sie ! 
    ; write " Brenne Konstanten: "

  push r12
  mov &konstantenfaltungszeiger, r12
  
  decd r12 ; Der Konstantenfaltungszeiger zeigt auf die Stelle VOR der ersten Konstante !

- pushda @r12 
    ;dup 
    ;call #udot
    ;write " "
  call #literalkomma
  decd r12
  dec r11
  jnz -
  
  mov &konstantenfaltungszeiger, r4
  pop r12
     ;writeln " Fertig"
  
+ ; Hier wird jedesmal der Konstantenfaltungszeiger gelöscht. Denn nun geschehen Dinge, die nicht faltbar sind.
  clr &konstantenfaltungszeiger
  ret
     
   
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar, "quit"
quit:      ; Die Endlosschleife eines Forth-Systems
;------------------------------------------------------------------------------
  ; Beim Einsprung setzt quit die Stacks zurück und räumt auf.
  mov   #returnstackanfang, SP                ; Stackpointer setzen, Stack 64 Bytes lang.
  mov   #datenstackanfang,  r4                ; Pointer für den Datenstack setzen. ebenso 64 Bytes lang.
  mov #10, &Base ; Dezimal.
  
  clr &state ; Bin am Ausführen, Lösche den Zustand, false = interpretiert, führt aus.
             ;                                       true wäre beim Kompilieren der Fall.

  clr &konstantenfaltungszeiger ; Im Falle eines Fehlers ist der Datenstack und damit alle Konstanten darin weg.

  ifdef leaveeinbinden                      ; Schleifenstrukturen gehen bei Quit verloren, klar.
    mov #datenstackende, &leavestackpointer ; Lege den Leavestack als von unten nach oben wachsenden Stack
  endif                                     ; mit in den Speicherbereich des Datenstacks.

quit_inneneinsprung:
- call #query      
  call #interpret
  writeln " ok."    
  jmp - ; Endlosschleife.
            
     
;------------------------------------------------------------------------------
  Kapitelbirne "--- Interpreter ---"  
;------------------------------------------------------------------------------  
