home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRPT.ZIP / ifpasscript / libraries / call / ifpscall.pas next >
Pascal/Delphi Source File  |  2001-06-08  |  25KB  |  684 lines
  1. unit ifpscall;
  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 scriptengine DLL library or Delphi Library.
  6.  
  7. }
  8. interface
  9. uses
  10.   ifspas, ifs_var, ifs_utl;
  11.  
  12. type
  13.   TCallingConvention = (ccRegister, ccPascal, ccCdecl, ccStdcall);
  14.  
  15. function InnerfuseCall(Self, Address: Pointer; CallingConv: TCallingConvention; Params: PVariableManager; Res: PIFVariant): Boolean; // res should already have been created with the type used for it
  16.  
  17. function ReadHeader(SE: TIfPasScript; Decl: String; var FuncName, FuncParam: String; Var CC: TCallingConvention): Boolean;
  18.  
  19. implementation
  20. function ReadHeader(SE: TIfPasScript; Decl: String; var FuncName, FuncParam: String; Var CC: TCallingConvention): Boolean;
  21. var
  22.   Parser: TIfPascalParser;
  23.   CurrVar: string;
  24.   FuncRes,
  25.     CurrType: Longint;
  26.   E: TIFParserError;
  27.  
  28.   function GetType(const s: string): Longint;
  29.   var
  30.     t: PTypeRec;
  31.   begin
  32.     if (S = 'PCHAR') then
  33.     begin
  34.       t := SE.GetType('!PCHAR');
  35.       if t = nil then
  36.       begin
  37.         t := Se.AddTypeEx('!PCHAR');
  38.         t^.Ext := Pointer(1);
  39.       end;
  40.       GetType := Longint(T);
  41.     end else
  42.     begin
  43.       t := SE.GetType(S);
  44.       if not assigned(t) then begin GetType := 0; exit; end;
  45.       case T.atypeid of
  46.         CSV_UByte,
  47.         CSV_SByte,
  48.         CSV_UInt16,
  49.         CSV_SInt16,
  50.         CSV_UInt32,
  51.         CSV_SInt32,
  52.         CSV_Char,
  53.         CSV_String{,
  54.         CSV_Record}: GetType := Longint(T);
  55.         else GetType := 0;
  56.       end;
  57.     end;
  58.   end;
  59. begin
  60.   Parser := TIfPascalParser.Create;
  61.   ReadHeader := False;
  62.   if not Parser.SetText(Decl, E) then
  63.   begin
  64.     parser.Free;
  65.     exit;
  66.   end;
  67.   if Parser.CurrTokenId = CSTII_Procedure then
  68.     FuncRes := 0
  69.   else
  70.     FuncRes := 1;
  71.   Parser.Next;
  72.   FuncName := Parser.GetToken;
  73.   Parser.Next;
  74.   FuncParam := '';
  75.   CurrVar := '';
  76.   if Parser.CurrTokenId = CSTI_OpenRound then begin
  77.     Parser.Next;
  78.     while True do begin
  79.       if Parser.CurrTokenId = CSTI_Eof then begin
  80.         Parser.Free;
  81.         exit;
  82.       end;
  83.       if Parser.CurrTokenId = CSTII_Var then begin
  84.         CurrVar := '!';
  85.         Parser.Next;
  86.       end; {if}
  87.       while True do begin
  88.         if Parser.CurrTokenId = CSTI_Eof then begin
  89.           Parser.Free;
  90.           exit;
  91.         end;
  92.         if Parser.CurrTokenId <> CSTI_Identifier then begin
  93.           parser.Free;
  94.           exit;
  95.         end;
  96.         CurrVar := CurrVar + Parser.GetToken + '|';
  97.         Parser.Next;
  98.         if Parser.CurrTokenId = CSTI_Colon then break;
  99.         if Parser.CurrTokenId <> CSTI_Comma then begin
  100.           parser.Free;
  101.           exit;
  102.         end;
  103.         Parser.Next;
  104.       end; {while}
  105.       Parser.Next;
  106.       CurrType := GetType(Parser.GetToken);
  107.       if CurrType = 0 then
  108.       begin
  109.         Parser.Free;
  110.         exit;
  111.       end;
  112.       if Pos('!', CurrVar) = 1 then begin
  113.         Delete(CurrVar, 1, 1);
  114.         while Pos('|', CurrVar) > 0 do begin
  115.           FuncParam := FuncParam + ' !' + copy(CurrVar, 1, Pos('|', CurrVar) - 1) + ' ' + inttostr(CurrType);
  116.           Delete(CurrVar, 1, Pos('|', CurrVar));
  117.         end; {while}
  118.       end else begin
  119.         while Pos('|', CurrVar) > 0 do begin
  120.           FuncParam := FuncParam + ' ' + copy(CurrVar, 1, Pos('|', CurrVar) - 1) + ' ' + inttostr(CurrType);
  121.           Delete(CurrVar, 1, Pos('|', CurrVar));
  122.         end; {while}
  123.       end; {if}
  124.       Parser.Next;
  125.       if Parser.CurrTokenId = CSTI_CloseRound then begin
  126.         Parser.Next;
  127.         break;
  128.       end; {if}
  129.       Parser.Next;
  130.     end;
  131.   end;
  132.   if FuncRes = 1 then begin
  133.     Parser.Next;
  134.     FuncRes := GetType(Parser.GetToken);
  135.     if FuncRes = 0 then begin
  136.       Parser.Free;
  137.       exit;
  138.     end;
  139.     Parser.Next;
  140.   end;
  141.   CC := ccRegister;
  142.   if Parser.CurrTokenID = CSTI_Semicolon then
  143.   begin
  144.     Parser.Next;
  145.     if Parser.CurrTokenId = CSTI_Identifier then
  146.     begin
  147.       if Parser.GetToken = 'STDCALL' then
  148.         CC := CCStdCall
  149.       else if Parser.GetToken = 'CDECL' then
  150.         CC := CCCdecl
  151.       else if Parser.GetToken = 'PASCAL' then
  152.         CC := ccPascal;
  153.       // Register is default.
  154.     end;
  155.   end;
  156.   FuncParam := inttostr(FuncRes) + FuncParam;
  157.   ReadHeader := True;
  158.   Parser.Free;
  159. end;
  160.  
  161. function  RealCall_Register(p: Pointer;
  162.                    _EAX, _EDX, _ECX: Cardinal;
  163.                    StackData: pointer;
  164.                    StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
  165.                    ResultLength: Longint):Longint; stdcall; // make sure all things are on stack
  166. var
  167.   r: Longint;                   
  168. begin
  169.   asm
  170.     mov ecx, stackdatalen
  171.     jecxz @@2
  172.     mov eax, stackdata
  173.     @@1:
  174.     mov edx, [eax]
  175.     push edx
  176.     add eax,4
  177.     dec ecx
  178.     or ecx, ecx
  179.     jnz @@1
  180.     @@2:
  181.     mov eax,_EAX
  182.     mov edx,_EDX
  183.     mov ecx,_ECX
  184.     call p
  185.     mov ecx, resultlength
  186.     cmp ecx, 0
  187.     je @@5
  188.     cmp ecx, 1
  189.     je @@3
  190.     cmp ecx, 2
  191.     je @@4
  192.     mov r, eax
  193.     jmp @@5
  194.     @@3:
  195.     xor ecx, ecx
  196.     mov cl, al
  197.     mov r, ecx
  198.     jmp @@5
  199.     @@4:
  200.     xor ecx, ecx
  201.     mov cx, ax
  202.     mov r, ecx
  203.     @@5:
  204.   end;
  205.   result := r;
  206. end;
  207.  
  208. function  RealCall_Other(p: Pointer;
  209.                    StackData: pointer;
  210.                    StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
  211.                    ResultLength: Longint): Longint; stdcall; // make sure all things are on stack
  212. var
  213.   R: Longint;
  214. begin
  215.   asm
  216.     mov ecx, stackdatalen
  217.     jecxz @@2
  218.     mov eax, stackdata
  219.     @@1:
  220.     mov edx, [eax]
  221.     push edx
  222.     add eax,4
  223.     dec ecx
  224.     or ecx, ecx
  225.     jnz @@1
  226.     @@2:
  227.     call p
  228.     mov ecx, resultlength
  229.     cmp ecx, 0
  230.     je @@5
  231.     cmp ecx, 1
  232.     je @@3
  233.     cmp ecx, 2
  234.     je @@4
  235.     mov r, eax
  236.     jmp @@5
  237.     @@3:
  238.     xor ecx, ecx
  239.     mov cl, al
  240.     mov r, ecx
  241.     jmp @@5
  242.     @@4:
  243.     xor ecx, ecx
  244.     mov cx, ax
  245.     mov r, ecx
  246.     @@5:
  247.   end;
  248.   result := r;
  249. end;
  250. function RealCall_CDecl(p: Pointer;
  251.                    StackData: pointer;
  252.                    StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
  253.                    ResultLength: Longint): Longint; stdcall; // make sure all things are on stack
  254. var
  255.   R: Longint;                   
  256. begin
  257.   asm
  258.     mov ecx, stackdatalen
  259.     jecxz @@2
  260.     mov eax, stackdata
  261.     @@1:
  262.     mov edx, [eax]
  263.     push edx
  264.     add eax,4
  265.     dec ecx
  266.     or ecx, ecx
  267.     jnz @@1
  268.     @@2:
  269.     call p
  270.     mov ecx, resultlength
  271.     cmp ecx, 0
  272.     je @@5
  273.     cmp ecx, 1
  274.     je @@3
  275.     cmp ecx, 2
  276.     je @@4
  277.     mov r, eax
  278.     jmp @@5
  279.     @@3:
  280.     xor ecx, ecx
  281.     mov cl, al
  282.     mov r, ecx
  283.     jmp @@5
  284.     @@4:
  285.     xor ecx, ecx
  286.     mov cx, ax
  287.     mov r, ecx
  288.     @@5:
  289.     mov ecx, stackdatalen
  290.     jecxz @@2
  291.     @@6:
  292.     pop edx
  293.     dec ecx
  294.     or ecx, ecx
  295.     jnz @@6
  296.   end;
  297.   Result := R;
  298. end;
  299.  
  300.  
  301. function InnerfuseCall(Self, Address: Pointer; CallingConv: TCallingConvention; Params: PVariableManager; Res: PIFVariant): Boolean; // res should already have been created with the type used for it
  302. var
  303.   Stack: ansistring;
  304.   i: Longint;
  305.   RegUsage: Byte;
  306.   EAX, EDX, ECX: Longint;
  307. begin
  308.   InnerfuseCall := False;
  309.   if Address = nil then
  310.     exit; // need address
  311.   stack := '';
  312.   case CallingConv of
  313.     ccRegister:
  314.     begin
  315.       EAX := 0;
  316.       EDX := 0;
  317.       ECX := 0;
  318.       RegUsage:= 0;
  319.       if assigned(Self) then
  320.       begin
  321.         RegUsage := 1;
  322.         EAX := Longint(Self);
  323.       end;
  324.       for i := 0 to VM_Count(Params)-1 do
  325.       begin
  326.         if VM_Get(Params, I)^.vtype^.atypeid = CSV_VAR then // var parameter
  327.         begin
  328.           case GetVarLink(VM_Get(Params, I))^.vtype^.atypeid of
  329.             CSV_Char, CSV_UByte, CSV_SByte: begin
  330.               case RegUsage of
  331.                 0: begin EAX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_UByte); inc(RegUsage);end;
  332.                 1: begin EDX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_UByte); inc(RegUsage);end;
  333.                 2: begin ECX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_UByte); inc(RegUsage);end;
  334.               else
  335.                 begin
  336.                   Stack := Stack + #0#0#0#0;
  337.                   Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Char);
  338.                 end;
  339.               end;
  340.             end;
  341.             CSV_UInt16, CSV_SInt16: begin
  342.               case RegUsage of
  343.                 0: begin EAX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_UInt16); Inc(RegUsage); end;
  344.                 1: begin EDX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_UInt16); Inc(RegUsage); end;
  345.                 2: begin ECX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_UInt16); Inc(RegUsage); end;
  346.                 else
  347.                   begin
  348.                     Stack := Stack + #0#0#0#0;
  349.                     Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Uint16);
  350.                   end;
  351.               end;
  352.             end;
  353.             CSV_UInt32, CSV_SInt32: begin
  354.               case RegUsage of
  355.                 0: Begin EAX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_SInt32); Inc(RegUsage); end;
  356.                 1: Begin EDX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_SInt32); Inc(RegUsage); end;
  357.                 2: Begin ECX := Longint(@GetVarLink(VM_Get(Params, I))^.CV_SInt32); Inc(RegUsage); end;
  358.               else
  359.                 begin
  360.                   Stack := Stack + #0#0#0#0;
  361.                   Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Sint32);
  362.                 end;
  363.               end;
  364.             end;
  365.             CSV_String: begin
  366.               case RegUsage of
  367.                 0: begin EAX := Longint(@(GetVarLink(VM_Get(Params, I))^.CV_Str)); Inc(RegUsage); end;
  368.                 1: begin EDX := Longint(@(GetVarLink(VM_Get(Params, I))^.CV_Str)); Inc(RegUsage); end;
  369.                 2: begin ECX := Longint(@(GetVarLink(VM_Get(Params, I))^.CV_Str)); Inc(RegUsage); end;
  370.                 else begin Stack := Stack + #0#0#0#0;Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  371.               end;
  372.             end;
  373.           else
  374.             begin
  375.               exit; //invalid type
  376.             end;
  377.           end;
  378.         end else begin
  379.           case GetVarLink(VM_Get(Params, I))^.vtype^.atypeid of
  380.             CSV_Char, CSV_UByte, CSV_SByte: begin
  381.               case RegUsage of
  382.                 0: begin EAX := GetVarLink(VM_Get(Params, I))^.CV_UByte; inc(RegUsage);end;
  383.                 1: begin EDX := GetVarLink(VM_Get(Params, I))^.CV_UByte; inc(RegUsage);end;
  384.                 2: begin ECX := GetVarLink(VM_Get(Params, I))^.CV_UByte; inc(RegUsage);end;
  385.               else
  386.                 begin
  387.                   Stack := Stack + GetVarLink(VM_Get(Params, I))^.CV_Char + #0#0#0;
  388.                 end;
  389.               end;
  390.             end;
  391.             CSV_UInt16, CSV_SInt16: begin
  392.               case RegUsage of
  393.                 0: begin EAX := GetVarLink(VM_Get(Params, I))^.CV_UInt16; Inc(RegUsage); end;
  394.                 1: begin EDX := GetVarLink(VM_Get(Params, I))^.CV_UInt16; Inc(RegUsage); end;
  395.                 2: begin ECX := GetVarLink(VM_Get(Params, I))^.CV_UInt16; Inc(RegUsage); end;
  396.                 else
  397.                   begin
  398.                     Stack := Stack + #0#0#0#0; Word((@Stack[Length(Stack)-3])^) := GetVarLink(VM_Get(Params, I))^.CV_UInt16;
  399.                   end;
  400.               end;
  401.             end;
  402.             CSV_UInt32, CSV_SInt32: begin
  403.               case RegUsage of
  404.                 0: Begin EAX := GetVarLink(VM_Get(Params, I))^.CV_SInt32; Inc(RegUsage); end;
  405.                 1: Begin EDX := GetVarLink(VM_Get(Params, I))^.CV_SInt32; Inc(RegUsage); end;
  406.                 2: Begin ECX := GetVarLink(VM_Get(Params, I))^.CV_SInt32; Inc(RegUsage); end;
  407.               else
  408.                 begin
  409.                   Stack := Stack + #0#0#0#0; Longint((@Stack[Length(Stack)-3])^) := GetVarLink(VM_Get(Params, I))^.CV_SInt32;
  410.                 end;
  411.               end;
  412.             end;
  413.             CSV_String: begin
  414.               case RegUsage of
  415.                 0: begin EAX := Longint(Pchar(GetVarLink(VM_Get(Params, I))^.CV_Str)); Inc(RegUsage); end;
  416.                 1: begin EDX := Longint(Pchar(GetVarLink(VM_Get(Params, I))^.CV_Str)); Inc(RegUsage); end;
  417.                 2: begin ECX := Longint(Pchar(GetVarLink(VM_Get(Params, I))^.CV_Str)); Inc(RegUsage); end;
  418.                 else begin Stack := Stack + #0#0#0#0; if GetVarLink(VM_Get(Params, I))^.cv_Str <> '' then Pointer((@Stack[Length(Stack)-3])^) := Pchar(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  419.               end;
  420.             end;
  421.           else
  422.             begin
  423.               exit; //invalid type
  424.             end;
  425.           end;
  426.         end;
  427.       end;
  428.       if Assigned(Res) then
  429.       begin
  430.         case Res^.VType^.atypeid of
  431.           CSV_String: begin
  432.             if Longint(Res^.VType^.ext) = 0 then
  433.             begin
  434.               case RegUsage of
  435.               0: begin EAX := Longint(@Res^.cv_Str); end;
  436.               1: begin EDX := Longint(@Res^.cv_Str); end;
  437.               2: begin ECX := Longint(@Res^.cv_Str); end;
  438.               else begin Stack := Stack + #0#0#0#0; Longint((@Stack[Length(Stack)-3])^) := Longint(@Res^.cv_Str); end;
  439.               end;
  440.             end;
  441.           end;
  442.         end;
  443.       end;
  444.       if assigned(Res) then
  445.       begin
  446.         case Res^.vtype^.atypeid of
  447.           CSV_Char, CSV_UByte, CSV_SByte: begin
  448.             Res^.CV_UByte := RealCall_Register(Address, EAX, EDX, ECX, @Stack[1], Length(Stack) div 4, 1);
  449.           end;
  450.           CSV_UInt16, CSV_SInt16: begin
  451.             res^.CV_UInt16 := RealCall_Register(Address, EAX, EDX, ECX, @Stack[1], Length(Stack) div 4, 2);
  452.           end;
  453.           CSV_UInt32, CSV_SInt32: begin
  454.             Res^.CV_SInt32 := RealCall_Register(Address, EAX, EDX, ECX, @Stack[1], Length(Stack) div 4, 4);
  455.           end;
  456.           CSV_String: if Longint(Res^.VType^.ext) = 1 then begin
  457.             Res^.CV_Str := PChar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[1], Length(Stack) div 4, 0));
  458.           end else RealCall_Register(Address, EAX, EDX, ECX, @Stack[1], Length(Stack) div 4, 0);
  459.         else
  460.           exit;
  461.         end;
  462.       end else begin
  463.         RealCall_Register(Address, EAX, EDX, ECX, @Stack[1], Length(Stack) div 4, 0);
  464.       end;
  465.       Result := True;
  466.     end;
  467.  
  468.     ccPascal:
  469.     begin
  470.       for i := 0 to VM_Count(Params)-1 do
  471.       begin
  472.         if VM_Get(Params, I)^.vtype^.atypeid = CSV_VAR then
  473.         begin
  474.           case GetVarLink(VM_Get(Params, I))^.vtype^.atypeid of
  475.             CSV_Char, CSV_UByte, CSV_SByte: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Char); end;
  476.             CSV_UInt16, CSV_SInt16: begin Stack := Stack + #0#0#0#0;  Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_UInt16); end;
  477.             CSV_UInt32, CSV_SInt32: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_UInt32);end;
  478.             CSV_String: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  479.           else
  480.             begin
  481.               exit; //invalid type
  482.             end;
  483.           end;
  484.         end else begin
  485.           case GetVarLink(VM_Get(Params, I))^.vtype^.atypeid of
  486.             CSV_Char, CSV_UByte, CSV_SByte: Stack := Stack + GetVarLink(VM_Get(Params, I))^.CV_Char + #0#0#0;
  487.             CSV_UInt16, CSV_SInt16: begin Stack := Stack + #0#0#0#0; Word((@Stack[Length(Stack)-3])^) := GetVarLink(VM_Get(Params, I))^.CV_UInt16; end;
  488.             CSV_UInt32, CSV_SInt32: begin Stack := Stack + #0#0#0#0; Longint((@Stack[Length(Stack)-3])^) := GetVarLink(VM_Get(Params, I))^.CV_SInt32;
  489.             end;
  490.             CSV_String: begin
  491.               case Longint(GetVarLink(VM_Get(Params, I))^.vtype^.Ext) of
  492.                 0 : begin Stack := Stack + #0#0#0#0; if GetVarLink(VM_Get(Params, I))^.cv_Str <> '' then Pointer((@Stack[Length(Stack)-3])^) := Pchar(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  493.                 1 : begin Stack := Stack + #0#0#0#0; if GetVarLink(VM_Get(Params, I))^.cv_Str <> '' then Pointer((@Stack[Length(Stack)-3])^) := PChar(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  494.               end;
  495.             end;
  496.           else
  497.             begin
  498.               exit; //invalid type
  499.             end;
  500.           end;
  501.         end;
  502.       end;
  503.       if Assigned(Res) then
  504.       begin
  505.         case Res^.VType^.atypeid of
  506.           CSV_String: begin
  507.             if Longint(Res^.VType^.ext) = 0 then
  508.             begin
  509.               Stack := Stack + #0#0#0#0;
  510.               Longint((@Stack[Length(Stack)-3])^) := Longint(@Res^.cv_Str);
  511.             end;
  512.           end;
  513.         end;
  514.       end;
  515.       if assigned(Self) then
  516.       begin
  517.         Stack := Stack + #0#0#0#0;
  518.         Pointer((@Stack[Length(Stack)-3])^) := Self;
  519.       end;
  520.       if assigned(Res) then
  521.       begin
  522.         case Res^.vtype^.atypeid of
  523.           CSV_Char, CSV_UByte, CSV_SByte: begin
  524.             Res^.CV_UByte := RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 1);
  525.           end;
  526.           CSV_UInt16, CSV_SInt16: begin
  527.             res^.CV_UInt16 := RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 2);
  528.           end;
  529.           CSV_UInt32, CSV_SInt32: begin
  530.             Res^.CV_SInt32 := RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 4);
  531.           end;
  532.           CSV_String: if Longint(Res^.VType^.ext) = 1 then begin
  533.             Res^.CV_Str := PChar(RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 0));
  534.           end else RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 0);
  535.         else
  536.           exit;
  537.         end;
  538.       end else begin
  539.         RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 0);
  540.       end;
  541.       Result := True;
  542.     end;
  543.  
  544.     ccCdecl: begin
  545.       if assigned(Self) then
  546.       begin
  547.         Stack := Stack + #0#0#0#0;
  548.         Pointer((@Stack[Length(Stack)-3])^) := Self;
  549.       end;
  550.       for i := VM_Count(Params)-1 downto 0 do
  551.       begin
  552.         if VM_Get(Params, I)^.vtype^.atypeid = CSV_VAR then
  553.         begin
  554.           case GetVarLink(VM_Get(Params, I))^.vtype^.atypeid of
  555.             CSV_Char, CSV_UByte, CSV_SByte: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Char); end;
  556.             CSV_UInt16, CSV_SInt16: begin Stack := Stack + #0#0#0#0;  Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_UInt16); end;
  557.             CSV_UInt32, CSV_SInt32: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_UInt32);end;
  558.             CSV_String: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  559.           else
  560.             begin
  561.               exit; //invalid type
  562.             end;
  563.           end;
  564.         end else begin
  565.           case GetVarLink(VM_Get(Params, I))^.vtype^.atypeid of
  566.             CSV_Char, CSV_UByte, CSV_SByte: Stack := Stack  + GetVarLink(VM_Get(Params, I))^.CV_Char+ #0#0#0;
  567.             CSV_UInt16, CSV_SInt16: begin Stack := Stack + #0#0#0#0; Word((@Stack[Length(Stack)-3])^) := GetVarLink(VM_Get(Params, I))^.CV_UInt16; end;
  568.             CSV_UInt32, CSV_SInt32: begin Stack := Stack + #0#0#0#0; Longint((@Stack[Length(Stack)-3])^) := GetVarLink(VM_Get(Params, I))^.CV_SInt32;
  569.             end;
  570.             CSV_String: begin
  571.               case Longint(GetVarLink(VM_Get(Params, I))^.vtype^.Ext) of
  572.                 0 : begin Stack := Stack + #0#0#0#0; if GetVarLink(VM_Get(Params, I))^.cv_Str <> '' then Pointer((@Stack[Length(Stack)-3])^) := Pchar(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  573.                 1 : begin Stack := Stack + #0#0#0#0; if GetVarLink(VM_Get(Params, I))^.cv_Str <> '' then Pointer((@Stack[Length(Stack)-3])^) := PChar(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  574.               end;
  575.             end;
  576.           else
  577.             begin
  578.               exit; //invalid type
  579.             end;
  580.           end;
  581.         end;
  582.       end;
  583.       if assigned(Res) then
  584.       begin
  585.         case Res^.VType^.atypeid of
  586.           CSV_String: begin
  587.             if Longint(Res^.VType^.ext) = 0 then
  588.             begin
  589.               Stack := Stack + #0#0#0#0;
  590.               Longint((@Stack[Length(Stack)-3])^) := Longint(@Res^.cv_Str);
  591.               RealCall_CDECL(Address, @Stack[1], Length(Stack) div 4, 0);
  592.             end else begin
  593.               Res^.CV_Str := Pchar(RealCall_CDECL(Address, @Stack[1], Length(Stack) div 4, 0));
  594.             end;
  595.           end;
  596.           CSV_Char, CSV_UByte, CSV_SByte: begin
  597.             Res^.CV_UByte := RealCall_CDECL(Address, @Stack[1], Length(Stack) div 4, 1);
  598.           end;
  599.           CSV_UInt16, CSV_SInt16: begin
  600.             res^.CV_UInt16 := RealCall_CDECL(Address, @Stack[1], Length(Stack) div 4, 2);
  601.           end;
  602.           CSV_UInt32, CSV_SInt32: begin
  603.             Res^.CV_SInt32 := RealCall_CDECL(Address, @Stack[1], Length(Stack) div 4, 4);
  604.           end;
  605.         else
  606.           exit;
  607.         end;
  608.       end else begin
  609.         RealCall_CDECL(Address, @Stack[1], Length(Stack) div 4, 0);
  610.       end;
  611.       Result := True;
  612.     end;
  613.     ccStdcall: begin
  614.       if assigned(Self) then
  615.       begin
  616.         Stack := Stack + #0#0#0#0;
  617.         Pointer((@Stack[Length(Stack)-3])^) := Self;
  618.       end;
  619.       for i := VM_Count(Params)-1 downto 0 do
  620.       begin
  621.         if VM_Get(Params, I)^.vtype^.atypeid = CSV_VAR then
  622.         begin
  623.           case GetVarLink(VM_Get(Params, I))^.vtype^.atypeid of
  624.             CSV_Char, CSV_UByte, CSV_SByte: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Char); end;
  625.             CSV_UInt16, CSV_SInt16: begin Stack := Stack + #0#0#0#0;  Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_UInt16); end;
  626.             CSV_UInt32, CSV_SInt32: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_UInt32);end;
  627.             CSV_String: begin Stack := Stack + #0#0#0#0; Pointer((@Stack[Length(Stack)-3])^) := @(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  628.           else
  629.             begin
  630.               exit; //invalid type
  631.             end;
  632.           end;
  633.         end else begin
  634.           case GetVarLink(VM_Get(Params, I))^.vtype^.atypeid of
  635.             CSV_Char, CSV_UByte, CSV_SByte: Stack := Stack + GetVarLink(VM_Get(Params, I))^.CV_Char + #0#0#0;
  636.             CSV_UInt16, CSV_SInt16: begin Stack := Stack + #0#0#0#0; Word((@Stack[Length(Stack)-3])^) := GetVarLink(VM_Get(Params, I))^.CV_UInt16; end;
  637.             CSV_UInt32, CSV_SInt32: begin Stack := Stack + #0#0#0#0; Longint((@Stack[Length(Stack)-3])^) := GetVarLink(VM_Get(Params, I))^.CV_SInt32;
  638.             end;
  639.             CSV_String: begin
  640.               case Longint(GetVarLink(VM_Get(Params, I))^.vtype^.Ext) of
  641.                 0 : begin Stack := Stack + #0#0#0#0; if GetVarLink(VM_Get(Params, I))^.cv_Str <> '' then Pointer((@Stack[Length(Stack)-3])^) := Pchar(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  642.                 1 : begin Stack := Stack + #0#0#0#0; if GetVarLink(VM_Get(Params, I))^.cv_Str <> '' then Pointer((@Stack[Length(Stack)-3])^) := PChar(GetVarLink(VM_Get(Params, I))^.CV_Str); end;
  643.               end;
  644.             end;
  645.           else
  646.             begin
  647.               exit; //invalid type
  648.             end;
  649.           end;
  650.         end;
  651.       end;
  652.       if assigned(Res) then
  653.       begin
  654.         case Res^.VType^.atypeid of
  655.           CSV_String: begin
  656.             if Longint(Res^.VType^.ext) = 0 then
  657.             begin
  658.               Stack := Stack + #0#0#0#0;
  659.               Longint((@Stack[Length(Stack)-3])^) := Longint(@Res^.cv_Str);
  660.               RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 0);
  661.             end else Res^.CV_Str := Pchar(RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 0));
  662.           end;
  663.           CSV_Char, CSV_UByte, CSV_SByte: begin
  664.             Res^.CV_UByte := RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 1);
  665.           end;
  666.           CSV_UInt16, CSV_SInt16: begin
  667.             res^.CV_UInt16 := RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 2);
  668.           end;
  669.           CSV_UInt32, CSV_SInt32: begin
  670.             Res^.CV_SInt32 := RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 4);
  671.           end;
  672.         else
  673.           exit;
  674.         end;
  675.       end else begin
  676.         RealCall_Other(Address, @Stack[1], Length(Stack) div 4, 0);
  677.       end;
  678.       Result := True;
  679.     end;
  680.   end;
  681. end;
  682.  
  683. end.
  684.