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

; Zahlenzauber enthält die Routinen für die Umwandlung von Zahlen in Strings und umgekehrt.
; Hier werden auf Wunsch (doppeltzahleneinbinden) tatsächlich doppeltlange Zahlen für die Ausgabe verwendet. Genau wie in ANS :-)=
; Die Zahlenbasis kann maximal bis 36 gehen, danach fehlt einfach der Zeichensatz.

;------------------------------------------------------------------------------
; --- Zahlenstrings ---
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, ".digit"
digitausgeben: ; ( Ziffer -- Zeichen ) Wandelt eine Ziffer in ein Zeichen um.
               ; Wenn ein Zahlensystem größer 36 angestrebt wird,
               ; werden nicht druckbare Zeichen einfach mit # beschrieben.
;------------------------------------------------------------------------------
  mov @r4, r7  ; Ziffer holen

  cmp #10, r7  ; Von 0-9:
  jhs +
  add #48, r7  ; Schiebe zum Anfang der Zahlen
  jmp +++

+ cmp #36, r7  ; Von A-Z:
  jhs +
  add #55, r7  ; Schiebe zum Anfang der Großbuchstaben - 10 = 55.
  jmp ++        ; Alternative für Kleinbuchstaben: 87.

+ mov #35, r7  ; Zeichen #, falls diese Ziffer nicht darstellbar ist

+ mov r7, @r4 ; Zeichen zurückschreiben
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "digit" ; Wandelt einen Buchstaben in eine Ziffer um.
flagdigit: ; ( Zeichen -- false / Ziffer true )
;------------------------------------------------------------------------------
  mov @r4, r7  ; Zeichen holen.

  sub #48, r7   ; "0" abziehen.
  jlo +          ; negativ --> Zeichen war "unter Null"

  cmp #10, r7   ; Im Bereich bis "9" ?
  jlo ++         ; Ziffer korrekt erkannt.

  ; Nein: Also ist die Ziffer nicht in den Zahlen 0-9 enthalten gewesen.
  ; Prüfe Buchstaben.

  sub #7,  r7  ; Anfang der Großbuchstaben, "A"
  cmp #10, r7  ; Buchstabenwerte beginnen bei 10
  jlo +         ; --> Zeichen war ein Sonderzeichen zwischen Ziffern und Großbuchstaben.

  cmp #36, r7  ; Es gibt 26 Buchstaben.
  jlo ++        ; In dem Bereich: Ziffer korrekt erkannt.

  ; Für den Fall, dass die Ziffer immer noch nicht erkannt ist, probiere es mit den Kleinbuchstaben.

  sub #32, r7  ; Schiebe zum Anfang der Kleinbuchstaben, "A"
  cmp #10, r7  ; Buchstabenwerte beginnen bei 10
  jlo +         ; --> Zeichen war ein Sonderzeichen zwischen Großbuchstaben und Kleinbuchstaben.

  cmp #36, r7  ; Es gibt 26 Buchstaben.
  jlo ++        ; In dem Bereich: Ziffer korrekt erkannt.

  ; Immer noch nicht ? Dann ist das ein Sonderzeichen oberhalb der Kleinbuchstaben oder ein Unicode-Zeichen.
  ; Keine gültige Ziffer.

/ clr @r4  ; Fehler.
  ret

+ ; Prüfe nun noch, ob die Ziffer innerhalb der Basis liegt !
  cmp &Base, r7
  jhs -          ; Außerhalb der Basis werden keine Buchstaben als Zahlen akzeptiert.

  mov r7, @r4
  pushda #-1
  ret

  ifndef fixkommarechnungeneinbinden

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "number" ; Zahlen-Input.
  ; ( Stringadresse -- 0 )
  ; ( Stringadresse -- Zahl 1 )

number: ; Versucht einen String in eine einfachgenaue Zahl umzuwandeln.
;------------------------------------------------------------------------------
  push &Base
  push r10
  push r11
  push r12 ; Zahl für die Vorkommastellen

  popda r10        ; Hole die Stringadresse
  mov.b @r10+, r11 ; Hole die Zahl der darin vorhandenen Zeichen.
                   ; Setze den Zeiger auf das erste Zeichen.

  ; Prüfe, ob der String mindestens ein Zeichen enthält, also nicht leer ist.
  tst r11
  jz number_fehler_stringleer ; Leere Strings sind keine gültigt Zahl


  ; Probe, ob die Zahlenbasis geschaltet werden soll:
  cmp.b #36, @r10 ; Ist es ein "$" ? Für Basisumschaltung in Hex.
  jne +
    mov #16, &Base ; Umschalten auf Hexadezimal
    jmp number_basiswechsel

+ cmp.b #37, @r10 ; Ist es ein "%" ? Für Basisumschaltung in Binär.
  jne +
    mov #2, &Base ; Umschalten auf Binär
    jmp number_basiswechsel

+ cmp.b #35, @r10 ; Ist es ein "#" ? Für Basisumschaltung in Dezimal.
  jne +
    mov #10, &Base ; Umschalten auf Binär

number_basiswechsel:
    inc r10 ; Zeiger vorrücken
    dec r11 ; Verbliebene Zeichenzahl verringern
    jz number_fehler_stringleer ; Leere Strings bzw. Basisvorsilben allein sind keine gültigt Zahl

+  ; Basisproben fertig.

  ; Prüfe Vorzeichen:
  cmp.b #45, @r10  ; Prüfe, ob das erste Zeichen ein Minus ist.
  push sr ; Vermerke das Vorzeichen als Carry-Flag.
  jne +
    ;writeln " Minus "
    inc r10 ; Zeiger vorrücken
    dec r11 ; Verbliebene Zeichenzahl verringern
+ ; Vorzeichen abgetrennt und bearbeitet.

  ; Habe jetzt noch Vorkommastellen Punkt Nachkommastellen im String.

  clr r12 ;  Vorkommastellen - Am Anfang noch keine Resultate.

  ; Vorkommastellen:
    ; Sind noch Zeichen da ? Sonst fertig.
    ; Hole ein Zeichen von vorne.
    ; Prüfe, ob Digit das mag.
    ; Wenn ja: Zahl := Zahl * Basis + neue Ziffer. Zeichen abtrennen.
    ; Wenn nein: Fertig.
    ; Wiederholen.

number_vorkommastellen:
  tst r11
  jz number_fertig

  decd r4
  mov.b @r10, @r4   ; Lege Zeichen vom Anfang des Strings bereit.
  clr.b 1(r4)       ; High-Byte im Datenstack löschen.

  call #flagdigit    ; Versuchen, das Zeichen umzuwandeln.
  bit @r4+, -2(r4)   ; Flag prüfen
  jz number_fehler   ; Mochte es nicht ! Schluss, aus, Ende.

  inc r10 ; Zeiger vorrücken
  dec r11 ; Verbliebene Zeichenzahl verringern

  pushda r12     ; Zahl
  pushda &Base   ; Basis
  call #um_star  ; Malnehmen
  drop           ; High-Teil verwerfen
  popda r12      ; Zurückholen
  add @r4+, r12  ; Neue Ziffer hinzutun.

  jmp number_vorkommastellen ; Weitermachen.

number_fertig:
  ; Bin fertig mit der Umwandlung. Alles hat geklappt. Betrachte Vorzeichen ! Lege Ergebnisse bereit.
  pop sr ; Hole das Vorzeichen zurück
  jne +
  ; Vorzeichen umkehren !
  inv r12
  inc r12

+ pushda r12
  pushda #1 ; Erfolgreich gewesen

number_aussprung:
  pop r12
  pop r11
  pop r10
  pop &Base
  ret

number_fehler:
  pop sr
number_fehler_stringleer:
  pushda #0 ; Unerfolgreich gewesen
  jmp number_aussprung

  endif ; fixkommarechnungeneinbinden

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "hold" ; Fügt dem Zahlenstring von vorne ein Zeichen hinzu.
hold: ; ( Zeichen -- )
;------------------------------------------------------------------------------
  ; Prüfe, ob der Puffer schon voll ist.
  cmp.b #Zahlenpufferlaenge, &Zahlenpuffer
  jhs ++ ; Wenn die Länge erreicht ist, ist der Puffer voll.

  ; Alter String:  | Länge     |     |
  ; Neuer String:  | Länge + 1 | Neu |

  ; Alter String:  | Länge     | I   | II  | III |     |
  ; Neuer String:  | Länge + 1 | Neu | I   | II  | III |

  ; Mache mich an die Arbeit !

  mov.b &Zahlenpuffer, r7 ; Hole die alte Stringlänge.
  inc.b &Zahlenpuffer      ; Stringlänge erhöhen

  ; Prüfe, ob mindestens ein Zeichen verschoben werden muss:
  tst r7
  je +

    ; Ja, es müssen Zeichen verschoben werden. Deren Anzahl steht in r7.
-   mov.b Zahlenpuffer(r7), Zahlenpuffer+1(r7)
    dec r7
    jnz -

+ mov.b @r4, &Zahlenpuffer+1 ; Das neue Zeichen einsetzen.

+ incd r4 ; Zeichen wird immer heruntergeworfen.
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "sign"
vorzeichen: ; ( Vorzeichen -- )
      ; Prüft die Zahl auf dem Stack auf ihr Vorzeichen hin und
      ; fügt bei Bedarf ein Minus an den Ziffernstring an.
;------------------------------------------------------------------------------
  tst @r4
  jn +
  drop
  ret

+ mov #45, @r4  ; Minuszeichen
  jmp hold      ; an den Zahlenpuffer anhängen

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "#S"
alleziffern: ; ( Zahl -- Zahl=0 )
      ; Fügt alle Ziffern, jedoch mindestens eine,
      ; an den im aufbau befindlichen String an.
      ; Benutzt dafür einfach den Zahlenpuffer.
      ; Normalerweise doppeltgenau, hier nur einfachgenau.
;------------------------------------------------------------------------------
- call #ziffer
  tst @r4   ; Wenn im High-Teil
  jne -

  ifdef doppeltzahleneinbinden
    tst 2(r4) ; Oder im Low-Teil noch etwas ist, weitermachen !
    jne -
  endif

  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "#"
ziffer: ; ( Zahl -- Zahl ) oder
        ; ( ZahlL ZahlH -- ZahlL ZahlH )
      ; Fügt eine weitere Ziffer hinzu, Rest entsprechend verkleinert.
      ; Benutzt dafür einfach den Zahlenpuffer.
;------------------------------------------------------------------------------
  ; Idee dahinter: Teile durch die Basis.
  ; Bekomme einen Rest, und einen Teil, den ich im nächsten Durchlauf
  ; behandeln muss. Der Rest ist die Ziffer.

  ifdef doppeltzahleneinbinden

    pushdadouble &Base, #0 ; Basis-Low und Basis-High
    ; ( ZahlL ZahlH BasisL BasisH )
    call #ud_slash_mod
    ; ( RestL RestH ZahlL ZahlH )
    ; Hier ist ein bisschen Stackjonglage nötig.
    call #dswap
    ; ( ZahlL ZahlH RestL RestH )
    drop
    ; ( ZahlL ZahlH RestL )
    call #digitausgeben
    jmp hold

  else

    ; Normalerweise doppeltgenau, hier nur einfachgenau.
    pushda &Base ; Basis
    ; Müsste haben: (u Basis -- )
    call #u_divmod ; ( u u -- u u ) Dividend Divisor -- Ergebnis Rest
    swap
    ; Erhalte zurück ( -- Ergebnis Rest )
    ; Der Rest ist die Ziffer, die ich an dieser Stelle wünsche.
    call #digitausgeben
    ; Habe nun das Zeichen auf dem Stack. ( -- Ergebnis Zeichen )
    ; Füge das Zeichen in den String ein.
    jmp hold
    ; ( Ergebnis )

  endif

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "#>" ; ( ZahlenrestL (ZahlenrestH) -- Addr )
zifferstringende:  ; Schließt einen neuen Ziffernstring ab und gibt seine Adresse zurück.
                   ; Benutzt dafür einfach den Zahlenpuffer.
;------------------------------------------------------------------------------
  ifdef doppeltzahleneinbinden
    drop
  endif
  mov #Zahlenpuffer, @r4
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "<#" ; ( Zahl -- )
zifferstringanfang: ; Eröffnet einen neuen Ziffernstring.
                    ; Benutzt dafür einfach den Zahlenpuffer.
                    ; Normalerweise doppeltgenau, hier nur einfachgenau.
;------------------------------------------------------------------------------
  clr.b &Zahlenpuffer ; Länge löschen, bisherige Länge Null.
  ret


  ifdef doppeltzahleneinbinden
; Aus Starting Forth:
;   : UD. <# #S #> TYPE SPACE ;
;   : D.  TUCK DABS <#  #S ROT SIGN  #>  TYPE SPACE ;

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "u." ; ( Zahl -- )
udot: ; Gibt eine vorzeichenlose Zahl aus.
      ; Benutzt dafür einfach den Zahlenpuffer.
;------------------------------------------------------------------------------
  pushda #0 ; Mache die Zahl doppeltlang !
  jmp +

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "." ; ( Zahl -- )
dot: ; Gibt eine vorzeichenbehaftete Zahl aus.
     ; Benutzt dafür einfach den Zahlenpuffer.
;------------------------------------------------------------------------------
  call #doppeltlangmachen
  jmp +

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "ud."
      ; ( ZahlL ZahlH -- )
      ; Gibt eine vorzeichenlose Zahl aus.
      ; Benutzt dafür einfach den Zahlenpuffer.
;------------------------------------------------------------------------------
  ; In Forth: <# #S #>
  call #zifferstringanfang
  call #alleziffern
  jmp abschluss_zahlenausgabe ; Abschluss des Ziffernstrings

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "d."
     ; ( ZahlL ZahlH -- )
     ; Gibt eine vorzeichenbehaftete Zahl aus.
     ; Benutzt dafür einfach den Zahlenpuffer.
;------------------------------------------------------------------------------
+ call #tuck
  call #dabs

  call #zifferstringanfang
  call #alleziffern ; ( Vorzeichen 0 0 )
  add #4, r4 ; rot - ( 0 0 Vorzeichen ) Stattdessen: ( Vorzeichen )
  call #vorzeichen
  sub #4, r4  ; ( irgendwas irgendwas )

abschluss_zahlenausgabe:
  call #zifferstringende
  call #schreibestringmitlaenge
  write " "
  ret

  else  ; ifdef doppeltzahleneinbinden

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "u."
udot: ; ( Zahl -- )
      ; Gibt eine vorzeichenlose Zahl aus.
      ; Benutzt dafür einfach den Zahlenpuffer.
;------------------------------------------------------------------------------
  ; In Forth: <# #S #>
  call #zifferstringanfang
  call #alleziffern
  jmp dot_inneneinsprung

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "." ; ( Zahl -- )
dot: ; Gibt eine vorzeichenbehaftete Zahl aus.
     ; Benutzt dafür einfach den Zahlenpuffer.
;------------------------------------------------------------------------------
  ; In Forth: dup abs <# #S SIGN #>
  dup ; ( Vorzeichen Zahl )
  abs ; ( Vorzeichen u )
  call #zifferstringanfang
  call #alleziffern ; ( Vorzeichen 0 )
  swap              ; ( 0 Vorzeichen )
  call #vorzeichen

dot_inneneinsprung:
  call #zifferstringende

  call #schreibestringmitlaenge
  write " "
  ret

  endif ; ifdef doppeltzahleneinbinden
