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


; Die Routinen, die nötig sind, um neue Definitionen zu kompilieren.

;------------------------------------------------------------------------------
; --- Dictionary erweitern ---
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
nullprobekomma: ; Schreibt eine Nullprobe ins Dictionary
;------------------------------------------------------------------------------
  pushdadouble #0FFFEh, #0B4B4h   ; Opcode für bit @r4+, -2(r4), Benötigt einen Takt weniger als and, da Ergebnis nicht geschrieben wird.
                                  ; also oberstes Stackelement auf Null prüfen und entfernen.
;------------------------------------------------------------------------------
doppelkomma: ; Fügt zwei Words an das Dictionary an.
  call #komma
  jmp komma

;------------------------------------------------------------------------------
nullkomma: ; Füge eine Null an das Dictionary an.
  pushda #0
  jmp komma

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, ","
komma: ; ( n -- ) Fügt ein Word an das Dictionary an.
;------------------------------------------------------------------------------

  ifdef flashdictionaryeinbinden
    cmp #nBacklinkgrenze, &DictionaryPointer
    jhs +
  endif

    ; Für Ram
      mov &DictionaryPointer, r7
      mov @r4+, @r7

  ifdef flashdictionaryeinbinden
      jmp ++
+   ; Für Flash
      pushda &DictionaryPointer
      call #flashstore
+ endif

zwei_allot:
  pushda #2
  jmp allot

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "c,"
ckomma: ; ( c -- ) Fügt ein Byte an das Dictionary an.
;------------------------------------------------------------------------------
  ifdef flashdictionaryeinbinden
    cmp #nBacklinkgrenze, &DictionaryPointer
    jhs +
  endif

    ; Für Ram
      mov &DictionaryPointer, r7
      mov.b @r4, @r7
      incd r4

  ifdef flashdictionaryeinbinden
      jmp ++
+   ; Für Flash
      pushda &DictionaryPointer
      call #flashCstore
+ endif

  pushda #1
  jmp allot

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "align,"
kommagrade: ; Macht den Dictionarypointer mit den Hinzufügen
            ; einer Null wieder gerade.
;------------------------------------------------------------------------------
  bit #1, &DictionaryPointer
  jnc +
  pushda #0
  jmp ckomma
+ ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate|Flag_foldable_0, "[char]" ; ( -- )
    ; Holt ein Zeichen aus dem Eingabestrom und fügt es als Literal ein.
;------------------------------------------------------------------------------
  jmp holechar

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "char" ; Holt ein Zeichen aus dem Eingabestrom
holechar: ; ( -- Zeichen )
;------------------------------------------------------------------------------
  call #token ; Gibt Stringadresse zurück
  inc @r4     ; Pointer um eine Stelle auf das erste Zeichen im String weiterschieben.
  br #c_fetch ; Zeichen holen

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "string,"
kommastring: ; ( Stringadresse -- )
             ; Fügt einen String an das Dictionary an und macht den Zeiger gerade.
;------------------------------------------------------------------------------
  push r10
  push r11
  mov   @r4+, r10  ; Stringadresse holen
  mov.b @r10, r11  ; Längenbyte des Strings

  inc r11          ; Einen mehr, weil das Längenbyte auch ein Byte lang ist

  ; Schreibe nun r11 Bytes in das Dictionary.
- decd r4
  mov.b @r10+, @r4 ; Byte holen
  call #ckomma
  dec r11
  jnz -

  pop r11
  pop r10

  jmp kommagrade

;------------------------------------------------------------------------------
pushda_r12_konstantenopcodierer:
  pushda r12
  jmp +
;------------------------------------------------------------------------------
mov_konstantenopcodierer: ; ( Zahl )  Fügt Mov-Opcode an.
  pushda #40B4h ; mov #Konstante, ...(r4)
;------------------------------------------------------------------------------
konstantenopcodierer: ; ( Zahl Opcode )
                      ; Nimmt einen Opcode entgegen, der eine Quellkonstante trägt.
                      ; Kann entweder direkt geschrieben werden, oder wird
                      ; durch den Konstantengenerator abgekürzt.
;------------------------------------------------------------------------------
+ push r10

  mov @r4, r7 ; Hole den Opcode
  bic #0F30h, r7 ; Wirf die Quelladressierung, die auf @pc+ steht, hinaus !

  mov 2(r4), r10  ; Hole die kommende Zahl

  cmp #0, r10
  jne +
  bis #0300h, r7
  jmp literalkomma_opcodieren

+ cmp #1, r10
  jne +
  bis #0310h, r7
  jmp literalkomma_opcodieren

+ cmp #2, r10
  jne +
  bis #0320h, r7
  jmp literalkomma_opcodieren

+ cmp #-1, r10
  jne +
- bis #0330h, r7
  jmp literalkomma_opcodieren

+ cmp #255, r10
  jne +
  bit #ByteOpcodeBit, r7 ; Prüfe, ob das ein Bytebefehl ist. Dann kann ich auch 255 via -1 opcodieren.
  jc -

+ cmp #4, r10
  jne +
  bis #0220h, r7
  jmp literalkomma_opcodieren

+ cmp #8, r10
  jne +
  bis #0230h, r7
literalkomma_opcodieren:
  ; ( Zahl Opcode )
  drop
  ; ( Zahl )
  mov r7, @r4
  ; ( Opcode* )
  jmp ++

+ ; Wenn ich hier ankomme, muss die Konstante ganz regulär behandelt werden.
  call #komma   ; Mov-Opcode regulär
+ pop r10
  jmp komma   ; Zahl oder Mov-Konstantengenerator-Opcode einkompilieren


;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "literal,"
literalkomma: ; ( n -- ) Kompiliert eine Zahl ins Dictionary
;------------------------------------------------------------------------------
  push r11
  mov #1, r11
- call #interpret_konstantenschreiben
  pop r11
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "2literal,"
dliteralkomma: ; ( d -- ) Kompiliert zwei Zahlen ins Dictionary
               ; ( n2 n1 -- ) und braucht dafür etwas weniger Platz
               ; da die Aktualisierung des Stackpointers nur einmal erfolgt.
;------------------------------------------------------------------------------
  push r11
  mov #2, r11
  jmp -

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "inline,"
inlinekomma: ; ( Einsprungadresse -- ) Bruder von "call,"
             ; Hängt die Routine, die an der Einsprungadresse steht,
             ; bis zum ersten Auftreten des ret-Opcodes an das Dictionary an.
             ; inlinekomma sucht bis zum retopcode und schreibt die Routine einfach binär um.
             ; Da es sich um position independent code handelt, ist das möglich. Alle Sprünge sind relativ;
             ; call-Einsprünge bleiben im Dictionary an ihrer alten Position.
             ; Einzige Einschränkungen: Innere Aussprünge (mehrere ret), oder retopcodes als Strings oder Literals.
             ; Da inline aber nur für die allerkürzesten Routinen verwendet wird, sollte das kein Problem darstellen.
;------------------------------------------------------------------------------
  ; Auf dem Stack ist die Adresse des Codes, der bis zum ersten ret übernommen werden soll.
  push r10
  popda r10 ; Codeadresse

- mov @r10+, r7  ; Inhalt in r7  holen
  cmp #4130h, r7  ; Ret-Opcode ?
  je +            ; Wenn ja, fertig.

  pushda r7 
  call #komma
  jmp -

+ ; Ret wurde gefunden. Fertig !
  pop r10
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "call,"
callkomma:    ; ( n -- ) Kompiliert einen Subroutinenaufruf ins Dictionary
              ;          mit dem call-Code
;------------------------------------------------------------------------------
  pushda #12B0h ; Code für call #Adresse
  jmp doppelkomma ; und Adresse einkompilieren

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "ret,"
retkomma:    ; Kompiliert einen Rücksprungbefehl ins Dictionary
;------------------------------------------------------------------------------
  pushda #4130h ; Code für ret = mov @r1+, r0
  jmp komma

;------------------------------------------------------------------------------
;  Wortbirne Flag_visible, "latest" ; ( -- Fadenende  ) liefert den Anfang des zuletzt definierten Wortes zurück
;------------------------------------------------------------------------------
;  pushda &Fadenende ; Nicht mehr herausgeführt, wird eigentlich nur intern benutzt.
;  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "here" ; Liefert den aktuellen Zeiger ins Dictionary
;------------------------------------------------------------------------------
  pushda &DictionaryPointer
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "allot" ; Erhöht den Dictionaryzeiger, schafft Platz !
allot:  ; Überprüft auch gleich, ob ich mich noch im Ram befinde.
        ; Ansonsten verweigtert Allot seinen Dienst.
;------------------------------------------------------------------------------
  mov &DictionaryPointer, r7 
  add @r4+, r7 

  ifdef flashdictionaryeinbinden

  cmp #nBacklinkgrenze, &DictionaryPointer
  jhs +

  ifdef ramverwaltungeinbinden
    cmp &VariablenPointer, r7 
  else
    cmp #nRamDictionaryEnde, r7 
  endif
  jlo ++  ; Solange der DictionaryPointer innerhalb des RAMs ist, ist alles okay.
          ; Oder außerhalb des Variablenbereichs
  writeln " Ram full"
  jmp quit

+ cmp #nFlashDictionaryEnde, r7 
  jlo +  ; Solange der DictionaryPointer innerhalb des RAMs ist, ist alles okay.
  writeln " Flash full"
  jmp quit

  else

  cmp #nRamDictionaryEnde, r7 
  jlo +  ; Solange der DictionaryPointer innerhalb des RAMs ist, ist alles okay.
  writeln " Ram full"
  jmp quit

  endif

+ mov r7, &DictionaryPointer
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "create"
create: ; Nimmt das nächste Token aus dem Puffer,
        ; erstellt einen neuen Kopf im Dictionary und verlinkt ihn.
;------------------------------------------------------------------------------
  call #token  ; Hole den Namen der neuen Definition.
  ; ( Tokenadresse )

  ; Überprüfe, ob der Token leer ist.
  ; Das passiert, wenn der Eingabepuffer nach create leer ist.

  mov   @r4, r7
  mov.b @r7, r7
  tst r7
  jne +

    ; Token ist leer. Brauche Stacks nicht zu putzen.
    writeln " Create needs name !"
    jmp quit

+ ; Tokenname ist okay.
  ; Prüfe, ob er schon existiert.

  ; ( Tokenadresse )
  dup
  ; ( Tokenadresse Tokenadresse )
  call #wortsuche
  ; ( Tokenadresse Einsprungadresse Flags )
  drop ; Benötige die Flags hier nicht. Möchte doch nur schauen, ob es das Wort schon gibt.
  ; ( Tokenadresse Einsprungadresse )
  popda r7
  ; ( Tokenadresse )
  tst r7 ; Prüfe, ob die Suche erfolgreich gewesen ist.
  je +

    write "Redefine "
    dup          ; ( Tokenadresse Tokenadresse )
    call #schreibestringmitlaenge   ; Den neuen Tokennamen nochmal ausgeben
    writeln "."

+ ; ( Tokenadresse )

  call #kommagrade ; Damit ein ungerader Dictionarypointer kein Chaos mehr verursacht.
  push &DictionaryPointer

  pushda #Flag_invisible  ; $FF
  call #ckomma            ; Im Flash wird NIE $FF geschrieben - und im RAM ist das kein Problem.

  ifdef flashdictionaryeinbinden
    mov #Flag_visible, &FlashFlags   ; Für Flash
  endif

  ; Stattdessen ist der String schon im Stack.
  call #kommastring

  ifdef flashdictionaryeinbinden ; Hier wird entschieden, ob Links oder Backlinks geschrieben werden.

  cmp #nBacklinkgrenze, &DictionaryPointer
  jhs +
    ; Für RAM - Links
    pushda &FadenEnde
    call #komma
    jmp ++

+   ; Für Flash - Backlinks

  ; Hier wird nun der Backlink gesetzt/vorbereitet.
  call #zwei_allot ; 2 Bytes Platz für den Backlink einplanen.

  ; Backlink im letzten Wort in die Lücke setzen:
  ; Dies ist eine Berechnung der Adresse des Backlinkfeldes des letzten Wortes.
    call #Fadenende_Einsprungadresse   ; Aus dem letzten Fadenende bestimme ich durch Überlesen des Namens und der Links die Einsprungadresse
    popda r7                ; die hole ich mir wieder
    decd r7                 ; und weiß, dass 2 Bytes davor der Backlink liegt.
    cmp #0FFFFh, @r7        ; Ist der Backlink ungesetzt ?
    jne +                    ; Wenn ja,
      pushdadouble @sp, r7    ; so wird das aktuelle Fadenende, das eben erschaffen wurde dort eingesetzt.
      call #flashstore         ; ehemals mov @sp, @r7
+

  else ; Falls nur ins Ram kompiliert wird
    pushda &FadenEnde
    call #komma
  endif

  pop &FadenEnde ; Der vorhin gesicherte Dictionarypointer ist das neue Fadenende.
  ret

  ifdef flashdictionaryeinbinden

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "compiletoram" ; Ändert das Schreibziel !
compiletoram:
;------------------------------------------------------------------------------
  cmp #nBacklinkgrenze, &DictionaryPointer
  jlo +

  call #zweitpointertausch ; Tauscht die Pointer

  ifdef ramverwaltungeinbinden
    cmp &VariablenPointer, &DictionaryPointer
    jlo +
   writeln " Variables collide with dictionary"
  endif

+ ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "compiletoflash" ; Ändert das Schreibziel !
compiletoflash:
;------------------------------------------------------------------------------
  cmp #nBacklinkgrenze, &DictionaryPointer
  jhs +

zweitpointertausch: ; Kleines Helferlein, das Pointerpaare vertauscht.
  ; Tausche die Pointer aus
  mov &DictionaryPointer, r7
  mov &ZweitDictionaryPointer, &DictionaryPointer
  mov r7, &ZweitDictionaryPointer

  mov &FadenEnde, r7
  mov &ZweitFadenEnde, &FadenEnde
  mov r7, &ZweitFadenEnde

+ ret

  endif ; flashdictionaryeinbinden

;------------------------------------------------------------------------------
; --- Links & Flags ---
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
Fadenende_Einsprungadresse: ; ( Fadenende -- Einsprungadresse )
                ; Ermittelt aus einem Fadenende eine Einsprungadresse
;------------------------------------------------------------------------------
  pushda &Fadenende
  inc @r4                  ; Flags
  call #stringueberlesen   ; Name
  incd @r4                 ; Link  überlesen
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "smudge"
smudge: ; Macht das zuletzt geschaffene Wort sichtbar
; Wird von dodoes, ;, constant und variable benutzt.
; Neuigkeiten:
; Smudge brennt die Flags, die in FlashFlags gesammelt worden sind.
; Auf diese Weise kann ich alles mit nur einem Schreibzugriff erledigen,
; habe als Kehrseite aber nicht mehr die Möglichkeit, immediate NACH dem
; gerade definierten Wort aufzurufen, sondern muss das innendrin tun.
;------------------------------------------------------------------------------
  ; Smudge muss am Ende im Ram einfach nur dafür sorgen, dass das Wort sichtbar wird.
  ; Im Flash muss Smudge das Ende auf $FFFF prüfen, gegebebenfalls eine Null anhängen
  ; und die gesammelten Flags brennen.

  ifdef flashdictionaryeinbinden

    cmp #nBacklinkgrenze, &DictionaryPointer
    jhs smudge_flash

    ; Im Ram ist nicht viel zu tun !
    mov #Flag_visible, r7
    jmp flagsetzer

smudge_flash:
    ; Im Flash ist mehr Arbeit vor uns.
    ; Prüfe, ob am Ende des Wortes ein $FFFF steht. Das darf nicht sein !
    ; Es würde als freie Stelle erkannt und später überschrieben werden.
    ; Deshalb wird in diesem Fall hier am Ende eine 0 ans Dictionary angehängt.

    mov &DictionaryPointer, r7
    cmp #-1, -2(r7) ; Denn der Dictionarypointer zeigt auf die nächste freie Stelle !
    jne +
    call #nullkomma  ; pushda #0  Spart einfach ein bisschen Platz
                     ; call #komma
+   ; Habe nun das Ende auf jeden Fall sauber abgeschlossen.

    ; Setze die Flags.
    push &DictionaryPointer
    mov &FadenEnde, &DictionaryPointer
    pushda &FlashFlags
    call #ckomma
    pop &DictionaryPointer
    ret

  else ; flashdictionaryeinbinden - Nur die Routine für Ram

    mov #Flag_visible, r7
    jmp flagsetzer

  endif

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate, "inline"
; inline: ; Macht das zuletzt geschaffene Wort inline
; Wird vom Assembler nie aufgerufen
; Vorsicht, Neuerung: Für das Flash-Dictionary
;  musste ich dies immediate machen, und es muss INNERHALB
;  des zu beeinflussenden Wortes aufgerufen werden !
;------------------------------------------------------------------------------
  mov #Flag_inline, r7
  jmp flagsetzer

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate, "immediate"
; immediate: ; Macht das zuletzt geschaffene Wort immediate
; Wird vom Assembler nie aufgerufen
; Vorsicht, Neuerung: Für das Flash-Dictionary
;  musste ich dies immediate machen, und es muss INNERHALB
;  des zu beeinflussenden Wortes aufgerufen werden !
;------------------------------------------------------------------------------
  mov #Flag_immediate, r7
  jmp flagsetzer ; Läuft direkt hinein.

;------------------------------------------------------------------------------
setze_faltbarflag: ; Markiert Wort als 0-Faltbar.
  mov #Flag_foldable, r7
  jmp flagsetzer

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "setflags"
  popda r7

flagsetzer: ; Hilft bei den Flags und ihrem Setzen.
            ; Ist nicht herausgeführt, spart aber Platz.
            ; Erwartet Einsprung mit jmp/br, Flagmuster in r10, vorher gesichert.
;------------------------------------------------------------------------------
  ifdef flashdictionaryeinbinden
    cmp #nBacklinkgrenze, &DictionaryPointer
    jhs flagsetzer_flash
  endif

  push r11
  mov &Fadenende, r11
  cmp.b #-1, @r11
  jne +
  mov.b r7 , @r11
  jmp ++
+ bis.b r7 , @r11
+ pop r11

  ifdef flashdictionaryeinbinden
    jmp flagsetzer_fertig
flagsetzer_flash:
    bis.b r7 , &FlashFlags
flagsetzer_fertig:
  endif

  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "find"
Wortsuche: ; ( Addr -- Einsprungadresse Flags )
           ; Nimmt die Adresse von einem String entgegen
           ; und prüft, ob der String im Wörterbuch gefunden wird.
           ; Die Adresse kann direkt angesprungen werden, falls gefunden wurde,
           ; ansonsten enthält sie eine Null, wenn das Wörterbuch
           ; erfolglos durchsucht wurde.

           ; Liefert aus Gründen der Nützlichkeit auch gleich
           ; die Flags des gefundenen Wortes mit.
;------------------------------------------------------------------------------
  ; ( String -- )
  push r10  ; Hangelpointer
  push r11  ; Flags
  push r12  ; Zieladresse
  push r13  ; Zielflags
  push r14  ; Zwischenspeicher für die Namensadresse

  ifdef flashdictionaryeinbinden
  cmp #nBacklinkgrenze, &DictionaryPointer
  jhs +
  ; Fürs Ram:
    mov &Fadenende, r10
    jmp ++
+ ; Für den Flash
    mov #CoreDictionaryAnfang, r10
+
  else
    mov &Fadenende, r10
  endif

  clr r12   ; Noch keinen Treffer
  clr r13   ; Und noch keine Trefferflags

  ; Auf dem Datenstack die ganze Zeit ( Stringadresse -- )

  ; Aufbau: Flags     Namenslänge
  ;         Name...   0
  ;         Link (zum Nachbarwort - nach vorn oder nach hinten ist egal)
  ;         Code

-
  ifdef flashdictionaryeinbinden
    ; Ist an der Stelle der Flags und der Namenslänge $FFFF ? Dann ist der Faden abgelaufen.
    cmp #0FFFFh, @r10
    je ++ ; Sprung ans Ende
  endif

  ; Habe einen Dictionaryeintrag gefunden !
  mov.b @r10+, r11 ; Flags merken
  mov r10, r14 ; Namensadresse für den eventuellen Vergleich vormerken.
  call #stringueberlesen_r10 ; Zeiger auf Linkfeld vorrücken.
  ; ( Stringadresse )

  ; Prüfe Sichtbarkeit. Unsichtbar -->                  Stringüberlesen, Weiterhangeln.     Brauche r11 dann nicht mehr.
  ;                       Sichtbar --> Stringvergleich, Stringüberlesen, Treffer markieren.

  ; Prüfe Sichtbarkeit:
  cmp.b #-1, r11 ; Im Falle von $FF Unsichtbarkeit vermerken.
  jc + ; Weiterhangeln.

  ; Mache den Stringvergleich nur bei sichtbaren Wörtern.
    dup ; Bereit machen zum Stringvergleich
    ; ( Stringadresse Stringadresse )
    pushda r14
    ; ( Stringadresse Stringadresse AktuellerName )
    call #flagstringvergleich
    bit @r4+, -2(r4)
    jz +

    ; Treffer:
    mov r10, r12 ; Adresse vermerken
    incd r12     ; Und den Linkfeld-Zeiger zum Code inkrementieren.
    mov r11, r13 ; Flags vermerken
    ; Jetzt kommt die Probe: Backlinks oder nicht ?
    ; Entweder fertig - oder weiterhangeln.

    ifdef flashdictionaryeinbinden
      cmp #nBacklinkgrenze, r12 ; Backlinks kann ich anhand der Adresse erkennen.
      jlo ++  ; Wenn (im Ram) keine Backlinks vorliegen, bin ich fertig.
    else
      jmp ++ ; Bei normalen Links immer beim ersten Treffer fertig.
    endif

+ ; Weiterhangeln

  ; Prüfe, ob der Link schmackhaft und gut ist.
  cmp #0FFFFh, @r10  ; -1 markiert Ende
  je +

  ; Folge dem Link
  mov @r10, r10
  jmp -

+ ; Ende
  mov r12, @r4 ; Aur dem Datenstack liegt noch die Stringadresse - Kann sie nun ersetzen.
  pushda r13   ; Die Flags des Treffers schreiben

  pop r14
  br #ende_pop_13_10

;------------------------------------------------------------------------------
; --- Compiler ---
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_inline, "execute" ; Führt aus, worauf der Datenstack zeigt.
;------------------------------------------------------------------------------
  call @r4+
- ret

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly, "recurse" ; Für Rekursion. Führt das gerade frische Wort aus.
;------------------------------------------------------------------------------
  call #Fadenende_Einsprungadresse
  jmp callkomma

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate|Flag_foldable_0, "[']" ; Sucht das nächste Wort im Eingabestrom
;------------------------------------------------------------------------------
  jmp tick ; So sah das mal aus: ['] ' immediate 0-foldable ;

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "'" ; Sucht das nächste Wort im Eingabestrom
tick: ; ( -- Adresse )
;------------------------------------------------------------------------------
  call #token
  ; ( Pufferadresse )
  call #wortsuche
  ; ( Einsprungadresse Flags )
  drop
  ; ( Einsprungadresse )
  tst @r4
  jne - ; ret

- mov #Eingabepuffer, @r4 ; Ehemals Stringpuffer
  call #schreibestringmitlaenge
  writeln " not found."
  br #quit

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate, "postpone" ; Sucht das nächste Wort im Eingabestrom
                                                ; und fügt es auf besondere Weise ein.
;------------------------------------------------------------------------------
  call #token
  ; ( Pufferadresse )
  call #wortsuche
  ; ( Einsprungadresse Flags )
    tst 2(r4)
    je -  ; Benutze Fehlermeldung aus tick.

  bit #010h, @r4
  jnc +
  ; Immediate
    drop
    jmp callkomma  ; Ok.

+ bit #020h, @r4
  jnc +
  ; Inline
    drop                  ; ( Einsprungadresse )
    call #literalkomma    ; Einsprungadresse als Konstante einkompilieren
    pushda #inlinekomma   ; Inline-Einfügung
    jmp callkomma         ; zum Aufruf bereitlegen

+ ; Normal
    drop
    call #literalkomma
    pushda #callkomma
    jmp callkomma

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_inline, "does>"
does: ; Fügt dem gerade erstellten Wort eine besondere Aufgabe hinzu.
;------------------------------------------------------------------------------
    ; An die Stelle, wo does> aufgerufen wird, wird ein Sprung in dodoes eingefügt
    ; und gleich dahinter inline ein R> um die Parameteradresse aus dem Einsprung
    ; auf den Datenstack zu legen. Dieser Teil wird nur ein einziges Mal beim
    ; Eincompilieren eines neuen Defining-Wortes angesprungen.
    call #dodoes
    r_from         ; Dies ergibt das inline >R im Wort.
  ret ; Ganz wichtig, da does> jetzt inline ist !

dodoes:
  ; Ich habe nun ein Wort vorbereitet, das alle möglichen Daten enthalten kann.
  ; Die Definition ist fertig und abgeschlossen, nur die Call-Adresse fehlt noch.

  ; Doch wohin soll das call springen ? Auf den Teil, der nach does> kommt.
  ; Den kann ich über die Rücksprungadresse finden.
  ; Da does> der Ausführung ein Ende setzt, nehme ich die Rücksprungadresse,
  ; die in das Call eingefügt wird komplett vom Stack.
  ; Das hat in etwa die Wirkung, als würde das Wort, was does> aufgerufen hat
  ; selbst ein ret ausführen.

  ; Gucke mal in den Stack:
  ; ( Rücksprung-des-Wortes-das-does>-aufgerufen-hat  Rücksprungadresse-von-does>-selbst )

  push &DictionaryPointer
  ; ( Rücksprung-des-Wortes-das-does>-aufgerufen-hat  Rücksprungadresse-von-does>-selbst AlterDictionaryPointer )
  ; Hole die Adresse, an die die Call-Adresse eingefügt werden soll:
  call #Fadenende_Einsprungadresse   ; Das aktuelle Wort soll den does>-Teil-Call bekommen. Berechne aus dem Fadenende die Einsprungstelle
  mov @r4, &DictionaryPointer ; An dieser Stelle soll der Call-Befehl eingefügt werden !
  mov 2(sp), @r4 ; Zieladresse für den Call-Befehl auf den Datenstack legen
  call #callkomma ; Call-Befehl mit Zieladresse einschreiben
  pop &DictionaryPointer
  ; ( Rücksprung-des-Wortes-das-does>-aufgerufen-hat  Rücksprungadresse-von-does>-selbst)
  incd sp ; Rücksprungadresse-von-does>-selbst vom Returnstack schmeißen
  ; ( Rücksprung-des-Wortes-das-does>-aufgerufen-hat )
  jmp smudge ; Markiere das neue Wort als Ausführbereit

  ; Das Call, dessen Adresse nachträglich eingefügt wurde, kehrt übringens nie zurück.
  ; Die Rücksprungadresse wird als Zeiger auf das Parameterfeld eines tatsächlich definierten Wortes
  ; verwendet und dort inline vom Returnstack auf den Datenstack geschoben.
  ; Das ret am Ende der Routine nach does> durchspringt ebenfalls eine Ebene.

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "<builds"
builds: ; Beginnt ein Defining-Wort.
        ; Dazu lege ich ein neues Wort an, lasse eine Lücke für den Call-Befehl
        ; Keine Strukturkennung
;------------------------------------------------------------------------------
  call #create  ; Neues Wort wird erzeugt
  pushda #4 ; Hier kommt ein Call-Befehl hinein, aber ich weiß die Adresse noch nicht.
  jmp allot ; Lasse also eine passende Lücke frei !

;------------------------------------------------------------------------------
  Wortbirne Flag_visible|Flag_foldable_0, "state"
;------------------------------------------------------------------------------
  pushda #state
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "]" ; In den Compile-Modus übergehen
  mov #-1, &state ; true-Flag in State legen
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate, "[" ; In den Execute-Modus übergehen
  clr &state ; false-Flag in State legen.
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly, ";"
  ; Schließt eine Definition ab und macht sie sichtbar.
;------------------------------------------------------------------------------
  cmp r4, &Datenstacksicherung ; Prüft den Füllstand des Datenstacks.
  je +
    writeln " Stack not balanced."
    br #quit

+ clr &state ; false-Flag in State legen --> Execute-Modus
  call #retkomma
  jmp smudge

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, ":"
  ; Holt vom Eingabepuffer einen neuen Namen und eröffnet eine Colon-Definition
;------------------------------------------------------------------------------
  mov r4, &Datenstacksicherung ; Setzt den Füllstand des Datenstacks zur Probe.

  call #create    ; Wortnamen einkompilieren
  mov #-1, &state ; true-Flag in State legen --> Compile-Modus
  ret
