Dynamical calling interface

[Melissa]

Summarizing: http://www.purebasic.fr/english/viewtop ... 13&t=41718
Needs to call procedure by pointer while obtaining number of required parameters on run-time ? No problemo anymore:

Code: Select all

; */=\=/=\=/=\=/=\=/=\=/=\=/=\=/=\=/*
; Dynamical calling interface v0.14
; Developed in 2010 by Dr. Melissa
; *\=/=\=/=\=/=\=/=\=/=\=/=\=/=\=/=\*

;{ ==Internal definitions==
Structure __DataTypes
StructureUnion
B.b : W.w : C.c : L.l : F.f ; Old types 
Q.q : D.d : I.i : A.a : U.u ; New types.
EndStructureUnion
*DataSize ; Internal mark, not used.
EndStructure

Structure CallData
*DataPtr    ; Pointer to data buffer
DataSize.I  ; Size of data buffer
UseGrowth.I ; Flag for dynamical buffer
*Passer.__DataTypes ; Tool for passing data
EndStructure

Define *__ThisCall.CallData

; ==Partializers & templates==
Macro __ValCopy(ValAccum, PassExtra)
CompilerIf OffsetOf(__DataTypes\PassExtra)
CopyMemory(ValAccum, *Call\Passer, PassExtra)
CompilerElse : *Call\Passer\PassExtra = ValAccum
CompilerEndIf
EndMacro

Macro __PassTemplate(ValAccum, SizeAccum, PassExtra)
Shared *__ThisCall ; 'cause it's used there.
If *Call = #Null : *Call = *__ThisCall : Else : *__ThisCall = *Call : EndIf
If *Call\UseGrowth : *Call\DataSize + SizeAccum
*Call\DataPtr = ReAllocateMemory(*Call\DataPtr, *Call\DataSize)
*Call\Passer = *Call\DataPtr + *Call\DataSize - SizeAccum
__ValCopy(ValAccum, PassExtra) ; Finally...
Else ; A lot more faster way:
__ValCopy(ValAccum, PassExtra)
*Call\Passer + SizeAccum
EndIf
EndMacro
;}

;{ ==External definitions==
; BeginNewCall(DataSize.i) - prepares new calling ceremony.
; Set 'DataSize' to #Null for dynamical expansion of data buffer. 
; Returns point to newborn caller's data and making it default.
ProcedureDLL BeginNewCall(DataSize.i = #Null)
Shared *__ThisCall ; 'cause it's used there.
Define *NewCall.CallData = AllocateMemory(SizeOf(CallData))
With *NewCall
If DataSize > 0 ; If static buffer required...
\DataPtr = AllocateMemory(DataSize) 
\DataSize = DataSize : \Passer = \DataPtr
Else : \UseGrowth = #True ; Dynamical buffer.
\DataPtr = AllocateMemory(1) : \DataSize = 0
EndIf : *__ThisCall = *NewCall
ProcedureReturn *NewCall
EndWith
EndProcedure

; GetCurrentCall() - returns pointer to default caller's data.
ProcedureDLL GetCurrentCall()
Shared *__ThisCall ; 'cause it's used there.
ProcedureReturn *__ThisCall ; ...and returned.
EndProcedure

; SetCurrentCall(*Call.CallData) - defines referenced caller as default one.
; Warning: no checks for passing invalid pointer would be made here !
ProcedureDLL SetCurrentCall(*Call.CallData)
Shared *__ThisCall ; 'cause it's used there.
*__ThisCall = *Call ; ...and redefined.
EndProcedure

; PassData(*DataPtr, DataSize, *Call.CallData) - pushes given number of bytes from pointer into data buffer.
; Set '*Call' to #Null for using default caller, otherwise it would be defined as one.
; Data would be passed through plain CopyMemory without any validation measures.
; Warning: no overflow checks would be made for static buffer !
ProcedureDLL PassData(*DataPtr, DataSize, *Call.CallData = #Null)
__PassTemplate(*DataPtr, DataSize, DataSize)
EndProcedure

Macro __Def_CallProcs(TypeName, TypeLetter)
; PassX(Value.X, *Call.CallData) - pushes new parameter of type X into data buffer.
; Set '*Call' to #Null for using default caller, otherwise it would be defined as one.
; Warning: no overflow checks would be made for static buffer !
ProcedureDLL Pass#TypeLetter(Val.TypeLetter, *Call.CallData = #Null)
__PassTemplate(Val, SizeOf(TypeName), TypeLetter)
EndProcedure

; FinishCallingAsX(*ProcPtr, *Call.CallData) - executes pointed code with desired caller.
; Data referenced by '*Call' would be disposed here. Set it to #Null for using default caller's info.
; Result would be returned from called procedure as X type.
Prototype.TypeLetter VoidCall#TypeLetter#__()
ProcedureDLL.TypeLetter FinishCallingAs#TypeLetter(*ProcPtr, *Call.CallData = #Null)
Shared *__ThisCall ; 'cause it's used there.
Static *CallPtr.VoidCall#TypeLetter#__
Static Result.TypeLetter, *Calling.CallData
If *Call = #Null : *Calling = *__ThisCall ; Using default.
Else : *Calling = *Call : EndIf  ; Using referenced caller.
EnableASM ; Could be done without that, but looks worse.
*CallPtr = *ProcPtr ; To be independent from locals.
If *Calling\DataSize ; If parameters passing required...
MOV *Calling\UseGrowth, ESP ; Saving initial ESP.
SUB ESP, *Calling\DataSize ; Stack correction.
MOV *Calling\Passer, ESP ; Retrieving new ESP.
CopyMemory(*Calling\DataPtr, *Calling\Passer, *Calling\DataSize)
EndIf : Result = *CallPtr() ; Finally doing it.
; Some clean-up:
MOV ESP, *Calling\UseGrowth
FreeMemory(*Calling\DataPtr)
FreeMemory(*Calling)
DisableASM
ProcedureReturn Result
EndProcedure
EndMacro

; ==Automatized definition block==
__Def_CallProcs(Byte, B)
__Def_CallProcs(Word, W)
__Def_CallProcs(Long, L)
__Def_CallProcs(Float, F)
__Def_CallProcs(Quad, Q)
__Def_CallProcs(Double, D)
__Def_CallProcs(Character, C)
__Def_CallProcs(Integer, I)
__Def_CallProcs(Ascii, A)
__Def_CallProcs(Unicode, U)
;}

...now some example of actual usage...

Code: Select all

Procedure.f Plus(A.f, B.l)
ProcedureReturn A.f + B 
EndProcedure

BeginNewCall() ; Easy as that.
PassF(1) : PassI(2) ; A.f and B.l
Debug FinishCallingAsF(@Plus()) ; 3.0

Warning: it isn't recommended to use FinishCallingAsX procedures in few threads simultaneously.

[DoctorLove]

Wow, dynamically?

Great code, i will try this out. That was something i missed in the language itself.
Thnx!

[Peyman]

Very Nice job, thanks job.
this is possible to add cdecl call, this code is very good.

[Melissa]

Well, updated first post with recently added support for cdecl calls. No knowledge on 'user' side required – just automatized stack restoration. BASIC way, I guess...

[Peyman]

wow very good work thanks.
i have some question, so why CallFunction of purebasic has limited to 20 parameters but this code not ?
why purebasic have CallFunction and CallCFunction for standard call and cdecl call but this code not ?

and one another thing, this way is good for passing string :

Code: Select all

ProcedureC.i Plus(a.i, b.i, c.s)
  Debug c
  ProcedureReturn a + b
EndProcedure

BeginNewCall() ; Easy as that.

text.s = "Sample Text"

For i = 1 To 2
  PassI(i)
Next

PassI(@text)

Debug FinishCallingAsi(@Plus()) ; 3

[Thalius]

Code: Select all

CallFunction(Fast) and CallCFunction

are old Relicts.

Generally nowadays the use of Interfaces is strongly recommended. While this piece of code is pretty handy tho i must admit

Cheers,
Thalius

[Melissa]

Updated first post to add new PassData procedure. Ability to pass any structures directly on stack for APIs like PtInRect was just one of things which I already ceased to wait from Fantaisie Software, so that could be also considered as self-help)...

i have some question, so why CallFunction of purebasic has limited to 20 parameters but this code not ?
why purebasic have CallFunction and CallCFunction for standard call and cdecl call but this code not ?

Well, I believe that it was part of Fred's politics to make Call(C)Function(Fast) family as unusable as it ever possible. That could be quite fair, however, since procedure with variant number of variant typed parameters leaves really big hole in PB’s overall ideology.

and one another thing, this way is good for passing string

Sure, yet I’m already working on some more convenient interface for such things. If only I had more time to reverse engineer local GC mechanisms for cleaning unused strings...