david
0172f78427
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@35 05c56307-c608-d34a-929d-697000501d7a
273 lines
7.9 KiB
ObjectPascal
273 lines
7.9 KiB
ObjectPascal
{Delphi function importer (compiletime)}
|
|
unit ifpidelphi;
|
|
{
|
|
Innerfuse Pascal Script Call unit
|
|
You may not copy a part of this unit, only use it as whole, with
|
|
Innerfuse Pascal Script Script Engine.
|
|
}
|
|
{$I ifps3_def.inc}
|
|
interface
|
|
uses
|
|
ifps3utl, ifps3common, ifpscomp;
|
|
|
|
|
|
{ Register a normal Delphi function at runtime. Decl should be the exact declaration of the
|
|
function. But since the const keyword is not support yet, you should leave that out.}
|
|
function RegisterDelphiFunctionC(SE: TIFPSPascalCompiler; const Decl: string): Boolean;
|
|
function RegisterDelphiFunctionC2(SE: TIFPSPascalCompiler; const Decl: string): TIFPSRegProc;
|
|
|
|
type
|
|
TFuncType = (ftProc, ftConstructor);
|
|
|
|
function ParseMethod(Owner: TIFPSPascalCompiler; const FClassName: string; const Decl: string; var DName, DStr: string; var Func: TFuncType): Boolean;
|
|
|
|
implementation
|
|
|
|
type
|
|
TComp = class(TIFPSPascalCompiler);
|
|
|
|
function ParseMethod(Owner: TIFPSPascalCompiler; const FClassName: string; const Decl: string; var DName, DStr: string; var Func: TFuncType): Boolean;
|
|
var
|
|
Parser: TIfPascalParser;
|
|
tt: PIFPSType;
|
|
FuncType: Byte;
|
|
VNames, Name, NDecl: string;
|
|
modifier: Char;
|
|
VCType: Cardinal;
|
|
|
|
function FindAdd(const Name, Decl: string): Cardinal;
|
|
begin
|
|
Result := Owner.FindType(Name);
|
|
if Result = Cardinal(-1) then
|
|
begin
|
|
tt := Owner.AddTypeS(Name, Decl);
|
|
tt.ExportName := True;
|
|
Result := TComp(Owner).FAvailableTypes.Count -1;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Parser := TIfPascalParser.Create;
|
|
Parser.SetText(Decl);
|
|
if Parser.CurrTokenId = CSTII_Function then
|
|
FuncType:= 0
|
|
else if Parser.CurrTokenId = CSTII_Procedure then
|
|
FuncType := 1
|
|
else if (Parser.CurrTokenId = CSTII_Constructor) and (FClassName <> '') then
|
|
FuncType := 2
|
|
else
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
NDecl := '';
|
|
Parser.Next;
|
|
if Parser.CurrTokenId <> CSTI_Identifier then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end; {if}
|
|
Name := Parser.GetToken;
|
|
Parser.Next;
|
|
if Parser.CurrTokenId = CSTI_OpenRound then
|
|
begin
|
|
Parser.Next;
|
|
if Parser.CurrTokenId <> CSTI_CloseRound then
|
|
begin
|
|
while True do
|
|
begin
|
|
if Parser.CurrTokenId = CSTII_Const then
|
|
begin
|
|
modifier := '@';
|
|
Parser.Next;
|
|
end
|
|
else
|
|
if Parser.CurrTokenId = CSTII_Var then
|
|
begin
|
|
modifier := '!';
|
|
Parser.Next;
|
|
end
|
|
else
|
|
modifier := '@';
|
|
if Parser.CurrTokenId <> CSTI_Identifier then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
VNames := Parser.GetToken + '|';
|
|
Parser.Next;
|
|
while Parser.CurrTokenId = CSTI_Comma do
|
|
begin
|
|
Parser.Next;
|
|
if Parser.CurrTokenId <> CSTI_Identifier then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
VNames := VNames + Parser.GetToken + '|';
|
|
Parser.Next;
|
|
end;
|
|
if Parser.CurrTokenId <> CSTI_Colon then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
Parser.Next;
|
|
if Parser.CurrTokenID = CSTII_Array then
|
|
begin
|
|
Parser.nExt;
|
|
if Parser.CurrTokenId <> CSTII_Of then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
Parser.Next;
|
|
if Parser.CurrTokenId = CSTII_Const then
|
|
VCType := FindAdd('!OPENARRAYOFCONST', 'array of variant')
|
|
else begin
|
|
VCType := Owner.FindType(Parser.GetToken);
|
|
if VCType = Cardinal(-1) then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
case TComp(Owner).GetAvailableType(VCType).BaseType of
|
|
btU8: VCType := FindAdd('!OPENARRAYOFU8', 'array of byte');
|
|
btS8: VCType := FindAdd('!OPENARRAYOFS8', 'array of ShortInt');
|
|
btU16: VCType := FindAdd('!OPENARRAYOFU16', 'array of SmallInt');
|
|
btS16: VCType := FindAdd('!OPENARRAYOFS16', 'array of Word');
|
|
btU32: VCType := FindAdd('!OPENARRAYOFU32', 'array of Cardinal');
|
|
btS32: VCType := FindAdd('!OPENARRAYOFS32', 'array of Longint');
|
|
btSingle: VCType := FindAdd('!OPENARRAYOFSINGLE', 'array of Single');
|
|
btDouble: VCType := FindAdd('!OPENARRAYOFDOUBLE', 'array of Double');
|
|
btExtended: VCType := FindAdd('!OPENARRAYOFEXTENDED', 'array of Extended');
|
|
btString: VCType := FindAdd('!OPENARRAYOFSTRING', 'array of String');
|
|
btPChar: VCType := FindAdd('!OPENARRAYOFPCHAR', 'array of PChar');
|
|
btVariant: VCType := FindAdd('!OPENARRAYOFVARIANT', 'array of variant');
|
|
{$IFNDEF NOINT64}btS64: VCType := FindAdd('!OPENARRAYOFS64', 'array of Int64');{$ENDIF}
|
|
btChar: VCType := FindAdd('!OPENARRAYOFCHAR', 'array of Char');
|
|
{$IFNDEF NOWIDESTRING}
|
|
btWideString: VCType := FindAdd('!OPENARRAYOFWIDESTRING', 'array of WideString');
|
|
btWideChar: VCType := FindAdd('!OPENARRAYOFWIDECHAR', 'array of WideChar');
|
|
{$ENDIF}
|
|
else
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end else begin
|
|
VCType := Owner.FindType(Parser.GetToken);
|
|
if VCType = Cardinal(-1) then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
while Pos('|', VNames) > 0 do
|
|
begin
|
|
NDecl := NDecl + ' ' + modifier + copy(VNames, 1, Pos('|', VNames) - 1)
|
|
+
|
|
' ' + inttostr(VCType);
|
|
Delete(VNames, 1, Pos('|', VNames));
|
|
end;
|
|
Parser.Next;
|
|
if Parser.CurrTokenId = CSTI_CloseRound then
|
|
break;
|
|
if Parser.CurrTokenId <> CSTI_Semicolon then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
Parser.Next;
|
|
end; {while}
|
|
end; {if}
|
|
Parser.Next;
|
|
end; {if}
|
|
if FuncType = 0 then
|
|
begin
|
|
if Parser.CurrTokenId <> CSTI_Colon then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
|
|
Parser.Next;
|
|
VCType := Owner.FindType(Parser.GetToken);
|
|
if VCType = Cardinal(-1) then
|
|
begin
|
|
Parser.Free;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end
|
|
else if FuncType = 2 then {constructor}
|
|
begin
|
|
VCType := Owner.FindType(FClassName)
|
|
end else
|
|
VCType := Cardinal(-1);
|
|
NDecl := inttostr(VCType) + NDecl;
|
|
Parser.Free;
|
|
DName := Name;
|
|
DStr := NDecl;
|
|
if FuncType = 2 then
|
|
Func := ftConstructor
|
|
else
|
|
Func := ftProc;
|
|
Result := True;
|
|
end;
|
|
|
|
function RegisterDelphiFunctionC(SE: TIFPSPascalCompiler; const Decl: string): Boolean;
|
|
begin
|
|
Result := RegisterDelphiFunctionC2(SE, Decl) <> nil;
|
|
end;
|
|
|
|
function RegisterDelphiFunctionC2(SE: TIFPSPascalCompiler; const Decl: string): TIFPSRegProc;
|
|
var
|
|
p: TIFPSRegProc;
|
|
DName, s: string;
|
|
FT: TFuncType;
|
|
|
|
begin
|
|
if not ParseMethod(SE, '', Decl, DName, s, FT) then begin Result := nil; exit; end;
|
|
|
|
p := TIFPSRegProc.Create;
|
|
P.Name := DName;
|
|
p.ExportName := True;
|
|
p.Decl := s;
|
|
|
|
TComp(SE).FRegProcs.Add(p);
|
|
|
|
if GRFW(s) = '-1' then
|
|
begin
|
|
p.ImportDecl := p.ImportDecl + #0;
|
|
end else
|
|
p.ImportDecl := p.ImportDecl + #1;
|
|
while length(s) > 0 do
|
|
begin
|
|
if s[1] = '!' then
|
|
p.ImportDecl := p.ImportDecl + #1
|
|
else
|
|
p.ImportDecl := p.ImportDecl + #0;
|
|
grfw(s);
|
|
grfw(s);
|
|
end;
|
|
p.ExportName := True;
|
|
Result := p;
|
|
end;
|
|
|
|
end.
|
|
|