You've already forked lazarus-ccr
chelper: improved function declaration parsing and extern variables pascal code generation
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1276 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -323,7 +323,6 @@ type
|
|||||||
protected
|
protected
|
||||||
function DoParse(AParser:TTextParser): Boolean; override;
|
function DoParse(AParser:TTextParser): Boolean; override;
|
||||||
public
|
public
|
||||||
Specifiers : TStringList;
|
|
||||||
RetType : TEntity;
|
RetType : TEntity;
|
||||||
Names : TList;
|
Names : TList;
|
||||||
constructor Create(AOffset: Integer=-1); override;
|
constructor Create(AOffset: Integer=-1); override;
|
||||||
@ -1419,6 +1418,32 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function isCallConv(const s: AnsiString): AnsiString;
|
||||||
|
var
|
||||||
|
i : Integer;
|
||||||
|
c : AnsiString;
|
||||||
|
begin
|
||||||
|
Result:='';
|
||||||
|
if s='' then Exit;
|
||||||
|
|
||||||
|
c:=s;
|
||||||
|
for i:=1 to length(c) do
|
||||||
|
if c[i]<>'_' then begin
|
||||||
|
if i>1 then c:=Copy(c, i, length(c));
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
|
||||||
|
case c[1] of
|
||||||
|
'c': if (c='cdecl') or (c='clrcall') then Result:=c;
|
||||||
|
'f': if c='fastcall' then Result:=c;
|
||||||
|
's': if c='stdcall' then Result:=c;
|
||||||
|
't': if c='thiscall' then Result:=c;
|
||||||
|
'p': if c='pascal' then Result:=c;
|
||||||
|
'r': if c='register' then Result:=c;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure ParseSepcifiers(AParser: TTextParser; st: TStrings);
|
procedure ParseSepcifiers(AParser: TTextParser; st: TStrings);
|
||||||
begin
|
begin
|
||||||
while isSomeSpecifier(AParser.Token) do begin
|
while isSomeSpecifier(AParser.Token) do begin
|
||||||
@ -1676,12 +1701,21 @@ end;
|
|||||||
function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean): Boolean;
|
function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean): Boolean;
|
||||||
var
|
var
|
||||||
Name : TNamePart;
|
Name : TNamePart;
|
||||||
done : Boolean;
|
done : Boolean;
|
||||||
specs : TStringList;
|
specs : TStringList;
|
||||||
|
s : AnsiString;
|
||||||
begin
|
begin
|
||||||
specs:=TStringList.Create;
|
specs:=TStringList.Create;
|
||||||
|
|
||||||
ParseSepcifiers(Parser, specs);
|
ParseSepcifiers(Parser, specs);
|
||||||
NameType:=ParseCType(Parser);
|
NameType:=ParseCType(Parser);
|
||||||
|
|
||||||
|
s:=isCallConv(Parser.Token);
|
||||||
|
if s<>'' then begin
|
||||||
|
specs.Add(s);
|
||||||
|
Parser.NextToken;
|
||||||
|
end;
|
||||||
|
|
||||||
Result:=Assigned(NameType);
|
Result:=Assigned(NameType);
|
||||||
if Result then NameType.Specifiers.Assign(specs);
|
if Result then NameType.Specifiers.Assign(specs);
|
||||||
specs.Free;
|
specs.Free;
|
||||||
@ -1761,13 +1795,11 @@ end;
|
|||||||
constructor TVarFuncEntity.Create(AOffset: Integer);
|
constructor TVarFuncEntity.Create(AOffset: Integer);
|
||||||
begin
|
begin
|
||||||
inherited Create(AOffset);
|
inherited Create(AOffset);
|
||||||
Specifiers:=TStringList.Create;
|
|
||||||
Names:=TList.Create;
|
Names:=TList.Create;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TVarFuncEntity.Destroy;
|
destructor TVarFuncEntity.Destroy;
|
||||||
begin
|
begin
|
||||||
Specifiers.Free;
|
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -26,7 +26,6 @@ uses
|
|||||||
// is function declared, i.e. int f()
|
// is function declared, i.e. int f()
|
||||||
function isFunc(name: TNamePart): Boolean;
|
function isFunc(name: TNamePart): Boolean;
|
||||||
|
|
||||||
|
|
||||||
// probably an untyped function: fn ().
|
// probably an untyped function: fn ().
|
||||||
// the name of the function has been consumed by TYPE parsing, so ommited!
|
// the name of the function has been consumed by TYPE parsing, so ommited!
|
||||||
// so TNamepart doesn't contain any children
|
// so TNamepart doesn't contain any children
|
||||||
|
@ -129,7 +129,7 @@ type
|
|||||||
function NextCommentBefore(AOffset: Integer): Integer;
|
function NextCommentBefore(AOffset: Integer): Integer;
|
||||||
procedure WriteLnCommentsBeforeOffset(AOffset: Integer);
|
procedure WriteLnCommentsBeforeOffset(AOffset: Integer);
|
||||||
|
|
||||||
procedure WriteFuncDecl(const FnName, PasRetType: Ansistring; const params : array of TFuncParam);
|
procedure WriteFuncDecl(const FnName, PasRetType: AnsiString; const params : array of TFuncParam);
|
||||||
procedure WriteFuncOrVar(cent: TVarFuncEntity; StartVar, WriteComment: Boolean); // todo: deprecate!
|
procedure WriteFuncOrVar(cent: TVarFuncEntity; StartVar, WriteComment: Boolean); // todo: deprecate!
|
||||||
procedure WriteTypeDef(tp: TTypeDef);
|
procedure WriteTypeDef(tp: TTypeDef);
|
||||||
procedure WriteEnum(en: TEnumType);
|
procedure WriteEnum(en: TEnumType);
|
||||||
@ -725,7 +725,7 @@ begin
|
|||||||
(params[0].name=nil);
|
(params[0].name=nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TCodeConvertor.WriteFuncDecl(const FnName, PasRetType: Ansistring; const params : array of TFuncParam);
|
procedure TCodeConvertor.WriteFuncDecl(const FnName, PasRetType: AnsiString; const params : array of TFuncParam);
|
||||||
var
|
var
|
||||||
i : Integer;
|
i : Integer;
|
||||||
ptypes : array of String;
|
ptypes : array of String;
|
||||||
@ -762,6 +762,12 @@ begin
|
|||||||
if cfg.FuncDeclPostfix<>'' then wr.W('; '+cfg.FuncDeclPostfix);
|
if cfg.FuncDeclPostfix<>'' then wr.W('; '+cfg.FuncDeclPostfix);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function isDeclExternal(cfg: TConvertSettings; DeclType: TEntity; isFunc: Boolean): Boolean;
|
||||||
|
begin
|
||||||
|
Result:=(isfunc and cfg.FuncsAreExternal) or
|
||||||
|
(Assigned(DeclType) and (DeclType.Specifiers.IndexOf('extern')>=0));
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCodeConvertor.WriteFuncOrVar(cent: TVarFuncEntity; StartVar, WriteComment: Boolean);
|
procedure TCodeConvertor.WriteFuncOrVar(cent: TVarFuncEntity; StartVar, WriteComment: Boolean);
|
||||||
var
|
var
|
||||||
i, j : integer;
|
i, j : integer;
|
||||||
@ -770,6 +776,7 @@ var
|
|||||||
id : AnsiString;
|
id : AnsiString;
|
||||||
ref : TNamePart;
|
ref : TNamePart;
|
||||||
rt : AnsiString;
|
rt : AnsiString;
|
||||||
|
isfunc : Boolean;
|
||||||
begin
|
begin
|
||||||
for j := 0 to cent.Names.Count - 1 do
|
for j := 0 to cent.Names.Count - 1 do
|
||||||
begin
|
begin
|
||||||
@ -778,6 +785,7 @@ begin
|
|||||||
wr.Wln(' bad declaration synax!');
|
wr.Wln(' bad declaration synax!');
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
|
isfunc:=False;
|
||||||
id:=cfg.GetUniqueName(name.Id);
|
id:=cfg.GetUniqueName(name.Id);
|
||||||
n:=name.owner;
|
n:=name.owner;
|
||||||
if not Assigned(n) then begin
|
if not Assigned(n) then begin
|
||||||
@ -790,7 +798,7 @@ begin
|
|||||||
SetPasSection(wr, '');
|
SetPasSection(wr, '');
|
||||||
rt:=GetPasTypeName(cent.RetType, n.owner);
|
rt:=GetPasTypeName(cent.RetType, n.owner);
|
||||||
WriteFuncDecl(id, rt, n.params);
|
WriteFuncDecl(id, rt, n.params);
|
||||||
if cfg.FuncsAreExternal then wr.W('; external');
|
isfunc:=True;
|
||||||
end else if (n.Kind=nk_Ref) then begin
|
end else if (n.Kind=nk_Ref) then begin
|
||||||
if StartVar then SetPasSection(wr, 'var');
|
if StartVar then SetPasSection(wr, 'var');
|
||||||
wr.W(id + ' : ');
|
wr.W(id + ' : ');
|
||||||
@ -820,8 +828,8 @@ begin
|
|||||||
wr.W(GetPasTypeName(cent.RetType, n.owner));
|
wr.W(GetPasTypeName(cent.RetType, n.owner));
|
||||||
end;
|
end;
|
||||||
wr.W(';');
|
wr.W(';');
|
||||||
|
if isDeclExternal(cfg, cent.RetType, isfunc) then wr.W(' external;');
|
||||||
if WriteComment then WriteLnCommentForOffset(cent.Offset)
|
if WriteComment then WriteLnCommentForOffset(cent.Offset);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user