PB/DLL Big Number Multiplication

[Ian Cairns]

'This was written in response to those who want to have results
' with greater than 18 significant digits. This is only a
' demonstration of the Multiplication algorithm.
'
' I make no claim for this code being optimized.
' It is good enough for every day use.
'
'The program assumes positive, non-unicode string representations of numbers,
' including decimals. If you want to multiply signed numbers, then it is a
' simple task to determine the sign of the result.

' Enjoy,
' Ian Cairns

#COMPILE EXE
#INCLUDE "Win32Api.Inc"
DECLARE FUNCTION BigMultiply(BYVAL value1 AS STRING, BYVAL value2 AS STRING) AS STRING
DECLARE SUB DecLeftFix(value AS LONG, carry AS LONG)
GLOBAL numOffset AS LONG
' This global represents the offsets of the ASCII numeric codes.
' This will not work under unicode. The purpose was to speed up the program
' by bypassing conversions from ASCII code to String Representation of
' the character to the actual numeric value (ie. VAL(CHR$(<pointer-to-byte> )) ).
FUNCTION PBMAIN
  STATIC Var1      AS STRING, _
         Var2      AS STRING, _
         VarResult AS STRING

  numOffset = 48 ' the digit 0 is at offset 48
  Var1 = "123456789.123456789"
  Var2 = "987654321.987654321"
  VarResult = BigMultiply(Var1, Var2)
  MSGBOX "Multiply: " + var1 + CHR$(13) + _
         "    With: " + var2 + CHR$(13) + _
         "  Equals: " + VarResult

END FUNCTION
'=========================================
FUNCTION BigMultiply(BYVAL value1 AS STRING, BYVAL value2 AS STRING) AS STRING
  LOCAL v1      AS LONG, _
        v2      AS LONG, _
        carry   AS LONG, _
        index   AS LONG, _
        maxPos  AS LONG, _
        v1Len   AS LONG, _
        v2Len   AS LONG, _
        v1Ptr   AS BYTE PTR, _
        v2Ptr   AS BYTE PTR, _
        v1Reset AS DWORD, _
        op1     AS LONG, _
        op2     AS LONG, _
        decimal AS LONG, _
        test    AS LONG, _
        result  AS STRING

  decimal = 0  ' assume no decimals
  test = INSTR(-1, value1, ".")
  IF test > 0 THEN
    decimal = LEN(value1) - test
    value1 = REMOVE$(value1, ".")
  END IF
  v1Ptr = STRPTR(value1)
  v1Len = LEN(value1)

  test = INSTR(-1, value2, ".")
  IF test > 0 THEN
    decimal = decimal + LEN(value2) - test
    value2 = REMOVE$(value2, ".")
  END IF
  v2Ptr = STRPTR(value2)
  v2Len = LEN(value2)

  IF v1Len > v2Len THEN ' It is faster to multiply the longer string by the shorter string
    SWAP v1Ptr, v2Ptr
    SWAP v1Len, v2Len
  END IF
  DIM cArray(1:v1Len + v2Len) AS LOCAL LONG ' Allow for the maximum length of the result
  maxPos = 1                                ' Allow for a shorter result than the length of the array
  v1Reset = v1Ptr           ' The pointer will be reset for every digit of the multiplying factor
  v2Ptr = v2Ptr + v2Len - 1 ' Start multiplication from the right side of the string.
  FOR v2 = 1 TO v2Len
    op2 = @v2Ptr - numOffset ' Alternative for: op2 = VAL(CHR$(@v2Ptr))
    DECR v2Ptr
    v1Ptr = v1Reset + v1Len - 1 ' Reset pointer for another pass.
    FOR v1 = 1 TO v1Len
      op1 = @v1Ptr - numOffset  ' Alternative for: op1 = VAL(CHR$(@v1Ptr))
      DECR v1Ptr ' Move from the right to the left
      op1 = op1 * op2
      index = v2 + v1 - 1 ' Watch for powers of 10
      maxPos = MAX&(maxPos, index)
      cArray(index) = cArray(index) + op1
    NEXT v1
  NEXT v2
' Fixup the carries and create a result string
  result = ""
  FOR index = 1 TO maxPos + 1 ' Allow for a carry!
    CALL CarryFixup(cArray(index), carry)
    result = FORMAT$(cArray(index) ) + result
    IF carry > 0 THEN cArray(index+1) = cArray(index+1) + carry
  NEXT i
  IF decimal > 0 THEN
    result = LEFT$(result, LEN(result) - decimal ) + "." + RIGHT$(result, decimal)
    result = RTRIM$(result, ANY "0.")
  END IF
  result = LTRIM$(result, "0")
  IF result = "" THEN result = "0"
  FUNCTION = result
END FUNCTION
'=========================================
SUB CarryFixup(value AS LONG, carry AS LONG)
  carry = 0
  IF value > 9 THEN
    carry = FIX(value/10)
    value = value - (carry * 10)
  END IF
END SUB
'=========================================

------------------
[email protected]