Delphi/pascalscript
Delphi/pascalscript
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

266: Error when calling delphi function in x64 mode

Browse Source
This commit is contained in:
evgenyk 2023-09-13 13:43:51 +03:00
parent f68967d58f
commit 78c62be048
2 changed files with 246 additions and 212 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
Source/InvokeCall.inc
View File

@ -5,11 +5,13 @@ var SysCalConv : TCallConv;
i : Integer; i : Integer;
fvar: PPSVariantIFC; fvar: PPSVariantIFC;
IsConstr : Boolean; IsConstr : Boolean;
IsStatic : Boolean;
ctx: TRTTIContext; ctx: TRTTIContext;
RttiType : TRttiType; RttiType : TRttiType;
ResValue : TValue; ResValue : TValue;
begin begin
Result := False; Result := False;
IsStatic := _Self = nil;
case CallingConv of case CallingConv of
cdRegister : SysCalConv := ccReg; cdRegister : SysCalConv := ccReg;
cdPascal : SysCalConv := ccPascal; cdPascal : SysCalConv := ccPascal;
@ -20,8 +22,12 @@ begin
SysCalConv := ccReg;//to prevent warning "W1036 Variable might not have been initialized" SysCalConv := ccReg;//to prevent warning "W1036 Variable might not have been initialized"
end; end;
if Assigned(_Self) then if not IsStatic then begin
{$IFDEF CPUX86}
if CallingConv <> cdPascal then
{$ENDIF CPUX86}
Args := Args + [TValue.From<Pointer>( _Self )]; Args := Args + [TValue.From<Pointer>( _Self )];
end;
for I := 0 to Params.Count - 1 do for I := 0 to Params.Count - 1 do
begin begin
@ -97,41 +103,47 @@ begin
Args := Args + [Arg]; Args := Args + [Arg];
end; end;
{$IFDEF CPUX86}
if not IsStatic then begin
if CallingConv = cdPascal then
Args := Args + [TValue.From<Pointer>( _Self )];
end;
{$ENDIF CPUX86}
IsConstr := (Integer(CallingConv) and 64) <> 0; IsConstr := (Integer(CallingConv) and 64) <> 0;
if not assigned(res) then if not assigned(res) then
begin begin
Invoke(Address,Args,SysCalConv,nil,False,IsConstr); { ignore return } Invoke(Address, Args, SysCalConv, nil); { ignore return }
end end
else begin else begin
case res.atype.basetype of case res.atype.basetype of
{ add result types here } { add result types here }
btString: tbtstring(res.dta^) := tbtstring(Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString) btString: tbtstring(res.dta^) := tbtstring(Invoke(Address,Args,SysCalConv,TypeInfo(String),IsStatic).AsString);
;
{$IFNDEF PS_NOWIDESTRING} {$IFNDEF PS_NOWIDESTRING}
btUnicodeString: tbtunicodestring(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString; btUnicodeString: tbtunicodestring(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),IsStatic).AsString;
btWideString: tbtWideString(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),False,IsConstr).AsString; btWideString: tbtWideString(res.dta^) := Invoke(Address,Args,SysCalConv,TypeInfo(String),IsStatic).AsString;
{$ENDIF} {$ENDIF}
btU8, btS8: pbyte(res.dta)^ := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),False,IsConstr).AsInteger); 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),False,IsConstr).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),False,IsConstr).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),False,IsConstr).AsInt64); {$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),False,IsConstr).AsExtended); btSingle: psingle(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Single),IsStatic).AsExtended);
btDouble: pdouble(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Double),False,IsConstr).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),False,IsConstr).AsExtended); btExtended: pextended(res.dta)^ := Extended(Invoke(Address,Args,SysCalConv,TypeInfo(Extended),IsStatic).AsExtended);
{$IFDEF FPC} {$IFDEF FPC}
btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),False,IsConstr).AsOrdinal); btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),IsStatic).AsOrdinal);
btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),False,IsConstr).AsChar); btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),IsStatic).AsChar);
{$ELSE} {$ELSE}
btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),False,IsConstr).AsType<PChar>()); btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),IsStatic).AsType<PChar>());
btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),False,IsConstr).AsType<Char>()); btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),IsStatic).AsType<Char>());
{$ENDIF} {$ENDIF}
btSet: btSet:
begin begin
case TPSTypeRec_Set(res.aType).aByteSize of case TPSTypeRec_Set(res.aType).aByteSize of
1: byte(res.Dta^) := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),False,IsConstr).AsInteger); 1: byte(res.Dta^) := Byte(Invoke(Address,Args,SysCalConv,TypeInfo(Byte),IsStatic).AsInteger);
2: word(res.Dta^) := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),False,IsConstr).AsInteger); 2: word(res.Dta^) := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),IsStatic).AsInteger);
3, 3,
4: Longint(res.Dta^) := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),False,IsConstr).AsInteger); 4: Longint(res.Dta^) := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),IsStatic).AsInteger);
{$IFNDEF FPC} {$IFNDEF FPC}
else else
begin begin
@ -139,7 +151,7 @@ begin
if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkSet) if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkSet)
and (RttiType.TypeSize = TPSTypeRec_Set(res.aType).aByteSize) then and (RttiType.TypeSize = TPSTypeRec_Set(res.aType).aByteSize) then
begin begin
Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).ExtractRawData(res.dta); Invoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic).ExtractRawData(res.dta);
Break; Break;
end; end;
end; end;
@ -151,7 +163,7 @@ begin
{$IFNDEF FPC}for RttiType in ctx.GetTypes do {$IFNDEF FPC}for RttiType in ctx.GetTypes do
if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkClass) then{$ENDIF} if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkClass) then{$ENDIF}
begin begin
TObject(res.dta^) := Invoke(Address,Args,SysCalConv,{$IFDEF FPC}TypeInfo(TObject){$ELSE}RttiType.Handle{$ENDIF},False,IsConstr).AsObject; TObject(res.dta^) := Invoke(Address,Args,SysCalConv,{$IFDEF FPC}TypeInfo(TObject){$ELSE}RttiType.Handle{$ENDIF},IsStatic, IsConstr).AsObject;
{$IFNDEF FPC}Break;{$ENDIF} {$IFNDEF FPC}Break;{$ENDIF}
end; end;
end; end;
@ -161,7 +173,7 @@ begin
for RttiType in ctx.GetTypes do for RttiType in ctx.GetTypes do
if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkArray) then if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkArray) then
begin begin
CopyArrayContents(res.dta, Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).GetReferenceToRawData, TPSTypeRec_StaticArray(res.aType).Size, TPSTypeRec_StaticArray(res.aType).ArrayType); CopyArrayContents(res.dta, Invoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic).GetReferenceToRawData, TPSTypeRec_StaticArray(res.aType).Size, TPSTypeRec_StaticArray(res.aType).ArrayType);
Break; Break;
end; end;
end; end;
@ -170,7 +182,7 @@ begin
for RttiType in ctx.GetTypes do for RttiType in ctx.GetTypes do
if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkRecord) then if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkRecord) then
begin begin
CopyArrayContents(res.dta, (Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).GetReferenceToRawData), 1, res.aType); CopyArrayContents(res.dta, (Invoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic).GetReferenceToRawData), 1, res.aType);
Break; Break;
end; end;
end; end;
@ -179,7 +191,7 @@ begin
for RttiType in ctx.GetTypes do for RttiType in ctx.GetTypes do
if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkDynArray) then if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkDynArray) then
begin begin
ResValue := Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr); ResValue := Invoke(Address,Args,SysCalConv,RttiType.Handle,IsStatic);
if ResValue.GetArrayLength > 0 then if ResValue.GetArrayLength > 0 then
CopyArrayContents(res.dta, ResValue.GetReferenceToRawData, 1, res.aType) CopyArrayContents(res.dta, ResValue.GetReferenceToRawData, 1, res.aType)
else else
@ -189,7 +201,7 @@ begin
end; end;
btVariant: btVariant:
begin begin
PVariant(res.dta)^ := Invoke(Address, Args, SysCalConv, TypeInfo(Variant), False, IsConstr).AsVariant; PVariant(res.dta)^ := Invoke(Address, Args, SysCalConv, TypeInfo(Variant), IsStatic).AsVariant;
end; end;
{$ENDIF} {$ENDIF}
else else

32
Source/uPSRuntime.pas
View File

@ -7623,6 +7623,8 @@ begin
Result := TMethod(Meth).Code; Result := TMethod(Meth).Code;
end; end;
{$IFDEF LOG} {$IFDEF LOG}
function NilProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean; forward;
procedure ODSvar(name: string; data: TPSResultData); procedure ODSvar(name: string; data: TPSResultData);
begin begin
__Log(name + '= $'+IntToHex(IPointer(data.P))+', '+ __Log(name + '= $'+IntToHex(IPointer(data.P))+', '+
@ -7633,12 +7635,24 @@ begin
end; end;
procedure ODS_TPSExternalProcRec(name: string; data: TPSExternalProcRec); procedure ODS_TPSExternalProcRec(name: string; data: TPSExternalProcRec);
var
s: string;
begin 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)))+', '+ 'ext1=$'+ IntToHex(IPointer(TObject(data.ext1)))+', '+
'ext2=$'+ IntToHex(IPointer(TObject(data.ext2)))); 'ext2=$'+ IntToHex(IPointer(TObject(data.ext2))));
end; end;
procedure ODS_TPSInternalProcRec(name: string; data: TPSInternalProcRec);
begin
__Log(name + ': name='+string(data.ExportName));
end;
procedure ODS_stack(stack: TPSStack); procedure ODS_stack(stack: TPSStack);
var var
i: integer; i: integer;
@ -8036,10 +8050,10 @@ begin
break; break;
end; end;
u := FProcs.Data^[p]; u := FProcs.Data^[p];
if u.ClassType = TPSExternalProcRec then begin
{$IFDEF LOG} {$IFDEF LOG}
ODS_TPSExternalProcRec('proc', TPSExternalProcRec(u)); ODS_TPSExternalProcRec('proc', TPSExternalProcRec(u));
{$ENDIF} {$ENDIF}
if u.ClassType = TPSExternalProcRec then begin
try try
if not TPSExternalProcRec(u).ProcPtr(Self, TPSExternalProcRec(u), FGlobalVars, FStack) then begin if not TPSExternalProcRec(u).ProcPtr(Self, TPSExternalProcRec(u), FGlobalVars, FStack) then begin
if ExEx = erNoError then if ExEx = erNoError then
@ -8090,6 +8104,10 @@ begin
{$ENDIF} {$ENDIF}
end end
else begin else begin
{$IFDEF LOG}
if u.ClassType = TPSInternalProcRec then
ODS_TPSInternalProcRec('proc', TPSInternalProcRec(u));
{$ENDIF}
Vtemp := Fstack.PushType(FReturnAddressType); Vtemp := Fstack.PushType(FReturnAddressType);
vd.P := Pointer(IPointer(VTemp)+PointerSize); vd.P := Pointer(IPointer(VTemp)+PointerSize);
vd.aType := pointer(vtemp^); vd.aType := pointer(vtemp^);
@ -10481,6 +10499,8 @@ begin
CurrStack := Cardinal(Stack.Count) - Cardinal(length(s)) -1; CurrStack := Cardinal(Stack.Count) - Cardinal(length(s)) -1;
if s[1] = #0 then inc(CurrStack); if s[1] = #0 then inc(CurrStack);
MyList := TPSList.Create; MyList := TPSList.Create;
if p.Ext2 = nil then
MyList.Add(NewPPSVariantIFC(n, False));
for i := 2 to length(s) do for i := 2 to length(s) do
begin begin
MyList.Add(nil); MyList.Add(nil);
@ -10497,7 +10517,7 @@ begin
end else v := nil; end else v := nil;
try try
if p.Ext2 = nil then if p.Ext2 = nil then
Result := Caller.InnerfuseCall(FSelf, p.Ext1, cc, MyList, v) Result := Caller.InnerfuseCall(nil, p.Ext1, cc, MyList, v)
else else
Result := Caller.InnerfuseCall(FSelf, VirtualMethodPtrToPtr(p.Ext1, FSelf), cc, MyList, v); Result := Caller.InnerfuseCall(FSelf, VirtualMethodPtrToPtr(p.Ext1, FSelf), cc, MyList, v);
finally finally
@ -11073,13 +11093,14 @@ begin
exit; exit;
end; end;
Params := TPSList.Create; Params := TPSList.Create;
Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - 2], False));
Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - 1], True)); Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - 1], True));
for i := Stack.Count -3 downto Longint(Stack.Count) - ParamCount -2 do for i := Stack.Count -3 downto Longint(Stack.Count) - ParamCount -2 do
begin begin
Params.Add(NewPPSVariantIFC(Stack[I], False)); Params.Add(NewPPSVariantIFC(Stack[I], False));
end; end;
try try
Result := Caller.InnerfuseCall(FSelf, p.Ext1, cdRegister, Params, nil); Result := Caller.InnerfuseCall(nil, p.Ext1, cdRegister, Params, nil);
finally finally
DisposePPSVariantIFCList(Params); DisposePPSVariantIFCList(Params);
end; end;
@ -11099,6 +11120,7 @@ begin
exit; exit;
end; end;
Params := TPSList.Create; Params := TPSList.Create;
Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - 1], False));
Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - ParamCount - 2], False)); Params.Add(NewPPSVariantIFC(Stack[Longint(Stack.Count) - ParamCount - 2], False));
for i := Stack.Count -2 downto Longint(Stack.Count) - ParamCount -1 do for i := Stack.Count -2 downto Longint(Stack.Count) - ParamCount -1 do
@ -11106,7 +11128,7 @@ begin
Params.Add(NewPPSVariantIFC(Stack[I], False)); Params.Add(NewPPSVariantIFC(Stack[I], False));
end; end;
try try
Result := Caller.InnerfuseCall(FSelf, p.Ext2, cdregister, Params, nil); Result := Caller.InnerfuseCall(nil, p.Ext2, cdregister, Params, nil);
finally finally
DisposePPSVariantIFCList(Params); DisposePPSVariantIFCList(Params);
end; end;