VCall (Variadic Call) module

[wilbert]

VCall is a cross platform module to call variadic C functions like for example printf.

Code: Select all

; VCall (Variadic Call) module by Wilbert

; Last updated : November 26, 2019

DeclareModule VCall
  
  ; A cross platform module to make calls to variadic functions 
  
  ; VCall  (*Function, *Arguments, *Types)
  ; VCallQ (*Function, *Arguments, *Types)
  ; VCallF (*Function, *Arguments, *Types)
  ; VCallD (*Function, *Arguments, *Types)
  
  ; *Function  : a pointer to the function to call
  ; *Arguments : an array of VCArgument elements
  ; *Types     : a pointer to a null terminated string of types
  
  ; Possible types are "i", "q", "f" and "d"
  
  ; For 64 bit macOS and Linux there are two additional types :
  ; "m" moves the argument to the stack even if a register is free
  ; "r" requires a pointer to a VCReturn structure which will be
  ; filled after the call has been made.
  ; Both of these types are useful for passing structures.
  
  Structure VCArgument
    StructureUnion
      i.i
      q.q
      f.f
      d.d
    EndStructureUnion
  EndStructure
  
  Structure VCReturn
    rax.i
    rdx.i
    xmm0.d
    xmm1.d
  EndStructure
  
  PrototypeC.i VCall  (*Function, *Arguments, *Types)
  PrototypeC.q VCallQ (*Function, *Arguments, *Types)
  PrototypeC.f VCallF (*Function, *Arguments, *Types)
  PrototypeC.d VCallD (*Function, *Arguments, *Types)
  
  Global VCall.VCall, VCallQ.VCallQ
  Global VCallF.VCallF, VCallD.VCallD
  
EndDeclareModule

Module VCall
  
  DisableDebugger
  EnableExplicit
  
  ;->> Procedures <<
  
  Procedure _VCall()
    CompilerIf #PB_Compiler_Unicode
      !.cSize equ 2
    CompilerElse
      !.cSize equ 1
    CompilerEndIf
    !jmp .ret_proc_addr
    !align 8
    !.proc_start:
    ;->> VCall procedure start <<
    
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      ; ->> x86 Cross platform <<
      !push ebp
      !mov ebp, esp
      !push esi
      !push edi
      ; Get length of types string
      !mov edx, [ebp + 16]
      !mov ecx, -1
      !.l0:
      !add ecx, 1
      !cmp byte [edx + ecx*.cSize], 0
      !jne .l0
      ; Adjust stack
      !lea ecx, [ecx*8]
      !sub esp, ecx
      !and esp, -16
      ; Copy arguments
      !mov esi, [ebp + 12]
      !mov edi, esp
      !.l1:
      !movzx eax, byte [edx]  ; get type
      !add edx, .cSize
      !cmp eax, 'i'
      !je .l3
      !cmp eax, 'f'
      !je .l3
      !cmp eax, 'd'
      !je .l2
      !cmp eax, 'q'
      !jne .l4
      !.l2:
      !mov eax, [esi]         ; copy double or quad
      !mov ecx, [esi + 4]
      !mov [edi], eax
      !mov [edi + 4], ecx
      !add esi, 8
      !add edi, 8
      !jmp .l1
      !.l3:
      !mov eax, [esi]         ; copy other types
      !mov [edi], eax
      !add esi, 8
      !add edi, 4
      !jmp .l1      
      ; Call function pointer    
      !.l4:
      !call dword [ebp + 8]    
      ; Restore stack
      !lea esp, [ebp - 8]
      !pop edi
      !pop esi
      !pop ebp
      !ret      
    CompilerElseIf #PB_Compiler_OS = #PB_OS_Windows
      ; ->> x64 Windows <<      
      !push rbp
      !mov rbp, rsp
      ; r11 = *Function
      !mov r11, rcx
      ; Get length of types string
      !mov ecx, -1
      !.l0:
      !add ecx, 1
      !cmp byte [r8 + rcx*.cSize], 0
      !jne .l0
      ; Adjust stack
      !lea ecx, [ecx*8 + 32]
      !sub rsp, rcx
      !and rsp, -16
      ; Copy arguments
      !mov r9, rsp
      !.l1:
      !movzx eax, byte [r8]   ; get type
      !add r8, .cSize
      !cmp eax, 'i'
      !je .l2
      !cmp eax, 'd'
      !je .l2
      !cmp eax, 'q'
      !je .l2
      !cmp eax, 'f'
      !jne .l3
      !movd xmm0, [rdx]       ; copy float
      !movq [r9], xmm0
      !add rdx, 8
      !add r9, 8
      !jmp .l1
      !.l2:
      !mov rax, [rdx]         ; copy other types
      !mov [r9], rax
      !add rdx, 8
      !add r9, 8
      !jmp .l1
      ; Load registers
      !.l3:
      !mov r9,  [rsp + 24]
      !mov r8,  [rsp + 16]
      !mov rdx, [rsp + 8]
      !mov rcx, [rsp]
      !movq xmm3, r9
      !movq xmm2, r8
      !movq xmm1, rdx
      !movq xmm0, rcx
      ; Call function pointer    
      !call r11
      ; Restore stack
      !mov rsp, rbp
      !pop rbp
      !ret
    CompilerElse
      ; ->> x64 macOS, Linux <<
      !push rbp
      !mov rbp, rsp
      ; r11 = *Function
      !mov r11, rdi
      ; Get length of types string
      !mov ecx, -1
      !.l0:
      !add ecx, 1
      !cmp byte [rdx + rcx*.cSize], 0
      !jne .l0
      ; Adjust stack
      !lea ecx, [ecx*8 + 128]
      !sub rsp, rcx
      !and rsp, -16
      ; Copy arguments
      !xor ecx, ecx
      !mov [rbp - 128], rcx   ; clear struct return
      !mov [rbp - 120], rcx   ; clear reg counters
      !mov rdi, rsp
      !.l1:
      !movzx eax, byte [rdx]  ; get type
      !add rdx, .cSize
      !cmp eax, 'i'
      !je .l6
      !cmp eax, 'd'
      !je .l3
      !cmp eax, 'q'
      !je .l6
      !cmp eax, 'f'
      !je .l2
      !cmp eax, 'm'
      !je .l8
      !cmp eax, 'r'
      !jne .l9
      !mov rax, [rsi]         ; set struct return
      !add rsi, 8
      !mov [rbp - 128], rax
      !jmp .l1
      !.l2:
      !movd xmm0, [rsi]       ; copy float
      !jmp .l4
      !.l3:
      !movq xmm0, [rsi]       ; copy double
      !.l4:
      !add rsi, 8
      !mov ecx, [rbp - 116]   ; fp reg count
      !cmp ecx, 8             ; >= 8 ?
      !jae .l5
      !movq [rbp - 112 + rcx*8], xmm0
      !add ecx, 1
      !mov [rbp - 116], ecx   ; fp reg count
      !jmp .l1
      !.l5:
      !movq [rdi], xmm0       ; to stack
      !add rdi, 8
      !jmp .l1
      !.l6:
      !mov rax, [rsi]         ; copy other types
      !add rsi, 8
      !mov ecx, [rbp - 120]   ; gp reg count      
      !cmp ecx, 6             ; >= 6 ?
      !jae .l7
      !mov [rbp - 48 + rcx*8], rax
      !add ecx, 1
      !mov [rbp - 120], ecx   ; gp reg count
      !jmp .l1
      !.l7:
      !mov [rdi], rax         ; to stack
      !add rdi, 8
      !jmp .l1
      !.l8:
      !mov rax, [rsi]
      !add rsi, 8
      !jmp .l7
      ; Load registers
      !.l9:
      !mov eax, [rbp - 116]
      !and eax, 0xff
      !jz .l10
      !movq xmm0, [rbp - 112]
      !movq xmm1, [rbp - 104]
      !movq xmm2, [rbp - 96]
      !movq xmm3, [rbp - 88]
      !movq xmm4, [rbp - 80]
      !movq xmm5, [rbp - 72]
      !movq xmm6, [rbp - 64]
      !movq xmm7, [rbp - 56]
      !.l10:
      !mov rdi, [rbp - 48]
      !mov rsi, [rbp - 40]
      !mov rdx, [rbp - 32]
      !mov rcx, [rbp - 24]
      !mov r8, [rbp - 16]
      !mov r9, [rbp - 8]
      ; Call function pointer    
      !call r11
      ; Struct return
      !mov rdi, [rbp - 128]
      !and rdi, rdi
      !jz .l11
      !mov [rdi], rax
      !mov [rdi + 8], rdx
      !movq [rdi + 16], xmm0
      !movq [rdi + 24], xmm1
      ; Restore stack
      !.l11:
      !mov rsp, rbp
      !pop rbp
      !ret    
    CompilerEndIf
    
    ;->> VCall procedure end <<
    !.ret_proc_addr:
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      !lea eax, [.proc_start]
    CompilerElse
      !lea rax, [.proc_start]
    CompilerEndIf
    ProcedureReturn
  EndProcedure
  
  ;->> Prototype assignments <<
  
  VCall  = _VCall()  
  VCallQ = _VCall()  
  VCallF = _VCall()  
  VCallD = _VCall()  
  
EndModule

[wilbert]

A small cross platform example.

This is a call to a normal function which is also possible.
Pointers and 8, 16 and 32 bit integers can all be passed as type i.

Code: Select all

Procedure.d Test(a.l, b.q, c.f, d.d, e.l, f.d)
  Debug a
  Debug b
  Debug c
  Debug d
  Debug e
  Debug f
  ProcedureReturn f
EndProcedure

UseModule VCall

Dim Args.VCArgument(5)
Args(0)\i = 1
Args(1)\q = 2
Args(2)\f = 3
Args(3)\d = 4
Args(4)\i = 5
Args(5)\d = 6

Debug VCallD(@Test(), @Args(), @"iqfdid")

sprintf example

Code: Select all

UseModule VCall

Define *sprintf

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  *sprintf = dlsym_(#RTLD_DEFAULT, "sprintf")
CompilerElse
  ImportC ""
    sprintf
  EndImport
  *sprintf = @sprintf
CompilerEndIf

Dim Args.VCArgument(3)

*result = AllocateMemory(256)
*format = AllocateMemory(256)

PokeS(*format, "Formatting test %d out of %d", -1, #PB_Ascii)

Args(0)\i = *result
Args(1)\i = *format
Args(2)\i = 1
Args(3)\i = 2

VCall(*sprintf, @Args(), @"iiii")

Debug PeekS(*result, -1, #PB_Ascii)

PokeS(*format, "Formatting test %.1f out of %.1f", -1, #PB_Ascii)

Args(2)\d = 2
Args(3)\d = 2

VCall(*sprintf, @Args(), @"iidd")

Debug PeekS(*result, -1, #PB_Ascii)

FreeMemory(*format)
FreeMemory(*result)

[Justin]

Hi wilbert, that's a great code.
I tested the example on linux mint 32 and works.
So i asume it should work for this macos function? i haven't tested.
https://developer.apple.com/documentati ... guage=objc

[wilbert]

Hi wilbert, that's a great code.

Thanks

So i asume it should work for this macos function?

Yes, here's a small macOS example showing the seconds since January 1, 1970.

Code: Select all

UseModule VCall

*objc_msgSend = dlsym_(#RTLD_DEFAULT, "objc_msgSend")

Dim Args.VCArgument(2)

Args(0)\i = objc_getClass_("NSDate")
Args(1)\i = sel_registerName_("date")

NSDateNow = VCall(*objc_msgSend, @Args(), @"ii")

Args(0)\i = NSDateNow
Args(1)\i = sel_registerName_("dateByAddingTimeInterval:")
Args(2)\d = 86400

NSDateTomorrow = VCall(*objc_msgSend, @Args(), @"iid")

Args(0)\i = NSDateNow
Args(1)\i = sel_registerName_("timeIntervalSince1970")

Debug VCallD(*objc_msgSend, @Args(), @"ii"); Now

Args(0)\i = NSDateTomorrow

Debug VCallD(*objc_msgSend, @Args(), @"ii"); Tomorrow

[Justin]

It can be very useful when dealing with that kind of functions, thanks

[Tenaja]

Excellent! I will save this for later--thanks for sharing!

[idle]

nice, that will save a lot head banging on the desk.

[djes]

Thank you Wilbert !

[wilbert]

Thanks for the feedback

I posted a small update which adds two types ("m" and "r") to 64 bit macOS and Linux.
The calling convention Windows uses is less complicated and doesn't need those.
The calling convention macOS and Linux use for 64 bit ("System V Application Binary Interface") sometimes passes structures by registers and sometimes by memory.
If you are calling functions which don't use structures or pass them by reference, you don't have to worry about all of this.

Here's an example for macOS.
It's not a variadic function but illustrates calling procedures which return a structure.

Code: Select all

UseModule VCall

Dim Args.VCArgument(10)
VCReturn.VCReturn

*CGAffineTransformMakeTranslation = dlsym_(#RTLD_DEFAULT, "CGAffineTransformMakeTranslation")
*CGPointApplyAffineTransform = dlsym_(#RTLD_DEFAULT, "CGPointApplyAffineTransform")

Point.CGPoint
Transform.CGAffineTransform

Point\x = 100
Point\y = 50

; CGAffineTransform CGAffineTransformMakeTranslation(CGFloat tx, CGFloat ty);

Args(0)\i = @Transform
Args(1)\d = 10
Args(2)\d = 20
VCall(*CGAffineTransformMakeTranslation, @Args(), @"idd")

; CGPoint CGPointApplyAffineTransform(CGPoint point, CGAffineTransform t);

Args(0)\i = @VCReturn
Args(1)\d = Point\x
Args(2)\d = Point\y
Args(3)\d = Transform\a
Args(4)\d = Transform\b
Args(5)\d = Transform\c
Args(6)\d = Transform\d
Args(7)\d = Transform\tx
Args(8)\d = Transform\ty
VCall(*CGPointApplyAffineTransform, @Args(), @"rddmmmmmm")

Point\x = VCReturn\xmm0
Point\y = VCReturn\xmm1

Debug Point\x
Debug Point\y

CGAffineTransformMakeTranslation returns a structure CGAffineTransform which consists of 6 CGFloat values.
Because the structure is too big to return in registers, the caller needs to provide a pointer to memory as a (hidden) first argument where the result will be copied.

CGPointApplyAffineTransform returns a CGPoint and needs to pass a CGPoint and a CGAffineTransform structure.
The CGPoint structure is small enough to return in registers and therefore the result is returned by the xmm0 and xmm1 registers.
The CGPoint structure that is passed to the function, is also small enough to pass by registers.
The CGAffineTransform structure is bigger than 32 bytes and structures that large are always passed by memory.
In the example above, only 2 out of 8 floating point registers are used by the CGPoint structure so there would be room to pass the CGAffineTransform structure by registers but the rule of the structure being bigger than 32 bytes, demands that it is passed by memory. If the specified type for the CGAffineTransform fields would be "d" just like for the CGPoint fields, they would be passed by registers and things wouldn't work.

For more information on how to pass structures by value, you can look at the System V ABI.
This example may be complicated but it's just to demonstrate that it is possible to call this kind of functions.

[CELTIC88]

good to created with a scripting language
example:

dllcal("kernel32","sleep","i:200000")
translate to
Args(0)\i = 200000
VCall(GetFunction("kernel32","Sleep"), @Args(), @"i")

just an imagination...

[Kwai chang caine]

Thanks a lot WILBERT for your always more amazing code

In fact, i not dare answer to this thread, because i not really understand the goal of this jewel of code
WILBERT is able to create a monstruous ASM code, and KCC unable to understand nothing than the title



But CELTIC with his idea, help me to understand a little bit more how use your splendid function for API windows
Please CELTIC, can you give a full example of your code ?

[Justin]

Can this be used to pass a structure by value to an api function?

I need to call an interface method that requires a RECT passed by value, i tried splitting the values but i get a memory error.

[mk-soft]

Should be just right

sorry - update

Code: Select all

;

CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
  Macro RectByVal(_rect_)
    _rect_\top << 32 | _rect_\left ,_rect_\bottom << 32 | _rect_\right
  EndMacro
CompilerElse
  Macro RectByVal(_rect_)
    _rect_\left, _rect_\top, _rect_\right, _rect_\bottom
  EndMacro
CompilerEndIf

; Test

Procedure foo(left_top, rigth_bottom)
  Protected rc.rect
  PokeQ(@rc, left_top)
  PokeQ(@rc + 8, rigth_bottom)
  Debug rc\left
  Debug rc\top
  Debug rc\right
  Debug rc\bottom
EndProcedure

Global rc.Rect
rc\left = 10
rc\top = 5
rc\right = 125
rc\bottom = 30

foo(RectByVal(rc))

[wilbert]

Can this be used to pass a structure by value to an api function?

I need to call an interface method that requires a RECT passed by value, i tried splitting the values but i get a memory error.

That should be possible.
If the solution mk-soft offered doesn't work for you, can you share which api function you need ?

[mk-soft]

Sorry, update

false order of quad value