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

+ comobj.pp, DispatchInvoke and DoDispCallByID: support Variant parameters passed by value, support Int64 and QWord arguments.

Browse Source 
git-svn-id: trunk@16388 -
This commit is contained in:
sergei 2010-11-20 21:36:29 +00:00
parent 907e7a32d5
commit 49013587a9
1 changed files with 23 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
packages/winunits-base/src/comobj.pp
View File

@ -1085,7 +1085,7 @@ HKCR
for i:=0 to CallDesc^.ArgCount-1 do
begin
{$ifdef DEBUG_COMDISPATCH}
writeln('DispatchInvoke: Params = ',hexstr(PtrInt(Params),SizeOf(Pointer)*2));
writeln('DispatchInvoke: Params = ',hexstr(Params));
{$endif DEBUG_COMDISPATCH}
{ get plain type }
CurrType:=CallDesc^.ArgTypes[i] and $3f;
@ -1138,7 +1138,7 @@ HKCR
end;
end
end
else
else { by-value argument }
case CurrType of
varStrArg:
begin
@ -1156,18 +1156,24 @@ HKCR
varVariant:
begin
{$ifdef DEBUG_COMDISPATCH}
writeln('Unimplemented variant dispatch');
writeln('By-value Variant, making a copy');
{$endif DEBUG_COMDISPATCH}
{ Codegen always passes a pointer to variant,
*unlike* Delphi which pushes the entire TVarData }
Arguments[i]:=PVarData(PPointer(Params)^)^;
Inc(PPointer(Params));
end;
varCurrency,
varDouble,
VarDate:
varInt64,
varQWord,
varDate:
begin
{$ifdef DEBUG_COMDISPATCH}
writeln('Got 8 byte float argument');
writeln('Got 8 byte argument');
{$endif DEBUG_COMDISPATCH}
Arguments[i].VType:=CurrType;
move(PPointer(Params)^,Arguments[i].VDouble,sizeof(Double));
Arguments[i].VDouble:=PDouble(Params)^;
inc(PDouble(Params));
end;
else
@ -1334,7 +1340,7 @@ HKCR
flags : WORD;
invokeresult : HRESULT;
preallocateddata : array[0..15] of TVarData;
Arguments : ^TVarData;
Arguments : PVarData;
CurrType, i : byte;
dispidNamed: dispid;
begin
@ -1349,7 +1355,7 @@ HKCR
for i:=0 to desc^.CallDesc.ArgCount-1 do
begin
{$ifdef DEBUG_DISPATCH}
writeln('DoDispCallByID: Params = ',hexstr(PtrInt(Params),SizeOf(Pointer)*2));
writeln('DoDispCallByID: Params = ',hexstr(Params));
{$endif DEBUG_DISPATCH}
{ get plain type }
CurrType:=desc^.CallDesc.ArgTypes[i] and $3f;
@ -1367,24 +1373,27 @@ HKCR
else
begin
{$ifdef DEBUG_DISPATCH}
writeln('DispatchInvoke: Got ref argument with type = ',CurrType);
writeln('DispatchInvoke: Got value argument with type = ',CurrType);
{$endif DEBUG_DISPATCH}
case CurrType of
varVariant:
begin
Arguments[i].VType:=CurrType;
move(PVarData(Params)^,Arguments[i],sizeof(TVarData));
{ Codegen always passes a pointer to variant,
*unlike* Delphi which pushes the entire TVarData }
Arguments[i]:=PVarData(PPointer(Params)^)^;
inc(PVarData(Params));
end;
varCurrency,
varDouble,
VarDate:
varInt64,
varQWord,
varDate:
begin
{$ifdef DEBUG_DISPATCH}
writeln('DispatchInvoke: Got 8 byte float argument');
writeln('DispatchInvoke: Got 8 byte argument');
{$endif DEBUG_DISPATCH}
Arguments[i].VType:=CurrType;
move(PPointer(Params)^,Arguments[i].VDouble,sizeof(Double));
Arguments[i].VDouble:=PDouble(Params)^;
inc(PDouble(Params));
end;
else