;; f2a -- converts a floating-point number to an ASCII string (compatible
;;        with the format used in the Microsoft's QuickBASIC, PDS and
;;        VBDOS interpreters and/or compilers)
;;
;; copyleft (c) Jan/2001 by v1ctor [av1ctor@yahoo.com.br]

;; for 386+ with math co-processor | optimized for Pentium

;; references used:
;;  - Intel 80287/80387 Programmer's Reference Manuals
;;  - The Art of Assembly book, chapter 14th
;;  - MASM 6.1 QuickHelp

;; bug:
;; * falses need f/ sci notation (9999999.0 or 0.0000001 f/ singles)

.data
single          dd      1.234567e-32 ;0.9999999 ;9999999.0 ;0.0000001 ;1000000.0 ;1.234567 ;3.333
double          dq      1.234567890123456e-300 ;0.9999999999999999 ;9999999999999999.0 ;0.0000000000000001 ;1000000000000000.0 ;1.234567890123456;3.33333333
crlf            db      13,10,'$'

.bss
asc_str         resb    30

.code

;;::::::::::::::
single_2_asc:   ;;  in: ebx-> single
                ;;      edx-> asc string (w/ length >= 13 bytes)
                push    ecx
                push    edi

                fld     dword [ebx]
                mov     edi, edx
                mov     ecx, 7
                call    near f2a

                pop     edi
                pop     ecx
                ret

;;::::::::::::::
double_2_asc:   ;;  in: ebx-> double
                ;;      edx-> asc string (w/ length >= 23 bytes)
                push    ecx
                push    edi

                fld     qword [ebx]
                mov     edi, edx
                mov     ecx, 16
                call    near f2a

                pop     edi
                pop     ecx
                ret

;;::::::::::::::
f2a:            ;;  in: st0= float
                ;;      edi-> asc string
                ;;      ecx= digits (max 7 f/ SINGLEs and 16 f/ DOUBLEs)
                ;;
                ;; out: eax= asc string length
                push    ebx
                push    ecx
                push    edx

                fnstcw  word [old_cw]           ;; save control word
                mov     ax, [old_cw]
                mov     [cur_cw], ax

                push    edi                     ;; (0)

                ;; check if NaN, zero or negative
                ftst
                fnstsw  ax
                sahf
                jp      near ffnan              ;; NaN?
                jz      near ffzero             ;; 0?

                mov     al, ' '                 ;; assume positive (QB quirk)
                jnb     ffsave_sign
                fabs                            ;; 2 positive
                mov     al, '-'

ffsave_sign:    mov     [edi], al
                inc     edi

                ;; check if out-of-range

                ;; 10 ^ b    = 2 ^ a
                ;; lg 10 ^ b = lg 2 ^ a
                ;; b * lg 10 = a * lg 2  || lg 2 = 1
                ;; b         = (int)(a / lg 10)

                ;; find a
                fld     st0                     ;; dup tos
                fxtract                         ;; st1= a, st0= m
                fstp    st0                     ;; pop m
                fist    dword [exp2]            ;; save the pow2
                ;; calc b
                fld     tword [const_il2t]      ;; 1 / lg 10
                fmulp   st1, st0
                frndint                         ;; 2 int
                fist    dword [exp10]           ;; save b & leave it on st0

                ;; abs(b) >= cx
                mov     eax, [exp10]
                cdq                             ;; got this ABS gem from
                xor     eax, edx                ;;  Imphobia magazine :}
                sub     eax, edx                ;; /
                cmp     eax, ecx
                jge     near ffsci_notation     ;; use scientific notation?

                fstp    st0                     ;; pop b
;;::::::::::::::
                ;; decimal notation

                cmp     dword [exp2], 0
                jle     ffset_round             ;; exp2 <= 0?
                ;; put the integer part in fractional part (to use
                ;; FMUL (1 clock) instead of FDIV or DIV (40 clocks))
                mov     ebx, [exp10]
                shl     ebx, 1                  ;; ebx= qword (8 bytes) index
                fld     tword [ipow10_tb+ebx*4+ebx]
                fmulp   st1, st0

ffset_round:    ;; change rounding control to truncating toward 0
                or      word [cur_cw], 110000000000b
                fldcw   [cur_cw]

                ;; handle dizima periodica (0.99999999999999998 -> 1.0)
                cmp     ecx, 8
                sbb     ebx, ebx                ;; ebx= (ecx < 8? -2: 0)
                shl     ebx, 1                  ;; /
                fld     tword [dizima_tb+ebx*4+ebx + 10]
                faddp   st1, st0

                ;; set last mantissa's bit (to prevent dizima to happen)
                fstp    tword [_dt]
                or      byte [_dt+1], 10b
                fld     tword [_dt]

                ;; float 2 dec
                ;; if number has integer part:
                ;;    int digits = exponent
                ;;    frac digits = digits - int digits
                ;; else
                ;;    int digits = 0
                ;;    frac digits = digits

                cmp     dword [exp2], 0
                jl      near ffno_int           ;; no int digits?

                mov     ebx, [exp10]            ;; ebx= int digits (exp)
                mov     edx, ecx                ;; edx= frac digits (dig - int)
                sub     edx, ebx                ;; /

                mov     ecx, edx                ;; ecx= digits - int + 1
                inc     ecx                     ;; /

                ;; check if already has an int digit
                fist    dword [_int]
                mov     al, byte [_int]
                test    al, al
                jz      ffiloop                 ;; not?
                add     al, '0'                 ;; 2 asc
                mov     [edi], al
                inc     edi
                dec     edx                     ;; --frac digits
                dec     ecx
                test    ebx, ebx
                jz      ffcheck_frac            ;; any more int digits?

ffiloop:        fisub   dword [_int]            ;; del digit
                fmul    qword [const_10]        ;; next digit
                fist    dword [_int]            ;; get digit

                mov     al, byte [_int]
                add     al, '0'                 ;; 2 asc
                mov     [edi], al
                inc     edi
                dec     ebx
                jnz     ffiloop

ffcheck_frac:   test    edx, edx
                jle     ffdone                  ;; any frac digit?
                mov     byte [edi], '.'
                inc     edi

fffloop:        fisub   dword [_int]            ;; del digit
                fmul    qword [const_10]        ;; next digit
                fist    dword [_int]            ;; get digit

                mov     al, byte [_int]         ;; /
                add     al, '0'                 ;; 2 asc
                mov     [edi], al
                inc     edi
                dec     edx
                jnz     fffloop

                ;; delete zero(s) at right
                mov     al, '0'
                dec     edi
                std                             ;; go down
                repe    scasb                   ;; scan while = '0'
                cld
                cmp     ecx, 1                  ;; all digits= '0'? del '.'
                sbb     ecx, ecx                ;; ecx= 2 + (ecx == 0? -1: 0)
                add     ecx, 2                  ;; /
                add     edi, ecx                ;;
                jmp     ffdone

ffno_int:       mov     byte [edi], '.'         ;; (QB quirk)
                inc     edi
                mov     edx, ecx                ;; edx= frac digits (dig)
                inc     ecx                     ;; ecx= digits + 1
                mov     dword [_int], 0         ;; f/ FISUB
                jmp     fffloop

ffdone:         fstp    st0                     ;; pop tos

;;::::::::::::::
ffexit:         mov     eax, edi
                pop     edi                     ;; (0)
                sub     eax, edi                ;; asc string length

                fldcw   [old_cw]                ;; restore control word

                pop     edx
                pop     ecx
                pop     ebx
                ret

;;::::::::::::::
ffzero:         fstp    st0                     ;; pop 0
                mov     word [edi], ' 0'        ;; (QB quirk)
                add     edi, 2
                jmp     ffexit

;;::::::::::::::
ffnan:          fstp    tword [_dt]             ;; pop NaN
                shl     byte [_dt+9], 1
                sbb     bl, bl                  ;; bl= (NaN >= 0? 0: 2)
                and     bl, 10b                 ;; /
                mov     ax, '1+'
                add     al, bl
                mov     [edi], ax
                mov     dword [edi+2], 'AN#.';; (QB quirk)
                mov     byte  [edi+6], 'N'
                add     edi, 7
                jmp     ffexit

;;::::::::::::::
ffsci_notation: ;; f=float, m=mantissa (frac), a=exponent (int)
                ;; f = m * (2 ^ a)
                ;; m = f / (2 ^ a)
                ;; for decimal base: m = f / (10 ^ b)

                ;; calc 10 ^ b

                ;; x = 10 ^ b
                ;; lg x = lg 10 ^ b
                ;; lg x = b * lg 10
                ;; 2 ^ (b * lg 10) = x
                fldl2t                          ;; b*= lg 10
                fmulp   st1, st0                ;; /

                ;; 2 ^ b = (2 ^ (int)b) * (2 ^ (b - (int)b))
                fld     st0                     ;; dup tos
                frndint                         ;; (int)b
                fsub    st1, st0                ;; b - (int)b
                fxch
                f2xm1                           ;; (2 ^ (b - (int)b) - 1
                fld1                            ;; + 1
                faddp   st1, st0                ;; /
                fscale                          ;; st0 * (b ^ (int)b)
                fstp    st1                     ;; free

                ;; m= f / (10 ^ b)
                fdivp   st1, st0

                ;; change rounding control to truncating toward 0
                or      word [cur_cw], 110000000000b
                fldcw   [cur_cw]

                ;; handle dizima periodica (0.9999999999 -> 1.0)
                cmp     ecx, 8
                sbb     ebx, ebx                ;; ebx= (cx < 8? -2: 0)
                shl     ebx, 1                  ;; /
                fld     tword [dizima_tb+ebx*4+ebx + 10]
                faddp   st1, st0

                ;; set last mantissa's bit (to prevent dizima to happen)
                fstp    tword [_dt]
                or      byte [_dt+1], 10b
                fld     tword [_dt]

                ;; float 2 dec
                ;; mantissa (integer part)
                fist    dword [_int]
                mov     al, byte [_int]
                test    al, al
                jnz     ffsave_int              ;; not zero?

                fmul    qword [const_10]        ;; next digit
                dec     dword [exp10]           ;; --exponent
                fist    dword [_int]
                mov     al, byte [_int]

ffsave_int:     add     al, '0'                 ;; 2 asc
                mov     [edi], al
                mov     byte [edi+1], '.'
                add     edi, 2

                ;; mantissa (fractional part)
                mov     ebx, ecx                ;; ebx= number-of-digits - 1
                dec     ebx                     ;; /

ffloop:         fisub   dword [_int]            ;; del digit
                fmul    qword [const_10]        ;; next digit
                fist    dword [_int]            ;; get digit

                mov     al, byte [_int]         ;; /
                add     al, '0'                 ;; 2 asc
                mov     [edi], al
                inc     edi
                dec     ebx
                jnz     ffloop

                fstp    st0                     ;; free tos

                ;; delete zero(s) at right
                mov     ebx, ecx                ;; save number-of-digits
                mov     al, '0'
                dec     edi
                std                             ;; go down
                repe    scasb                   ;; scan while = '0'
                cld
                cmp     ecx, 1                  ;; all digits= '0'? del '.'
                sbb     ecx, ecx                ;; ecx= 2 + (ecx == 0? -1: 0)
                add     ecx, 2                  ;; /
                add     edi, ecx                ;;

ffexp:          ;; exponent
                mov     eax, [exp10]
                ;; eax= abs(eax)
                cdq
                xor     eax, edx
                sub     eax, edx

                ;; bl= (digits <= 8? 'E': 'D') (QB quirk)
                cmp     ebx, 8
                sbb     bl, bl
                and     bl, 1
                add     bl, 'D'
                mov     [edi], bl

                ;; sign
                and     dl, 10b
                add     dl, '+'                 ;; dl= '+' or '-'
                mov     [edi+1], dl
                ;; bin 2 dec
                mov     ecx, 10
                cmp     eax, 99
                ja      ff3_digits              ;; exp > 99?

                div     cl
                add     ax, '00'                ;; dec 2 asc
                mov     [edi+2], ax             ;; save
                add     edi, 4
                jmp     ffexit

ff3_digits:     xor     edx, edx
                div     ecx
                div     cl
                add     dl, '0'                 ;; dec 2 asc
                add     ax, '00'                ;; /
                mov     [edi+2], ax             ;; save
                mov     [edi+4], dl             ;; /
                add     edi, 5
                jmp     ffexit

.data
const_il2t      dt      0.3010299956639811952   ;; 1 / lg 10
const_10        dq      10.0
dizima_tb       dt      9.E-8
                dt      9.E-17

                ;; 1 / pow10(0..16) table
ipow10_tb       dt      1.E-00, 1.E-01, 1.E-02, 1.E-03, 1.E-04, 1.E-05
                dt      1.E-06, 1.E-07, 1.E-08, 1.E-09, 1.E-10, 1.E-11
                dt      1.E-12, 1.E-13, 1.E-14, 1.E-15, 1.E-16

.bss
old_cw          resw    1                       ;; control word
cur_cw          resw    1                       ;; /
exp2            resd    1                       ;; pow of 2
exp10           resd    1                       ;;  '   ' 10
_int            resd    1
_dt             rest    1




; --- Floating Point Val
; EBX, String
; RET: Value in FPU

FVal:
  XOR EDI, EDI
  mov ecx, [ebx]
  add ebx, 3
  mov al, [ebx+1]
  cmp al, 45
  JNE NEAR  fnoneg
   mov edi, 1
   dec ecx
   inc ebx
fnoneg:
XOR EAX, EAX
XOR EDX, EDX
fnext1:
   INC EBX
   INC EDX
   DEC ECX
     mov al, [ebx]
     sub al, 48
     PUSH EAX
   CMP ECX, 0
JNE NEAR  fnext1
  MOV ecx, edx
  MOV EBX, 1
  XOR ESI, ESI
fnext2:
  DEC ECX
    POP EAX
    cmp al, -2
    je near fnext3
    XOR EDX, EDX
    MUL EBX
      add esi, eax
    MOV EDX, EBX
    Shl ebx, 1
    shl edx, 3
    add ebx, edx
  CMP ECX, 0
JNE NEAR  fnext2

fldz
jmp fnext5

fnext3:
mov [tmpvar], esi
fild dword [tmpvar]
mov [tmpvar], ebx
fidiv dword [tmpvar]
MOV EBX, 1
xor esi,esi
;cmp edi, 0
;JE NEAR fnext4 
;  mov esi, -1
;  mov edi, 0

fnext4:
  CMP ECX, 0
  JE NEAR  fnext5
  DEC ECX
    POP EAX
    XOR EDX, EDX
    MUL EBX
      add esi, eax
    MOV EDX, EBX
    Shl ebx, 1
    shl edx, 3
    add ebx, edx
JMP NEAR  fnext4

fnext5:
mov [tmpvar], esi
fiadd dword [tmpvar]
cmp edi, 1
JNE NEAR fnext6
fchs
fnext6:

RET

