{
 ***************************************************************************
 *                                                                         *
 *   This source is free software; you can redistribute it and/or modify   *
 *   it under the terms of the GNU General Public License as published by  *
 *   the Free Software Foundation; either version 2 of the License, or     *
 *   (at your option) any later version.                                   *
 *                                                                         *
 *   This code is distributed in the hope that it will be useful, but      *
 *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 *   General Public License for more details.                              *
 *                                                                         *
 *   A copy of the GNU General Public License is available on the World    *
 *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 *   obtain it by writing to the Free Software Foundation,                 *
 *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
 *                                                                         *
 ***************************************************************************

  Author: Mattias Gaertner

  Abstract:
    A tool to help converting C header files to pascal bindings.
    
    enum     ->  enum
    int i;   ->  var i: integer;
    const char a; -> const a: char;
    struct   ->  var plus record
    union    ->  var plus record case
    typedef  ->  type
    void func()  -> procedure
    int func()   -> function
    #define name value  ->  alias  (const, var, type, proc)
}
unit H2PasTool;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, contnrs, AVL_Tree,
  FileProcs, BasicCodeTools, CCodeParserTool, NonPascalCodeTools,
  KeywordFuncLists, CodeCache, CodeTree, CodeAtom;
  
const
  DefaultMaxPascalIdentLen = 70;

type

  { TH2PNode }

  TH2PNode = class
  public
    PascalName: string;
    CName: string;
    CNode: TCodeTreeNode;
    PascalDesc: TCodeTreeNodeDesc;
    PascalCode: string;
    NormalizedPascalCode: string;
    Parent, FirstChild, LastChild, NextBrother, PriorBrother: TH2PNode;
    function Next: TH2PNode;
    function NextSkipChilds: TH2PNode;
    function Prior: TH2PNode;
    function HasAsParent(Node: TH2PNode): boolean;
    function HasAsChild(Node: TH2PNode): boolean;
    function GetLevel: integer;
    function DescAsString: string;
    procedure ConsistencyCheck;
    procedure WriteDebugReport(const Prefix: string; WithChilds: boolean);
  end;
  
  { TH2PTree }

  TH2PTree = class
  private
    FNodeCount: integer;
  public
    Root: TH2PNode;
    LastRoot: TH2PNode;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    property NodeCount: integer read FNodeCount;
    procedure DeleteNode(ANode: TH2PNode);
    procedure AddNodeAsLastChild(ParentNode, ANode: TH2PNode);
    procedure AddNodeInFrontOf(NextBrotherNode, ANode: TH2PNode);
    function ContainsNode(ANode: TH2PNode): boolean;
    procedure ConsistencyCheck;
    procedure WriteDebugReport(WithChilds: boolean);
  end;
  
  { TH2PasTool }

  TH2PasTool = class
  private
    FPredefinedCTypes: TFPStringHashTable;
    FPascalNames: TAVLTree;// tree of TH2PNode sorted for PascalName
    FCNames: TAVLTree;// tree of TH2PNode sorted for CName
  public
    Tree: TH2PTree;
    CTool: TCCodeParserTool;
    function Convert(CCode, PascalCode: TCodeBuffer): boolean;
    procedure BuildH2PTree(ParentNode: TH2PNode = nil; StartNode: TCodeTreeNode = nil);
    
    function GetSimplePascalTypeOfCVar(CVarNode: TCodeTreeNode): string;
    function GetSimplePascalTypeOfCParameter(CParamNode: TCodeTreeNode): string;
    function GetSimplePascalResultTypeOfCFunction(CFuncNode: TCodeTreeNode): string;
    function ConvertSimpleCTypeToPascalType(CType: string;
                  UseSingleIdentifierAsDefault: boolean): string;
    
    function CreateH2PNode(const PascalName, CName: string; CNode: TCodeTreeNode;
       PascalDesc: TCodeTreeNodeDesc; const PascalCode: string;
       ParentNode: TH2PNode = nil; IsGlobal: boolean = true): TH2PNode;
    function CreateAutoGeneratedH2PNode(var PascalName: string; CNode: TCodeTreeNode;
       PascalDesc: TCodeTreeNodeDesc; const PascalCode: string;
       ParentNode: TH2PNode = nil; IsGlobal: boolean = true): TH2PNode;
    function GetH2PNodeForComplexType(CNode: TCodeTreeNode;
                               CreateIfNotExists: boolean = true): TH2PNode;
    function CreatePascalNameFromCCode(const CCode: string;
                                       StartPos: integer = 1;
                                       EndPos: integer = -1): string;
    function FindH2PNodeWithPascalName(const PascalName: string): TH2PNode;

    procedure WriteDebugReport;
    procedure WriteH2PNodeReport;
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    property PredefinedCTypes: TFPStringHashTable read FPredefinedCTypes;
  end;
  
  
function DefaultPredefinedCTypes: TFPStringHashTable;// types in unit ctypes

function CompareH2PNodePascalNames(Data1, Data2: Pointer): integer;
function CompareStringWithH2PNodePascalName(AString, ANode: Pointer): integer;
function CompareH2PNodeCNames(Data1, Data2: Pointer): integer;

implementation

var
  InternalPredefinedCTypes: TFPStringHashTable = nil;// types in unit ctypes

function DefaultPredefinedCTypes: TFPStringHashTable;
begin
  if InternalPredefinedCTypes=nil then begin
    InternalPredefinedCTypes:=TFPStringHashTable.Create;
    with InternalPredefinedCTypes do begin
      // int
      Add('int','cint');
      Add('int*','pcint');
      Add('signed int','csint');
      Add('signed int*','pcsint');
      Add('unsigned int','cuint');
      Add('unsigned int*','pcuint');
      // short
      Add('short','cshort');
      Add('short*','pcshort');
      Add('signed short','csshort');
      Add('signed short*','pcsshort');
      Add('unsigned short','csshort');
      Add('unsigned short*','pcsshort');
      Add('short int','cshort');
      Add('short int*','pcshort');
      Add('signed short int','csshort');
      Add('signed short int*','pcsshort');
      Add('short signed int','csshort');
      Add('short signed int*','pcsshort');
      Add('short unsigned int','csshort');
      Add('short unsigned int*','pcsshort');
      // int8
      Add('int8','cint8');
      Add('int8*','pcint8');
      Add('unsigned int8','cuint8');
      Add('unsigned int8*','pcuint8');
      // int16
      Add('int16','cint16');
      Add('int16*','pcint16');
      Add('unsigned int16','cuint16');
      Add('unsigned int16*','pcuint16');
      // int32
      Add('int32','cint32');
      Add('int32*','pcint32');
      Add('unsigned int32','cuint32');
      Add('unsigned int32*','pcuint32');
      // int64
      Add('int64','cint64');
      Add('int64*','pcint64');
      Add('unsigned int64','cuint64');
      Add('unsigned int64*','pcuint64');
      // long
      Add('long','clong');
      Add('long*','pclong');
      Add('signed long','cslong');
      Add('signed long*','pcslong');
      Add('unsigned long','culong');
      Add('unsigned long*','pculong');
      Add('long int','clong');
      Add('long int*','pclong');
      Add('signed long int','cslong');
      Add('signed long int*','pcslong');
      Add('long signed int','cslong');
      Add('long signed int*','pcslong');
      Add('unsigned long int','culong');
      Add('unsigned long int*','pculong');
      Add('long unsigned int','culong');
      Add('long unsigned int*','pculong');
      // long long
      Add('long long','clonglong');
      Add('long long*','pclonglong');
      Add('signed long long','cslonglong');
      Add('signed long long*','pcslonglong');
      Add('unsigned long long','culonglong');
      Add('unsigned long long*','pculonglong');
      // bool
      Add('bool','cbool');
      Add('bool*','pcbool');
      // char
      Add('char','cchar');
      Add('char*','pcchar');
      Add('signed char','cschar');
      Add('signed char*','pcschar');
      Add('unsigned char','cuchar');
      Add('unsigned char*','pcuchar');
      // float
      Add('float','cfloat');
      Add('float*','pcfloat');
      // double
      Add('double','cdouble');
      Add('double*','pcdouble');
      Add('long double','clongdouble');
      Add('long double*','pclongdouble');
      // void
      Add('void*','pointer');
    end;
  end;
  Result:=InternalPredefinedCTypes;
end;

function CompareH2PNodePascalNames(Data1, Data2: Pointer): integer;
begin
  Result:=CompareIdentifierPtrs(Pointer(TH2PNode(Data1).PascalName),
                                Pointer(TH2PNode(Data2).PascalName));
end;

function CompareStringWithH2PNodePascalName(AString, ANode: Pointer): integer;
begin
  Result:=CompareIdentifierPtrs(Pointer(AString),
                                Pointer(TH2PNode(ANode).PascalName));
end;

function CompareH2PNodeCNames(Data1, Data2: Pointer): integer;
begin
  Result:=CompareIdentifiersCaseSensitive(PChar(Pointer(TH2PNode(Data1).CName)),
                                          PChar(Pointer(TH2PNode(Data2).CName)));
end;

{ TH2PasTool }

function TH2PasTool.Convert(CCode, PascalCode: TCodeBuffer): boolean;
begin
  Result:=false;

  if CTool=nil then
    CTool:=TCCodeParserTool.Create;
  // pare C header file
  CTool.Parse(CCode);
  //CTool.WriteDebugReport;

  BuildH2PTree;

  Result:=true;
end;

procedure TH2PasTool.BuildH2PTree(ParentNode: TH2PNode;
  StartNode: TCodeTreeNode);
var
  CNode: TCodeTreeNode;
  CurName: String;
  CurType: String;
  SimpleType: String;
  H2PNode: TH2PNode;
  NextCNode: TCodeTreeNode;
  TypeH2PNode: TH2PNode;
  CurValue: String;
  StatementNode: TCodeTreeNode;
  Ok: Boolean;
  IsPointerToFunction: Boolean;
  ChildNode: TCodeTreeNode;
begin
  //DebugLn(['TH2PasTool.BuildH2PTree ParentNode=',ParentNode.DescAsString]);
  if ParentNode<>nil then begin
    if StartNode=nil then
      StartNode:=ParentNode.CNode.FirstChild;
  end else begin
    Tree.Clear;
    if StartNode=nil then
      StartNode:=CTool.Tree.Root;
  end;
  CNode:=StartNode;
  while CNode<>nil do begin
    //DebugLn(['TH2PasTool.BuildH2PTree Current ParentNode=',ParentNode.DescAsString,' CNode=',CCNodeDescAsString(CNode.Desc)]);
    NextCNode:=CNode.NextSkipChilds;
    case CNode.Desc of
    ccnRoot, ccnExtern:
      NextCNode:=CNode.Next;
      
    ccnDirective:
      NextCNode:=CNode.Next;
      
    ccnTypedef:
      if CNode.FirstChild<>nil then begin
        CurName:=CTool.ExtractTypedefName(CNode);
        DebugLn(['TH2PasTool.BuildH2PTree Typedef name="',CurName,'"']);
        ChildNode:=CNode.FirstChild;
        case ChildNode.Desc of
        
        ccnStruct: // typedef struct
          begin
            ChildNode:=CNode.FirstChild.FirstChild;
            if (ChildNode<>nil)
            and (ChildNode.Desc=ccnStructAlias) then begin
              // this is a struct alias
              CurType:=GetIdentifier(@CTool.Src[ChildNode.StartPos]);
              TypeH2PNode:=CreateH2PNode(CurName,CurName,CNode,
                                         ctnTypeDefinition,CurType);
            end else begin
              // this is a new struct
              TypeH2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnRecordType,'');
              DebugLn(['TH2PasTool.BuildH2PTree added record: ',TypeH2PNode.DescAsString]);
              // build recursively
              if ChildNode<>nil then
                BuildH2PTree(TypeH2PNode,ChildNode);
            end;
          end;
          
        ccnFunction: // typedef function
          begin
            CurName:=CTool.ExtractFunctionName(ChildNode);
            CurType:=CTool.ExtractFunctionResultType(ChildNode,false,false);
            IsPointerToFunction:=CTool.IsPointerToFunction(ChildNode);
            SimpleType:=GetSimplePascalResultTypeOfCFunction(ChildNode);
            if IsPointerToFunction and (SimpleType='') then begin
              // this function has a complex result type
              TypeH2PNode:=GetH2PNodeForComplexType(ChildNode);
              if TypeH2PNode<>nil then
                SimpleType:=TypeH2PNode.PascalName;
            end;
            if IsPointerToFunction and (SimpleType<>'') then begin
              H2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnProcedureType,SimpleType,
                                     nil,true);
              DebugLn(['TH2PasTool.BuildH2PTree function type added: ',H2PNode.DescAsString]);
              // build recursively
              if ChildNode.FirstChild<>nil then
                BuildH2PTree(H2PNode,ChildNode.FirstChild);
            end else begin
              DebugLn(['TH2PasTool.BuildH2PTree typdef function CurName=',CurName,' CurType=',CTool.ExtractFunctionResultType(ChildNode),' SimpleType=',SimpleType]);
              DebugLn(['TH2PasTool.BuildH2PTree SKIPPING typedef ',CCNodeDescAsString(ChildNode.Desc),' at ',CTool.CleanPosToStr(CNode.StartPos)]);
            end;
          end;
          
        else // typedef
          DebugLn(['TH2PasTool.BuildH2PTree SKIPPING typedef ',CCNodeDescAsString(CNode.FirstChild.Desc),' at ',CTool.CleanPosToStr(CNode.StartPos)]);
        end;
      end;
      
    ccnVariable:
      if (CNode.FirstChild<>nil) and (CNode.FirstChild.Desc=ccnUnion)
      then begin
        CurName:=CTool.ExtractVariableName(CNode);
        if (ParentNode<>nil) and (ParentNode.PascalDesc=ctnRecordType)
        then begin
          // create a pascal 'record case'
          TypeH2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnRecordCase,'',
                                     ParentNode,false);
          DebugLn(['TH2PasTool.BuildH2PTree added record case for nested union']);
          // build recursively the record cases
          if CNode.FirstChild.FirstChild<>nil then
            BuildH2PTree(TypeH2PNode,CNode.FirstChild.FirstChild);
        end else if (CurName<>'') and (ParentNode=nil) then begin
          // this union has a name
          // create a record type
          TypeH2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnRecordCase,'',
                                     nil,true);
          DebugLn(['TH2PasTool.BuildH2PTree added record type for union: ',TypeH2PNode.DescAsString]);
          // build recursively
          if CNode.FirstChild.FirstChild<>nil then
            BuildH2PTree(TypeH2PNode,CNode.FirstChild.FirstChild);
          // create variable
          CurName:=CTool.ExtractUnionName(CNode);
          H2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnVarDefinition,
                                 TypeH2PNode.PascalName,
                                 nil,ParentNode=nil);
          DebugLn(['TH2PasTool.BuildH2PTree added variable for union: ',H2PNode.DescAsString]);
        end else begin
          DebugLn(['TH2PasTool.BuildH2PTree SKIPPING union variable at ',CTool.CleanPosToStr(CNode.StartPos)]);
        end;
      end else begin
        CurName:=CTool.ExtractVariableName(CNode);
        CurType:=CTool.ExtractVariableType(CNode);
        SimpleType:=GetSimplePascalTypeOfCVar(CNode);
        if SimpleType='' then begin
          // this variable has a complex type
          TypeH2PNode:=GetH2PNodeForComplexType(CNode);
          if TypeH2PNode<>nil then
            SimpleType:=TypeH2PNode.PascalName;
        end;
        if SimpleType<>'' then begin
          H2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnVarDefinition,SimpleType,
                                 ParentNode,ParentNode=nil);
          DebugLn(['TH2PasTool.BuildH2PTree added: ',H2PNode.DescAsString]);
        end else begin
          DebugLn(['TH2PasTool.BuildH2PTree SKIPPING Variable Name="',CurName,'" Type="',CurType,'"']);
        end;
      end;
      
    ccnFunction:
      begin
        CurName:=CTool.ExtractFunctionName(CNode);
        CurType:=CTool.ExtractFunctionResultType(CNode);
        SimpleType:=GetSimplePascalResultTypeOfCFunction(CNode);
        IsPointerToFunction:=CTool.IsPointerToFunction(CNode);
        StatementNode:=nil;
        Ok:=true;
        if (CNode.LastChild<>nil) and (CNode.LastChild.Desc=ccnStatementBlock) then
          StatementNode:=CNode.LastChild;
        DebugLn(['TH2PasTool.BuildH2PTree Function Name="',CurName,'" ResultType="',CurType,'" SimpleType=',SimpleType,' HasStatements=',StatementNode<>nil,' IsPointer=',IsPointerToFunction]);
        if StatementNode<>nil then begin
          // this function has a body
          Ok:=false;
        end;
        if Ok and (SimpleType='') then begin
          // this function has a complex result type
          TypeH2PNode:=GetH2PNodeForComplexType(CNode);
          if TypeH2PNode<>nil then begin
            SimpleType:=TypeH2PNode.PascalName;
          end else
            Ok:=false;
        end;
        
        if Ok then begin
          H2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnProcedure,SimpleType,
                                 nil,false);
          DebugLn(['TH2PasTool.BuildH2PTree function added: ',H2PNode.DescAsString]);
          // build recursively
          BuildH2PTree(H2PNode);
        end else begin
          DebugLn(['TH2PasTool.BuildH2PTree SKIPPING Function Name="',CurName,'" Type="',CurType,'" at ',CTool.CleanPosToStr(CNode.StartPos)]);
        end;
      end;
      
    ccnFuncParamList:
      NextCNode:=CNode.FirstChild;
      
    ccnFuncParameter:
      begin
        CurName:=CTool.ExtractParameterName(CNode);
        CurType:=CTool.ExtractParameterType(CNode);
        SimpleType:=GetSimplePascalTypeOfCParameter(CNode);
        DebugLn(['TH2PasTool.BuildH2PTree Parameter: Name="',CurName,'" Type="',CurType,'" SimpleType="',SimpleType,'"']);
        if SimpleType='' then begin
          // this variable has a complex type
          TypeH2PNode:=GetH2PNodeForComplexType(CNode);
          if TypeH2PNode<>nil then
            SimpleType:=TypeH2PNode.PascalName;
        end;
        if SimpleType<>'' then begin
          H2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnVarDefinition,SimpleType,
                                 ParentNode,false);
          DebugLn(['TH2PasTool.BuildH2PTree added: ',H2PNode.DescAsString]);
        end else begin
          DebugLn(['TH2PasTool.BuildH2PTree SKIPPING parameter Name="',CurName,'" Type="',CurType,'" at ',CTool.CleanPosToStr(CNode.StartPos)]);
        end;
      end;
      
    ccnEnumBlock:
      begin
        CurName:=CTool.ExtractEnumBlockName(CNode);
        if CurName='' then begin
          // this is an anonymous enum block => auto generate a name
          CurName:=CreatePascalNameFromCCode(CTool.Src,CNode.StartPos,CNode.EndPos);
          TypeH2PNode:=CreateAutoGeneratedH2PNode(CurName,CNode,ctnEnumerationType,'',
                                                  nil,ParentNode=nil);
        end else begin
          // this enum block has a name
          TypeH2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnEnumerationType,'',
                                     nil,ParentNode=nil);
        end;
        DebugLn(['TH2PasTool.BuildH2PTree added: ',TypeH2PNode.DescAsString]);

        CNode:=CNode.FirstChild;
        while CNode<>nil do begin
          if CNode.Desc=ccnEnumID then begin
            CurName:=CTool.ExtractEnumIDName(CNode);
            CurValue:=CTool.ExtractEnumIDValue(CNode);
            H2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnEnumIdentifier,CurValue,
                                   TypeH2PNode,ParentNode=nil);
            DebugLn(['TH2PasTool.BuildH2PTree added: ',H2PNode.DescAsString]);
          end;
          CNode:=CNode.NextBrother;
        end;
      end;
      
    ccnStruct:
      begin
        CurName:=CTool.ExtractStructName(CNode);
        if CurName='' then begin
          // this is an anonymous struct -> ignore
          DebugLn(['TH2PasTool.BuildH2PTree SKIPPING anonymous struct at ',CTool.CleanPosToStr(CNode.StartPos)]);
        end else begin
          // this struct has a name
          // create a type
          TypeH2PNode:=CreateH2PNode(CurName,CurName,CNode,ctnRecordType,'',
                                     nil,ParentNode=nil);
          // build recursively
          BuildH2PTree(TypeH2PNode);
        end;
      end;

    ccnName: ;

    else
      DebugLn(['TH2PasTool.BuildH2PTree SKIPPING ',CCNodeDescAsString(CNode.Desc),' at ',CTool.CleanPosToStr(CNode.StartPos)]);
    end;
    // next C node
    if (ParentNode<>nil) and (not ParentNode.CNode.HasAsChild(NextCNode)) then
      NextCNode:=nil;
    CNode:=NextCNode;
  end;
end;

function TH2PasTool.GetSimplePascalTypeOfCVar(CVarNode: TCodeTreeNode): string;
begin
  Result:=CTool.ExtractVariableType(CVarNode);
  if Result='' then exit;
  Result:=ConvertSimpleCTypeToPascalType(Result,true);
end;

function TH2PasTool.GetSimplePascalTypeOfCParameter(CParamNode: TCodeTreeNode
  ): string;
begin
  Result:=CTool.ExtractParameterType(CParamNode);
  if Result='' then exit;
  if (Result='...') then
    Result:='array of const'
  else
    Result:=ConvertSimpleCTypeToPascalType(Result,true);
end;

function TH2PasTool.GetSimplePascalResultTypeOfCFunction(
  CFuncNode: TCodeTreeNode): string;
begin
  Result:=CTool.ExtractFunctionResultType(CFuncNode,false,false);
  if Result='' then exit;
  Result:=ConvertSimpleCTypeToPascalType(Result,true);
end;

function TH2PasTool.ConvertSimpleCTypeToPascalType(CType: string;
  UseSingleIdentifierAsDefault: boolean): string;
// the type must be normalized. That means no directives,
// no unneeded spaces, no tabs, no comments, no newlines.
var
  p: Integer;
  CurAtomStart: integer;
  
  function TestIsAtomAndRemove(const s: shortstring): boolean;
  begin
    if (p-CurAtomStart<>length(s))
    or (not CompareMem(@s[1],@CType[CurAtomStart],length(s))) then
      exit(false);
    Result:=true;
    // remove token
    if IsIdentStartChar[s[1]] then begin
      // token is a word => remove one space too
      if (CurAtomStart>1) and (CType[CurAtomStart-1]=' ') then
        dec(CurAtomStart)
      else if (p<=length(CType)) and (CType[p]=' ') then
        inc(p);
    end;
    // remove token
    CType:=copy(CType,1,CurAtomStart-1)+copy(CType,p,length(CType));
    p:=CurAtomStart;
    //DebugLn(['TH2PasTool.ConvertSimpleCTypeToPascalType CType="',CType,'"']);
  end;
  
begin
  // remove 'const' and 'struct'
  p:=1;
  repeat
    ReadRawNextCAtom(CType,p,CurAtomStart);
    if CurAtomStart>length(CType) then break;
    //DebugLn(['TH2PasTool.ConvertSimpleCTypeToPascalType Atom=',copy(CType,CurAtomStart,p-CurAtomStart)]);
    if (not TestIsAtomAndRemove('const'))
    and (not TestIsAtomAndRemove('struct')) then ;
  until false;
  // seach in predefined ctypes
  Result:=PredefinedCTypes[CType];
  
  if (Result='') and (UseSingleIdentifierAsDefault) and IsValidIdent(CType) then
    Result:=CType;
end;

function TH2PasTool.CreateH2PNode(const PascalName, CName: string;
  CNode: TCodeTreeNode; PascalDesc: TCodeTreeNodeDesc;
  const PascalCode: string;
  ParentNode: TH2PNode; IsGlobal: boolean): TH2PNode;
begin
  Result:=TH2PNode.Create;
  Result.PascalName:=PascalName;
  Result.CName:=CName;
  Result.CNode:=CNode;
  Result.PascalDesc:=PascalDesc;
  Result.PascalCode:=PascalCode;
  Tree.AddNodeAsLastChild(ParentNode,Result);
  if IsGlobal then begin
    FPascalNames.Add(Result);
    FCNames.Add(Result);
  end;
end;

function TH2PasTool.CreateAutoGeneratedH2PNode(var PascalName: string;
  CNode: TCodeTreeNode; PascalDesc: TCodeTreeNodeDesc;
  const PascalCode: string;
  ParentNode: TH2PNode;
  IsGlobal: boolean): TH2PNode;
  
  function Check(const TestName: string; out Node: TH2PNode): boolean;
  begin
    Node:=FindH2PNodeWithPascalName(TestName);
    if (Node=nil) then begin
      Node:=CreateH2PNode(TestName,'',CNode,PascalDesc,PascalCode);
      Result:=true;
    end else if ((Node.CNode=CNode) and (Node.PascalDesc=PascalDesc)
      and (Node.PascalCode=PascalCode)
      and (Node.Parent=ParentNode))
    then begin
      Result:=true;
    end else begin
      Result:=false;
      Node:=nil;
    end;
  end;
  
var
  i: Integer;
begin
  Result:=nil;
  if Check(PascalName,Result) then exit;
  i:=1;
  while not Check(PascalName+'_'+IntToStr(i),Result) do
    inc(i);
end;

function TH2PasTool.GetH2PNodeForComplexType(CNode: TCodeTreeNode;
  CreateIfNotExists: boolean): TH2PNode;
var
  CCode: String;
  PascalName: String;
  AtomStart: integer;
  p: Integer;
  CurAtom: String;
  BaseCType: String;
  BasePascalType: String;
  NewBasePascalType: String;
  SubH2PNode: TH2PNode;
  PascalCode: String;
  ConstantStartPos: LongInt;
  ConstantEndPos: LongInt;
  ConstantCode: String;
  ConstantNumber: int64;
  BracketOpenPos: LongInt;
  NeedH2PNode: Boolean;
begin
  Result:=nil;
  if (CNode.Desc=ccnVariable)
  and (CNode.FirstChild<>nil)
  and (CNode.FirstChild.Desc=ccnUnion) then begin
    // ToDo: union
  end else begin
    SubH2PNode:=nil;
    if CNode.Desc=ccnVariable then
      CCode:=CTool.ExtractVariableType(CNode)
    else if CNode.Desc=ccnFunction then
      CCode:=CTool.ExtractFunctionResultType(CNode)
    else if CNode.Desc=ccnFuncParameter then
      CCode:=CTool.ExtractParameterType(CNode)
    else
      exit;
      
    DebugLn(['TH2PasTool.GetH2PNodeForComplexType CCode="',CCode,'"']);
    { int[][3]  -> array of array[0..2] of cint
      char**    -> PPchar
      int *[15] -> array[0..14] of pcint
      
    }
    // read identifiers
    p:=1;
    BaseCType:='';
    repeat
      ReadRawNextCAtom(CCode,p,AtomStart);
      if AtomStart>length(CCode) then break;
      if IsIdentStartChar[CCode[AtomStart]] then begin
        CurAtom:=copy(CCode,AtomStart,p-AtomStart);
        if BaseCType<>'' then
          BaseCType:=BaseCType+' ';
        BaseCType:=BaseCType+CurAtom;
      end else
        break;
    until false;
    if BaseCType='' then begin
      DebugLn(['TH2PasTool.GetH2PNodeForComplexType no base type in c declaration: CCode="',dbgstr(CCode),'"']);
      exit;
    end;
    BasePascalType:=ConvertSimpleCTypeToPascalType(BaseCType,true);
    if (BasePascalType='') then begin
      DebugLn(['TH2PasTool.GetH2PNodeForComplexType unknown c type: "',BaseCType,'"']);
      exit;
    end;
    DebugLn(['TH2PasTool.GetH2PNodeForComplexType BasePascalType="',BasePascalType,'" BaseCType="',BaseCType,'"']);
    
    // read pointer(s)
    while (AtomStart<=length(CCode)) do begin
      CurAtom:=copy(CCode,AtomStart,p-AtomStart);
      if (CurAtom='*') then begin
        BaseCType:=BaseCType+'*';
        NewBasePascalType:=ConvertSimpleCTypeToPascalType(BaseCType,true);
        if NewBasePascalType<>'' then begin
          // for this pointer type exists already a predefined simple type
        end else begin
          // a new pointer type is needed
          NewBasePascalType:='P'+BasePascalType;
          SubH2PNode:=CreateAutoGeneratedH2PNode(NewBasePascalType,nil,
                                    ctnTypeDefinition,'^'+BasePascalType);
          DebugLn(['TH2PasTool.GetH2PNodeForComplexType added new pointer type: ',SubH2PNode.DescAsString]);
          NewBasePascalType:=SubH2PNode.PascalName;
        end;
        BasePascalType:=NewBasePascalType;
        DebugLn(['TH2PasTool.GetH2PNodeForComplexType using pointer type: BasePascalType="',BasePascalType,'" BaseCType="',BaseCType,'"']);
      end else if (CurAtom='const') then begin
        // skip 'const'
      end else begin
        break;
      end;
      ReadRawNextCAtom(CCode,p,AtomStart);
    end;
    
    PascalName:=BasePascalType;
    PascalCode:=PascalName;
    
    // read arrays
    NeedH2PNode:=false;
    while (AtomStart<=length(CCode)) do begin
      CurAtom:=copy(CCode,AtomStart,p-AtomStart);
      if CurAtom='[' then begin
        NeedH2PNode:=true;
        BracketOpenPos:=AtomStart;
        ReadRawNextCAtom(CCode,p,AtomStart);
        if AtomStart>length(CCode) then begin
          DebugLn(['TH2PasTool.GetH2PNodeForComplexType untranslatable (missing ]): CCode="',dbgstr(CCode),'"']);
          exit;
        end;
        CurAtom:=copy(CCode,AtomStart,p-AtomStart);
        if CurAtom=']' then begin
          // [] -> open array
          PascalCode:='array of '+PascalCode;
          PascalName:='ArrayOf'+PascalName;
          //DebugLn(['TH2PasTool.GetTypeForVarType open array: ',PascalCode]);
        end else begin
          // [constant] -> array[0..constant-1]
          ConstantStartPos:=AtomStart;
          p:=BracketOpenPos;
          ReadTilCBracketClose(CCode,p);
          ConstantEndPos:=p-1;
          ConstantCode:=copy(CCode,ConstantStartPos,ConstantEndPos-ConstantStartPos);
          //DebugLn(['TH2PasTool.GetTypeForVarType ConstantCode="',ConstantCode,'"']);
          if CConstantToInt64(ConstantCode,ConstantNumber) then begin
            if ConstantNumber>0 then
              dec(ConstantNumber)
            else
              ConstantNumber:=0;
            ConstantCode:=IntToStr(ConstantNumber);
          end else begin
            ConstantCode:=ConstantCode+'-1';
          end;
          PascalCode:='array[0..'+ConstantCode+'] of '+PascalCode;
          PascalName:='Array0to'+CreatePascalNameFromCCode(ConstantCode)+'Of'+PascalName;
          //DebugLn(['TH2PasTool.GetTypeForVarType fixed array: ',PascalCode]);
        end;
      end else
        break;
      ReadRawNextCAtom(CCode,p,AtomStart);
    end;
    if NeedH2PNode then begin
      PascalName:='T'+PascalName;
      PascalName:=copy(PascalName,1,DefaultMaxPascalIdentLen);
      SubH2PNode:=CreateAutoGeneratedH2PNode(PascalName,nil,ctnTypeDefinition,PascalCode);
    end;
    
    // check if the whole declaration was translated
    if AtomStart<=length(CCode) then begin
      // unknown C type
      DebugLn(['TH2PasTool.GetTypeForVarType untranslatable: CCode="',dbgstr(CCode),'"']);
      exit;
    end;
    
    DebugLn(['TH2PasTool.GetTypeForVarType CCode="',dbgstr(CCode),'" PascalName="',PascalName,'"']);
    Result:=SubH2PNode;
  end;
end;

function TH2PasTool.CreatePascalNameFromCCode(const CCode: string;
  StartPos: integer; EndPos: integer): string;

  function Add(var PascalName: string; const Addition: string): boolean;
  begin
    if Addition='' then exit(true);
    if length(PascalName)+length(Addition)>DefaultMaxPascalIdentLen then
      exit(false);
    PascalName:=PascalName+Addition;
  end;
  
var
  p: Integer;
  AtomStart: integer;
  i: LongInt;
  c: Char;
  CurAtom: String;
begin
  Result:='';
  if EndPos<1 then
    EndPos:=length(CCode)+1;
  p:=StartPos;
  if EndPos>length(CCode) then
    EndPos:=length(CCode);
  repeat
    ReadRawNextCAtom(CCode,p,AtomStart);
    if AtomStart>EndPos then exit;
    
    if IsIdentStartChar[CCode[AtomStart]] then begin
      CurAtom:=copy(CCode,AtomStart,p-AtomStart);
      if (CurAtom<>'const')
      and (CurAtom<>'struct')
      and not Add(Result,CurAtom) then
        exit;
    end else begin
      if CCode[AtomStart] in ['0'..'9'] then begin
        CurAtom:=copy(CCode,AtomStart,p-AtomStart);
        for i:=AtomStart to p-1 do begin
          c:=CCode[i];
          if not IsIdentChar[c] then
            c:='_';
          if not Add(Result,c) then exit;
        end;
      end;
    end;
  until false;
end;

function TH2PasTool.FindH2PNodeWithPascalName(const PascalName: string
  ): TH2PNode;
var
  AVLNode: TAVLTreeNode;
begin
  AVLNode:=FPascalNames.FindKey(Pointer(PascalName),
                                @CompareStringWithH2PNodePascalName);
  if AVLNode<>nil then
    Result:=TH2PNode(AVLNode.Data)
  else
    Result:=nil;
end;

procedure TH2PasTool.WriteDebugReport;
begin
  DebugLn(['TH2PasTool.WriteDebugReport ']);
  if CTool<>nil then
    CTool.WriteDebugReport;
  WriteH2PNodeReport;
end;

procedure TH2PasTool.WriteH2PNodeReport;
var
  Node: TH2PNode;
begin
  if (Tree=nil) then begin
    DebugLn(['TH2PasTool.WriteH2PNodeReport Tree=nil']);
  end else if (Tree.Root=nil) then begin
    DebugLn(['TH2PasTool.WriteH2PNodeReport Tree.Root=nil']);
  end else begin
    Node:=Tree.Root;
    while Node<>nil do begin
      DebugLn([GetIndentStr(Node.GetLevel*2),Node.DescAsString]);
      Node:=Node.Next;
    end;
  end;
end;

constructor TH2PasTool.Create;
begin
  FPredefinedCTypes:=DefaultPredefinedCTypes;
  Tree:=TH2PTree.Create;
  FPascalNames:=TAVLTree.Create(@CompareH2PNodePascalNames);
  FCNames:=TAVLTree.Create(@CompareH2PNodeCNames);
end;

destructor TH2PasTool.Destroy;
begin
  FPredefinedCTypes:=nil;
  Clear;
  FreeAndNil(Tree);
  FreeAndNil(FPascalNames);
  FreeAndNil(FCNames);
  FreeAndNil(CTool);
  inherited Destroy;
end;

procedure TH2PasTool.Clear;
begin
  FPascalNames.Clear;
  FCNames.Clear;
  Tree.Clear;
end;

{ TH2PNode }

function TH2PNode.Next: TH2PNode;
begin
  if FirstChild<>nil then begin
    Result:=FirstChild;
  end else begin
    Result:=Self;
    while (Result<>nil) and (Result.NextBrother=nil) do
      Result:=Result.Parent;
    if Result<>nil then Result:=Result.NextBrother;
  end;
end;

function TH2PNode.NextSkipChilds: TH2PNode;
begin
  Result:=Self;
  while (Result<>nil) and (Result.NextBrother=nil) do
    Result:=Result.Parent;
  if Result<>nil then Result:=Result.NextBrother;
end;

function TH2PNode.Prior: TH2PNode;
begin
  if PriorBrother<>nil then begin
    Result:=PriorBrother;
    while Result.LastChild<>nil do
      Result:=Result.LastChild;
  end else
    Result:=Parent;
end;

function TH2PNode.HasAsParent(Node: TH2PNode): boolean;
var CurNode: TH2PNode;
begin
  Result:=false;
  if Node=nil then exit;
  CurNode:=Parent;
  while (CurNode<>nil) do begin
    if CurNode=Node then begin
      Result:=true;
      exit;
    end;
    CurNode:=CurNode.Parent;
  end;
end;

function TH2PNode.HasAsChild(Node: TH2PNode): boolean;
begin
  Result:=false;
  if Node=nil then exit;
  Result:=Node.HasAsParent(Self);
end;

function TH2PNode.GetLevel: integer;
var ANode: TH2PNode;
begin
  Result:=0;
  ANode:=Parent;
  while ANode<>nil do begin
    inc(Result);
    ANode:=ANode.Parent;
  end;
end;

function TH2PNode.DescAsString: string;
begin
  if Self=nil then begin
    Result:='nil';
    exit;
  end;
  Result:='{PascalName="'+PascalName+'"';
  if PascalName<>CName then
    Result:=Result+',CName="'+CName+'"';
  Result:=Result+',PascalDesc="'+NodeDescriptionAsString(PascalDesc)+'"';
  if CNode<>nil then begin
    Result:=Result+',CNode='+CCNodeDescAsString(CNode.Desc);
  end else begin
    Result:=Result+', CNode=nil';
  end;
  Result:=Result+',PascalCode="'+dbgstr(PascalCode)+'"';
  Result:=Result+'}';
end;

procedure TH2PNode.ConsistencyCheck;
begin
  if (Parent<>nil) then begin
    if (PriorBrother=nil) and (Parent.FirstChild<>Self) then
      raise Exception.Create('');
    if (NextBrother=nil) and (Parent.LastChild<>Self) then
      raise Exception.Create('');
  end;
  if (NextBrother<>nil) and (NextBrother.PriorBrother<>Self) then
    raise Exception.Create('');
  if (PriorBrother<>nil) and (PriorBrother.NextBrother<>Self) then
    raise Exception.Create('');
  if (FirstChild<>nil) then
    FirstChild.ConsistencyCheck;
  if NextBrother<>nil then
    NextBrother.ConsistencyCheck;
end;

procedure TH2PNode.WriteDebugReport(const Prefix: string; WithChilds: boolean);
var
  Node: TH2PNode;
begin
  DebugLn([Prefix,DescAsString]);
  if WithChilds then begin
    Node:=FirstChild;
    while Node<>nil do begin
      Node.WriteDebugReport(Prefix+'  ',true);
      Node:=Node.NextBrother;
    end;
  end;
end;

{ TH2PTree }

constructor TH2PTree.Create;
begin
  Root:=nil;
  FNodeCount:=0;
end;

destructor TH2PTree.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TH2PTree.Clear;
var ANode: TH2PNode;
begin
  while Root<>nil do begin
    ANode:=Root;
    Root:=ANode.NextBrother;
    DeleteNode(ANode);
  end;
end;

procedure TH2PTree.DeleteNode(ANode: TH2PNode);
begin
  if ANode=nil then exit;
  while (ANode.FirstChild<>nil) do DeleteNode(ANode.FirstChild);
  with ANode do begin
    if (Parent<>nil) then begin
      if (Parent.FirstChild=ANode) then
        Parent.FirstChild:=NextBrother;
      if (Parent.LastChild=ANode) then
        Parent.LastChild:=PriorBrother;
      Parent:=nil;
    end;
    if NextBrother<>nil then NextBrother.PriorBrother:=PriorBrother;
    if PriorBrother<>nil then PriorBrother.NextBrother:=NextBrother;
    NextBrother:=nil;
    PriorBrother:=nil;
  end;
  if ANode=Root then Root:=nil;
  dec(FNodeCount);
  ANode.Free;
end;

procedure TH2PTree.AddNodeAsLastChild(ParentNode, ANode: TH2PNode);
begin
  if ParentNode=ANode then RaiseCatchableException('');
  ANode.Parent:=ParentNode;
  if Root=nil then begin
    // set as root
    Root:=ANode;
    while Root.Parent<>nil do Root:=Root.Parent;
    LastRoot:=Root;
    while LastRoot.NextBrother<>nil do
      LastRoot:=LastRoot.NextBrother;
  end else if ParentNode<>nil then begin
    if ParentNode.FirstChild=nil then begin
      // add as first child
      ParentNode.FirstChild:=ANode;
      ParentNode.LastChild:=ANode;
    end else begin
      // add as last child
      ANode.PriorBrother:=ParentNode.LastChild;
      ParentNode.LastChild:=ANode;
      if ANode.PriorBrother<>nil then ANode.PriorBrother.NextBrother:=ANode;
    end;
  end else begin
    // add as last brother of top nodes
    while (LastRoot.NextBrother<>nil) do LastRoot:=LastRoot.NextBrother;
    ANode.PriorBrother:=LastRoot;
    ANode.PriorBrother.NextBrother:=ANode;
    LastRoot:=ANode;
    while (LastRoot.NextBrother<>nil) do LastRoot:=LastRoot.NextBrother;
  end;
  inc(FNodeCount);
end;

procedure TH2PTree.AddNodeInFrontOf(NextBrotherNode, ANode: TH2PNode);
begin
  ANode.Parent:=NextBrotherNode.Parent;
  ANode.NextBrother:=NextBrotherNode;
  ANode.PriorBrother:=NextBrotherNode.PriorBrother;
  NextBrotherNode.PriorBrother:=ANode;
  if ANode.PriorBrother<>nil then
    ANode.PriorBrother.NextBrother:=ANode;
end;

function TH2PTree.ContainsNode(ANode: TH2PNode): boolean;
begin
  if ANode=nil then exit(false);
  while ANode.Parent<>nil do ANode:=ANode.Parent;
  while ANode.PriorBrother<>nil do ANode:=ANode.PriorBrother;
  Result:=ANode=Root;
end;

procedure TH2PTree.ConsistencyCheck;
// 0 = ok
var RealNodeCount: integer;

  procedure CountNodes(ANode: TH2PNode);
  begin
    if ANode=nil then exit;
    inc(RealNodeCount);
    CountNodes(ANode.FirstChild);
    CountNodes(ANode.NextBrother);
  end;

begin
  if Root<>nil then begin
    Root.ConsistencyCheck;
    if Root.Parent<>nil then
      raise Exception.Create('Root.Parent<>nil');
  end;
  RealNodeCount:=0;
  CountNodes(Root);
  if RealNodeCount<>FNodeCount then
    raise Exception.Create('RealNodeCount<>FNodeCount');
end;

procedure TH2PTree.WriteDebugReport(WithChilds: boolean);
begin
  DebugLn('[TH2PTree.WriteDebugReport] Root=',dbgs(Root<>nil));
  if Root<>nil then
    Root.WriteDebugReport(' ',true);
  ConsistencyCheck;
end;

finalization
  FreeAndNil(InternalPredefinedCTypes);

end.