home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d456 / CAJSCRPT.ZIP / ifps3 / ifpicall.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-07-18  |  38.2 KB  |  1,139 lines
  1. unit ifpicall;
  2. {
  3.   Innerfuse Pascal Script Call unit
  4.   You may not copy a part of this unit, only use it as whole, with
  5.   Innerfuse Pascal Script Script Engine.
  6. }
  7. {$I ifps3_def.inc}
  8. interface
  9. uses
  10.   ifps3, ifps3utl, ifps3common{$IFDEF HAVEVARIANT}{$IFDEF D6PLUS}, variants{$ENDIF}{$ENDIF};
  11.  
  12. type
  13.   TCallingConvention = (ccRegister, ccPascal, CCCdecl, CCStdCall);
  14.   PResourcePtrSupportFuncs = ^TResourcePtrSupportFuncs;
  15.   TResourcePtrToStrProc = function (PSelf: PResourcePtrSupportFuncs; Sender: TIFPSExec; P: PIFVariant): string;
  16.   TVarResourcePtrToStrProc = function (PSelf: PResourcePtrSupportFuncs; Sender: TIFPSExec; P: PIFVariant): string;
  17.   TResultToRsourcePtr = procedure(PSelf: PResourcePtrSupportFuncs; Sender: TIFPSExec; Data: Longint; P: PIFVariant);
  18.  
  19.   TRPSResultMethod = (rmParam, rmRegister);
  20.   TResourcePtrSupportFuncs = record
  21.     Ptr: Pointer;
  22.     PtrToStr: TResourcePtrToStrProc;
  23.     VarPtrToStr: TVarResourcePtrToStrProc;
  24.     ResultMethod: TRPSResultMethod;
  25.     ResToPtr: TResultToRsourcePtr;
  26.   end;
  27. function InnerfuseCall(SE: TIFPSExec; Self, Address: Pointer; CallingConv: TCallingConvention; Params: TIfList; res: PIfVariant; SupFunc: PResourcePtrSupportFuncs): Boolean;
  28.  
  29. implementation
  30.  
  31. {$IFDEF HAVEVARIANT}
  32. var
  33.   VNull: Variant;
  34.  
  35. const
  36.   VariantType: TIFTypeRec = (ext:nil;BaseType: btVariant);
  37.   VariantArrayType: TIFTypeRec = (ext:@VariantType;basetype: btArray);
  38. {$ENDIF}
  39.  
  40. function RealFloatCall_Register(p: Pointer;
  41.   _EAX, _EDX, _ECX: Cardinal;
  42.   StackData: Pointer;
  43.   StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
  44.   ): Extended; Stdcall; // make sure all things are on stack
  45. var
  46.   E: Extended;
  47. begin
  48.   asm
  49.     mov ecx, stackdatalen
  50.     jecxz @@2
  51.     mov eax, stackdata
  52.     @@1:
  53.     mov edx, [eax]
  54.     push edx
  55.     sub eax, 4
  56.     dec ecx
  57.     or ecx, ecx
  58.     jnz @@1
  59.     @@2:
  60.     mov eax,_EAX
  61.     mov edx,_EDX
  62.     mov ecx,_ECX
  63.     call p
  64.     fstp tbyte ptr [e]
  65.   end;
  66.   Result := E;
  67. end;
  68.  
  69. function RealFloatCall_Other(p: Pointer;
  70.   StackData: Pointer;
  71.   StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
  72.   ): Extended; Stdcall; // make sure all things are on stack
  73. var
  74.   E: Extended;
  75. begin
  76.   asm
  77.     mov ecx, stackdatalen
  78.     jecxz @@2
  79.     mov eax, stackdata
  80.     @@1:
  81.     mov edx, [eax]
  82.     push edx
  83.     sub eax, 4
  84.     dec ecx
  85.     or ecx, ecx
  86.     jnz @@1
  87.     @@2:
  88.     call p
  89.     fstp tbyte ptr [e]
  90.   end;
  91.   Result := E;
  92. end;
  93.  
  94. function RealFloatCall_CDecl(p: Pointer;
  95.   StackData: Pointer;
  96.   StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
  97.   ): Extended; Stdcall; // make sure all things are on stack
  98. var
  99.   E: Extended;
  100. begin
  101.   asm
  102.     mov ecx, stackdatalen
  103.     jecxz @@2
  104.     mov eax, stackdata
  105.     @@1:
  106.     mov edx, [eax]
  107.     push edx
  108.     sub eax, 4
  109.     dec ecx
  110.     or ecx, ecx
  111.     jnz @@1
  112.     @@2:
  113.     call p
  114.     fstp tbyte ptr [e]
  115.     @@5:
  116.     mov ecx, stackdatalen
  117.     jecxz @@2
  118.     @@6:
  119.     pop edx
  120.     dec ecx
  121.     or ecx, ecx
  122.     jnz @@6
  123.   end;
  124.   Result := E;
  125. end;
  126.  
  127. function RealCall_Register(p: Pointer;
  128.   _EAX, _EDX, _ECX: Cardinal;
  129.   StackData: Pointer;
  130.   StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
  131.   ResultLength: Longint): Longint; Stdcall; // make sure all things are on stack
  132. var
  133.   r: Longint;
  134. begin
  135.   asm
  136.     mov ecx, stackdatalen
  137.     jecxz @@2
  138.     mov eax, stackdata
  139.     @@1:
  140.     mov edx, [eax]
  141.     push edx
  142.     sub eax, 4
  143.     dec ecx
  144.     or ecx, ecx
  145.     jnz @@1
  146.     @@2:
  147.     mov eax,_EAX
  148.     mov edx,_EDX
  149.     mov ecx,_ECX
  150.     call p
  151.     mov ecx, resultlength
  152.     cmp ecx, 0
  153.     je @@5
  154.     cmp ecx, 1
  155.     je @@3
  156.     cmp ecx, 2
  157.     je @@4
  158.     mov r, eax
  159.     jmp @@5
  160.     @@3:
  161.     xor ecx, ecx
  162.     mov cl, al
  163.     mov r, ecx
  164.     jmp @@5
  165.     @@4:
  166.     xor ecx, ecx
  167.     mov cx, ax
  168.     mov r, ecx
  169.     @@5:
  170.   end;
  171.   Result := r;
  172. end;
  173.  
  174. function RealCall_Other(p: Pointer;
  175.   StackData: Pointer;
  176.   StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
  177.   ResultLength: Longint): Longint; Stdcall; // make sure all things are on stack
  178. var
  179.   r: Longint;
  180. begin
  181.   asm
  182.     mov ecx, stackdatalen
  183.     jecxz @@2
  184.     mov eax, stackdata
  185.     @@1:
  186.     mov edx, [eax]
  187.     push edx
  188.     sub eax, 4
  189.     dec ecx
  190.     or ecx, ecx
  191.     jnz @@1
  192.     @@2:
  193.     call p
  194.     mov ecx, resultlength
  195.     cmp ecx, 0
  196.     je @@5
  197.     cmp ecx, 1
  198.     je @@3
  199.     cmp ecx, 2
  200.     je @@4
  201.     mov r, eax
  202.     jmp @@5
  203.     @@3:
  204.     xor ecx, ecx
  205.     mov cl, al
  206.     mov r, ecx
  207.     jmp @@5
  208.     @@4:
  209.     xor ecx, ecx
  210.     mov cx, ax
  211.     mov r, ecx
  212.     @@5:
  213.   end;
  214.   Result := r;
  215. end;
  216.  
  217. function RealCall_CDecl(p: Pointer;
  218.   StackData: Pointer;
  219.   StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
  220.   ResultLength: Longint): Longint; Stdcall; // make sure all things are on stack
  221. var
  222.   r: Longint;
  223. begin
  224.   asm
  225.     mov ecx, stackdatalen
  226.     jecxz @@2
  227.     mov eax, stackdata
  228.     @@1:
  229.     mov edx, [eax]
  230.     push edx
  231.     sub eax, 4
  232.     dec ecx
  233.     or ecx, ecx
  234.     jnz @@1
  235.     @@2:
  236.     call p
  237.     mov ecx, resultlength
  238.     cmp ecx, 0
  239.     je @@5
  240.     cmp ecx, 1
  241.     je @@3
  242.     cmp ecx, 2
  243.     je @@4
  244.     mov r, eax
  245.     jmp @@5
  246.     @@3:
  247.     xor ecx, ecx
  248.     mov cl, al
  249.     mov r, ecx
  250.     jmp @@5
  251.     @@4:
  252.     xor ecx, ecx
  253.     mov cx, ax
  254.     mov r, ecx
  255.     @@5:
  256.     mov ecx, stackdatalen
  257.     jecxz @@2
  258.     @@6:
  259.     pop edx
  260.     dec ecx
  261.     or ecx, ecx
  262.     jnz @@6
  263.   end;
  264.   Result := r;
  265. end;
  266.  
  267. type
  268.   TCallInfoType = (ciRecord, ciVariant, ciOpenArray);
  269.   PCallInfo = ^TCallInfo;
  270.   TCallInfo = record
  271.     ftype: TCallInfoType;
  272.     orgvar: PIFVariant;
  273.     varparam: Boolean;
  274.     recData: string;
  275. {$IFDEF HAVEVARIANT}
  276.     varVar: variant;
  277. {$ENDIF}
  278.     arrLength: Longint;
  279.     arrType: TIFPSBaseType;
  280.     arrData: Pointer;
  281.   end;
  282.  
  283. {$IFDEF HAVEVARIANT}
  284. function BuildVariant(Exec: TIFPSExec; rec: PIFVariant; SupFunc: PResourcePtrSupportFuncs): PCallInfo;
  285. var
  286.   t: PCallInfo;
  287.   i: Longint;
  288. begin
  289.   New(Result);
  290.   Result^.ftype := ciVariant;
  291.   Result^.orgvar := Rec;
  292.   try
  293.     case rec^.FType^.BaseType of
  294.     btS8: Result^.varVar := Rec^.ts8;
  295.     btU8: Result^.varVar := Rec^.tu8;
  296.     btU16: Result^.varVar := Rec^.tu16;
  297.     btS16: Result^.varVar := Rec^.ts16;
  298.     btU32: Result^.varVar := LongInt(Rec^.tu32);
  299.     btS32: Result^.varVar := Rec^.ts32;
  300.     btSingle: Result^.varVar := Rec^.tsingle;
  301.     btDouble: Result^.varVar := Rec^.tdouble;
  302.     btExtended: Result^.varVar := Rec^.tExtended;
  303.     btString, btPChar: Result^.varVar := string(Rec^.tstring);
  304.     btVariant: begin
  305.       if rec^.tvariant^.FType = nil then
  306.       begin
  307.         Result^.varVar := null;
  308.       end else begin
  309.         t := BuildVariant(Exec, Rec^.tVariant, SupFunc);
  310.         if t = nil then begin
  311.           Dispose(Result);
  312.           result := nil;
  313.           Exit;
  314.         end;
  315.         Result^.varVar := t^.varVar;
  316.         Dispose(t);
  317.       end;
  318.     end;
  319.     btArray:
  320.       begin
  321.         case Exec.GetTypeNo(Cardinal(Rec^.FType^.Ext))^.BaseType of
  322.         {$IFDEF D6PLUS}
  323.           btS16: i := varSmallint;
  324.           bts32: i := varInteger;
  325.           btu32: i := varLongWord;
  326.           btu16: i := varWord;
  327.           btu8: i := varByte;
  328.           bts8: i := varShortInt;
  329.         {$ELSE}
  330.           bts8, btu8, btS16: i := varSmallint;
  331.           btu16, btu32, btS32: i := varInteger;
  332.         {$ENDIF}
  333.           btSingle: i := varSingle;
  334.           btDouble, btExtended : i := varDouble;
  335.           btString, btPChar: i := varString;
  336.           btVariant: i := varVariant;
  337.         else
  338.           begin
  339.             Dispose(Result);
  340.             Result := nil;
  341.             exit;
  342.           end;
  343.         end;
  344.         if Rec^.trecord <> nil then
  345.         begin
  346.           result^.varVar := VarArrayCreate([0, rec^.trecord^.FieldCount-1], i);
  347.           for i := 0 to Rec^.trecord^.FieldCount -1 do
  348.           begin
  349.             t := BuildVariant(Exec, Rec^.trecord^.Fields[I], SupFunc);
  350.             if t = nil then
  351.             begin
  352.               Dispose(Result);
  353.               Result := nil;
  354.               exit;
  355.             end;
  356.             Result^.varvar[i] := t^.varvar;
  357.             Dispose(t);
  358.           end;
  359.         end;
  360.       end;
  361.     else
  362.       begin
  363.         Dispose(Result);
  364.         Result := nil;
  365.       end;
  366.     end;
  367.   except
  368.     if Result <> nil then begin
  369.       Dispose(Result);
  370.       Result := nil;
  371.     end;
  372.   end;
  373. end;
  374.  
  375. procedure CopyBack(Exec: TIFPSExec; p: PCallInfo);
  376. var
  377.   I: Longint;
  378.   l: Cardinal;
  379.   Pt: PIFTypeRec;
  380.  
  381.   procedure SetVariant(P: PIfVariant; v: variant);
  382.   begin
  383.     case i of
  384.       varEmpty, varNull: ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, nil);
  385.       varSmallint: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, Exec.FindType2(btS16)); p^.tvariant^.ts16 := v; end;
  386.       varInteger: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, Exec.FindType2(btS32)); p^.tvariant^.ts32 := v; end;
  387.       varSingle: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, Exec.FindType2(btSingle)); p^.tvariant^.tsingle := v; end;
  388.       varDouble, varCurrency, varDate: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p, Exec.FindType2(btdouble)); p^.tvariant^.tdouble := v; end;
  389.       varBoolean: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, exec.FindType2(btU8)); p^.tvariant^.tu8 := ord(boolean(v)); end;
  390.       varOleStr, varString: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, exec.FindType2(btString)); string(p^.tvariant^.tstring) := v;end;
  391.       {$IFDEF D6PLUS}
  392.       varShortInt: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, exec.FindType2(bts8)); p^.tvariant^.ts8 := v;end;
  393.       varByte: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, exec.FindType2(btu8)); p^.tvariant^.tu8 := v;end;
  394.       varWord: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, exec.FindType2(btu16)); p^.tvariant^.tu16 := v;end;
  395.       varLongWord: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, exec.FindType2(btu32)); p^.tvariant^.tu32 := v;end;
  396.       varInt64: begin ChangeVariantType({$IFNDEF NOSMARTMM}Exec.MemoryManager, {$ENDIF}p^.tvariant, exec.FindType2(btS64)); p^.tvariant^.ts64 := v;end;
  397.       {$ENDIF}
  398.     end;
  399.   end;
  400. begin
  401.   try
  402.   i := VarType(p^.varVar);
  403.   if (i and VarArray) <> 0 then
  404.   begin
  405.  
  406.     if VarArrayDimCount(p^.Varvar) > 1 then Exit;
  407.     if (p^.orgvar.FType^.BaseType <> btArray) or (Exec.GetTypeNo(Cardinal(p^.orgvar^.FType^.Ext))^.BaseType <> btVariant) then
  408.     begin
  409.       l := 0;
  410.       repeat
  411.         pt := Exec.FindType(l, btArray, l);
  412.         if PIFTypeRec(pt^.Ext)^.BaseType = btVariant then break;
  413.       until pt = nil;
  414.       if pt = nil then pt := @VariantArrayType;
  415.       p^.orgvar^.tvariant.FType := pt;
  416.     end;
  417.     SetIFPSArrayLength(Exec, p^.orgvar, VarArrayHighBound(p^.varvar, 1) - VarArrayLowBound(p^.varvar, 1)+1);
  418.     for i := VarArrayLowBound(p^.varvar, 1) to VarArrayHighBound(p^.varvar, 1) do
  419.     begin
  420.       SetVariant(p^.Orgvar^.tArray^.Fields[i - VarArrayLowBound(p^.varvar, 1)], p^.varvar[i]);
  421.     end;
  422.   end else
  423.     SetVariant(p^.orgvar, p^.varvar);
  424.   except
  425.   end;
  426. end;
  427.  
  428. {$ENDIF}
  429.  
  430. function CreateOpenArray(Exec: TIFPSExec; fVar: PIFVariant; SupFunc: PResourcePtrSupportFuncs): PCallInfo;
  431. var
  432.   p: Pointer;
  433.   {$IFDEF HAVEVARIANT}
  434.   fv: PIFVariant;
  435.   temps: string;
  436.   {$ENDIF}
  437.   i, elementsize: Longint;
  438. begin
  439.   New(Result);
  440.   Result^.FType := ciOpenArray;
  441.   Result^.orgvar := FVar;
  442.   Result^.ArrType := Exec.GetTypeNo(Cardinal(fVar^.FType^.Ext))^.BaseType;
  443.   case Result^.ArrType of
  444.     btU8, btS8, btU16, btS16, btu32, bts32, btSingle, btDouble, btExtended,
  445.     btString, btPChar, btVariant: ;
  446.     else begin Dispose(Result); Result := nil; exit; end;
  447.   end;
  448.   Result^.arrLength := GetIFPSArrayLength(Exec, fvar);
  449.   case Result^.ArrType of
  450.     btU8, btS8: elementsize := 1;
  451.     btU16, btS16: elementsize := 2;
  452.     btString, btPChar, btsingle, btu32, bts32: elementsize := 4;
  453.     btDouble{$IFNDEF NOINT64}, bts64{$ENDIF}:elementsize := 8;
  454.     btExtended: elementsize := 12;
  455.     else elementsize := sizeof(TVarRec);
  456.   end;
  457.   try
  458.   GetMem(Result^.ArrData, elementSize * Result^.ArrLength);
  459.   FillChar(Result^.arrData^, elementSize * Result^.ArrLength, 0);
  460.   except
  461.     FreeMem(Result);
  462.     Result := nil;
  463.     exit;
  464.   end;
  465.   case Result^.ArrType of
  466.     btPChar, btU8, btS8, btU16, btS16, btu32, bts32, btSingle, btDouble, btExtended:
  467.     begin
  468.       p := result^.arrData;
  469.       for i := 0 to Result^.arrLength -1 do
  470.       begin
  471.         Move(fVar^.tArray.Fields[i].tu8, p^, elementsize);
  472.         p := pchar(p) + elementsize;
  473.       end;
  474.     end;
  475.     btString:
  476.     begin
  477.       p := result^.arrData;
  478.       for i := 0 to Result^.arrLength -1 do
  479.       begin
  480.         string(p^) := string(fVar^.tArray.Fields[i].tstring);
  481.         p := pchar(p) + elementsize;
  482.       end;
  483.     end;
  484.     {$IFDEF HAVEVARIANT}
  485.     btVariant:
  486.     begin
  487.       p := result^.arrData;
  488.       for i := 0 to Result^.arrLength -1 do
  489.       begin
  490.         fv := fVar^.tArray.Fields[i];
  491.         if fv^.tvariant^.FType = nil then
  492.         begin
  493.           tvarrec(p^).VType := vtVariant;
  494.           tvarrec(p^).VVariant := @VNull;
  495.         end else begin
  496.           case fv^.tvariant^.ftype^.BaseType of
  497.             btU8: begin
  498.                 tvarrec(p^).VType := vtInteger;
  499.                 tvarrec(p^).VInteger := fv^.tvariant^.tu8;
  500.               end;
  501.             btS8: begin
  502.                 tvarrec(p^).VType := vtInteger;
  503.                 tvarrec(p^).VInteger := fv^.tvariant^.ts8;
  504.               end;
  505.             btU16: begin
  506.                 tvarrec(p^).VType := vtInteger;
  507.                 tvarrec(p^).VInteger := fv^.tvariant^.tu16;
  508.               end;
  509.             btS16: begin
  510.                 tvarrec(p^).VType := vtInteger;
  511.                 tvarrec(p^).VInteger := fv^.tvariant^.ts16;
  512.               end;
  513.             btU32: begin
  514.                 tvarrec(p^).VType := vtInteger;
  515.                 tvarrec(p^).VInteger := fv^.tvariant^.tu32;
  516.               end;
  517.             btS32: begin
  518.                 tvarrec(p^).VType := vtInteger;
  519.                 tvarrec(p^).VInteger := fv^.tvariant^.ts32;
  520.               end;
  521.             btString: begin
  522.               tvarrec(p^).VType := vtAnsiString;
  523.               string(TVarRec(p^).VAnsiString) := string(fv^.tvariant^.tstring);
  524.             end;
  525.             btPChar: begin
  526.               tvarrec(p^).VType := vtPchar;
  527.               TVarRec(p^).VPChar := pointer(fv^.tvariant^.tstring);
  528.             end;
  529.             btResourcePointer: begin
  530.               temps := SupFunc.PtrToStr(supfunc, exec, fv^.tvariant);
  531.               if length(temps) =4 then
  532.               begin
  533.               tvarrec(p^).VType := vtObject;
  534.               TVarRec(p^).VObject := Pointer((@temps[1])^);
  535.               end;
  536.             end;
  537.           end;
  538.         end;
  539.         p := pchar(p) + elementsize;
  540.       end;
  541.     end;
  542.     {$ENDIF}
  543.   end;
  544. end;
  545.  
  546. procedure DestroyOpenArray(Exec: TIFPSExec; CI: PCallInfo; SupFunc: PResourcePtrSupportFuncs);
  547. var
  548.   p: Pointer;
  549.   fv: PIFVariant;
  550.   i, elementsize: Longint;
  551. begin
  552.   case CI^.ArrType of
  553.     btU8, btS8: elementsize := 1;
  554.     btU16, btS16: elementsize := 2;
  555.     btString, btPChar, btsingle, btu32, bts32: elementsize := 4;
  556.     btDouble{$IFNDEF NOINT64}, bts64{$ENDIF}:elementsize := 8;
  557.     btExtended: elementsize := 12;
  558.     else elementsize := sizeof(TVarRec);
  559.   end;
  560.   case CI^.ArrType of
  561.     btPChar, btU8, btS8, btU16, btS16, btu32, bts32, btSingle, btDouble, btExtended:
  562.     begin
  563.       if CI^.VarParam then
  564.       begin
  565.         p := ci^.arrData;
  566.         for i := 0 to ci^.arrLength -1 do
  567.         begin
  568.           Move(p^, ci^.orgvar^.tArray.Fields[i].tu8, elementsize);
  569.           p := pchar(p) + elementsize;
  570.         end;
  571.       end;
  572.     end;
  573.     btString:
  574.     begin
  575.       p := ci^.arrData;
  576.       for i := 0 to ci^.arrLength -1 do
  577.       begin
  578.         if ci^.varparam then
  579.           string(ci^.OrgVar^.tArray.Fields[i].tstring) := string(p^);
  580.         Finalize(string(p^));
  581.         p := pchar(p) + elementsize;
  582.       end;
  583.     end;
  584.     btVariant:
  585.     begin
  586.       p := ci^.arrData;
  587.       for i := 0 to ci^.arrLength -1 do
  588.       begin
  589.         fv := ci^.OrgVar^.tArray.Fields[i];
  590.         if fv^.tvariant^.FType = nil then
  591.         begin
  592.           tvarrec(p^).VType := vtInteger;
  593.         end else begin
  594.           case fv^.tvariant^.ftype^.BaseType of
  595.             btU8: begin
  596.                 tvarrec(p^).VType := vtInteger;
  597.                 if ci^.varParam then
  598.                   fv^.tvariant^.tu8 := tvarrec(p^).VInteger;
  599.               end;
  600.             btS8: begin
  601.                 tvarrec(p^).VType := vtInteger;
  602.                 if ci^.varParam then
  603.                 fv^.tvariant^.ts8 := tvarrec(p^).VInteger;
  604.               end;
  605.             btU16: begin
  606.                 tvarrec(p^).VType := vtInteger;
  607.                 if ci^.varParam then
  608.                 fv^.tvariant^.tu16 := tvarrec(p^).VInteger;
  609.               end;
  610.             btS16: begin
  611.                 tvarrec(p^).VType := vtInteger;
  612.                 if ci^.varParam then
  613.                 fv^.tvariant^.ts16 := tvarrec(p^).VInteger;
  614.               end;
  615.             btU32: begin
  616.                 tvarrec(p^).VType := vtInteger;
  617.                 if ci^.varParam then
  618.                 fv^.tvariant^.tu32 := tvarrec(p^).VInteger;
  619.               end;
  620.             btS32: begin
  621.                 tvarrec(p^).VType := vtInteger;
  622.                 if ci^.varParam then
  623.                 fv^.tvariant^.ts32 := tvarrec(p^).VInteger;
  624.               end;
  625.             btString: begin
  626.               tvarrec(p^).VType := vtString;
  627.               if ci^.VarParam then
  628.                 string(fv^.tvariant^.tstring) := string(TVarRec(p^).VAnsiString);
  629.               finalize(string(TVarRec(p^).VAnsiString));
  630.             end;
  631.             btResourcePointer: begin
  632.               if ci^.varparam then
  633.               begin
  634.                 SupFunc.ResToPtr(SupFunc, Exec, Longint(TVarRec(p^).VObject), fv);
  635.               end;
  636.             end;
  637.           end;
  638.         end;
  639.         p := pchar(p) + elementsize;
  640.       end;
  641.     end;
  642.   end;
  643.   try
  644.     FreeMem(ci^.ArrData, elementSize * ci^.ArrLength);
  645.   except
  646.   end;
  647. end;
  648.  
  649. procedure CreateRecord_(Rec: PIFVariant; var Data: string; SE: TIFPSExec; SupFunc: PResourcePtrSupportFuncs);
  650. var
  651.   I: Longint;
  652. begin
  653.   while Rec^.FType^.BaseType = btPointer do
  654.   begin
  655.     Rec := Rec^.tPointer;
  656.     if Rec = nil then begin Data := Data + #0#0#0#0; Exit; end;
  657.   end;
  658.   case Rec^.FType^.BaseType of
  659.   btS8, btU8: Data := Data + Chr(Rec^.tu8);
  660.   btU16, btS16: begin Data := Data + #0#0; Word((@Data[Length(Data)-1])^) := Rec^.tu16; end;
  661.   btS32, btU32: begin Data := Data + #0#0#0#0; Cardinal((@Data[Length(Data)-3])^) := Rec^.tu32; end;
  662.   btSingle: begin Data := Data + #0#0#0#0; Single((@Data[Length(Data)-3])^) := Rec^.tsingle; end;
  663.   btDouble: begin Data := Data + #0#0#0#0#0#0#0#0; Double((@Data[Length(Data)-7])^) := Rec^.tdouble; end;
  664.   btExtended: begin Data := Data + #0#0#0#0#0#0#0#0#0#0; Extended((@Data[Length(Data)-9])^) := Rec^.tExtended; end;
  665.   btString, btPChar: begin Data := Data + #0#0#0#0; tbtString((@Data[Length(Data)-3])^) := tbtString(Rec^.tString); end;
  666.   btRecord, btArray:
  667.     begin
  668.       if Rec^.trecord <> nil then
  669.       begin
  670.         for i := 0 to Rec^.trecord^.FieldCount -1 do
  671.         begin
  672.           CreateRecord_(Rec^.trecord^.Fields[I], Data, Se, SupFunc);
  673.         end;
  674.       end;
  675.     end;
  676.   btResourcePointer:
  677.     begin
  678.       Data := Data + SupFunc^.PtrToStr(SupFunc, Se, Rec);
  679.     end;
  680. {$IFNDEF NOINT64}btS64: begin Data := Data + #0#0#0#0#0#0#0#0; int64((@Data[Length(Data)-7])^) := Rec^.ts64; end;{$ENDIF}
  681.   end;
  682. end;
  683.  
  684. function CreateRecord(VarParam: Boolean; Fvar: PIFVariant; SE: TIFPSExec; SupFunc: PResourcePtrSupportFuncs): PCallInfo;
  685. begin
  686.   New(Result);
  687.   Result^.ftype := ciRecord;
  688.   Result^.orgvar := FVar;
  689.   Result^.varparam:= VarParam;
  690.   CreateRecord_(FVar, Result^.recData, Se, SupFunc);
  691. end;
  692.  
  693. procedure DestroyRecord_(CopyBack: Boolean; Rec: PIFVariant; var Position: Longint; const Data: string; SE: TIFPSExec; SupFunc: PResourcePtrSupportFuncs);
  694. var
  695.   I: Longint;
  696.   P: Pointer;
  697.  
  698.   procedure GetP(var D; Len: Longint);
  699.   begin
  700.     if Position + Len -1 <= Length(Data) then
  701.     begin
  702.       if CopyBack then Move(Data[Position], D, Len);
  703.       Position := Position + Len;
  704.     end else Position := Length(Data) + 1;
  705.   end;
  706.  
  707.  
  708. begin
  709.   while Rec^.FType^.BaseType = btPointer do
  710.   begin
  711.     Rec := Rec^.tPointer;
  712.     if Rec = nil then begin Inc(position, 4); Exit; end;
  713.   end;
  714.   case Rec^.FType^.BaseType of
  715.   btS8, btU8: GetP(Rec^.tu8, 1);
  716.   btU16, btS16: GetP(Rec^.tu16, 2);
  717.   btS32, btU32: GetP(Rec^.tu32, 4);
  718.   btSingle: GetP(Rec^.tsingle, 4);
  719.   btDouble: GetP(Rec^.tdouble, 8);
  720.   btExtended: GetP(Rec^.TExtended, 10);
  721.   btString, btPChar: begin GetP(P, 4); tbtString(Rec^.tString) := string(p); end;
  722.   btRecord, btArray:
  723.     begin
  724.       if Rec^.trecord <> nil then
  725.       begin
  726.         for i := 0 to Rec^.trecord^.FieldCount -1 do
  727.         begin
  728.           DestroyRecord_(CopyBack, Rec^.trecord^.Fields[I], Position, Data, Se, SupFunc);
  729.         end;
  730.       end;
  731.     end;
  732.   btResourcePointer:
  733.     begin
  734.       GetP(I, 4);
  735.       SupFunc^.ResToPtr(SupFunc, SE, I, Rec);
  736.     end;
  737. {$IFNDEF NOINT64}btS64: begin GetP(Rec^.ts64, 8); end;{$ENDIF}
  738.   end;
  739. end;
  740.  
  741.  
  742. procedure DestroyRecord(Rec: PCallInfo; SE: TIFPSExec; SupFunc: PResourcePtrSupportFuncs);
  743. var
  744.   Pos: Longint;
  745. begin
  746.   Pos := 1;
  747.   DestroyRecord_(Rec^.varparam, Rec^.orgvar, Pos, Rec^.recData, Se, SupFunc);
  748. end;
  749.  
  750. function InnerfuseCall(SE: TIFPSExec; Self, Address: Pointer; CallingConv: TCallingConvention; Params: TIfList; res: PIfVariant; SupFunc: PResourcePtrSupportFuncs): Boolean;
  751. var
  752.   Stack: ansistring;
  753.   I: Longint;
  754.   RegUsage: Byte;
  755.   CallData: TIfList;
  756.   pp: PCallInfo;
  757.  
  758.   EAX, EDX, ECX: Longint;
  759.  
  760.   function GetPtr(fVar: PIfVariant): Boolean;
  761.   var
  762.     varPtr: Pointer;
  763.     UseReg: Boolean;
  764.     tempstr: string;
  765.     p: PCallInfo;
  766.   begin
  767.     Result := False;
  768.     if fVar^.RefCount >= IFPSAddrStackStart then begin
  769.       fvar^.RefCount := FVar^.RefCount and not IFPSAddrStackStart;
  770.       case fVar^.FType^.BaseType of
  771.         btArray:
  772.           begin
  773.             p := CreateOpenArray(SE, fVar, SupFunc);
  774.             if p =nil then exit;
  775.             p^.varparam := true;
  776.             CallData.Add(p);
  777.             case RegUsage of
  778.               0: begin EAX := Longint(p^.arrData); Inc(RegUsage); end;
  779.               1: begin EDX := Longint(p^.arrData); Inc(RegUsage); end;
  780.               2: begin ECX := Longint(p^.arrData); Inc(RegUsage); end;
  781.               else begin
  782.                 Stack := #0#0#0#0 + Stack;
  783.                 Pointer((@Stack[1])^) := p^.arrData;
  784.               end;
  785.             end;
  786.             case RegUsage of
  787.               0: begin EAX := Longint(p^.arrLength -1); Inc(RegUsage); end;
  788.               1: begin EDX := Longint(p^.arrLength -1); Inc(RegUsage); end;
  789.               2: begin ECX := Longint(p^.arrLength -1); Inc(RegUsage); end;
  790.               else begin
  791.                 Stack := #0#0#0#0 + Stack;
  792.                 Longint((@Stack[1])^) := p^.arrLength -1;
  793.               end;
  794.             end;
  795.             Result := True;
  796.             Exit;
  797.           end;
  798.         {$IFDEF HAVEVARIANT}
  799.         btVariant:
  800.           begin
  801.             p := BuildVariant(SE, fvar, SupFunc);
  802.             if p = nil then exit;
  803.             p^.varparam := True;
  804.             VarPtr := @(p^.varVar);
  805.             CallData.Add(p);
  806.           end;
  807.         {$ENDIF}
  808.         btRecord:
  809.           begin
  810.             p := CreateRecord(True, fVar, SE, SupFunc);
  811.             VarPtr := @(p^.recData[1]);
  812.             CallData.Add(p);
  813.           end;
  814.         btResourcePointer:
  815.           begin
  816.             if SupFunc = nil then exit;
  817.             tempstr := SupFunc^.VarPtrToStr(SupFunc, SE, fVar);
  818.             if length(tempstr) <> 4 then exit;
  819.             VarPtr := Pointer((@tempstr[1])^);
  820.           end;
  821.         btString: VarPtr := @tbtString(fvar^.tstring);
  822.         btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble,
  823.         btExtended{$IFNDEF NOINT64}, bts64{$ENDIF}: VarPtr := @(fVar^.tu8);
  824.       else begin
  825.           exit; //invalid type
  826.         end;
  827.       end; {case}
  828.       case RegUsage of
  829.         0: begin EAX := Longint(VarPtr); Inc(RegUsage); end;
  830.         1: begin EDX := Longint(VarPtr); Inc(RegUsage); end;
  831.         2: begin ECX := Longint(VarPtr); Inc(RegUsage); end;
  832.         else begin
  833.           Stack := #0#0#0#0 + Stack;
  834.           Pointer((@Stack[1])^) := VarPtr;
  835.         end;
  836.       end;
  837.     end else begin
  838.       UseReg := True;
  839.       case fVar^.FType^.BaseType of
  840.         btArray:
  841.           begin
  842.             p := CreateOpenArray(SE, fVar, SupFunc);
  843.             if p =nil then exit;
  844.             CallData.Add(p);
  845.             case RegUsage of
  846.               0: begin EAX := Longint(p^.arrData); Inc(RegUsage); end;
  847.               1: begin EDX := Longint(p^.arrData); Inc(RegUsage); end;
  848.               2: begin ECX := Longint(p^.arrData); Inc(RegUsage); end;
  849.               else begin
  850.                 Stack := #0#0#0#0 + Stack;
  851.                 Pointer((@Stack[1])^) := p^.arrData;
  852.               end;
  853.             end;
  854.             case RegUsage of
  855.               0: begin EAX := Longint(p^.arrLength -1); Inc(RegUsage); end;
  856.               1: begin EDX := Longint(p^.arrLength -1); Inc(RegUsage); end;
  857.               2: begin ECX := Longint(p^.arrLength -1); Inc(RegUsage); end;
  858.               else begin
  859.                 Stack := #0#0#0#0 + Stack;
  860.                 Longint((@Stack[1])^) := p^.arrLength -1;
  861.               end;
  862.             end;
  863.             Result := True;
  864.             exit;
  865.           end;
  866.         {$IFDEF HAVEVARIANT}
  867.         btVariant:
  868.           begin
  869.             p := BuildVariant(Se, fvar, SupFunc);
  870.             if p = nil then exit;
  871.             TempStr := #0#0#0#0;
  872.             Pointer((@TempStr[1])^) := @(p^.varvar);
  873.             p^.varparam := False;
  874.             CallData.Add(p);
  875.           end;
  876.         {$ENDIF}
  877.         btRecord:
  878.           begin
  879.             p := CreateRecord(False, fVar, SE, SupFunc);
  880.             CallData.Add(p);
  881.             TempStr := #0#0#0#0;
  882.             Pointer((@TempStr[1])^) := @(P^.recData[1]);
  883.           end;
  884.         btDouble: {8 bytes} begin
  885.             TempStr := #0#0#0#0#0#0#0#0;
  886.             UseReg := False;
  887.             double((@TempStr[1])^) := fVar^.tdouble;
  888.           end;
  889.  
  890.         btSingle: {4 bytes} begin
  891.             TempStr := #0#0#0#0;
  892.             UseReg := False;
  893.             Single((@TempStr[1])^) := fVar^.tsingle;
  894.           end;
  895.  
  896.         btExtended: {10 bytes} begin
  897.             UseReg := False;
  898.             TempStr:= #0#0#0#0#0#0#0#0#0#0#0#0;
  899.             Extended((@TempStr[1])^) := fVar^.textended;
  900.           end;
  901.         btU8,
  902.         btS8: begin
  903.             TempStr := char(fVar^.tu8) + #0#0#0;
  904.           end;
  905.         btu16, btS16: begin
  906.             TempStr := #0#0#0#0;
  907.             Word((@TempStr[1])^) := fVar^.tu16;
  908.           end;
  909.         btu32, bts32: begin
  910.             TempStr := #0#0#0#0;
  911.             Longint((@TempStr[1])^) := fVar^.tu32;
  912.           end;
  913.         btPChar, btString: begin
  914.             TempStr := #0#0#0#0;
  915.             Pointer((@TempStr[1])^) := fVar^.tstring;
  916.           end;
  917.         btResourcePointer:
  918.           begin
  919.             if SupFunc = nil then exit;
  920.             TempStr := SupFunc^.PtrToStr(SupFunc, SE, fVar);
  921.             if Length(TempStr) > 4 then
  922.               UseReg := False
  923.             else
  924.               SetLength(TempStr, 4);
  925.           end;
  926.         {$IFNDEF NOINT64}bts64: begin
  927.             TempStr:= #0#0#0#0#0#0#0#0;
  928.             Int64((@TempStr[1])^) := fvar^.ts64;
  929.         end;{$ENDIF}
  930.       end; {case}
  931.       if UseReg then
  932.       begin
  933.         case RegUsage of
  934.           0: begin EAX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
  935.           1: begin EDX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
  936.           2: begin ECX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
  937.           else Stack := TempStr + Stack;
  938.         end;
  939.       end else begin
  940.         Stack := TempStr + Stack;
  941.       end;
  942.     end;                      
  943.     Result := True;
  944.   end;
  945. begin
  946.   InnerfuseCall := False;
  947.   if Address = nil then
  948.     exit; // need address
  949.   Stack := '';
  950.   CallData := TIfList.Create;
  951.   if res <> nil then
  952.     res^.RefCount := res^.RefCount or IFPSAddrStackStart;
  953.   try
  954.   try
  955.     case CallingConv of
  956.       ccRegister: begin
  957.           EAX := 0;
  958.           EDX := 0;
  959.           ECX := 0;
  960.           RegUsage := 0;
  961.           if assigned(Self) then begin
  962.             RegUsage := 1;
  963.             EAX := Longint(Self);
  964.           end;
  965.           for I := 0 to Params.Count - 1 do
  966.           begin
  967.             if not GetPtr(Params.GetItem(I)) then Exit;
  968.           end;
  969.           if assigned(res) then begin
  970.             case res^.FType^.BaseType of
  971.               btResourcePointer:
  972.                 begin
  973.                   if SupFunc = nil then exit;
  974.                   if SupFunc^.ResultMethod = rmParam then GetPtr(res);
  975.                 end;
  976.               btrecord, btstring{$IFNDEF NOINT64}, bts64{$ENDIF}{$IFDEF HAVEVARIANT}, btVariant{$ENDIF}: GetPtr(res);
  977.             end;
  978.             case res^.FType^.BaseType of
  979.               btSingle:      res^.tsingle := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
  980.               btDouble:      res^.tdouble:= RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
  981.               btExtended:    res^.textended:= RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
  982.               btU8, btS8:    res^.tu8 := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1);
  983.               btu16, bts16:  res^.tu16:= RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2);
  984.               btu32, bts32:  res^.tu32:= RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4);
  985.               btPChar:       TBTSTRING(res^.tstring) := Pchar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4));
  986.               {$IFNDEF NOINT64}bts64, {$ENDIF}{$IFDEF HAVEVARIANT}btVariant, {$ENDIF}
  987.               btrecord, btstring:      RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0);
  988.               btResourcePointer: if SupFunc^.ResultMethod = rmParam then
  989.                   RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0)
  990.                 else
  991.                   SupFunc^.ResToPtr(SupFunc, SE, RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4), res);
  992.             else
  993.               exit;
  994.             end;
  995.           end else
  996.             RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0);
  997.           Result := True;
  998.         end;
  999.       ccPascal: begin
  1000.           RegUsage := 3;
  1001.           for I :=  0 to Params.Count - 1 do begin
  1002.             if not GetPtr(Params.GetItem(i)) then Exit;
  1003.           end;
  1004.           if assigned(res) then begin
  1005.             case res^.FType^.BaseType of
  1006.               btResourcePointer:
  1007.                 begin
  1008.                   if SupFunc = nil then exit;
  1009.                   if SupFunc^.ResultMethod = rmParam then GetPtr(res);
  1010.                 end;
  1011.               btrecord, btstring{$IFNDEF NOINT64}, bts64{$ENDIF}{$IFDEF HAVEVARIANT}, btVariant{$ENDIF}: GetPtr(res);
  1012.             end;
  1013.           end;
  1014.           if assigned(Self) then begin
  1015.             Stack := #0#0#0#0 +Stack;
  1016.             Pointer((@Stack[1])^) := Self;
  1017.           end;
  1018.           if assigned(res) then begin
  1019.             case res^.FType^.BaseType of
  1020.               btSingle:      res^.tsingle := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1021.               btDouble:      res^.tdouble:= RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1022.               btExtended:    res^.textended:= RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1023.               btU8, btS8:    res^.tu8 := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1);
  1024.               btu16, bts16:  res^.tu16:= RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2);
  1025.               btu32, bts32:  res^.tu32:= RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4);
  1026.               btPChar:       TBTSTRING(res^.tstring) := Pchar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4));
  1027.               {$IFNDEF NOINT64}bts64, {$ENDIF}{$IFDEF HAVEVARIANT}btVariant, {$ENDIF}
  1028.               btrecord, btstring:      RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0);
  1029.               btResourcePointer: if SupFunc^.ResultMethod = rmParam then
  1030.                   RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0)
  1031.                 else
  1032.                   SupFunc^.ResToPtr(SupFunc, SE, RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4), res);
  1033.             else
  1034.               exit;
  1035.             end;
  1036.           end else
  1037.             RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0);
  1038.           Result := True;
  1039.         end;
  1040.  
  1041.       CCCdecl: begin
  1042.           RegUsage := 3;
  1043.           if assigned(Self) then begin
  1044.             Stack := #0#0#0#0;
  1045.             Pointer((@Stack[1])^) := Self;
  1046.           end;
  1047.           for I := Params.Count - 1 downto 0 do begin
  1048.             if not GetPtr(Params.GetItem(I)) then Exit;
  1049.           end;
  1050.           if assigned(res) then begin
  1051.             case res^.FType^.BaseType of
  1052.               btSingle:      res^.tsingle := RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1053.               btDouble:      res^.tdouble:= RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1054.               btExtended:    res^.textended:= RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1055.               btU8, btS8:    res^.tu8 := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1);
  1056.               btu16, bts16:  res^.tu16:= RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2);
  1057.               btu32, bts32:  res^.tu32:= RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4);
  1058.               btPChar:       TBTSTRING(res^.tstring) := Pchar(RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4));
  1059.               {$IFNDEF NOINT64}bts64, {$ENDIF}{$IFDEF HAVEVARIANT}btVariant, {$ENDIF}
  1060.               btrecord, btstring:      begin GetPtr(res); RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0); end;
  1061.               btResourcePointer: begin
  1062.                 if SupFunc = nil then exit;
  1063.                 if SupFunc^.ResultMethod = rmParam then begin
  1064.                   GetPtr(res);
  1065.                   RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0);
  1066.                 end else
  1067.                   SupFunc^.ResToPtr(SupFunc, SE, RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4), res);
  1068.               end;
  1069.             else
  1070.               exit;
  1071.             end;
  1072.           end else begin
  1073.             RealCall_CDecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0);
  1074.           end;
  1075.           Result := True;
  1076.         end;
  1077.       CCStdCall: begin
  1078.           RegUsage := 3;
  1079.           if assigned(Self) then begin
  1080.             Stack := #0#0#0#0;
  1081.             Pointer((@Stack[1])^) := Self;
  1082.           end;
  1083.           for I := Params.Count - 1 downto 0 do begin
  1084.             if not GetPtr(Params.GetItem(I)) then exit;
  1085.           end;
  1086.           if assigned(res) then begin
  1087.             case res^.FType^.BaseType of
  1088.               btSingle:      res^.tsingle := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1089.               btDouble:      res^.tdouble:= RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1090.               btExtended:    res^.textended:= RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
  1091.               btU8, btS8:    res^.tu8 := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1);
  1092.               btu16, bts16:  res^.tu16:= RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2);
  1093.               btu32, bts32:  res^.tu32:= RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4);
  1094.               btPChar:       TBTSTRING(res^.tstring) := Pchar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4));
  1095.               {$IFNDEF NOINT64}bts64, {$ENDIF}{$IFDEF HAVEVARIANT}btVariant, {$ENDIF}
  1096.               btrecord, btstring:      begin GetPtr(res); RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0); end;
  1097.               btResourcePointer: begin
  1098.                 if SupFunc = nil then exit;
  1099.                 if SupFunc^.ResultMethod = rmParam then begin
  1100.                   GetPtr(res);
  1101.                   RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0);
  1102.                 end else
  1103.                   SupFunc^.ResToPtr(SupFunc, SE, RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4), res);
  1104.               end;
  1105.             else
  1106.               exit;
  1107.             end;
  1108.           end else begin
  1109.             RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0);
  1110.           end;
  1111.           Result := True;
  1112.         end;
  1113.     end;
  1114.   except
  1115.     Result := False;
  1116.   end;
  1117.   finally
  1118.     if res <> nil then
  1119.       res^.RefCount := res^.RefCount and not IFPSAddrStackStart;
  1120.     for i := CallData.Count -1 downto 0 do
  1121.     begin
  1122.       pp := CallData.GetItem(i);
  1123.       case pp^.ftype of
  1124.         ciRecord: DestroyRecord(pp, SE, SupFunc);
  1125.         ciOpenArray: DestroyOpenArray(SE, pp, SupFunc);
  1126.         {$IFDEF HAVEVARIANT}ciVariant: if (pp^.varparam) then CopyBack(SE, pp); {$ENDIF}
  1127.       end;
  1128.       Dispose(pp);
  1129.     end;
  1130.     CallData.Free;
  1131.   end;
  1132. end;
  1133. {$IFDEF HAVEVARIANT}
  1134. begin
  1135.   VNull := Null;
  1136. {$ENDIF}
  1137. end.
  1138.  
  1139.