VB6 long multiplication overflow fix

Visual Basic Topics

VB6 long multiplication overflow fix

Postby Saman » Mon Dec 08, 2014 11:57 pm

You know that the good old VB6 has only 32-bit signed integer type. When you multiply two singled integers, the output could overflow signed range. Here is a good solution.

Code: Select all
Public Function uAdd(ByVal A As Long, ByVal B As Long) As Long
Dim lOr As Long, lAnd As Long, P As Long

lOr = (A Or B) And &HC0000000

If lOr Then 'it might overflow
   lAnd = (A And B) And &HC0000000
   P = (A And &H3FFFFFFF) + (B And &H3FFFFFFF)
   
   Select Case lAnd 'the last two bits common to both numbers
     Case 0&
       If (P And lOr) Then
         If lOr < 0 Then uAdd = (P And &H3FFFFFFF) Else uAdd = (P And &H3FFFFFFF) Or &H80000000
       Else
         uAdd = P Or lOr
       End If
     Case &H80000000: If (P And lOr) Then uAdd = (P And &H3FFFFFFF) Or &H80000000 Else uAdd = P Or (lOr And &H40000000)
     Case &H40000000: If (lOr < 0) Then uAdd = P Else uAdd = P Or &H80000000
     Case Else: uAdd = P Or &H80000000
   End Select
   
Else 'it won't overflow
   uAdd = A + B
End If
 
End Function




Public Function uMult(ByVal A As Long, ByVal B As Long) As Long
'Unsigned 32bit integer multiplication with signed 32bit numbers
'Returns a signed 32bit number as if it were unsigned.
'Will overflow without error

'It might look ugly, but it's much faster than converting Longs to Doubles and back (when compiled)

Dim A1 As Long, A2 As Long
Dim B1 As Long, B2 As Long
Dim P As Long, P2 As Long

  A1 = A And &H7FFF&
  B1 = B And &H7FFF&
  A2 = (A And &H3FFF8000) \ &H8000& 'quicker than... (A \ &h8000&) And &H7FFF&
  B2 = (B And &H3FFF8000) \ &H8000& 'quicker than... (A \ &h8000&) And &H7FFF&
 
  'multiply first 2 bits of A by last 2 bits of B
  Select Case B And &HC0000000
    Case 0&
    Case &H40000000
      Select Case A And 3&
        Case 0&:
        Case 1&: P = &H40000000
        Case 2&: P = &H80000000
        Case 3&: P = &HC0000000
      End Select
    Case &H80000000
      If A And 1& Then P = &H80000000
    Case Else
      Select Case A And 3&
        Case 0&:
        Case 1&: P = &HC0000000
        Case 2&: P = &H80000000
        Case 3&: P = &H40000000
      End Select
  End Select
 
  'multiply first 2 bits of B by last 2 bits of A
  Select Case A And &HC0000000
    Case 0&
    Case &H40000000
      Select Case B And 3&
        Case 0&                                                                          'P+0
        Case 1&: If P And &H40000000 Then P = P Xor &HC0000000 Else P = P Or &H40000000  'P+&H40000000
        Case 2&: P = P Xor &H80000000                                                    'P+&H80000000
        Case 3&: If P And &H40000000 Then P = P Xor &H40000000 Else P = P Xor &HC0000000 'P+&H40000000+&H80000000
      End Select
    Case &H80000000
      If B And 1& Then P = P Xor &H80000000                                             'P+&H80000000
    Case Else
      Select Case B And 3&
        Case 0&                                                                          'P+0
        Case 1&: If P And &H40000000 Then P = P Xor &H40000000 Else P = P Xor &HC0000000 'P+&H40000000+&H80000000
        Case 2&: P = P Xor &H80000000                                                    'P+&H80000000
        Case 3&: If P And &H40000000 Then P = P Xor &HC0000000 Else P = P Or &H40000000  'P+&H40000000
      End Select
  End Select
 
  'multiply bits 16 and 17 of A and B
  Select Case (A2 * B2) And &H3&
    Case 0&                                                                              'P+0
    Case 1&: If P And &H40000000 Then P = P Xor &HC0000000 Else P = P Or &H40000000      'P+&H40000000
    Case 2&: P = P Xor &H80000000                                                        'P+&H80000000
    Case Else: If P And &H40000000 Then P = P Xor &H40000000 Else P = P Xor &HC0000000   'P+&H40000000+&H80000000
  End Select
 
  'multiply first 15 bits of A and B
  P = (A1 * B1) Or P
 
  'multiply first 15 bits of A with bits 16 to 30 of B
  P2 = A1 * &H2&
  If P2 And &H10000 Then P2 = ((P2 And &HFFFF&) * &H8000&) Or &H80000000 Else P2 = (P2 And &HFFFF&) * &H8000&
  P = uAdd(P, P2)
 
  'multiply first 15 bits of B with bits 16 to 30 of A
  P2 = A2 * &H1&
  If P2 And &H10000 Then P2 = ((P2 And &HFFFF&) * &H8000&) Or &H80000000 Else P2 = (P2 And &HFFFF&) * &H8000&
  uMult = uAdd(P, P2)

End Function
User avatar
Saman
Support Team
Support Team
 
Posts: 816
Joined: Fri Jul 31, 2009 5:02 pm
Cash on hand: 152,553.20
Location: Mount Lavinia
Medals: 1
EC_Achievment (1)

Invitations sent: 44
Registered friends: 1
Reputation point: 37
Staff Sergeant

Return to Visual Basic Programming

Who is online

Users browsing this forum: No registered users and 2 guests

cron