Author Topic: decimal floating point (Read 4396 times)

jack · « **on:** June 12, 2021, 10:52:04 pm »

I am making progress, I implemented addition subtraction and multiplication
floating point multiplication should be working
sub's and functions
dim as decfloat x, y, result
dim as long n ' value restricted to 9 decimal digits, positive or negative
Call str2dec("123", x) ' converts string to decfloat and stores it in x
Print dec2str(x) ' converts a decfloat to string
Print dec2str_fix(x) ' converts a decfloat to string without scientific notation, not reccomended for very lare numbers
Call fpadd(result, x, y) ' adds: x + y into result
Call fpsub(result, x, y) ' subtracts: x - y into result
Call fpmul(result, x, y) ' multiplies: x * y into result
Call fpmul_si(result, x, n) ' multiplies by a long: x * n into result
n=cmp(x, y) 'function that compares x and y: returns -1 if x<y, 0 if x=y and 1 if x>y

Code: QB64: [Select]

''$Checking:Off
$Console:Only
_Dest _Console
 
Const NUM_DIGITS = 9 * 312 '50731 '3963
Const NUM_DWORDS = NUM_DIGITS \ 9
Const NUM_BYTES = 2 + 4 * NUM_DWORDS
Const BIAS = 1073741824 '2 ^ 30
 
' Error definitions
 
Const DIVZ_ERR = 1 'Divide by zero
Const EXPO_ERR = 2 'Exponent overflow error
Const EXPU_ERR = 3 'Exponent underflow error
 
Type decfloat
    sign As Integer
    exponent As _Unsigned Long
    mantissa As String * Num_bytes
End Type
 
Dim As decfloat x, y, z
 
Dim As Long i, j
Dim As Double t
Dim As String fib, s
fib = "999999999999999999999998999999999999999999999999"
t = Timer
Call str2dec(fib, x)
Call recip(y, x)
s = dec2str_fix(y)
j = InStr(s, ".")
s = Mid$(s, j + 1)
 
j = 1
For i = 1 To 58
    Print Mid$(s, j, 24), Mid$(s, j + 24, 24)
    j = j + 48
Next
t = Timer - t
Print "fib by reciprocal time is "; t; " seconds"
 
'Call str2dec("1", x)
'z = x
 
't = Timer
 
'For i = 1 To 100000
'Call fpmul_si(z, z, i)
'Next
't = Timer - t
 
'Print dec2str(z)
'Print "factorial 10000 in "; t; " seconds"
 
Sub str2dec (value As String, n As decfloat)
    Dim As Long j, s, d, e, ep, ex, es, i, f, fp, fln
    Dim As String c, f1, f2, f3, ts
    Dim As _Unsigned Long ulng
 
    j = 1
    s = 1
    d = 0
    e = 0
    ep = 0
    ex = 0
    es = 1
    i = 0
    f = 0
    fp = 0
    f1 = ""
 
    f2 = ""
    f3 = ""
    value = UCase$(value)
    fln = Len(value)
 
    While j <= fln
        c = Mid$(value, j, 1)
        If ep = 1 Then
            If c = " " Then
                j = j + 1
                GoTo skip_while
            End If
            If c = "-" Then
                es = -es
                c = ""
            End If
            If c = "+" Then
                j = j + 1
                GoTo skip_while
            End If
            If (c = "0") And (f3 = "") Then
                j = j + 1
                GoTo skip_while
            End If
            If (c > "/") And (c < ":") Then 'c is digit between 0 and 9
                f3 = f3 + c
                ex = 10 * ex + (Asc(c) - 48)
                j = j + 1
                GoTo skip_while
            End If
        End If
 
        If c = " " Then
            j = j + 1
            GoTo skip_while
        End If
        If c = "-" Then
            s = -s
            j = j + 1
            GoTo skip_while
        End If
        If c = "+" Then
            j = j + 1
            GoTo skip_while
        End If
        If c = "." Then
            If d = 1 Then
                j = j + 1
                GoTo skip_while
            End If
            d = 1
        End If
        If (c > "/") And (c < ":") Then 'c is digit between 0 and 9
            If ((c = "0") And (i = 0)) Then
                If d = 0 Then
                    j = j + 1
                    GoTo skip_while
                End If
                If (d = 1) And (f = 0) Then
                    e = e - 1
                    j = j + 1
                    GoTo skip_while
                End If
            End If
            If d = 0 Then
                f1 = f1 + c
                i = i + 1
            Else
                If (c > "0") Then
                    fp = 1
                End If
                f2 = f2 + c
                f = f + 1
            End If
        End If
        If c = "E" Or c = "D" Then
            ep = 1
        End If
        j = j + 1
        skip_while:
    Wend
    If fp = 0 Then
        f = 0
        f2 = ""
    End If
 
    If s = -1 Then s = &H8000 Else s = 0
    n.sign = s
    ex = es * ex - 1 + i + e
    f1 = f1 + f2
    f1 = Mid$(f1, 1, 1) + Right$(f1, Len(f1) - 1)
    fln = Len(f1)
    If Len(f1) > ((NUM_DWORDS * 9) + 1) Then
        f1 = Mid$(f1, 1, ((NUM_DWORDS * 9) + 1))
    End If
    While Len(f1) < ((NUM_DWORDS * 9) + 1)
        f1 = f1 + "0"
    Wend
    j = 1
    For i = 0 To NUM_DWORDS - 1
        ts = Mid$(f1, j, 9)
        ulng = Val(ts)
        Mid$(n.mantissa, 4 * i + 1, 4) = MKL$(ulng)
        If ulng <> 0 Then fp = 1
        j = j + 9
    Next
    If fp Then n.exponent = (ex + BIAS + 1) Else n.exponent = 0
End Sub
 
Function dec2str$ (n As decfloat)
    Dim As Long i, ex
    Dim As String v, f, ts
    If n.exponent > 0 Then
        ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
    Else
        ex = 0
    End If
    If n.sign Then v = "-" Else v = " "
    ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * 0 + 1, 4))))
    If Len(ts) < 9 Then
        ts = ts + String$(9 - Len(ts), "0")
    End If
    v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
    For i = 1 To NUM_DWORDS - 1
        ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * i + 1, 4))))
        If Len(ts) < 9 Then
            ts = String$(9 - Len(ts), "0") + ts
        End If
        v = v + ts
    Next
    f = _Trim$(Str$(Abs(ex)))
    f = String$(5 - Len(f), "0") + f
    If ex < 0 Then v = v + "E-" Else v = v + "E+"
    v = v + f
    dec2str = v
End Function
 
Function dec2str_fix$ (n As decfloat)
    Dim As Long i, ex
    Dim As String v, ts, s
    If n.exponent > 0 Then
        ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
    Else
        ex = 0
    End If
    If n.sign Then s = "-" Else s = " "
    ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * 0 + 1, 4))))
    If Len(ts) < 9 Then
        ts = ts + String$(9 - Len(ts), "0")
    End If
    v = ts
    For i = 1 To NUM_DWORDS - 1
        ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * i + 1, 4))))
        If Len(ts) < 9 Then
            ts = String$(9 - Len(ts), "0") + ts
        End If
        v = v + ts
    Next
    If ex = 0 Then
        v = Left$(v, 1) + "." + Mid$(v, 2)
    ElseIf ex < 0 Then
        v = "0." + String$(Abs(ex) - 1, "0") + v
    ElseIf ex > 0 Then
        v = Left$(v, ex + 1) + "." + Mid$(v, ex + 2)
    End If
    dec2str_fix = s + v
End Function
 
Function dec2dbl# (n As decfloat)
    Dim As Long ex
    Dim As String v, f, ts
    If n.exponent > 0 Then
        ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
    Else
        ex = 0
    End If
    If n.sign Then v = "-" Else v = " "
    ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * 0 + 1, 4))))
    If Len(ts) < 9 Then
        ts = ts + String$(9 - Len(ts), "0")
    End If
    v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
 
    ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * 1 + 1, 4))))
    If Len(ts) < 9 Then
        ts = String$(9 - Len(ts), "0") + ts
    End If
    v = v + ts
 
    f = _Trim$(Str$(Abs(ex)))
    f = String$(5 - Len(f), "0") + f
    If ex < 0 Then v = v + "E-" Else v = v + "E+"
    v = v + f
    dec2dbl = Val(v)
End Function
 
Sub RSHIFT_1 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 10
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 10
        v2 = v2 * 100000000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 10)
End Sub
 
Sub LSHIFT_1 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 100000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 100000000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 10 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 100000000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(10 * CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 100000000)
End Sub
 
Sub RSHIFT_2 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 100
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 100
        v2 = v2 * 10000000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 100)
End Sub
 
Sub LSHIFT_2 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 10000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 10000000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 100 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 10000000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(100 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 10000000))
End Sub
 
Sub RSHIFT_3 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 1000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 1000
        v2 = v2 * 1000000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 1000)
End Sub
 
Sub LSHIFT_3 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 1000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 1000000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 1000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 1000000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(1000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 1000000))
End Sub
 
Sub RSHIFT_4 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 10000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 10000
        v2 = v2 * 100000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 10000)
End Sub
 
Sub LSHIFT_4 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 100000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 100000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 10000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 100000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(10000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 100000))
End Sub
 
Sub RSHIFT_5 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 100000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 100000
        v2 = v2 * 10000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 100000)
End Sub
 
Sub LSHIFT_5 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 10000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 10000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 100000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 10000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(100000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 10000))
End Sub
 
Sub RSHIFT_6 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 1000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 1000000
        v2 = v2 * 1000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 1000000)
End Sub
 
Sub LSHIFT_6 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 1000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 1000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 1000000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 1000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(1000000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 1000))
End Sub
 
Sub RSHIFT_7 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 10000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 10000000
        v2 = v2 * 100 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 10000000)
End Sub
 
Sub LSHIFT_7 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 100
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 100
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 10000000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 100)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(10000000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 100))
End Sub
 
Sub RSHIFT_8 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 100000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 100000000
        v2 = v2 * 10 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 100000000)
End Sub
 
Sub LSHIFT_8 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 10
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 10
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 100000000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 10)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(100000000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 10))
End Sub
 
Sub RSHIFT_9 (mantissa As decfloat)
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(0)
End Sub
 
Sub LSHIFT_9 (mantissa As decfloat)
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        Mid$(mantissa.mantissa, 4 * i + 1) = Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(0)
End Sub
 
Function cmp% (x As decfloat, y As decfloat)
    Dim As Long c, i
    If x.sign = y.sign Then
        If x.exponent = y.exponent Then
            For i = 0 To NUM_DWORDS - 1
                c = CVL(Mid$(x.mantissa, 4 * i + 1, 4)) - CVL(Mid$(y.mantissa, 4 * i + 1, 4))
                If c <> 0 Then Exit For
            Next
            If c < 0 Then
                cmp = -1
                Exit Function
            ElseIf c = 0 Then
                cmp = 0
                Exit Function
            ElseIf c > 0 Then
                cmp = 1
                Exit Function
            End If
        End If
        If x.exponent < y.exponent Then
            cmp = -1
            Exit Function
        End If
        If x.exponent > y.exponent Then
            cmp = 1
            Exit Function
        End If
    End If
    If x.sign Then cmp = -1
End Function
 
Function NORM_FAC1% (fac1 As decfloat)
    ' normalize the number in fac1
    ' all routines exit through this one.
    ' we leave ax=0 if normalization was
    ' ok...else ax = error code.
 
    'see if the mantissa is all zeros.
    'if so, set the exponent and sign equal to 0.
    Dim As Long i, er, f
    er = 0: f = 0
    For i = 0 To NUM_DWORDS - 1
        If CVL(Mid$(fac1.mantissa, 4 * i + 1, 4)) > 0 Then f = 1
    Next
    If f = 0 Then
        fac1.exponent = 0
        fac1.sign = 0
        Exit Function
        'if the highmost nibble in fac1_man is nonzero,
        'shift the mantissa right 1 nibble and
        'increment the exponent
    ElseIf CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) > 999999999 Then
        Call RSHIFT_1(fac1)
        fac1.exponent = fac1.exponent + 1
    Else
        'now shift fac1_man 1 to the left until a
        'nonzero digit appears in the next-to-highest
        'nibble of fac1_man.  decrement exponent for
        'each shift.
        While CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) < 100000000
            Call LSHIFT_1(fac1)
            fac1.exponent = fac1.exponent - 1
            If fac1.exponent = 0 Then
                NORM_FAC1 = EXPU_ERR
                Exit Function
            End If
        Wend
    End If
    'check for overflow/underflow
    If fac1.exponent < 0 Then
        NORM_FAC1 = EXPO_ERR
    End If
End Function
 
Sub fpadd_aux (fac1 As decfloat, fac2 As decfloat)
    Dim As _Unsigned Long v, c, i
    Dim As Integer er
    c = 0
    For i = NUM_DWORDS - 1 To 1 Step -1
        v = CVL(Mid$(fac2.mantissa, 4 * i + 1, 4)) + CVL(Mid$(fac1.mantissa, 4 * i + 1, 4)) + c
        If v > 999999999 Then
            v = v - 1000000000
            c = 1
        Else
            c = 0
        End If
        Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(v)
    Next
    v = CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + CVL(Mid$(fac2.mantissa, 4 * 0 + 1, 4)) + c
    Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(v)
 
    er = NORM_FAC1%(fac1)
 
End Sub
 
Sub fpsub_aux (fac1 As decfloat, fac2 As decfloat)
    Dim As Long v, c, i
    c = 0
    For i = NUM_DWORDS - 1 To 1 Step -1
        v = CVL(Mid$(fac1.mantissa, 4 * i + 1, 4)) - CVL(Mid$(fac2.mantissa, 4 * i + 1, 4)) - c
        If v < 0 Then
            v = v + 1000000000
            c = 1
        Else
            c = 0
        End If
        Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(v)
    Next
    v = CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) - CVL(Mid$(fac2.mantissa, 4 * 0 + 1, 4)) - c
    Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(v)
 
    c = NORM_FAC1(fac1)
End Sub
 
Sub fpadd (result As decfloat, x As decfloat, y As decfloat)
 
    Dim As decfloat fac1, fac2
    Dim As Long t, c, xsign, ysign
 
    xsign = x.sign: x.sign = 0
    ysign = y.sign: y.sign = 0
    c = cmp(x, y)
    x.sign = xsign
    y.sign = ysign
    If c < 0 Then
        fac1 = y
        fac2 = x
    Else
        fac1 = x
        fac2 = y
    End If
    t = fac1.exponent - fac2.exponent
 
    If t < NUM_DIGITS Then
        'The difference between the two
        'exponents indicate how many times
        'we have to multiply the mantissa
        'of FAC2 by 10 (i.e., shift it right 1 place).
        'If we have to shift more times than
        'we have digits, the result is already in FAC1.
        t = fac1.exponent - fac2.exponent
        If t > 0 And t < (NUM_DIGITS) Then 'shift
            While t
                Call RSHIFT_1(fac2)
                t = t - 1
            Wend
        End If
        'See if the signs of the two numbers
        'are the same.  If so, add; if not, subtract.
        If fac1.sign = fac2.sign Then 'add
            Call fpadd_aux(fac1, fac2)
        Else
            Call fpsub_aux(fac1, fac2)
        End If
    End If
    result = fac1
End Sub
 
Sub fpsub (result As decfloat, x As decfloat, y As decfloat)
    Dim As decfloat fac1, fac2
    fac1 = x
    fac2 = y
    fac2.sign = fac2.sign Xor &H8000
    Call fpadd(result, fac1, fac2)
End Sub
 
Sub fpmul_si (result As decfloat, x As decfloat, y As _Integer64)
    Dim As decfloat fac1
    Dim As Long count, ex, er, i
    Dim As _Integer64 value, carry, digit, prod
    fac1 = x
    digit = Abs(y)
    'check exponents.  if either is zero,
    'the result is zero
    If fac1.exponent = 0 Or y = 0 Then 'result is zero...clear fac1.
        fac1.sign = 0
        fac1.exponent = 0
        For count = 0 To NUM_DWORDS - 1
            Mid$(fac1.mantissa, 4 * count + 1, 4) = MKL$(0)
        Next
        er = NORM_FAC1(fac1)
        result = fac1
        Exit Sub
    Else
        If digit = 1 Then
            If y < 0 Then
                fac1.sign = fac1.sign Xor &H8000
            End If
            result = fac1
        End If
        'now determine exponent of result.
        'as you do...watch for overflow.
        '        ex=fac2.exponent-BIAS+fac1.exponent-1
 
        If ex < 0 Then
            er = EXPO_ERR
            Exit Sub
        End If
        'for number of digits in the floating
        'point number, add fac2 to fac1 number
        'of times given by lowest nibble in
        'fac3.  then shift fac1 and fac3
        'right 1 digit and repeat.
        'count=NUM_DIGITS-1
 
        carry = 0
 
        For i = NUM_DWORDS - 1 To 0 Step -1
            prod = CVL(Mid$(fac1.mantissa, 4 * i + 1, 4))
            prod = digit * prod + carry
            value = (prod Mod 1000000000)
            Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(value)
            carry = prod \ 1000000000
        Next
 
        If carry < 10 Then
            Call RSHIFT_1(fac1)
            fac1.exponent = fac1.exponent + 1
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 100000000)
        ElseIf carry < 100 Then
            Call RSHIFT_2(fac1)
            fac1.exponent = fac1.exponent + 2
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 10000000)
        ElseIf carry < 1000 Then
            Call RSHIFT_3(fac1)
            fac1.exponent = fac1.exponent + 3
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 1000000)
        ElseIf carry < 10000 Then
            Call RSHIFT_4(fac1)
            fac1.exponent = fac1.exponent + 4
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 100000)
        ElseIf carry < 100000 Then
            Call RSHIFT_5(fac1)
            fac1.exponent = fac1.exponent + 5
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 10000)
        ElseIf carry < 1000000 Then
            Call RSHIFT_6(fac1)
            fac1.exponent = fac1.exponent + 6
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 1000)
        ElseIf carry < 10000000 Then
            Call RSHIFT_7(fac1)
            fac1.exponent = fac1.exponent + 7
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 100)
        ElseIf carry < 100000000 Then
            Call RSHIFT_8(fac1)
            fac1.exponent = fac1.exponent + 8
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 10)
        ElseIf carry < 1000000000 Then
            Call RSHIFT_9(fac1)
            fac1.exponent = fac1.exponent + 9
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry)
        End If
 
    End If
 
    'fac1.exponent=fac2.exponent+fac1.exponent-BIAS-1
    er = NORM_FAC1(fac1)
    'fac1.exponent+=c 'ex
    'if v>100000000 then fac1.exponent+=1
    If y < 0 Then
        fac1.sign = fac1.sign Xor &H8000
    End If
    result = fac1
End Sub
 
Sub fpmul (result As decfloat, x As decfloat, y As decfloat)
    Dim As decfloat fac1, fac2, fac3
    Dim As Long i, j, ex, er
    Dim As _Integer64 prod, digit, carry
    Dim As _Unsigned Long c, v
 
    fac1 = x
    fac2 = y
    'check exponents.  if either is zero,
    'the result is zero
    If fac1.exponent = 0 Or fac2.exponent = 0 Then 'result is zero...clear fac1.
        fac1.sign = 0
        fac1.exponent = 0
        For i = 0 To NUM_DWORDS - 1
            Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(0)
        Next
        er = NORM_FAC1(fac1)
        result = fac1
        Exit Sub
    Else
 
        'now determine exponent of result.
        'as you do...watch for overflow.
        ex = fac2.exponent - BIAS + fac1.exponent
 
        If ex < 0 Then
            er = EXPO_ERR
            Exit Sub
        End If
        fac1.exponent = ex
        'determine the sign of the product
        fac1.sign = fac1.sign Xor fac2.sign
        'copy fac1 mantissa to fac3 and clear fac1's mantissa
        For i = 0 To NUM_DWORDS - 1
            Mid$(fac3.mantissa, 4 * i + 1, 4) = MKL$(0)
            Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(0)
        Next
        'for number of digits in the floating
        'point number, add fac2 to fac1 number
        'of times given by lowest nibble in
        'fac3.  then shift fac1 and fac3
        'right 1 digit and repeat.
 
        For j = NUM_DWORDS - 1 To 0 Step -1
            carry = 0
            digit = CVL(Mid$(y.mantissa, 4 * j + 1, 4))
            For i = NUM_DWORDS - 1 To 0 Step -1
                prod = digit * CVL(Mid$(x.mantissa, 4 * i + 1, 4)) + carry
                Mid$(fac3.mantissa, 4 * i + 1, 4) = MKL$(prod Mod 1000000000)
                carry = prod \ 1000000000
 
            Next
 
            Call RSHIFT_9(fac1)
            Call RSHIFT_9(fac3)
            Mid$(fac3.mantissa, 4 * 0 + 1, 4) = MKL$(carry)
 
            c = 0
            For i = NUM_DWORDS - 1 To 1 Step -1
                v = CVL(Mid$(fac3.mantissa, 4 * i + 1, 4)) + CVL(Mid$(fac1.mantissa, 4 * i + 1, 4)) + c
                If v > 999999999 Then
                    v = v - 1000000000
                    c = 1
                Else
                    c = 0
                End If
                Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(v)
            Next
            v = CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + CVL(Mid$(fac3.mantissa, 4 * 0 + 1, 4)) + c
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(v)
 
        Next
    End If
 
    er = NORM_FAC1(fac1)
    result = fac1
End Sub
 
Sub recip (result As decfloat, n As decfloat)
    Dim As Double x: x = dec2dbl(n)
    Dim As Long k, l
    Dim As decfloat r, r2, two
    l = Log(NUM_DIGITS * 0.0625) * 1.5
    If x = 0 Then Print "Div 0": Exit Sub
    If x = 1 Then
        Call str2dec("1", r)
        result = r
        Exit Sub
    End If
 
    x = 1# / x
    Call str2dec(Str$(x), r)
    Call str2dec("2", two)
    For k = 1 To l
        Call fpmul(r2, n, r)
        Call fpsub(r2, two, r2)
        Call fpmul(r, r, r2)
    Next k
 
    result = r
End Sub
 

jack · « **Reply #1 on:** June 13, 2021, 02:21:25 pm »

the addition and subtraction are now implemented, would someone give suggestions on the implementation of multiplication?
the old school method is probably the easiest, but I was hoping to implement the Karatsuba method
I saw no way to do subtraction without first determining which of the two numbers was smaller, it works fine but the time to do addition is doubled

jack · « **Reply #2 on:** June 15, 2021, 06:15:33 pm »

added multiply by signed integer, factorial 10000 takes about 10 seconds

Quote

2.8462596809170545189064132121198......00000000000000000000000000000E+35659
factorial 10000 in 9.9453125 seconds

George McGinn · « **Reply #3 on:** June 15, 2021, 07:41:59 pm »

I would, but since I'm running on Linux, the $CONSOLE and destination CONSOLE does not work.

Looking at the code, it is somewhat similar to the code my friend and I wrote in SmartBASIC.

That code will not run in QB64 without some extensive modification (we developed it to run on mobile devices), but I could send you the program so you can look at it (BASIC is still BASIC, so you should be able to read it).

Quote from: jack on June 13, 2021, 02:21:25 pm

the addition and subtraction are now implemented, would someone give suggestions on the implementation of multiplication?
the old school method is probably the easiest, but I was hoping to implement the Karatsuba method
I saw no way to do subtraction without first determining which of the two numbers was smaller, it works fine but the time to do addition is doubled

jack · « **Reply #4 on:** June 15, 2021, 07:50:20 pm »

you could simply comment-out those instructions, I don't like the graphic screen because you can't copy from it like you can from a console

jack · « **Reply #5 on:** June 16, 2021, 06:40:18 am »

I finally got multiplication working
@bplus would you describe your nInverse function perhaps in pseudo code?
I like to implement that, I know that I can use the Newton-Raphson method but the exponent range of decfloat far surpasses that of double and so it would be restricted to the range of double

jack · « **Reply #6 on:** June 16, 2021, 10:19:23 am »

using the Newton-Raphson for reciprocal

Code: [Select]

000000000000000000000000     000000000000000000000001
000000000000000000000001     000000000000000000000002
000000000000000000000003     000000000000000000000005
000000000000000000000008     000000000000000000000013
000000000000000000000021     000000000000000000000034
000000000000000000000055     000000000000000000000089
000000000000000000000144     000000000000000000000233
000000000000000000000377     000000000000000000000610
000000000000000000000987     000000000000000000001597
000000000000000000002584     000000000000000000004181
000000000000000000006765     000000000000000000010946
000000000000000000017711     000000000000000000028657
000000000000000000046368     000000000000000000075025
000000000000000000121393     000000000000000000196418
000000000000000000317811     000000000000000000514229
000000000000000000832040     000000000000000001346269
000000000000000002178309     000000000000000003524578
000000000000000005702887     000000000000000009227465
000000000000000014930352     000000000000000024157817
000000000000000039088169     000000000000000063245986
000000000000000102334155     000000000000000165580141
000000000000000267914296     000000000000000433494437
000000000000000701408733     000000000000001134903170
000000000000001836311903     000000000000002971215073
000000000000004807526976     000000000000007778742049
000000000000012586269025     000000000000020365011074
000000000000032951280099     000000000000053316291173
000000000000086267571272     000000000000139583862445
000000000000225851433717     000000000000365435296162
000000000000591286729879     000000000000956722026041
000000000001548008755920     000000000002504730781961
000000000004052739537881     000000000006557470319842
000000000010610209857723     000000000017167680177565
000000000027777890035288     000000000044945570212853
000000000072723460248141     000000000117669030460994
000000000190392490709135     000000000308061521170129
000000000498454011879264     000000000806515533049393
000000001304969544928657     000000002111485077978050
000000003416454622906707     000000005527939700884757
000000008944394323791464     000000014472334024676221
000000023416728348467685     000000037889062373143906
000000061305790721611591     000000099194853094755497
000000160500643816367088     000000259695496911122585
000000420196140727489673     000000679891637638612258
000001100087778366101931     000001779979416004714189
000002880067194370816120     000004660046610375530309
000007540113804746346429     000012200160415121876738
000019740274219868223167     000031940434634990099905
000051680708854858323072     000083621143489848422977
000135301852344706746049     000218922995834555169026
000354224848179261915075     000573147844013817084101
000927372692193078999176     001500520536206896083277
002427893228399975082453     003928413764606871165730
006356306993006846248183     010284720757613717413913
016641027750620563662096     026925748508234281076009
043566776258854844738105     070492524767089125814114
114059301025943970552219     184551825793033096366333
298611126818977066918552     483162952612010163284885
fib by reciprocal time is  .55078125  seconds

bplus · « **Reply #7 on:** June 16, 2021, 11:55:50 am »

Quote

@bplus would you describe your nInverse function perhaps in pseudo code?

Same as you learned in school how to divide only the denominator is integer > 1 and you are dividing into 1

Assume a decimal at the start output$ = "." let's take 15 as example

and now remainder r is 10 'it always starts like this
loop start
is divisor <= remainder?
no
15 is greater than 10 so output$ = output$ + "0" and now make remainder r = 100
loop back

yes
15 does go into 100 6 times so output$ = output$ +"6"
(for this part in string math I made a table (0 to 9) * denominator and go back from 9, 8, 7 until have highest mult <= remainder for 15 the table is 0, 15, 30, 45, 60, 75, 90, 105, 120, 135 in string form)
calc new remainder 100 -90 (15*6) = 10 new remainder is 10 again.
(So for String math I had to have Mult and Subtr for strings ready before attempting Inverse.)
say is remainder 0? if yes then division is done set function and exit
say is output$ long enough? if yes ie 100 digits long then set function and exit
else
add 0 to end of remainder and loop back to decision point

No estimation at all you just write out the inverse until you get exact 0 remainder or reach a string length limit.

When I did String Math I needed a Function that could compare 2 number strings and say which is the greater number, first compare lengths size matters the bigger is greater, if sizes match then go down strings and compare each digit the string having the greater or lesser digit. (if digit strings start with 0's remove them before testing lengths, so I needed a trim leading 0's function.)

jack · « **Reply #8 on:** June 16, 2021, 12:07:46 pm »

thank you bplus, much appreciated

bplus · « **Reply #9 on:** June 16, 2021, 12:18:11 pm »

One of these days I am going to get around to digging into what you and Luke are doing.

I suspect one of you is going to take advantage of binary math, you multiple and divide by shift 0's and 1's left and right. The addition and subtraction tables are pretty sweet too. But this involves an extra steps of converting to and from binary and decimal.

jack · « **Reply #10 on:** June 16, 2021, 01:19:36 pm »

I need to describe in comments what the code is supposed to doing, without clear comments it's hard to decipher the code

jack · « **Reply #11 on:** June 16, 2021, 06:11:06 pm »

432 Fibonacci numbers via reciprocal in 145 seconds

Code: QB64: [Select]

''$Checking:Off
$Console:Only
_Dest _Console
 
Const NUM_DIGITS = 9 * 4301 '4301 '312 '50731 '3963
Const NUM_DWORDS = NUM_DIGITS \ 9
Const NUM_BYTES = 2 + 4 * NUM_DWORDS
Const BIAS = 1073741824 '2 ^ 30
 
' Error definitions
 
Const DIVZ_ERR = 1 'Divide by zero
Const EXPO_ERR = 2 'Exponent overflow error
Const EXPU_ERR = 3 'Exponent underflow error
 
Type decfloat
    sign As Integer
    exponent As _Unsigned Long
    mantissa As String * Num_bytes
End Type
 
Dim As decfloat x, y, z
 
Dim As Long i, j
Dim As Double t
Dim As String fib, s
fib = String$(89, "9") + "8" + String$(90, "9")
 
t = Timer
Call str2dec(fib, x)
Call recip(y, x)
s = dec2str_fix(y)
j = InStr(s, ".")
s = Mid$(s, j + 1)
 
j = 1
For i = 1 To 432
    Print Mid$(s, j, 90)
    j = j + 90
Next
t = Timer - t
Print "fib by reciprocal time is "; t; " seconds"
 
'Call str2dec("1", x)
'z = x
 
't = Timer
 
'For i = 1 To 100000
'Call fpmul_si(z, z, i)
'Next
't = Timer - t
 
'Print dec2str(z)
'Print "factorial 10000 in "; t; " seconds"
 
Sub str2dec (value As String, n As decfloat)
    Dim As Long j, s, d, e, ep, ex, es, i, f, fp, fln
    Dim As String c, f1, f2, f3, ts
    Dim As _Unsigned Long ulng
 
    j = 1
    s = 1
    d = 0
    e = 0
    ep = 0
    ex = 0
    es = 1
    i = 0
    f = 0
    fp = 0
    f1 = ""
 
    f2 = ""
    f3 = ""
    value = UCase$(value)
    fln = Len(value)
 
    While j <= fln
        c = Mid$(value, j, 1)
        If ep = 1 Then
            If c = " " Then
                j = j + 1
                GoTo skip_while
            End If
            If c = "-" Then
                es = -es
                c = ""
            End If
            If c = "+" Then
                j = j + 1
                GoTo skip_while
            End If
            If (c = "0") And (f3 = "") Then
                j = j + 1
                GoTo skip_while
            End If
            If (c > "/") And (c < ":") Then 'c is digit between 0 and 9
                f3 = f3 + c
                ex = 10 * ex + (Asc(c) - 48)
                j = j + 1
                GoTo skip_while
            End If
        End If
 
        If c = " " Then
            j = j + 1
            GoTo skip_while
        End If
        If c = "-" Then
            s = -s
            j = j + 1
            GoTo skip_while
        End If
        If c = "+" Then
            j = j + 1
            GoTo skip_while
        End If
        If c = "." Then
            If d = 1 Then
                j = j + 1
                GoTo skip_while
            End If
            d = 1
        End If
        If (c > "/") And (c < ":") Then 'c is digit between 0 and 9
            If ((c = "0") And (i = 0)) Then
                If d = 0 Then
                    j = j + 1
                    GoTo skip_while
                End If
                If (d = 1) And (f = 0) Then
                    e = e - 1
                    j = j + 1
                    GoTo skip_while
                End If
            End If
            If d = 0 Then
                f1 = f1 + c
                i = i + 1
            Else
                If (c > "0") Then
                    fp = 1
                End If
                f2 = f2 + c
                f = f + 1
            End If
        End If
        If c = "E" Or c = "D" Then
            ep = 1
        End If
        j = j + 1
        skip_while:
    Wend
    If fp = 0 Then
        f = 0
        f2 = ""
    End If
 
    If s = -1 Then s = &H8000 Else s = 0
    n.sign = s
    ex = es * ex - 1 + i + e
    f1 = f1 + f2
    f1 = Mid$(f1, 1, 1) + Right$(f1, Len(f1) - 1)
    fln = Len(f1)
    If Len(f1) > ((NUM_DWORDS * 9) + 1) Then
        f1 = Mid$(f1, 1, ((NUM_DWORDS * 9) + 1))
    End If
    While Len(f1) < ((NUM_DWORDS * 9) + 1)
        f1 = f1 + "0"
    Wend
    j = 1
    For i = 0 To NUM_DWORDS - 1
        ts = Mid$(f1, j, 9)
        ulng = Val(ts)
        Mid$(n.mantissa, 4 * i + 1, 4) = MKL$(ulng)
        If ulng <> 0 Then fp = 1
        j = j + 9
    Next
    If fp Then n.exponent = (ex + BIAS + 1) Else n.exponent = 0
End Sub
 
Function dec2str$ (n As decfloat)
    Dim As Long i, ex
    Dim As String v, f, ts
    If n.exponent > 0 Then
        ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
    Else
        ex = 0
    End If
    If n.sign Then v = "-" Else v = " "
    ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * 0 + 1, 4))))
    If Len(ts) < 9 Then
        ts = ts + String$(9 - Len(ts), "0")
    End If
    v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
    For i = 1 To NUM_DWORDS - 1
        ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * i + 1, 4))))
        If Len(ts) < 9 Then
            ts = String$(9 - Len(ts), "0") + ts
        End If
        v = v + ts
    Next
    f = _Trim$(Str$(Abs(ex)))
    f = String$(5 - Len(f), "0") + f
    If ex < 0 Then v = v + "E-" Else v = v + "E+"
    v = v + f
    dec2str = v
End Function
 
Function dec2str_fix$ (n As decfloat)
    Dim As Long i, ex
    Dim As String v, ts, s
    If n.exponent > 0 Then
        ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
    Else
        ex = 0
    End If
    If n.sign Then s = "-" Else s = " "
    ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * 0 + 1, 4))))
    If Len(ts) < 9 Then
        ts = ts + String$(9 - Len(ts), "0")
    End If
    v = ts
    For i = 1 To NUM_DWORDS - 1
        ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * i + 1, 4))))
        If Len(ts) < 9 Then
            ts = String$(9 - Len(ts), "0") + ts
        End If
        v = v + ts
    Next
    If ex = 0 Then
        v = Left$(v, 1) + "." + Mid$(v, 2)
    ElseIf ex < 0 Then
        v = "0." + String$(Abs(ex) - 1, "0") + v
    ElseIf ex > 0 Then
        v = Left$(v, ex + 1) + "." + Mid$(v, ex + 2)
    End If
    dec2str_fix = s + v
End Function
 
Function dec2dbl# (n As decfloat)
    Dim As Long ex
    Dim As String v, f, ts
    If n.exponent > 0 Then
        ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
    Else
        ex = 0
    End If
    If n.sign Then v = "-" Else v = " "
    ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * 0 + 1, 4))))
    If Len(ts) < 9 Then
        ts = ts + String$(9 - Len(ts), "0")
    End If
    v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
 
    ts = _Trim$(Str$(CVL(Mid$(n.mantissa, 4 * 1 + 1, 4))))
    If Len(ts) < 9 Then
        ts = String$(9 - Len(ts), "0") + ts
    End If
    v = v + ts
 
    f = _Trim$(Str$(Abs(ex)))
    f = String$(5 - Len(f), "0") + f
    If ex < 0 Then v = v + "E-" Else v = v + "E+"
    v = v + f
    dec2dbl = Val(v)
End Function
 
Sub RSHIFT_1 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 10
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 10
        v2 = v2 * 100000000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 10)
End Sub
 
Sub LSHIFT_1 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 100000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 100000000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 10 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 100000000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(10 * CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 100000000)
End Sub
 
Sub RSHIFT_2 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 100
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 100
        v2 = v2 * 10000000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 100)
End Sub
 
Sub LSHIFT_2 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 10000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 10000000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 100 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 10000000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(100 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 10000000))
End Sub
 
Sub RSHIFT_3 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 1000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 1000
        v2 = v2 * 1000000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 1000)
End Sub
 
Sub LSHIFT_3 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 1000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 1000000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 1000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 1000000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(1000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 1000000))
End Sub
 
Sub RSHIFT_4 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 10000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 10000
        v2 = v2 * 100000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 10000)
End Sub
 
Sub LSHIFT_4 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 100000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 100000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 10000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 100000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(10000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 100000))
End Sub
 
Sub RSHIFT_5 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 100000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 100000
        v2 = v2 * 10000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 100000)
End Sub
 
Sub LSHIFT_5 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 10000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 10000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 100000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 10000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(100000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 10000))
End Sub
 
Sub RSHIFT_6 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 1000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 1000000
        v2 = v2 * 1000 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 1000000)
End Sub
 
Sub LSHIFT_6 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 1000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 1000
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 1000000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 1000)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(1000000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 1000))
End Sub
 
Sub RSHIFT_7 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 10000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 10000000
        v2 = v2 * 100 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 10000000)
End Sub
 
Sub LSHIFT_7 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 100
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 100
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 10000000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 100)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(10000000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 100))
End Sub
 
Sub RSHIFT_8 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) \ 100000000
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)) Mod 100000000
        v2 = v2 * 10 + v1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v2)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * 0 + 1, 4)) \ 100000000)
End Sub
 
Sub LSHIFT_8 (mantissa As decfloat)
    Dim As _Unsigned Long v1, v2
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        v1 = CVL(Mid$(mantissa.mantissa, 4 * i + 1, 4)) Mod 10
        v2 = CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) \ 10
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = MKL$(v1 * 100000000 + v2)
        Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4) = MKL$(CVL(Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)) Mod 10)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(100000000 * (CVL(Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4)) Mod 10))
End Sub
 
Sub RSHIFT_9 (mantissa As decfloat)
    Dim As Long i
    For i = NUM_DWORDS - 1 To 1 Step -1
        Mid$(mantissa.mantissa, 4 * i + 1, 4) = Mid$(mantissa.mantissa, 4 * (i - 1) + 1, 4)
    Next
    Mid$(mantissa.mantissa, 4 * 0 + 1, 4) = MKL$(0)
End Sub
 
Sub LSHIFT_9 (mantissa As decfloat)
    Dim As Long i
    For i = 0 To NUM_DWORDS - 2
        Mid$(mantissa.mantissa, 4 * i + 1) = Mid$(mantissa.mantissa, 4 * (i + 1) + 1, 4)
    Next
    Mid$(mantissa.mantissa, 4 * (NUM_DWORDS - 1) + 1, 4) = MKL$(0)
End Sub
 
Function cmp% (x As decfloat, y As decfloat)
    Dim As Long c, i
    If x.sign = y.sign Then
        If x.exponent = y.exponent Then
            For i = 0 To NUM_DWORDS - 1
                c = CVL(Mid$(x.mantissa, 4 * i + 1, 4)) - CVL(Mid$(y.mantissa, 4 * i + 1, 4))
                If c <> 0 Then Exit For
            Next
            If c < 0 Then
                cmp = -1
                Exit Function
            ElseIf c = 0 Then
                cmp = 0
                Exit Function
            ElseIf c > 0 Then
                cmp = 1
                Exit Function
            End If
        End If
        If x.exponent < y.exponent Then
            cmp = -1
            Exit Function
        End If
        If x.exponent > y.exponent Then
            cmp = 1
            Exit Function
        End If
    End If
    If x.sign Then cmp = -1
End Function
 
Function NORM_FAC1% (fac1 As decfloat)
    ' normalize the number in fac1
    ' all routines exit through this one.
    ' we leave ax=0 if normalization was
    ' ok...else ax = error code.
 
    'see if the mantissa is all zeros.
    'if so, set the exponent and sign equal to 0.
    Dim As Long i, er, f
    er = 0: f = 0
    For i = 0 To NUM_DWORDS - 1
        If CVL(Mid$(fac1.mantissa, 4 * i + 1, 4)) > 0 Then f = 1
    Next
    If f = 0 Then
        fac1.exponent = 0
        fac1.sign = 0
        Exit Function
        'if the highmost nibble in fac1_man is nonzero,
        'shift the mantissa right 1 nibble and
        'increment the exponent
    ElseIf CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) > 999999999 Then
        Call RSHIFT_1(fac1)
        fac1.exponent = fac1.exponent + 1
    Else
        'now shift fac1_man 1 to the left until a
        'nonzero digit appears in the next-to-highest
        'nibble of fac1_man.  decrement exponent for
        'each shift.
        While CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) < 100000000
            Call LSHIFT_1(fac1)
            fac1.exponent = fac1.exponent - 1
            If fac1.exponent = 0 Then
                NORM_FAC1 = EXPU_ERR
                Exit Function
            End If
        Wend
    End If
    'check for overflow/underflow
    If fac1.exponent < 0 Then
        NORM_FAC1 = EXPO_ERR
    End If
End Function
 
Sub fpadd_aux (fac1 As decfloat, fac2 As decfloat)
    Dim As _Unsigned Long v, c, i
    Dim As Integer er
    c = 0
    For i = NUM_DWORDS - 1 To 1 Step -1
        v = CVL(Mid$(fac2.mantissa, 4 * i + 1, 4)) + CVL(Mid$(fac1.mantissa, 4 * i + 1, 4)) + c
        If v > 999999999 Then
            v = v - 1000000000
            c = 1
        Else
            c = 0
        End If
        Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(v)
    Next
    v = CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + CVL(Mid$(fac2.mantissa, 4 * 0 + 1, 4)) + c
    Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(v)
 
    er = NORM_FAC1%(fac1)
 
End Sub
 
Sub fpsub_aux (fac1 As decfloat, fac2 As decfloat)
    Dim As Long v, c, i
    c = 0
    For i = NUM_DWORDS - 1 To 1 Step -1
        v = CVL(Mid$(fac1.mantissa, 4 * i + 1, 4)) - CVL(Mid$(fac2.mantissa, 4 * i + 1, 4)) - c
        If v < 0 Then
            v = v + 1000000000
            c = 1
        Else
            c = 0
        End If
        Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(v)
    Next
    v = CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) - CVL(Mid$(fac2.mantissa, 4 * 0 + 1, 4)) - c
    Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(v)
 
    c = NORM_FAC1(fac1)
End Sub
 
Sub fpadd (result As decfloat, x As decfloat, y As decfloat)
 
    Dim As decfloat fac1, fac2
    Dim As Long t, c, xsign, ysign
 
    xsign = x.sign: x.sign = 0
    ysign = y.sign: y.sign = 0
    c = cmp(x, y)
    x.sign = xsign
    y.sign = ysign
    If c < 0 Then
        fac1 = y
        fac2 = x
    Else
        fac1 = x
        fac2 = y
    End If
    t = fac1.exponent - fac2.exponent
 
    If t < NUM_DIGITS Then
        'The difference between the two
        'exponents indicate how many times
        'we have to multiply the mantissa
        'of FAC2 by 10 (i.e., shift it right 1 place).
        'If we have to shift more times than
        'we have digits, the result is already in FAC1.
        t = fac1.exponent - fac2.exponent
        If t > 0 And t < (NUM_DIGITS) Then 'shift
            While t
                Call RSHIFT_1(fac2)
                t = t - 1
            Wend
        End If
        'See if the signs of the two numbers
        'are the same.  If so, add; if not, subtract.
        If fac1.sign = fac2.sign Then 'add
            Call fpadd_aux(fac1, fac2)
        Else
            Call fpsub_aux(fac1, fac2)
        End If
    End If
    result = fac1
End Sub
 
Sub fpsub (result As decfloat, x As decfloat, y As decfloat)
    Dim As decfloat fac1, fac2
    fac1 = x
    fac2 = y
    fac2.sign = fac2.sign Xor &H8000
    Call fpadd(result, fac1, fac2)
End Sub
 
Sub fpmul_si (result As decfloat, x As decfloat, y As _Integer64)
    Dim As decfloat fac1
    Dim As Long count, ex, er, i
    Dim As _Integer64 value, carry, digit, prod
    fac1 = x
    digit = Abs(y)
    'check exponents.  if either is zero,
    'the result is zero
    If fac1.exponent = 0 Or y = 0 Then 'result is zero...clear fac1.
        fac1.sign = 0
        fac1.exponent = 0
        For count = 0 To NUM_DWORDS - 1
            Mid$(fac1.mantissa, 4 * count + 1, 4) = MKL$(0)
        Next
        er = NORM_FAC1(fac1)
        result = fac1
        Exit Sub
    Else
        If digit = 1 Then
            If y < 0 Then
                fac1.sign = fac1.sign Xor &H8000
            End If
            result = fac1
        End If
        'now determine exponent of result.
        'as you do...watch for overflow.
        '        ex=fac2.exponent-BIAS+fac1.exponent-1
 
        If ex < 0 Then
            er = EXPO_ERR
            Exit Sub
        End If
        'for number of digits in the floating
        'point number, add fac2 to fac1 number
        'of times given by lowest nibble in
        'fac3.  then shift fac1 and fac3
        'right 1 digit and repeat.
        'count=NUM_DIGITS-1
 
        carry = 0
 
        For i = NUM_DWORDS - 1 To 0 Step -1
            prod = CVL(Mid$(fac1.mantissa, 4 * i + 1, 4))
            prod = digit * prod + carry
            value = (prod Mod 1000000000)
            Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(value)
            carry = prod \ 1000000000
        Next
 
        If carry < 10 Then
            Call RSHIFT_1(fac1)
            fac1.exponent = fac1.exponent + 1
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 100000000)
        ElseIf carry < 100 Then
            Call RSHIFT_2(fac1)
            fac1.exponent = fac1.exponent + 2
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 10000000)
        ElseIf carry < 1000 Then
            Call RSHIFT_3(fac1)
            fac1.exponent = fac1.exponent + 3
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 1000000)
        ElseIf carry < 10000 Then
            Call RSHIFT_4(fac1)
            fac1.exponent = fac1.exponent + 4
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 100000)
        ElseIf carry < 100000 Then
            Call RSHIFT_5(fac1)
            fac1.exponent = fac1.exponent + 5
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 10000)
        ElseIf carry < 1000000 Then
            Call RSHIFT_6(fac1)
            fac1.exponent = fac1.exponent + 6
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 1000)
        ElseIf carry < 10000000 Then
            Call RSHIFT_7(fac1)
            fac1.exponent = fac1.exponent + 7
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 100)
        ElseIf carry < 100000000 Then
            Call RSHIFT_8(fac1)
            fac1.exponent = fac1.exponent + 8
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry * 10)
        ElseIf carry < 1000000000 Then
            Call RSHIFT_9(fac1)
            fac1.exponent = fac1.exponent + 9
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + carry)
        End If
 
    End If
 
    'fac1.exponent=fac2.exponent+fac1.exponent-BIAS-1
    er = NORM_FAC1(fac1)
    'fac1.exponent+=c 'ex
    'if v>100000000 then fac1.exponent+=1
    If y < 0 Then
        fac1.sign = fac1.sign Xor &H8000
    End If
    result = fac1
End Sub
 
Sub fpmul (result As decfloat, x As decfloat, y As decfloat)
    Dim As decfloat fac1, fac2, fac3
    Dim As Long i, j, ex, er
    Dim As _Integer64 prod, digit, carry
    Dim As _Unsigned Long c, v
 
    fac1 = x
    fac2 = y
    'check exponents.  if either is zero,
    'the result is zero
    If fac1.exponent = 0 Or fac2.exponent = 0 Then 'result is zero...clear fac1.
        fac1.sign = 0
        fac1.exponent = 0
        For i = 0 To NUM_DWORDS - 1
            Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(0)
        Next
        er = NORM_FAC1(fac1)
        result = fac1
        Exit Sub
    Else
 
        'now determine exponent of result.
        'as you do...watch for overflow.
        ex = fac2.exponent - BIAS + fac1.exponent
 
        If ex < 0 Then
            er = EXPO_ERR
            Exit Sub
        End If
        fac1.exponent = ex
        'determine the sign of the product
        fac1.sign = fac1.sign Xor fac2.sign
        'copy fac1 mantissa to fac3 and clear fac1's mantissa
        For i = 0 To NUM_DWORDS - 1
            Mid$(fac3.mantissa, 4 * i + 1, 4) = MKL$(0)
            Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(0)
        Next
        'for number of digits in the floating
        'point number, add fac2 to fac1 number
        'of times given by lowest nibble in
        'fac3.  then shift fac1 and fac3
        'right 1 digit and repeat.
 
        For j = NUM_DWORDS - 1 To 0 Step -1
            carry = 0
            digit = CVL(Mid$(y.mantissa, 4 * j + 1, 4))
            For i = NUM_DWORDS - 1 To 0 Step -1
                prod = digit * CVL(Mid$(x.mantissa, 4 * i + 1, 4)) + carry
                Mid$(fac3.mantissa, 4 * i + 1, 4) = MKL$(prod Mod 1000000000)
                carry = prod \ 1000000000
 
            Next
 
            Call RSHIFT_9(fac1)
            Call RSHIFT_9(fac3)
            Mid$(fac3.mantissa, 4 * 0 + 1, 4) = MKL$(carry)
 
            c = 0
            For i = NUM_DWORDS - 1 To 1 Step -1
                v = CVL(Mid$(fac3.mantissa, 4 * i + 1, 4)) + CVL(Mid$(fac1.mantissa, 4 * i + 1, 4)) + c
                If v > 999999999 Then
                    v = v - 1000000000
                    c = 1
                Else
                    c = 0
                End If
                Mid$(fac1.mantissa, 4 * i + 1, 4) = MKL$(v)
            Next
            v = CVL(Mid$(fac1.mantissa, 4 * 0 + 1, 4)) + CVL(Mid$(fac3.mantissa, 4 * 0 + 1, 4)) + c
            Mid$(fac1.mantissa, 4 * 0 + 1, 4) = MKL$(v)
 
        Next
    End If
 
    er = NORM_FAC1(fac1)
    result = fac1
End Sub
 
Sub recip (result As decfloat, n As decfloat)
    Dim As Double x: x = dec2dbl(n)
    Dim As Long k, l
    Dim As decfloat r, r2, two
    l = Log(NUM_DIGITS * 0.0625) * 1.5
    If x = 0 Then Print "Div 0": Exit Sub
    If x = 1 Then
        Call str2dec("1", r)
        result = r
        Exit Sub
    End If
 
    x = 1# / x
    Call str2dec(Str$(x), r)
    Call str2dec("2", two)
    For k = 1 To l
        Call fpmul(r2, n, r)
        Call fpsub(r2, two, r2)
        Call fpmul(r, r, r2)
    Next k
    Print
    result = r
End Sub
 
Function fpdiv (result As decfloat, x As decfloat, y As decfloat)
    Dim As decfloat fac1, fac2
    fac1 = x
    fac2 = y
    Call recip(fac2, fac2)
    Call fpmul(fac1, fac1, fac2)
    result = fac1
End Function
 

News:

Author Topic: decimal floating point (Read 4396 times)

jack

decimal floating point

jack

Re: decimal floating point

jack

Re: decimal floating point

George McGinn

Re: decimal floating point

jack

Re: decimal floating point

jack

Re: decimal floating point

jack

Re: decimal floating point

bplus

Re: decimal floating point

jack

Re: decimal floating point

bplus

Re: decimal floating point

jack

Re: decimal floating point

jack

Re: decimal floating point