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

; Input and Output of numbers

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, ".digit"
digitausgeben: ; ( u -- c ) Converts a digit into a character.
               ; If base is bigger than 36, unprintable digits are written as #
;------------------------------------------------------------------------------
  push r10
  mov @r4, r10  ; Fetch digit

  cmp #10, r10  ; 0-9:
  jhs +
  add #48, r10  ; Shift to beginning of ASCII numbers
  jmp +++

+ cmp #36, r10  ; A-Z:
  jhs +
  add #55, r10  ; Shift to beginning of ASCII-capital-letters- 10 = 55.
  jmp ++        ; For small letters: 87.

+ mov #35, r10  ; Character #, if digit is not printable

+ mov r10, @r4  ; Return Character
  pop r10
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "digit" ; Converts a character into a digit.
flagdigit: ; ( c -- false / u true )
;------------------------------------------------------------------------------
  push r10
  mov @r4, r10   ; Fetch character

  sub #48, r10   ; Subtract "0"
  jlo +          ; Negative ? --> Invalid character.

  cmp #10, r10   ; In range up to "9" ?
  jlo ++         ; Digit recognized properly.

  ; Character is a letter. 

  sub #7,  r10  ; Beginning of capital letters "A"
  cmp #10, r10  ; Values of letters start with 10
  jlo +         ; --> Character has been a special one between numbers and capital letters.

  cmp #36, r10  ; 26 letters available.
  jlo ++        ; In this range ? Digit recognized properly.

  ; Try to recognize small letters.

  sub #32, r10  ; Beginning of small letters "a"
  cmp #10, r10  ; Values of letters start with 10
  jlo +         ; --> Character has been a special one between small and capital letters.

  cmp #36, r10  ; 26 letters available.
  jlo ++        ; In this range ? Digit recognized properly.

  ; Not yet recognized ? --> Character has been a special one above small letters or in Unicode.
  ; No valid digit then..

/ clr @r4  ; Error.
  pop r10
  ret

+ ; Check if digit is within current base !
  cmp &Base, r10
  jhs -          ; Do not accept digits greater than current base

  mov r10, @r4
  pushda #-1
  pop r10
  ret

  ifndef fixkommarechnungeneinbinden

  ; This is number without support for double and s15.16 formats.
  ; Look at full-featured implementation of number in fixpoint.asm for English description.

;------------------------------------------------------------------------------
  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" ; Insert one character at the beginning of number buffer
hold: ; ( Character -- )
;------------------------------------------------------------------------------
  cmp.b #Zahlenpufferlaenge, &Zahlenpuffer
  jhs ++ ; Number buffer full ?

  ; Old String:  | Length     |     |
  ; New String:  | Length + 1 | New |

  ; Old String:  | Length     | I   | II  | III |     |
  ; New String:  | Length + 1 | New | I   | II  | III |

  push r10
  mov.b &Zahlenpuffer, r10 ; Fetch old length of buffer
  inc.b &Zahlenpuffer      ; Increment it

  ; Check if at least one character has to be moved
  tst r10
  je +

    ; Yes, move r10 characters.
-   mov.b Zahlenpuffer(r10), Zahlenpuffer+1(r10)
    dec r10
    jnz -

+ pop r10

  mov.b @r4, &Zahlenpuffer+1 ; Insert new character

+ incd r4 ; Drop character from stack
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "sign"
vorzeichen: ; ( n -- ) Checks flag of number on stack and adds a minus to number buffer if it is negative.
;------------------------------------------------------------------------------
  tst @r4
  jn +
  drop
  ret

+ mov #45, @r4  ; ASCII for minus
  jmp hold      ; put it into number buffer

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "#S"
alleziffern: ; ( u|ud -- u|ud=0 )
             ; Inserts all digits, at least one, into number buffer.
;------------------------------------------------------------------------------
- call #ziffer
  tst @r4   ; Continue if there is still something in high part
  jne -

  ifdef doppeltzahleneinbinden
    tst 2(r4) ; or in low part of number to print.
    jne -
  endif

  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "#"
ziffer: ; ( u -- u ) oder
        ; ( uL uH -- uL uH )
        ; Insert one more digit into number buffer
;------------------------------------------------------------------------------
  ; Idea: Divide by base. Remainder is digit, Result is to be handled in next run.

  ifdef doppeltzahleneinbinden

    pushdadouble &Base, #0 ; Base-Low and Base-High
    ; ( uL uH BaseL BaseH )
    call #ud_slash_mod
    ; ( RemainderL RemainderH uL uH )
    call #dswap
    ; ( uL uH RemainderL RemainderH )
    drop
    ; ( uL uH RemainderL )
    call #digitausgeben
    jmp hold

  else

    ; # normally handles double numbers. This one uses single numbers only.
    pushda &Base
    ; (u Base -- )
    call #u_divmod ; ( Dividend Divisor -- Remainder Result )
    swap
    ; ( Result Remainder )
    call #digitausgeben
    ; ( Result Character )
    jmp hold
    ; ( Result )

  endif

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "#>" ; ( u|ud -- Addr )
zifferstringende:  ; Finishes a number string and gives back its address.
;------------------------------------------------------------------------------
  ifdef doppeltzahleneinbinden
    drop
  endif
  mov #Zahlenpuffer, @r4
  ret

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "<#" ; ( n|d -- )
zifferstringanfang: ; Opens a number string
;------------------------------------------------------------------------------
  clr.b &Zahlenpuffer ; Clear number buffer
  ret


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

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "u." ; ( u -- )
udot: ; Prints an unsigned single number
;------------------------------------------------------------------------------
  pushda #0 ; Convert to unsigned double
  jmp +

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "." ; ( n -- )
dot: ; Prints a signed single number
;------------------------------------------------------------------------------
  call #doppeltlangmachen
  jmp +

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "ud." ; ( ud -- )
      ; Prints an unsigned double number
;------------------------------------------------------------------------------
  ; In Forth: <# #S #>
  call #zifferstringanfang
  call #alleziffern
  jmp abschluss_zahlenausgabe

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "d." ; ( d -- )
     ; Prints a signed double number
;------------------------------------------------------------------------------
+ call #tuck
  call #dabs

  call #zifferstringanfang
  call #alleziffern ; ( Sign 0 0 )
  add #4, r4
  call #vorzeichen
  sub #4, r4  ; ( Random Random ) Will be dropped anyway.

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

  else  ; ifdef doppeltzahleneinbinden

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "u." ; ( u -- )
udot: ; Prints an unsigned single number
;------------------------------------------------------------------------------
  call #zifferstringanfang
  call #alleziffern
  jmp dot_inneneinsprung

;------------------------------------------------------------------------------
  Wortbirne Flag_visible, "." ; ( n -- )
dot: ; Prints a signed single number
;------------------------------------------------------------------------------
  dup ; ( Sign n )
  abs ; ( Sign u )
  call #zifferstringanfang
  call #alleziffern ; ( Sign 0 )
  swap              ; ( 0 Sign )
  call #vorzeichen

dot_inneneinsprung:
  call #zifferstringende

  call #schreibestringmitlaenge
  write " "
  ret

  endif ; ifdef doppeltzahleneinbinden
