From 78c62be048b493e5945e2d98dce5584ff7232ede Mon Sep 17 00:00:00 2001 From: evgenyk Date: Wed, 13 Sep 2023 13:43:51 +0300 Subject: [PATCH] 266: Error when calling delphi function in x64 mode --- Source/InvokeCall.inc | 416 ++++++++++++++++++++++-------------------- Source/uPSRuntime.pas | 42 ++++- 2 files changed, 246 insertions(+), 212 deletions(-) diff --git a/Source/InvokeCall.inc b/Source/InvokeCall.inc index 3a59b5d..0c0c931 100644 --- a/Source/InvokeCall.inc +++ b/Source/InvokeCall.inc @@ -1,202 +1,214 @@ -function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean; -var SysCalConv : TCallConv; - Args: TArray; - Arg : TValue; - i : Integer; - fvar: PPSVariantIFC; - IsConstr : Boolean; - ctx: TRTTIContext; - RttiType : TRttiType; - ResValue : TValue; -begin - Result := False; - case CallingConv of - cdRegister : SysCalConv := ccReg; - cdPascal : SysCalConv := ccPascal; - cdCdecl : SysCalConv := ccCdecl; - cdStdCall : SysCalConv := ccStdCall; - cdSafeCall : SysCalConv := ccSafeCall; - else - SysCalConv := ccReg;//to prevent warning "W1036 Variable might not have been initialized" - end; - - if Assigned(_Self) then - Args := Args + [TValue.From( _Self )]; - - for I := 0 to Params.Count - 1 do - begin - if Params[i] = nil - then Exit; - fvar := Params[i]; - - if fvar.varparam then - begin { var param } - case fvar.aType.BaseType of - btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF} - btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency, - btUnicodeString - {$IFNDEF PS_NOINT64}, bts64{$ENDIF}: - Arg := TValue.From( Pointer(fvar.dta) ); - else - begin - Exit; - end; - end; - end - else - begin { not a var param } - case fvar.aType.BaseType of - { add normal params here } - {$IFNDEF PS_NOWIDESTRING} - btWidestring, - btUnicodestring, - {$ENDIF} - btString: Arg := TValue.From(pstring(fvar.dta)^); - btU8, btS8: Arg := TValue.From(pbyte(fvar.dta)^); - btU16, BtS16: Arg := TValue.From(pword(fvar.dta)^); - btU32, btS32: Arg := TValue.From(pCardinal(fvar.dta)^); - {$IFNDEF PS_NOINT64}bts64:{$ENDIF} Arg := TValue.From(pint64(fvar.dta)^); - btSingle: Arg := TValue.From(PSingle(fvar.dta)^); - btDouble: Arg := TValue.From(PDouble(fvar.dta)^); - btExtended: Arg := TValue.From(PExtended(fvar.dta)^); - btPChar: Arg := TValue.From(ppchar(fvar.dta)^); - btChar: Arg := TValue.From(pchar(fvar.dta)^); - btClass: Arg := TValue.From(TObject(fvar.dta^)); - btRecord: Arg := TValue.From(fvar.dta); - btStaticArray: Arg := TValue.From(fvar.dta); - btVariant: - Arg := TValue.From(Variant(fvar.dta^)); - btArray: - begin - if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then - begin //openarray - //in case of openarray we should provide TWO params: first is pointer to array, - Args := Args + [TValue.From(Pointer(fvar.Dta^))]; - //2nd - integer with arraylength - 1 (high) - Arg := TValue.From(PSDynArrayGetLength(Pointer(fvar.Dta^), fvar.aType)-1);// = High of OpenArray - end - else //dynarray = just push pointer - Arg := TValue.From(fvar.dta); - end; - btSet: - begin - case TPSTypeRec_Set(fvar.aType).aByteSize of - 1: Arg := TValue.From(pbyte(fvar.dta)^); - 2: Arg := TValue.From(pWord(fvar.dta)^); - 3, - 4: Arg := TValue.From(pCardinal(fvar.dta)^); - else - Arg := TValue.From(fvar.dta); - end; - end; - else -// writeln(stderr, 'Parameter type not implemented!'); - Exit; - end; { case } - end; - Args := Args + [Arg]; - end; - - IsConstr := (Integer(CallingConv) and 64) <> 0; - if not assigned(res) then - begin - Invoke(Address,Args,SysCalConv,nil,False,IsConstr); { ignore return } - end - else begin - case res.atype.basetype of - { add result types here } - btString: tbtstring(res.dta^) := tbtstring(Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString) - ; - {$IFNDEF PS_NOWIDESTRING} - btUnicodeString: tbtunicodestring(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString; - btWideString: tbtWideString(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString; - {$ENDIF} - btU8, btS8: pbyte(res.dta)^ := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),False,IsConstr).AsInteger); - btU16, btS16: pword(res.dta)^ := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),False,IsConstr).AsInteger); - btU32, btS32: pCardinal(res.dta)^ := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),False,IsConstr).AsInteger); - {$IFNDEF PS_NOINT64}bts64:{$ENDIF} pInt64(res.dta)^ := Int64(Invoke(Address,Args,SysCalConv,TypeInfo(Int64),False,IsConstr).AsInt64); - btSingle: psingle(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Single),False,IsConstr).AsExtended); - btDouble: pdouble(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Double),False,IsConstr).AsExtended); - btExtended: pextended(res.dta)^ := Extended(Invoke(Address,Args,SysCalConv,TypeInfo(Extended),False,IsConstr).AsExtended); - {$IFDEF FPC} - btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),False,IsConstr).AsOrdinal); - btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),False,IsConstr).AsChar); - {$ELSE} - btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),False,IsConstr).AsType()); - btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),False,IsConstr).AsType()); - {$ENDIF} - btSet: - begin - case TPSTypeRec_Set(res.aType).aByteSize of - 1: byte(res.Dta^) := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),False,IsConstr).AsInteger); - 2: word(res.Dta^) := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),False,IsConstr).AsInteger); - 3, - 4: Longint(res.Dta^) := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),False,IsConstr).AsInteger); - {$IFNDEF FPC} - else - begin - for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkSet) - and (RttiType.TypeSize = TPSTypeRec_Set(res.aType).aByteSize) then - begin - Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).ExtractRawData(res.dta); - Break; - end; - end; - {$ENDIF} - end; - end; - btClass: - begin - {$IFNDEF FPC}for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkClass) then{$ENDIF} - begin - TObject(res.dta^) := Invoke(Address,Args,SysCalConv,{$IFDEF FPC}TypeInfo(TObject){$ELSE}RttiType.Handle{$ENDIF},False,IsConstr).AsObject; - {$IFNDEF FPC}Break;{$ENDIF} - end; - end; - {$IFNDEF FPC} - btStaticArray: - begin - for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkArray) then - begin - CopyArrayContents(res.dta, Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).GetReferenceToRawData, TPSTypeRec_StaticArray(res.aType).Size, TPSTypeRec_StaticArray(res.aType).ArrayType); - Break; - end; - end; - btRecord: - begin - for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkRecord) then - begin - CopyArrayContents(res.dta, (Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).GetReferenceToRawData), 1, res.aType); - Break; - end; - end; - btArray: //need to check with open arrays - begin - for RttiType in ctx.GetTypes do - if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkDynArray) then - begin - ResValue := Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr); - if ResValue.GetArrayLength > 0 then - CopyArrayContents(res.dta, ResValue.GetReferenceToRawData, 1, res.aType) - else - res.dta := nil; - Break; - end; - end; - btVariant: - begin - PVariant(res.dta)^ := Invoke(Address, Args, SysCalConv, TypeInfo(Variant), False, IsConstr).AsVariant; - end; - {$ENDIF} - else -// writeln(stderr, 'Result type not implemented!'); - Exit; - end; { case } - end; //assigned(res) - - Result := True; -end; +function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean; +var SysCalConv : TCallConv; + Args: TArray; + Arg : TValue; + i : Integer; + fvar: PPSVariantIFC; + IsConstr : Boolean; + IsStatic : Boolean; + ctx: TRTTIContext; + RttiType : TRttiType; + ResValue : TValue; +begin + Result := False; + IsStatic := _Self = nil; + case CallingConv of + cdRegister : SysCalConv := ccReg; + cdPascal : SysCalConv := ccPascal; + cdCdecl : SysCalConv := ccCdecl; + cdStdCall : SysCalConv := ccStdCall; + cdSafeCall : SysCalConv := ccSafeCall; + else + SysCalConv := ccReg;//to prevent warning "W1036 Variable might not have been initialized" + end; + + if not IsStatic then begin + {$IFDEF CPUX86} + if CallingConv <> cdPascal then + {$ENDIF CPUX86} + Args := Args + [TValue.From( _Self )]; + end; + + for I := 0 to Params.Count - 1 do + begin + if Params[i] = nil + then Exit; + fvar := Params[i]; + + if fvar.varparam then + begin { var param } + case fvar.aType.BaseType of + btArray, btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, {$IFNDEF PS_NOWIDESTRING} btWideString, btWideChar, {$ENDIF} + btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency, + btUnicodeString + {$IFNDEF PS_NOINT64}, bts64{$ENDIF}: + Arg := TValue.From( Pointer(fvar.dta) ); + else + begin + Exit; + end; + end; + end + else + begin { not a var param } + case fvar.aType.BaseType of + { add normal params here } + {$IFNDEF PS_NOWIDESTRING} + btWidestring, + btUnicodestring, + {$ENDIF} + btString: Arg := TValue.From(pstring(fvar.dta)^); + btU8, btS8: Arg := TValue.From(pbyte(fvar.dta)^); + btU16, BtS16: Arg := TValue.From(pword(fvar.dta)^); + btU32, btS32: Arg := TValue.From(pCardinal(fvar.dta)^); + {$IFNDEF PS_NOINT64}bts64:{$ENDIF} Arg := TValue.From(pint64(fvar.dta)^); + btSingle: Arg := TValue.From(PSingle(fvar.dta)^); + btDouble: Arg := TValue.From(PDouble(fvar.dta)^); + btExtended: Arg := TValue.From(PExtended(fvar.dta)^); + btPChar: Arg := TValue.From(ppchar(fvar.dta)^); + btChar: Arg := TValue.From(pchar(fvar.dta)^); + btClass: Arg := TValue.From(TObject(fvar.dta^)); + btRecord: Arg := TValue.From(fvar.dta); + btStaticArray: Arg := TValue.From(fvar.dta); + btVariant: + Arg := TValue.From(Variant(fvar.dta^)); + btArray: + begin + if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then + begin //openarray + //in case of openarray we should provide TWO params: first is pointer to array, + Args := Args + [TValue.From(Pointer(fvar.Dta^))]; + //2nd - integer with arraylength - 1 (high) + Arg := TValue.From(PSDynArrayGetLength(Pointer(fvar.Dta^), fvar.aType)-1);// = High of OpenArray + end + else //dynarray = just push pointer + Arg := TValue.From(fvar.dta); + end; + btSet: + begin + case TPSTypeRec_Set(fvar.aType).aByteSize of + 1: Arg := TValue.From(pbyte(fvar.dta)^); + 2: Arg := TValue.From(pWord(fvar.dta)^); + 3, + 4: Arg := TValue.From(pCardinal(fvar.dta)^); + else + Arg := TValue.From(fvar.dta); + end; + end; + else +// writeln(stderr, 'Parameter type not implemented!'); + Exit; + end; { case } + end; + Args := Args + [Arg]; + end; + + {$IFDEF CPUX86} + if not IsStatic then begin + if CallingConv = cdPascal then + Args := Args + [TValue.From( _Self )]; + end; + {$ENDIF CPUX86} + + IsConstr := (Integer(CallingConv) and 64) <> 0; + if not assigned(res) then + begin + Invoke(Address, Args, SysCalConv, nil); { ignore return } + end + else begin + case res.atype.basetype of + { add result types here } + btString: tbtstring(res.dta^) := tbtstring(Invoke(Address,Args,SysCalConv,TypeInfo(String),IsStatic).AsString); + {$IFNDEF PS_NOWIDESTRING} + btUnicodeString: tbtunicodestring(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),IsStatic).AsString; + btWideString: tbtWideString(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),IsStatic).AsString; + {$ENDIF} + btU8, btS8: pbyte(res.dta)^ := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),IsStatic).AsInteger); + btU16, btS16: pword(res.dta)^ := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),IsStatic).AsInteger); + btU32, btS32: pCardinal(res.dta)^ := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),IsStatic).AsInteger); + {$IFNDEF PS_NOINT64}bts64:{$ENDIF} pInt64(res.dta)^ := Int64(Invoke(Address,Args,SysCalConv,TypeInfo(Int64),IsStatic).AsInt64); + btSingle: psingle(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Single),IsStatic).AsExtended); + btDouble: pdouble(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Double),IsStatic).AsExtended); + btExtended: pextended(res.dta)^ := Extended(Invoke(Address,Args,SysCalConv,TypeInfo(Extended),IsStatic).AsExtended); + {$IFDEF FPC} + btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),IsStatic).AsOrdinal); + btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),IsStatic).AsChar); + {$ELSE} + btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),IsStatic).AsType()); + btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),IsStatic).AsType()); + {$ENDIF} + btSet: + begin + case TPSTypeRec_Set(res.aType).aByteSize of + 1: byte(res.Dta^) := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),IsStatic).AsInteger); + 2: word(res.Dta^) := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),IsStatic).AsInteger); + 3, + 4: Longint(res.Dta^) := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),IsStatic).AsInteger); + {$IFNDEF FPC} + else + begin + for RttiType in ctx.GetTypes do + if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkSet) + and (RttiType.TypeSize = TPSTypeRec_Set(res.aType).aByteSize) then + begin + Invoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic).ExtractRawData(res.dta); + Break; + end; + end; + {$ENDIF} + end; + end; + btClass: + begin + {$IFNDEF FPC}for RttiType in ctx.GetTypes do + if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkClass) then{$ENDIF} + begin + TObject(res.dta^) := Invoke(Address,Args,SysCalConv,{$IFDEF FPC}TypeInfo(TObject){$ELSE}RttiType.Handle{$ENDIF},IsStatic, IsConstr).AsObject; + {$IFNDEF FPC}Break;{$ENDIF} + end; + end; + {$IFNDEF FPC} + btStaticArray: + begin + for RttiType in ctx.GetTypes do + if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkArray) then + begin + CopyArrayContents(res.dta, Invoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic).GetReferenceToRawData, TPSTypeRec_StaticArray(res.aType).Size, TPSTypeRec_StaticArray(res.aType).ArrayType); + Break; + end; + end; + btRecord: + begin + for RttiType in ctx.GetTypes do + if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkRecord) then + begin + CopyArrayContents(res.dta, (Invoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic).GetReferenceToRawData), 1, res.aType); + Break; + end; + end; + btArray: //need to check with open arrays + begin + for RttiType in ctx.GetTypes do + if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkDynArray) then + begin + ResValue := Invoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic); + if ResValue.GetArrayLength > 0 then + CopyArrayContents(res.dta, ResValue.GetReferenceToRawData, 1, res.aType) + else + res.dta := nil; + Break; + end; + end; + btVariant: + begin + PVariant(res.dta)^ := Invoke(Address, Args, SysCalConv, TypeInfo(Variant), IsStatic).AsVariant; + end; + {$ENDIF} + else +// writeln(stderr, 'Result type not implemented!'); + Exit; + end; { case } + end; //assigned(res) + + Result := True; +end; diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas index 8fac357..effe55a 100644 --- a/Source/uPSRuntime.pas +++ b/Source/uPSRuntime.pas @@ -7623,6 +7623,8 @@ begin Result := TMethod(Meth).Code; end; {$IFDEF LOG} +function NilProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; forward; + procedure ODSvar(name: string; data: TPSResultData); begin __Log(name + '= $'+IntToHex(IPointer(data.P))+', '+ @@ -7633,12 +7635,24 @@ begin end; procedure ODS_TPSExternalProcRec(name: string; data: TPSExternalProcRec); +var + s: string; begin - __Log(name + ': name='+string(data.Name)+', '+ + s := string(data.Name); + if s = '' then begin + if @data.ProcPtr = @NilProc then + s := 'NilProc'; + end; + __Log(name + ': name='+s+', '+ 'ext1=$'+ IntToHex(IPointer(TObject(data.ext1)))+', '+ 'ext2=$'+ IntToHex(IPointer(TObject(data.ext2)))); end; +procedure ODS_TPSInternalProcRec(name: string; data: TPSInternalProcRec); +begin + __Log(name + ': name='+string(data.ExportName)); +end; + procedure ODS_stack(stack: TPSStack); var i: integer; @@ -8025,21 +8039,21 @@ begin Cmd_Err(erOutOfRange); Break; end; - {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} + {$ifdef FPC_REQUIRES_PROPER_ALIGNMENT} p := unaligned(Cardinal((@FData^[FCurrentPosition])^)); - {$else} + {$else} p := Cardinal((@FData^[FCurrentPosition])^); - {$endif} + {$endif} Inc(FCurrentPosition, 4); if p >= FProcs.Count then begin CMD_Err(erOutOfProcRange); break; end; u := FProcs.Data^[p]; - {$IFDEF LOG} - ODS_TPSExternalProcRec('proc', TPSExternalProcRec(u)); - {$ENDIF} if u.ClassType = TPSExternalProcRec then begin + {$IFDEF LOG} + ODS_TPSExternalProcRec('proc', TPSExternalProcRec(u)); + {$ENDIF} try if not TPSExternalProcRec(u).ProcPtr(Self, TPSExternalProcRec(u), FGlobalVars, FStack) then begin if ExEx = erNoError then @@ -8090,6 +8104,10 @@ begin {$ENDIF} end else begin + {$IFDEF LOG} + if u.ClassType = TPSInternalProcRec then + ODS_TPSInternalProcRec('proc', TPSInternalProcRec(u)); + {$ENDIF} Vtemp := Fstack.PushType(FReturnAddressType); vd.P := Pointer(IPointer(VTemp)+PointerSize); vd.aType := pointer(vtemp^); @@ -10481,6 +10499,8 @@ begin CurrStack := Cardinal(Stack.Count) - Cardinal(length(s)) -1; if s[1] = #0 then inc(CurrStack); MyList := TPSList.Create; + if p.Ext2 = nil then + MyList.Add(NewPPSVariantIFC(n, False)); for i := 2 to length(s) do begin MyList.Add(nil); @@ -10497,7 +10517,7 @@ begin end else v := nil; try if p.Ext2 = nil then - Result := Caller.InnerfuseCall(FSelf, p.Ext1, cc, MyList, v) + Result := Caller.InnerfuseCall(nil, p.Ext1, cc, MyList, v) else Result := Caller.InnerfuseCall(FSelf, VirtualMethodPtrToPtr(p.Ext1, FSelf), cc, MyList, v); finally @@ -11073,13 +11093,14 @@ begin exit; end; Params := TPSList.Create; + Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - 2], False)); Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - 1], True)); for i := Stack.Count -3 downto Longint(Stack.Count) - ParamCount -2 do begin Params.Add(NewPPSVariantIFC(Stack[I], False)); end; try - Result := Caller.InnerfuseCall(FSelf, p.Ext1, cdRegister, Params, nil); + Result := Caller.InnerfuseCall(nil, p.Ext1, cdRegister, Params, nil); finally DisposePPSVariantIFCList(Params); end; @@ -11099,6 +11120,7 @@ begin exit; end; Params := TPSList.Create; + Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - 1], False)); Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - ParamCount - 2], False)); for i := Stack.Count -2 downto Longint(Stack.Count) - ParamCount -1 do @@ -11106,7 +11128,7 @@ begin Params.Add(NewPPSVariantIFC(Stack[I], False)); end; try - Result := Caller.InnerfuseCall(FSelf, p.Ext2, cdregister, Params, nil); + Result := Caller.InnerfuseCall(nil, p.Ext2, cdregister, Params, nil); finally DisposePPSVariantIFCList(Params); end;