# Visual Basic > Visual Basic 6 and Earlier >  [RESOLVED] Trying to use "_allmul" but I need to detect overflows

## Elroy

I'd like to multiply two LongLongs (sitting in Currency types).  Here's what I'm doing (just in a Form1):



```

Option Explicit
'
Private Declare Function Int64Mult Lib "ntdll" Alias "_allmul" (ByVal cMultiplicand As Currency, ByVal cMultiplier As Currency) As Currency


Private Sub Form_Load()
    Dim ll1 As Currency
    Dim ll2 As Currency

    ll1 = 5000@
    ll2 = 0.001@ ' Actually 10 as a LongLong.

    Do
        ll1 = Int64Mult(ll1, ll2)
        Debug.Print ll1
        If MsgBox("paused", vbOKCancel) = vbCancel Then Exit Do
    Loop


    Unload Me
End Sub


```

This all works fine, up to a point.  The first 10 clicks show a correct number.  However, after that, it goes berserk.  Obviously (at least to me), what's happening is that it's overflowing and just tossing the overflow bits.  That's somewhat evident by (if you just keep clicking) how it randomly flips from positive to negative.

---------------

So, I just need to figure out how/when it overflows.  But I can't come up with a good way to test for this.

---------------

I could do this other ways, but I don't think any would be as fast as a call to _allmul.  

I could convert to Decimal types, do the multiplication, and then test for overflow.  

Or, I could convert to actual LongLong values into Variants, do the math, and then it'd error if it overflowed.  But I'm not sure that processing Variants would be as fast as directly operating on 64-bit numbers.

---------------

I feel like I'm overlooking something.  It seems there's got to be an easy way to see if _allmul overflowed (as 2s complement LongLong values being multiplied).

Ohh, and I checked Err.LastDllError, and there's nothing there.

----------


## VanGoghGaming

MSDN says that "_This routine is used only on x86 platforms_".
https://learn.microsoft.com/en-us/wi.../-win32-allmul

So this is not real 64-bit multiplication, it is simulated using 32-bit instructions and registers. There goes all the speed down the drain.

Also I remember reading somewhere that function names beginning with an underscore "_" means they are using the "cdecl" convention as a standard.

----------


## dz32

The utypes c library will probably do everything you need safely

https://github.com/dzzie/libs/blob/0...types.cpp#L150

There are class wrappers for each type

https://github.com/dzzie/libs/blob/0...ong64.cls#L270

----------


## The trick

You could test the values before multiplication. For example your multiplier is 10 then the maximum value you could multiply without an overflow equals to 922337203685477580. Alternatively you could using division to check the overflow.

----------


## wqweto

Here is how *_allmul* is (probably) implemented:



```
    __declspec(naked) void __cdecl _allmul()
    {
        #define A       esp + 8       // stack address of a
        #define B       esp + 16      // stack address of b

        __asm
        {
        push    ebx

        mov     eax,CRT_HIWORD(A)
        mov     ecx,CRT_LOWORD(B)
        mul     ecx             ;eax has AHI, ecx has BLO, so AHI * BLO
        mov     ebx,eax         ;save result

        mov     eax,CRT_LOWORD(A)
        mul     CRT_HIWORD(B)       ;ALO * BHI
        add     ebx,eax         ;ebx = ((ALO * BHI) + (AHI * BLO))

        mov     eax,CRT_LOWORD(A)   ;ecx = BLO
        mul     ecx             ;so edx:eax = ALO*BLO
        add     edx,ebx         ;now edx has all the LO*HI stuff

        pop     ebx

        ret     16              ; callee restores the stack
        }

        #undef A
        #undef B
    }
```

Here is what I use:



```
#If HasPtrSafe Then
Private LNG_POW2(0 To 63)           As LongLong
Private LNG_SIGN_BIT                As LongLong ' 2 ^ 63
Private LNG_UINT_MAX                As LongLong ' 2 ^ 32 - 1
#Else
Private LNG_POW2(0 To 63)           As Variant
Private LNG_SIGN_BIT                As Variant
Private LNG_UINT_MAX                As Variant
#End If

#If HasPtrSafe Then
Private Function UMul64(ByVal lX As LongLong, ByVal lY As LongLong) As LongLong
#Else
Private Function UMul64(lX As Variant, lY As Variant) As Variant
#End If
    UMul64 = (lX And &H7FFFFFFF) * (lY And LNG_UINT_MAX)
    If (lX And LNG_POW2(31)) <> 0 Then
        UMul64 = UAdd64(UMul64, (lX And LNG_POW2(31)) * (lY And LNG_UINT_MAX))
    End If
End Function

#If HasPtrSafe Then
Private Function UAdd64(ByVal lX As LongLong, ByVal lY As LongLong) As LongLong
#Else
Private Function UAdd64(lX As Variant, lY As Variant) As Variant
#End If
    If (lX Xor lY) >= 0 Then
        UAdd64 = ((lX Xor LNG_SIGN_BIT) + lY) Xor LNG_SIGN_BIT
    Else
        UAdd64 = lX + lY
    End If
End Function
```

Unfortunately this multiplies U32 * U32 to U64 only.

cheers,
</wqw>

----------


## Elroy

Just to say it, yeah, I'm acutely aware that VB6 is a 32-bit (x86) application (running in WoW).  And, as such, I doubt anything is going to give access to the 64-bit registers.  However, I'm suspecting that _allmul is still the fastest alternative available to VB6.

I'm eating breakfast, but I'll look at some of the suggestions shortly.   :Smilie:

----------


## The trick

> Just to say it, yeah, I'm acutely aware that VB6 is a 32-bit (x86) application (running in WoW).  And, as such, I doubt anything is going to give access to the 64-bit registers.  However, I'm suspecting that _allmul is still the fastest alternative available to VB6.
> 
> I'm eating breakfast, but I'll look at some of the suggestions shortly.


Is it applicable to use inline-asm? I could make a function which returns the overflow error. Also there is a way to do calculations in 64bit mode.

----------


## Elroy

> Is it applicable to use inline-asm? I could make a function which returns the overflow error. Also there is a way to do calculations in 64bit mode.


Sure Trick, I don't mind using a small thunk to get this done.  I was already thinking about that.  If you want to do it, I'd be fascinated to take a look at your work.  And, if you don't mind, if you do it, please give me ASM as well as machine code.

EDIT:  Or, I guess I can generate the ASM myself.   :Smilie:

----------


## VanGoghGaming

It would be interesting to check the speed over a million iterations or so but I would venture to say this "_allmul" isn't much faster than multiplying decimals contained in variants the old fashioned way.

These "ntdll" functions are notoriously slow as shown in this example: http://www.xbeat.net/vbspeed/c_ShiftLeft.htm

There you can see that even pure VB implementations of bit-shifting are much faster than "RtlLargeIntegerShiftLeft" and the ASM version wins hands down as it should.

----------


## Elroy

> It would be interesting to check the speed over a million iterations or so but I would venture to say this "_allmul" isn't much faster than multiplying decimals contained in variants the old fashioned way.


Oh gosh, that's hard to believe (but it is an empirical question).  But decimals aren't even 2s complement, and the bytes aren't even in an endianness order, so those have to be slow, and also done in pure software (with convoluted use of registers).

I'll probably create Variants with LongLongs in them (which VB6 can do) until I get a better alternative.

EDIT:  That's interesting about RtlLargeIntegerShiftLeft though (winding up the slowest of what's presented).  I might have to rework some of that.  That's only a Long shift though (on VbSpeed) and not a LongLong shift.

----------


## Elroy

Grrrr, LongLong multiplication (in a Variant) doesn't overflow either.



```

Option Explicit
Private Declare Function GetMem1 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function GetMem2 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function GetMem4 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function GetMem8 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.

Private Sub Form_Load()
    Dim ll1 As Currency
    Dim ll2 As Currency
    Dim ll3 As Currency

    ll1 = 922337203685477.5807@     ' &h7fffffffffffffff  Largest possible LongLong.
    ll2 = 4000@
    ll3 = Mult(ll1, ll2)

    Debug.Print "ll1: "; ll1
    Debug.Print "ll2: "; ll2
    Debug.Print "ll3: "; ll3        ' No overflow.  Grrrrr.  And it's smaller than ll1 !!!!!!

    Unload Me
    Exit Sub


End Sub



Function Mult(llMultiplicand As Currency, llMultiplier As Currency) As Currency
    Static v1 As Variant
    Static v2 As Variant
    Static v3 As Variant
    Const vbLongLong As Integer = 20
    GetMem2 vbLongLong, v1                          ' Make sure its a LongLong type.
    GetMem2 vbLongLong, v2                          ' Make sure its a LongLong type.
    GetMem8 llMultiplicand, ByVal VarPtr(v1) + 8&   ' Put LongLong sitting in Currency into our Variant.
    GetMem8 llMultiplier, ByVal VarPtr(v2) + 8&     ' Put LongLong sitting in Currency into our Variant.
    ' If the following errors, let it, and return zero.
    v3 = v1 * v2                                    ' Do our multiplication.  It will cast to a LongLong in the Variant.
    GetMem8 ByVal VarPtr(v3) + 8&, Mult             ' Put results into our return.
End Function


```

I guess I'll do it in a Decimal until I work out a better solution.

----------


## The trick

```
8B 44 24 10 83 7C 24 08 00 74 0E 85 C0 75 3B 8B
44 24 0C F7 64 24 08 EB 12 85 C0 75 0A 8B 44 24
04 F7 64 24 0C EB 16 F7 64 24 04 85 D2 75 1B 89
C1 8B 44 24 04 F7 64 24 0C 01 CA 72 0D 8B 4C 24
14 C7 01 00 00 00 00 C2 14 00 8B 4C 24 14 C7 01
01 00 00 00 C2 14 00
```



```
mul64:

    mov eax, [esp + 0x10]       ; bh

    cmp dword [esp + 0x08], 0   ; ah
    je .no_ah

    test eax, eax
    jnz .set_overflow

    mov eax, [esp + 0x0c]       ; bl
    mul dword [esp + 0x08]      ; bl * ah
    jmp .continue

  .no_ah:

    test eax, eax
    jnz .has_bh

    mov eax, [esp + 0x04]       ; al
    mul dword [esp + 0x0c]      ; bl
    jmp .remove_overflow

  .has_bh:

    mul dword [esp + 0x04]      ; bh * al

  .continue:

    test edx, edx
    jnz .set_overflow

    mov ecx, eax
    mov eax, [esp + 0x04]   ; al
    mul dword [esp + 0x0c]  ; bl
    add edx, ecx
    jc .set_overflow

.remove_overflow:
    mov ecx, [esp + 0x14]
    mov [ecx], dword 0
    ret 0x14

.set_overflow:
    mov ecx, [esp + 0x14]
    mov [ecx], dword 1
    ret 0x14
```



```
Private Declare Function mul64 Lib "mul64.dll" (ByVal a As Currency, ByVal b As Currency, ByRef bOverflow As Long) As Currency
```

----------


## Elroy

@The Trick:  Ahhh, you did it as a DLL.  I'll probably try to rework it as a thunk.  But hey, thanks a million.   :Smilie:  

It turns out that it does work when doing it as a Decimal:



```

Option Explicit

Dim mvPoint0001     As Variant
Dim mv10000         As Variant

Private Sub Form_Initialize()
    mv10000 = CDec(10000)
    mvPoint0001 = CDec(0.0001@)
End Sub

Private Sub Form_Load()
    Dim ll1 As Currency
    Dim ll2 As Currency
    Dim ll3 As Currency
    Dim e As Long

    ll1 = 922337203685477.5807@     ' &h7fffffffffffffff  Largest possible LongLong.
    ll2 = 0.0002@
    On Error Resume Next
        ll3 = Mult(ll1, ll2)
        e = Err.Number
    On Error GoTo 0

    Debug.Print "error: "; e
    Debug.Print "ll1: "; ll1
    Debug.Print "ll2: "; ll2
    Debug.Print "ll3: "; ll3



    ' Now try overflowing in negative direction.
    ll1 = -922337203685477.5807@
    ll1 = ll1 - 0.0001@             ' &h8000000000000000  Smallest possible LongLong.
    ll2 = 0.0002@
    On Error Resume Next
        ll3 = Mult(ll1, ll2)
        e = Err.Number
    On Error GoTo 0

    Debug.Print "error: "; e
    Debug.Print "ll1: "; ll1
    Debug.Print "ll2: "; ll2
    Debug.Print "ll3: "; ll3         

    Unload Me
    Exit Sub


End Sub

Function Mult(llMultiplicand As Currency, llMultiplier As Currency) As Currency
    Static v1 As Variant
    Static v2 As Variant
    v1 = CDec(llMultiplicand) * mv10000     ' Get into Decimal type.
    v2 = CDec(llMultiplier) * mv10000       ' Get into Decimal type.
    ' The following may overflow in two separate ways, both ok.
    ' The v1 * v2 may overflow the Decimal type or the CCur may be overflowed.
    ' Either way, the LongLong is being overflowed.
    ' And, either way, Mult stays ZERO, which is what we want.
    Mult = CCur(v1 * v2 * mvPoint0001)
End Function

```

But there's no way that's as fast as a call to your DLL or a thunk.

----------


## The trick

Another option with swithing to 64bit mode:



```
68 33 00 00 00 E8 00 00 00 00 83 04 24 07 FF 2C
24 48 8B 44 24 0C 48 F7 64 24 14 48 85 D2 75 2F
48 89 C2 48 C1 EA 20 8B 4C 24 1C 67 C7 01 00 00
00 00 E8 00 00 00 00 67 C7 44 24 04 23 00 00 00
67 83 04 24 12 67 FF 2C 24 83 C4 10 C2 14 00 8B
4C 24 1C 67 C7 01 01 00 00 00 EB D6
```



```
mul64:

    push dword 0x33
    call $ + 5
    add dword [esp], 7
    jmp far [esp]

    use64

    mov rax, [rsp + 0x0c]
    mul qword [rsp + 0x14]

    test rdx, rdx
    jne .set_overflow

    mov rdx, rax
    shr rdx, 32

    mov ecx, [rsp + 0x1c]
    mov [ecx], dword 0

  .exit:

    call $ + 5
    mov dword [esp + 4], 0x23
    add dword [esp], 0x12
    jmp far [esp]

    use32

    add esp, 0x10
    ret 0x14

    use64

  .set_overflow:

    mov ecx, [rsp + 0x1c]
    mov [ecx], dword 1
    jmp .exit
```

----------


## Elroy

:Smilie:  nice.

----------


## The trick

Performance test:


```
Option Explicit
Option Base 0

Private Const PAGE_EXECUTE_READWRITE As Long = &H40&
Private Const MEM_RESERVE            As Long = &H2000&
Private Const MEM_COMMIT             As Long = &H1000&
Private Const MEM_RELEASE            As Long = &H8000&

Private Const TOTAL_ELEMENTS         As Long = 4000000
Private Const TOTAL_REPEATS          As Long = 20

Private Declare Function allmul Lib "ntdll" _
                         Alias "_allmul" ( _
                         ByVal cMultiplicand As Currency, _
                         ByVal cMultiplier As Currency) As Currency
Private Declare Function VirtualAlloc Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flAllocationType As Long, _
                         ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal dwFreeType As Long) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
                         ByRef lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
                         ByRef lpFrequency As Currency) As Long
Private Declare Sub PutMem8 Lib "msvbvm60" ( _
                    ByRef pAddr As Any, _
                    ByVal cVal As Currency)

Private Sub cmdRun_Click()
    Dim cFreq       As Currency
    Dim cStart      As Currency
    Dim cEnd        As Currency
    Dim sResult     As String
    Dim cA()        As Currency
    Dim cB()        As Currency
    Dim cA_ref()    As Currency
    Dim cB_ref()    As Currency
    Dim cResult     As Currency
    Dim pThunk      As Long
    Dim lIndex      As Long
    Dim lPass       As Long
    Dim lOverflow   As Long
    
    QueryPerformanceFrequency cFreq
    
    PatchFunc AddressOf CallMul64
    InitMult
    
    ReDim cA_ref(TOTAL_ELEMENTS - 1)
    ReDim cB_ref(TOTAL_ELEMENTS - 1)
    
    For lIndex = 0 To TOTAL_ELEMENTS - 1
        cA_ref(lIndex) = Rnd * 123124
        cB_ref(lIndex) = Rnd * 123124
    Next
    
    pThunk = VirtualAlloc(0, 4096, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    If (pThunk = 0) Then
        Err.Raise 7
    End If
    
    PutMem8 ByVal pThunk + &H0, 58673075381837.9403@:    PutMem8 ByVal pThunk + &H8, -841400200908515.2256@
    PutMem8 ByVal pThunk + &H10, -151091765892270.3804@: PutMem8 ByVal pThunk + &H18, 261336656082321.5378@
    PutMem8 ByVal pThunk + &H20, -64206745947098.5468@:  PutMem8 ByVal pThunk + &H28, -856712431910701.3532@
    PutMem8 ByVal pThunk + &H30, 262249248019687.3153@:  PutMem8 ByVal pThunk + &H38, 261561837347209.2428@
    PutMem8 ByVal pThunk + &H40, -446757083035141.5532@: PutMem8 ByVal pThunk + &H48, 12809326053890.4596@
    PutMem8 ByVal pThunk + &H50, 2282345621.0945@:
    
    cA = cA_ref
    cB = cB_ref
    
    QueryPerformanceCounter cStart
    
    For lPass = 0 To TOTAL_REPEATS - 1
        For lIndex = 0 To TOTAL_ELEMENTS - 1
            cA(lIndex) = CallMul64(pThunk, cA(lIndex), cB(lIndex), lOverflow)
        Next
    Next
    
    QueryPerformanceCounter cEnd
    
    sResult = "mul64: " & Format$((cEnd - cStart) / cFreq, "0.00000") & "s" & vbNewLine
    
    PutMem8 ByVal pThunk + &H0, 25508669765.7192@:       PutMem8 ByVal pThunk + &H8, 324231810800595.7632@
    PutMem8 ByVal pThunk + &H10, -62823879810984.9564@:  PutMem8 ByVal pThunk + &H18, 341987096193952.266@
    PutMem8 ByVal pThunk + &H20, -842147318731253.1128@: PutMem8 ByVal pThunk + &H28, 195594001.7228@
    PutMem8 ByVal pThunk + &H30, 742193218592178.176@:   PutMem8 ByVal pThunk + &H38, 15039334.1127@
    PutMem8 ByVal pThunk + &H40, 324242358434139.4279@:  PutMem8 ByVal pThunk + &H48, -843071567870004.3484@
    PutMem8 ByVal pThunk + &H50, 28343091672.7884@:      PutMem8 ByVal pThunk + &H58, 360572.5184@
    
    cA = cA_ref
    cB = cB_ref
    
    QueryPerformanceCounter cStart
    
    For lPass = 0 To TOTAL_REPEATS - 1
        For lIndex = 0 To TOTAL_ELEMENTS - 1
            cA(lIndex) = CallMul64(pThunk, cA(lIndex), cB(lIndex), lOverflow)
        Next
    Next
    
    QueryPerformanceCounter cEnd
    
    VirtualFree pThunk, 0, MEM_RELEASE
    
    sResult = sResult & "mul64 (64bit): " & Format$((cEnd - cStart) / cFreq, "0.00000") & "s" & vbNewLine
    
'    cA = cA_ref
'    cB = cB_ref
'
'    On Error Resume Next
'
'    QueryPerformanceCounter cStart
'
'    For lPass = 0 To TOTAL_REPEATS - 1
'        For lIndex = 0 To TOTAL_ELEMENTS - 1
'            cResult = Mult(cA(lIndex), cB(lIndex))
'        Next
'    Next
'
'    QueryPerformanceCounter cEnd
'
'    sResult = sResult & "Mult: " & Format$((cEnd - cStart) / cFreq, "0.00000") & "s" & vbNewLine

    cA = cA_ref
    cB = cB_ref

    QueryPerformanceCounter cStart
    
    For lPass = 0 To TOTAL_REPEATS - 1
        For lIndex = 0 To TOTAL_ELEMENTS - 1
            cA(lIndex) = allmul(cA(lIndex), cB(lIndex))
        Next
    Next
    
    QueryPerformanceCounter cEnd
    
    sResult = sResult & "allmul: " & Format$((cEnd - cStart) / cFreq, "0.00000") & "s" & vbNewLine
    
    MsgBox sResult
    

End Sub
```



```
Option Explicit

' // https://www.vbforums.com/showthread.php?788413-VB6-Calling-functions-by-pointer&p=4942769&viewfull=1#post4942769

Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long
Private Declare Function VirtualProtect Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flNewProtect As Long, _
                         ByRef lpflOldProtect As Long) As Long
 
Private Const PAGE_EXECUTE_READWRITE = &H40

Dim mvPoint0001     As Variant
Dim mv10000         As Variant

' // Helpers functions
Public Sub PatchFunc(ByVal Addr As Long)
    Dim InIDE As Boolean
 
    Debug.Assert MakeTrue(InIDE)
 
    If InIDE Then
        GetMem4 ByVal Addr + &H16, Addr
    Else
        VirtualProtect Addr, 8, PAGE_EXECUTE_READWRITE, 0
    End If

    GetMem4 &HFF505958, ByVal Addr
    GetMem4 &HE1, ByVal Addr + 4
End Sub

Public Function CallMul64( _
                ByVal pfn As Long, _
                ByVal cA As Currency, _
                ByVal cB As Currency, _
                ByRef lOverflow As Long) As Currency
End Function

Public Function MakeTrue(ByRef bVar As Boolean) As Boolean
    bVar = True: MakeTrue = True
End Function

Public Sub InitMult()
    mv10000 = CDec(10000)
    mvPoint0001 = CDec(0.0001@)
End Sub

Public Function Mult(llMultiplicand As Currency, llMultiplier As Currency) As Currency
    Static v1 As Variant
    Static v2 As Variant
    v1 = CDec(llMultiplicand) * mv10000     ' Get into Decimal type.
    v2 = CDec(llMultiplier) * mv10000       ' Get into Decimal type.
    ' The following may overflow in two separate ways, both ok.
    ' The v1 * v2 may overflow the Decimal type or the CCur may be overflowed.
    ' Either way, the LongLong is being overflowed.
    ' And, either way, Mult stays ZERO, which is what we want.
    Mult = CCur(v1 * v2 * mvPoint0001)
End Function
```

I've excluded *Mult* because it's very slow.

----------


## Elroy

haha, ok ok, I'll swap my Mult out with yours.  Just give me a bit.   :Smilie:

----------


## Elroy

Trick, I'm testing your code, and I'm finding problems.  I've cut your code down to just be the thunk without *use64* .

Here's your cutdown *BAS module*:



```

Option Explicit

Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long
Private Declare Function VirtualProtect Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flNewProtect As Long, _
                         ByRef lpflOldProtect As Long) As Long

Private Const PAGE_EXECUTE_READWRITE = &H40


' // Helpers functions
Public Sub PatchFunc(ByVal Addr As Long)
    Dim InIDE As Boolean

    Debug.Assert MakeTrue(InIDE)

    If InIDE Then
        GetMem4 ByVal Addr + &H16, Addr
    Else
        VirtualProtect Addr, 8, PAGE_EXECUTE_READWRITE, 0
    End If

    GetMem4 &HFF505958, ByVal Addr
    GetMem4 &HE1, ByVal Addr + 4
End Sub

Public Function CallMul64( _
                ByVal pfn As Long, _
                ByVal cA As Currency, _
                ByVal cB As Currency, _
                ByRef lOverflow As Long) As Currency
End Function

Public Function MakeTrue(ByRef bVar As Boolean) As Boolean
    bVar = True: MakeTrue = True
End Function



```

And here's the *Form1* for testing:



```

Option Explicit
Option Base 0

Private Const PAGE_EXECUTE_READWRITE As Long = &H40&
Private Const MEM_RESERVE            As Long = &H2000&
Private Const MEM_COMMIT             As Long = &H1000&
Private Const MEM_RELEASE            As Long = &H8000&

Private Declare Function VirtualAlloc Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flAllocationType As Long, _
                         ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal dwFreeType As Long) As Long
Private Declare Sub PutMem8 Lib "msvbvm60" ( _
                    ByRef pAddr As Any, _
                    ByVal cVal As Currency)

Private Sub Form_Load()
    Dim pThunk      As Long

    PatchFunc AddressOf CallMul64

    pThunk = VirtualAlloc(0, 4096, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    If (pThunk = 0) Then
        Err.Raise 7
    End If

    PutMem8 ByVal pThunk + &H0, 58673075381837.9403@:    PutMem8 ByVal pThunk + &H8, -841400200908515.2256@
    PutMem8 ByVal pThunk + &H10, -151091765892270.3804@: PutMem8 ByVal pThunk + &H18, 261336656082321.5378@
    PutMem8 ByVal pThunk + &H20, -64206745947098.5468@:  PutMem8 ByVal pThunk + &H28, -856712431910701.3532@
    PutMem8 ByVal pThunk + &H30, 262249248019687.3153@:  PutMem8 ByVal pThunk + &H38, 261561837347209.2428@
    PutMem8 ByVal pThunk + &H40, -446757083035141.5532@: PutMem8 ByVal pThunk + &H48, 12809326053890.4596@
    PutMem8 ByVal pThunk + &H50, 2282345621.0945@:


    Dim lOverflow   As Long
    Dim cA          As Currency
    Dim cB          As Currency
    Dim cResult     As Currency

    ' Test and make sure it works.
    cA = 0.0005@
    cB = 0.0006@
    cResult = CallMul64(pThunk, cA, cB, lOverflow)
    Debug.Print cA, cB, cResult, lOverflow

    ' Now, show an anomaly.
    cA = -111716480418833.6608@
    cB = 0.0002@
    cResult = CallMul64(pThunk, cA, cB, lOverflow)
    Debug.Print cA, cB, cResult, lOverflow
    Debug.Print "Should be  -223432960837667.3216  which isn't an overflow."

    ' Another anomaly.
    cA = 249392271666.6979@
    cB = 0.4654@
    cResult = CallMul64(pThunk, cA, cB, lOverflow)
    Debug.Print cA, cB, cResult, lOverflow
    Debug.Print "Should have overflowed."



    VirtualFree pThunk, 0, MEM_RELEASE
    MsgBox "Done."
    Unload Me

End Sub



```

As you can see, there are some problems.   :Frown: 

FYI, I just did a perpetual Monte Carlo loop testing it against the Mult approach to find these problems.  If we get these problems knocked out, I'll start testing the edge conditions.   :Smilie:

----------


## The trick

Elroy, the code considers 64 bit integers as unsigned types like _allmul does. Should it consider them like signed?

----------


## Elroy

> Elroy, the code considers 64 bit integers as unsigned types like _allmul does. Should it consider them like signed?


Hi Trick.  Yes, I was hoping for a 2s complement version of all of this.

I might implement an unsigned later, but I'd like to get a signed version going first.   :Smilie: 

EDIT:  Actually, I thought _allmul considered them signed, and _aullmul did them unsigned.  But that doesn't really matter.

----------


## VanGoghGaming

> It turns out that it does work when doing it as a Decimal


In my opinion the "Decimal" type is only useful if you need to work with really big numbers (up to 96 bytes). All arithmetic operations work fine with them ("+","-","*","/", and the "Int" function). Integer division (\) and modulo ("Mod") don't work and need alternative implementations.

Since VB6 doesn't have a "BIG INTEGER" library for truly astronomical numbers, I had to manage with Decimals for my pure VB6 implementation of the "RSA" encryption algorithm. I managed to put together a functional prototype that generates Private/Public key pairs and encrypt/decrypt messages with them. This was purely for didactic purposes since anything even remotely useful in terms of "RSA" would need much larger numbers and the "Crypto API" provides a far more superior solution but I wanted to see if I understand how the algorithm works in a hands-on approach.

----------


## Elroy

Well, I fixed it (Trick's thunk), but I did it with a VB6 wrapper.  And it took a lot of the performance out of it.   :Frown: 

Trick's code for *BAS module*:


```
Option Explicit

' // https://www.vbforums.com/showthread.php?788413-VB6-Calling-functions-by-pointer&p=4942769&viewfull=1#post4942769

Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long
Private Declare Function VirtualProtect Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flNewProtect As Long, _
                         ByRef lpflOldProtect As Long) As Long
 
Private Const PAGE_EXECUTE_READWRITE = &H40

Dim mvPoint0001     As Variant
Dim mv10000         As Variant

' // Helpers functions
Public Sub PatchFunc(ByVal Addr As Long)
    Dim InIDE As Boolean
 
    Debug.Assert MakeTrue(InIDE)
 
    If InIDE Then
        GetMem4 ByVal Addr + &H16, Addr
    Else
        VirtualProtect Addr, 8, PAGE_EXECUTE_READWRITE, 0
    End If

    GetMem4 &HFF505958, ByVal Addr
    GetMem4 &HE1, ByVal Addr + 4
End Sub

Public Function CallMul64( _
                ByVal pfn As Long, _
                ByVal cA As Currency, _
                ByVal cB As Currency, _
                ByRef lOverflow As Long) As Currency
End Function

Public Function MakeTrue(ByRef bVar As Boolean) As Boolean
    bVar = True: MakeTrue = True
End Function

Public Sub InitMult()
    mv10000 = CDec(10000)
    mvPoint0001 = CDec(0.0001@)
End Sub

Public Function Mult(llMultiplicand As Currency, llMultiplier As Currency) As Currency
    Static v1 As Variant
    Static v2 As Variant
    v1 = CDec(llMultiplicand) * mv10000     ' Get into Decimal type.
    v2 = CDec(llMultiplier) * mv10000       ' Get into Decimal type.
    ' The following may overflow in two separate ways, both ok.
    ' The v1 * v2 may overflow the Decimal type or the CCur may be overflowed.
    ' Either way, the LongLong is being overflowed.
    ' And, either way, Mult stays ZERO, which is what we want.
    Mult = CCur(v1 * v2 * mvPoint0001)
End Function
```

Trick's modified code for performance test (just of the thunk operating in use32 mode), with my wrapper (*in Form1*):


```
Option Explicit
Option Base 0

Private Const PAGE_EXECUTE_READWRITE As Long = &H40&
Private Const MEM_RESERVE            As Long = &H2000&
Private Const MEM_COMMIT             As Long = &H1000&
Private Const MEM_RELEASE            As Long = &H8000&

Private Const TOTAL_ELEMENTS         As Long = 4000000
Private Const TOTAL_REPEATS          As Long = 5

Private Declare Function allmul Lib "ntdll" _
                         Alias "_allmul" ( _
                         ByVal cMultiplicand As Currency, _
                         ByVal cMultiplier As Currency) As Currency
Private Declare Function VirtualAlloc Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flAllocationType As Long, _
                         ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal dwFreeType As Long) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
                         ByRef lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
                         ByRef lpFrequency As Currency) As Long
Private Declare Sub PutMem8 Lib "msvbvm60" ( _
                    ByRef pAddr As Any, _
                    ByVal cVal As Currency)

Private Sub Form_Load()
    Dim cFreq       As Currency
    Dim cStart      As Currency
    Dim cEnd        As Currency
    Dim sResult     As String
    Dim cA()        As Currency
    Dim cB()        As Currency
    Dim cA_ref()    As Currency
    Dim cB_ref()    As Currency
    Dim cResult     As Currency
    Dim pThunk      As Long
    Dim lIndex      As Long
    Dim lPass       As Long
    Dim lOverflow   As Long
    
    QueryPerformanceFrequency cFreq
    
    PatchFunc AddressOf CallMul64
    InitMult
    
    ReDim cA_ref(TOTAL_ELEMENTS - 1)
    ReDim cB_ref(TOTAL_ELEMENTS - 1)
    
    For lIndex = 0 To TOTAL_ELEMENTS - 1
        cA_ref(lIndex) = Rnd * 123124
        cB_ref(lIndex) = Rnd * 123124
    Next
    
    pThunk = VirtualAlloc(0, 4096, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    If (pThunk = 0) Then
        Err.Raise 7
    End If
    
    PutMem8 ByVal pThunk + &H0, 58673075381837.9403@:    PutMem8 ByVal pThunk + &H8, -841400200908515.2256@
    PutMem8 ByVal pThunk + &H10, -151091765892270.3804@: PutMem8 ByVal pThunk + &H18, 261336656082321.5378@
    PutMem8 ByVal pThunk + &H20, -64206745947098.5468@:  PutMem8 ByVal pThunk + &H28, -856712431910701.3532@
    PutMem8 ByVal pThunk + &H30, 262249248019687.3153@:  PutMem8 ByVal pThunk + &H38, 261561837347209.2428@
    PutMem8 ByVal pThunk + &H40, -446757083035141.5532@: PutMem8 ByVal pThunk + &H48, 12809326053890.4596@
    PutMem8 ByVal pThunk + &H50, 2282345621.0945@:
    
    
    
    cA = cA_ref
    cB = cB_ref
    '
    QueryPerformanceCounter cStart
    '
    For lPass = 0 To TOTAL_REPEATS - 1
        For lIndex = 0 To TOTAL_ELEMENTS - 1
            cA(lIndex) = CallMul64(pThunk, cA(lIndex), cB(lIndex), lOverflow)
        Next
    Next
    '
    QueryPerformanceCounter cEnd
    sResult = sResult & "mul64 (wo wrapper): " & Format$((cEnd - cStart) / cFreq, "0.00000") & "s" & vbNewLine
    
    
    
    cA = cA_ref
    cB = cB_ref
    '
    QueryPerformanceCounter cStart
    '
    For lPass = 0 To TOTAL_REPEATS - 1
        For lIndex = 0 To TOTAL_ELEMENTS - 1
            cA(lIndex) = MultThunk(pThunk, cA(lIndex), cB(lIndex), lOverflow)
        Next
    Next
    '
    QueryPerformanceCounter cEnd
    sResult = sResult & "mul64 (w   wrapper): " & Format$((cEnd - cStart) / cFreq, "0.00000") & "s" & vbNewLine
    
    
    
    VirtualFree pThunk, 0, MEM_RELEASE
    MsgBox sResult
    
    Unload Me

End Sub

' WRAPPER TO MAKE IT 2s COMPLEMENT.
Friend Function MultThunk( _
                ByVal pThunk As Long, _
                ByVal cA As Currency, _
                ByVal cB As Currency, _
                lOverflow As Long) As Currency
    '
    If cA = 0.0001@ Then MultThunk = cB: Exit Function      ' These two solve the problem of a &h8000000000000000 coming in as either one,
    If cB = 0.0001@ Then MultThunk = cA: Exit Function      ' as this can't be negated, but it can be multiplied by 1 without overflow.
    '
    Dim iSignA As Integer
    Dim iSignB As Integer
    iSignA = Sgn(cA)                                        ' Save sign of multiplicand.
    iSignB = Sgn(cB)                                        ' Save sign of multiplier.
    If iSignA = -1 Then cA = -cA                            ' Force positive.
    If iSignB = -1 Then cB = -cB                            ' Force positive.
    '
    MultThunk = CallMul64(pThunk, cA, cB, lOverflow)        ' Call thunk.
    '
    If MultThunk < 0@ Then lOverflow = 1&                   ' If we went negative, same as an overflow.
    If iSignA * iSignB = -1 Then MultThunk = -MultThunk     ' Make sure sign of multiplication is correct.
End Function
```

And here are the results:



As we can see, the wrapper makes it over 5 times slower.   :Frown: 

I'll continue working on this.

----------


## Elroy

I added my existing (using Decimal_Variant approach), and even with the wrapper, the thunk is still over twice as fast:



So, before I change it, I'll work on the thunk, or keep doing my rain-dance hoping The Trick will do it.   :Stick Out Tongue:   haha, nahhh, I'll eventually tackle it.

----------


## The trick

I'm preparing for the new year today. I'll do the example later.

----------


## Elroy

> I'm preparing for the new year today. I'll do the example later.


Hey Trick, I just appreciate all you do.  No worries and no hurry.   :Smilie:   Even if you never get it done, it's all good.

You have a WONDERFUL and HAPPY NEW YEAR!!!

----------


## The trick

I don't test it enough. Happy New Year!


```
imul64:

    push ebx

    xor ebx, ebx

    mov eax, [esp + 0x0c]       ; ah
    bt eax, 31
    jnc .check_b

    xor ecx, ecx
    neg dword [esp + 0x08]      ; - al
    sbb ecx, [esp + 0x0c]
    mov [esp + 0x0c], ecx
    inc ebx

  .check_b:

    mov eax, [esp + 0x14]       ; bh
    bt eax, 31
    jnc .mul_start

    xor ecx, ecx
    neg dword [esp + 0x10]      ; - bl
    sbb ecx, [esp + 0x14]
    mov [esp + 0x14], ecx
    inc ebx

    mov eax, ecx

  .mul_start:

    cmp dword [esp + 0x0c], 0   ; ah
    je .no_ah

    test eax, eax
    jnz .set_overflow

    mov eax, [esp + 0x10]       ; bl
    mul dword [esp + 0x0c]      ; bl * ah
    jmp .continue

  .no_ah:

    test eax, eax
    jnz .has_bh

    mov eax, [esp + 0x08]       ; al
    mul dword [esp + 0x10]      ; bl
    jmp .check_negate

  .has_bh:

    mul dword [esp + 0x08]      ; bh * al

  .continue:

    jc .set_overflow

    mov ecx, eax
    mov eax, [esp + 0x08]   ; al
    mul dword [esp + 0x10]  ; bl
    add edx, ecx
    jc .set_overflow

  .check_negate:
    jns .process_negate

    test eax, eax
    jnz .set_overflow
    cmp edx, 0x80000000
    jnz .set_overflow

    test bl, 1
    jnz .negate_result
    jmp .set_overflow

  .process_negate:

    test bl, 1
    jz .remove_overflow

  .negate_result:

    xor ecx, ecx
    xchg ecx, edx
    neg eax
    sbb edx, ecx

.remove_overflow:
    mov ecx, [esp + 0x18]
    mov [ecx], dword 0
    pop ebx
    ret 0x14

.set_overflow:
    mov ecx, [esp + 0x18]
    mov [ecx], dword 1
    pop ebx
    ret 0x14
```



```
53 31 DB 8B 44 24 0C 0F BA E0 1F 73 0F 31 C9 F7
5C 24 08 1B 4C 24 0C 89 4C 24 0C 43 8B 44 24 14
0F BA E0 1F 73 11 31 C9 F7 5C 24 10 1B 4C 24 14
89 4C 24 14 43 89 C8 83 7C 24 0C 00 74 0E 85 C0
75 5C 8B 44 24 10 F7 64 24 0C EB 12 85 C0 75 0A
8B 44 24 08 F7 64 24 10 EB 14 F7 64 24 08 72 3E
89 C1 8B 44 24 08 F7 64 24 10 01 CA 72 30 79 13
85 C0 75 2A 81 FA 00 00 00 80 75 22 F6 C3 01 75
07 EB 1B F6 C3 01 74 08 31 C9 87 CA F7 D8 19 CA
8B 4C 24 18 C7 01 00 00 00 00 5B C2 14 00 8B 4C
24 18 C7 01 01 00 00 00 5B C2 14 00
```




> ---------------------------
> Test64BitMul
> ---------------------------
> mul64: 1,07577s
> 
> mul64 (64bit): 4,01637s
> 
> imul64: 1,19007s
> 
> ...

----------


## georgekar

Today I am babysitting my Grandchildren, so I am writing from my phone.
The clever way to check overflow is to use varisnts as long long and check the type of result, if it isn't long long you raise error 6.
Keep on mind that you have to multiply two long long values, and only for this type the multiplication may produce negative number  from two positive, because actually return result as unsigned long long for bits but in a container which we mark as signed long long. I didn't try yet the 21 type, the original unsigned long long.

----------


## Elroy

> I don't test it enough. Happy New Year!
> 
> 
> ```
> imul64:
> 
>     push ebx
> 
>     xor ebx, ebx
> ...


Trick, you're the greatest!

You have a magnificent New Year as well.   :Smilie: 

I'll test it thoroughly and report back.

----------


## Elroy

@The Trick:  The thunk looks good.  I've just done preliminary "edge" testing, but no failures.  I'll set up a Monte Carlo test (against Decimal approach) later today and let it run for a while.

*Code for BAS module* (for this test):


```

Option Explicit

Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long
Private Declare Function VirtualProtect Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flNewProtect As Long, _
                         ByRef lpflOldProtect As Long) As Long

Private Const PAGE_EXECUTE_READWRITE = &H40


' // Helpers functions
Public Sub PatchFunc(ByVal Addr As Long)
    Dim InIDE As Boolean

    Debug.Assert MakeTrue(InIDE)

    If InIDE Then
        GetMem4 ByVal Addr + &H16, Addr
    Else
        VirtualProtect Addr, 8, PAGE_EXECUTE_READWRITE, 0
    End If

    GetMem4 &HFF505958, ByVal Addr
    GetMem4 &HE1, ByVal Addr + 4
End Sub

Public Function CallMul64( _
                ByVal pfn As Long, _
                ByVal cA As Currency, _
                ByVal cB As Currency, _
                ByRef lOverflow As Long) As Currency
End Function

Public Function MakeTrue(ByRef bVar As Boolean) As Boolean
    bVar = True: MakeTrue = True
End Function


```

*Code for Form1* (for this test):


```

Option Explicit

Private Const PAGE_EXECUTE_READWRITE As Long = &H40&
Private Const MEM_RESERVE            As Long = &H2000&
Private Const MEM_COMMIT             As Long = &H1000&
Private Const MEM_RELEASE            As Long = &H8000&

Private Declare Function VirtualAlloc Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flAllocationType As Long, _
                         ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal dwFreeType As Long) As Long
Private Declare Sub PutMem8 Lib "msvbvm60" ( _
                    ByRef pAddr As Any, _
                    ByVal cVal As Currency)

Private Sub Form_Load()
    Dim pThunk      As Long

    PatchFunc AddressOf CallMul64

    pThunk = VirtualAlloc(0, 4096, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    If (pThunk = 0) Then
        Err.Raise 7
    End If

    ' Signed (2s complement) code (from The Trick).
    PutMem8 ByVal pThunk + &H0, 108428148711222.1011@:      PutMem8 ByVal pThunk + &H8, -59188793359677.0118@
    PutMem8 ByVal pThunk + &H10, -857143608150326.3652@:    PutMem8 ByVal pThunk + &H18, 145136034483615.4444@
    PutMem8 ByVal pThunk + &H20, -394935621207348.1713@:    PutMem8 ByVal pThunk + &H28, 145136865903878.8855@
    PutMem8 ByVal pThunk + &H30, -895075333820512.3447@:    PutMem8 ByVal pThunk + &H38, -457423395514507.9684@
    PutMem8 ByVal pThunk + &H40, 727530147099517.6565@:     PutMem8 ByVal pThunk + &H48, 75372019043500.3428@
    PutMem8 ByVal pThunk + &H50, 116316561592472.4875@:     PutMem8 ByVal pThunk + &H58, 449966793010230.6027@
    PutMem8 ByVal pThunk + &H60, 727529267490218.0233@:     PutMem8 ByVal pThunk + &H68, 140320602847609.2452@
    PutMem8 ByVal pThunk + &H70, 27543267008.5253@:         PutMem8 ByVal pThunk + &H78, 843123543932177.6128@
    PutMem8 ByVal pThunk + &H80, 60911379076113.4855@:      PutMem8 ByVal pThunk + &H88, -388383464486392.3919@
    PutMem8 ByVal pThunk + &H90, 195461515.1755@:           PutMem8 ByVal pThunk + &H98, 551550225780539.392@
    PutMem8 ByVal pThunk + &HA0, 432479.2356@:              PutMem8 ByVal pThunk + &HA8, 136.0475@


    ' Unsigned code (from The Trick).
    'PutMem8 ByVal pThunk + &H0, 58673075381837.9403@:    PutMem8 ByVal pThunk + &H8, -841400200908515.2256@
    'PutMem8 ByVal pThunk + &H10, -151091765892270.3804@: PutMem8 ByVal pThunk + &H18, 261336656082321.5378@
    'PutMem8 ByVal pThunk + &H20, -64206745947098.5468@:  PutMem8 ByVal pThunk + &H28, -856712431910701.3532@
    'PutMem8 ByVal pThunk + &H30, 262249248019687.3153@:  PutMem8 ByVal pThunk + &H38, 261561837347209.2428@
    'PutMem8 ByVal pThunk + &H40, -446757083035141.5532@: PutMem8 ByVal pThunk + &H48, 12809326053890.4596@
    'PutMem8 ByVal pThunk + &H50, 2282345621.0945@:


    Dim lOverflow   As Long
    Dim cA          As Currency
    Dim cB          As Currency
    Dim cResult     As Currency
    Dim bShouldOverflow As Boolean

    ' Test and make sure it works.
    cA = 0.0005@
    cB = 0.0006@
    cResult = CallMul64(pThunk, cA, cB, lOverflow)
    If cResult <> 0.003@ Then Debug.Print "Big problem": Stop

    ' Anomaly when trying to use non-2s complement to do 2s complement.
    cA = -111716480418833.6608@:        cB = 0.0002@:                   bShouldOverflow = False: GoSub DoAndTest
    cB = -111716480418833.6608@:        cA = 0.0002@:                   bShouldOverflow = False: GoSub DoAndTest

    ' Anomaly when trying to use non-2s complement to do 2s complement.
    cA = 249392271666.6979@:            cB = 0.4654@:                   bShouldOverflow = True: GoSub DoAndTest
    cB = 249392271666.6979@:            cA = 0.4654@:                   bShouldOverflow = True: GoSub DoAndTest

    ' Some edge conditions.

    ' 2 * largest neg, should overflow.
    cA = 0.0002@:       cB = -922337203685477.5807@ - 0.0001@:          bShouldOverflow = True: GoSub DoAndTest
    cB = 0.0002@:       cA = -922337203685477.5807@ - 0.0001@:          bShouldOverflow = True: GoSub DoAndTest

    ' 2 * largest pos, should overflow.
    cA = 0.0002@:               cB = 922337203685477.5807@:             bShouldOverflow = True: GoSub DoAndTest
    cB = 0.0002@:               cA = 922337203685477.5807@:             bShouldOverflow = True: GoSub DoAndTest

    ' 1/2 largest negative, shouldn't overflow.
    cA = 0.0002@:               cB = -461168601842738.7904@:            bShouldOverflow = False: GoSub DoAndTest
    cB = 0.0002@:               cA = -461168601842738.7904@:            bShouldOverflow = False: GoSub DoAndTest

    ' 1/2 largest negative-1, should overflow.
    cA = 0.0002@:               cB = -461168601842738.7905@:            bShouldOverflow = True: GoSub DoAndTest
    cB = 0.0002@:               cA = -461168601842738.7905@:            bShouldOverflow = True: GoSub DoAndTest

    ' 1/2 largest positive (rounded up), should overflow.
    cA = 0.0002@:               cB = 461168601842738.7904@:             bShouldOverflow = True: GoSub DoAndTest
    cB = 0.0002@:               cA = 461168601842738.7904@:             bShouldOverflow = True: GoSub DoAndTest

    ' 1/2 largest positive (rounded down), shouldn't overflow.
    cA = 0.0002@:               cB = 461168601842738.7903@:             bShouldOverflow = False: GoSub DoAndTest
    cB = 0.0002@:               cA = 461168601842738.7903@:             bShouldOverflow = False: GoSub DoAndTest


    VirtualFree pThunk, 0, MEM_RELEASE
    MsgBox "Done."
    Unload Me
    Exit Sub


DoAndTest:

    cResult = CallMul64(pThunk, cA, cB, lOverflow)
    If lOverflow And Not bShouldOverflow Then
        Debug.Print "**** Problem ****"
        Debug.Print "", "Should overflow: "; bShouldOverflow
        Debug.Print "", cA, cB, cResult, lOverflow
    Else
        Debug.Print "**** Seems ok: "; cA; " * "; cB; " = "; cResult; "  Overflow: "; lOverflow
    End If
    Return

End Sub


```

----------


## Elroy

And here's the addition of a Monte Carlo test, which didn't show any problems on a couple of runs.

*Code for BAS module* (for this test).  Same as above:


```

Option Explicit

Private Declare Function GetMem4 Lib "msvbvm60" ( _
                         ByRef src As Any, _
                         ByRef dst As Any) As Long
Private Declare Function VirtualProtect Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flNewProtect As Long, _
                         ByRef lpflOldProtect As Long) As Long

Private Const PAGE_EXECUTE_READWRITE = &H40


' // Helpers functions
Public Sub PatchFunc(ByVal Addr As Long)
    Dim InIDE As Boolean

    Debug.Assert MakeTrue(InIDE)

    If InIDE Then
        GetMem4 ByVal Addr + &H16, Addr
    Else
        VirtualProtect Addr, 8, PAGE_EXECUTE_READWRITE, 0
    End If

    GetMem4 &HFF505958, ByVal Addr
    GetMem4 &HE1, ByVal Addr + 4
End Sub

Public Function CallMul64( _
                ByVal pfn As Long, _
                ByVal cA As Currency, _
                ByVal cB As Currency, _
                ByRef lOverflow As Long) As Currency
End Function

Public Function MakeTrue(ByRef bVar As Boolean) As Boolean
    bVar = True: MakeTrue = True
End Function





```

*Code for Form1* with Monte Carlo test in it:


```

Option Explicit

Private Const PAGE_EXECUTE_READWRITE As Long = &H40&
Private Const MEM_RESERVE            As Long = &H2000&
Private Const MEM_COMMIT             As Long = &H1000&
Private Const MEM_RELEASE            As Long = &H8000&

Private Declare Function VirtualAlloc Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flAllocationType As Long, _
                         ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal dwFreeType As Long) As Long
Private Declare Sub PutMem8 Lib "msvbvm60" ( _
                    ByRef pAddr As Any, _
                    ByVal cVal As Currency)

Private Declare Function CryptAcquireContextW Lib "advapi32.dll" (hProv As Long, ByVal pszContainer As Long, ByVal pszProvider As Long, ByVal dwProvType As Long, ByVal dwFlags As Long) As Boolean
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwlen As Long, ByRef pbBuffer As Any) As Boolean
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetMem1 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function GetMem2 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function GetMem4 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function GetMem8 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.

Dim mv10000         As Variant
Dim mvPoint0001     As Variant
Dim mvOne           As Variant
Dim mvHex100000000000000    As Variant
Dim mvHex1000000000000      As Variant
Dim mvHex10000000000        As Variant
Dim mvHex100000000          As Variant
Dim mvHex1000000            As Variant
Dim mvHex10000              As Variant
Dim mvHex100                As Variant
'
Dim mhCrypt         As Long


Private Sub Form_Initialize()
    mv10000 = CDec(10000)
    mvPoint0001 = CDec(0.0001@)
    mvOne = CDec(1)
    mvHex100000000000000 = CDec("72057594037927936")    ' This one must be a string to preserve precision.
    mvHex1000000000000 = CDec(281474976710656#)         ' Double has adequate precision.
    mvHex10000000000 = CDec(1099511627776#)             ' Double has adequate precision.
    mvHex100000000 = CDec(4294967296#)                  ' Double has adequate precision.
    mvHex1000000 = CDec(16777216)                       ' Long has adequate precision.
    mvHex10000 = CDec(65536)                            ' Long has adequate precision.
    mvHex100 = CDec(256)                                ' Integer has adequate precision.
End Sub
Private Sub Form_Terminate()
    If mhCrypt Then
        Call CryptReleaseContext(mhCrypt, 0&)       ' Turn off advapi32.
        mhCrypt = 0&
    End If
End Sub



Private Sub Form_Load()
    Dim pThunk      As Long

    PatchFunc AddressOf CallMul64

    pThunk = VirtualAlloc(0, 4096, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    If (pThunk = 0) Then
        Err.Raise 7
    End If

    ' Signed (2s complement) code (from The Trick).
    PutMem8 ByVal pThunk + &H0, 108428148711222.1011@:      PutMem8 ByVal pThunk + &H8, -59188793359677.0118@
    PutMem8 ByVal pThunk + &H10, -857143608150326.3652@:    PutMem8 ByVal pThunk + &H18, 145136034483615.4444@
    PutMem8 ByVal pThunk + &H20, -394935621207348.1713@:    PutMem8 ByVal pThunk + &H28, 145136865903878.8855@
    PutMem8 ByVal pThunk + &H30, -895075333820512.3447@:    PutMem8 ByVal pThunk + &H38, -457423395514507.9684@
    PutMem8 ByVal pThunk + &H40, 727530147099517.6565@:     PutMem8 ByVal pThunk + &H48, 75372019043500.3428@
    PutMem8 ByVal pThunk + &H50, 116316561592472.4875@:     PutMem8 ByVal pThunk + &H58, 449966793010230.6027@
    PutMem8 ByVal pThunk + &H60, 727529267490218.0233@:     PutMem8 ByVal pThunk + &H68, 140320602847609.2452@
    PutMem8 ByVal pThunk + &H70, 27543267008.5253@:         PutMem8 ByVal pThunk + &H78, 843123543932177.6128@
    PutMem8 ByVal pThunk + &H80, 60911379076113.4855@:      PutMem8 ByVal pThunk + &H88, -388383464486392.3919@
    PutMem8 ByVal pThunk + &H90, 195461515.1755@:           PutMem8 ByVal pThunk + &H98, 551550225780539.392@
    PutMem8 ByVal pThunk + &HA0, 432479.2356@:              PutMem8 ByVal pThunk + &HA8, 136.0475@


    ' Unsigned code (from The Trick).
    'PutMem8 ByVal pThunk + &H0, 58673075381837.9403@:    PutMem8 ByVal pThunk + &H8, -841400200908515.2256@
    'PutMem8 ByVal pThunk + &H10, -151091765892270.3804@: PutMem8 ByVal pThunk + &H18, 261336656082321.5378@
    'PutMem8 ByVal pThunk + &H20, -64206745947098.5468@:  PutMem8 ByVal pThunk + &H28, -856712431910701.3532@
    'PutMem8 ByVal pThunk + &H30, 262249248019687.3153@:  PutMem8 ByVal pThunk + &H38, 261561837347209.2428@
    'PutMem8 ByVal pThunk + &H40, -446757083035141.5532@: PutMem8 ByVal pThunk + &H48, 12809326053890.4596@
    'PutMem8 ByVal pThunk + &H50, 2282345621.0945@:


    Dim lOverflow   As Long
    Dim cA          As Currency
    Dim cB          As Currency
    Dim cResult     As Currency

    ' Test and make sure it works.
    cA = 0.0005@
    cB = 0.0006@
    cResult = CallMul64(pThunk, cA, cB, lOverflow)
    If cResult <> 0.003@ Then Debug.Print "Big problem": Stop

    ' Anomaly when trying to use non-2s complement to do 2s complement.
    cA = -111716480418833.6608@:        cB = 0.0002@:                   GoSub DoAndTest
    cB = -111716480418833.6608@:        cA = 0.0002@:                   GoSub DoAndTest

    ' Anomaly when trying to use non-2s complement to do 2s complement.
    cA = 249392271666.6979@:            cB = 0.4654@:                   GoSub DoAndTest
    cB = 249392271666.6979@:            cA = 0.4654@:                   GoSub DoAndTest

    ' Some edge conditions.

    ' 2 * largest neg, should overflow.
    cA = 0.0002@:       cB = -922337203685477.5807@ - 0.0001@:          GoSub DoAndTest
    cB = 0.0002@:       cA = -922337203685477.5807@ - 0.0001@:          GoSub DoAndTest

    ' 2 * largest pos, should overflow.
    cA = 0.0002@:               cB = 922337203685477.5807@:             GoSub DoAndTest
    cB = 0.0002@:               cA = 922337203685477.5807@:             GoSub DoAndTest

    ' 1/2 largest negative, shouldn't overflow.
    cA = 0.0002@:               cB = -461168601842738.7904@:            GoSub DoAndTest
    cB = 0.0002@:               cA = -461168601842738.7904@:            GoSub DoAndTest

    ' 1/2 largest negative-1, should overflow.
    cA = 0.0002@:               cB = -461168601842738.7905@:            GoSub DoAndTest
    cB = 0.0002@:               cA = -461168601842738.7905@:            GoSub DoAndTest

    ' 1/2 largest positive (rounded up), should overflow.
    cA = 0.0002@:               cB = 461168601842738.7904@:             GoSub DoAndTest
    cB = 0.0002@:               cA = 461168601842738.7904@:             GoSub DoAndTest

    ' 1/2 largest positive (rounded down), shouldn't overflow.
    cA = 0.0002@:               cB = 461168601842738.7903@:             GoSub DoAndTest
    cB = 0.0002@:               cA = 461168601842738.7903@:             GoSub DoAndTest



    Dim i As Long
    For i = 0 To 200000
        cA = Random(-922337203685477.5807@ - 0.0001@)   ' Full LongLong range.
        cB = Random(0@, 0.0101@)                        ' Small range so it doesn't overflow almost everytime.
        GoSub DoAndTest
    Next


    VirtualFree pThunk, 0, MEM_RELEASE
    MsgBox "Done."
    Unload Me
    Exit Sub


DoAndTest:

    cResult = CallMul64(pThunk, cA, cB, lOverflow)
    Dim cResultMult As Currency
    Dim e As Long
    On Error Resume Next
        cResultMult = Mult(cA, cB)
        e = Err.Number
    On Error GoTo 0


    If (lOverflow And e = 0&) Or (lOverflow = 0& And e) Or (lOverflow = 0& And e = 0& And cResult <> cResultMult) Then
        Debug.Print
        Debug.Print "**** Problem ****"
        Debug.Print "", cA, cB, cResult, lOverflow
        Stop
    Else
        Debug.Print ".";
        'Debug.Print "**** Seems ok: "; cA; " * "; cB; " = "; cResult; "  Overflow: "; lOverflow
    End If


    Return

End Sub


Friend Function Mult(llMultiplicand As Currency, llMultiplier As Currency) As Currency
    ' This approach uses Decimal to get it done.
    Static v1 As Variant
    Static v2 As Variant
    v1 = CDec(llMultiplicand) * mv10000     ' Get into Decimal type.
    v2 = CDec(llMultiplier) * mv10000       ' Get into Decimal type.
    ' The following may overflow in two separate ways, both ok.
    ' The v1 * v2 may overflow the Decimal type or the CCur may be overflowed.
    ' Either way, the LongLong is being overflowed.
    ' And, either way, Mult stays ZERO, which is what we want.
    Mult = CCur(v1 * v2 * mvPoint0001)
End Function


Friend Function Random(Optional ByVal llMin As Currency = 0@, Optional ByVal llMax As Currency = 922337203685477.5807@) As Currency
    ' The default is from &h0000000000000000 to &h7fffffffffffffff (the positive range), however, a range including negatives can be specified.
    ' if llMin is more than llMax, they're swapped, and that's why they're passed ByVal.
    '
    ' As a note, there's a bug in Intellisense where you can't create the smallest Currency negative as a literal constant.
    ' Therefore, if needed, you must specify the smallest negative as: FromStr("-9223372036854775808") or FromHex("&h8000000000000000")
    '
    If mhCrypt = 0& Then
        Const PROV_RSA_FULL             As Long = 1&
        Const CRYPT_VERIFYCONTEXT       As Long = &HF0000000
        Call CryptAcquireContextW(mhCrypt, 0&, 0&, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)  ' Initialize advapi32.
        If mhCrypt = 0& Then Error 48           ' Error loading DLL.  This shouldn't ever happen, but we check anyway.
    End If
    '
    Dim llTemp As Currency
    If llMin > llMax Then llTemp = llMin: llMin = llMax: llMax = llTemp   ' Swap min & max if needed.
    '
    ' We do our work as Decimal to get plenty of working range.
    Dim vRng As Variant
    Dim vMin As Variant
    Dim vMax As Variant
    Dim iLen As Long
    vMin = CDec(llMin) * mv10000
    vMax = CDec(llMax) * mv10000
    vRng = vMax - vMin + mvOne                          ' This will always be positive.
    Select Case vRng                                    ' How many bytes of randomness do we actually need.
    Case Is > mvHex100000000000000:     iLen = 8&
    Case Is > mvHex1000000000000:       iLen = 7&
    Case Is > mvHex10000000000:         iLen = 6&
    Case Is > mvHex100000000:           iLen = 5&
    Case Is > mvHex1000000:             iLen = 4&
    Case Is > mvHex10000:               iLen = 3&
    Case Is > mvHex100:                 iLen = 2&
    Case Else:                          iLen = 1&
    End Select
    '
    ' Now, get our Decimal that's in the range we want.
    Dim vVal As Variant
    GetMem1 vbDecimal, vVal                                     ' Make it a Decimal type.
    Call CryptGenRandom(mhCrypt, iLen, ByVal VarPtr(vVal) + 8&) ' Get our random bits, just shoved into low bytes of Decimal.
    While vVal >= vRng: vVal = vVal - vRng: Wend                ' Force correct range.  Any other way will introduce bias in the return.
    vVal = vVal + vMin                                          ' Correct for min.
    '
    Random = CCur(vVal * mvPoint0001)                           ' Return value.  CCur takes care of 2s complement.
End Function


```

It seems like we're good to go.  I think this thread is resolved.

----------

