Ermitteln, ob Runtime-Procedure Parameter entgegennimmt

[Kiffi]

Hallo,

kann man mit PB-Boardmitteln herausfinden, ob eine Runtime-Prozedur mit oder ohne Parametern aufgerufen werden muss?

Beispiel 1: Wenn man die parameterlose Prozedur myProc1() mit einem Parameter aufruft, dann gibt es einen Invalid memory access:

Code: Alles auswählen

EnableExplicit

Runtime Procedure myProc1()
  Debug "this is myProc1()"
EndProcedure

Define ProcedureName.s
Define ProcedureAddress

ProcedureName = "myProc1()"
If IsRuntime(ProcedureName)
  ProcedureAddress = GetRuntimeInteger(ProcedureName)
  Debug ProcedureName + " at address: " + ProcedureAddress 
  If ProcedureAddress
    CallFunctionFast(ProcedureAddress) ; OK
    CallFunctionFast(ProcedureAddress, 123) ; IMA
  EndIf
EndIf

Beispiel 2: Procedure myProc2() erwartet einen Parameter. Wenn ich diese ohne Parameter aufrufe, dann wird die Prozedur zwei mal aufgerufen (?) und das Programm bleibt hängen.

Code: Alles auswählen

EnableExplicit

Runtime Procedure myProc2(myParam)
  Debug "this is myProc2()"
  Debug "myParam: " + myParam
EndProcedure
  
Define ProcedureName.s
Define ProcedureAddress

ProcedureName = "myProc2()"
If IsRuntime(ProcedureName)
  ProcedureAddress = GetRuntimeInteger(ProcedureName)
  Debug ProcedureName + " at address: " + ProcedureAddress 
  If ProcedureAddress
    CallFunctionFast(ProcedureAddress, 123) ; OK
    CallFunctionFast(ProcedureAddress) ; doppelter Aufruf, dann bleibt das Programm hängen
  EndIf
EndIf

Danke im Voraus & Grüße ... Peter

[mk-soft]

Geht leider nicht.

Parameter-Count im Procedure-Name hinterlegen oder immer mit fester Parameteranzahl arbeiten.

[NicTheQuick]

Da kann man so nichts dran ändern, da du den Stack durcheinander bringst, wenn du n Parameter zu wenig oder zu viel übergibst. Du musst wohl grundlegend etwas an deiner Idee ändern. Was hast du eigentlich vor?

[Kiffi]

Hallo mk-soft & NicTheQuick,

Was hast du eigentlich vor?

das weiß ich selber auch noch nicht so ganz genau.

Prinzipiell möchte ich via TCP/IP Runtime-Prozeduren in meinem Programm aufrufen. Diese haben generell eine feste Anzahl von Übergabeparametern.

Wenn ich allerdings im Eifer des Gefechts bei einer neuen Runtime-Prozedur den Parameter vergesse, schmiert mein Programm ab. Das finde ich unschick. Wäre schöner, wenn man das vorher testen könnte.

Schade & Danke Euch beiden & Grüße ... Peter

[#NULL]

Du könntest den Funktionen vielleicht eine Annotation in einem Comment geben, dann Compiler_File Includen und daraus den Code Peeken. Die Funktions Köpfe könntest du dann ja noch weiter parsen:

Code: Alles auswählen

Procedure p1() ; callable
  ProcedureReturn 123
EndProcedure

Procedure p2(p)
  ProcedureReturn p
EndProcedure

Procedure p3(p, pp) ; callable
  ProcedureReturn p
EndProcedure

NewList callable.s()
code.s = PeekS(?l_codestart+3, ?l_codeend - ?l_codestart - 3, #PB_UTF8 | #PB_ByteLength) ; (file should be utf-8, 3 bytes BOM)
code = ReplaceString(code, #CRLF$, #LF$)
code = ReplaceString(code, #CR$, #LF$)
nbLines = CountString(code, #LF$)
For l = 1 To nbLines + 1
  line.s = LCase(Trim(StringField(code, l, #LF$)))
  If (FindString(line, "procedure") = 1) And (FindString(line, "; callable") = Len(line) - 10 + 1)
    AddElement(callable())
    callable() = line
  EndIf
Next

ForEach callable()
  Debug callable()
Next

DataSection
  l_codestart:
  IncludeBinary #PB_Compiler_File
  l_codeend:
EndDataSection

Geht natürlich nur mit eigenen Funktionen.

[NicTheQuick]

Dann wäre der komplette Quellcode aber im im Executable und es ginge nicht mit Includes.

[Mijikai]

Wenn es eine PureBasic Funktion ist geht es mit etwas schwarzer Magie

Allerdings sollte man dies vorher testen da sich der (hinter den Kulissen erzeugte) Assembly Code unter
Umständen ändern kann wenn z.B. eine andere PureBasic Version verwendet wird oder eine anderes OS.

Code (PB v.5.60 x64 Windows):

Code: Alles auswählen

;by Mijikai
;x64 only!

Procedure.i GetParameterCount(*Proc)
  Protected *W.Word
  Protected *A.Ascii
  Protected *P.Ascii
  Protected Cnt.i
  *W = *Proc
  If *W\w = -31928
    ProcedureReturn 0
  Else
    Cnt + 1
    *A = *W + 1
    *P = *W + 4
    While *A\a = 137 And *P\a = 8 * Cnt
      *A + 5
      *P + 5
      Cnt + 1
    Wend
    Cnt - 1
    If Cnt = 0
      ProcedureReturn -1
    Else
      ProcedureReturn Cnt
    EndIf
  EndIf
  ProcedureReturn -1
EndProcedure

;->Debug GetParameterCount(@ProcedureXYZ())

[Kiffi]

Wenn es eine PureBasic Funktion ist geht es mit etwas schwarzer Magie

Teufelszeuch!

Aber es funktioniert!

Danke & Grüße ... Peter

[mk-soft]

Ohne Magie

Mit Macro für die Parmeter und Prototype für den Aufruf.
Sollte sich die Parameter ändern, brauch diese nur an den Macro durchgeführt werden.

Code: Alles auswählen

;-TOP

; Runtime Procedure mit festen Parametern

Macro RT_Args
  p1=0, p2=0, p3=0, p4=0, p5=0, p6=0, p7=0, p8=0
EndMacro

Prototype RT_Invoke(RT_Args)

Runtime Procedure myProc1(RT_Args)
  Debug "myProc3: p8 = " + p8 
EndProcedure

Runtime Procedure myProc2(RT_Args)
  Debug "myProc3: p8 = " + p8 
EndProcedure

Runtime Procedure myProc3(RT_Args)
  Debug "myProc3: p8 = " + p8 
EndProcedure

ProcedureName.s = "myProc1()"
If IsRuntime(ProcedureName)
  ProcedureAddress.RT_Invoke = GetRuntimeInteger(ProcedureName)
  Debug ProcedureName + " at address: " + ProcedureAddress
  If ProcedureAddress
    ProcedureAddress() ; OK
  EndIf
EndIf

ProcedureName.s = "myProc3()"
If IsRuntime(ProcedureName)
  ProcedureAddress.RT_Invoke = GetRuntimeInteger(ProcedureName)
  Debug ProcedureName + " at address: " + ProcedureAddress
  If ProcedureAddress
    ProcedureAddress(1, 2, 3, 4, 5, 6, 7, 8) ; OK
  EndIf
EndIf

Um Parameter mit verschiedenen Typen zu übergeben baute ich mir immer ein Variablentype Any zusammen

Code: Alles auswählen

;-TOP

; Runtime Procedure mit festen Parametern

EnableExplicit

Structure udtAny
  Type.i
  StructureUnion
    lVal.l
    iVal.i
    qVal.q
    fltVal.f
    dblVal.d
  EndStructureUnion
  strVal.s
EndStructure

Macro RT_AnyArgs
  *p1.udtAny=0, *p2.udtAny=0, *p3.udtAny=0, *p4.udtAny=0, *p5.udtAny=0, *p6.udtAny=0, *p7.udtAny=0, *p8.udtAny=0
EndMacro
  
Macro SetAny(Var, Value)
  Var\Type = TypeOf(Value)    
  CompilerSelect TypeOf(Value)
    CompilerCase #PB_Long
      Var\lVal = Value
    CompilerCase #PB_Integer
      Var\iVal = Value
    CompilerCase #PB_Quad
      Var\qVal = Value
    CompilerCase #PB_Float
      Var\fltVal = Value
    CompilerCase #PB_Double
      Var\dblVal = Value
    CompilerCase #PB_String
      Var\strVal = Value
  CompilerEndSelect
EndMacro

; IDE Helper
Define *p1.udtAny, *p2.udtAny, *p3.udtAny, *p4.udtAny, *p5.udtAny, *p6.udtAny, *p7.udtAny, *p8.udtAny

Prototype RT_Invoke(RT_AnyArgs)

Runtime Procedure myProc1(RT_AnyArgs)
  If *p1 And *p1\Type = #PB_String
    Debug "Text = " + *p1\strVal
  Else
    Debug "Error: p1 falscher Type"
  EndIf
EndProcedure

Runtime Procedure myProc2(RT_AnyArgs)
  Debug "myProc3: p8 = " + *p8 
EndProcedure

Runtime Procedure myProc3(RT_AnyArgs)
  Debug "myProc3: p8 = " + *p8 
EndProcedure


Define.udtAny p1,p2,p3,p4,p5,p6,p7,p8

Define ProcedureName.s = "myProc1()"
Define s1.s = "Hello World"
SetAny(p1.udtAny, s1)

If IsRuntime(ProcedureName)
  Define ProcedureAddress.RT_Invoke = GetRuntimeInteger(ProcedureName)
  Debug ProcedureName + " at address: " + ProcedureAddress
  If ProcedureAddress
    ProcedureAddress(p1) ; OK
  EndIf
EndIf

If IsRuntime(ProcedureName)
  Define ProcedureAddress.RT_Invoke = GetRuntimeInteger(ProcedureName)
  Debug ProcedureName + " at address: " + ProcedureAddress
  If ProcedureAddress
    ProcedureAddress(0) ; OK
  EndIf
EndIf

ProcedureName.s = "myProc3()"
If IsRuntime(ProcedureName)
  ProcedureAddress.RT_Invoke = GetRuntimeInteger(ProcedureName)
  Debug ProcedureName + " at address: " + ProcedureAddress
  If ProcedureAddress
    ProcedureAddress(1, 2, 3, 4, 5, 6, 7, 8) ; OK
  EndIf
EndIf

[NicTheQuick]

Wenn es eine PureBasic Funktion ist geht es mit etwas schwarzer Magie

Leider funktioniert diese schwarze Magie nicht unter Linux.