dcsimg
Results 1 to 21 of 21

Thread: [VB6] - Inline assembler Add-in.

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

    [VB6] - Inline assembler Add-in.

    Hello everyone!
    There are cases where you need to use the assembly code in your VB6 projects. Usually this is done using a previously-compiled code that is placed into the the memory. Then this code is run using one of millions method. Unfortunately this method has the disadvantages. For instance, you will have to change the procedures of the placement code in the memory If you change the asm-code. In addition it is quite slow process. I've written the Add-in that does these process automatically, also after compilation any processes of the placement of the code in the memory are not performed. Asm-code links to EXE. This add-in supports the asm-code either IDE or the compiled form (native only!).

    How to use?
    First you have to install the Add-in (installer available at the end of article). After installing you should run the Add-in from VB6 IDE (Add-Ins -> Add-in Manager -> Inline assembler). It adds the new item to Add-Ins menu. If current project does not use the add-In features yet it will add the new module to project. You should add the prototypes of the functions in this module in order to call them from VB6 code. You can rename this module, place the prototypes of the functions, but you can't place the code to this module. After creating of the module you can run the ASM-editor. There is the combobox with the the functions which you defined in the module. For each function you can override the code using the NASM syntax. However if you don't override code (just leaving it empty) a function won't be overridden (this function is left a typical vb6 function). Each project (if you use this Add-in) is associated the additional file with *.ia extension in the project folder. This file contains the asm-codes for each function that is overridden by user. This add-in works "transparently", i.e. if you disable add-in project will work and compile, only "stub-functions" will work without overrides. *.ia file isn't "vitally essential" for working of the project, i.e. this project will work anyway.
    Let's consider working of Add-in with the simple example. For instance, we need to mix the two integers-arrays without overflowing, i.e. if the result of the addition is greater than 32767 it should be left to 32767. Opposite, if the result of the addition is smaller than -32768 it should be left to -32768. For this very well suit MMX-extension. It has the instructions for working with the vector data with the saturation. Ok, let's go! Create new project, open Add-in. It adds the new module, rename this module to modInlineAsm. Now define the prototype of the function:
    Code:
    Public Function MMXAdd( _
                    ByRef dest As Integer, _
                    ByRef src As Integer, _
                    ByVal count As Long) As Long
    End Function
    At the first parameter we pass the first element of the array, also this array is result; at the second parameter we pass the first element of the second array; finally, at the third parameter we pass the number of the elements. Note that the size should be a multiple of 8 bytes, because we will use the vector instructions, which work with 8 bytes simultaneously. Now define the procedure that will call this function:
    Code:
    Private Sub Form_Load()
        Dim src()   As Integer
        Dim dst()   As Integer
        Dim size    As Long
        Dim index   As Long
        
        size = 1024
        
        ReDim src(size - 1)
        ReDim dst(size - 1)
        
        For index = 0 To size - 1
            ' // Fill arrays with sine
            src(index) = Sin(index / 40) * 20000
            dst(index) = Sin(index / 23) * 20000
        Next
        
        ' // Add with saturation
        MMXAdd dst(0), src(0), size
        
        '// Draw result
        AutoRedraw = True
        
        Scale (0, 32767)-(index, -32768)
        
        For index = 0 To size - 1
            If index Then
                Me.Line -(index, dst(index))
            Else
                Me.PSet (index, dst(index))
            End If
        Next
        
    End Sub
    As you can see here both arrays are filled with sines which have the different period. Further we mix these arrays using MMXAdd function. Eventually the result array is being shown to the screen. Now we should override the MMXAdd function. For this activate the Add-in. The editor window will be opened, and there we select the MMXAdd function and add the following code:
    Code:
    BITS 32
    
    ; Addition of two arrays using saturation
    ; Size of arrays should be a multiple of 8
    
    push    EBP
    mov   EBP, ESP
    push    EBX
    push    ESI
    push    EDI
    mov   ESI,DWORD [EBP+0x8]
    mov   EDI,DWORD [EBP+0x0C]
    mov   ECX,DWORD [EBP+0x10]
    shr   ECX,2
    
    test   ECX,ECX
    je   EXIT_PROC
    emms   ; Initialize MMX
    
    CYCLE:
       movq   MM0,QWORD [EDI]
       movq   MM1,QWORD [ESI]
       paddsw   MM1,MM0
       movq   QWORD [ESI],MM1
       add   ESI,0x8
       add   EDI,0x8
    loop   CYCLE
    
    emms
    
    EXIT_PROC:
    pop    EDI
    pop   ESI
    pop   EBX
    mov   esp, ebp
    pop   ebp
    
    ret   0x0c
    It's very simple if you know the instruction set. The main instruction is paddsw that adds two four-dimensional 16 bits integer vectors with sign by single operation. Now save project and run it:
    Name:  MMX_test.PNG
Views: 2711
Size:  20.7 KB
    Nice! As you can see at the screenshot, the two sines are added with the saturation. You can notice the saturation by the peaks.
    Okay, now let's try to compile the EXE file and check what is called and what is compiled:

    As you can see, the code is already inside EXE, without memory allocation and unnecessary stuff.

    How does it work?
    Actually everything is very simple. When Add-in is connected the handlers of key events are set: the compilation start event, running code event, close/save project event etc. When you run code in IDE the all asm-codes are being compiled, also the addresses of the overrides function are calculated. Further the code of the original stub-functions is replaced to asm-code. When you call the stub-function it calls the asm-code. When you stop the execution the Add-in restores the original code. When you compile to the native code (or rather before linking) it finds the OBJ-file of the overridable module and replaces the code of the stub functions to asm-code and resaves file. For this functionality i write the COFF parser. Generally it can provides the lot of different features.
    This project is very poorly tested, because i don't have enough time, therefore i think it'll contain very many bugs. Considering that the half of the project uses the undocumented features and trick, which perhaps don't work as i know. In this project even isn't syntax highlighting, because i don't have the possibility to finish the my highlighter textbox yet. Still i'm using the simple textbox. If someone have found the bugs write here.
    Thanks for attention!

    https://yadi.sk/d/_yMsCu7o3So5GY

  2. #2

  3. #3
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,224

    Re: [VB6] - Inline assembler Add-in.

    you should make another codebank post on how to make a VST Plugin.

  4. #4

  5. #5
    Fanatic Member
    Join Date
    May 2014
    Location
    Kallithea Attikis, Greece
    Posts
    948

    Re: [VB6] - Inline assembler Add-in.

    Where is the code??
    Trick can you use a github for the addin?

  6. #6

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

    Re: [VB6] - Inline assembler Add-in.

    georgekar, hi. While i don't publish the source code of addin, because it doesn't support the integration of the NASM code to VB project, ie. you can't use the project variables in NASM code, only the parameters of the function. The rules of this forum forbid to publish the installer without source code. If you need to get the add-in, write me PM, i send you the installer.

  7. #7
    Hyperactive Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    468

    Re: [VB6] - Inline assembler Add-in.

    very interesting
    I suppose the use of the assmbler code is due to its speed performance.

    I have often noticed that VB6 is very slow. Especially when working on Image processing or Vector operations.
    I would like to be able to implement some functions in assembler.
    However, I would like to be sure that the assembler implementation is much faster and worth using.

    Please can you make an example of simple operations between 2D or 3D vectors (using Floating point (singles / double))?
    Or at least add other examples?

    I had assembly bases, I studied it many years ago, and, having no longer used it, I forgot a lot.
    So at least you could suggest some links where I can study Assembler instructions, registers ... and NASM ?
    (For NASM I found This)

  8. #8

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

    Re: [VB6] - Inline assembler Add-in.

    Please can you make an example of simple operations between 2D or 3D vectors (using Floating point (singles / double))?
    Or at least add other examples?
    I've created the example of using generation of the random 4D vectors and calculation the sum of them using SSE:
    Code:
    ' //
    ' // Fast 4D-vectors operations example using inline assembler (SSE)
    ' // by The trick
    ' //
    
    Option Explicit
    
    Private Const FADF_AUTO As Long = 1
    
    Private Type SAFEARRAYBOUND
        cElements   As Long
        lLBound     As Long
    End Type
    
    Private Type SAFEARRAY
        cDims       As Integer
        fFeatures   As Integer
        cbElements  As Long
        cLocks      As Long
        pvData      As Long
        Bounds      As SAFEARRAYBOUND
    End Type
    
    Public Type tVector4D
        fX  As Single
        fY  As Single
        fZ  As Single
        fW  As Single
    End Type
    
    Private Declare Sub SafeArrayAllocDescriptor Lib "oleaut32" ( _
                        ByVal cDims As Long, _
                        ByRef ppsaOut As Long)
    Private Declare Sub MoveArray Lib "msvbvm60" _
                        Alias "__vbaAryMove" ( _
                        ByRef Destination() As Any, _
                        ByRef Source As Any)
    Private Declare Sub MoveArray2 Lib "msvbvm60" _
                        Alias "__vbaAryMove" ( _
                        ByRef Destination As Any, _
                        ByRef Source() As Any)
    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 Function RtlCompareMemory Lib "ntdll" ( _
                             ByRef ptrSource1 As Any, _
                             ByRef ptrSource2 As Any, _
                             ByVal Length As Long) As Long
                        
                        
    Private msLog   As String   ' // Events log
    
    Sub Main()
        Dim tVB()   As tVector4D
        Dim tAsm()  As tVector4D
        
        ' // Run tests
        TestVB tVB
        TestAsm tAsm
        
        ' // Compare results
        If RtlCompareMemory(tVB(0), tAsm(0), Len(tAsm(0)) * UBound(tAsm)) = Len(tAsm(0)) * UBound(tAsm) Then
            msLog = msLog & "Match"
        Else
            msLog = msLog & "Doesn't match"
        End If
        
        ' // Display
        MsgBox msLog
        
    End Sub
    
    ' // Run inline asm test
    Private Sub TestAsm( _
                ByRef tRes() As tVector4D)
        Dim tVec1()     As tVector4D
        Dim tVec2()     As tVector4D
        Dim cAlloc1     As CAllocator
        Dim cAlloc2     As CAllocator
        Dim lRndSeed    As Long
        
        LogEvent "ASM test is running...", True
        
        Set cAlloc1 = New CAllocator
        Set cAlloc2 = New CAllocator
        
        tVec1 = CreateVectorArr4D(10000000, cAlloc1)
        tVec2 = CreateVectorArr4D(10000000, cAlloc2)
        
        lRndSeed = 327680
        
        LogEvent "Allocation"
        
        FillRandomAsm tVec1, lRndSeed
        FillRandomAsm tVec2, lRndSeed
        
        LogEvent "Fill random"
        
        VectorsAdditionAsm tVec1, tVec2
        
        LogEvent "Vectors Addition"
        
        tRes = tVec1
        
    End Sub
    
    ' // Run pure-VB test
    Private Sub TestVB( _
                ByRef tRes() As tVector4D)
        Dim tVec1()     As tVector4D
        Dim tVec2()     As tVector4D
        Dim cAlloc1     As CAllocator
        Dim cAlloc2     As CAllocator
        
        LogEvent "VB6 test is running...", True
        
        Set cAlloc1 = New CAllocator
        Set cAlloc2 = New CAllocator
        
        tVec1 = CreateVectorArr4D(10000000, cAlloc1)
        tVec2 = CreateVectorArr4D(10000000, cAlloc2)
        
        LogEvent "Allocation"
        
        FillRandomVB tVec1
        FillRandomVB tVec2
        
        LogEvent "Fill random"
        
        VectorsAdditionVB tVec1, tVec2
        
        LogEvent "Vectors Addition"
        
        tRes = tVec1
        
    End Sub
    
    ' // Log
    Public Sub LogEvent( _
               Optional ByRef sText As String, _
               Optional ByVal bNoTime As Boolean)
        Static cFreq    As Currency, _
               cOldVal  As Currency
        Dim cNewVal     As Currency
        
        If cFreq = 0@ Then
        
            QueryPerformanceFrequency cFreq
            QueryPerformanceCounter cNewVal
            cOldVal = cNewVal
            
        Else
        
            QueryPerformanceCounter cNewVal
            
        End If
        
        If Not bNoTime Then
            msLog = msLog & Format$((cNewVal - cOldVal) / cFreq, "0.00000") & "ms. "
        End If
        
        msLog = msLog & sText & vbNewLine
            
        cOldVal = cNewVal
            
    End Sub
    
    
    ' //
    ' // Alloc at 16 bytes boundary
    ' //
    Public Function CreateVectorArr4D( _
                    ByVal lCount As Long, _
                    ByVal cAlloc As CAllocator) As tVector4D()
        Dim pDesc   As Long
        Dim tDesc   As SAFEARRAY
        Dim tVec    As tVector4D
        
        SafeArrayAllocDescriptor 1, pDesc
        
        MoveMemory tDesc, ByVal pDesc, Len(tDesc)
    
        tDesc.pvData = cAlloc.Alloc(lCount * Len(tVec))
        tDesc.cbElements = Len(tVec)
        tDesc.fFeatures = FADF_AUTO
        tDesc.Bounds.cElements = lCount
        
        MoveMemory ByVal pDesc, tDesc, Len(tDesc)
        
        MoveArray CreateVectorArr4D, pDesc
        
    End Function
    Code:
    Option Explicit
    
    ' //
    ' // Fill with random values
    ' //
    Public Sub FillRandomVB( _
               ByRef tVec() As tVector4D)
        Dim lIndex  As Long
        
        For lIndex = 0 To UBound(tVec)
        
            tVec(lIndex).fX = Rnd
            tVec(lIndex).fY = Rnd
            tVec(lIndex).fZ = Rnd
            tVec(lIndex).fW = Rnd
            
        Next
        
    End Sub
               
               
    ' //
    ' // Vectors addition
    ' // tVecDst(0..n) = tVecDst(0..n) + tVecSrc(0..n)
    ' //
    Public Sub VectorsAdditionVB( _
               ByRef tVecDst() As tVector4D, _
               ByRef tVecSrc() As tVector4D)
        Dim lIndex  As Long
        Dim lCount  As Long
        
        If UBound(tVecDst) > UBound(tVecSrc) Then
            lCount = UBound(tVecSrc) + 1
        Else
            lCount = UBound(tVecDst) + 1
        End If
        
        For lIndex = 0 To lCount - 1
            
            tVecDst(lIndex).fX = tVecDst(lIndex).fX + tVecSrc(lIndex).fX
            tVecDst(lIndex).fY = tVecDst(lIndex).fY + tVecSrc(lIndex).fY
            tVecDst(lIndex).fZ = tVecDst(lIndex).fZ + tVecSrc(lIndex).fZ
            tVecDst(lIndex).fW = tVecDst(lIndex).fW + tVecSrc(lIndex).fW
            
        Next
        
    End Sub
    Code:
    Option Explicit
    
    Public Sub FillRandomAsm( _
               ByRef tVec() As tVector4D, _
               ByRef lRndSeed As Long)
    
    End Sub
    
    Public Sub VectorsAdditionAsm( _
               ByRef tVecDst() As tVector4D, _
               ByRef tVecSrc() As tVector4D)
               
    End Sub
    The CAllocator class:
    Code:
    ' //
    ' // 16-byte alignment allocator
    ' //
    
    Option Explicit
    
    Private mpMem   As Long
    
    Public Property Get Ptr() As Long
        Ptr = (mpMem + 15) And &HFFFFFFF0
    End Property
    
    Public Function Alloc( _
                    ByVal lSize As Long) As Long
        
        If mpMem Then Err.Raise 5
        
        mpMem = CoTaskMemAlloc(lSize + 16)
        
        Alloc = (mpMem + 15) And &HFFFFFFF0
        
    End Function
    
    Public Sub Free()
        
        If mpMem Then
            CoTaskMemFree mpMem
        End If
        
        mpMem = 0
        
    End Sub
    
    Private Sub Class_Terminate()
        Free
    End Sub
    Code:
    FillRandomAsm:
    BITS 32
    
    ; Validate SafeArray
    mov eax, dword [esp + 4]
    test eax, eax
    jz EXIT
    
    mov eax, dword [eax]
    test eax, eax
    jz EXIT
    
    mov cx, word [eax]
    dec cx
    jnz EXIT
    
    push edi
    
    mov ecx, dword [eax + 0x10]	; SA.Bounds.cElements
    mov edi, dword [eax + 0x0c]	; SA.pvData
    
    mov eax, __float32__(16777216.0)
    movd xmm1, eax
    
    mov eax, dword [esp + 0x0c]	; *Seed
    mov eax, dword [eax]		; Seed
    
    ; Multiply by 4
    shl ecx, 2
    
    CYCLE:
    test ecx, ecx
    jz END_CYCLE
    
    ; VB6 Rnd algo: NewVal = (0xFFC39EC3 - (OldVal * 0x2BC03)) And &HFFFFFF
    imul eax, eax, 0x2BC03
    sub eax, 0xFFC39EC3
    neg eax
    and eax, 0xFFFFFF
    cvtsi2ss xmm0, eax
    divss xmm0, xmm1
    
    ; Store
    movd [edi], xmm0
    
    add edi, 4
    dec ecx
    jmp CYCLE
    
    END_CYCLE:
    
    mov edi, dword [esp + 0x0c]
    mov dword [edi], eax
    
    pop edi
    
    EXIT:
    ret 8
    
    VectorsAdditionAsm:
    BITS 32
    
    push ebx
    
    mov eax, dword [esp + 8]
    test eax, eax
    jz EXIT
    
    mov ebx, dword [esp + 0xc]
    test ebx, ebx
    jz EXIT
    
    mov eax, dword [eax]
    test eax, eax
    jz EXIT
    
    mov ebx, dword [ebx]
    test ebx, ebx
    jz EXIT
    
    mov cx, word [eax]
    cmp cx, word [ebx]
    jne EXIT
    dec cx
    jne EXIT
    
    mov edx, dword [eax + 0x10]
    cmp edx, dword [ebx + 0x10]
    jbe START_CYCLE
    mov edx, dword [ebx + 0x10]
    
    START_CYCLE:
    
    test edx, edx
    jz EXIT
    
    xor ecx, ecx
    shl edx, 4
    mov eax, dword [eax + 0xc]
    mov ebx, dword [ebx + 0xc]
    
    CYCLE:
    
    movaps xmm0, [eax + ecx]
    addps xmm0, [ebx + ecx]
    movaps [eax + ecx], xmm0
    add ecx, 0x10
    cmp ecx, edx
    jb CYCLE
    
    EXIT:
    
    pop ebx
    ret 8
    It uses the allocator because some SSE instructions require the 16-bytes alignment for the performance reasons. The allocator just reserve the enough memory for an array and hold the original memory pointer to free it when the allocator has been released. The example has no error checking and uses default Rnd seed (327680).
    The asm code works quite fast both in the IDE and in the exe:

    VB6 compiles pretty good
    The main advantages is it doesn't use the dynamic code and you have the all in the exe:
    Attached Files Attached Files

  9. #9
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,684

    Re: [VB6] - Inline assembler Add-in.

    Thank you, The trick. I tested it, and the test project shows "Out of memory", I don't know if the version of olelib.tlb on my computer is incorrect.

    Code:
    Private Sub TestAsm( _
                ByRef tRes() As tVector4D)
        Dim tVec1()     As tVector4D
        Dim tVec2()     As tVector4D
        Dim cAlloc1     As CAllocator
        Dim cAlloc2     As CAllocator
        Dim lRndSeed    As Long
        
        LogEvent "ASM test is running...", True
        
        Set cAlloc1 = New CAllocator
        Set cAlloc2 = New CAllocator
        
        tVec1 = CreateVectorArr4D(10000000, cAlloc1)
        tVec2 = CreateVectorArr4D(10000000, cAlloc2)
        
        lRndSeed = 327680
        
        LogEvent "Allocation"
        
        FillRandomAsm tVec1, lRndSeed
        FillRandomAsm tVec2, lRndSeed
        
        LogEvent "Fill random"
        
        VectorsAdditionAsm tVec1, tVec2
        
        LogEvent "Vectors Addition"
        
        tRes = tVec1    '--- Out of memory ---		
        
    End Sub
    Last edited by dreammanor; Dec 21st, 2018 at 11:10 PM.

  10. #10

  11. #11

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

    Re: [VB6] - Inline assembler Add-in.

    You can also insert the files into an exe files using that macro:
    Code:
    BITS 32
    
    %assign TEMP_COUNTER 0
    
    %macro insert_file 1
    
    	cmp eax, TEMP_COUNTER
    	jnz %%label3	
    
    	call %%label2
    %%label1:
    	incbin %1
    %%label2:
    	pop eax
    	mov edx, %%label2 - %%label1
    	ret 4
    %%label3:
    %assign TEMP_COUNTER  TEMP_COUNTER +1
    %endmacro
    
    xor edx, edx
    mov eax, dword [esp+4]
    
    ; // Add the files
    insert_file "wf_01.bin"
    insert_file "wf_02.bin"
    insert_file "wf_03.bin"
    insert_file "wf_04.bin"
    insert_file "wf_05.bin"
    insert_file "wf_06.bin"
    insert_file "firmware_sw.bin"
    insert_file "firmware_sw_inv.bin"
    insert_file "firmware_hw.bin"
    insert_file "firmware_hw_inv.bin"
    You can get the data using such prototype:
    Code:
    Public Type tResource
        pData   As Long
        lSize   As Long
    End Type
    
    Public Function GetResource( _
                    ByVal lIndex As Long) As tResource
                        
    End Function
    I used that approach in TrickComposer to store all the resources into the compound file inside EXE.

  12. #12
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    1,684

    Re: [VB6] - Inline assembler Add-in.

    Quote Originally Posted by The trick View Post
    dreammanor, thank for debugging. Seems you have no enough memory to hold all the arrays. Just either try to reduce the arrays or try to compile.

    Yes, I didn't notice that the number of Vectors is so huge (20 million). After I reduced the number of Vectors, the program works fine. Thank you very much, The trick.

    Some time ago, I tested the performance of my Spread control. My Spread takes 57 seconds to load 6 million cells (300,000 rows, 20 cols), while Farpoint Spread takes only 22 seconds. I don't know if your code can be used to improve the performance of my Spread control. If it can, that would be great.

  13. #13
    Hyperactive Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    468

    Re: [VB6] - Inline assembler Add-in.

    Name:  SSS1.jpg
Views: 690
Size:  24.3 KBName:  sss2.jpg
Views: 720
Size:  25.0 KB

    Very interesting but also very difficult to understand.
    I realize I really understand very little ... I still do not know exactly what a SafeArray is ....
    Apart from this I do not know how many people can understand the example. (also the Asm)
    In my opinion, much simpler examples of small functions would be needed.

    When working with vectors, eg for graphics, you always have to deal with the "Normalize" function. That must execute 1 / Sqr (magnitude) and here the "famous" Fast Inverse square root takes over.
    https://en.wikipedia.org/wiki/Fast_inverse_square_root
    http://www.vbforums.com/showthread.p...t-Inverse-Sqrt

    I was thinking to use Asm for this, and, if it's worth it, also for other Vectorial operations.

  14. #14
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,606

    Re: [VB6] - Inline assembler Add-in.

    I though fast inverse hack is not relevant anymore as FPUs are faster doing it precisely and in floating-point (the hack is approximation).

    What is more relevant nowadays is vectorization of the processing approach, using SSE/AVX instruction that deal with batches of 4-8-16 operands in parallel.

    cheers,
    </wqw>

  15. #15

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,364

    Re: [VB6] - Inline assembler Add-in.

    I've made such tests:
    Code:
    ' //
    ' // Vectors normalization test using different approaches
    ' // by The trick
    ' //
    
    Option Explicit
    
    Private Const ERR_TOLERANCE     As Single = 0.01        ' // Error checking tolerance
    
    Public Type tVector4D
        fX As Single
        fY As Single
        fZ As Single
        fW As Single
    End Type
    
    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 msLog   As String   ' // Events log
    
    Sub Main()
        Dim tVec()      As tVector4D
        Dim tVecTemp()  As tVector4D
        Dim tDirect()   As tVector4D
        
        ReDim tVec(10000000)
        
        ' // Fill the vectors with different random values with range 0...10000
        FillRandom tVec
        
        tVecTemp = tVec
        
        LogEvent "NormalizeVectorsDirectVB", True
        
        ' // Default VB-implementation using direct sqr calculation
        NormalizeVectorsDirectVB tVecTemp
        
        LogEvent ""
        
        tDirect = tVecTemp
        
        tVecTemp = tVec
        
        LogEvent "NormalizeVectorsFastVB", True
        
        ' // Using VB fast inverse square root
        NormalizeVectorsFastVB tVecTemp
    
        LogEvent ""
        
        CheckError tDirect, tVecTemp
        
        tVecTemp = tVec
        
        LogEvent "NormalizeVectorsFastAsmFPU", True
        
        ' // Using ASM (FPU) fast inverse square root
        NormalizeVectorsFastAsmFPU tVecTemp
    
        LogEvent ""
        
        CheckError tDirect, tVecTemp
        
        tVecTemp = tVec
        
        LogEvent "NormalizeVectorsFastAsmSSE", True
        
        ' // Using ASM (SSE3) fast inverse square root
        NormalizeVectorsFastAsmSSE tVecTemp
    
        LogEvent ""
        
        CheckError tDirect, tVecTemp
        
        MsgBox msLog
        
    End Sub
    
    ' //
    ' // Check error
    ' //
    Private Sub CheckError( _
                ByRef tDirect() As tVector4D, _
                ByRef tVectors() As tVector4D)
        Dim lIndex  As Long
        
        For lIndex = 0 To UBound(tDirect)
            
            ' // 0.01 - tolerance
            If Abs(tDirect(lIndex).fX - tVectors(lIndex).fX) > ERR_TOLERANCE Or _
               Abs(tDirect(lIndex).fY - tVectors(lIndex).fY) > ERR_TOLERANCE Or _
               Abs(tDirect(lIndex).fZ - tVectors(lIndex).fZ) > ERR_TOLERANCE Or _
               Abs(tDirect(lIndex).fW - tVectors(lIndex).fW) > ERR_TOLERANCE Then
                Stop
            End If
            
        Next
        
    End Sub
    
    ' //
    ' // Normalize array of vectors using direct calculatuion
    ' //
    Private Sub NormalizeVectorsDirectVB( _
                ByRef tVectors() As tVector4D)
        Dim lIndex  As Long
        Dim fLen    As Single
        
        For lIndex = 0 To UBound(tVectors)
        
            fLen = Sqr(tVectors(lIndex).fX * tVectors(lIndex).fX + _
                       tVectors(lIndex).fY * tVectors(lIndex).fY + _
                       tVectors(lIndex).fZ * tVectors(lIndex).fZ + _
                       tVectors(lIndex).fW * tVectors(lIndex).fW)
                       
            tVectors(lIndex).fX = tVectors(lIndex).fX / fLen
            tVectors(lIndex).fY = tVectors(lIndex).fY / fLen
            tVectors(lIndex).fZ = tVectors(lIndex).fZ / fLen
            tVectors(lIndex).fW = tVectors(lIndex).fW / fLen
            
        Next
        
    End Sub
    
    ' //
    ' // Normalize array of vectors using fast inverse square
    ' //
    Private Sub NormalizeVectorsFastVB( _
                ByRef tVectors() As tVector4D)
        Dim lIndex  As Long
        Dim fLen    As Single
        Dim fHalf   As Single
        Dim lInt    As Long
        
        For lIndex = 0 To UBound(tVectors)
        
            fLen = tVectors(lIndex).fX * tVectors(lIndex).fX + _
                   tVectors(lIndex).fY * tVectors(lIndex).fY + _
                   tVectors(lIndex).fZ * tVectors(lIndex).fZ + _
                   tVectors(lIndex).fW * tVectors(lIndex).fW
                       
            fHalf = fLen * 0.5!
            
            GetMem4 fLen, lInt
            
            lInt = &H5F3759DF - (lInt \ 2)
            
            GetMem4 lInt, fLen
            
            fLen = fLen * (1.5! - (fHalf * fLen * fLen))
            
            tVectors(lIndex).fX = tVectors(lIndex).fX * fLen
            tVectors(lIndex).fY = tVectors(lIndex).fY * fLen
            tVectors(lIndex).fZ = tVectors(lIndex).fZ * fLen
            tVectors(lIndex).fW = tVectors(lIndex).fW * fLen
            
        Next
        
    End Sub
    
    ' // Log
    Public Sub LogEvent( _
               Optional ByRef sText As String, _
               Optional ByVal bNoTime As Boolean)
        Static cFreq    As Currency, _
               cOldVal  As Currency
        Dim cNewVal     As Currency
        
        If cFreq = 0@ Then
        
            QueryPerformanceFrequency cFreq
            QueryPerformanceCounter cNewVal
            cOldVal = cNewVal
            
        Else
        
            QueryPerformanceCounter cNewVal
            
        End If
        
        If Not bNoTime Then
            msLog = msLog & Format$((cNewVal - cOldVal) / cFreq, "0.00000") & "ms. "
        End If
        
        msLog = msLog & sText & vbNewLine
            
        cOldVal = cNewVal
            
    End Sub
    
    Option Explicit
    
    ' //
    ' // Normalize array of vectors using fast inverse square using FPU
    ' //
    Public Sub NormalizeVectorsFastAsmFPU( _
               ByRef tVectors() As tVector4D)
    
    End Sub
    
    ' //
    ' // Normalize array of vectors using fast inverse square using SSE3
    ' //
    Public Sub NormalizeVectorsFastAsmSSE( _
               ByRef tVectors() As tVector4D)
    
    End Sub
    
    ' //
    ' // Fill with random numbers
    ' //
    Public Sub FillRandom( _
               ByRef tVectors() As tVector4D)
    End Sub
    With the following asm code:
    Code:
    NormalizeVectorsFastAsmFPU:
    
    BITS 32
    
    sub esp, 8
    
    mov eax, dword [esp + 0x0c]
    test eax, eax
    jz EXIT
    
    mov eax, dword [eax]
    test eax, eax
    jz EXIT
    
    cmp word [eax], 1
    jne EXIT
    
    mov ecx, dword [eax + 0x10]
    test ecx, ecx
    jz EXIT
    
    mov eax, dword [eax + 0x0c]
    
    ; // 0.5
    mov dword [esp], __float32__(1.5)
    fld dword [esp]
    
    ; // 1.5
    mov dword [esp + 4], __float32__(0.5)
    fld dword [esp + 4]
    
    CYCLE:
    
    ; // Calculate x*x + y*y + z*z + w*w
    fld dword [eax]
    fmul ST0, ST0
    fld dword [eax + 4]
    fmul ST0, ST0
    fld dword [eax + 8]
    fmul ST0, ST0
    fld dword [eax + 0x0c]
    fmul ST0, ST0
    faddp ST1, ST0
    faddp ST1, ST0
    faddp ST1, ST0
    fld ST0
    
    ; // Calculate half
    fmul ST0, ST2
    fxch ST0, ST1
    fstp dword [esp]
    
    shr dword [esp], 1
    sub dword [esp], 0x5f3759df
    neg dword [esp]
    fld dword [esp]
    fmulp ST1
    fmul dword [esp]
    fsubr ST0, ST2
    fmul dword [esp]
    
    fld ST0
    fmul dword [eax]
    fstp dword [eax]
    
    fld ST0
    fmul dword [eax + 4]
    fstp dword [eax + 4]
    
    fld ST0
    fmul dword [eax + 8]
    fstp dword [eax + 8]
    
    fmul dword [eax + 0x0c]
    fstp dword [eax + 0x0c]
    
    add eax, 0x10
    
    loop CYCLE
    
    fstp ST0
    fstp ST0
    
    EXIT:
    
    add esp, 8
    ret 4
    
    NormalizeVectorsFastAsmSSE:
    BITS 32
    
    mov eax, dword [esp + 4]
    test eax, eax
    jz EXIT
    
    mov eax, dword [eax]
    test eax, eax
    jz EXIT
    
    mov cx, word [eax]
    cmp cx, 1
    jne EXIT
    
    mov ecx, dword [eax + 0x10]
    test ecx, ecx
    jz EXIT
    
    mov eax, dword [eax + 0x0c]
    push eax
    mov eax, __float32__(0.5)
    movd xmm0, eax
    mov eax, __float32__(1.5)
    movd xmm1, eax
    mov eax, 0x5F3759DF
    movd xmm2, eax
    pop eax
    
    CYCLE:
    
    movups xmm3, [eax]
    movaps xmm6, xmm3
    mulps xmm3, xmm3
    haddps xmm3, xmm3
    haddps xmm3, xmm3
    
    movss xmm5, xmm3
    mulss xmm5, xmm0
    
    psrad xmm3, 1
    movss xmm4, xmm2
    psubd xmm4, xmm3
    
    mulss xmm5, xmm4
    mulss xmm5, xmm4
    movss xmm3, xmm1
    subss xmm3, xmm5
    mulss xmm3, xmm4
    
    shufps xmm3, xmm3, 0
    mulps xmm3, xmm6
    
    movups [eax], xmm3
    
    add eax, 0x10
    
    loop CYCLE
    
    EXIT:
    
    ret 4
    SSE3 implementation is more faster on my PC even regardless i didn't do the optimization with alignment (used movups).
    Attached Files Attached Files

  16. #16
    Hyperactive Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    468

    Re: [VB6] - Inline assembler Add-in.

    @TheTrick
    Congratulations on your knowledge of Asm - FPU/SSE !
    Fast Inverse Sqr seems to have no more usefullness. (NormalizeVectorsFastVB).
    Since it is the division "/" that consumes time. (in addition to Sqr)
    This change brings to have 1 division instead of 4.
    Code:
    ' //
    ' // Normalize array of vectors using direct calculatuion
    ' //
    Private Sub NormalizeVectorsDirectVB( _
                ByRef tVectors() As tVector4D)
        Dim lIndex  As Long
        Dim fLen    As Single
        For lIndex = 0 To UBound(tVectors)
        
            fLen = 1 / Sqr(tVectors(lIndex).fX * tVectors(lIndex).fX + _
                       tVectors(lIndex).fY * tVectors(lIndex).fY + _
                       tVectors(lIndex).fZ * tVectors(lIndex).fZ + _
                       tVectors(lIndex).fW * tVectors(lIndex).fW)
                       
            tVectors(lIndex).fX = tVectors(lIndex).fX * fLen
            tVectors(lIndex).fY = tVectors(lIndex).fY * fLen
            tVectors(lIndex).fZ = tVectors(lIndex).fZ * fLen
            tVectors(lIndex).fW = tVectors(lIndex).fW * fLen
            
        Next
    End Sub
    And I have this result (WITH Above change):
    Name:  invsqr.jpg
Views: 673
Size:  23.0 KB

    WITHOUT Above change:
    Name:  aaaaaaaaaaaaaaaaaaaaaaaaaaa.jpg
Views: 660
Size:  23.3 KB



    PS:
    Sorry to bother you. When have time, could you make the SSE one just for 1 input 3D vector ?
    Code:
    Public Sub NormalizeVectorFastAsmSSE( ByRef tVectors As tVector3D)

  17. #17
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    315

    Re: [VB6] - Inline assembler Add-in.

    Could be interesting to write a routine that convert procedures/function VB code to ASM, of course, small procedures that are called quite a lot into projects, in order to make them faster.
    Like such code :
    Code:
    Public Function NormalizeAmount(sAmount As String, Optional nDecimals As Long = 3) As Double
       ' #VBIDEUtils#***********************************************************
       ' * Date             : 12/01/2003
       ' * Time             : 21:46
       ' * Module Name      : Lib_Module
       ' * Module Filename  : Lib.bas
       ' * Procedure Name   : NormalizeAmount
       ' * Purpose          :
       ' * Parameters       :
       ' *                    sAmount As String
       ' *                    Optional nDecimals As Long = 3
       ' * Purpose          :
       ' **********************************************************************
       ' * Comments         :
       ' *
       ' *
       ' * Example          :
       ' *
       ' * See Also         :
       ' *
       ' * History          :
       ' *
       ' *
       ' **********************************************************************
    
    1    On Error Resume Next
    
    2    sAmount = Trim$(sAmount)
    
    3    If LenB(sAmount) Then
    4       If gsConfig_Decimal = "," Then
    5          If InStrB(sAmount, ".") Then sAmount = Replace(sAmount, ".", vbNullString)
    6       ElseIf gsConfig_Decimal = "." Then
    7          If InStrB(sAmount, ",") Then sAmount = Replace(sAmount, ",", vbNullString)
    8       End If
    
    9       If InStrB(sAmount, gsConfig_Devise) Then sAmount = Replace(sAmount, gsConfig_Devise, vbNullString)
    
    10       If Left$(sAmount, 1) = "-" Then
    11          NormalizeAmount = -Format(Replace(0 & Replace(sAmount, "-", vbNullString), ".", gsConfig_Decimal), "0." & String$(nDecimals, "0"))
    12       Else
    13          NormalizeAmount = Format(Replace(0 & sAmount, ".", gsConfig_Decimal), "0." & String$(nDecimals, "0"))
    14       End If
    15    Else
    16       NormalizeAmount = 0
    17    End If
    
    End Function

  18. #18
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,429

    Re: [VB6] - Inline assembler Add-in.

    Quote Originally Posted by Thierry69 View Post
    Could be interesting to write a routine that convert procedures/function VB code to ASM, ...
    Like such code...
    I've just tested your NormalizeAmount - function with the following global settings (here on my german locale):
    Code:
    Public Const gsConfig_Decimal = ","
    Public Const gsConfig_Devise = "€"
    And then the following loop-code in a Form_Click:
    Code:
    Private Sub Form_Click()
      Dim i As Long, Result As Double, T!
      T = Timer
        For i = 1 To 10 ^ 6
          Result = NormalizeAmount("€1.002,234501", 3)
        Next
      Caption = Timer - T
    End Sub
    The above (using your function) needs about 5 seconds to finish the 1Mio evaluations to a Double-Value...

    Tough - for an easy factor 10 speed-up, I've just had to change "NormalizeAmount" with "VBA.Round"...

    I guess this example shows, that "ASM-tuning" of "inefficient routines" would bring not much -
    usually it is algorithm- or library-changes, which can ensure a decent speed-up much more effortlessly...

    Besides ... ASM-stuff is not really needed these days anymore, since most decent C/C++/Fortran-compilers
    can optimize exceptionally well, giving even an experienced ASM-guy quite a hard time, to come up with something better.

    Olaf

  19. #19
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    315

    Re: [VB6] - Inline assembler Add-in.

    Thanks Olaf.
    I think I used Round in the past, but for some reasons it was not working in all cases.
    I'll investigate

    I just tested with a routine that intesivielly use this function, here is the result :

    With my function
    87,23828125

    With round (in the function, so just modified the core of the function)
    87,08984375

    So no gain

    Than, I did a global replace in the project for my function to Round, and I had quite a lot of errors.
    My function manage empty strings and also "%" in order to manage all numerics.

    After some "quickly and dirty" modifications to manage the errors, I had the result :
    77,17578125

    But the final result of the calculations was not the same (probably some dirty code not well managed during my test)

    But only a gain of 10 seconds wich is not so significant.
    Last edited by Thierry69; Dec 25th, 2018 at 03:42 AM.

  20. #20
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,429

    Re: [VB6] - Inline assembler Add-in.

    Quote Originally Posted by Thierry69 View Post
    I just tested with a routine that intesivielly use this function, here is the result :

    With my function
    87,23828125
    ...
    After some "quickly and dirty" modifications to manage the errors, I had the result :
    77,17578125
    ...
    But only a gain of 10 seconds wich is not so significant.
    There has to be "something more to it" (the scenario, in which you apply that function) -
    because the performance-increase using Round is definitely > factor 10 (when comparing the two routines isolated).

    I'd be happy to take a look at a demo-scenario of yours though (ideally uploaded in a little Demo-Zip),
    where you make use of that function... (just open up another thread for it, to not derail this one here).

    Olaf

  21. #21
    Hyperactive Member
    Join Date
    Jan 2015
    Posts
    315

    Re: [VB6] - Inline assembler Add-in.

    It is not used in a loop like your sample, but intensively in the business application, at several thousands of place.
    So, not only this function is used.
    Th eproject is something like 1 millions of lines and I try always to optimise a bit the speed when I can

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width