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

  ifdef spruengerausfuehren
;------------------------------------------------------------------------------
  Kapitelbirne_flash "--- Sprünge und Helferlein ---"   
;------------------------------------------------------------------------------ 
  endif

;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar, "nullprobe," ; Schreibt eine Nullprobe ins Dictionary
  endif
nullprobekomma:  
;------------------------------------------------------------------------------
  pushda #0F4B4h  ; Opcode für and @r4+, -2(r4), also oberstes Stackelement auf Null prüfen und entfernen.
  call #komma
  pushda #0FFFEh
  br #komma
    
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar, "sprungoffset" ; Berechnet den Offset für einen relativen Sprung.
  endif
sprungoffset: ; ( Adresse-für-Sprungbefehl Sprungziel -- Sprungoffset)
;------------------------------------------------------------------------------

  push r10       ; Das war mal: swap  minus  decd @r4  mov @r4, r10
  mov @r4+, r10
  sub @r4, r10   ; Differenz aus jetztiger Adresse und Sprungziel bilden
  decd r10       ; -2, da der aktuelle Befehl noch läuft.

  mov r10, @r4   ; Sichern, während die Probe arbeitet.

  ; Bits 5432 1098 7654 3210
  ;      1111 1000 0000 0001  Maske für and
  ;      0000 0000 0000 0000  Ergebnis bei Vorwärtssprung
  ;      1111 1000 0000 0000  Ergebnis bei Rückwärtssprung.
  ; Andere Ergebnisse deuten auf Fehler hin.

  ; Probe der Sprungdistanz ! Prüfe auch gleich, ob es ungerade Sprungdistanzen gibt... 
  and #1111100000000001b, r10
  cmp #0000000000000000b, r10
  je + ; Wenn es gleich ist: Fertig.
  ; Ansonsten prüfe zweites Muster:
  cmp #1111100000000000b, r10
  je + ; Wenn es gleich ist: Fertig.
  ; Ansonsten ist die Sprungdistanz einfach zu groß.  
  ; writeln "Sprungdistanz zu groß."
  writeln "Jump too far"
  br #quit ; quit setzt auch die Stacks zurück, brauche das hier nicht zu tun.
    
+ ; Probe befand die Sprungdistanz für okay.  
  ; clrc  ; Dies Bit wird ins MSB geschoben und wird dort von der and-Maske eliminiert.
  rrc @r4 ; Schieben, weil 10 Bit Offset * 2    
  ;    9876543210
  and #1111111111b, @r4 ; Maske anwenden

  pop r10 
  ret

   
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar_immediate, "<--0branch" ; Abschluss bedingter Rückwärtssprung
  endif
r_nullbranch: ; ( Sprungziel -- )
;------------------------------------------------------------------------------    
  ifdef spruengerausfuehren
    call #qcomp
  endif

  call #nullprobekomma
  push r11
  mov #0010010000000000b, r11 ; Opcode für einen bedingten Sprung jz

r_branch_spezial:
  ; ( Sprungziel )
  push r10 
  
  mov @r4, r10 ; Sprungziel in r10
  mov &DictionaryPointer, @r4
  pushda r10
  ; ( Adresse-für-Sprungbefehl Sprungziel )
  call #sprungoffset
  ; ( Distanz-für-Sprungbefehl )
  bis r11, @r4 ; Sprung-Opcode hinzuverodern  
  ; ( Sprungbefehl )

  pop r10
  pop r11

  br #komma  


  ifdef spruengerausfuehren
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "0branch<--" ; Einleitung bedingter Rückwärtssprung
nullbranch_r: ; ( -- Sprungziel )
;------------------------------------------------------------------------------
;  call #qcomp                  ; : branch--> ?comp here 2allot ; immediate
;  pushda &DictionaryPointer
;  ret  
  jmp branch_r ; Identisch. Und spart so 10 Bytes :-)
  else
nullbranch_r equ branch_r
  endif
 
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar_immediate, "<--branch" ; Abschluss unbedingter Rückwärtssprung
  endif
r_branch: ; ( Sprungziel -- )
;------------------------------------------------------------------------------    
  ifdef spruengerausfuehren
    call #qcomp
  endif
  push r11
  mov #0011110000000000b, r11 ; Opcode für einen unbedingten Sprung jmp
  jmp r_branch_spezial
 
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar_immediate, "branch<--" ; Einleitung unbedingter Rückwärtssprung
  endif
branch_r: ; ( -- Sprungziel )
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    call #qcomp                  ; : branch--> ?comp here 2allot ; immediate
  endif
  pushda &DictionaryPointer
  ret  

      
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar_immediate, "-->0branch" ; Abschluss bedingter Vorwärtssprung
  endif
v_nullbranch: ; ( Adresse-für-Sprungbefehl -- )
;------------------------------------------------------------------------------    
  push r11
  mov #0010010000000000b, r11 ; ; Opcode für einen bedingten Sprung jz
  jmp branch_write_spezial
        
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar_immediate, "0branch-->" ; Einleitung bedingter Vorwärtssprung
  endif
nullbranch_v: ; ( -- Adresse-für-Sprungbefehl )
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    call #qcomp
  endif
  call #nullprobekomma       ; Nullprobe-Befehl schreiben
  jmp branch_v_spezial

;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar_immediate, "-->branch" ; Abschluss unbedingter Vorwärtssprung
  endif
v_branch: ; ( Adresse-für-Sprungbefehl -- )
;------------------------------------------------------------------------------   
  push r11
  mov #0011110000000000b, r11 ; Opcode für einen unbedingten Sprung jmp
 
branch_write_spezial:
  ifdef spruengerausfuehren
    call #qcomp
  endif
  push r10
  ; ( Adresse-für-Sprungbefehl )
  mov @r4, r10 ; Adresse für Sprungbefehl zwischenspeichern
  
  ; ( Adresse-für-Sprungbefehl )
  pushda &DictionaryPointer  
  ; ( Adresse-für-Sprungbefehl Sprungziel )
  call #sprungoffset
  ; ( Distanz-für-Sprungbefehl )
  
  bis r11, @r4 ; Sprung-Opcode hinzuverodern  
  ; ( Fertiger Sprungbefehl )

  ifdef flashdictionaryeinbinden
    push &DictionaryPointer
    mov r10, &DictionaryPointer
    call #komma
    pop &DictionaryPointer
    pop r10
    pop r11
    ret
  else ; Nur fürs Ram:
    mov @r4+, @r10  ; Befehl in den Speicher schreiben.
    pop r10
    pop r11
    ret
  endif
  
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    Wortbirne Flag_sichtbar_immediate, "branch-->" ; Einleitung unbedingter Vorwärtssprung
  endif
branch_v: ; ( -- Adresse-für-Sprungbefehl )
;------------------------------------------------------------------------------
  ifdef spruengerausfuehren
    call #qcomp                  ; : branch--> ?comp here 2allot ; immediate
  endif
branch_v_spezial:
  pushda &DictionaryPointer  ; Adresse-für-Sprungbefehl
  pushda #2                  ; Lücke lassen
  br #allot
 
  ifdef spruengerausfuehren
;------------------------------------------------------------------------------
  Kapitelbirne "--- Sprünge und Helferlein ---"   
;------------------------------------------------------------------------------  
  endif
;------------------------------------------------------------------------------
  Kapitelbirne_flash "--- Kontrollstrukturen ---"  
;------------------------------------------------------------------------------   


  ifdef flashdictionaryeinbinden
;------------------------------------------------------------------------------
;  Wortbirne Flag_sichtbar, "SucheFlashPointer" ; Versucht, den Variablenpointer wiederherzustellen.
;  Nicht von außen sichtbar, es würde wichtige Pointer zerstören.
SucheFlashPointer: ; ( -- ) Aktualisiert die Flash-Variablen
;------------------------------------------------------------------------------  

  push r10 ; Adresshangelzeiger
  push r11 ; Flags
  push r13 ; SucheFadenende...

  ifdef ramverwaltungeinbinden
    push r12 ; Belegtes Ram.
    mov #nRamDictionaryEnde, r12 ; Fürs Abzählen des Variablenplatzes
  endif

  mov #CoreDictionaryAnfang, r10 ; Hier fängt es an.
  decd r4 ; Platz auf dem Datenstack schaffen
  
  ; Die Struktur der Wörter ist so:
  ; Flags | Namenslänge  oder $FFFF
  ; Namen 
  ; Namen (|0)
  ; Link Richtung Fadenanfang
  ; Link Richtung Fadenende bzw. $FFFF falls noch nicht gesetzt
  
  ; Zwei Möglichkeiten: Vorwärtslink ist $FFFF --> Ende gefunden
  ; Oder Vorwärtslink gesetzt, aber an der Stelle liegt $FFFF. Dann ist das Ende auch da.
  ; Diese Variante tritt auf, wenn nichts hinzugetan wurde, denn im festen Teil ist der Vorwärtslink
  ; immer gesetzt und zeigt auf den Anfang des Schreib/Löschbaren Teils.
  
SucheFlashPointer_Hangelschleife:
  mov r10, r13 ; Es könnte das Fadenende sein !
  ; Hier ist r10 direkt auf das Flagfeld gerichtet.

  ifdef ramverwaltungeinbinden

    mov.b @r10+, r11 ; Hole die Flags und überlese sie !

    mov r10, @r4
    call #stringueberlesen
    mov @r4, r10

    ; Prüfe, ob die Flags FF sind. In diesem Fall ignorieren.
    cmp #0FFh, r11
    je +

    ; Prüfe, ob dieses Wort Speicherplatz belegt.
    bit #Flag_ramallot, r11
    jnc + ; Wenn nicht, bin ich fertig.
    
    ; Ja, das Wort belegt Speicher.
    and #0Fh, r11 ; Low-Nibble maskieren
    rla r11       ; mit zwei Malnehmen
    sub r11, r12  ; und den Zeiger wandern lassen.    

  ifdef 0
  ; Hier mal zu Probezwecken eine Speicherkarte schreiben:    
    push &Base
    hex
    write "  Ram-Adresse: "
    pushda r12
    call #udot
    decimal
    write " Bytes: "
    pushda r11
    call #udot   
    writeln ""
    pop &Base    
  endif
  
  ifdef initialisiereflashvariablen
    tst r11
    je + ; Bei Null Bytes brauche ich nichts zu kopieren.
    ; An dieser Stelle kann ich nun die Variablen initialisieren, wenn ich das möchte.
    push r10 ; Hangelzeiger
    push r12 ; Ram-Variablen-Pointer

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

    ; Habe nun in r10 den Zeiger auf den Initialisierungsinhalt.
    ; Kopiere ihn an die richtige Stelle ! r11 gibt Zahl der Bytes an.
-   mov.b @r10+, @r12
    inc r12
    dec r11
    jnz -

    pop r12
    pop r10
+   ; Fertig mit der Initialisierung.
  endif ; initialisiereflashvariablen

  else ; ifdef ramverwaltungeinbinden
    inc r10 ; Flags überlesen

    mov r10, @r4
    call #stringueberlesen
    mov @r4, r10
  endif
  
  cmp #0FFFFh, @r10  ; Ist der Vorwärtslink gesetzt ?
  je +
  
  mov @r10, r10
  cmp #0FFFFh, @r10  ; Ist dort etwas anderes als $FFFF ?
  je +
  
  jmp SucheFlashPointer_Hangelschleife

+ drop ; Benötige den Platz auf dem Datenstack nicht mehr.
  ifdef ramverwaltungeinbinden
    mov r12, &VariablenPointer
    pop r12
  endif
  mov r13, &Fadenende


  ; Suche jetzt gleich noch den DictionaryPointer.

  mov #nFlashDictionaryEnde, r10 ; Kann eigentlich an der Stelle DictionaryEnde etwas liegen ?  
  ; Gehe Rückwärts, bis ich aus dem $FFFF-Freigebiet in Daten komme.  
- cmp #nFlashDictionaryAnfang, r10 ; Wenn ich am Anfang angelangt bin, ist das der DictionaryPointer.
  je +

  decd r10
  cmp #0FFFFh, @r10
  je - ; Wenn es nicht gleich ist, habe ich eine Füllung gefunden.
    
  incd r10
   
+ mov r10, &DictionaryPointer

  pop r13
  pop r11
  pop r10
  ret

  endif

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar, "?pairs" ; Prüft, ob die Strukturwörter zusammengehören.
qpairs: ; ( n1 n2 -- )
;------------------------------------------------------------------------------ 
  cmp @r4+, @r4
  je +
  drop
  ;writeln "Unpassende Kontrollstrukturen !"
  writeln "Unpassende Kontrollstrukturen"
  br #quit
  
+ drop
  ret  
  
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "then"
struktur_then: ; ( -- Adresse-für-Sprung 2 | Adresse-für-Sprung 5 )
;------------------------------------------------------------------------------
  call #qcomp
  
  cmp #5, @r4 ; Kommend aus Else-Zweig
  jne + 
  
  drop        ; Paar-Kennung vom Stack werfen
  call #v_branch
  ret

+ pushda #2  ; Kommend direkt aus IF-Zweig
  call #qpairs
  br #v_nullbranch
    
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "else"
struktur_else: ; ( Adresse-für-Sprung 2 -- Adresse-für-Sprung 5 )
;------------------------------------------------------------------------------ 
  ; Else macht es ein kleines bisschen Komplizierter.
  ; Bedingung  if           [true]    else                  [false]   then      Folgendes.
  ;            0branch-->             branch--> -->0branch            -->branch
  call #qcomp  
  
  pushda #2
  call #qpairs
    
  ; ( Bedingter-Sprung )
  call #branch_v
  ; ( Bedingter-Sprung  Unbedingter-Sprung )
  to_r            ; Adresse für den unbedingten Vorwärtssprung retten
  ; ( Bedingter-Sprung )
  call #v_nullbranch   
  ; ( )
  r_from          ; und zurückholen.
  ; ( Unbedingter Sprung )
  
  pushda #5 ; Strukturerkennung
  ret
      
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "if"
struktur_if: ; ( -- Adresse-für-Sprung 2 )
;------------------------------------------------------------------------------  
  call #qcomp
  call #nullbranch_v
  pushda #2           ; Strukturerkennung
  ret  
  
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "repeat"  ; Wie das Pascal-While-Konstrukt.
struktur_repeat: ; ( Sprungziel Adresse-für-Sprung 4 -- )
;------------------------------------------------------------------------------    
  ; begin (Bedingung) while (Agenda) repeat (Folgendes).  
  ; In Pascal: while (true) do Agenda; 
  call #qcomp
  
  ; ( Sprungziel-zurück-an-Anfang Adresse-für-Sprung-ans-Ende 4 )
  
  pushda #4
  call #qpairs
  
  ; ( Sprungziel-zurück-an-Anfang  Adresse-für-Sprung-ans-Ende )  
  swap
  ; ( Adresse-für-Sprung-ans-Ende  Sprungziel-zurück-an-Anfang )  
  call #r_branch ; Rücksprung an den Anfang, falls ich normal einlaufe
  ; ( Adresse-für-Sprung-ans-Ende )
  br #v_nullbranch ; Raussprung aus dem Konstrukt.  
      
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "while"  ; Wie das Pascal-While-Konstrukt.
struktur_while: ; ( Sprungziel 1 -- )
;------------------------------------------------------------------------------    
  ; begin (Bedingung) while (Agenda) repeat (Folgendes).  
  ; In Pascal: while (true) do Agenda; 
  call #qcomp
  pushda #1
  call #qpairs
  ; ( Sprungziel ) wird für den späteren Rücksprung benutzt.
  call #struktur_if ; Benutze einfach mal If.
  ; ( Sprungziel Adresse-Für-Sprung 2 )
  add #2, @r4
  ; ( Sprungziel Adresse-Für-Sprung 4 ) ; Strukturkennung 4 !
  ret
    
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "until"  ; Bedingte Schleife 
struktur_until: ; ( Sprungziel 1 -- )
;------------------------------------------------------------------------------  
  call #qcomp
  pushda #1 
  call #qpairs  
  br #r_nullbranch
    
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "again"  ; Endlosschleife
struktur_again: ; ( Sprungziel 1 -- )
;------------------------------------------------------------------------------  
  call #qcomp
  pushda #1 
  call #qpairs  
  br #r_branch
    
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "begin"
struktur_begin: ; ( -- Sprungziel 1 )
;------------------------------------------------------------------------------  
  call #qcomp
  call #branch_r
  pushda #1       ; Strukturerkennung
  ret 

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "exit" ; Kompiliert ein ret mitten in die Definition.
;------------------------------------------------------------------------------  
  br #retkomma

  ; Die Schleifenindizies sind nur innerhalb von Schleifen erreichbar -
  ; und dort sind sie immer einkompiliert. Wage den Schritt !
  ; Jetzt sind sie inline und laufen schneller :-)

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_inline, "k" ; Kopiert den drittobersten Schleifenindex
;------------------------------------------------------------------------------
  ; Returnstack ( Limit Index Limit Index [Rücksprung] )  
  pushda 4(sp) ; Mit Rücksprung: 6(sp)
  ret  
  
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_inline, "j" ; Kopiert den zweitobersten Schleifenindex
;------------------------------------------------------------------------------
  ; Returnstack ( Limit Index [Rücksprung] )  
  pushda @sp ; Mit Rücksprung: 2(sp)
  ret  

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_inline, "i" ; Kopiert den obersten Schleifenindex
;------------------------------------------------------------------------------
  ; Returnstack ( [Rücksprung] )  
  pushda r5 ; Ist immer im Register.
  ret  

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar, "unloop" ; Wirft die Schleifenstruktur vom Returnstack
;------------------------------------------------------------------------------
  jmp unloop_extern


  ifdef leaveeinbinden
;------------------------------------------------------------------------------
  Wortbirne Flag_immediate, "leave" ; Beendet die Schleife sofort.
;------------------------------------------------------------------------------  
  pushda #unloop_extern  ; Verwerfen der Schleifenstruktur einkompilieren.
  call #callkomma
leave_spezial:
  call #branch_v ; Unbedingten Vorwärtssprung einleiten
  ; Dies gibt eine Adresse zurück.
  ; Lege sie auf den Leave-Stack.

  push r10
  mov &leavestackpointer, r10
  mov @r4+, @r10 ; Die Adresse vom Datenstack in den Leavestack legen.
  pop r10
  incd &leavestackpointer ; Pointer erhöhen
  
  ret

; ANS sagt dazu:
; Discard the current loop control parameters. An ambiguous condition exists if they are unavailable. 
; Continue execution immediately following the innermost syntactically enclosing DO ... LOOP or DO ... +LOOP. 
; Wie ist das eigentlich zu implementieren ?

  endif ; leaveeinbinden
 

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "+loop" ; Es wird benutzt mit ( Increment -- ).
struktur_plusloop: ; ( Sprungziel 3 -- )
;------------------------------------------------------------------------------  
  push #struktur_doplusloop  ; Schleifenendroutinen einkompilieren
  jmp struktur_loop_spezial
  
struktur_doplusloop:
  ; Zusätzlich auf dem Datenstack den Increment.
  
  ; Inkrementiere den Index.
  ; Wenn Limit erreicht oder überschritten, Strukturen entfernen mit unloop Schleife verlassen.  
   
  add #8000h, r5 ; Index + $8000
  sub r6, r5     ; Index + $8000 - Limit

  add @r4+, r5   ; Index + $8000 - Limit + Schritt
  
  bit #100h, sr  ; An dieser Stelle Flags prüfen
  jc unloop      ; Beim Überlauf beenden.

  add r6, r5     ; Index + $8000 + Schritt
  sub #8000h, r5 ; Index + Schritt
  ret            ; Schleife läuft noch.
      
; ANS: Add n to the loop index. If the loop index did not cross the boundary between 
; the loop limit minus one and the loop limit, continue execution at the beginning of 
; the loop. Otherwise, discard the current loop control parameters and continue execution 
; immediately following the loop. 
; Das Problem liegt darin, dass die Grenze von BEIDEN Seiten her überschritten werden kann ! 

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "loop" ; Es wird benutzt mit ( -- ).
struktur_loop: ; ( Sprungziel 3 -- )
;------------------------------------------------------------------------------  
  push #struktur_doloop  ; Schleifenendroutinen einkompilieren

struktur_loop_spezial: ; Adresse der Schleifenendroutine liegt auf Returnstack !
  call #qcomp  
  
  pushda #3
  call #qpairs
    
  r_from
  call #callkomma ; Schreibt den Sprung in die Schleifenendroutinen von loop und +loop.
  
  ifndef leaveeinbinden
    br #r_branch ; Unbedingten Rücksprung einkompilieren, 
                 ; er liegt in den zwei Bytes nach dem Call struktur_doloop
  else
    call #r_branch
    
    push r10

    mov &leavestackpointer, r10
    ; Auf dem Leavestack ist folgendes: 0 Adresse Adresse ... Adresse [Zeiger hierhin.]
    ; Teste, ob obenauf eine 0 ist.
-   decd &leavestackpointer
    decd r10
    cmp #0, @r10 ; Oberstes Element eine 0 ? 
    je +         ; Dann bin ich fertig.
 
    ; Sonst ist das eine Adresse, und ich habe zu tun !
    pushda @r10
    call #v_branch ; Unbedingten Vorwärtssprung abschließen.
    jmp -

+   pop r10
    ret

  endif ; leaveeinbinden
  
struktur_doloop:
  ; Erhöhe Index um Eins und vergleiche mit dem Limit. 
  ; Wenn gleich, Schleife verlassen. Ansonsten weitermachen.
  
  inc r5  ; Index erhöhen
  cmp r5, r6 ; Mit Limit vergleichen
  je unloop  ; In diesem Fall: Bis die Grenze erreicht wird. ; Until reached or passed the limit. = jge
  ret ; Schleife läuft noch

; ANS: Add one to the loop index. If the loop index is then equal to the loop limit, 
; discard the loop parameters and continue execution immediately following the loop. 
; Otherwise continue execution at the beginning of the loop. 
  
unloop:
  ; Schleife zu Ende.  
  ; Auf dem Return-Stack: ( Limit Index Rücksprung ) Werte der "nächstäußeren" Schleife.
  ; Muss Rücksprungadresse verschieben und die beiden Werte Limit und Index zurück in die Register holen.

  incd @sp ; Überspringe den Sprungbefehl am Ende der Schleife,
           ; indem die Rücksprungadresse um zwei vergrößert wird !

unloop_extern: ; Einsprung für das nach außen herausgeführte unloop.
  ; Hole die alten Schleifenwerte zurück
  mov 2(sp), r5 ; Index
  mov 4(sp), r6 ; Limit

  mov @sp, 4(sp)
  ; ( Rücksprung Index Rücksprung )
  add #4, sp
  ; ( Rücksprung )
  ret
  
  ifndef leaveeinbinden
;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "do" ; Es wird benutzt mit ( Limit Index -- ).
struktur_do: ; ( -- Sprungziel 3 )
;------------------------------------------------------------------------------  
  call #qcomp  
  
  pushda #struktur_dodo  ; Schleifenvorbereitungen einkompilieren
  call #callkomma
  
  call #nullbranch_r ; Bedingten Rücksprung vorbereiten
  pushda #3          ; Strukturerkennung

  ifdef leaveeinbinden
    push r10
    mov &leavestackpointer, r10
    mov #0, @r10 ; Eine Null zur Erkennung den Leavestack legen.
    pop r10
    incd &leavestackpointer ; Pointer erhöhen
  endif

  ret  
   
struktur_dodo:
  ; ( Limit Index -- ) Schiebt die alten Exemplare auf den Return-Stack und läd die Schleifenregister neu.
  ; Return-Stack: ( Rücksprung )
  ; Möchte dort haben: ( Limit Index Rücksprung )

  ; 4 Bytes auf Returnstack reservieren
  sub #4, sp
  ; Habe jetzt im Returnstack ( Rücksprung Leer Leer )  Datenstack ( Limit Index )
  mov 4(sp), @sp
  ; ( Rücksprung Leer Rücksprung ) Datenstack ( Limit Index )

  ; Alte Schleifenwerte einfügen.
  mov r5, 2(sp) ; Index
  mov r6, 4(sp) ; Limit

  ; Neue Schleifenwerte in die Register legen.
  popda r5 ; Hole neuen Index
  popda r6 ; Hole neues Limit

  ret

  else  ; leaveeinbinden

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "?do" ; Es wird benutzt mit ( Limit Index -- ).
                                           ; ( -- Sprungziel 3 )
  ; Diese Schleife springt sofort ans Ende, wenn Limit=Index.
;------------------------------------------------------------------------------  
  pushda #struktur_qdodo
  call #struktur_do_spezial
  ; Auf dem Datenstack liegt nun: ( Rücksprunglückenadresse Strukturerkennung )
  ; An der Stelle, wohin der Rücksprung erfolgt, liegt aber nun der direkte Aussprung.
  ; Muss deswegen die Rücksprungadresse weiterschieben !
  add #2, 2(r4)
  br #leave_spezial

;------------------------------------------------------------------------------
  Wortbirne Flag_sichtbar_immediate, "do" ; Es wird benutzt mit ( Limit Index -- ).
struktur_do: ; ( -- Sprungziel 3 )
;------------------------------------------------------------------------------  
  pushda #struktur_dodo  ; Schleifenvorbereitungen einkompilieren

struktur_do_spezial:
  call #qcomp    
  call #callkomma
  
  call #nullbranch_r ; Bedingten Rücksprung vorbereiten
  pushda #3          ; Strukturerkennung

  ifdef leaveeinbinden
    push r10
    mov &leavestackpointer, r10
    mov #0, @r10 ; Eine Null zur Erkennung den Leavestack legen.
    pop r10
    incd &leavestackpointer ; Pointer erhöhen
  endif

  ret  

struktur_qdodo:
  ; Sind Limit und Index gleich, wird direkt ausgesprungen !
  cmp @r4, 2(r4) ; Limit und Index gleich ?
  jne +
  add #4, r4 ; Limit und Index vergessen
  ret
+ incd @sp ; Den gleich auf diesen Aufruf folgenden Schleife-Verlassen-Vorwärtssprung überspringen
   
struktur_dodo:
  ; ( Limit Index -- ) Schiebt die alten Exemplare auf den Return-Stack und läd die Schleifenregister neu.
  ; Return-Stack: ( Rücksprung )
  ; Möchte dort haben: ( Limit Index Rücksprung )

  ; 4 Bytes auf Returnstack reservieren
  sub #4, sp
  ; Habe jetzt im Returnstack ( Rücksprung Leer Leer )  Datenstack ( Limit Index )
  mov 4(sp), @sp
  ; ( Rücksprung Leer Rücksprung ) Datenstack ( Limit Index )

  ; Alte Schleifenwerte einfügen.
  mov r5, 2(sp) ; Index
  mov r6, 4(sp) ; Limit

  ; Neue Schleifenwerte in die Register legen.
  popda r5 ; Hole neuen Index
  popda r6 ; Hole neues Limit

  ret   

  endif ; leaveeinbinden
  
;------------------------------------------------------------------------------
  Kapitelbirne "--- Kontrollstrukturen ---"  
;------------------------------------------------------------------------------      
   