Author Topic: decfloat 2.0  (Read 10281 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
decfloat 2.0
« on: October 10, 2021, 08:00:41 am »
FreeBASIC supports arrays in UDT's and I had written this using arrays in the decfloat type
so in order to test how much slower this routines would perform using a string * some_number
I rewrote it using the same string scheme as you see here, for 1000 digit precision it was 178 times slower
Code: QB64: [Select]
  1. Dest Console
  2.  
  3. Option Explicit
  4.  
  5. Const NUMBER_OF_DIGITS = 512
  6. Const NUM_DIGITS = NUMBER_OF_DIGITS
  7. Const NUM_DWORDS = NUM_DIGITS \ 8
  8. Const BIAS = 1073741824 '2 ^ 30
  9. Const MANTISSA_BYTES = (NUM_DWORDS + 1) * 8 * 4
  10.  
  11. Type decfloat
  12.     As Long sign
  13.     As Unsigned Long exponent
  14.     As String * Mantissa_bytes mantissa
  15.  
  16. ' Error definitions
  17.  
  18. Const DIVZ_ERR = 1 'Divide by zero
  19. Const EXPO_ERR = 2 'Exponent overflow error
  20. Const EXPU_ERR = 3 'Exponent underflow error
  21. Dim Shared As decfloat pi_dec
  22. Call pi_brent_salamin(pi_dec, NUMBER_OF_DIGITS)
  23.  
  24. Dim As decfloat n, m, z
  25.  
  26. t = Timer
  27. Call fpfactorial(z, 10000, NUMBER_OF_DIGITS)
  28. t = Timer - t
  29. Print "factorial(10000) to "; NUMBER_OF_DIGITS; " digits"
  30. Print fp2str(z, NUMBER_OF_DIGITS)
  31. Print "in "; t; " seconds"
  32. Call str2fp(n, "3")
  33. Call str2fp(m, "9")
  34. t = Timer
  35. Call fpdiv(z, n, m, NUMBER_OF_DIGITS)
  36. t = Timer - t
  37. Print "3/9 to "; NUMBER_OF_DIGITS; " digits"
  38. Print fp2str(z, NUMBER_OF_DIGITS)
  39. Print "in "; t; " seconds"
  40. t = Timer
  41. Call fpmul(z, z, z, NUMBER_OF_DIGITS)
  42. t = Timer - t
  43. Print "and square it"
  44. Print fp2str(z, NUMBER_OF_DIGITS)
  45. Call str2fp(n, "2")
  46. t = Timer
  47. Call fplog(z, n, NUMBER_OF_DIGITS)
  48. t = Timer - t
  49. Print "ln(2) to "; NUMBER_OF_DIGITS; " digits"
  50. Print fp2str(z, NUMBER_OF_DIGITS)
  51. Print "in "; t; " seconds"
  52. t = Timer
  53. Call fpexp(z, z, NUMBER_OF_DIGITS)
  54. t = Timer - t
  55. Print "and the inverse"
  56. Print fp2str(z, NUMBER_OF_DIGITS)
  57. Print "in "; t; " seconds"
  58. Call si2fp(n, 3, NUMBER_OF_DIGITS)
  59. Print "reciprocal of 3"
  60. t = Timer
  61. Call fpinv(z, n, NUMBER_OF_DIGITS)
  62. t = Timer - t
  63. Print fp2str(z, NUMBER_OF_DIGITS)
  64. Print "in "; t; " seconds"
  65.  
  66. Sub set (s$, i&, v~&)
  67.     Mid$(s$, 4 * i& + 1, 4) = MKL$(v~&)
  68.  
  69. Function git~& (s$, i&)
  70.     git = CVL(Mid$(s$, 4 * i& + 1, 4))
  71.  
  72. Function fp2str_exp$ (n As decfloat, places As Long)
  73.     Dim As Long i, ex
  74.     Dim As String v, f, ts
  75.     If n.exponent > 0 Then
  76.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  77.     Else
  78.         ex = 0
  79.     End If
  80.     If n.sign Then v = "-" Else v = " "
  81.     ts = Str$(git(n.mantissa, 0))
  82.     ts = Trim$(ts)
  83.     If Len(ts) < 8 Then
  84.         ts = ts + String$(8 - Len(ts), "0")
  85.     End If
  86.     v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
  87.     For i = 1 To NUM_DWORDS - 1
  88.         ts = Str$(git(n.mantissa, i))
  89.         ts = Trim$(ts)
  90.         If Len(ts) < 8 Then
  91.             ts = String$(8 - Len(ts), "0") + ts
  92.         End If
  93.         v = v + ts
  94.     Next
  95.     v = Left$(v, places + 3)
  96.     f = Trim$(Str$(Abs(ex)))
  97.     f = String$(5 - Len(f), "0") + f
  98.     If ex < 0 Then v = v + "E-" Else v = v + "E+"
  99.     v = v + f
  100.     fp2str_exp$ = v
  101.  
  102. 'long part of num
  103. Sub fpfix (result As decfloat, num As decfloat)
  104.     Dim As decfloat ip
  105.     Dim As Long ex, ex2, j, k
  106.  
  107.     ex = (num.exponent And &H7FFFFFFF) - BIAS
  108.     If ex < 1 Then
  109.         result = ip: Exit Sub
  110.     End If
  111.     If ex >= (NUM_DIGITS) Then
  112.         result = num: Exit Sub
  113.     End If
  114.     ex2 = ex \ 8
  115.     k = ex2
  116.     j = ex Mod 8
  117.     While ex2 > 0
  118.         ex2 = ex2 - 1
  119.         Call set(ip.mantissa, ex2, git(num.mantissa, ex2))
  120.     Wend
  121.     If j = 1 Then
  122.         Call set(ip.mantissa, k, 10000000 * (git(num.mantissa, k) \ 10000000))
  123.     ElseIf j = 2 Then
  124.         Call set(ip.mantissa, k, 1000000 * (git(num.mantissa, k) \ 1000000))
  125.     ElseIf j = 3 Then
  126.         Call set(ip.mantissa, k, 100000 * (git(num.mantissa, k) \ 100000))
  127.     ElseIf j = 4 Then
  128.         Call set(ip.mantissa, k, 10000 * (git(num.mantissa, k) \ 10000))
  129.     ElseIf j = 5 Then
  130.         Call set(ip.mantissa, k, 1000 * (git(num.mantissa, k) \ 1000))
  131.     ElseIf j = 6 Then
  132.         Call set(ip.mantissa, k, 100 * (git(num.mantissa, k) \ 100))
  133.     ElseIf j = 7 Then
  134.         Call set(ip.mantissa, k, 10 * (git(num.mantissa, k) \ 10))
  135.     ElseIf j = 8 Then
  136.         Call set(ip.mantissa, k, git(num.mantissa, k))
  137.     End If
  138.     ip.exponent = ex + BIAS
  139.     ip.sign = num.sign
  140.     result = ip
  141.  
  142. Function fp2dbl# (n As decfloat)
  143.     Dim As Long ex
  144.     Dim As String v, f, ts
  145.     If n.exponent > 0 Then
  146.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  147.     Else
  148.         ex = 0
  149.     End If
  150.     If n.sign Then v = "-" Else v = " "
  151.     ts = Trim$(Str$(git(n.mantissa, 0)))
  152.     If Len(ts) < 8 Then
  153.         ts = ts + String$(8 - Len(ts), "0")
  154.     End If
  155.     v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
  156.     ts = Trim$(Str$(git(n.mantissa, 1)))
  157.     If Len(ts) < 8 Then
  158.         ts = String$(8 - Len(ts), "0") + ts
  159.     End If
  160.     v = v + ts
  161.  
  162.     f = Str$(Abs(ex))
  163.     f = String$(5 - Len(f), "0") + f
  164.     If ex < 0 Then v = v + "E-" Else v = v + "E+"
  165.     v = v + f
  166.     fp2dbl# = Val(v)
  167.  
  168. Function fp2str_fix$ (n As decfloat, places As Long)
  169.     Dim As Long i, ex
  170.     Dim As String v, ts, s
  171.     If n.exponent > 0 Then
  172.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  173.     Else
  174.         ex = 0
  175.     End If
  176.     If n.sign Then s = "-" Else s = " "
  177.     ts = Trim$(Str$(git(n.mantissa, 0)))
  178.     If Len(ts) < 8 Then
  179.         ts = ts + String$(8 - Len(ts), "0")
  180.     End If
  181.     v = ts
  182.     For i = 1 To NUM_DWORDS - 1
  183.         ts = Trim$(Str$(git(n.mantissa, i)))
  184.         If Len(ts) < 8 Then
  185.             ts = String$(8 - Len(ts), "0") + ts
  186.         End If
  187.         v = v + ts
  188.     Next
  189.     If places < NUM_DIGITS Then
  190.         v = Left$(v, places)
  191.     End If
  192.     If ex = 0 Then
  193.         v = Left$(v, 1) + "." + Mid$(v, 2)
  194.     ElseIf ex < 0 Then
  195.         v = "0." + String$(Abs(ex) - 1, "0") + v
  196.     ElseIf ex > 0 Then
  197.         v = Left$(v, ex + 1) + "." + Mid$(v, ex + 2)
  198.     End If
  199.     fp2str_fix$ = s + v
  200.  
  201. Function fp2str$ (n As decfloat, places As Long)
  202.     Dim As Long ex
  203.     If n.exponent > 0 Then
  204.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  205.     Else
  206.         ex = 0
  207.     End If
  208.     If Abs(ex) < places Then
  209.         fp2str = fp2str_fix(n, places)
  210.     Else
  211.         fp2str = fp2str_exp(n, places)
  212.     End If
  213.  
  214. Sub str2fp (result As decfloat, value As String)
  215.     Dim As Long j, s, d, e, ep, ex, es, i, f, fp, fln
  216.     Dim As String c, f1, f2, f3, ts
  217.     Dim As Unsigned Long ulng
  218.     Dim n As decfloat
  219.     j = 1
  220.     s = 1
  221.     d = 0
  222.     e = 0
  223.     ep = 0
  224.     ex = 0
  225.     es = 1
  226.     i = 0
  227.     f = 0
  228.     fp = 0
  229.     f1 = ""
  230.     f2 = ""
  231.     f3 = ""
  232.     value = UCase$(value)
  233.     fln = Len(value)
  234.  
  235.     While j <= fln
  236.         c = Mid$(value, j, 1)
  237.         If ep = 1 Then
  238.             If c = " " Then
  239.                 j = j + 1
  240.                 GoTo skip_while
  241.             End If
  242.             If c = "-" Then
  243.                 es = -es
  244.                 c = ""
  245.             End If
  246.             If c = "+" Then
  247.                 j = j + 1
  248.                 GoTo skip_while
  249.             End If
  250.             If (c = "0") And (f3 = "") Then
  251.                 j = j + 1
  252.                 GoTo skip_while
  253.             End If
  254.             If (c > "/") And (c < ":") Then 'c is digit between 0 and 9
  255.                 f3 = f3 + c
  256.                 ex = 10 * ex + (Asc(c) - 48)
  257.                 j = j + 1
  258.                 GoTo skip_while
  259.             End If
  260.         End If
  261.  
  262.         If c = " " Then
  263.             j = j + 1
  264.             GoTo skip_while
  265.         End If
  266.         If c = "-" Then
  267.             s = -s
  268.             j = j + 1
  269.             GoTo skip_while
  270.         End If
  271.         If c = "+" Then
  272.             j = j + 1
  273.             GoTo skip_while
  274.         End If
  275.         If c = "." Then
  276.             If d = 1 Then
  277.                 j = j + 1
  278.                 GoTo skip_while
  279.             End If
  280.             d = 1
  281.         End If
  282.         If (c > "/") And (c < ":") Then 'c is digit between 0 and 9
  283.             If ((c = "0") And (i = 0)) Then
  284.                 If d = 0 Then
  285.                     j = j + 1
  286.                     GoTo skip_while
  287.                 End If
  288.                 If (d = 1) And (f = 0) Then
  289.                     e = e - 1
  290.                     j = j + 1
  291.                     GoTo skip_while
  292.                 End If
  293.             End If
  294.             If d = 0 Then
  295.                 f1 = f1 + c
  296.                 i = i + 1
  297.             Else
  298.                 If (c > "0") Then
  299.                     fp = 1
  300.                 End If
  301.                 f2 = f2 + c
  302.                 f = f + 1
  303.             End If
  304.         End If
  305.         If c = "E" Or c = "D" Then
  306.             ep = 1
  307.         End If
  308.         j = j + 1
  309.         skip_while:
  310.     Wend
  311.     If fp = 0 Then
  312.         f = 0
  313.         f2 = ""
  314.     End If
  315.  
  316.     If s = -1 Then s = &H8000 Else s = 0
  317.     n.sign = s
  318.     ex = es * ex - 1 + i + e
  319.     f1 = f1 + f2
  320.     f1 = Mid$(f1, 1, 1) + Right$(f1, Len(f1) - 1)
  321.     fln = Len(f1)
  322.     If Len(f1) > (NUM_DIGITS + 1 + 8) Then
  323.         f1 = Mid$(f1, 1, (NUM_DIGITS + 1 + 8))
  324.     End If
  325.     While Len(f1) < (NUM_DIGITS + 1 + 8)
  326.         f1 = f1 + "0"
  327.     Wend
  328.     j = 1
  329.     For i = 0 To NUM_DWORDS
  330.         ts = Mid$(f1, j, 8)
  331.         ulng = Val(ts)
  332.         Call set(n.mantissa, i, ulng)
  333.         If ulng <> 0 Then fp = 1
  334.         j = j + 8
  335.     Next
  336.     If fp Then n.exponent = (ex + BIAS + 1) Else n.exponent = 0
  337.     result = n
  338.  
  339. Sub si2fp (result As decfloat, m As Integer64, digits_in As Long)
  340.     Dim As Long digits
  341.     digits = digits_in
  342.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  343.     Dim As decfloat fac1
  344.     Dim As Long i
  345.     Dim As Integer64 n
  346.     n = Abs(m)
  347.  
  348.     If n > 9999999999999999 Then
  349.         Call str2fp(fac1, Str$(m))
  350.         result = fac1: Exit Sub
  351.     End If
  352.  
  353.     For i = 1 To digits
  354.         Call set(fac1.mantissa, i, 0)
  355.     Next
  356.  
  357.     If m = 0 Then
  358.         fac1.exponent = 0
  359.         fac1.sign = 0
  360.         result = fac1: Exit Sub
  361.     End If
  362.  
  363.     fac1.exponent = BIAS
  364.     If n < 100000000 Then
  365.         If n < 10 Then
  366.             Call set(fac1.mantissa, 0, n * 10000000)
  367.             fac1.exponent = fac1.exponent + 1
  368.         ElseIf n < 100 Then
  369.             Call set(fac1.mantissa, 0, n * 1000000)
  370.             fac1.exponent = fac1.exponent + 2
  371.         ElseIf n < 1000 Then
  372.             Call set(fac1.mantissa, 0, n * 100000)
  373.             fac1.exponent = fac1.exponent + 3
  374.         ElseIf n < 10000 Then
  375.             Call set(fac1.mantissa, 0, n * 10000)
  376.             fac1.exponent = fac1.exponent + 4
  377.         ElseIf n < 100000 Then
  378.             Call set(fac1.mantissa, 0, n * 1000)
  379.             fac1.exponent = fac1.exponent + 5
  380.         ElseIf n < 1000000 Then
  381.             Call set(fac1.mantissa, 0, n * 100)
  382.             fac1.exponent = fac1.exponent + 6
  383.         ElseIf n < 10000000 Then
  384.             Call set(fac1.mantissa, 0, n * 10)
  385.             fac1.exponent = fac1.exponent + 7
  386.         ElseIf n < 100000000 Then
  387.             Call set(fac1.mantissa, 0, n)
  388.             fac1.exponent = fac1.exponent + 8
  389.         End If
  390.     End If
  391.     If n > 99999999 Then
  392.         fac1.exponent = fac1.exponent + 8
  393.         If n < 1000000000 Then
  394.             Call set(fac1.mantissa, 0, n \ 10)
  395.             Call set(fac1.mantissa, 1, (n Mod 10) * 10000000)
  396.             fac1.exponent = fac1.exponent + 1
  397.         ElseIf n < 100000000000 Then
  398.             Call set(fac1.mantissa, 0, n \ 100)
  399.             Call set(fac1.mantissa, 1, (n Mod 100) * 1000000)
  400.             fac1.exponent = fac1.exponent + 2
  401.         ElseIf n < 1000000000000 Then
  402.             Call set(fac1.mantissa, 0, n \ 1000)
  403.             Call set(fac1.mantissa, 1, (n Mod 1000) * 100000)
  404.             fac1.exponent = fac1.exponent + 3
  405.         ElseIf n < 10000000000000 Then
  406.             Call set(fac1.mantissa, 0, n \ 10000)
  407.             Call set(fac1.mantissa, 1, (n Mod 10000) * 10000)
  408.             fac1.exponent = fac1.exponent + 4
  409.         ElseIf n < 100000000000000 Then
  410.             Call set(fac1.mantissa, 0, n \ 100000)
  411.             Call set(fac1.mantissa, 1, (n Mod 100000) * 1000)
  412.             fac1.exponent = fac1.exponent + 5
  413.         ElseIf n < 1000000000000000 Then
  414.             Call set(fac1.mantissa, 0, n \ 1000000)
  415.             Call set(fac1.mantissa, 1, (n Mod 1000000) * 100)
  416.             fac1.exponent = fac1.exponent + 6
  417.         ElseIf n < 10000000000000000 Then
  418.             Call set(fac1.mantissa, 0, n \ 10000000)
  419.             Call set(fac1.mantissa, 1, (n Mod 10000000) * 10)
  420.             fac1.exponent = fac1.exponent + 7
  421.         ElseIf n < 100000000000000000 Then
  422.             Call set(fac1.mantissa, 0, n \ 100000000)
  423.             Call set(fac1.mantissa, 1, n Mod 100000000)
  424.             fac1.exponent = fac1.exponent + 8
  425.         End If
  426.     End If
  427.     If m < 0 Then
  428.         fac1.sign = &H8000
  429.     Else
  430.         fac1.sign = 0
  431.     End If
  432.     result = fac1
  433.  
  434. Sub RSHIFT_1 (mantissa As decfloat, digits_in As Long)
  435.     Dim As Long digits
  436.     digits = digits_in
  437.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  438.  
  439.     Dim As Unsigned Long v1, v2
  440.     Dim As Long i
  441.     For i = digits To 1 Step -1
  442.         v1 = git(mantissa.mantissa, i) \ 10
  443.         v2 = git(mantissa.mantissa, i - 1) Mod 10
  444.         v2 = v2 * 10000000 + v1
  445.         Call set(mantissa.mantissa, i, v2)
  446.     Next
  447.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 10)
  448.  
  449. Sub LSHIFT_1 (mantissa As decfloat, digits_in As Long)
  450.     Dim As Long digits
  451.     digits = digits_in
  452.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  453.  
  454.     Dim As Unsigned Long v1, v2
  455.     Dim As Long i
  456.     For i = 0 To digits - 1
  457.         v1 = git(mantissa.mantissa, i) Mod 10000000
  458.         v2 = git(mantissa.mantissa, i + 1) \ 10000000
  459.         Call set(mantissa.mantissa, i, v1 * 10 + v2)
  460.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 10000000)
  461.     Next
  462.     Call set(mantissa.mantissa, digits, 10 * (git(mantissa.mantissa, digits) Mod 10000000))
  463.  
  464. Sub RSHIFT_2 (mantissa As decfloat, digits_in As Long)
  465.     Dim As Long digits
  466.     digits = digits_in
  467.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  468.  
  469.     Dim As Unsigned Long v1, v2
  470.     Dim As Long i
  471.     For i = digits To 1 Step -1
  472.         v1 = git(mantissa.mantissa, i) \ 100
  473.         v2 = git(mantissa.mantissa, i - 1) Mod 100
  474.         v2 = v2 * 1000000 + v1
  475.         Call set(mantissa.mantissa, i, v2)
  476.     Next
  477.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 100)
  478.  
  479. Sub LSHIFT_2 (mantissa As decfloat, digits_in As Long)
  480.     Dim As Long digits
  481.     digits = digits_in
  482.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  483.  
  484.     Dim As Unsigned Long v1, v2
  485.     Dim As Long i
  486.     For i = 0 To digits - 1
  487.         v1 = git(mantissa.mantissa, i) Mod 1000000
  488.         v2 = git(mantissa.mantissa, i + 1) \ 1000000
  489.         Call set(mantissa.mantissa, i, v1 * 100 + v2)
  490.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 1000000)
  491.     Next
  492.     Call set(mantissa.mantissa, digits, 100 * (git(mantissa.mantissa, digits) Mod 1000000))
  493.  
  494. Sub RSHIFT_3 (mantissa As decfloat, digits_in As Long)
  495.     Dim As Long digits
  496.     digits = digits_in
  497.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  498.  
  499.     Dim As Unsigned Long v1, v2
  500.     Dim As Long i
  501.     For i = digits To 1 Step -1
  502.         v1 = git(mantissa.mantissa, i) \ 1000
  503.         v2 = git(mantissa.mantissa, i - 1) Mod 1000
  504.         v2 = v2 * 100000 + v1
  505.         Call set(mantissa.mantissa, i, v2)
  506.     Next
  507.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 1000)
  508.  
  509. Sub LSHIFT_3 (mantissa As decfloat, digits_in As Long)
  510.     Dim As Long digits
  511.     digits = digits_in
  512.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  513.  
  514.     Dim As Unsigned Long v1, v2
  515.     Dim As Long i
  516.     For i = 0 To digits - 1
  517.         v1 = git(mantissa.mantissa, i) Mod 100000
  518.         v2 = git(mantissa.mantissa, i + 1) \ 100000
  519.         Call set(mantissa.mantissa, i, v1 * 1000 + v2)
  520.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 100000)
  521.     Next
  522.     Call set(mantissa.mantissa, digits, 1000 * (git(mantissa.mantissa, digits) Mod 100000))
  523.  
  524. Sub RSHIFT_4 (mantissa As decfloat, digits_in As Long)
  525.     Dim As Long digits
  526.     digits = digits_in
  527.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  528.  
  529.     Dim As Unsigned Long v1, v2
  530.     Dim As Long i
  531.     For i = digits To 1 Step -1
  532.         v1 = git(mantissa.mantissa, i) \ 10000
  533.         v2 = git(mantissa.mantissa, i - 1) Mod 10000
  534.         v2 = v2 * 10000 + v1
  535.         Call set(mantissa.mantissa, i, v2)
  536.     Next
  537.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 10000)
  538.  
  539. Sub LSHIFT_4 (mantissa As decfloat, digits_in As Long)
  540.     Dim As Long digits
  541.     digits = digits_in
  542.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  543.  
  544.     Dim As Unsigned Long v1, v2
  545.     Dim As Long i
  546.     For i = 0 To digits - 1
  547.         v1 = git(mantissa.mantissa, i) Mod 10000
  548.         v2 = git(mantissa.mantissa, i + 1) \ 10000
  549.         Call set(mantissa.mantissa, i, v1 * 10000 + v2)
  550.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 10000)
  551.     Next
  552.     Call set(mantissa.mantissa, digits, 10000 * (git(mantissa.mantissa, digits) Mod 10000))
  553.  
  554. Sub RSHIFT_5 (mantissa As decfloat, digits_in As Long)
  555.     Dim As Long digits
  556.     digits = digits_in
  557.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  558.  
  559.     Dim As Unsigned Long v1, v2
  560.     Dim As Long i
  561.     For i = digits To 1 Step -1
  562.         v1 = git(mantissa.mantissa, i) \ 100000
  563.         v2 = git(mantissa.mantissa, i - 1) Mod 100000
  564.         v2 = v2 * 1000 + v1
  565.         Call set(mantissa.mantissa, i, v2)
  566.     Next
  567.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 100000)
  568.  
  569. Sub LSHIFT_5 (mantissa As decfloat, digits_in As Long)
  570.     Dim As Long digits
  571.     digits = digits_in
  572.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  573.  
  574.     Dim As Unsigned Long v1, v2
  575.     Dim As Long i
  576.     For i = 0 To digits - 1
  577.         v1 = git(mantissa.mantissa, i) Mod 1000
  578.         v2 = git(mantissa.mantissa, i + 1) \ 1000
  579.         Call set(mantissa.mantissa, i, v1 * 100000 + v2)
  580.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 1000)
  581.     Next
  582.     Call set(mantissa.mantissa, digits, 100000 * (git(mantissa.mantissa, digits) Mod 1000))
  583.  
  584. Sub RSHIFT_6 (mantissa As decfloat, digits_in As Long)
  585.     Dim As Long digits
  586.     digits = digits_in
  587.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  588.  
  589.     Dim As Unsigned Long v1, v2
  590.     Dim As Long i
  591.     For i = digits To 1 Step -1
  592.         v1 = git(mantissa.mantissa, i) \ 1000000
  593.         v2 = git(mantissa.mantissa, i - 1) Mod 1000000
  594.         v2 = v2 * 100 + v1
  595.         Call set(mantissa.mantissa, i, v2)
  596.     Next
  597.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 1000000)
  598.  
  599. Sub LSHIFT_6 (mantissa As decfloat, digits_in As Long)
  600.     Dim As Long digits
  601.     digits = digits_in
  602.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  603.  
  604.     Dim As Unsigned Long v1, v2
  605.     Dim As Long i
  606.     For i = 0 To digits - 1
  607.         v1 = git(mantissa.mantissa, i) Mod 100
  608.         v2 = git(mantissa.mantissa, i + 1) \ 100
  609.         Call set(mantissa.mantissa, i, v1 * 1000000 + v2)
  610.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 100)
  611.     Next
  612.     Call set(mantissa.mantissa, digits, 1000000 * (git(mantissa.mantissa, digits) Mod 100))
  613.  
  614. Sub RSHIFT_7 (mantissa As decfloat, digits_in As Long)
  615.     Dim As Long digits
  616.     digits = digits_in
  617.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  618.  
  619.     Dim As Unsigned Long v1, v2
  620.     Dim As Long i
  621.     For i = digits To 1 Step -1
  622.         v1 = git(mantissa.mantissa, i) \ 10000000
  623.         v2 = git(mantissa.mantissa, i - 1) Mod 10000000
  624.         v2 = v2 * 10 + v1
  625.         Call set(mantissa.mantissa, i, v2)
  626.     Next
  627.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 10000000)
  628.  
  629. Sub LSHIFT_7 (mantissa As decfloat, digits_in As Long)
  630.     Dim As Long digits
  631.     digits = digits_in
  632.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  633.  
  634.     Dim As Unsigned Long v1, v2
  635.     Dim As Long i
  636.     For i = 0 To digits - 1
  637.         v1 = git(mantissa.mantissa, i) Mod 10
  638.         v2 = git(mantissa.mantissa, i + 1) \ 10
  639.         Call set(mantissa.mantissa, i, v1 * 10000000 + v2)
  640.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 10)
  641.     Next
  642.     Call set(mantissa.mantissa, digits, 10000000 * (git(mantissa.mantissa, digits) Mod 10))
  643.  
  644. Sub RSHIFT_8 (mantissa As decfloat, digits_in As Long)
  645.     Dim As Long digits
  646.     digits = digits_in
  647.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  648.     Dim As Long i
  649.     For i = digits To 1 Step -1
  650.         Call set(mantissa.mantissa, i, git(mantissa.mantissa, i - 1))
  651.     Next
  652.     Call set(mantissa.mantissa, 0, 0)
  653.  
  654. Sub LSHIFT_8 (mantissa As decfloat, digits_in As Long)
  655.     Dim As Long digits
  656.     digits = digits_in
  657.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  658.     Dim As Long i
  659.     For i = 0 To digits - 1
  660.         Call set(mantissa.mantissa, i, git(mantissa.mantissa, i + 1))
  661.     Next
  662.     Call set(mantissa.mantissa, digits, 0)
  663.  
  664. Function fpcmp& (x As decfloat, y As decfloat, digits_in As Long)
  665.     Dim As Long digits
  666.     digits = digits_in
  667.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  668.     Dim As Long c, i
  669.     If x.sign < y.sign Then fpcmp = -1: Exit Function
  670.     If x.sign > y.sign Then fpcmp = 1: Exit Function
  671.     If x.sign = y.sign Then
  672.         If x.exponent = y.exponent Then
  673.             For i = 0 To digits
  674.                 c = git(x.mantissa, i) - git(y.mantissa, i)
  675.                 If c <> 0 Then Exit For
  676.             Next
  677.             If c < 0 Then fpcmp = -1: Exit Function
  678.             If c = 0 Then fpcmp = 0: Exit Function
  679.             If c > 0 Then fpcmp = 1: Exit Function
  680.         End If
  681.         If x.exponent < y.exponent Then fpcmp = -1: Exit Function
  682.         If x.exponent > y.exponent Then fpcmp = 1: Exit Function
  683.     End If
  684.     ' if we reach this point it means that the signs are different
  685.     ' and if the sign of x is set meaning that x is negative then x < y
  686.  
  687.  
  688. Sub NORM_FAC1 (fac1 As decfloat, digits_in As Long)
  689.     Dim As Long digits
  690.     digits = digits_in
  691.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  692.     ' normalize the number in fac1
  693.     ' all routines exit through this one.
  694.  
  695.     'see if the mantissa is all zeros.
  696.     'if so, set the exponent and sign equal to 0.
  697.     Dim As Long i, er, f
  698.     er = 0: f = 0
  699.     For i = 0 To digits
  700.         If git(fac1.mantissa, i) > 0 Then f = 1
  701.     Next
  702.     If f = 0 Then
  703.         fac1.exponent = 0
  704.         fac1.sign = 0
  705.         Exit Sub
  706.         'if the highmost Digit in fac1_man is nonzero,
  707.         'shift the mantissa right 1 Digit and
  708.         'increment the exponent
  709.     ElseIf git(fac1.mantissa, 0) > 99999999 Then
  710.         Call RSHIFT_1(fac1, digits)
  711.         fac1.exponent = fac1.exponent + 1
  712.     Else
  713.         'now shift fac1_man 1 to the left until a
  714.         'nonzero digit appears in the next-to-highest
  715.         'Digit of fac1_man.  decrement exponent for
  716.         'each shift.
  717.         While git(fac1.mantissa, 0) = 0
  718.             Call LSHIFT_8(fac1, digits)
  719.             fac1.exponent = fac1.exponent - 8
  720.             If fac1.exponent = 0 Then
  721.                 Print "NORM_FAC1=EXPU_ERR"
  722.                 Exit Sub
  723.             End If
  724.         Wend
  725.         If git(fac1.mantissa, 0) < 10 Then
  726.             Call LSHIFT_7(fac1, digits)
  727.             fac1.exponent = fac1.exponent - 7
  728.         ElseIf git(fac1.mantissa, 0) < 100 Then
  729.             Call LSHIFT_6(fac1, digits)
  730.             fac1.exponent = fac1.exponent - 6
  731.         ElseIf git(fac1.mantissa, 0) < 1000 Then
  732.             Call LSHIFT_5(fac1, digits)
  733.             fac1.exponent = fac1.exponent - 5
  734.         ElseIf git(fac1.mantissa, 0) < 10000 Then
  735.             Call LSHIFT_4(fac1, digits)
  736.             fac1.exponent = fac1.exponent - 4
  737.         ElseIf git(fac1.mantissa, 0) < 100000 Then
  738.             Call LSHIFT_3(fac1, digits)
  739.             fac1.exponent = fac1.exponent - 3
  740.         ElseIf git(fac1.mantissa, 0) < 1000000 Then
  741.             Call LSHIFT_2(fac1, digits)
  742.             fac1.exponent = fac1.exponent - 2
  743.         ElseIf git(fac1.mantissa, 0) < 10000000 Then
  744.             Call LSHIFT_1(fac1, digits)
  745.             fac1.exponent = fac1.exponent - 1
  746.         End If
  747.     End If
  748.     'check for overflow/underflow
  749.     If fac1.exponent < 0 Then
  750.         Print "NORM_FAC1=EXPO_ERR"
  751.     End If
  752.  
  753. Sub fpadd_aux (fac1 As decfloat, fac2 As decfloat, digits_in As Long)
  754.     Dim As Long digits
  755.     digits = digits_in
  756.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  757.     Dim As Unsigned Long v, c, i
  758.     c = 0
  759.     For i = digits To 1 Step -1
  760.         v = git(fac2.mantissa, i) + git(fac1.mantissa, i) + c
  761.         If v > 99999999 Then
  762.             v = v - 100000000
  763.             c = 1
  764.         Else
  765.             c = 0
  766.         End If
  767.         Call set(fac1.mantissa, i, v)
  768.     Next
  769.     v = git(fac1.mantissa, 0) + git(fac2.mantissa, 0) + c
  770.     Call set(fac1.mantissa, 0, v)
  771.  
  772.     Call NORM_FAC1(fac1, digits)
  773.  
  774.  
  775. Sub fpsub_aux (fac1 As decfloat, fac2 As decfloat, digits_in As Long)
  776.     Dim As Long digits
  777.     digits = digits_in
  778.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  779.     Dim As Long v, c, i
  780.     c = 0
  781.     For i = digits To 1 Step -1
  782.         v = git(fac1.mantissa, i) - git(fac2.mantissa, i) - c
  783.         If v < 0 Then
  784.             v = v + 100000000
  785.             c = 1
  786.         Else
  787.             c = 0
  788.         End If
  789.         Call set(fac1.mantissa, i, v)
  790.     Next
  791.     v = git(fac1.mantissa, 0) - git(fac2.mantissa, 0) - c
  792.     Call set(fac1.mantissa, 0, v)
  793.  
  794.     Call NORM_FAC1(fac1, digits)
  795.  
  796. Sub fpadd (result As decfloat, x As decfloat, y As decfloat, digits_in As Long)
  797.     Dim As Long digits
  798.     digits = digits_in
  799.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  800.  
  801.     Dim As decfloat fac1, fac2
  802.     Dim As Long i, t, c, xsign, ysign
  803.  
  804.     xsign = x.sign: x.sign = 0
  805.     ysign = y.sign: y.sign = 0
  806.     c = fpcmp(x, y, digits)
  807.  
  808.     x.sign = xsign
  809.     y.sign = ysign
  810.     If c < 0 Then
  811.         fac1 = y
  812.         fac2 = x
  813.     Else
  814.         fac1 = x
  815.         fac2 = y
  816.     End If
  817.     t = fac1.exponent - fac2.exponent
  818.     t = ((fac1.exponent And &H7FFFFFFF) - BIAS - 1) - ((fac2.exponent And &H7FFFFFFF) - BIAS - 1)
  819.  
  820.     If t < (NUM_DIGITS + 8) Then
  821.         'The difference between the two
  822.         'exponents indicate how many times
  823.         'we have to multiply the mantissa
  824.         'of FAC2 by 10 (i.e., shift it right 1 place).
  825.         'If we have to shift more times than
  826.         'we have digits, the result is already in FAC1.
  827.         t = fac1.exponent - fac2.exponent
  828.         If t > 0 And t < (NUM_DIGITS + 8) Then 'shift
  829.  
  830.             i = t \ 8
  831.             While i > 0
  832.                 Call RSHIFT_8(fac2, digits)
  833.                 t = t - 8
  834.                 i = i - 1
  835.             Wend
  836.             If t = 7 Then
  837.                 Call RSHIFT_7(fac2, digits)
  838.             ElseIf t = 6 Then
  839.                 Call RSHIFT_6(fac2, digits)
  840.             ElseIf t = 5 Then
  841.                 Call RSHIFT_5(fac2, digits)
  842.             ElseIf t = 4 Then
  843.                 Call RSHIFT_4(fac2, digits)
  844.             ElseIf t = 3 Then
  845.                 Call RSHIFT_3(fac2, digits)
  846.             ElseIf t = 2 Then
  847.                 Call RSHIFT_2(fac2, digits)
  848.             ElseIf t = 1 Then
  849.                 Call RSHIFT_1(fac2, digits)
  850.             End If
  851.         End If
  852.         'See if the signs of the two numbers
  853.         'are the same.  If so, add; if not, subtract.
  854.         If fac1.sign = fac2.sign Then 'add
  855.             Call fpadd_aux(fac1, fac2, digits)
  856.         Else
  857.             Call fpsub_aux(fac1, fac2, digits)
  858.         End If
  859.     End If
  860.     result = fac1
  861.  
  862. Sub fpsub (result As decfloat, x As decfloat, y As decfloat, digits_in As Long)
  863.     Dim As Long digits
  864.     digits = digits_in
  865.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  866.     Dim As decfloat fac1, fac2
  867.     fac1 = x
  868.     fac2 = y
  869.     fac2.sign = fac2.sign Xor &H8000
  870.     Call fpadd(fac1, fac1, fac2, digits)
  871.     result = fac1
  872.  
  873. Sub fpmul (result As decfloat, x As decfloat, y As decfloat, digits_in As Long)
  874.     Dim As Long digits
  875.     digits = digits_in
  876.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  877.     Dim As decfloat fac1, fac2
  878.     Dim As Long i, j, ex, er, den, num
  879.     Dim As Integer64 digit, carry
  880.     Dim As Unsigned Integer64 fac3(0 To digits)
  881.  
  882.     fac1 = x
  883.     fac2 = y
  884.     'check exponents.  if either is zero,
  885.     'the result is zero
  886.     If fac1.exponent = 0 Or fac2.exponent = 0 Then 'result is zero...clear fac1.
  887.         fac1.sign = 0
  888.         fac1.exponent = 0
  889.         For i = 0 To digits
  890.             Call set(fac1.mantissa, i, 0)
  891.         Next
  892.         'NORM_FAC1(fac1)
  893.         result = fac1: Exit Sub
  894.     Else
  895.  
  896.         If ex < 0 Then
  897.             er = EXPO_ERR
  898.             result = fac1: Exit Sub
  899.         End If
  900.  
  901.         'clear fac3 mantissa
  902.         For i = 0 To digits
  903.             fac3(i) = 0
  904.         Next
  905.  
  906.         den = digits
  907.         While git(fac2.mantissa, den) = 0
  908.             den = den - 1
  909.         Wend
  910.         num = digits
  911.         While git(fac1.mantissa, num) = 0
  912.             num = num - 1
  913.         Wend
  914.  
  915.         If num < den Then
  916.             Swap fac1, fac2
  917.             'fac1=y
  918.             'fac2=x
  919.             Swap den, num
  920.         End If
  921.  
  922.         For j = den To 0 Step -1
  923.             carry = 0
  924.             digit = git(fac2.mantissa, j)
  925.             For i = num To 0 Step -1
  926.                 fac3(i) = fac3(i) + digit * git(fac1.mantissa, i)
  927.             Next
  928.             For i = num To 0 Step -1
  929.                 fac3(i) = fac3(i) + carry
  930.                 carry = fac3(i) \ 100000000
  931.                 fac3(i) = (fac3(i) Mod 100000000)
  932.             Next
  933.  
  934.             For i = digits To 1 Step -1
  935.                 fac3(i) = fac3(i - 1)
  936.             Next
  937.             fac3(0) = carry
  938.         Next
  939.  
  940.         For i = 0 To digits
  941.             Call set(fac1.mantissa, i, fac3(i))
  942.         Next
  943.     End If
  944.     'now determine exponent of result.
  945.     'as you do...watch for overflow.
  946.     ex = fac2.exponent - BIAS + fac1.exponent
  947.     fac1.exponent = ex
  948.     'determine the sign of the product
  949.     fac1.sign = fac1.sign Xor fac2.sign
  950.     Call NORM_FAC1(fac1, digits)
  951.     result = fac1
  952.  
  953. Sub fpmul_si (result As decfloat, x As decfloat, y As Integer64, digits_in As Long)
  954.     Dim As Long digits
  955.     digits = digits_in
  956.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  957.     Dim As decfloat fac1, fac2
  958.     Dim As Long count, ex, er, i
  959.     Dim As Integer64 carry, digit, prod, value
  960.     fac1 = x
  961.     digit = Abs(y)
  962.     If digit > 99999999 Then
  963.         Call si2fp(fac2, y, digits)
  964.         Call fpmul(fac1, fac1, fac2, digits)
  965.         result = fac1: Exit Sub
  966.     End If
  967.     'check exponents.  if either is zero,
  968.     'the result is zero
  969.     If fac1.exponent = 0 Or y = 0 Then 'result is zero...clear fac1.
  970.         fac1.sign = 0
  971.         fac1.exponent = 0
  972.         For count = 0 To digits
  973.             Call set(fac1.mantissa, count, 0)
  974.         Next
  975.         Call NORM_FAC1(fac1, digits)
  976.         result = fac1: Exit Sub
  977.     Else
  978.         If digit = 1 Then
  979.             If y < 0 Then
  980.                 fac1.sign = fac1.sign Xor &H8000
  981.             End If
  982.             result = fac1: Exit Sub
  983.         End If
  984.         'now determine exponent of result.
  985.         'as you do...watch for overflow.
  986.  
  987.         If ex < 0 Then
  988.             er = EXPO_ERR
  989.             result = fac1: Exit Sub
  990.         End If
  991.  
  992.         carry = 0
  993.  
  994.         For i = digits To 0 Step -1
  995.             prod = digit * git(fac1.mantissa, i) + carry
  996.             value = (prod Mod 100000000)
  997.             Call set(fac1.mantissa, i, value)
  998.             carry = prod \ 100000000
  999.         Next
  1000.  
  1001.         If carry < 10 Then
  1002.             Call RSHIFT_1(fac1, digits)
  1003.             fac1.exponent = fac1.exponent + 1
  1004.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10000000)
  1005.         ElseIf carry < 100 Then
  1006.             Call RSHIFT_2(fac1, digits)
  1007.             fac1.exponent = fac1.exponent + 2
  1008.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 1000000)
  1009.         ElseIf carry < 1000 Then
  1010.             Call RSHIFT_3(fac1, digits)
  1011.             fac1.exponent = fac1.exponent + 3
  1012.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 100000)
  1013.         ElseIf carry < 10000 Then
  1014.             Call RSHIFT_4(fac1, digits)
  1015.             fac1.exponent = fac1.exponent + 4
  1016.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10000)
  1017.         ElseIf carry < 100000 Then
  1018.             Call RSHIFT_5(fac1, digits)
  1019.             fac1.exponent = fac1.exponent + 5
  1020.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 1000)
  1021.         ElseIf carry < 1000000 Then
  1022.             Call RSHIFT_6(fac1, digits)
  1023.             fac1.exponent = fac1.exponent + 6
  1024.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 100)
  1025.         ElseIf carry < 10000000 Then
  1026.             Call RSHIFT_7(fac1, digits)
  1027.             fac1.exponent = fac1.exponent + 7
  1028.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10)
  1029.         ElseIf carry < 100000000 Then
  1030.             Call RSHIFT_8(fac1, digits)
  1031.             fac1.exponent = fac1.exponent + 8
  1032.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry)
  1033.         End If
  1034.  
  1035.     End If
  1036.  
  1037.     Call NORM_FAC1(fac1, digits)
  1038.  
  1039.     If y < 0 Then
  1040.         fac1.sign = fac1.sign Xor &H8000
  1041.     End If
  1042.     result = fac1
  1043.  
  1044. Sub fpmul_ll (result As decfloat, x As decfloat, y As Integer64, digits_in As Long)
  1045.     Dim As Long digits
  1046.     digits = digits_in
  1047.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1048.     Dim As decfloat fac1, fac2
  1049.     Dim As Long count, ex, er, i
  1050.     Dim As Integer64 carry, digit, prod, value, n0, n1
  1051.     fac1 = x
  1052.     digit = Abs(y)
  1053.     If digit > 99999999 And digit < 10000000000000000 Then
  1054.         n0 = digit \ 100000000
  1055.         n1 = digit Mod 100000000
  1056.         Call fpmul_si(fac2, fac1, n1, digits)
  1057.         fac1.exponent = fac1.exponent + 8
  1058.         Call fpmul_si(fac1, fac1, n0, digits)
  1059.         Call fpadd(fac1, fac1, fac2, digits)
  1060.         If y < 0 Then fac1.sign = fac1.sign Xor &H8000
  1061.         result = fac1: Exit Sub
  1062.     End If
  1063.     If digit > 9999999999999999 Then
  1064.         Call str2fp(fac2, Str$(y))
  1065.         Call fpmul(fac1, fac1, fac2, digits)
  1066.         result = fac1: Exit Sub
  1067.     End If
  1068.     Call si2fp(fac2, y, digits)
  1069.  
  1070.     'check exponents.  if either is zero,
  1071.     'the result is zero
  1072.     If fac1.exponent = 0 Or y = 0 Then 'result is zero...clear fac1.
  1073.         fac1.sign = 0
  1074.         fac1.exponent = 0
  1075.         For count = 0 To digits
  1076.             Call set(fac1.mantissa, count, 0)
  1077.         Next
  1078.         Call NORM_FAC1(fac1, digits)
  1079.         result = fac1: Exit Sub
  1080.     Else
  1081.         If digit = 1 Then
  1082.             If y < 0 Then
  1083.                 fac1.sign = fac1.sign Xor &H8000
  1084.             End If
  1085.             result = fac1: Exit Sub
  1086.         End If
  1087.         'now determine exponent of result.
  1088.         'as you do...watch for overflow.
  1089.  
  1090.         If ex < 0 Then
  1091.             er = EXPO_ERR
  1092.             result = fac1: Exit Sub
  1093.         End If
  1094.  
  1095.         carry = 0
  1096.  
  1097.         For i = digits To 0 Step -1
  1098.             prod = digit * git(fac1.mantissa, i) + carry
  1099.             value = (prod Mod 100000000)
  1100.             Call set(fac1.mantissa, i, value)
  1101.             carry = prod \ 100000000
  1102.         Next
  1103.  
  1104.         If carry < 10 Then
  1105.             Call RSHIFT_1(fac1, digits)
  1106.             fac1.exponent = fac1.exponent + 1
  1107.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10000000)
  1108.         ElseIf carry < 100 Then
  1109.             Call RSHIFT_2(fac1, digits)
  1110.             fac1.exponent = fac1.exponent + 2
  1111.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 1000000)
  1112.         ElseIf carry < 1000 Then
  1113.             Call RSHIFT_3(fac1, digits)
  1114.             fac1.exponent = fac1.exponent + 3
  1115.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 100000)
  1116.         ElseIf carry < 10000 Then
  1117.             Call RSHIFT_4(fac1, digits)
  1118.             fac1.exponent = fac1.exponent + 4
  1119.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10000)
  1120.         ElseIf carry < 100000 Then
  1121.             Call RSHIFT_5(fac1, digits)
  1122.             fac1.exponent = fac1.exponent + 5
  1123.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 1000)
  1124.         ElseIf carry < 1000000 Then
  1125.             Call RSHIFT_6(fac1, digits)
  1126.             fac1.exponent = fac1.exponent + 6
  1127.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 100)
  1128.         ElseIf carry < 10000000 Then
  1129.             Call RSHIFT_7(fac1, digits)
  1130.             fac1.exponent = fac1.exponent + 7
  1131.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10)
  1132.         ElseIf carry < 100000000 Then
  1133.             Call RSHIFT_8(fac1, digits)
  1134.             fac1.exponent = fac1.exponent + 8
  1135.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry)
  1136.         End If
  1137.  
  1138.     End If
  1139.  
  1140.     Call NORM_FAC1(fac1, digits)
  1141.  
  1142.     If y < 0 Then
  1143.         fac1.sign = fac1.sign Xor &H8000
  1144.     End If
  1145.     result = fac1
  1146.  
  1147. Sub fpinv (result As decfloat, m As decfloat, digits_in As Long)
  1148.     Dim As Long digits
  1149.     digits = digits_in
  1150.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1151.     Dim As Double x
  1152.     Dim As Long k, l, ex
  1153.     Dim As Long prec
  1154.     Dim As decfloat r, r2, one, n
  1155.     n = m
  1156.     l = Log((NUM_DIGITS + 8) * 0.0625) * 1.5
  1157.     Dim As String v, ts
  1158.     If n.exponent > 0 Then
  1159.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  1160.     Else
  1161.         ex = 0
  1162.     End If
  1163.  
  1164.     If n.sign Then v = "-" Else v = " "
  1165.     ts = Str$(git(n.mantissa, 0))
  1166.     If Len(ts) < 8 Then
  1167.         ts = ts + String$(8 - Len(ts), "0")
  1168.     End If
  1169.     v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
  1170.     ts = Str$(git(n.mantissa, 1))
  1171.     If Len(ts) < 8 Then
  1172.         ts = String$(8 - Len(ts), "0") + ts
  1173.     End If
  1174.     v = v + ts
  1175.     x = Val(v)
  1176.     If x = 0 Then Print "Div 0": result = r: Exit Sub
  1177.     If x = 1 And ex = 0 Then
  1178.         Call str2fp(r, "1")
  1179.         result = r: Exit Sub
  1180.     ElseIf x = 1 Then
  1181.         x = 10
  1182.         ex = ex - 1
  1183.     End If
  1184.     ex = (-1) - ex
  1185.     x = 1 / x
  1186.     Call str2fp(r, Str$(x))
  1187.     r.exponent = ex + BIAS + 1
  1188.     Call set(one.mantissa, 0, 10000000)
  1189.     one.exponent = BIAS + 1
  1190.     r2 = r
  1191.     prec = 3
  1192.     For k = 1 To l
  1193.         prec = 2 * prec - 1
  1194.         Call fpmul(r2, n, r, prec)
  1195.         Call fpsub(r2, one, r2, prec)
  1196.         Call fpmul(r2, r, r2, prec)
  1197.         Call fpadd(r, r, r2, prec)
  1198.     Next
  1199.     result = r
  1200.  
  1201. Function min& (a As Long, b As Long)
  1202.     If a < b Then min& = a Else min& = b
  1203.  
  1204. Function RealW# (w() As Double, j As Long)
  1205.     Dim wx As Double
  1206.     wx = ((w(j - 1) * 10000 + w(j)) * 10000 + w(j + 1)) * 10000
  1207.     If UBound(w) >= (j + 2) Then wx = wx + w(j + 2)
  1208.     RealW# = wx
  1209.  
  1210. Sub subtract (w() As Double, q As Long, d() As Double, ka As Long, kb As Long)
  1211.     Dim As Long j
  1212.     For j = ka To kb
  1213.         w(j) = w(j) - q * d(j - ka + 2)
  1214.     Next
  1215.  
  1216. Sub normalize (w() As Double, ka As Long, q As Long)
  1217.     w(ka) = w(ka) + w(ka - 1) * 10000
  1218.     w(ka - 1) = q
  1219.  
  1220. Sub finalnorm (w() As Double, kb As Long)
  1221.     Dim As Long carry, j
  1222.     For j = kb To 3 Step -1
  1223.         If w(j) < 0 Then
  1224.             carry = ((-w(j) - 1) \ 10000) + 1
  1225.         Else
  1226.             If w(j) >= 10000 Then
  1227.                 carry = -(w(j) \ 10000)
  1228.             Else
  1229.                 carry = 0
  1230.             End If
  1231.         End If
  1232.         w(j) = w(j) + carry * 10000
  1233.         w(j - 1) = w(j - 1) - carry
  1234.     Next
  1235.  
  1236. Sub fpdiv (result As decfloat, x As decfloat, y As decfloat, digits_in As Long)
  1237.     Dim As Long digits
  1238.     digits = digits_in
  1239.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1240.     Dim As decfloat fac1, fac2
  1241.     Dim As Long i, er, is_power_of_ten
  1242.  
  1243.     fac1 = x
  1244.     fac2 = y
  1245.  
  1246.     If fac2.exponent = 0 Then ' if fac2 = 0, return
  1247.         ' a divide-by-zero error and
  1248.         ' bail out.
  1249.         For i = 0 To digits
  1250.             Call set(fac1.mantissa, i, 99999999)
  1251.         Next
  1252.         fac1.exponent = 99999 + BIAS + 1
  1253.         er = DIVZ_ERR
  1254.         result = fac1
  1255.         Exit Sub
  1256.     ElseIf fac1.exponent = 0 Then 'fact1=0, just return
  1257.         er = 0
  1258.         result = fac1
  1259.         Exit Sub
  1260.     Else
  1261.         'check to see if fac2 is a power of ten
  1262.         is_power_of_ten = 0
  1263.         If git(fac2.mantissa, 0) = 10000000 Then
  1264.             is_power_of_ten = 1
  1265.             For i = 1 To digits
  1266.                 If git(fac2.mantissa, i) <> 0 Then
  1267.                     is_power_of_ten = 0
  1268.                     Exit For
  1269.                 End If
  1270.             Next
  1271.         End If
  1272.         'if fac2 is a power of ten then all we need to do is to adjust the sign and exponent and we are finished
  1273.         If is_power_of_ten = 1 Then
  1274.             fac1.sign = fac1.sign Xor fac2.sign
  1275.             fac1.exponent = fac1.exponent - fac2.exponent + BIAS + 1
  1276.             result = fac1
  1277.             Exit Sub
  1278.         End If
  1279.  
  1280.         Dim As Double result(1 To 2 * digits + 3), n(1 To 2 * digits + 3), d(1 To 2 * digits + 3)
  1281.         Const b = 10000
  1282.         Dim As Long j, last, laststep, q, t
  1283.         Dim As Long stp
  1284.         Dim As Double xd, xn, rund
  1285.         Dim As Double w(1 To UBound(n) + 4)
  1286.  
  1287.         For j = 0 To digits
  1288.             n(2 * j + 2) = git(fac1.mantissa, j) \ 10000
  1289.             n(2 * j + 3) = git(fac1.mantissa, j) Mod 10000
  1290.             d(2 * j + 2) = git(fac2.mantissa, j) \ 10000
  1291.             d(2 * j + 3) = git(fac2.mantissa, j) Mod 10000
  1292.         Next
  1293.         n(1) = (fac1.exponent And &H7FFFFFFF) - BIAS - 1
  1294.         d(1) = (fac2.exponent And &H7FFFFFFF) - BIAS - 1
  1295.         For j = UBound(n) To UBound(w)
  1296.             w(j) = 0
  1297.         Next
  1298.         t = UBound(n) - 1
  1299.         w(1) = n(1) - d(1) + 1
  1300.         w(2) = 0
  1301.         For j = 2 To UBound(n)
  1302.             w(j + 1) = n(j)
  1303.         Next
  1304.         xd = (d(2) * b + d(3)) * b + d(4) + d(5) / b
  1305.         laststep = t + 2
  1306.         For stp = 1 To laststep
  1307.             xn = RealW(w(), (stp + 2))
  1308.             q = Int(xn / xd)
  1309.             last = min(stp + t + 1, UBound(w))
  1310.             Call subtract(w(), q, d(), (stp + 2), last)
  1311.             Call normalize(w(), (stp + 2), q)
  1312.         Next
  1313.         Call finalnorm(w(), (laststep + 1))
  1314.         If w(2) <> 0 Then laststep = laststep - 1
  1315.         rund = w(laststep + 1) / b
  1316.         If rund >= 0.5 Then w(laststep) = w(laststep) + 1
  1317.         If w(2) = 0 Then
  1318.             For j = 1 To t + 1
  1319.                 result(j) = w(j + 1)
  1320.             Next
  1321.         Else
  1322.             For j = 1 To t + 1
  1323.                 result(j) = w(j)
  1324.             Next
  1325.         End If
  1326.         If w(2) = 0 Then result(1) = w(1) - 1 Else result(1) = w(1)
  1327.  
  1328.         For j = 0 To digits
  1329.             Call set(fac1.mantissa, j, result(2 * j + 2) * 10000 + result(2 * j + 3))
  1330.         Next
  1331.         Call NORM_FAC1(fac1, digits)
  1332.         fac1.exponent = (result(1) + BIAS)
  1333.     End If
  1334.     fac1.sign = fac1.sign Xor fac2.sign
  1335.     result = fac1
  1336.  
  1337. ' sqrt(num)
  1338. Sub fpsqr (result As decfloat, num As decfloat, digits_in As Long)
  1339.     Dim As Long digits
  1340.     digits = digits_in
  1341.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1342.     Dim As decfloat r, r2, tmp, n, half
  1343.     Dim As Long ex, k, l, prec
  1344.     Dim As String ts, v
  1345.     Dim As Double x
  1346.     l = Log((NUM_DIGITS + 8) * 0.0625) * 1.5
  1347.     'l=estimated number of iterations needed
  1348.     'first estimate is accurate to about 16 digits
  1349.     'l is approximatly = to log2((NUM_DIGITS+9)/16)
  1350.     'NUM_DIGITS+9 because decfloat has an extra 9 guard digits
  1351.     n = num
  1352.     Call si2fp(tmp, 0, digits)
  1353.     If fpcmp(n, tmp, digits) = 0 Then
  1354.         Call si2fp(r, 0, digits)
  1355.         result = r
  1356.         Exit Sub
  1357.     End If
  1358.     Call si2fp(tmp, 1, digits)
  1359.     If fpcmp(n, tmp, digits) = 0 Then
  1360.         Call si2fp(r, 1, digits)
  1361.         result = r
  1362.         Exit Sub
  1363.     End If
  1364.     Call si2fp(tmp, 0, digits)
  1365.     If fpcmp(n, tmp, digits) < 0 Then
  1366.         Call si2fp(r, 0, digits)
  1367.         result = r
  1368.         Exit Sub
  1369.     End If
  1370.     '=====================================================================
  1371.     'hack to bypass the limitation of double exponent range
  1372.     'in case the number is larger than what a double can handle
  1373.     'for example, if the number is 2e500
  1374.     'we separate the exponent and mantissa in this case 2
  1375.     'if the exponent is odd then multiply the mantissa by 10
  1376.     'take the square root and assign it to decfloat
  1377.     'divide the exponent in half for square root
  1378.     'in this case 1.414213562373095e250
  1379.     If n.exponent > 0 Then
  1380.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  1381.     Else
  1382.         ex = 0
  1383.     End If
  1384.     ts = Trim$(Str$(git(n.mantissa, 0)))
  1385.     If Len(ts) < 8 Then
  1386.         ts = ts + String$(8 - Len(ts), "0")
  1387.     End If
  1388.     v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
  1389.     ts = Trim$(Str$(git(n.mantissa, 1)))
  1390.     If Len(ts) < 8 Then
  1391.         ts = String$(8 - Len(ts), "0") + ts
  1392.     End If
  1393.     v = v + ts
  1394.     x = Val(v)
  1395.     If x = 0 Then Print "Div 0": result = r: Exit Sub
  1396.     If x = 1 And ex = 0 Then
  1397.         Call si2fp(r, 1, digits)
  1398.         result = r
  1399.         Exit Sub
  1400.     End If
  1401.     If Abs(ex) And 1 Then
  1402.         x = x * 10
  1403.         ex = ex - 1
  1404.     End If
  1405.     x = Sqr(x) 'approximation
  1406.     v = Trim$(Str$(x))
  1407.     k = InStr(v, ".")
  1408.     Call str2fp(r, v)
  1409.     r.exponent = ex \ 2 + BIAS + 1
  1410.     If Len(v) > 1 And k = 0 Then r.exponent = r.exponent + 1
  1411.     For k = 1 To digits
  1412.         Call set(half.mantissa, k, 0)
  1413.     Next
  1414.     Call set(half.mantissa, 0, 50000000)
  1415.     half.exponent = BIAS
  1416.     half.sign = 0
  1417.     '=====================================================================
  1418.     'Newton-Raphson method
  1419.     prec = 3
  1420.     For k = 1 To l + 1
  1421.         prec = 2 * prec - 1
  1422.         Call fpdiv(tmp, n, r, prec)
  1423.         Call fpadd(r2, r, tmp, prec)
  1424.         Call fpmul(r, r2, half, prec)
  1425.     Next
  1426.     result = r
  1427.  
  1428. Sub fpdiv_si (result As decfloat, num As decfloat, den As Long, digits_in As Long)
  1429.     Dim As Long digits
  1430.     digits = digits_in
  1431.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1432.     Dim As decfloat fac1
  1433.     Dim As Unsigned Integer64 carry, remder
  1434.     Dim As Integer64 i, divisor
  1435.     Dim As Integer64 quotient
  1436.     remder = 0
  1437.     divisor = Abs(den)
  1438.     fac1 = num
  1439.     If divisor = 0 Then
  1440.         Print "error: divisor = 0"
  1441.         result = fac1: Exit Sub
  1442.     End If
  1443.     If divisor > 99999999 Then
  1444.         Print "error: divisor too large"
  1445.         result = fac1: Exit Sub
  1446.     End If
  1447.  
  1448.     For i = 0 To digits
  1449.         quotient = git(fac1.mantissa, i) + remder * 100000000
  1450.         remder = quotient Mod divisor
  1451.         Call set(fac1.mantissa, i, quotient \ divisor)
  1452.     Next
  1453.     quotient = remder * 100000000
  1454.     quotient = quotient \ divisor
  1455.     carry = git(fac1.mantissa, 0)
  1456.  
  1457.     If carry = 0 Then
  1458.         Call LSHIFT_8(fac1, digits)
  1459.         fac1.exponent = fac1.exponent - 8
  1460.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient)
  1461.     ElseIf carry < 10 Then
  1462.         Call LSHIFT_7(fac1, digits)
  1463.         fac1.exponent = fac1.exponent - 7
  1464.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 10)
  1465.     ElseIf carry < 100 Then
  1466.         Call LSHIFT_6(fac1, digits)
  1467.         fac1.exponent = fac1.exponent - 6
  1468.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 100)
  1469.     ElseIf carry < 1000 Then
  1470.         Call LSHIFT_5(fac1, digits)
  1471.         fac1.exponent = fac1.exponent - 5
  1472.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 1000)
  1473.     ElseIf carry < 10000 Then
  1474.         Call LSHIFT_4(fac1, digits)
  1475.         fac1.exponent = fac1.exponent - 4
  1476.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 10000)
  1477.     ElseIf carry < 100000 Then
  1478.         Call LSHIFT_3(fac1, digits)
  1479.         fac1.exponent = fac1.exponent - 3
  1480.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 100000)
  1481.     ElseIf carry < 1000000 Then
  1482.         Call LSHIFT_2(fac1, digits)
  1483.         fac1.exponent = fac1.exponent - 2
  1484.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 1000000)
  1485.     ElseIf carry < 10000000 Then
  1486.         Call LSHIFT_1(fac1, digits)
  1487.         fac1.exponent = fac1.exponent - 1
  1488.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 10000000)
  1489.     End If
  1490.  
  1491.     'NORM_FAC1(fac1)
  1492.     If den < 0 Then
  1493.         fac1.sign = fac1.sign Xor &H8000
  1494.     End If
  1495.     result = fac1
  1496.  
  1497. 'fractional part of num
  1498. Sub fpfrac (result As decfloat, num As decfloat, digits_in As Long)
  1499.     Dim As Long digits
  1500.     digits = digits_in
  1501.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1502.     Dim As decfloat n
  1503.     Call fpfix(n, num)
  1504.     Call fpsub(n, num, n, digits)
  1505.     result = n
  1506.  
  1507. 'returns the positive of n
  1508. Sub fpabs (result As decfloat, n As decfloat)
  1509.     Dim As decfloat x
  1510.     x = n
  1511.     x.sign = 0
  1512.     result = x
  1513.  
  1514. 'changes the sign of n, if n is positive then n will be negative & vice versa
  1515. Sub fpneg (result As decfloat, n As decfloat)
  1516.     Dim As decfloat x
  1517.     x = n
  1518.     x.sign = x.sign Xor &H8000
  1519.     result = x
  1520.  
  1521. 'returns the negative of n regardless of the sign of n
  1522. Sub fpnegative (result As decfloat, n As decfloat)
  1523.     Dim As decfloat x
  1524.     x = n
  1525.     x.sign = &H8000
  1526.     result = x
  1527.  
  1528. Sub fpfmod (quotient As decfloat, f_mod As decfloat, num As decfloat, denom As decfloat, digits As Long)
  1529.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1530.     Dim As decfloat q, fm 'make copy in case the destination and source are the same
  1531.     Call fpdiv(fm, num, denom, digits): Call fpfix(q, fm)
  1532.     Call fpsub(fm, fm, q, digits): Call fpmul(fm, fm, denom, digits)
  1533.     quotient = q
  1534.     f_mod = fm
  1535.  
  1536. Sub fpeps (result As decfloat, digits As Long)
  1537.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1538.     Dim As decfloat ep
  1539.     Call si2fp(ep, 1, digits)
  1540.     ep.exponent = (-(NUM_DIGITS) + BIAS + 1)
  1541.     result = ep
  1542.  
  1543. Sub fpipow (result As decfloat, x As decfloat, e As Integer64, digits_in As Long)
  1544.     Dim As Long digits
  1545.     digits = digits_in
  1546.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1547.     'take x to an Long power
  1548.     Dim As decfloat y
  1549.     Dim As decfloat z
  1550.     Dim As Integer64 n, c
  1551.     Dim As Long i
  1552.     c = 0
  1553.     y = x
  1554.     n = Abs(e)
  1555.     z.sign = 0
  1556.     z.exponent = (BIAS + 1)
  1557.     Call set(z.mantissa, 0, 10000000)
  1558.     For i = 1 To NUM_DWORDS
  1559.         Call set(z.mantissa, i, 0)
  1560.     Next
  1561.     While n > 0
  1562.         While (n And 1) = 0
  1563.             n = n \ 2
  1564.             Call fpmul(y, y, y, digits)
  1565.             c = c + 1
  1566.         Wend
  1567.         n = n - 1
  1568.         Call fpmul(z, y, z, digits)
  1569.         c = c + 1
  1570.     Wend
  1571.     If e < 0 Then
  1572.         Call fpinv(z, z, digits)
  1573.     End If
  1574.     result = z
  1575.  
  1576. Sub fpfactorial (result As decfloat, n As Long, digits_in As Long)
  1577.     Dim As Long digits
  1578.     digits = digits_in
  1579.     Dim As Long i
  1580.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1581.     Dim As decfloat f
  1582.     If n < 0 Then Print "inf": result = f: Exit Sub
  1583.     If n = 0 Or n = 1 Then
  1584.         Call si2fp(f, 1, digits)
  1585.         result = f: Exit Sub
  1586.     End If
  1587.     Call si2fp(f, 2, digits)
  1588.     If n = 2 Then result = f: Exit Sub
  1589.     For i = 3 To n
  1590.         Call fpmul_si(f, f, i, digits)
  1591.     Next
  1592.     result = f
  1593.  
  1594. Sub fplogTaylor (result As decfloat, x As decfloat, digits_in As Long)
  1595.     Dim As Long digits
  1596.     digits = digits_in
  1597.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1598.     'taylor series
  1599.     '====================Log Guard==================
  1600.     Dim As decfloat g, zero
  1601.     Dim As Long i
  1602.     Call fpabs(g, x)
  1603.     zero.sign = 0
  1604.     zero.exponent = 0
  1605.     For i = 0 To NUM_DWORDS
  1606.         Call set(zero.mantissa, i, 0)
  1607.     Next
  1608.     If fpcmp(g, x, digits) <> 0 Then result = zero: Exit Sub
  1609.     If fpcmp(x, zero, digits) = 0 Then result = zero: Exit Sub
  1610.     '=============================================
  1611.     Dim As Long invflag
  1612.     Dim As decfloat XX, Term, Accum, x9, tmp, tmp2
  1613.     Dim As decfloat T, B, one, Q, two
  1614.  
  1615.     one.sign = 0
  1616.     one.exponent = (BIAS + 1)
  1617.     Call set(one.mantissa, 0, 10000000)
  1618.     two.sign = 0
  1619.     two.exponent = (BIAS + 1)
  1620.     Call set(two.mantissa, 0, 20000000)
  1621.     For i = 1 To NUM_DWORDS
  1622.         Call set(one.mantissa, i, 0)
  1623.         Call set(two.mantissa, i, 0)
  1624.     Next
  1625.     x9 = x
  1626.     If fpcmp(x, one, digits) < 0 Then
  1627.         invflag = 1
  1628.         Call fpdiv(x9, one, x9, digits)
  1629.     End If
  1630.     Call fpsub(T, x9, one, digits)
  1631.     Call fpadd(B, x9, one, digits)
  1632.     Call fpdiv(Accum, T, B, digits)
  1633.     Call fpdiv(Q, T, B, digits)
  1634.     tmp = Q
  1635.     Call fpmul(XX, Q, Q, digits)
  1636.     Dim As Long c
  1637.     c = 1
  1638.     Do
  1639.         c = c + 2
  1640.         tmp2 = tmp
  1641.         Call fpmul(Q, Q, XX, digits)
  1642.         Call fpdiv_si(Term, Q, c, digits)
  1643.         Call fpadd(Accum, tmp, Term, digits)
  1644.         Swap tmp, Accum
  1645.     Loop Until fpcmp(tmp, tmp2, digits) = 0
  1646.     Call fpmul_si(Accum, Accum, 2, digits)
  1647.     If invflag Then
  1648.         Call fpneg(Accum, Accum)
  1649.         result = Accum: Exit Sub
  1650.     End If
  1651.     result = Accum
  1652.  
  1653. Sub fplog (result As decfloat, x As decfloat, digits_in As Long)
  1654.     Dim As Long digits
  1655.     digits = digits_in
  1656.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1657.     '====================Log Guard==================
  1658.     Dim As decfloat g, one, zero
  1659.     Dim As Long i, factor
  1660.     zero.sign = 0
  1661.     zero.exponent = 0
  1662.     For i = 0 To NUM_DWORDS
  1663.         Call set(zero.mantissa, i, 0)
  1664.     Next
  1665.     Call si2fp(one, 1, digits)
  1666.     Call fpabs(g, x)
  1667.     If fpcmp(g, x, digits) <> 0 Then result = zero: Exit Sub
  1668.     If fpcmp(x, zero, digits) = 0 Then result = zero: Exit Sub
  1669.     If fpcmp(x, one, digits) = 0 Then result = zero: Exit Sub
  1670.     '=============================================
  1671.     Dim As decfloat approx, ans, logx
  1672.     approx = x
  1673.     factor = 4096
  1674.     Call fpsqr(approx, approx, digits)
  1675.     Call fpsqr(approx, approx, digits)
  1676.     Call fpsqr(approx, approx, digits)
  1677.     Call fpsqr(approx, approx, digits)
  1678.     Call fpsqr(approx, approx, digits)
  1679.     Call fpsqr(approx, approx, digits)
  1680.     Call fpsqr(approx, approx, digits)
  1681.     Call fpsqr(approx, approx, digits)
  1682.     Call fpsqr(approx, approx, digits)
  1683.     Call fpsqr(approx, approx, digits)
  1684.     Call fpsqr(approx, approx, digits)
  1685.     Call fpsqr(approx, approx, digits)
  1686.     Call fplogTaylor(logx, approx, digits)
  1687.     Call fpmul_si(ans, logx, factor, digits)
  1688.     result = ans
  1689.  
  1690. Sub fpexp (result As decfloat, x As decfloat, digits_in As Long)
  1691.     Dim As Long digits
  1692.     digits = digits_in
  1693.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1694.     'taylor series
  1695.     Dim As decfloat fac, x9, temp, accum, p, term
  1696.     Dim As Long i, c
  1697.     Call si2fp(temp, 0, digits)
  1698.  
  1699.     fac.sign = 0
  1700.     fac.exponent = (BIAS + 1)
  1701.     Call set(fac.mantissa, 0, 10000000)
  1702.     For i = 1 To NUM_DWORDS
  1703.         Call set(fac.mantissa, i, 0)
  1704.     Next
  1705.     If fpcmp(x, temp, digits) = 0 Then result = fac: Exit Sub
  1706.     c = 1
  1707.     Call fpdiv_si(x9, x, 8192, digits) 'fpdiv_si(x, 67108864) '
  1708.     p = x9
  1709.     Call fpadd(accum, fac, x9, digits) '1 + x
  1710.  
  1711.     Do
  1712.         c = c + 1
  1713.         temp = accum
  1714.         Call fpdiv_si(fac, fac, c, digits)
  1715.         Call fpmul(p, p, x9, digits)
  1716.         Call fpmul(term, p, fac, digits)
  1717.         Call fpadd(accum, temp, term, digits)
  1718.     Loop Until fpcmp(accum, temp, digits) = 0
  1719.     For i = 1 To 13
  1720.         Call fpmul(accum, accum, accum, digits)
  1721.     Next
  1722.     result = accum
  1723.  
  1724. Sub fpexp_cf (result As decfloat, x As decfloat, n As Long, digits_in As Long)
  1725.     Dim As Long digits
  1726.     digits = digits_in
  1727.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1728.  
  1729.     '                       x
  1730.     '    cf =   ------------------------------
  1731.     '                         x^2
  1732.     '           2 + -------------------------
  1733.     '                           x^2
  1734.     '              6 + ----------------------
  1735.     '                             x^2
  1736.     '                 10 + ------------------
  1737.     '                               x^2
  1738.     '                     14 + --------------
  1739.     '                                 x^2
  1740.     '                          18 + ---------
  1741.     '                                   x^2
  1742.     '                              22 + -----
  1743.     '                                   26 + ...
  1744.     '           (1 + cf)
  1745.     ' exp(x) = ----------
  1746.     '           (1 - cf)
  1747.  
  1748.     Dim i As Long
  1749.     Dim As decfloat s, x1, x2, tmp, tmp2
  1750.     Call fpdiv_si(x1, x, 8192, digits) ' 2^13
  1751.     Call fpmul(x2, x1, x1, digits)
  1752.     Call si2fp(s, 4 * n + 6, digits)
  1753.     For i = n To 0 Step -1
  1754.         Call si2fp(tmp, 4 * i + 2, digits)
  1755.         Call fpdiv(s, x2, s, digits)
  1756.         Call fpadd(s, s, tmp, digits)
  1757.     Next
  1758.     Call fpdiv(s, x1, s, digits)
  1759.     Call si2fp(tmp, 1, digits)
  1760.     tmp2 = tmp
  1761.     Call fpadd(tmp, tmp, s, digits)
  1762.     Call fpsub(tmp2, tmp2, s, digits)
  1763.     Call fpdiv(s, tmp, tmp2, digits)
  1764.     For i = 1 To 13 ' s^13
  1765.         Call fpmul(s, s, s, digits)
  1766.     Next
  1767.     result = s
  1768.  
  1769. Sub fplog_r (result As decfloat, x As decfloat, digits_in As Long)
  1770.     Dim As Long digits
  1771.     digits = digits_in
  1772.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1773.     '====================Log Guard==================
  1774.     Dim As decfloat x2, y, tmp
  1775.     Dim As Long i
  1776.     Dim As Long ex, terms, prec, n
  1777.     Dim As Double t, t2
  1778.  
  1779.     tmp.sign = 0
  1780.     tmp.exponent = (BIAS + 1)
  1781.     Call set(tmp.mantissa, 0, 10000000)
  1782.     For i = 1 To NUM_DWORDS
  1783.         Call set(tmp.mantissa, i, 0)
  1784.     Next
  1785.     If fpcmp(x, tmp, digits) = 0 Then result = x2: Exit Sub
  1786.     ex = (x.exponent And &H7FFFFFFF) - BIAS - 1
  1787.     t = git(x.mantissa, 0) + git(x.mantissa, 1) / 100000000
  1788.     t = t / 10000000
  1789.     t2 = Log(t) + Log(10) * ex
  1790.  
  1791.     n = Log((digits + 1) * 0.5) * 1.5
  1792.  
  1793.     Call str2fp(x2, Str$(t2))
  1794.     prec = 3
  1795.     terms = 2
  1796.     prec = 2 * prec - 1
  1797.     Call fpexp_cf(y, x2, terms, prec)
  1798.     Call fpsub(tmp, y, x, prec)
  1799.     Call fpdiv(tmp, tmp, y, prec)
  1800.     Call fpsub(x2, x2, tmp, prec)
  1801.     If digits > 4 And digits <= 9 Then
  1802.         prec = 2 * prec - 1
  1803.         terms = 2 * terms + 1
  1804.         Call fpexp_cf(y, x2, terms, prec)
  1805.         Call fpsub(tmp, y, x, prec)
  1806.         Call fpdiv(tmp, tmp, y, prec)
  1807.         Call fpsub(x2, x2, tmp, prec)
  1808.     ElseIf digits > 9 And digits < 18 Then
  1809.         For i = 1 To 3
  1810.             prec = 2 * prec - 1
  1811.             terms = 2 * terms + 1
  1812.             Call fpexp_cf(y, x2, terms, prec)
  1813.             Call fpsub(tmp, y, x, prec)
  1814.             Call fpdiv(tmp, tmp, y, prec)
  1815.             Call fpsub(x2, x2, tmp, prec)
  1816.         Next
  1817.     ElseIf digits > 17 And digits < 34 Then
  1818.         For i = 1 To 4
  1819.             prec = 2 * prec - 1
  1820.             terms = 2 * terms + 1
  1821.             Call fpexp_cf(y, x2, terms, prec)
  1822.             Call fpsub(tmp, y, x, prec)
  1823.             Call fpdiv(tmp, tmp, y, prec)
  1824.             Call fpsub(x2, x2, tmp, prec)
  1825.         Next
  1826.     ElseIf digits > 33 And digits < 65 Then
  1827.         For i = 1 To 5
  1828.             prec = 2 * prec - 1
  1829.             terms = 2 * terms + 1
  1830.             Call fpexp_cf(y, x2, terms, prec)
  1831.             Call fpsub(tmp, y, x, prec)
  1832.             Call fpdiv(tmp, tmp, y, prec)
  1833.             Call fpsub(x2, x2, tmp, prec)
  1834.         Next
  1835.     ElseIf digits > 64 Then
  1836.         For i = 1 To 6
  1837.             prec = 2 * prec - 1
  1838.             terms = 2 * terms + 1
  1839.             Call fpexp_cf(y, x2, terms, prec)
  1840.             Call fpsub(tmp, y, x, prec)
  1841.             Call fpdiv(tmp, tmp, y, prec)
  1842.             Call fpsub(x2, x2, tmp, prec)
  1843.         Next
  1844.     End If
  1845.     result = x2
  1846.  
  1847. Sub fppow (result As decfloat, lhs As decfloat, rhs As decfloat)
  1848.     Dim As decfloat lhs2
  1849.     Call fplog(lhs2, lhs, NUM_DWORDS)
  1850.     Call fpmul(lhs2, lhs2, rhs, NUM_DWORDS)
  1851.     Call fpexp(lhs2, lhs2, NUM_DWORDS)
  1852.     result = lhs2
  1853.  
  1854. Sub fpnroot (result As decfloat, x As decfloat, p As Long, digits_in As Long)
  1855.     Dim As Long digits
  1856.     digits = digits_in
  1857.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1858.     Dim As decfloat ry, tmp, tmp2
  1859.     Dim As Double t, t2
  1860.     Dim As Long i, ex, l, prec
  1861.  
  1862.     l = Log((NUM_DIGITS + 8) * 0.0625) * 1.5
  1863.     ex = (x.exponent And &H7FFFFFFF) - BIAS - 1
  1864.     t = git(x.mantissa, 0) + git(x.mantissa, 1) / 100000000
  1865.     t = t / 10000000
  1866.     t2 = Log(t) / p + Log(10) * ex / p
  1867.     t2 = Exp(t2)
  1868.     Call str2fp(ry, Str$(t2))
  1869.     prec = 3
  1870.  
  1871.     Call fpipow(tmp, ry, p - 1, prec)
  1872.     Call fpdiv(tmp, x, tmp, prec)
  1873.     Call fpmul_si(tmp2, ry, p - 1, prec)
  1874.     Call fpadd(tmp2, tmp2, tmp, prec)
  1875.     Call fpdiv_si(ry, tmp2, p, prec)
  1876.     For i = 1 To l
  1877.         prec = 2 * prec - 1
  1878.         Call fpipow(tmp, ry, p - 1, prec)
  1879.         Call fpdiv(tmp, x, tmp, prec)
  1880.         Call fpmul_si(tmp2, ry, p - 1, prec)
  1881.         Call fpadd(tmp2, tmp2, tmp, prec)
  1882.         Call fpdiv_si(ry, tmp2, p, prec)
  1883.     Next
  1884.     result = ry
  1885.  
  1886. Sub pi_brent_salamin (pi_bs As decfloat, digits_in As Unsigned Long)
  1887.     Dim As Unsigned Long digits
  1888.     digits = digits_in
  1889.     If digits > NUMBER_OF_DIGITS Then digits = NUMBER_OF_DIGITS
  1890.  
  1891.     Dim As Long limit2
  1892.     Dim As decfloat c0, c1, c2, c05
  1893.     Dim As decfloat a, b, sum
  1894.     Dim As decfloat ak, bk, ck
  1895.     Dim As decfloat ab, asq
  1896.     Dim As decfloat pow2, tmp
  1897.  
  1898.     limit2 = -digits + BIAS + 1
  1899.     Call si2fp(c0, 0, NUMBER_OF_DIGITS): ak = c0: bk = c0: ab = c0: asq = c0
  1900.     Call si2fp(c1, 1, NUMBER_OF_DIGITS): a = c1: ck = c1: pow2 = c1
  1901.     Call si2fp(c2, 2, NUMBER_OF_DIGITS): b = c2
  1902.     Call str2fp(c05, ".5"): sum = c05
  1903.     Call si2fp(pi_bs, 3, NUMBER_OF_DIGITS)
  1904.  
  1905.     Call fpsqr(b, b, NUMBER_OF_DIGITS)
  1906.     Call fpdiv(b, c1, b, NUMBER_OF_DIGITS)
  1907.     While fpcmp(ck, c0, NUMBER_OF_DIGITS) <> 0 And ck.exponent > limit2
  1908.         Call fpadd(ak, a, b, NUMBER_OF_DIGITS)
  1909.         Call fpmul(ak, c05, ak, NUMBER_OF_DIGITS)
  1910.         Call fpmul(ab, a, b, NUMBER_OF_DIGITS)
  1911.         Call fpsqr(bk, ab, NUMBER_OF_DIGITS)
  1912.         Call fpmul(asq, ak, ak, NUMBER_OF_DIGITS)
  1913.         Call fpsub(ck, asq, ab, NUMBER_OF_DIGITS)
  1914.         Call fpmul(pow2, pow2, c2, NUMBER_OF_DIGITS)
  1915.         Call fpmul(tmp, pow2, ck, NUMBER_OF_DIGITS)
  1916.         Call fpsub(sum, sum, tmp, NUMBER_OF_DIGITS)
  1917.         a = ak: b = bk
  1918.     Wend
  1919.     Call fpdiv(tmp, asq, sum, NUMBER_OF_DIGITS)
  1920.     Call fpmul(pi_bs, c2, tmp, NUMBER_OF_DIGITS)
  1921.  
  1922. Sub fpsin (result As decfloat, x As decfloat, digits_in As Unsigned Long)
  1923.     Dim As decfloat XX, Term, Accum, p, temp2, fac, x_2
  1924.     Dim As decfloat pi2, circ, Ab
  1925.     Dim As Long precision
  1926.     precision = digits_in
  1927.  
  1928.     x_2 = x
  1929.     pi2 = pi_dec
  1930.     Call fpmul_si(circ, pi2, 2, precision)
  1931.     Call fpabs(Ab, x)
  1932.     If fpcmp(Ab, circ, precision) > 0 Then
  1933.         '======== CENTRALIZE ==============
  1934.         'floor/ceil to centralize
  1935.         Dim As decfloat tmp, tmp2
  1936.         If precision > 20 Then
  1937.             pi2 = pi_dec
  1938.         End If
  1939.         Call fpmul_si(pi2, pi2, 2, precision) 'got 2*pi
  1940.         Call fpdiv(tmp, x_2, pi2, precision)
  1941.         tmp2 = tmp
  1942.         Call fpfix(tmp, tmp) 'int part
  1943.         Call fpsub(tmp, tmp2, tmp, precision) 'frac part
  1944.         Call fpmul(tmp, tmp, pi2, precision)
  1945.         x_2 = tmp
  1946.     End If
  1947.  
  1948.     Dim As Long lm, limit2, i
  1949.     Dim As decfloat factor
  1950.     lm = precision
  1951.     limit2 = Int(-0.45344993886092585968 + 0.022333002852398072433 * lm + 5.0461814408333079844E-7 * lm * lm - 4.2338453039804235772E-11 * lm * lm * lm)
  1952.  
  1953.     Call si2fp(factor, 5, precision)
  1954.     Call fpipow(factor, factor, limit2, precision)
  1955.     Call fpdiv(x_2, x_2, factor, precision) 'x_=x_/5^limit2
  1956.     '==================================
  1957.     Dim As Long sign(3): sign(3) = 1
  1958.     Dim As Long c: c = 1
  1959.  
  1960.     Accum = x_2
  1961.     Call si2fp(fac, 1, precision)
  1962.     p = x_2
  1963.     Call fpmul(XX, x_2, x_2, precision)
  1964.     Do
  1965.         c = c + 2
  1966.         temp2 = Accum
  1967.         Call fpmul_si(fac, fac, c * (c - 1), precision)
  1968.         Call fpmul(p, p, XX, precision)
  1969.         Call fpdiv(Term, p, fac, precision)
  1970.         If sign(c And 3) Then
  1971.             Call fpsub(Accum, temp2, Term, precision)
  1972.         Else
  1973.             Call fpadd(Accum, temp2, Term, precision)
  1974.         End If
  1975.     Loop Until fpcmp(Accum, temp2, precision) = 0
  1976.     'multiply the result by 5^limit2
  1977.  
  1978.     For i = 1 To limit2
  1979.         Call fpmul(p, Accum, Accum, precision)
  1980.         Call fpmul(temp2, Accum, p, precision)
  1981.         '*** sin(5*x) = 5 * sin(x) - 20 * sin(x)^3 + 16 * sin(x)^5
  1982.         Call fpmul_si(Accum, Accum, 5, precision)
  1983.         Call fpmul_si(Term, temp2, 20, precision)
  1984.         Call fpmul_si(XX, temp2, 16, precision)
  1985.         Call fpmul(XX, XX, p, precision)
  1986.         Call fpsub(Accum, Accum, Term, precision)
  1987.         Call fpadd(Accum, Accum, XX, precision)
  1988.     Next i
  1989.     result = Accum
  1990.  
  1991. Sub fpcos (result As decfloat, z As decfloat, digits_in As Unsigned Long)
  1992.     Dim As decfloat x_2, pi2
  1993.     Dim As Long precision
  1994.     precision = digits_in
  1995.     Call fpdiv_si(pi2, pi_dec, 2, precision)
  1996.     Call fpsub(x_2, pi2, z, precision)
  1997.  
  1998.     Call fpsin(result, x_2, precision)
  1999.  
  2000. Sub fptan (result As decfloat, z As decfloat, digits_in As Unsigned Long)
  2001.     Dim As decfloat x_2, s, c
  2002.     Dim As Long precision
  2003.     precision = digits_in
  2004.     x_2 = z
  2005.     Call fpsin(s, x_2, precision)
  2006.     x_2 = z
  2007.     Call fpcos(c, x_2, precision)
  2008.     Call fpdiv(result, s, c, precision)
  2009.  
  2010. Sub fpatn (result As decfloat, x As decfloat, digits_in As Unsigned Long)
  2011.     Dim As Long precision, z
  2012.     precision = digits_in
  2013.     Dim As Long sign(3): sign(3) = 1
  2014.     Dim As Unsigned Long c: c = 1
  2015.     Dim As decfloat XX, Term, Accum, strC, x_2, mt, mt2, p
  2016.     Dim As decfloat decnum, one, decnum2, factor
  2017.  
  2018.     decnum2 = x
  2019.     decnum2.sign = 0
  2020.     Call si2fp(one, 1, precision)
  2021.     If fpcmp(decnum2, one, precision) = 0 Then
  2022.         Call fpdiv_si(result, pi_dec, 4, precision)
  2023.         result.sign = x.sign
  2024.         Exit Sub
  2025.     End If
  2026.     decnum2.sign = x.sign
  2027.     Dim As Long limit2: limit2 = 16
  2028.     Call si2fp(factor, SHL(2, limit2 - 1), precision)
  2029.     For z = 1 To limit2
  2030.         Call fpmul(decnum, decnum2, decnum2, precision)
  2031.         Call fpadd(decnum, decnum, one, precision)
  2032.         Call fpsqr(decnum, decnum, precision)
  2033.         Call fpadd(decnum, decnum, one, precision)
  2034.         Call fpdiv(decnum, decnum2, decnum, precision)
  2035.         decnum2 = decnum
  2036.     Next z
  2037.  
  2038.     mt = decnum
  2039.     x_2 = decnum
  2040.     p = decnum
  2041.     Call fpmul(XX, x_2, x_2, precision)
  2042.     Do
  2043.         c = c + 2
  2044.         mt2 = mt
  2045.         Call si2fp(strC, c, precision)
  2046.         Call fpmul(p, p, XX, precision)
  2047.         Call fpdiv(Term, p, strC, precision)
  2048.         If sign(c And 3) Then
  2049.             Call fpsub(Accum, mt, Term, precision)
  2050.         Else
  2051.             Call fpadd(Accum, mt, Term, precision)
  2052.         End If
  2053.         Swap mt, Accum
  2054.     Loop Until fpcmp(mt, mt2, precision) = 0
  2055.     Call fpmul(result, factor, mt, precision)
  2056.  
  2057. Sub fpasin (result As decfloat, x As decfloat, digits_in As Unsigned Long)
  2058.     Dim As Long precision
  2059.     precision = digits_in
  2060.     Dim As Double num
  2061.     ' ARCSIN = ATN(x / SQR(-x * x + 1))
  2062.     '============= ARCSIN GUARD =========
  2063.     num = fp2dbl(x)
  2064.     If num > 1 Then Exit Sub
  2065.     If num < -1 Then Exit Sub
  2066.     '========================
  2067.     Dim As decfloat one, T, B, term1, minusone
  2068.     Call si2fp(one, 1, precision)
  2069.     Call si2fp(minusone, -1, precision)
  2070.     T = x
  2071.     Call fpmul(B, x, x, precision) 'x*x
  2072.     'for 1 and -1
  2073.     If fpcmp(B, one, precision) = 0 Then
  2074.         Dim As decfloat two, atn1
  2075.         Call si2fp(two, 2, precision)
  2076.         Call fpatn(atn1, one, precision)
  2077.         If fpcmp(x, minusone, precision) = 0 Then
  2078.             Call fpmul(two, two, atn1, precision)
  2079.             Call fpmul(result, two, minusone, precision)
  2080.             Exit Sub
  2081.         Else
  2082.             Call fpmul(result, two, atn1, precision)
  2083.             Exit Sub
  2084.         End If
  2085.     End If
  2086.     Call fpsub(B, one, B, precision) '1-x*x
  2087.     Call fpsqr(B, B, precision) 'sqr(1-x*x)
  2088.     Call fpdiv(term1, T, B, precision)
  2089.     Call fpatn(result, term1, precision)
  2090.  
  2091. Sub fpacos (result As decfloat, x As decfloat, digits_in As Unsigned Long)
  2092.     Dim As Long precision
  2093.     precision = digits_in
  2094.     Dim As decfloat one, minusone, two, atn1, tail, T, B, term1, atnterm1 ',_x,temp
  2095.     Dim As Double num
  2096.     'ARCCOS = ATN(-x / SQR(-x * x + 1)) + 2 * ATN(1)
  2097.     '============= ARCCOS GUARD =========
  2098.     num = fp2dbl(x)
  2099.     If num > 1 Then Exit Sub
  2100.     If num < -1 Then Exit Sub
  2101.     '========================
  2102.     Call si2fp(one, 1, precision)
  2103.     Call si2fp(minusone, -1, precision)
  2104.     Call si2fp(two, 2, precision)
  2105.     Call fpatn(atn1, one, precision)
  2106.     Call fpmul(tail, two, atn1, precision) '2*atn(1)
  2107.     Call fpmul(T, minusone, x, precision) '-x
  2108.     Call fpmul(B, x, x, precision) 'x*x
  2109.     If fpcmp(B, one, precision) = 0 Then
  2110.         'for 1 and -1
  2111.         If fpcmp(x, minusone, precision) = 0 Then
  2112.             Dim As decfloat four
  2113.             Call si2fp(four, 4, precision)
  2114.             Call fpmul(result, four, atn1, precision)
  2115.             Exit Sub
  2116.         Else
  2117.             Call si2fp(result, 0, precision)
  2118.             Exit Sub
  2119.         End If
  2120.     End If
  2121.     Call fpsub(B, one, B, precision) '1-x*x
  2122.     Call fpsqr(B, B, precision) 'sqr(1-x*x)
  2123.     Call fpdiv(term1, T, B, precision)
  2124.     Call fpatn(atnterm1, term1, precision)
  2125.     Call fpadd(result, atnterm1, tail, precision)
  2126.  
output
Code: [Select]
factorial(10000) to  512  digits
 2.8462596809170545189064132121198688901480514017027992307941799942744113400037644437729907867577847758158840621423175288300423399401535187390524211613827161748198241998275924182892597878981242531205946599625986706560161572036032397926328736717055741975962099479720346153698119897092611277500484198845410475544642442136573303076703628825803548967461117097369578603670191071512730587281041158640561281165385325968425825995584688146430425589836649317059251717204276597407446133400054194052462303436869154059404066227E+35659

in  .494140625  seconds

3/9 to  512  digits
 0.33333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333

in  0  seconds

and square it
 0.11111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111

ln(2) to  512  digits
 0.69314718055994530941723212145817656807550013436025525412068000949339362196969471560586332699641868754200148102057068573368552023575813055703267075163507596193072757082837143519030703862389167347112335011536449795523912047517268157493206515552473413952588295045300709532636664265410423915781495204374043038550080194417064167151864471283996817178454695702627163106454615025720740248163777338963855069526066834113727387372292895649354702576265209885969320196505855476470330679365443254763274495125040606943814710468

in  .111328125  seconds

and the inverse
 1.9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999

in  .21875  seconds

reciprocal of 3
 0.33333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333

in  0  seconds

Press any key to continue
« Last Edit: October 14, 2021, 06:16:26 am by jack »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: decfloat 2.0
« Reply #1 on: October 10, 2021, 09:19:30 am »
Might be slower but I bet it runs rings around my string math. Looks like you might be using binary math?

Very impressive set of functions Power and Log... (I'm just scanning code).

I went to run the code and the Option Explicit line is red-lined in IDE, not first statement in code. Was that a last minute addition? Seems fixed when I moved it just under $NoPrefix which also demand to be top line. ;-)) Certainly $noprefix wins top spot specially if want "Option Explicit" without _prefix.

Ha! didn't take but a second or 2! Fast enough for me!  Very nice work @jack


FellippeHeitor

  • Guest
Re: decfloat 2.0
« Reply #2 on: October 10, 2021, 09:31:45 am »
Option _Explicit, _ExplicitArray, and $NoPrefix no longer have to be the first line in a program in v2.0 😉😉

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: decfloat 2.0
« Reply #3 on: October 10, 2021, 09:33:20 am »
thanks bplus for testing
I am using base 100000000, that is 8 digits per element

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: decfloat 2.0
« Reply #4 on: October 10, 2021, 10:04:13 am »
bplus
the reason I added a precision parameter was so that you could vary the precision in Newton–Raphson type calculations, I use it in the square-root and reciprocal routines
it's a pity that QB64 doesn't support array in type and optional parameters

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: decfloat 2.0
« Reply #5 on: October 10, 2021, 10:45:01 am »
Quote
QB64 doesn't support array in type and optional parameters.

Actually might be an advantage if you are really, really after speed and not so much pretty object like coding. It will discourage you from using Type. What was I working on that I was trying to get done much much faster? Oh yeah, the thing with word mods, trying to get from one word to another by only changing a letter at a time. This also worked great for me in tracking worm segments (x, y) positions, DIM x(1 to nWorms, 1 to MaxSegmentsAllowed), y(1 to nWorms, 1 to MaxSegmentsAllowed), ItemLimit(1 to nWorms)

Anyway the lesson was to dump Type stuff and use @2D dimension arrays (1 to nItems, 1 to MaxNumberYouWillEverNeedPlusOneForSafety). You will see significant jump in speed performance, no strings, no ReDim _Preserves, just track highest element for each item but I suspect you will use same amount for each "String Array" part probably the number of digits you want your precision plus a safety margin for rounding errors that creep in after thousands of iterations.

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: decfloat 2.0
« Reply #6 on: October 10, 2021, 11:11:01 am »
bplus
I find that type's are essential and operator and function overloading are very handy and the slowdown is minimum, my guess less than 5% slowdown but you get huge benefits.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: decfloat 2.0
« Reply #7 on: October 10, 2021, 11:50:38 am »
bplus
I find that type's are essential and operator and function overloading are very handy and the slowdown is minimum, my guess less than 5% slowdown but you get huge benefits.

jack,

I'd sure like to pick your brain on what is "essential" about Types, this thread probably not appropriate for such discussion and besides all you might mean by that is they offer code organization and clarity, to which I would agree whole heartedly.

But to me essential means you couldn't do something unless in Type form, I am pretty sure in QB64 that is not the case, that's why I want to pick your brain a bit more. I have learned to watch out when I am pretty sure about something ;-))

PS I quoted you in case you decided to change out " essential" in edit. I seem to be picking arguments with people's wording today, it is one way to learn not necessarily essential to building friendships. :)

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: decfloat 2.0
« Reply #8 on: October 10, 2021, 12:09:08 pm »
where are the emoticons?
sure could use laughing emoticon now, but you basically stated it
just to be a little absurd, imagine we didn't have long's or double's just loose bytes all over the place, what a nightmare it would be to write readable and maintainable code
« Last Edit: October 20, 2021, 08:19:22 pm by jack »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: decfloat 2.0
« Reply #9 on: October 10, 2021, 12:11:03 pm »
where are the emoticons?
sure could use laughing emoticon now, but you basically stated it
just to be a little absurd, imagine we didn't have long's or double's just loose bytes all over the place, what a nightmare it would be to write readable and maintainable code

Sounds like coding everything using just _MEMNEW to hold the data.

And we has emoticons!  😂🤣🥲😅😇🙃😊☺️🙂😘😗😙🥰😍😋😚😛🤪😜😝🤨🧐🤓😗😁😆.... And MANY more!
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: decfloat 2.0
« Reply #10 on: October 10, 2021, 12:58:11 pm »
Quote
And we has emoticons!  😂🤣🥲😅😇🙃😊☺️🙂😘😗😙🥰😍😋😚😛🤪😜😝🤨🧐🤓😗😁😆.... And MANY more!

Must be an QB64 Developer privilege, closet I am finding is this font.

Wait! 
Quote
Emoticons are punctuation marks, letters, and numbers used to create pictorial icons that generally display an emotion or sentiment.

Quote
Emoji were invented in 1999 by Shigetaka Kurita and were intended for a Japanese user base. The first emoji were very simple—only 12 pixels by 12 pixels—and were inspired by manga art and kanji characters. In order to attract Japanese customers, Apple hid an emoji keyboard in the first iPhone back in 2007, but North American users quickly became aware of the keyboard. Now, emoji are available in almost all messaging apps, and while different apps have distinct emoji styles, emoji can translate across platforms, thanks to Unicode. This is why an iPhone user is able to receive the smiling pile of poo emoji from someone using a Samsung Galaxy.

So, if you come across a smiley face that contains a character you can find on your computer keyboard, it’s an emoticon. If it’s a little cartoon figure that is free from the binds of punctuation, numbers, and letters, it’s an emoji.

Emoji must be one of those things know to QB64 Developers.
 
download.jpg

FellippeHeitor

  • Guest
Re: decfloat 2.0
« Reply #11 on: October 10, 2021, 12:59:47 pm »
Lol, nothing exclusive. Emoji are available on all mobile devices and all modern operating systems have a way to allow you to insert them (virtual keyboards, look for those).
🤯⌨️

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: decfloat 2.0
« Reply #12 on: October 10, 2021, 01:59:02 pm »
« Last Edit: October 11, 2021, 08:36:24 am by jack »

Offline Cobalt

  • QB64 Developer
  • Forum Resident
  • Posts: 878
  • At 60 I become highly radioactive!
    • View Profile
Re: decfloat 2.0
« Reply #13 on: October 12, 2021, 03:51:12 am »
Lol, nothing exclusive. Emoji are available on all mobile devices and all modern operating systems have a way to allow you to insert them (virtual keyboards, look for those).

Woo Hoo my Vista machine is "Modern" again!

🥳


Long standing advocate for Arrays in UDTs.
Granted after becoming radioactive I only have a half-life!

Marked as best answer by jack on October 14, 2021, 02:46:39 am

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: decfloat 2.0
« Reply #14 on: October 12, 2021, 10:24:52 pm »
if someone were to actually use this it would be better to have a bi, bm
decfloat.bi
Code: QB64: [Select]
  1. 'Const NUMBER_OF_DIGITS = 512
  2. Const NUM_DIGITS = NUMBER_OF_DIGITS
  3. Const NUM_DWORDS = NUM_DIGITS \ 8
  4. Const BIAS = 1073741824 '2 ^ 30
  5. Const MANTISSA_BYTES = (NUM_DWORDS + 1) * 8 * 4
  6.  
  7. Type decfloat
  8.     As Long sign
  9.     As Unsigned Long exponent
  10.     As String * Mantissa_bytes mantissa
  11.  
  12. ' Error definitions
  13.  
  14. Const DIVZ_ERR = 1 'Divide by zero
  15. Const EXPO_ERR = 2 'Exponent overflow error
  16. Const EXPU_ERR = 3 'Exponent underflow error
  17. Dim Shared As decfloat pi_dec
  18. Call pi_brent_salamin(pi_dec, NUMBER_OF_DIGITS)
  19.  
decfloat.bm
Code: QB64: [Select]
  1. Sub set (s$, i&, v~&)
  2.     Mid$(s$, 4 * i& + 1, 4) = MKL$(v~&)
  3.  
  4. Function git~& (s$, i&)
  5.     git = CVL(Mid$(s$, 4 * i& + 1, 4))
  6.  
  7. Function fp2str_exp$ (n As decfloat, places As Long)
  8.     Dim As Long i, ex
  9.     Dim As String v, f, ts
  10.     If n.exponent > 0 Then
  11.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  12.     Else
  13.         ex = 0
  14.     End If
  15.     If n.sign Then v = "-" Else v = " "
  16.     ts = Str$(git(n.mantissa, 0))
  17.     ts = Trim$(ts)
  18.     If Len(ts) < 8 Then
  19.         ts = ts + String$(8 - Len(ts), "0")
  20.     End If
  21.     v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
  22.     For i = 1 To NUM_DWORDS - 1
  23.         ts = Str$(git(n.mantissa, i))
  24.         ts = Trim$(ts)
  25.         If Len(ts) < 8 Then
  26.             ts = String$(8 - Len(ts), "0") + ts
  27.         End If
  28.         v = v + ts
  29.     Next
  30.     v = Left$(v, places + 3)
  31.     f = Trim$(Str$(Abs(ex)))
  32.     f = String$(5 - Len(f), "0") + f
  33.     If ex < 0 Then v = v + "E-" Else v = v + "E+"
  34.     v = v + f
  35.     fp2str_exp$ = v
  36.  
  37. 'long part of num
  38. Sub fpfix (result As decfloat, num As decfloat)
  39.     Dim As decfloat ip
  40.     Dim As Long ex, ex2, j, k
  41.  
  42.     ex = (num.exponent And &H7FFFFFFF) - BIAS
  43.     If ex < 1 Then
  44.         result = ip: Exit Sub
  45.     End If
  46.     If ex >= (NUM_DIGITS) Then
  47.         result = num: Exit Sub
  48.     End If
  49.     ex2 = ex \ 8
  50.     k = ex2
  51.     j = ex Mod 8
  52.     While ex2 > 0
  53.         ex2 = ex2 - 1
  54.         Call set(ip.mantissa, ex2, git(num.mantissa, ex2))
  55.     Wend
  56.     If j = 1 Then
  57.         Call set(ip.mantissa, k, 10000000 * (git(num.mantissa, k) \ 10000000))
  58.     ElseIf j = 2 Then
  59.         Call set(ip.mantissa, k, 1000000 * (git(num.mantissa, k) \ 1000000))
  60.     ElseIf j = 3 Then
  61.         Call set(ip.mantissa, k, 100000 * (git(num.mantissa, k) \ 100000))
  62.     ElseIf j = 4 Then
  63.         Call set(ip.mantissa, k, 10000 * (git(num.mantissa, k) \ 10000))
  64.     ElseIf j = 5 Then
  65.         Call set(ip.mantissa, k, 1000 * (git(num.mantissa, k) \ 1000))
  66.     ElseIf j = 6 Then
  67.         Call set(ip.mantissa, k, 100 * (git(num.mantissa, k) \ 100))
  68.     ElseIf j = 7 Then
  69.         Call set(ip.mantissa, k, 10 * (git(num.mantissa, k) \ 10))
  70.     ElseIf j = 8 Then
  71.         Call set(ip.mantissa, k, git(num.mantissa, k))
  72.     End If
  73.     ip.exponent = ex + BIAS
  74.     ip.sign = num.sign
  75.     result = ip
  76.  
  77. Function fp2dbl# (n As decfloat)
  78.     Dim As Long ex
  79.     Dim As String v, f, ts
  80.     If n.exponent > 0 Then
  81.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  82.     Else
  83.         ex = 0
  84.     End If
  85.     If n.sign Then v = "-" Else v = " "
  86.     ts = Trim$(Str$(git(n.mantissa, 0)))
  87.     If Len(ts) < 8 Then
  88.         ts = ts + String$(8 - Len(ts), "0")
  89.     End If
  90.     v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
  91.     ts = Trim$(Str$(git(n.mantissa, 1)))
  92.     If Len(ts) < 8 Then
  93.         ts = String$(8 - Len(ts), "0") + ts
  94.     End If
  95.     v = v + ts
  96.  
  97.     f = Str$(Abs(ex))
  98.     f = String$(5 - Len(f), "0") + f
  99.     If ex < 0 Then v = v + "E-" Else v = v + "E+"
  100.     v = v + f
  101.     fp2dbl# = Val(v)
  102.  
  103. Function fp2str_fix$ (n As decfloat, places As Long)
  104.     Dim As Long i, ex
  105.     Dim As String v, ts, s
  106.     If n.exponent > 0 Then
  107.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  108.     Else
  109.         ex = 0
  110.     End If
  111.     If n.sign Then s = "-" Else s = " "
  112.     ts = Trim$(Str$(git(n.mantissa, 0)))
  113.     If Len(ts) < 8 Then
  114.         ts = ts + String$(8 - Len(ts), "0")
  115.     End If
  116.     v = ts
  117.     For i = 1 To NUM_DWORDS - 1
  118.         ts = Trim$(Str$(git(n.mantissa, i)))
  119.         If Len(ts) < 8 Then
  120.             ts = String$(8 - Len(ts), "0") + ts
  121.         End If
  122.         v = v + ts
  123.     Next
  124.     If places < NUM_DIGITS Then
  125.         v = Left$(v, places)
  126.     End If
  127.     If ex = 0 Then
  128.         v = Left$(v, 1) + "." + Mid$(v, 2)
  129.     ElseIf ex < 0 Then
  130.         v = "0." + String$(Abs(ex) - 1, "0") + v
  131.     ElseIf ex > 0 Then
  132.         v = Left$(v, ex + 1) + "." + Mid$(v, ex + 2)
  133.     End If
  134.     fp2str_fix$ = s + v
  135.  
  136. Function fp2str$ (n As decfloat, places As Long)
  137.     Dim As Long ex
  138.     If n.exponent > 0 Then
  139.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  140.     Else
  141.         ex = 0
  142.     End If
  143.     If Abs(ex) < places Then
  144.         fp2str = fp2str_fix(n, places)
  145.     Else
  146.         fp2str = fp2str_exp(n, places)
  147.     End If
  148.  
  149. Sub str2fp (result As decfloat, value As String)
  150.     Dim As Long j, s, d, e, ep, ex, es, i, f, fp, fln
  151.     Dim As String c, f1, f2, f3, ts
  152.     Dim As Unsigned Long ulng
  153.     Dim n As decfloat
  154.     j = 1
  155.     s = 1
  156.     d = 0
  157.     e = 0
  158.     ep = 0
  159.     ex = 0
  160.     es = 1
  161.     i = 0
  162.     f = 0
  163.     fp = 0
  164.     f1 = ""
  165.     f2 = ""
  166.     f3 = ""
  167.     value = UCase$(value)
  168.     fln = Len(value)
  169.  
  170.     While j <= fln
  171.         c = Mid$(value, j, 1)
  172.         If ep = 1 Then
  173.             If c = " " Then
  174.                 j = j + 1
  175.                 GoTo skip_while
  176.             End If
  177.             If c = "-" Then
  178.                 es = -es
  179.                 c = ""
  180.             End If
  181.             If c = "+" Then
  182.                 j = j + 1
  183.                 GoTo skip_while
  184.             End If
  185.             If (c = "0") And (f3 = "") Then
  186.                 j = j + 1
  187.                 GoTo skip_while
  188.             End If
  189.             If (c > "/") And (c < ":") Then 'c is digit between 0 and 9
  190.                 f3 = f3 + c
  191.                 ex = 10 * ex + (Asc(c) - 48)
  192.                 j = j + 1
  193.                 GoTo skip_while
  194.             End If
  195.         End If
  196.  
  197.         If c = " " Then
  198.             j = j + 1
  199.             GoTo skip_while
  200.         End If
  201.         If c = "-" Then
  202.             s = -s
  203.             j = j + 1
  204.             GoTo skip_while
  205.         End If
  206.         If c = "+" Then
  207.             j = j + 1
  208.             GoTo skip_while
  209.         End If
  210.         If c = "." Then
  211.             If d = 1 Then
  212.                 j = j + 1
  213.                 GoTo skip_while
  214.             End If
  215.             d = 1
  216.         End If
  217.         If (c > "/") And (c < ":") Then 'c is digit between 0 and 9
  218.             If ((c = "0") And (i = 0)) Then
  219.                 If d = 0 Then
  220.                     j = j + 1
  221.                     GoTo skip_while
  222.                 End If
  223.                 If (d = 1) And (f = 0) Then
  224.                     e = e - 1
  225.                     j = j + 1
  226.                     GoTo skip_while
  227.                 End If
  228.             End If
  229.             If d = 0 Then
  230.                 f1 = f1 + c
  231.                 i = i + 1
  232.             Else
  233.                 If (c > "0") Then
  234.                     fp = 1
  235.                 End If
  236.                 f2 = f2 + c
  237.                 f = f + 1
  238.             End If
  239.         End If
  240.         If c = "E" Or c = "D" Then
  241.             ep = 1
  242.         End If
  243.         j = j + 1
  244.         skip_while:
  245.     Wend
  246.     If fp = 0 Then
  247.         f = 0
  248.         f2 = ""
  249.     End If
  250.  
  251.     If s = -1 Then s = &H8000 Else s = 0
  252.     n.sign = s
  253.     ex = es * ex - 1 + i + e
  254.     f1 = f1 + f2
  255.     f1 = Mid$(f1, 1, 1) + Right$(f1, Len(f1) - 1)
  256.     fln = Len(f1)
  257.     If Len(f1) > (NUM_DIGITS + 1 + 8) Then
  258.         f1 = Mid$(f1, 1, (NUM_DIGITS + 1 + 8))
  259.     End If
  260.     While Len(f1) < (NUM_DIGITS + 1 + 8)
  261.         f1 = f1 + "0"
  262.     Wend
  263.     j = 1
  264.     For i = 0 To NUM_DWORDS
  265.         ts = Mid$(f1, j, 8)
  266.         ulng = Val(ts)
  267.         Call set(n.mantissa, i, ulng)
  268.         If ulng <> 0 Then fp = 1
  269.         j = j + 8
  270.     Next
  271.     If fp Then n.exponent = (ex + BIAS + 1) Else n.exponent = 0
  272.     result = n
  273.  
  274. Sub si2fp (result As decfloat, m As Integer64, digits_in As Long)
  275.     Dim As Long digits
  276.     digits = digits_in
  277.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  278.     Dim As decfloat fac1
  279.     Dim As Long i
  280.     Dim As Integer64 n
  281.     n = Abs(m)
  282.  
  283.     If n > 9999999999999999 Then
  284.         Call str2fp(fac1, Str$(m))
  285.         result = fac1: Exit Sub
  286.     End If
  287.  
  288.     For i = 1 To digits
  289.         Call set(fac1.mantissa, i, 0)
  290.     Next
  291.  
  292.     If m = 0 Then
  293.         fac1.exponent = 0
  294.         fac1.sign = 0
  295.         result = fac1: Exit Sub
  296.     End If
  297.  
  298.     fac1.exponent = BIAS
  299.     If n < 100000000 Then
  300.         If n < 10 Then
  301.             Call set(fac1.mantissa, 0, n * 10000000)
  302.             fac1.exponent = fac1.exponent + 1
  303.         ElseIf n < 100 Then
  304.             Call set(fac1.mantissa, 0, n * 1000000)
  305.             fac1.exponent = fac1.exponent + 2
  306.         ElseIf n < 1000 Then
  307.             Call set(fac1.mantissa, 0, n * 100000)
  308.             fac1.exponent = fac1.exponent + 3
  309.         ElseIf n < 10000 Then
  310.             Call set(fac1.mantissa, 0, n * 10000)
  311.             fac1.exponent = fac1.exponent + 4
  312.         ElseIf n < 100000 Then
  313.             Call set(fac1.mantissa, 0, n * 1000)
  314.             fac1.exponent = fac1.exponent + 5
  315.         ElseIf n < 1000000 Then
  316.             Call set(fac1.mantissa, 0, n * 100)
  317.             fac1.exponent = fac1.exponent + 6
  318.         ElseIf n < 10000000 Then
  319.             Call set(fac1.mantissa, 0, n * 10)
  320.             fac1.exponent = fac1.exponent + 7
  321.         ElseIf n < 100000000 Then
  322.             Call set(fac1.mantissa, 0, n)
  323.             fac1.exponent = fac1.exponent + 8
  324.         End If
  325.     End If
  326.     If n > 99999999 Then
  327.         fac1.exponent = fac1.exponent + 8
  328.         If n < 1000000000 Then
  329.             Call set(fac1.mantissa, 0, n \ 10)
  330.             Call set(fac1.mantissa, 1, (n Mod 10) * 10000000)
  331.             fac1.exponent = fac1.exponent + 1
  332.         ElseIf n < 100000000000 Then
  333.             Call set(fac1.mantissa, 0, n \ 100)
  334.             Call set(fac1.mantissa, 1, (n Mod 100) * 1000000)
  335.             fac1.exponent = fac1.exponent + 2
  336.         ElseIf n < 1000000000000 Then
  337.             Call set(fac1.mantissa, 0, n \ 1000)
  338.             Call set(fac1.mantissa, 1, (n Mod 1000) * 100000)
  339.             fac1.exponent = fac1.exponent + 3
  340.         ElseIf n < 10000000000000 Then
  341.             Call set(fac1.mantissa, 0, n \ 10000)
  342.             Call set(fac1.mantissa, 1, (n Mod 10000) * 10000)
  343.             fac1.exponent = fac1.exponent + 4
  344.         ElseIf n < 100000000000000 Then
  345.             Call set(fac1.mantissa, 0, n \ 100000)
  346.             Call set(fac1.mantissa, 1, (n Mod 100000) * 1000)
  347.             fac1.exponent = fac1.exponent + 5
  348.         ElseIf n < 1000000000000000 Then
  349.             Call set(fac1.mantissa, 0, n \ 1000000)
  350.             Call set(fac1.mantissa, 1, (n Mod 1000000) * 100)
  351.             fac1.exponent = fac1.exponent + 6
  352.         ElseIf n < 10000000000000000 Then
  353.             Call set(fac1.mantissa, 0, n \ 10000000)
  354.             Call set(fac1.mantissa, 1, (n Mod 10000000) * 10)
  355.             fac1.exponent = fac1.exponent + 7
  356.         ElseIf n < 100000000000000000 Then
  357.             Call set(fac1.mantissa, 0, n \ 100000000)
  358.             Call set(fac1.mantissa, 1, n Mod 100000000)
  359.             fac1.exponent = fac1.exponent + 8
  360.         End If
  361.     End If
  362.     If m < 0 Then
  363.         fac1.sign = &H8000
  364.     Else
  365.         fac1.sign = 0
  366.     End If
  367.     result = fac1
  368.  
  369. Sub RSHIFT_1 (mantissa As decfloat, digits_in As Long)
  370.     Dim As Long digits
  371.     digits = digits_in
  372.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  373.  
  374.     Dim As Unsigned Long v1, v2
  375.     Dim As Long i
  376.     For i = digits To 1 Step -1
  377.         v1 = git(mantissa.mantissa, i) \ 10
  378.         v2 = git(mantissa.mantissa, i - 1) Mod 10
  379.         v2 = v2 * 10000000 + v1
  380.         Call set(mantissa.mantissa, i, v2)
  381.     Next
  382.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 10)
  383.  
  384. Sub LSHIFT_1 (mantissa As decfloat, digits_in As Long)
  385.     Dim As Long digits
  386.     digits = digits_in
  387.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  388.  
  389.     Dim As Unsigned Long v1, v2
  390.     Dim As Long i
  391.     For i = 0 To digits - 1
  392.         v1 = git(mantissa.mantissa, i) Mod 10000000
  393.         v2 = git(mantissa.mantissa, i + 1) \ 10000000
  394.         Call set(mantissa.mantissa, i, v1 * 10 + v2)
  395.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 10000000)
  396.     Next
  397.     Call set(mantissa.mantissa, digits, 10 * (git(mantissa.mantissa, digits) Mod 10000000))
  398.  
  399. Sub RSHIFT_2 (mantissa As decfloat, digits_in As Long)
  400.     Dim As Long digits
  401.     digits = digits_in
  402.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  403.  
  404.     Dim As Unsigned Long v1, v2
  405.     Dim As Long i
  406.     For i = digits To 1 Step -1
  407.         v1 = git(mantissa.mantissa, i) \ 100
  408.         v2 = git(mantissa.mantissa, i - 1) Mod 100
  409.         v2 = v2 * 1000000 + v1
  410.         Call set(mantissa.mantissa, i, v2)
  411.     Next
  412.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 100)
  413.  
  414. Sub LSHIFT_2 (mantissa As decfloat, digits_in As Long)
  415.     Dim As Long digits
  416.     digits = digits_in
  417.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  418.  
  419.     Dim As Unsigned Long v1, v2
  420.     Dim As Long i
  421.     For i = 0 To digits - 1
  422.         v1 = git(mantissa.mantissa, i) Mod 1000000
  423.         v2 = git(mantissa.mantissa, i + 1) \ 1000000
  424.         Call set(mantissa.mantissa, i, v1 * 100 + v2)
  425.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 1000000)
  426.     Next
  427.     Call set(mantissa.mantissa, digits, 100 * (git(mantissa.mantissa, digits) Mod 1000000))
  428.  
  429. Sub RSHIFT_3 (mantissa As decfloat, digits_in As Long)
  430.     Dim As Long digits
  431.     digits = digits_in
  432.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  433.  
  434.     Dim As Unsigned Long v1, v2
  435.     Dim As Long i
  436.     For i = digits To 1 Step -1
  437.         v1 = git(mantissa.mantissa, i) \ 1000
  438.         v2 = git(mantissa.mantissa, i - 1) Mod 1000
  439.         v2 = v2 * 100000 + v1
  440.         Call set(mantissa.mantissa, i, v2)
  441.     Next
  442.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 1000)
  443.  
  444. Sub LSHIFT_3 (mantissa As decfloat, digits_in As Long)
  445.     Dim As Long digits
  446.     digits = digits_in
  447.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  448.  
  449.     Dim As Unsigned Long v1, v2
  450.     Dim As Long i
  451.     For i = 0 To digits - 1
  452.         v1 = git(mantissa.mantissa, i) Mod 100000
  453.         v2 = git(mantissa.mantissa, i + 1) \ 100000
  454.         Call set(mantissa.mantissa, i, v1 * 1000 + v2)
  455.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 100000)
  456.     Next
  457.     Call set(mantissa.mantissa, digits, 1000 * (git(mantissa.mantissa, digits) Mod 100000))
  458.  
  459. Sub RSHIFT_4 (mantissa As decfloat, digits_in As Long)
  460.     Dim As Long digits
  461.     digits = digits_in
  462.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  463.  
  464.     Dim As Unsigned Long v1, v2
  465.     Dim As Long i
  466.     For i = digits To 1 Step -1
  467.         v1 = git(mantissa.mantissa, i) \ 10000
  468.         v2 = git(mantissa.mantissa, i - 1) Mod 10000
  469.         v2 = v2 * 10000 + v1
  470.         Call set(mantissa.mantissa, i, v2)
  471.     Next
  472.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 10000)
  473.  
  474. Sub LSHIFT_4 (mantissa As decfloat, digits_in As Long)
  475.     Dim As Long digits
  476.     digits = digits_in
  477.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  478.  
  479.     Dim As Unsigned Long v1, v2
  480.     Dim As Long i
  481.     For i = 0 To digits - 1
  482.         v1 = git(mantissa.mantissa, i) Mod 10000
  483.         v2 = git(mantissa.mantissa, i + 1) \ 10000
  484.         Call set(mantissa.mantissa, i, v1 * 10000 + v2)
  485.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 10000)
  486.     Next
  487.     Call set(mantissa.mantissa, digits, 10000 * (git(mantissa.mantissa, digits) Mod 10000))
  488.  
  489. Sub RSHIFT_5 (mantissa As decfloat, digits_in As Long)
  490.     Dim As Long digits
  491.     digits = digits_in
  492.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  493.  
  494.     Dim As Unsigned Long v1, v2
  495.     Dim As Long i
  496.     For i = digits To 1 Step -1
  497.         v1 = git(mantissa.mantissa, i) \ 100000
  498.         v2 = git(mantissa.mantissa, i - 1) Mod 100000
  499.         v2 = v2 * 1000 + v1
  500.         Call set(mantissa.mantissa, i, v2)
  501.     Next
  502.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 100000)
  503.  
  504. Sub LSHIFT_5 (mantissa As decfloat, digits_in As Long)
  505.     Dim As Long digits
  506.     digits = digits_in
  507.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  508.  
  509.     Dim As Unsigned Long v1, v2
  510.     Dim As Long i
  511.     For i = 0 To digits - 1
  512.         v1 = git(mantissa.mantissa, i) Mod 1000
  513.         v2 = git(mantissa.mantissa, i + 1) \ 1000
  514.         Call set(mantissa.mantissa, i, v1 * 100000 + v2)
  515.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 1000)
  516.     Next
  517.     Call set(mantissa.mantissa, digits, 100000 * (git(mantissa.mantissa, digits) Mod 1000))
  518.  
  519. Sub RSHIFT_6 (mantissa As decfloat, digits_in As Long)
  520.     Dim As Long digits
  521.     digits = digits_in
  522.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  523.  
  524.     Dim As Unsigned Long v1, v2
  525.     Dim As Long i
  526.     For i = digits To 1 Step -1
  527.         v1 = git(mantissa.mantissa, i) \ 1000000
  528.         v2 = git(mantissa.mantissa, i - 1) Mod 1000000
  529.         v2 = v2 * 100 + v1
  530.         Call set(mantissa.mantissa, i, v2)
  531.     Next
  532.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 1000000)
  533.  
  534. Sub LSHIFT_6 (mantissa As decfloat, digits_in As Long)
  535.     Dim As Long digits
  536.     digits = digits_in
  537.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  538.  
  539.     Dim As Unsigned Long v1, v2
  540.     Dim As Long i
  541.     For i = 0 To digits - 1
  542.         v1 = git(mantissa.mantissa, i) Mod 100
  543.         v2 = git(mantissa.mantissa, i + 1) \ 100
  544.         Call set(mantissa.mantissa, i, v1 * 1000000 + v2)
  545.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 100)
  546.     Next
  547.     Call set(mantissa.mantissa, digits, 1000000 * (git(mantissa.mantissa, digits) Mod 100))
  548.  
  549. Sub RSHIFT_7 (mantissa As decfloat, digits_in As Long)
  550.     Dim As Long digits
  551.     digits = digits_in
  552.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  553.  
  554.     Dim As Unsigned Long v1, v2
  555.     Dim As Long i
  556.     For i = digits To 1 Step -1
  557.         v1 = git(mantissa.mantissa, i) \ 10000000
  558.         v2 = git(mantissa.mantissa, i - 1) Mod 10000000
  559.         v2 = v2 * 10 + v1
  560.         Call set(mantissa.mantissa, i, v2)
  561.     Next
  562.     Call set(mantissa.mantissa, 0, git(mantissa.mantissa, 0) \ 10000000)
  563.  
  564. Sub LSHIFT_7 (mantissa As decfloat, digits_in As Long)
  565.     Dim As Long digits
  566.     digits = digits_in
  567.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  568.  
  569.     Dim As Unsigned Long v1, v2
  570.     Dim As Long i
  571.     For i = 0 To digits - 1
  572.         v1 = git(mantissa.mantissa, i) Mod 10
  573.         v2 = git(mantissa.mantissa, i + 1) \ 10
  574.         Call set(mantissa.mantissa, i, v1 * 10000000 + v2)
  575.         Call set(mantissa.mantissa, i + 1, git(mantissa.mantissa, i + 1) Mod 10)
  576.     Next
  577.     Call set(mantissa.mantissa, digits, 10000000 * (git(mantissa.mantissa, digits) Mod 10))
  578.  
  579. Sub RSHIFT_8 (mantissa As decfloat, digits_in As Long)
  580.     Dim As Long digits
  581.     digits = digits_in
  582.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  583.     Dim As Long i
  584.     For i = digits To 1 Step -1
  585.         Call set(mantissa.mantissa, i, git(mantissa.mantissa, i - 1))
  586.     Next
  587.     Call set(mantissa.mantissa, 0, 0)
  588.  
  589. Sub LSHIFT_8 (mantissa As decfloat, digits_in As Long)
  590.     Dim As Long digits
  591.     digits = digits_in
  592.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  593.     Dim As Long i
  594.     For i = 0 To digits - 1
  595.         Call set(mantissa.mantissa, i, git(mantissa.mantissa, i + 1))
  596.     Next
  597.     Call set(mantissa.mantissa, digits, 0)
  598.  
  599. Function fpcmp& (x As decfloat, y As decfloat, digits_in As Long)
  600.     Dim As Long digits
  601.     digits = digits_in
  602.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  603.     Dim As Long c, i
  604.     If x.sign < y.sign Then fpcmp = -1: Exit Function
  605.     If x.sign > y.sign Then fpcmp = 1: Exit Function
  606.     If x.sign = y.sign Then
  607.         If x.exponent = y.exponent Then
  608.             For i = 0 To digits
  609.                 c = git(x.mantissa, i) - git(y.mantissa, i)
  610.                 If c <> 0 Then Exit For
  611.             Next
  612.             If c < 0 Then fpcmp = -1: Exit Function
  613.             If c = 0 Then fpcmp = 0: Exit Function
  614.             If c > 0 Then fpcmp = 1: Exit Function
  615.         End If
  616.         If x.exponent < y.exponent Then fpcmp = -1: Exit Function
  617.         If x.exponent > y.exponent Then fpcmp = 1: Exit Function
  618.     End If
  619.     ' if we reach this point it means that the signs are different
  620.     ' and if the sign of x is set meaning that x is negative then x < y
  621.  
  622.  
  623. Sub NORM_FAC1 (fac1 As decfloat, digits_in As Long)
  624.     Dim As Long digits
  625.     digits = digits_in
  626.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  627.     ' normalize the number in fac1
  628.     ' all routines exit through this one.
  629.  
  630.     'see if the mantissa is all zeros.
  631.     'if so, set the exponent and sign equal to 0.
  632.     Dim As Long i, er, f
  633.     er = 0: f = 0
  634.     For i = 0 To digits
  635.         If git(fac1.mantissa, i) > 0 Then f = 1
  636.     Next
  637.     If f = 0 Then
  638.         fac1.exponent = 0
  639.         fac1.sign = 0
  640.         Exit Sub
  641.         'if the highmost Digit in fac1_man is nonzero,
  642.         'shift the mantissa right 1 Digit and
  643.         'increment the exponent
  644.     ElseIf git(fac1.mantissa, 0) > 99999999 Then
  645.         Call RSHIFT_1(fac1, digits)
  646.         fac1.exponent = fac1.exponent + 1
  647.     Else
  648.         'now shift fac1_man 1 to the left until a
  649.         'nonzero digit appears in the next-to-highest
  650.         'Digit of fac1_man.  decrement exponent for
  651.         'each shift.
  652.         While git(fac1.mantissa, 0) = 0
  653.             Call LSHIFT_8(fac1, digits)
  654.             fac1.exponent = fac1.exponent - 8
  655.             If fac1.exponent = 0 Then
  656.                 Print "NORM_FAC1=EXPU_ERR"
  657.                 Exit Sub
  658.             End If
  659.         Wend
  660.         If git(fac1.mantissa, 0) < 10 Then
  661.             Call LSHIFT_7(fac1, digits)
  662.             fac1.exponent = fac1.exponent - 7
  663.         ElseIf git(fac1.mantissa, 0) < 100 Then
  664.             Call LSHIFT_6(fac1, digits)
  665.             fac1.exponent = fac1.exponent - 6
  666.         ElseIf git(fac1.mantissa, 0) < 1000 Then
  667.             Call LSHIFT_5(fac1, digits)
  668.             fac1.exponent = fac1.exponent - 5
  669.         ElseIf git(fac1.mantissa, 0) < 10000 Then
  670.             Call LSHIFT_4(fac1, digits)
  671.             fac1.exponent = fac1.exponent - 4
  672.         ElseIf git(fac1.mantissa, 0) < 100000 Then
  673.             Call LSHIFT_3(fac1, digits)
  674.             fac1.exponent = fac1.exponent - 3
  675.         ElseIf git(fac1.mantissa, 0) < 1000000 Then
  676.             Call LSHIFT_2(fac1, digits)
  677.             fac1.exponent = fac1.exponent - 2
  678.         ElseIf git(fac1.mantissa, 0) < 10000000 Then
  679.             Call LSHIFT_1(fac1, digits)
  680.             fac1.exponent = fac1.exponent - 1
  681.         End If
  682.     End If
  683.     'check for overflow/underflow
  684.     If fac1.exponent < 0 Then
  685.         Print "NORM_FAC1=EXPO_ERR"
  686.     End If
  687.  
  688. Sub fpadd_aux (fac1 As decfloat, fac2 As decfloat, digits_in As Long)
  689.     Dim As Long digits
  690.     digits = digits_in
  691.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  692.     Dim As Unsigned Long v, c, i
  693.     c = 0
  694.     For i = digits To 1 Step -1
  695.         v = git(fac2.mantissa, i) + git(fac1.mantissa, i) + c
  696.         If v > 99999999 Then
  697.             v = v - 100000000
  698.             c = 1
  699.         Else
  700.             c = 0
  701.         End If
  702.         Call set(fac1.mantissa, i, v)
  703.     Next
  704.     v = git(fac1.mantissa, 0) + git(fac2.mantissa, 0) + c
  705.     Call set(fac1.mantissa, 0, v)
  706.  
  707.     Call NORM_FAC1(fac1, digits)
  708.  
  709.  
  710. Sub fpsub_aux (fac1 As decfloat, fac2 As decfloat, digits_in As Long)
  711.     Dim As Long digits
  712.     digits = digits_in
  713.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  714.     Dim As Long v, c, i
  715.     c = 0
  716.     For i = digits To 1 Step -1
  717.         v = git(fac1.mantissa, i) - git(fac2.mantissa, i) - c
  718.         If v < 0 Then
  719.             v = v + 100000000
  720.             c = 1
  721.         Else
  722.             c = 0
  723.         End If
  724.         Call set(fac1.mantissa, i, v)
  725.     Next
  726.     v = git(fac1.mantissa, 0) - git(fac2.mantissa, 0) - c
  727.     Call set(fac1.mantissa, 0, v)
  728.  
  729.     Call NORM_FAC1(fac1, digits)
  730.  
  731. Sub fpadd (result As decfloat, x As decfloat, y As decfloat, digits_in As Long)
  732.     Dim As Long digits
  733.     digits = digits_in
  734.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  735.  
  736.     Dim As decfloat fac1, fac2
  737.     Dim As Long i, t, c, xsign, ysign
  738.  
  739.     xsign = x.sign: x.sign = 0
  740.     ysign = y.sign: y.sign = 0
  741.     c = fpcmp(x, y, digits)
  742.  
  743.     x.sign = xsign
  744.     y.sign = ysign
  745.     If c < 0 Then
  746.         fac1 = y
  747.         fac2 = x
  748.     Else
  749.         fac1 = x
  750.         fac2 = y
  751.     End If
  752.     t = fac1.exponent - fac2.exponent
  753.     t = ((fac1.exponent And &H7FFFFFFF) - BIAS - 1) - ((fac2.exponent And &H7FFFFFFF) - BIAS - 1)
  754.  
  755.     If t < (NUM_DIGITS + 8) Then
  756.         'The difference between the two
  757.         'exponents indicate how many times
  758.         'we have to multiply the mantissa
  759.         'of FAC2 by 10 (i.e., shift it right 1 place).
  760.         'If we have to shift more times than
  761.         'we have digits, the result is already in FAC1.
  762.         t = fac1.exponent - fac2.exponent
  763.         If t > 0 And t < (NUM_DIGITS + 8) Then 'shift
  764.  
  765.             i = t \ 8
  766.             While i > 0
  767.                 Call RSHIFT_8(fac2, digits)
  768.                 t = t - 8
  769.                 i = i - 1
  770.             Wend
  771.             If t = 7 Then
  772.                 Call RSHIFT_7(fac2, digits)
  773.             ElseIf t = 6 Then
  774.                 Call RSHIFT_6(fac2, digits)
  775.             ElseIf t = 5 Then
  776.                 Call RSHIFT_5(fac2, digits)
  777.             ElseIf t = 4 Then
  778.                 Call RSHIFT_4(fac2, digits)
  779.             ElseIf t = 3 Then
  780.                 Call RSHIFT_3(fac2, digits)
  781.             ElseIf t = 2 Then
  782.                 Call RSHIFT_2(fac2, digits)
  783.             ElseIf t = 1 Then
  784.                 Call RSHIFT_1(fac2, digits)
  785.             End If
  786.         End If
  787.         'See if the signs of the two numbers
  788.         'are the same.  If so, add; if not, subtract.
  789.         If fac1.sign = fac2.sign Then 'add
  790.             Call fpadd_aux(fac1, fac2, digits)
  791.         Else
  792.             Call fpsub_aux(fac1, fac2, digits)
  793.         End If
  794.     End If
  795.     result = fac1
  796.  
  797. Sub fpsub (result As decfloat, x As decfloat, y As decfloat, digits_in As Long)
  798.     Dim As Long digits
  799.     digits = digits_in
  800.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  801.     Dim As decfloat fac1, fac2
  802.     fac1 = x
  803.     fac2 = y
  804.     fac2.sign = fac2.sign Xor &H8000
  805.     Call fpadd(fac1, fac1, fac2, digits)
  806.     result = fac1
  807.  
  808. Sub fpmul (result As decfloat, x As decfloat, y As decfloat, digits_in As Long)
  809.     Dim As Long digits
  810.     digits = digits_in
  811.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  812.     Dim As decfloat fac1, fac2
  813.     Dim As Long i, j, ex, er, den, num
  814.     Dim As Integer64 digit, carry
  815.     Dim As Unsigned Integer64 fac3(0 To digits)
  816.  
  817.     fac1 = x
  818.     fac2 = y
  819.     'check exponents.  if either is zero,
  820.     'the result is zero
  821.     If fac1.exponent = 0 Or fac2.exponent = 0 Then 'result is zero...clear fac1.
  822.         fac1.sign = 0
  823.         fac1.exponent = 0
  824.         For i = 0 To digits
  825.             Call set(fac1.mantissa, i, 0)
  826.         Next
  827.         'NORM_FAC1(fac1)
  828.         result = fac1: Exit Sub
  829.     Else
  830.  
  831.         If ex < 0 Then
  832.             er = EXPO_ERR
  833.             result = fac1: Exit Sub
  834.         End If
  835.  
  836.         'clear fac3 mantissa
  837.         For i = 0 To digits
  838.             fac3(i) = 0
  839.         Next
  840.  
  841.         den = digits
  842.         While git(fac2.mantissa, den) = 0
  843.             den = den - 1
  844.         Wend
  845.         num = digits
  846.         While git(fac1.mantissa, num) = 0
  847.             num = num - 1
  848.         Wend
  849.  
  850.         If num < den Then
  851.             Swap fac1, fac2
  852.             'fac1=y
  853.             'fac2=x
  854.             Swap den, num
  855.         End If
  856.  
  857.         For j = den To 0 Step -1
  858.             carry = 0
  859.             digit = git(fac2.mantissa, j)
  860.             For i = num To 0 Step -1
  861.                 fac3(i) = fac3(i) + digit * git(fac1.mantissa, i)
  862.             Next
  863.             For i = num To 0 Step -1
  864.                 fac3(i) = fac3(i) + carry
  865.                 carry = fac3(i) \ 100000000
  866.                 fac3(i) = (fac3(i) Mod 100000000)
  867.             Next
  868.  
  869.             For i = digits To 1 Step -1
  870.                 fac3(i) = fac3(i - 1)
  871.             Next
  872.             fac3(0) = carry
  873.         Next
  874.  
  875.         For i = 0 To digits
  876.             Call set(fac1.mantissa, i, fac3(i))
  877.         Next
  878.     End If
  879.     'now determine exponent of result.
  880.     'as you do...watch for overflow.
  881.     ex = fac2.exponent - BIAS + fac1.exponent
  882.     fac1.exponent = ex
  883.     'determine the sign of the product
  884.     fac1.sign = fac1.sign Xor fac2.sign
  885.     Call NORM_FAC1(fac1, digits)
  886.     result = fac1
  887.  
  888. Sub fpmul_si (result As decfloat, x As decfloat, y As Integer64, digits_in As Long)
  889.     Dim As Long digits
  890.     digits = digits_in
  891.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  892.     Dim As decfloat fac1, fac2
  893.     Dim As Long count, ex, er, i
  894.     Dim As Integer64 carry, digit, prod, value
  895.     fac1 = x
  896.     digit = Abs(y)
  897.     If digit > 99999999 Then
  898.         Call si2fp(fac2, y, digits)
  899.         Call fpmul(fac1, fac1, fac2, digits)
  900.         result = fac1: Exit Sub
  901.     End If
  902.     'check exponents.  if either is zero,
  903.     'the result is zero
  904.     If fac1.exponent = 0 Or y = 0 Then 'result is zero...clear fac1.
  905.         fac1.sign = 0
  906.         fac1.exponent = 0
  907.         For count = 0 To digits
  908.             Call set(fac1.mantissa, count, 0)
  909.         Next
  910.         Call NORM_FAC1(fac1, digits)
  911.         result = fac1: Exit Sub
  912.     Else
  913.         If digit = 1 Then
  914.             If y < 0 Then
  915.                 fac1.sign = fac1.sign Xor &H8000
  916.             End If
  917.             result = fac1: Exit Sub
  918.         End If
  919.         'now determine exponent of result.
  920.         'as you do...watch for overflow.
  921.  
  922.         If ex < 0 Then
  923.             er = EXPO_ERR
  924.             result = fac1: Exit Sub
  925.         End If
  926.  
  927.         carry = 0
  928.  
  929.         For i = digits To 0 Step -1
  930.             prod = digit * git(fac1.mantissa, i) + carry
  931.             value = (prod Mod 100000000)
  932.             Call set(fac1.mantissa, i, value)
  933.             carry = prod \ 100000000
  934.         Next
  935.  
  936.         If carry < 10 Then
  937.             Call RSHIFT_1(fac1, digits)
  938.             fac1.exponent = fac1.exponent + 1
  939.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10000000)
  940.         ElseIf carry < 100 Then
  941.             Call RSHIFT_2(fac1, digits)
  942.             fac1.exponent = fac1.exponent + 2
  943.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 1000000)
  944.         ElseIf carry < 1000 Then
  945.             Call RSHIFT_3(fac1, digits)
  946.             fac1.exponent = fac1.exponent + 3
  947.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 100000)
  948.         ElseIf carry < 10000 Then
  949.             Call RSHIFT_4(fac1, digits)
  950.             fac1.exponent = fac1.exponent + 4
  951.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10000)
  952.         ElseIf carry < 100000 Then
  953.             Call RSHIFT_5(fac1, digits)
  954.             fac1.exponent = fac1.exponent + 5
  955.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 1000)
  956.         ElseIf carry < 1000000 Then
  957.             Call RSHIFT_6(fac1, digits)
  958.             fac1.exponent = fac1.exponent + 6
  959.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 100)
  960.         ElseIf carry < 10000000 Then
  961.             Call RSHIFT_7(fac1, digits)
  962.             fac1.exponent = fac1.exponent + 7
  963.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10)
  964.         ElseIf carry < 100000000 Then
  965.             Call RSHIFT_8(fac1, digits)
  966.             fac1.exponent = fac1.exponent + 8
  967.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry)
  968.         End If
  969.  
  970.     End If
  971.  
  972.     Call NORM_FAC1(fac1, digits)
  973.  
  974.     If y < 0 Then
  975.         fac1.sign = fac1.sign Xor &H8000
  976.     End If
  977.     result = fac1
  978.  
  979. Sub fpmul_ll (result As decfloat, x As decfloat, y As Integer64, digits_in As Long)
  980.     Dim As Long digits
  981.     digits = digits_in
  982.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  983.     Dim As decfloat fac1, fac2
  984.     Dim As Long count, ex, er, i
  985.     Dim As Integer64 carry, digit, prod, value, n0, n1
  986.     fac1 = x
  987.     digit = Abs(y)
  988.     If digit > 99999999 And digit < 10000000000000000 Then
  989.         n0 = digit \ 100000000
  990.         n1 = digit Mod 100000000
  991.         Call fpmul_si(fac2, fac1, n1, digits)
  992.         fac1.exponent = fac1.exponent + 8
  993.         Call fpmul_si(fac1, fac1, n0, digits)
  994.         Call fpadd(fac1, fac1, fac2, digits)
  995.         If y < 0 Then fac1.sign = fac1.sign Xor &H8000
  996.         result = fac1: Exit Sub
  997.     End If
  998.     If digit > 9999999999999999 Then
  999.         Call str2fp(fac2, Str$(y))
  1000.         Call fpmul(fac1, fac1, fac2, digits)
  1001.         result = fac1: Exit Sub
  1002.     End If
  1003.     Call si2fp(fac2, y, digits)
  1004.  
  1005.     'check exponents.  if either is zero,
  1006.     'the result is zero
  1007.     If fac1.exponent = 0 Or y = 0 Then 'result is zero...clear fac1.
  1008.         fac1.sign = 0
  1009.         fac1.exponent = 0
  1010.         For count = 0 To digits
  1011.             Call set(fac1.mantissa, count, 0)
  1012.         Next
  1013.         Call NORM_FAC1(fac1, digits)
  1014.         result = fac1: Exit Sub
  1015.     Else
  1016.         If digit = 1 Then
  1017.             If y < 0 Then
  1018.                 fac1.sign = fac1.sign Xor &H8000
  1019.             End If
  1020.             result = fac1: Exit Sub
  1021.         End If
  1022.         'now determine exponent of result.
  1023.         'as you do...watch for overflow.
  1024.  
  1025.         If ex < 0 Then
  1026.             er = EXPO_ERR
  1027.             result = fac1: Exit Sub
  1028.         End If
  1029.  
  1030.         carry = 0
  1031.  
  1032.         For i = digits To 0 Step -1
  1033.             prod = digit * git(fac1.mantissa, i) + carry
  1034.             value = (prod Mod 100000000)
  1035.             Call set(fac1.mantissa, i, value)
  1036.             carry = prod \ 100000000
  1037.         Next
  1038.  
  1039.         If carry < 10 Then
  1040.             Call RSHIFT_1(fac1, digits)
  1041.             fac1.exponent = fac1.exponent + 1
  1042.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10000000)
  1043.         ElseIf carry < 100 Then
  1044.             Call RSHIFT_2(fac1, digits)
  1045.             fac1.exponent = fac1.exponent + 2
  1046.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 1000000)
  1047.         ElseIf carry < 1000 Then
  1048.             Call RSHIFT_3(fac1, digits)
  1049.             fac1.exponent = fac1.exponent + 3
  1050.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 100000)
  1051.         ElseIf carry < 10000 Then
  1052.             Call RSHIFT_4(fac1, digits)
  1053.             fac1.exponent = fac1.exponent + 4
  1054.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10000)
  1055.         ElseIf carry < 100000 Then
  1056.             Call RSHIFT_5(fac1, digits)
  1057.             fac1.exponent = fac1.exponent + 5
  1058.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 1000)
  1059.         ElseIf carry < 1000000 Then
  1060.             Call RSHIFT_6(fac1, digits)
  1061.             fac1.exponent = fac1.exponent + 6
  1062.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 100)
  1063.         ElseIf carry < 10000000 Then
  1064.             Call RSHIFT_7(fac1, digits)
  1065.             fac1.exponent = fac1.exponent + 7
  1066.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry * 10)
  1067.         ElseIf carry < 100000000 Then
  1068.             Call RSHIFT_8(fac1, digits)
  1069.             fac1.exponent = fac1.exponent + 8
  1070.             Call set(fac1.mantissa, 0, git(fac1.mantissa, 0) + carry)
  1071.         End If
  1072.  
  1073.     End If
  1074.  
  1075.     Call NORM_FAC1(fac1, digits)
  1076.  
  1077.     If y < 0 Then
  1078.         fac1.sign = fac1.sign Xor &H8000
  1079.     End If
  1080.     result = fac1
  1081.  
  1082. Sub fpinv (result As decfloat, m As decfloat, digits_in As Long)
  1083.     Dim As Long digits
  1084.     digits = digits_in
  1085.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1086.     Dim As Double x
  1087.     Dim As Long k, l, ex
  1088.     Dim As Long prec
  1089.     Dim As decfloat r, r2, one, n
  1090.     n = m
  1091.     l = Log((NUM_DIGITS + 8) * 0.0625) * 1.5
  1092.     Dim As String v, ts
  1093.     If n.exponent > 0 Then
  1094.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  1095.     Else
  1096.         ex = 0
  1097.     End If
  1098.  
  1099.     If n.sign Then v = "-" Else v = " "
  1100.     ts = Str$(git(n.mantissa, 0))
  1101.     If Len(ts) < 8 Then
  1102.         ts = ts + String$(8 - Len(ts), "0")
  1103.     End If
  1104.     v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
  1105.     ts = Str$(git(n.mantissa, 1))
  1106.     If Len(ts) < 8 Then
  1107.         ts = String$(8 - Len(ts), "0") + ts
  1108.     End If
  1109.     v = v + ts
  1110.     x = Val(v)
  1111.     If x = 0 Then Print "Div 0": result = r: Exit Sub
  1112.     If x = 1 And ex = 0 Then
  1113.         Call str2fp(r, "1")
  1114.         result = r: Exit Sub
  1115.     ElseIf x = 1 Then
  1116.         x = 10
  1117.         ex = ex - 1
  1118.     End If
  1119.     ex = (-1) - ex
  1120.     x = 1 / x
  1121.     Call str2fp(r, Str$(x))
  1122.     r.exponent = ex + BIAS + 1
  1123.     Call set(one.mantissa, 0, 10000000)
  1124.     one.exponent = BIAS + 1
  1125.     r2 = r
  1126.     prec = 3
  1127.     For k = 1 To l
  1128.         prec = 2 * prec - 1
  1129.         Call fpmul(r2, n, r, prec)
  1130.         Call fpsub(r2, one, r2, prec)
  1131.         Call fpmul(r2, r, r2, prec)
  1132.         Call fpadd(r, r, r2, prec)
  1133.     Next
  1134.     result = r
  1135.  
  1136. Function min& (a As Long, b As Long)
  1137.     If a < b Then min& = a Else min& = b
  1138.  
  1139. Function RealW# (w() As Double, j As Long)
  1140.     Dim wx As Double
  1141.     wx = ((w(j - 1) * 10000 + w(j)) * 10000 + w(j + 1)) * 10000
  1142.     If UBound(w) >= (j + 2) Then wx = wx + w(j + 2)
  1143.     RealW# = wx
  1144.  
  1145. Sub subtract (w() As Double, q As Long, d() As Double, ka As Long, kb As Long)
  1146.     Dim As Long j
  1147.     For j = ka To kb
  1148.         w(j) = w(j) - q * d(j - ka + 2)
  1149.     Next
  1150.  
  1151. Sub normalize (w() As Double, ka As Long, q As Long)
  1152.     w(ka) = w(ka) + w(ka - 1) * 10000
  1153.     w(ka - 1) = q
  1154.  
  1155. Sub finalnorm (w() As Double, kb As Long)
  1156.     Dim As Long carry, j
  1157.     For j = kb To 3 Step -1
  1158.         If w(j) < 0 Then
  1159.             carry = ((-w(j) - 1) \ 10000) + 1
  1160.         Else
  1161.             If w(j) >= 10000 Then
  1162.                 carry = -(w(j) \ 10000)
  1163.             Else
  1164.                 carry = 0
  1165.             End If
  1166.         End If
  1167.         w(j) = w(j) + carry * 10000
  1168.         w(j - 1) = w(j - 1) - carry
  1169.     Next
  1170.  
  1171. Sub fpdiv (result As decfloat, x As decfloat, y As decfloat, digits_in As Long)
  1172.     Dim As Long digits
  1173.     digits = digits_in
  1174.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1175.     Dim As decfloat fac1, fac2
  1176.     Dim As Long i, er, is_power_of_ten
  1177.  
  1178.     fac1 = x
  1179.     fac2 = y
  1180.  
  1181.     If fac2.exponent = 0 Then ' if fac2 = 0, return
  1182.         ' a divide-by-zero error and
  1183.         ' bail out.
  1184.         For i = 0 To digits
  1185.             Call set(fac1.mantissa, i, 99999999)
  1186.         Next
  1187.         fac1.exponent = 99999 + BIAS + 1
  1188.         er = DIVZ_ERR
  1189.         result = fac1
  1190.         Exit Sub
  1191.     ElseIf fac1.exponent = 0 Then 'fact1=0, just return
  1192.         er = 0
  1193.         result = fac1
  1194.         Exit Sub
  1195.     Else
  1196.         'check to see if fac2 is a power of ten
  1197.         is_power_of_ten = 0
  1198.         If git(fac2.mantissa, 0) = 10000000 Then
  1199.             is_power_of_ten = 1
  1200.             For i = 1 To digits
  1201.                 If git(fac2.mantissa, i) <> 0 Then
  1202.                     is_power_of_ten = 0
  1203.                     Exit For
  1204.                 End If
  1205.             Next
  1206.         End If
  1207.         'if fac2 is a power of ten then all we need to do is to adjust the sign and exponent and we are finished
  1208.         If is_power_of_ten = 1 Then
  1209.             fac1.sign = fac1.sign Xor fac2.sign
  1210.             fac1.exponent = fac1.exponent - fac2.exponent + BIAS + 1
  1211.             result = fac1
  1212.             Exit Sub
  1213.         End If
  1214.  
  1215.         Dim As Double result(1 To 2 * digits + 3), n(1 To 2 * digits + 3), d(1 To 2 * digits + 3)
  1216.         Const b = 10000
  1217.         Dim As Long j, last, laststep, q, t
  1218.         Dim As Long stp
  1219.         Dim As Double xd, xn, rund
  1220.         Dim As Double w(1 To UBound(n) + 4)
  1221.  
  1222.         For j = 0 To digits
  1223.             n(2 * j + 2) = git(fac1.mantissa, j) \ 10000
  1224.             n(2 * j + 3) = git(fac1.mantissa, j) Mod 10000
  1225.             d(2 * j + 2) = git(fac2.mantissa, j) \ 10000
  1226.             d(2 * j + 3) = git(fac2.mantissa, j) Mod 10000
  1227.         Next
  1228.         n(1) = (fac1.exponent And &H7FFFFFFF) - BIAS - 1
  1229.         d(1) = (fac2.exponent And &H7FFFFFFF) - BIAS - 1
  1230.         For j = UBound(n) To UBound(w)
  1231.             w(j) = 0
  1232.         Next
  1233.         t = UBound(n) - 1
  1234.         w(1) = n(1) - d(1) + 1
  1235.         w(2) = 0
  1236.         For j = 2 To UBound(n)
  1237.             w(j + 1) = n(j)
  1238.         Next
  1239.         xd = (d(2) * b + d(3)) * b + d(4) + d(5) / b
  1240.         laststep = t + 2
  1241.         For stp = 1 To laststep
  1242.             xn = RealW(w(), (stp + 2))
  1243.             q = Int(xn / xd)
  1244.             last = min(stp + t + 1, UBound(w))
  1245.             Call subtract(w(), q, d(), (stp + 2), last)
  1246.             Call normalize(w(), (stp + 2), q)
  1247.         Next
  1248.         Call finalnorm(w(), (laststep + 1))
  1249.         If w(2) <> 0 Then laststep = laststep - 1
  1250.         rund = w(laststep + 1) / b
  1251.         If rund >= 0.5 Then w(laststep) = w(laststep) + 1
  1252.         If w(2) = 0 Then
  1253.             For j = 1 To t + 1
  1254.                 result(j) = w(j + 1)
  1255.             Next
  1256.         Else
  1257.             For j = 1 To t + 1
  1258.                 result(j) = w(j)
  1259.             Next
  1260.         End If
  1261.         If w(2) = 0 Then result(1) = w(1) - 1 Else result(1) = w(1)
  1262.  
  1263.         For j = 0 To digits
  1264.             Call set(fac1.mantissa, j, result(2 * j + 2) * 10000 + result(2 * j + 3))
  1265.         Next
  1266.         Call NORM_FAC1(fac1, digits)
  1267.         fac1.exponent = (result(1) + BIAS)
  1268.     End If
  1269.     fac1.sign = fac1.sign Xor fac2.sign
  1270.     result = fac1
  1271.  
  1272. ' sqrt(num)
  1273. Sub fpsqr (result As decfloat, num As decfloat, digits_in As Long)
  1274.     Dim As Long digits
  1275.     digits = digits_in
  1276.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1277.     Dim As decfloat r, r2, tmp, n, half
  1278.     Dim As Long ex, k, l, prec
  1279.     Dim As String ts, v
  1280.     Dim As Double x
  1281.     l = Log((NUM_DIGITS + 8) * 0.0625) * 1.5
  1282.     'l=estimated number of iterations needed
  1283.     'first estimate is accurate to about 16 digits
  1284.     'l is approximatly = to log2((NUM_DIGITS+9)/16)
  1285.     'NUM_DIGITS+9 because decfloat has an extra 9 guard digits
  1286.     n = num
  1287.     Call si2fp(tmp, 0, digits)
  1288.     If fpcmp(n, tmp, digits) = 0 Then
  1289.         Call si2fp(r, 0, digits)
  1290.         result = r
  1291.         Exit Sub
  1292.     End If
  1293.     Call si2fp(tmp, 1, digits)
  1294.     If fpcmp(n, tmp, digits) = 0 Then
  1295.         Call si2fp(r, 1, digits)
  1296.         result = r
  1297.         Exit Sub
  1298.     End If
  1299.     Call si2fp(tmp, 0, digits)
  1300.     If fpcmp(n, tmp, digits) < 0 Then
  1301.         Call si2fp(r, 0, digits)
  1302.         result = r
  1303.         Exit Sub
  1304.     End If
  1305.     '=====================================================================
  1306.     'hack to bypass the limitation of double exponent range
  1307.     'in case the number is larger than what a double can handle
  1308.     'for example, if the number is 2e500
  1309.     'we separate the exponent and mantissa in this case 2
  1310.     'if the exponent is odd then multiply the mantissa by 10
  1311.     'take the square root and assign it to decfloat
  1312.     'divide the exponent in half for square root
  1313.     'in this case 1.414213562373095e250
  1314.     If n.exponent > 0 Then
  1315.         ex = (n.exponent And &H7FFFFFFF) - BIAS - 1
  1316.     Else
  1317.         ex = 0
  1318.     End If
  1319.     ts = Trim$(Str$(git(n.mantissa, 0)))
  1320.     If Len(ts) < 8 Then
  1321.         ts = ts + String$(8 - Len(ts), "0")
  1322.     End If
  1323.     v = v + Left$(ts, 1) + "." + Mid$(ts, 2)
  1324.     ts = Trim$(Str$(git(n.mantissa, 1)))
  1325.     If Len(ts) < 8 Then
  1326.         ts = String$(8 - Len(ts), "0") + ts
  1327.     End If
  1328.     v = v + ts
  1329.     x = Val(v)
  1330.     If x = 0 Then Print "Div 0": result = r: Exit Sub
  1331.     If x = 1 And ex = 0 Then
  1332.         Call si2fp(r, 1, digits)
  1333.         result = r
  1334.         Exit Sub
  1335.     End If
  1336.     If Abs(ex) And 1 Then
  1337.         x = x * 10
  1338.         ex = ex - 1
  1339.     End If
  1340.     x = Sqr(x) 'approximation
  1341.     v = Trim$(Str$(x))
  1342.     k = InStr(v, ".")
  1343.     Call str2fp(r, v)
  1344.     r.exponent = ex \ 2 + BIAS + 1
  1345.     If Len(v) > 1 And k = 0 Then r.exponent = r.exponent + 1
  1346.     For k = 1 To digits
  1347.         Call set(half.mantissa, k, 0)
  1348.     Next
  1349.     Call set(half.mantissa, 0, 50000000)
  1350.     half.exponent = BIAS
  1351.     half.sign = 0
  1352.     '=====================================================================
  1353.     'Newton-Raphson method
  1354.     prec = 3
  1355.     For k = 1 To l + 1
  1356.         prec = 2 * prec - 1
  1357.         Call fpdiv(tmp, n, r, prec)
  1358.         Call fpadd(r2, r, tmp, prec)
  1359.         Call fpmul(r, r2, half, prec)
  1360.     Next
  1361.     result = r
  1362.  
  1363. Sub fpdiv_si (result As decfloat, num As decfloat, den As Long, digits_in As Long)
  1364.     Dim As Long digits
  1365.     digits = digits_in
  1366.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1367.     Dim As decfloat fac1
  1368.     Dim As Unsigned Integer64 carry, remder
  1369.     Dim As Integer64 i, divisor
  1370.     Dim As Integer64 quotient
  1371.     remder = 0
  1372.     divisor = Abs(den)
  1373.     fac1 = num
  1374.     If divisor = 0 Then
  1375.         Print "error: divisor = 0"
  1376.         result = fac1: Exit Sub
  1377.     End If
  1378.     If divisor > 99999999 Then
  1379.         Print "error: divisor too large"
  1380.         result = fac1: Exit Sub
  1381.     End If
  1382.  
  1383.     For i = 0 To digits
  1384.         quotient = git(fac1.mantissa, i) + remder * 100000000
  1385.         remder = quotient Mod divisor
  1386.         Call set(fac1.mantissa, i, quotient \ divisor)
  1387.     Next
  1388.     quotient = remder * 100000000
  1389.     quotient = quotient \ divisor
  1390.     carry = git(fac1.mantissa, 0)
  1391.  
  1392.     If carry = 0 Then
  1393.         Call LSHIFT_8(fac1, digits)
  1394.         fac1.exponent = fac1.exponent - 8
  1395.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient)
  1396.     ElseIf carry < 10 Then
  1397.         Call LSHIFT_7(fac1, digits)
  1398.         fac1.exponent = fac1.exponent - 7
  1399.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 10)
  1400.     ElseIf carry < 100 Then
  1401.         Call LSHIFT_6(fac1, digits)
  1402.         fac1.exponent = fac1.exponent - 6
  1403.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 100)
  1404.     ElseIf carry < 1000 Then
  1405.         Call LSHIFT_5(fac1, digits)
  1406.         fac1.exponent = fac1.exponent - 5
  1407.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 1000)
  1408.     ElseIf carry < 10000 Then
  1409.         Call LSHIFT_4(fac1, digits)
  1410.         fac1.exponent = fac1.exponent - 4
  1411.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 10000)
  1412.     ElseIf carry < 100000 Then
  1413.         Call LSHIFT_3(fac1, digits)
  1414.         fac1.exponent = fac1.exponent - 3
  1415.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 100000)
  1416.     ElseIf carry < 1000000 Then
  1417.         Call LSHIFT_2(fac1, digits)
  1418.         fac1.exponent = fac1.exponent - 2
  1419.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 1000000)
  1420.     ElseIf carry < 10000000 Then
  1421.         Call LSHIFT_1(fac1, digits)
  1422.         fac1.exponent = fac1.exponent - 1
  1423.         Call set(fac1.mantissa, digits, git(fac1.mantissa, digits) + quotient \ 10000000)
  1424.     End If
  1425.  
  1426.     'NORM_FAC1(fac1)
  1427.     If den < 0 Then
  1428.         fac1.sign = fac1.sign Xor &H8000
  1429.     End If
  1430.     result = fac1
  1431.  
  1432. 'fractional part of num
  1433. Sub fpfrac (result As decfloat, num As decfloat, digits_in As Long)
  1434.     Dim As Long digits
  1435.     digits = digits_in
  1436.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1437.     Dim As decfloat n
  1438.     Call fpfix(n, num)
  1439.     Call fpsub(n, num, n, digits)
  1440.     result = n
  1441.  
  1442. 'returns the positive of n
  1443. Sub fpabs (result As decfloat, n As decfloat)
  1444.     Dim As decfloat x
  1445.     x = n
  1446.     x.sign = 0
  1447.     result = x
  1448.  
  1449. 'changes the sign of n, if n is positive then n will be negative & vice versa
  1450. Sub fpneg (result As decfloat, n As decfloat)
  1451.     Dim As decfloat x
  1452.     x = n
  1453.     x.sign = x.sign Xor &H8000
  1454.     result = x
  1455.  
  1456. 'returns the negative of n regardless of the sign of n
  1457. Sub fpnegative (result As decfloat, n As decfloat)
  1458.     Dim As decfloat x
  1459.     x = n
  1460.     x.sign = &H8000
  1461.     result = x
  1462.  
  1463. Sub fpfmod (quotient As decfloat, f_mod As decfloat, num As decfloat, denom As decfloat, digits As Long)
  1464.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1465.     Dim As decfloat q, fm 'make copy in case the destination and source are the same
  1466.     Call fpdiv(fm, num, denom, digits): Call fpfix(q, fm)
  1467.     Call fpsub(fm, fm, q, digits): Call fpmul(fm, fm, denom, digits)
  1468.     quotient = q
  1469.     f_mod = fm
  1470.  
  1471. Sub fpeps (result As decfloat, digits As Long)
  1472.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1473.     Dim As decfloat ep
  1474.     Call si2fp(ep, 1, digits)
  1475.     ep.exponent = (-(NUM_DIGITS) + BIAS + 1)
  1476.     result = ep
  1477.  
  1478. Sub fpipow (result As decfloat, x As decfloat, e As Integer64, digits_in As Long)
  1479.     Dim As Long digits
  1480.     digits = digits_in
  1481.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1482.     'take x to an Long power
  1483.     Dim As decfloat y
  1484.     Dim As decfloat z
  1485.     Dim As Integer64 n, c
  1486.     Dim As Long i
  1487.     c = 0
  1488.     y = x
  1489.     n = Abs(e)
  1490.     z.sign = 0
  1491.     z.exponent = (BIAS + 1)
  1492.     Call set(z.mantissa, 0, 10000000)
  1493.     For i = 1 To NUM_DWORDS
  1494.         Call set(z.mantissa, i, 0)
  1495.     Next
  1496.     While n > 0
  1497.         While (n And 1) = 0
  1498.             n = n \ 2
  1499.             Call fpmul(y, y, y, digits)
  1500.             c = c + 1
  1501.         Wend
  1502.         n = n - 1
  1503.         Call fpmul(z, y, z, digits)
  1504.         c = c + 1
  1505.     Wend
  1506.     If e < 0 Then
  1507.         Call fpinv(z, z, digits)
  1508.     End If
  1509.     result = z
  1510.  
  1511. Sub fpfactorial (result As decfloat, n As Long, digits_in As Long)
  1512.     Dim As Long digits
  1513.     digits = digits_in
  1514.     Dim As Long i
  1515.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1516.     Dim As decfloat f
  1517.     If n < 0 Then Print "inf": result = f: Exit Sub
  1518.     If n = 0 Or n = 1 Then
  1519.         Call si2fp(f, 1, digits)
  1520.         result = f: Exit Sub
  1521.     End If
  1522.     Call si2fp(f, 2, digits)
  1523.     If n = 2 Then result = f: Exit Sub
  1524.     For i = 3 To n
  1525.         Call fpmul_si(f, f, i, digits)
  1526.     Next
  1527.     result = f
  1528.  
  1529. Sub fplogTaylor (result As decfloat, x As decfloat, digits_in As Long)
  1530.     Dim As Long digits
  1531.     digits = digits_in
  1532.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1533.     'taylor series
  1534.     '====================Log Guard==================
  1535.     Dim As decfloat g, zero
  1536.     Dim As Long i
  1537.     Call fpabs(g, x)
  1538.     zero.sign = 0
  1539.     zero.exponent = 0
  1540.     For i = 0 To NUM_DWORDS
  1541.         Call set(zero.mantissa, i, 0)
  1542.     Next
  1543.     If fpcmp(g, x, digits) <> 0 Then result = zero: Exit Sub
  1544.     If fpcmp(x, zero, digits) = 0 Then result = zero: Exit Sub
  1545.     '=============================================
  1546.     Dim As Long invflag
  1547.     Dim As decfloat XX, Term, Accum, x9, tmp, tmp2
  1548.     Dim As decfloat T, B, one, Q, two
  1549.  
  1550.     one.sign = 0
  1551.     one.exponent = (BIAS + 1)
  1552.     Call set(one.mantissa, 0, 10000000)
  1553.     two.sign = 0
  1554.     two.exponent = (BIAS + 1)
  1555.     Call set(two.mantissa, 0, 20000000)
  1556.     For i = 1 To NUM_DWORDS
  1557.         Call set(one.mantissa, i, 0)
  1558.         Call set(two.mantissa, i, 0)
  1559.     Next
  1560.     x9 = x
  1561.     If fpcmp(x, one, digits) < 0 Then
  1562.         invflag = 1
  1563.         Call fpdiv(x9, one, x9, digits)
  1564.     End If
  1565.     Call fpsub(T, x9, one, digits)
  1566.     Call fpadd(B, x9, one, digits)
  1567.     Call fpdiv(Accum, T, B, digits)
  1568.     Call fpdiv(Q, T, B, digits)
  1569.     tmp = Q
  1570.     Call fpmul(XX, Q, Q, digits)
  1571.     Dim As Long c
  1572.     c = 1
  1573.     Do
  1574.         c = c + 2
  1575.         tmp2 = tmp
  1576.         Call fpmul(Q, Q, XX, digits)
  1577.         Call fpdiv_si(Term, Q, c, digits)
  1578.         Call fpadd(Accum, tmp, Term, digits)
  1579.         Swap tmp, Accum
  1580.     Loop Until fpcmp(tmp, tmp2, digits) = 0
  1581.     Call fpmul_si(Accum, Accum, 2, digits)
  1582.     If invflag Then
  1583.         Call fpneg(Accum, Accum)
  1584.         result = Accum: Exit Sub
  1585.     End If
  1586.     result = Accum
  1587.  
  1588. Sub fplog (result As decfloat, x As decfloat, digits_in As Long)
  1589.     Dim As Long digits
  1590.     digits = digits_in
  1591.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1592.     '====================Log Guard==================
  1593.     Dim As decfloat g, one, zero
  1594.     Dim As Long i, factor
  1595.     zero.sign = 0
  1596.     zero.exponent = 0
  1597.     For i = 0 To NUM_DWORDS
  1598.         Call set(zero.mantissa, i, 0)
  1599.     Next
  1600.     Call si2fp(one, 1, digits)
  1601.     Call fpabs(g, x)
  1602.     If fpcmp(g, x, digits) <> 0 Then result = zero: Exit Sub
  1603.     If fpcmp(x, zero, digits) = 0 Then result = zero: Exit Sub
  1604.     If fpcmp(x, one, digits) = 0 Then result = zero: Exit Sub
  1605.     '=============================================
  1606.     Dim As decfloat approx, ans, logx
  1607.     approx = x
  1608.     factor = 4096
  1609.     Call fpsqr(approx, approx, digits)
  1610.     Call fpsqr(approx, approx, digits)
  1611.     Call fpsqr(approx, approx, digits)
  1612.     Call fpsqr(approx, approx, digits)
  1613.     Call fpsqr(approx, approx, digits)
  1614.     Call fpsqr(approx, approx, digits)
  1615.     Call fpsqr(approx, approx, digits)
  1616.     Call fpsqr(approx, approx, digits)
  1617.     Call fpsqr(approx, approx, digits)
  1618.     Call fpsqr(approx, approx, digits)
  1619.     Call fpsqr(approx, approx, digits)
  1620.     Call fpsqr(approx, approx, digits)
  1621.     Call fplogTaylor(logx, approx, digits)
  1622.     Call fpmul_si(ans, logx, factor, digits)
  1623.     result = ans
  1624.  
  1625. Sub fpexp (result As decfloat, x As decfloat, digits_in As Long)
  1626.     Dim As Long digits
  1627.     digits = digits_in
  1628.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1629.     'taylor series
  1630.     Dim As decfloat fac, x9, temp, accum, p, term
  1631.     Dim As Long i, c
  1632.     Call si2fp(temp, 0, digits)
  1633.  
  1634.     fac.sign = 0
  1635.     fac.exponent = (BIAS + 1)
  1636.     Call set(fac.mantissa, 0, 10000000)
  1637.     For i = 1 To NUM_DWORDS
  1638.         Call set(fac.mantissa, i, 0)
  1639.     Next
  1640.     If fpcmp(x, temp, digits) = 0 Then result = fac: Exit Sub
  1641.     c = 1
  1642.     Call fpdiv_si(x9, x, 8192, digits) 'fpdiv_si(x, 67108864) '
  1643.     p = x9
  1644.     Call fpadd(accum, fac, x9, digits) '1 + x
  1645.  
  1646.     Do
  1647.         c = c + 1
  1648.         temp = accum
  1649.         Call fpdiv_si(fac, fac, c, digits)
  1650.         Call fpmul(p, p, x9, digits)
  1651.         Call fpmul(term, p, fac, digits)
  1652.         Call fpadd(accum, temp, term, digits)
  1653.     Loop Until fpcmp(accum, temp, digits) = 0
  1654.     For i = 1 To 13
  1655.         Call fpmul(accum, accum, accum, digits)
  1656.     Next
  1657.     result = accum
  1658.  
  1659. Sub fpexp_cf (result As decfloat, x As decfloat, n As Long, digits_in As Long)
  1660.     Dim As Long digits
  1661.     digits = digits_in
  1662.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1663.  
  1664.     '                       x
  1665.     '    cf =   ------------------------------
  1666.     '                         x^2
  1667.     '           2 + -------------------------
  1668.     '                           x^2
  1669.     '              6 + ----------------------
  1670.     '                             x^2
  1671.     '                 10 + ------------------
  1672.     '                               x^2
  1673.     '                     14 + --------------
  1674.     '                                 x^2
  1675.     '                          18 + ---------
  1676.     '                                   x^2
  1677.     '                              22 + -----
  1678.     '                                   26 + ...
  1679.     '           (1 + cf)
  1680.     ' exp(x) = ----------
  1681.     '           (1 - cf)
  1682.  
  1683.     Dim i As Long
  1684.     Dim As decfloat s, x1, x2, tmp, tmp2
  1685.     Call fpdiv_si(x1, x, 8192, digits) ' 2^13
  1686.     Call fpmul(x2, x1, x1, digits)
  1687.     Call si2fp(s, 4 * n + 6, digits)
  1688.     For i = n To 0 Step -1
  1689.         Call si2fp(tmp, 4 * i + 2, digits)
  1690.         Call fpdiv(s, x2, s, digits)
  1691.         Call fpadd(s, s, tmp, digits)
  1692.     Next
  1693.     Call fpdiv(s, x1, s, digits)
  1694.     Call si2fp(tmp, 1, digits)
  1695.     tmp2 = tmp
  1696.     Call fpadd(tmp, tmp, s, digits)
  1697.     Call fpsub(tmp2, tmp2, s, digits)
  1698.     Call fpdiv(s, tmp, tmp2, digits)
  1699.     For i = 1 To 13 ' s^13
  1700.         Call fpmul(s, s, s, digits)
  1701.     Next
  1702.     result = s
  1703.  
  1704. Sub fplog_r (result As decfloat, x As decfloat, digits_in As Long)
  1705.     Dim As Long digits
  1706.     digits = digits_in
  1707.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1708.     '====================Log Guard==================
  1709.     Dim As decfloat x2, y, tmp
  1710.     Dim As Long i
  1711.     Dim As Long ex, terms, prec, n
  1712.     Dim As Double t, t2
  1713.  
  1714.     tmp.sign = 0
  1715.     tmp.exponent = (BIAS + 1)
  1716.     Call set(tmp.mantissa, 0, 10000000)
  1717.     For i = 1 To NUM_DWORDS
  1718.         Call set(tmp.mantissa, i, 0)
  1719.     Next
  1720.     If fpcmp(x, tmp, digits) = 0 Then result = x2: Exit Sub
  1721.     ex = (x.exponent And &H7FFFFFFF) - BIAS - 1
  1722.     t = git(x.mantissa, 0) + git(x.mantissa, 1) / 100000000
  1723.     t = t / 10000000
  1724.     t2 = Log(t) + Log(10) * ex
  1725.  
  1726.     n = Log((digits + 1) * 0.5) * 1.5
  1727.  
  1728.     Call str2fp(x2, Str$(t2))
  1729.     prec = 3
  1730.     terms = 2
  1731.     prec = 2 * prec - 1
  1732.     Call fpexp_cf(y, x2, terms, prec)
  1733.     Call fpsub(tmp, y, x, prec)
  1734.     Call fpdiv(tmp, tmp, y, prec)
  1735.     Call fpsub(x2, x2, tmp, prec)
  1736.     If digits > 4 And digits <= 9 Then
  1737.         prec = 2 * prec - 1
  1738.         terms = 2 * terms + 1
  1739.         Call fpexp_cf(y, x2, terms, prec)
  1740.         Call fpsub(tmp, y, x, prec)
  1741.         Call fpdiv(tmp, tmp, y, prec)
  1742.         Call fpsub(x2, x2, tmp, prec)
  1743.     ElseIf digits > 9 And digits < 18 Then
  1744.         For i = 1 To 3
  1745.             prec = 2 * prec - 1
  1746.             terms = 2 * terms + 1
  1747.             Call fpexp_cf(y, x2, terms, prec)
  1748.             Call fpsub(tmp, y, x, prec)
  1749.             Call fpdiv(tmp, tmp, y, prec)
  1750.             Call fpsub(x2, x2, tmp, prec)
  1751.         Next
  1752.     ElseIf digits > 17 And digits < 34 Then
  1753.         For i = 1 To 4
  1754.             prec = 2 * prec - 1
  1755.             terms = 2 * terms + 1
  1756.             Call fpexp_cf(y, x2, terms, prec)
  1757.             Call fpsub(tmp, y, x, prec)
  1758.             Call fpdiv(tmp, tmp, y, prec)
  1759.             Call fpsub(x2, x2, tmp, prec)
  1760.         Next
  1761.     ElseIf digits > 33 And digits < 65 Then
  1762.         For i = 1 To 5
  1763.             prec = 2 * prec - 1
  1764.             terms = 2 * terms + 1
  1765.             Call fpexp_cf(y, x2, terms, prec)
  1766.             Call fpsub(tmp, y, x, prec)
  1767.             Call fpdiv(tmp, tmp, y, prec)
  1768.             Call fpsub(x2, x2, tmp, prec)
  1769.         Next
  1770.     ElseIf digits > 64 Then
  1771.         For i = 1 To 6
  1772.             prec = 2 * prec - 1
  1773.             terms = 2 * terms + 1
  1774.             Call fpexp_cf(y, x2, terms, prec)
  1775.             Call fpsub(tmp, y, x, prec)
  1776.             Call fpdiv(tmp, tmp, y, prec)
  1777.             Call fpsub(x2, x2, tmp, prec)
  1778.         Next
  1779.     End If
  1780.     result = x2
  1781.  
  1782. Sub fppow (result As decfloat, lhs As decfloat, rhs As decfloat)
  1783.     Dim As decfloat lhs2
  1784.     Call fplog(lhs2, lhs, NUM_DWORDS)
  1785.     Call fpmul(lhs2, lhs2, rhs, NUM_DWORDS)
  1786.     Call fpexp(lhs2, lhs2, NUM_DWORDS)
  1787.     result = lhs2
  1788.  
  1789. Sub fpnroot (result As decfloat, x As decfloat, p As Long, digits_in As Long)
  1790.     Dim As Long digits
  1791.     digits = digits_in
  1792.     If digits > NUM_DWORDS Then digits = NUM_DWORDS
  1793.     Dim As decfloat ry, tmp, tmp2
  1794.     Dim As Double t, t2
  1795.     Dim As Long i, ex, l, prec
  1796.  
  1797.     l = Log((NUM_DIGITS + 8) * 0.0625) * 1.5
  1798.     ex = (x.exponent And &H7FFFFFFF) - BIAS - 1
  1799.     t = git(x.mantissa, 0) + git(x.mantissa, 1) / 100000000
  1800.     t = t / 10000000
  1801.     t2 = Log(t) / p + Log(10) * ex / p
  1802.     t2 = Exp(t2)
  1803.     Call str2fp(ry, Str$(t2))
  1804.     prec = 3
  1805.  
  1806.     Call fpipow(tmp, ry, p - 1, prec)
  1807.     Call fpdiv(tmp, x, tmp, prec)
  1808.     Call fpmul_si(tmp2, ry, p - 1, prec)
  1809.     Call fpadd(tmp2, tmp2, tmp, prec)
  1810.     Call fpdiv_si(ry, tmp2, p, prec)
  1811.     For i = 1 To l
  1812.         prec = 2 * prec - 1
  1813.         Call fpipow(tmp, ry, p - 1, prec)
  1814.         Call fpdiv(tmp, x, tmp, prec)
  1815.         Call fpmul_si(tmp2, ry, p - 1, prec)
  1816.         Call fpadd(tmp2, tmp2, tmp, prec)
  1817.         Call fpdiv_si(ry, tmp2, p, prec)
  1818.     Next
  1819.     result = ry
  1820.  
  1821. Sub pi_brent_salamin (pi_bs As decfloat, digits_in As Unsigned Long)
  1822.     Dim As Unsigned Long digits
  1823.     digits = digits_in
  1824.     If digits > NUMBER_OF_DIGITS Then digits = NUMBER_OF_DIGITS
  1825.  
  1826.     Dim As Long limit2
  1827.     Dim As decfloat c0, c1, c2, c05
  1828.     Dim As decfloat a, b, sum
  1829.     Dim As decfloat ak, bk, ck
  1830.     Dim As decfloat ab, asq
  1831.     Dim As decfloat pow2, tmp
  1832.  
  1833.     limit2 = -digits + BIAS + 1
  1834.     Call si2fp(c0, 0, NUMBER_OF_DIGITS): ak = c0: bk = c0: ab = c0: asq = c0
  1835.     Call si2fp(c1, 1, NUMBER_OF_DIGITS): a = c1: ck = c1: pow2 = c1
  1836.     Call si2fp(c2, 2, NUMBER_OF_DIGITS): b = c2
  1837.     Call str2fp(c05, ".5"): sum = c05
  1838.     Call si2fp(pi_bs, 3, NUMBER_OF_DIGITS)
  1839.  
  1840.     Call fpsqr(b, b, NUMBER_OF_DIGITS)
  1841.     Call fpdiv(b, c1, b, NUMBER_OF_DIGITS)
  1842.     While fpcmp(ck, c0, NUMBER_OF_DIGITS) <> 0 And ck.exponent > limit2
  1843.         Call fpadd(ak, a, b, NUMBER_OF_DIGITS)
  1844.         Call fpmul(ak, c05, ak, NUMBER_OF_DIGITS)
  1845.         Call fpmul(ab, a, b, NUMBER_OF_DIGITS)
  1846.         Call fpsqr(bk, ab, NUMBER_OF_DIGITS)
  1847.         Call fpmul(asq, ak, ak, NUMBER_OF_DIGITS)
  1848.         Call fpsub(ck, asq, ab, NUMBER_OF_DIGITS)
  1849.         Call fpmul(pow2, pow2, c2, NUMBER_OF_DIGITS)
  1850.         Call fpmul(tmp, pow2, ck, NUMBER_OF_DIGITS)
  1851.         Call fpsub(sum, sum, tmp, NUMBER_OF_DIGITS)
  1852.         a = ak: b = bk
  1853.     Wend
  1854.     Call fpdiv(tmp, asq, sum, NUMBER_OF_DIGITS)
  1855.     Call fpmul(pi_bs, c2, tmp, NUMBER_OF_DIGITS)
  1856.  
  1857. Sub fpsin (result As decfloat, x As decfloat, digits_in As Unsigned Long)
  1858.     Dim As decfloat XX, Term, Accum, p, temp2, fac, x_2
  1859.     Dim As decfloat pi2, circ, Ab
  1860.     Dim As Long precision
  1861.     precision = digits_in
  1862.  
  1863.     x_2 = x
  1864.     pi2 = pi_dec
  1865.     Call fpmul_si(circ, pi2, 2, precision)
  1866.     Call fpabs(Ab, x)
  1867.     If fpcmp(Ab, circ, precision) > 0 Then
  1868.         '======== CENTRALIZE ==============
  1869.         'floor/ceil to centralize
  1870.         Dim As decfloat tmp, tmp2
  1871.         If precision > 20 Then
  1872.             pi2 = pi_dec
  1873.         End If
  1874.         Call fpmul_si(pi2, pi2, 2, precision) 'got 2*pi
  1875.         Call fpdiv(tmp, x_2, pi2, precision)
  1876.         tmp2 = tmp
  1877.         Call fpfix(tmp, tmp) 'int part
  1878.         Call fpsub(tmp, tmp2, tmp, precision) 'frac part
  1879.         Call fpmul(tmp, tmp, pi2, precision)
  1880.         x_2 = tmp
  1881.     End If
  1882.  
  1883.     Dim As Long lm, limit2, i
  1884.     Dim As decfloat factor
  1885.     lm = precision
  1886.     limit2 = Int(-0.45344993886092585968 + 0.022333002852398072433 * lm + 5.0461814408333079844E-7 * lm * lm - 4.2338453039804235772E-11 * lm * lm * lm)
  1887.  
  1888.     Call si2fp(factor, 5, precision)
  1889.     Call fpipow(factor, factor, limit2, precision)
  1890.     Call fpdiv(x_2, x_2, factor, precision) 'x_=x_/5^limit2
  1891.     '==================================
  1892.     Dim As Long sign(3): sign(3) = 1
  1893.     Dim As Long c: c = 1
  1894.  
  1895.     Accum = x_2
  1896.     Call si2fp(fac, 1, precision)
  1897.     p = x_2
  1898.     Call fpmul(XX, x_2, x_2, precision)
  1899.     Do
  1900.         c = c + 2
  1901.         temp2 = Accum
  1902.         Call fpmul_si(fac, fac, c * (c - 1), precision)
  1903.         Call fpmul(p, p, XX, precision)
  1904.         Call fpdiv(Term, p, fac, precision)
  1905.         If sign(c And 3) Then
  1906.             Call fpsub(Accum, temp2, Term, precision)
  1907.         Else
  1908.             Call fpadd(Accum, temp2, Term, precision)
  1909.         End If
  1910.     Loop Until fpcmp(Accum, temp2, precision) = 0
  1911.     'multiply the result by 5^limit2
  1912.  
  1913.     For i = 1 To limit2
  1914.         Call fpmul(p, Accum, Accum, precision)
  1915.         Call fpmul(temp2, Accum, p, precision)
  1916.         '*** sin(5*x) = 5 * sin(x) - 20 * sin(x)^3 + 16 * sin(x)^5
  1917.         Call fpmul_si(Accum, Accum, 5, precision)
  1918.         Call fpmul_si(Term, temp2, 20, precision)
  1919.         Call fpmul_si(XX, temp2, 16, precision)
  1920.         Call fpmul(XX, XX, p, precision)
  1921.         Call fpsub(Accum, Accum, Term, precision)
  1922.         Call fpadd(Accum, Accum, XX, precision)
  1923.     Next i
  1924.     result = Accum
  1925.  
  1926. Sub fpcos (result As decfloat, z As decfloat, digits_in As Unsigned Long)
  1927.     Dim As decfloat x_2, pi2
  1928.     Dim As Long precision
  1929.     precision = digits_in
  1930.     Call fpdiv_si(pi2, pi_dec, 2, precision)
  1931.     Call fpsub(x_2, pi2, z, precision)
  1932.  
  1933.     Call fpsin(result, x_2, precision)
  1934.  
  1935. Sub fptan (result As decfloat, z As decfloat, digits_in As Unsigned Long)
  1936.     Dim As decfloat x_2, s, c
  1937.     Dim As Long precision
  1938.     precision = digits_in
  1939.     x_2 = z
  1940.     Call fpsin(s, x_2, precision)
  1941.     x_2 = z
  1942.     Call fpcos(c, x_2, precision)
  1943.     Call fpdiv(result, s, c, precision)
  1944.  
  1945. Sub fpatn (result As decfloat, x As decfloat, digits_in As Unsigned Long)
  1946.     Dim As Long precision, z
  1947.     precision = digits_in
  1948.     Dim As Long sign(3): sign(3) = 1
  1949.     Dim As Unsigned Long c: c = 1
  1950.     Dim As decfloat XX, Term, Accum, strC, x_2, mt, mt2, p
  1951.     Dim As decfloat decnum, one, decnum2, factor
  1952.  
  1953.     decnum2 = x
  1954.     decnum2.sign = 0
  1955.     Call si2fp(one, 1, precision)
  1956.     If fpcmp(decnum2, one, precision) = 0 Then
  1957.         Call fpdiv_si(result, pi_dec, 4, precision)
  1958.         result.sign = x.sign
  1959.         Exit Sub
  1960.     End If
  1961.     decnum2.sign = x.sign
  1962.     Dim As Long limit2: limit2 = 16
  1963.     Call si2fp(factor, SHL(2, limit2 - 1), precision)
  1964.     For z = 1 To limit2
  1965.         Call fpmul(decnum, decnum2, decnum2, precision)
  1966.         Call fpadd(decnum, decnum, one, precision)
  1967.         Call fpsqr(decnum, decnum, precision)
  1968.         Call fpadd(decnum, decnum, one, precision)
  1969.         Call fpdiv(decnum, decnum2, decnum, precision)
  1970.         decnum2 = decnum
  1971.     Next z
  1972.  
  1973.     mt = decnum
  1974.     x_2 = decnum
  1975.     p = decnum
  1976.     Call fpmul(XX, x_2, x_2, precision)
  1977.     Do
  1978.         c = c + 2
  1979.         mt2 = mt
  1980.         Call si2fp(strC, c, precision)
  1981.         Call fpmul(p, p, XX, precision)
  1982.         Call fpdiv(Term, p, strC, precision)
  1983.         If sign(c And 3) Then
  1984.             Call fpsub(Accum, mt, Term, precision)
  1985.         Else
  1986.             Call fpadd(Accum, mt, Term, precision)
  1987.         End If
  1988.         Swap mt, Accum
  1989.     Loop Until fpcmp(mt, mt2, precision) = 0
  1990.     Call fpmul(result, factor, mt, precision)
  1991.  
  1992. Sub fpasin (result As decfloat, x As decfloat, digits_in As Unsigned Long)
  1993.     Dim As Long precision
  1994.     precision = digits_in
  1995.     Dim As Double num
  1996.     ' ARCSIN = ATN(x / SQR(-x * x + 1))
  1997.     '============= ARCSIN GUARD =========
  1998.     num = fp2dbl(x)
  1999.     If num > 1 Then Exit Sub
  2000.     If num < -1 Then Exit Sub
  2001.     '========================
  2002.     Dim As decfloat one, T, B, term1, minusone
  2003.     Call si2fp(one, 1, precision)
  2004.     Call si2fp(minusone, -1, precision)
  2005.     T = x
  2006.     Call fpmul(B, x, x, precision) 'x*x
  2007.     'for 1 and -1
  2008.     If fpcmp(B, one, precision) = 0 Then
  2009.         Dim As decfloat two, atn1
  2010.         Call si2fp(two, 2, precision)
  2011.         Call fpatn(atn1, one, precision)
  2012.         If fpcmp(x, minusone, precision) = 0 Then
  2013.             Call fpmul(two, two, atn1, precision)
  2014.             Call fpmul(result, two, minusone, precision)
  2015.             Exit Sub
  2016.         Else
  2017.             Call fpmul(result, two, atn1, precision)
  2018.             Exit Sub
  2019.         End If
  2020.     End If
  2021.     Call fpsub(B, one, B, precision) '1-x*x
  2022.     Call fpsqr(B, B, precision) 'sqr(1-x*x)
  2023.     Call fpdiv(term1, T, B, precision)
  2024.     Call fpatn(result, term1, precision)
  2025.  
  2026. Sub fpacos (result As decfloat, x As decfloat, digits_in As Unsigned Long)
  2027.     Dim As Long precision
  2028.     precision = digits_in
  2029.     Dim As decfloat one, minusone, two, atn1, tail, T, B, term1, atnterm1 ',_x,temp
  2030.     Dim As Double num
  2031.     'ARCCOS = ATN(-x / SQR(-x * x + 1)) + 2 * ATN(1)
  2032.     '============= ARCCOS GUARD =========
  2033.     num = fp2dbl(x)
  2034.     If num > 1 Then Exit Sub
  2035.     If num < -1 Then Exit Sub
  2036.     '========================
  2037.     Call si2fp(one, 1, precision)
  2038.     Call si2fp(minusone, -1, precision)
  2039.     Call si2fp(two, 2, precision)
  2040.     Call fpatn(atn1, one, precision)
  2041.     Call fpmul(tail, two, atn1, precision) '2*atn(1)
  2042.     Call fpmul(T, minusone, x, precision) '-x
  2043.     Call fpmul(B, x, x, precision) 'x*x
  2044.     If fpcmp(B, one, precision) = 0 Then
  2045.         'for 1 and -1
  2046.         If fpcmp(x, minusone, precision) = 0 Then
  2047.             Dim As decfloat four
  2048.             Call si2fp(four, 4, precision)
  2049.             Call fpmul(result, four, atn1, precision)
  2050.             Exit Sub
  2051.         Else
  2052.             Call si2fp(result, 0, precision)
  2053.             Exit Sub
  2054.         End If
  2055.     End If
  2056.     Call fpsub(B, one, B, precision) '1-x*x
  2057.     Call fpsqr(B, B, precision) 'sqr(1-x*x)
  2058.     Call fpdiv(term1, T, B, precision)
  2059.     Call fpatn(atnterm1, term1, precision)
  2060.     Call fpadd(result, atnterm1, tail, precision)
  2061.  
test-decfloat.bas
Code: QB64: [Select]
  1. 'you must use $NoPrefix
  2. Dest Console
  3.  
  4. Option Explicit
  5.  
  6. Const NUMBER_OF_DIGITS = 80 ' you must have NUMBER_OF_DIGITS defined -- not to exceed 1024
  7. '                             before including decfloat.bi
  8. '$include: 'decfloat.bi'
  9.  
  10. '======================================================================
  11. ' your code follows
  12.  
  13. Dim As decfloat x, y, z
  14. Dim As Long i, n
  15. n = 5
  16. Print "     x                y=sin(x)                                     asin(y)"
  17. For i = 1 To n
  18.     Call si2fp(x, i, NUMBER_OF_DIGITS)
  19.     Call fpdiv_si(x, x, n, NUMBER_OF_DIGITS)
  20.     Call fpsin(y, x, NUMBER_OF_DIGITS)
  21.     Call fpasin(z, y, NUMBER_OF_DIGITS)
  22.     Print fp2str(x, 10), fp2str(y, 30), fp2str(z, 30)
  23. Print "     x                y=cos(x)                                     acos(y)"
  24. For i = 1 To n
  25.     Call si2fp(x, i, NUMBER_OF_DIGITS)
  26.     Call fpdiv_si(x, x, n, NUMBER_OF_DIGITS)
  27.     Call fpcos(y, x, NUMBER_OF_DIGITS)
  28.     Call fpacos(z, y, NUMBER_OF_DIGITS)
  29.     Print fp2str(x, 10), fp2str(y, 30), fp2str(z, 30)
  30. Print "     x                y=tan(x)                                     atn(y)"
  31. For i = 1 To n
  32.     Call si2fp(x, i, NUMBER_OF_DIGITS)
  33.     Call fpdiv_si(x, x, n, NUMBER_OF_DIGITS)
  34.     Call fptan(y, x, NUMBER_OF_DIGITS)
  35.     Call fpatn(z, y, NUMBER_OF_DIGITS)
  36.     Print fp2str(x, 10), fp2str(y, 30), fp2str(z, 30)
  37.  
  38. ' end of your code
  39. ' you must include decfloat.bm
  40. '$include: 'decfloat.bm'
  41.  
output
Code: [Select]
     x                y=sin(x)                                     asin(y)
 0.2000000000       0.198669330795061215459412627118        0.199999999999999999999999999999
 0.4000000000       0.389418342308650491666311756795        0.399999999999999999999999999999
 0.6000000000       0.564642473395035357200945445658        0.600000000000000000000000000000
 0.8000000000       0.717356090899522761627174610581        0.799999999999999999999999999999
 1.000000000        0.841470984807896506652502321630        1.00000000000000000000000000000
     x                y=cos(x)                                     acos(y)
 0.2000000000       0.980066577841241631124196516748        0.199999999999999999999999999999
 0.4000000000       0.921060994002885082798526732051        0.399999999999999999999999999999
 0.6000000000       0.825335614909678297240952498955        0.599999999999999999999999999999
 0.8000000000       0.696706709347165420920749981642        0.800000000000000000000000000000
 1.000000000        0.540302305868139717400936607442        0.999999999999999999999999999999
     x                y=tan(x)                                     atn(y)
 0.2000000000       0.202710035508672483321358271647        0.199999999999999999999999999999
 0.4000000000       0.422793218738161761981635427165        0.399999999999999999999999999999
 0.6000000000       0.684136808341692317070925417463        0.600000000000000000000000000000
 0.8000000000       1.02963855705036401274636117282         0.799999999999999999999999999999
 1.000000000        1.55740772465490223050697480745         1.00000000000000000000000000000

Press any key to continue
« Last Edit: October 14, 2021, 06:44:15 am by jack »