paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 08:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* move check for result location to separate function

Browse Source 
git-svn-id: trunk@40668 -
This commit is contained in:
svenbarth 2018-12-26 22:59:42 +00:00
parent cfd8df4894
commit 8c52dc30ce
1 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
packages/rtl-objpas/src/x86_64/invoke.inc
View File

@ -86,6 +86,24 @@ resourcestring
SErrFailedToConvertArg = 'Failed to convert argument %d of type %s'; SErrFailedToConvertArg = 'Failed to convert argument %d of type %s';
SErrFailedToConvertRes = 'Failed to convert result of type %s'; SErrFailedToConvertRes = 'Failed to convert result of type %s';
function ReturnResultInParam(aType: PTypeInfo): Boolean;
var
td: PTypeData;
begin
Result := False;
if Assigned(aType) then begin
case aType^.Kind of
tkSString,
tkAString,
tkUString,
tkWString,
tkInterface,
tkDynArray:
Result := True;
end;
end;
end;
procedure SystemInvoke(aCodeAddress: CodePointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv; procedure SystemInvoke(aCodeAddress: CodePointer; const aArgs: TFunctionCallParameterArray; aCallConv: TCallConv;
aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags); aResultType: PTypeInfo; aResultValue: Pointer; aFlags: TFunctionCallFlags);
type type
@ -107,18 +125,7 @@ begin
if Assigned(aResultType) and not Assigned(aResultValue) then if Assigned(aResultType) and not Assigned(aResultValue) then
raise EInvocationError.Create(SErrInvokeResultTypeNoValue); raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
{$ifdef windows} {$ifdef windows}
retinparam := False; retinparam := ReturnResultInParam(aResultType);
if Assigned(aResultType) then begin
case aResultType^.Kind of
tkSString,
tkAString,
tkUString,
tkWString,
tkInterface,
tkDynArray:
retinparam := True;
end;
end;
stackidx := 0; stackidx := 0;
regidx := 0; regidx := 0;