ROBOT.LK

Posted: **Tue Dec 09, 2014 5:27 am**

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

ROBOT.LK

VB6 long multiplication overflow fix

VB6 long multiplication overflow fix