;
;    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, aktuell aus Platzgründen noch nicht eingebunden.

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate, "case"
  ; ( -- 0 6 )
;------------------------------------------------------------------------------  
  pushdadouble #0, #6
  ret


; : of  ( #of -- orig #of+1 / x -- )
;   1+    ( count OFs )
;   >r    ( move off the stack in case the control-flow )
;         ( stack is the data stack. )
;
;   $94B4 , $0 ,   \ cmp @r4+, 0(r4)
;   here 2 allot   \ Place for jne
;   postpone drop 
;
;   r>             ( we can bring count back now )
;immediate ; 

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate, "?of"  ; Nochmal 44 Bytes.
  ; ( ... #of 6 -- ... addr #of+1 7 )
  ; Nimmt einen Flag statt einer Konstanten entgegen.
  ; Kann so eigene Vergleiche aufbauen.
;------------------------------------------------------------------------------  
  pushda #6
  call #qcompqpairs
  
  to_r
  inc @sp

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

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

  jmp of_inneneinsprung

;------------------------------------------------------------------------------ 
  Wortbirne Flag_opcodierbar_spezialfall|Flag_immediate, "of"
  ; ( ... #of 6 -- ... addr #of+1 7 )
;------------------------------------------------------------------------------  
  pushda #6
  call #qcompqpairs
  
  to_r
  inc @sp

  pushdadouble #0, #094B4h  ; cmp @r4+, 0(r4)
  call #doppelkomma

of_inneneinsprung:
  call #branch_v ; here 2 allot

  pushdadouble @sp+, #7

dropkomma:
  pushda #05324h ; Opcode for drop
  call #komma
  ret

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

      pushda #6 ; Darf dies erst nach dem Rücksetzen der Faltung prüfen !
      call #qcompqpairs ; Auf dem Stack waren doch vorher noch die Faltkonstanten...

      to_r
      inc @sp

      pushdadouble r10, #090b4h    ; Befehl, der nun geschrieben wird:
      call #konstantenopcodierer   ; cmp #Konstante, 0(r4)
      call #nullkomma

      jmp of_inneneinsprung

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate, "endof"
  ; ( ... addr-jne #of 7 -- ... addr-jmp #of 6 )
;------------------------------------------------------------------------------  
  pushda #7
  call #qcompqpairs

  to_r ; #of auf Returnstack

    call #branch_v ; here 2 allot
    swap ; ( here Addr-jne )
    pushdadouble &Dictionarypointer, #02000h ; ( here=Addr-jmp   Addr-jne here $2000 )
    call #jumpgenerator

  pushdadouble @sp+, #6
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible_immediate, "endcase"
  ; ( ... addrs-jmp #of 6 -- )
;------------------------------------------------------------------------------  
  pushda #6
  call #qcompqpairs

  call #dropkomma

  push r10
  popda r10 ; Zahl der noch zu bearbeitenden Sprünge
  tst r10
  je +

- call #v_branch

  dec r10 
  jnz -

+ pop r10
  ret
