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

; Interpreter und Optimierungen

;------------------------------------------------------------------------------
zeichenloeschen: ; Löscht das erste Zeichen im Eingabepuffer. 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

  ; Ein Zeichen vorne abhängen = die anderen Zeichen nachrutschen lassen.
  mov.b &Eingabepuffergesamtlaenge, r7 ; 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 r7
  jnz -

  pop r10
+ ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "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_visible, "parse"
parse: ; ( Zeichen -- Addr ) Nimmt aus dem Eingabestrom,
       ; bis das Trennzeichen gefunden wurde oder der Puffer leer ist.
;------------------------------------------------------------------------------
  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_visible, "interpret"
interpret: ; Interpretiert einen String - mit Konstantenfaltung
;------------------------------------------------------------------------------
  push r10
  push r11
  ; Stack leer. Zumindest für das, was interpret tut.

interpret_weitermachen:
  ;------------------------------------------------------------------------------
  ; Prüfe, ob die Stackgrenzen eingehalten werden.
  ; Unter- und Überläufe des Stacks sollten hier abgefangen werden.

  ; Datenstack.
  cmp #datenstackanfang+2, r4
  jlo + ; Stacks fangen oben an und wachsen nach unten.
        ; Wenn die Adresse kleiner oder gleich der Anfangsadresse ist, ist alles okay.
  writeln " Stack underflow"
  jmp quit

+ cmp #datenstackende, r4
  jhs + ; Solange der Stackzeiger oberhalb des Endes liegt, ist alles okay.
  writeln " Stack overflow"
  jmp quit

+ ; Stack ok.
  ;------------------------------------------------------------------------------

  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.
    ; 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.

  ; 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
  call #wortsuche          ; Die Wortsuche prüft, ob das Token im Dictionary vorkommt.
  ; ( 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:
  ; 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.
  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
  bit @r4+, -2(r4) ; Ergebnis prüfen.
  jnz interpret_weitermachen

  pushda r10
  call #schreibestringmitlaenge
  writeln " is unknown."
  jmp quit

  ;------------------------------------------------------------
interpret_token: ; Das Wort wurde gefunden. Entscheide, was zu tun ist.
  ; ( Adresse Flags ) von der Wortsuche.
  ; Hole die Flags des Wortes zur genaueren Untersuchung.
  popda r10

  tst &state
  jne interpret_kompilierzustand

  and #30h, r10
  cmp #30h, r10
  jne +
    pushda #Eingabepuffer
    call #schreibestringmitlaenge
    writeln " is compile-only"
    jmp quit

+ ; Execute ! Im Execute-Modus wird es gleich ausgeführt, keine Konstanten sammeln !
  clr &Konstantenfaltungszeiger
  call @r4+
  jmp interpret_weitermachen

  ;------------------------------------------------------------
interpret_kompilierzustand:
  ; Wir sind im Kompiliermodus. Hier gibt es viele Fällt und Optimierungen zu beachten.
  ; ( Einsprungadresse )  Flags in r10
  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_foldable, 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:
    pop r10
    call r10  ; Nicht mit call @sp+ versuchen, echter Chip stürzt ab.
    jmp interpret_weitermachen


interpret_unoptimierbar:
    ; Erstmal keine Optimierungen berücksichtigen.
    call #interpret_konstantenschreiben
  r_from
;------------------------------------------------------------

interpret_klassisch_kompilieren:  ; ( Einsprungadresse ), Flags in r10
  push #interpret_weitermachen    ; Rücksprungadresse für das Ret in den jeweiligen Möglichkeiten
  bit #Flag_immediate, r10
  jnc interpret_einkompilieren
  br @r4+

interpret_einkompilieren:
  bit #Flag_inline, r10
  jc inlinekomma
  jmp callkomma

;------------------------------------------------------------
; 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 !

  ; 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 ++
    ;------------------------------------------------------------------------------
    ; Rechenlogik

    cmp #1, r11 ; Nur bei genau einer Konstanten optimieren. Sonst habe ich 2 oder mehr Konstanten --> Falten !
    je +
      pop r12   ; Opcode brauche ich nicht
      jmp interpret_faltoptimierung
+   ; Rechenlogik - tatsächlich opcodieren !
    call #inline_at_r4_plus
    jmp interpret_opcodierbar_fertig
+   ; Rechenlogik abgeschlossen


- 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 -

    cmp #4, r10
    jne +
      ;------------------------------------------------------------------------------
      ; Hier wird nun in die ganz besonderen Wörter eingesprungen, die keine eigene Regel im Interpreter haben.
      ; Beispiele: = <> bit@ cbit@  All die bunt schillernden Sonderdinge !
      ; In r12 ist die Adresse des Opcodierfalles. Habe die Register r10, r12 und nach dem Konstantenschreiben auch r11 zur Verfügung.

      call r12 ; Einspringen, und dort entscheiden, was passieren soll.
      jmp interpret_opcodierbar_fertig
      ; Wird nur aufgerufen, wenn es mindestens 1 Konstante gibt.
      ; Wird standardmäßig übergefaltet. Wenn das nicht passieren soll, muss ich darin nochmal dran denken.
+

  ; r12 enthält Adresse des Opcodes.
  mov @r12, r12 ; Hole den Opcode.

  cmp #2, r10
  jne interpret_opcodierbar_speicherlesen
    ;------------------------------------------------------------------------------
    ; Speicher schreiben

    ; Betrachte die zwei Fälle: Genau eine Konstante und mindestens zwei Konstanten.
    cmp #1, r11
    je +
      ; Mindestens zwei Konstanten:
      call #swap_sprung ; swap ; Schreibe den Befehl !
      call #pushda_r12_konstantenopcodierer ; Opcode und Konstante einfügen, letztere liegt noch auf dem Datenstack
      call #komma ; Adresse an den Befehl anfügen
      jmp interpret_opcodierbar_fertig

    ; Schreibe bei genau einer Konstanten:
    ; Opcode, bei Bytebefehlen verändert
    ; Adresse
    ; Bei Bytebefehlen zusätzlich: incd r4

+   ; Genau eine Konstante:
    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 ; Opcode auf den Datenstack legen
    ; ( Adresse für Ziel  Opcode )
    call #doppelkomma

    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 !
      ; Byte-Einkonstanten-Speicherschreiben
      ifdef caseeinbinden
        call #dropkomma
      else
        pushda #05324h ; Opcode für incd r4 = add #2, r4 anhängen
        call #komma
      endif
+   ; Okay.
    jmp interpret_opcodierbar_fertig

interpret_opcodierbar_speicherlesen:
  ; Es gibt nur diese drei festcodierten Fälle, also erübrigt sich hier eine Probe.
    ;------------------------------------------------------------------------------
    ; Benötige genau eine Konstante, Habe 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.

    pushdadouble r12, #8324h  ; decd r4
    call #doppelkomma         ; Opcode aus r12
    pushdadouble #0, r10      ; Adresse
    call #doppelkomma         ; Die Null in 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 !
      ; Byte-Einkonstanten-Speicherlesen
      pushdadouble #0001h, #43c4h ; Opcode für clr.b 1(r4) $43c4 $0001
      call #doppelkomma
+   ; Okay.

interpret_opcodierbar_fertig:
    pop r12
    incd sp ; Einsprungadresse runterwerfen
    jmp interpret_weitermachen


;------------------------------------------------------------------------------
interpret_konstantenschreiben: ; Schreibe die Konstanten auf dem Datenstack.
                               ; Niemals rausführen ! Spezielle Registerabhängigkeiten !!
  ; r11 Anzahl der zu schreibenden Konstanten, auch Null ist ok.
  ; konstantenfaltungszeiger stets gesetzt !
;------------------------------------------------------------------------------
  rla r11
  jz +     ; Bei Null zu schreibenden Konstanten ausspringen.

  pushdadouble r11, #08034h ; sub #Konstante, r4
  call #konstantenopcodierer

  push r12 ; r12 muss gesichert werden, weil die Opcodierfälle den Inhalt noch brauchen.
  clr r12

- call #mov_konstantenopcodierer
  pushda r12
  incd r12
  call #komma ; Index in den Datenstack an Opcode anhängen
  cmp r12, r11
  jne -

  pop r12

+ ; Die neue Variante setzt r4 quasi nebenbei von selbst zurück.
  ; Hier wird jedesmal der Konstantenfaltungszeiger gelöscht. Denn nun geschehen Dinge, die nicht faltbar sind.
  clr &konstantenfaltungszeiger
  ret


;------------------------------------------------------------------------------
inline_at_r4_plus: ; Fügt eine Routine inline ein und faltet Konstanten in die darin enthaltenen @r4+-Opcodes.
;------------------------------------------------------------------------------
  ; r10: Wird verändert
  ; r11: Zahl der vorhandenen Faltungskonstanten
  ; r12: Adresse der einzufügenden Routine

- mov @r12+, r10     ; Inhalt in r12 holen
  cmp #4130h, r10    ; Ret-Opcode ?
  je interpret_konstantenschreiben ; Wenn ja, fertig. --> Konstantenschreiben !

  ; Prüfe nun, ob es ein @r4+-Opcode ist !
  pushda r10 ; Schonmal bereitlegen, denn die Probe verändert den Opcode sehr

  and #00F70h, r10  ; Quelle und Quellregister maskieren
  cmp #00430h, r10  ; und prüfen
  jne +

  ; Habe ich noch genug Konstanten ?
  tst r11
  jz +
    dec r11 ; Eine Konstante weniger in der Faltung
    ; Umschalten auf @pc+
    bic #00400h, @r4  ; Umschalten von @r4+ auf @pc+
    call #konstantenopcodierer
    jmp -

+ call #komma
  jmp -

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "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.

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

