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

; Routinen, um mit Strings umzugehen, die aus einem Längenbyte und den folgenden Zeichen bestehen,

lowercase macro Zeichen ; Ein Zeichen in einem Register wird auf Lowercase umgestellt.
  ;    Hex Dec  Hex Dec
  ; A  41  65   61  97  a
  ; Z  5A  90   7A  122 z

  cmp.b #041h, Zeichen
  jlo +
  cmp.b #05Bh, Zeichen
  jhs +
  add.b #020h, Zeichen
+ ; Fertig
          endm

;------------------------------------------------------------------------------
  ifdef spezialstrings
    Wortbirne Flag_visible, "compare"
  endif
flagstringvergleich: ; ( Adresse Adresse -- true | false )
;------------------------------------------------------------------------------
  push r10  ; Adresse des ersten  Strings
  push r11  ; Adresse des zweiten Strings
  push r12  ; Zeichen aus dem ersten  String
  push r13  ; Zeichen aus dem zweiten String
  ;     r7  ; Länge

  popda r10    ; Adresse des ersten  Strings holen
  mov @r4, r11 ; Adresse des zweiten Strings holen
  clr @r4      ; False-Flag bereitlegen
                                                  
  mov.b @r10+, r7 ; Längenbyte des ersten Strings holen
  cmp.b @r11+, r7 ; Mit dem Längenbyte des zweiten Strings vergleichen
  jnz stringvergleich_ungleich

  tst r7   ; Für den Fall, dass leere Strings verglichen werden.
  jz stringvergleich_gleich

- ; Die Längen sind identisch. Prüfe nun nacheinander die Zeichen in den Strings.
  mov.b @r10+, r12
  mov.b @r11+, r13

  ifdef caseinsensitive
    ; Lowercase r12 und r13 für case-insensitive.
    lowercase r12
    lowercase r13
  endif

  cmp.b r12, r13
  jnz stringvergleich_ungleich

  dec r7
  jnz -
  ; Falle ich hier raus, ist Z gesetzt und die Strings sind gleich.

stringvergleich_gleich:
  mov #-1, @r4
stringvergleich_ungleich:
  jmp ende_pop_13_10


;------------------------------------------------------------------------------
  ifdef spezialstrings
    Wortbirne Flag_visible, "skipstring"
  endif
stringueberlesen: ; ( Adresse -- Adresse )
                  ; Überspringt einen String.
;------------------------------------------------------------------------------
  push r10
  mov @r4, r10 ; Stringanfangsadresse
  call #stringueberlesen_r10
  mov r10, @r4
  pop r10
  ret

;  Schneller, String muss aber auf einer geraden Adresse beginnen...
;  mov @r4, r7    ; Stringadresse holen
;  mov.b @r7, r7  ; Längenbyte holen
;  bit #1, r7     ; Füll-Null überlesen, falls ungerade Adresse...
;  adc r7
;  add r7, @r4    ; Zahl der zu überspringenden Zeichen hinzuaddieren
;  ret

stringueberlesen_r10:
  mov.b @r10+, r7 ; Hole das Längenbyte nach r7, Längenbyte überlesen
  add r7, r10    ; Zahl der Textzeichen hinzuaddieren

  ; Füll-Null überlesen, falls ungerade Adresse...
  bit #1, r10
  adc r10
  ; Zeiger ist jetzt beim Befehl nach dem String.
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "type"
schreibestringmitlaenge: ; ( Adresse -- )
                ; Schreibt einen String über emit hinaus
                ; Beispiel: Moinstring:  .byte 5, "Moin", 10
                  ; So geht es !
                  ; pushda #Moinstring
                  ; call #schreibestringmitlaenge
;------------------------------------------------------------------------------
  push r10
  push r11

  popda r10          ; Anfangsadresse des Strings
  mov.b @r10+, r11   ; Länge des Strings holen
                     ; r10 ist Adresszeiger

- cmp #0, r11        ; Wenn die Länge Null ist, sind wir fertig.
  je +

  ; decd r4
  ; clr @r4            ; High-Byte auf jeden Fall Nullsetzen.
  ; mov.b @r10+, @r4

  mov.b @r10+, r7
  pushda r7
  call #emit

  dec r11           ; Länge verringern
  jnz -

+ pop r11
  pop r10
  ret

  ifdef spezialstrings
;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly, "s\i" ; Dies ist s" und gibt einen Stringpointer zurück.
;------------------------------------------------------------------------------
  push #sgaensefuesschen
  jmp gaensefuesschendetektor

sgaensefuesschen:
  ; Returnstack: ( Stringanfangsadresse-im-Rücksprung )

  ; Adresse des Strings ist in der Rücksprungadresse enthalten.
  pushda @sp ; Lege die Stringadresse für spätere Verwendung bereit.
  ; call #schreibestringmitlaenge ; Das ist der einzige Unterschied zu dotgaensefuesschen.
  jmp dotgaensefuesschen_inneneinsprung

  endif

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate_compileonly, ".\i" ; Dies ist ." und das write von Forth.
;------------------------------------------------------------------------------
  push #dotgaensefuesschen

gaensefuesschendetektor:
  r_from
  call #callkomma

  pushda #34
  call #parse
  br #kommastring

  ; Benutzung:
  ; call #dotgaensefuesschen
  ; .byte Länge, Buchstaben [, 0 um Adresse gerade zu machen]

dotgaensefuesschen:
  ; Returnstack: ( Stringanfangsadresse-im-Rücksprung )

  ; Adresse des Strings ist in der Rücksprungadresse enthalten.
  pushda @sp
  call #schreibestringmitlaenge

dotgaensefuesschen_inneneinsprung:

  pushda @sp+ ; Adresse vom Returnstack auf den Datenstack legen
  call #stringueberlesen ; Rücksprungadresse auf den Befehl nach dem String setzen.
  mov @r4+, pc ; Ret über den Datenstack

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "cr" ; ( -- ) Gibt einen Zeilenumbruch aus
  writeln ""
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "space" ; ( -- ) Gibt ein Leerzeichen aus
  write " "
  ret  

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate|Flag_Foldable_0, "\40" ; ( -- ) Kommentar (
  mov #41, r7 ; [char] )
  jmp +

;------------------------------------------------------------------------------
  Wortbirne Flag_immediate|Flag_Foldable_0, "\\" ; ( -- ) Kommentar \ bis zum Ende der Zeile
  clr r7 ; Zeichen 0 gibt es nicht, also bis zum Ende der Zeile
+ pushda r7
  call #parse
  ; jmp drop_vektor
  drop
  ret
