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

; Vom Rechnen und Ausgeben von Fixkommazahlen.
; Number wird auch hier definiert und kann mit allen Arten von Zahlen umgehen.

;------------------------------------------------------------------------------
; --- Fixkomma-Rechnen ---
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
uf_slash_mod: ; Dividiert 32/32 = 32 Rest 32. Setzt aber die Kommastelle in die Mitte. Kann Überlaufen.
              ; Wird nur einmal benutzt, ist aber als Einsprungpunkt wichtig, wegen besonderer Registerabhängigkeiten.
;------------------------------------------------------------------------------
  push r10
  mov #16, r10
  jmp ud_slash_mod_kommastellenverschiebung

;------------------------------------------------------------------------------
  Wortbirne Flag_visible|Flag_foldable_4, "f/"
f_div: ; Vorzeichenrichtige Fixkomma-Division. Kann Überlaufen.
       ; Vorzeichen bei Überlauf nicht richtig. Wozu auch ?
;------------------------------------------------------------------------------
  ; Vorzeichen beachten ! ( 1L 1H 2L 2H - EL EH )
  push r10
  clr r10

  bit #8000h, 0(r4)
  jnc +
    inc r10
    call #dnegate

+ bit #8000h, 4(r4)
  jnc +
    inc r10
    ; Müsste nun die Doppeltgenaue Zahl an zweiter Stelle auf dem Datenstack negieren.
    call #dswap
    call #dnegate
    call #dswap
+
  call #uf_slash_mod
  call #doppelnip ; Der Rest interessiert mich hier nicht.
  ; call #dabs ; Warum ? Wegen des Überlaufes ? Damit Vorzeichen nach Überlauf stimmt ?!

  bit #1, r10
  jnc +
  call #dnegate
+
  pop r10
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible|Flag_foldable_4, "f*"
f_star: ; Multipliziert zwei Fixkommazahlen, Vorzeichenrichtig, Nachkommastellen beachten.
        ; ( fi fi -- fi )
        ; Vorzeichen bei Überlauf nicht richtig. Wozu auch ?
;------------------------------------------------------------------------------
  ; Vorzeichen beachten ! ( 1L 1H 2L 2H - EL EH )
  push r10
  clr r10

  bit #8000h, 0(r4)
  jnc +
    inc r10
    call #dnegate

+ call #dswap
  bit #8000h, 0(r4)
  jnc +
    inc r10
    call #dnegate
+
  call #ud_star

;   Sollte ich hier vielleicht eine Sättigung oder einen Überlauffehler implementieren ?
;   tst @r4 ; Der High-Teil, der abgeschnitten wird.
;   jz +
;   writeln " Overflow in f* !"
; +

  ; Das Ergebnis ist 64 Bits breit, muss die vordersten und hintersten 16 Bits abschneiden.
  mov 4(r4), 6(r4)
  mov 2(r4), 4(r4)
  add #4, r4

  bit #1, r10
  jnc +
  call #dnegate
+
  pop r10
  ret

;------------------------------------------------------------------------------
; --- Fixkomma-Ein-Ausgabe ---
;------------------------------------------------------------------------------

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

  inc.b &Zahlenpuffer ; Längenbyte um eins erhöhen.
  mov.b &Zahlenpuffer, r7    ; Längenbyte in Register holen
  mov.b @r4, Zahlenpuffer(r7) ; Und an die entsprechende Stelle schreiben.

+ incd r4 ; Das Zeichen wird immer heruntergeworfen. Pufferüberläufe passieren in Kommentaren öfter mal.
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "f#S"
falleziffern: ; ( 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.
;------------------------------------------------------------------------------
  push r10
  mov #16, r10

- call #fziffer
  dec r10
  jnz -

+ pop r10
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "f#"
fziffer: ; ( Zahl -- Zahl )
      ; Fügt eine weitere Nachkomma-Ziffer hinzu
      ; Benutzt dafür einfach den Zahlenpuffer.

;------------------------------------------------------------------------------
  ; ( Nachkommastellen )
  ; Idee dahinter: Multipliziere mit der Basis.
  ; Dabei wird die nächste Stelle in den High-Teil der Multiplikation geschoben
  ; und kann diesen ausgeben.

  pushda &Base ; Basis
  call #um_star ; ( Nachkommastellen Basis -- Low High )
  call #digitausgeben ; ( Low=Nachkommastellen Zeichen )

  br #zahlanhaengen ; Fügt das Zeichen dem Puffer hinzu. ( Nachkommastellen Zeichen Zahlenpuffer -- Nachkommastellen )

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "f."
      ; ( ZahlL ZahlH -- )
      ; Gibt eine Fixkommazahl aus.
      ; Benutzt dafür einfach den Zahlenpuffer.

  ; In Forth: <# #S #>

  ; ( ZahlL ZahlH )
  call #tuck ; ( Vorzeichen ZahlL ZahlH )
  call #dabs ; ( Vorzeichen uL uH )

  pushda #0  ; ( Vorzeichen Nachkommastellen VorkommastellenL=uH VorkommastellenH=0 )
  call #zifferstringanfang

  call #alleziffern ; Damit ist der High-Teil bearbeitet. ( Vorzeichen uL 0 0 )
  drop ; ( Vorzeichen uL 0 )

  mov #44, @r4 ; Das ist das Komma ( Vorzeichen uL 44 )
  call #zahlanhaengen ; ( Vorzeichen uL )

  call #falleziffern ; Nachkommastellen ( Vorzeichen 0 )
  mov 2(r4), @r4     ; ( Vorzeichen Vorzeichen )
  call #vorzeichen   ; ( Vorzeichen )

  decd r4 ; ( Vorzeichen irgendwas ) Das Folgende verwirft den Doppelt-"Rest" in sich.
  br #abschluss_zahlenausgabe

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "number" ; Zahlen-Input.
  ; ( Stringadresse -- 0 )
  ; ( Stringadresse -- Zahl 1 )         Einfachlange Zahl
  ; ( Stringadresse -- ZahlL ZahlH 2 )  Doppeltlange Zahl oder Fixkommazahl s15.16

number: ; Versucht einen String in die möglichen Zahlenformate umzuwandeln.
;------------------------------------------------------------------------------
  push r10
  push r11
  push r12 ; Zahl für die Vorkommastellen
  push r13 ; Zahl für die Nachkommastellen
  push r14 ; Zahl der Ergebnisse
  push &Base

  clr r14 ; Am Anfang noch keine Ergebnisse.

  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 universalnumber_aussprung  ; Unerfolgreicher Aussprung.

  ; Probe, ob die Zahlenbasis geschaltet werden soll:
  mov.b @r10, r13 ; Hole erstes Zeichen von dem Zahlenstring

  cmp.b #36, r13 ; Ist es ein "$" ? Für Basisumschaltung in Hex.
  mov #16, r12   ; Umschalten auf Hexadezimal
  je +

  cmp.b #37, r13 ; Ist es ein "%" ? Für Basisumschaltung in Binär.
  mov #2, r12    ; Umschalten auf Binär
  je +

  cmp.b #35, r13 ; Ist es ein "#" ? Für Basisumschaltung in Dezimal.
  mov #10, r12   ; Umschalten auf Dezimal
  jne ++

+ ; Basis muss gewechselt werden :-)

    mov r12, &Base
    inc r10 ; Zeiger vorrücken
    dec r11 ; Verbliebene Zeichenzahl verringern
    jz universalnumber_aussprung ; number_fehler_stringleer ; Leere Strings bzw. Basisvorsilben allein sind keine gültigt Zahl

+ ; Basisproben fertig.

;------------------------------------------------------------------------------
; Basisvorsilben abgearbeitet. Prüfe Vorzeichen:

  cmp.b #45, @r10  ; Prüfe, ob das erste Zeichen ein Minus ist.
  push sr ; Vermerke das Vorzeichen als Zero-Flag auf Datenstack.
  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.

;------------------------------------------------------------------------------
; Präparationen sind abgeschlossen. Basisvorsilben und Vorzeichen erkannt und bearbeitet.
; Kümmere mich nun um die eigentliche Zahl !
; Aussprünge ab jetzt mit

  clr r12 ; Low-Teil   - Am Anfang noch keine Resultate.
  clr r13 ; High-Teil

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

  mov #1, r14 ; Eine Ergebniszelle !

universalnumber_vorkommastellen:
  tst r11
  jz universalnumber_vorzeichenbearbeiten ; Bedeutet: Erfolgreich fertig !

  ; Vorkommastellen:

  ; Prüfe auf den Wunsch, doppeltlange Zahlen zu erhalten.
  cmp.b #46, @r10 ; Punkt
  jne +
    mov #2, r14 ; Doppeltlang !
    jmp ++

+ 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
  bit @r4+, -2(r4) ; Flag prüfen
  jz universalnumber_nachkommastellen

  sub #8, r4
  mov r12,   6(r4) ; ZahlL
  mov r13,   4(r4) ; ZahlH
  mov &Base, 2(r4) ; Basis low
  mov #0,    0(r4) ; Basis high = 0

  call #ud_star  ; Malnehmen
  add #4, r4     ; Highest-Teile verwerfen
  popda r13      ; Zurückholen ZahlH
  popda r12      ; Zurückholen ZahlL
  add @r4+, r12  ; Neue Ziffer hinzutun.
  adc r13        ; Überlauf in High-Teil beachten.

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

  jmp universalnumber_vorkommastellen ; Weitermachen.

;------------------------------------------------------------------------------

  ; Nachkommastellen:
    ; Sind noch Zeichen da ? Sonst fertig. Brauche ich hier nicht !
    ; Hole ein Zeichen von hinten.
    ; Prüfe, ob Digit das mag.
    ; Wenn ja: (Neue Ziffer, Alte Nachkommastellen)/Basis.
    ;          Also als Vorkommastelle bereitlegen und hineinteilen.
    ;          Zeichen abtrennen.
    ; Wenn nein: Fertig.
    ; Wiederholen.

universalnumber_nachkommastellen: ; Mache mit den Nachkommastellen weiter. Es ist noch mindestens ein Zeichen da.
  ; tst r11                  ; Es würde mich sehr wundern. Vorkommastellen hat mindestens ein Zeichen ausgespien.
  ; jz universalnumber_leer  ; Dieses Zeichen ist für Digit unverdaulich. Also muss auch Nachkommastellen es verschmähen.

  mov r12, r13 ; ZahlL ist jetzt ZahlH, denn die Nachkommastellen sind winziger als ZahlL.
  clr r12      ; Nachkommastellen sind momentan leer.

  ; Datenstack leer.
  pushda r12 ; ( Nachkommastellen ) - die sind jetzt noch Null.

- ; ( Nachkommastellen )

  decd r4
    add r11, r10
    dec r10
  mov.b @r10, @r4  ; Lege Zeichen vom Ende des Strings bereit.
    inc r10
    sub r11, r10
  clr.b 1(r4)      ; High-Byte im Datenstack löschen.

  ; ( Nachkommastellen Zeichen )
  call #flagdigit  ; Versuchen, das Zeichen umzuwandeln.
  bit @r4+, -2(r4) ; Flag prüfen
  jz universalnumber_nachkommafertig ; Mochte es nicht ! Weiter prüfe, ob dies ein Komma ist.

  dec r11 ; Verbliebene Zeichenzahl verringern. Zeiger nicht vorrücken. hole ja von hinten.

  pushda &Base       ; ( AlteNachkommastellen NeueZiffer Basis )
  call #um_slash_mod ; ( Rest NeueNachkommastellen )
  nip                ; ( NeueNachkommastellen )

  jmp -

;------------------------------------------------------------------------------

universalnumber_nachkommafertig: ; Einsprung nur aus den Nachkommastellen
  popda r12 ; Hole Nachkommastellen zurück.

  ; Prüfe, ob das verschmähte Zeichen nur eins ist und ob dieses ein Punkt ist. Dann ist alles okay.
  ; Ansonsten Rücksprung mit Fehler.

  clr r14 ; Erstmal kein Ergebnis

  cmp #1, r11          ; Noch genau ein Zeichen ?
  jne universalnumber_vorzeichenbearbeiten
  cmp.b #44, @r10      ; Ist das Zeichen ein Komma ?
  jne universalnumber_vorzeichenbearbeiten

  ; Bin fertig mit der Umwandlung. Alles hat geklappt. Betrachte Vorzeichen ! Lege Ergebnisse bereit.
  mov #2, r14

;------------------------------------------------------------------------------
; Hier wird das Vorzeichen vom Returnstack geholt und beachtet.
universalnumber_vorzeichenbearbeiten:
  pop sr
  jne +
    ;writeln "Vorzeichenwechsel"
    inv r12 ; Low-Teil invertieren
    inv r13 ; High-Teil invertieren
    inc r12 ; Low-Teil um Eins erhöhen
    adc r13 ; High-Teil-Übertrag berücksichtigen.
+

  ; Je nach Zahl der Operanden Ergebnisse bereitlegen:
  ; Auf dem Stack soll erscheinen: [Low [High]] Anzahl.

  cmp #1, r14
  jlo ++
    pushda r12 ; Low-Teil

+ cmp #2, r14
  jlo +
    pushda r13 ; High-Teil

;------------------------------------------------------------------------------
universalnumber_aussprung:
+ pushda r14 ; Zahl der Operanden auf Stack legen
  pop &Base
  pop r14
  jmp ende_pop_13_10
