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

; Case-Struktur

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly, "case"
  ; ( -- 0 8 )
;------------------------------------------------------------------------------
  pushdadouble #0, #8
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly, "?of"
  ; ( ... #of 8 -- ... addr #of+1 9 )
  ; Nimmt einen Flag statt einer Konstanten entgegen.
  ; Kann so eigene Vergleiche aufbauen.
;------------------------------------------------------------------------------
  cmp #8, @r4
  jne strukturen_passen_nicht

  ; Habe oben einen Flag liegen. True: Dieser Fall soll genommen werden.
  ; False: Weitermachen. Sprung ist JNE !

  call #nullprobekomma   ; bit @r4+, -2(r4)
  mov #0b322h, @r4       ; bit #z, sr        Dreht die Bedeutung des z-Flags um
  call #komma

  jmp of_inneneinsprung_fuer_qof

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly|Flag_opcodierbar_spezialfall, "of"
  ; ( ... #of 8 -- ... addr #of+1 9 )
;------------------------------------------------------------------------------
  cmp #8, @r4
  jne strukturen_passen_nicht

  mov #094B4h, @r4 ; Opcode für cmp @r4+, 0(r4)
  call #komma

of_inneneinsprung:
  call #nullkomma
of_inneneinsprung_fuer_qof:

  ; ( #of --> Addr #of+1)

  call #branch_v ; here 2 allot
  call #swap_sprung
  inc @r4

  pushda #9 ; Strukturerkennung bereitlegen

dropkomma:
  pushda #05324h ; Opcode for drop
  call #komma
  ret ; Ret hier als Ende-Erkennung für den Spezialopcodierfall wichtig.

  ;------------------------------------------------------------------------------
  ; Einsprung mit mindestens einer Konstanten:
  ;------------------------------------------------------------------------------
      ; Da dies ein Spezial-Einsprung ist, kann ich r10 frei verwenden, ist schon gesichert.
      ; Habe mindestens eine Falt-Konstante bereitliegend.
      ; Die Konstante aus der Faltung liegt obenauf !

      popda r10 ; Habe die Konstante aus der Faltung nun in r10.

        dec r11 ; Zahl der verbrauchten Konstanten abziehen
        call #interpret_konstantenschreiben ; Ende des Faltens, Anzahl restlicher Konstanten in r11.

      cmp #8, @r4                 ; Darf dies erst nach dem Rücksetzen der Faltung prüfen !
      jne strukturen_passen_nicht ; Auf dem Stack waren doch vorher noch die Faltkonstanten...

      mov r10, @r4
      mov #090b4h, r12
      call #pushda_r12_konstantenopcodierer   ; cmp #Konstante, 0(r4)
      jmp of_inneneinsprung


;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly, "endof"
  ; ( ... addr-jne #of 9 -- ... addr-jmp #of 8 )
;------------------------------------------------------------------------------
  cmp #9, @r4
  jne strukturen_passen_nicht
  drop

  to_r ; #of auf Returnstack

    call #branch_v    ; here 2 allot
    call #swap_sprung ; ( here Addr-jne )
    call #v_casebranch

  pushdadouble @sp+, #8
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly, "endcase"
  ; ( ... addrs-jmp #of 8 -- )
;------------------------------------------------------------------------------
  cmp #8, @r4
  jne strukturen_passen_nicht
  drop

  call #dropkomma

spruenge_einpflegen:
    ; Einpflegen der gesammelten ?do und leave-Sprünge
    push r10
    popda r10 ; Hole die Zahl der einzupflegenden Sprünge hierher
    tst r10
    je +++

-   bit #1, @r4 ; Prüfe, ob es ein bedingter oder unbedingter Sprung werden soll:
    jnc +
      bic #1, @r4 ; Markierung für bedingten Sprung entfernen
      call #v_nullbranch
      jmp ++
+   call #v_branch
+   dec r10
    jnz -
+   pop r10 ; Alle einzufügenden Sprünge abgearbeitet
  ret
