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:
skalogryz
2010-08-12 12:00:21 +00:00
parent 5f20a3f950
commit fc28fcccd9
3 changed files with 50 additions and 11 deletions

View File

@ -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;

View File

@ -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

View File

@ -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;