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