From fc28fcccd9db0a7590206f2af88f38de6731dc61 Mon Sep 17 00:00:00 2001
From: skalogryz <skalogryz@8e941d3f-bd1b-0410-a28a-d453659cc2b4>
Date: Thu, 12 Aug 2010 12:00:21 +0000
Subject: [PATCH] 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
---
 components/chelper/cparsertypes.pas  | 42 ++++++++++++++++++++++++----
 components/chelper/cparserutils.pas  |  1 -
 components/chelper/ctopasconvert.pas | 18 ++++++++----
 3 files changed, 50 insertions(+), 11 deletions(-)

diff --git a/components/chelper/cparsertypes.pas b/components/chelper/cparsertypes.pas
index 0aa883856..e89deada5 100755
--- a/components/chelper/cparsertypes.pas
+++ b/components/chelper/cparsertypes.pas
@@ -323,7 +323,6 @@ type
   protected
     function DoParse(AParser:TTextParser): Boolean; override;
   public
-    Specifiers  : TStringList;
     RetType     : TEntity;
     Names       : TList;
     constructor Create(AOffset: Integer=-1); override;
@@ -1419,6 +1418,32 @@ begin
     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);
 begin
   while isSomeSpecifier(AParser.Token) do begin
@@ -1676,12 +1701,21 @@ end;
 function ParseNames(Parser: TTextParser; var NameType: TEntity; Names: TList; AllowMultipleNames: Boolean): Boolean;
 var
   Name  : TNamePart;
-  done   : Boolean;
-  specs  : TStringList;
+  done  : Boolean;
+  specs : TStringList;
+  s     : AnsiString;
 begin
   specs:=TStringList.Create;
+
   ParseSepcifiers(Parser, specs);
   NameType:=ParseCType(Parser);
+
+  s:=isCallConv(Parser.Token);
+  if s<>'' then begin
+    specs.Add(s);
+    Parser.NextToken;
+  end;
+
   Result:=Assigned(NameType);
   if Result then NameType.Specifiers.Assign(specs);
   specs.Free;
@@ -1761,13 +1795,11 @@ end;
 constructor TVarFuncEntity.Create(AOffset: Integer);
 begin
   inherited Create(AOffset);
-  Specifiers:=TStringList.Create;
   Names:=TList.Create;
 end;
 
 destructor TVarFuncEntity.Destroy;
 begin
-  Specifiers.Free;
   inherited Destroy;
 end;
 
diff --git a/components/chelper/cparserutils.pas b/components/chelper/cparserutils.pas
index 202bba0fc..aea4fa5cf 100644
--- a/components/chelper/cparserutils.pas
+++ b/components/chelper/cparserutils.pas
@@ -26,7 +26,6 @@ uses
 // is function declared, i.e. int f()
 function isFunc(name: TNamePart): Boolean;
 
-
 // probably an untyped function: fn ().
 // the name of the function has been consumed by TYPE parsing, so ommited!
 // so TNamepart doesn't contain any children
diff --git a/components/chelper/ctopasconvert.pas b/components/chelper/ctopasconvert.pas
index beeb18073..0650a9372 100644
--- a/components/chelper/ctopasconvert.pas
+++ b/components/chelper/ctopasconvert.pas
@@ -129,7 +129,7 @@ type
     function NextCommentBefore(AOffset: Integer): 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 WriteTypeDef(tp: TTypeDef);
     procedure WriteEnum(en: TEnumType);
@@ -725,7 +725,7 @@ begin
             (params[0].name=nil);
 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
   i        : Integer;
   ptypes   : array of String;
@@ -762,6 +762,12 @@ begin
   if cfg.FuncDeclPostfix<>'' then wr.W('; '+cfg.FuncDeclPostfix);
 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);
 var
   i, j  : integer;
@@ -770,6 +776,7 @@ var
   id    : AnsiString;
   ref   : TNamePart;
   rt    : AnsiString;
+  isfunc  : Boolean;
 begin
   for j := 0 to cent.Names.Count - 1 do
   begin
@@ -778,6 +785,7 @@ begin
       wr.Wln(' bad declaration synax!');
       Exit;
     end;
+    isfunc:=False;
     id:=cfg.GetUniqueName(name.Id);
     n:=name.owner;
     if not Assigned(n) then begin
@@ -790,7 +798,7 @@ begin
       SetPasSection(wr, '');
       rt:=GetPasTypeName(cent.RetType, n.owner);
       WriteFuncDecl(id, rt, n.params);
-      if cfg.FuncsAreExternal then wr.W('; external');
+      isfunc:=True;
     end else if (n.Kind=nk_Ref) then begin
       if StartVar then SetPasSection(wr, 'var');
       wr.W(id + ' : ');
@@ -820,8 +828,8 @@ begin
       wr.W(GetPasTypeName(cent.RetType, n.owner));
     end;
     wr.W(';');
-
-    if WriteComment then WriteLnCommentForOffset(cent.Offset)
+    if isDeclExternal(cfg, cent.RetType, isfunc) then wr.W(' external;');
+    if WriteComment then WriteLnCommentForOffset(cent.Offset);
   end;
 end;