Browse Source

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

git-svn-id: trunk@16388 -
sergei 14 years ago
parent
commit
49013587a9
1 changed files with 23 additions and 14 deletions
  1. 23 14
      packages/winunits-base/src/comobj.pp

+ 23 - 14
packages/winunits-base/src/comobj.pp

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