1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 A tool to help converting C header files to pascal bindings.
25
26 enum -> enum
27 int i -> var i: integer
28 struct -> var plus record
29 union -> var plus record case
30 typedef -> type
31 void func() -> procedure
32 int func() -> function
33 implicit types -> explicit types
34 #ifdef,if,ifndef,undef,elif,else,endif
35 -> $ifdef,if,ifndef,...
36 #define macroname
37 -> $define macroname
38 #define macroname constant
39 -> const macroname = constant
40 simplifies conditional directives (e.g. deletes #ifdef nonexisting)
41 }
42 (*
43 ToDos:
44 add comments for skipped items
45 insert auto generated types in front of current node
46 c comments
47 const char a; -> const a: char;
48 #define name value -> alias (const, var, type, proc)
49 more complex expressions and statements
50
51 A basic record type definition in C is
52
53 struct structname { <struct_definition> };
54
55 The full name of this type is "struct structname". If you want to avoid typing the extra "struct" everywhere, you can create an alias for the type name using typedef:
56
57 typedef struct structname aliasname;
58
59 You can combine both statements into one:
60
61 typedef struct structname { <struct_definition> } aliasname;
62
63 You can also create multiple type aliases using a single typedef statement:
64
65 typedef struct structname aliasname, anotheraliasname;
66 typedef struct structname { <struct_definition> } aliasname, anotheraliasname; // same as line above
67
68 You can also create pointer type names at the same time:
69
70 typedef struct structname aliasname, anotheraliasname, *pointeraliasname;
71 typedef struct structname { <struct_definition> } aliasname, anotheraliasname, *pointeraliasname; // same as line above
72 typedef struct structname aliasname, anotheraliasname; typedef aliasname *pointeraliasname; // same as line above
73
74 If you want to declare a variable whose type is a struct, it works the same as with any other C type: the type definition/name followed by the variable name (and in case of multiple variables, those are in turn separated by commas).
75
76 struct structname structvar1, *structvar2;
77 aliasname structvar1, *strucvar2; // same as line above
78 aliasname structvar1; pointeraliasname structvar2; // same as line above
79 struct structname { <struct_definition> } structvar1, *structvar2; // same as line above
80
81 It is also possible to define anonymous structs (without any identifier following the "struct" keyword). In that case it should either be used in a variable definition, or in a typedef declaration. Otherwise the statement has no meaning, since there is no way to refer to that struct definition later on:
82
83 struct { <struct_definition> }; // no meaning: does not define a variable, and no name to refer to the type again in later declarations; gcc will warn
84 struct { <struct_definition> } structvar; // same as "var structvar: record <struct_definition> end;"
85 typedef struct { <struct_definition> } aliasname; // same as *** above, except that you can only use "aliasname" to refer to this type, rather than also "struct structname"
86
87 *)
88 unit H2PasTool;
89
90 {$mode objfpc}{$H+}
91
92 {off $DEFINE VerboseH2PasTool}
93
94 interface
95
96 uses
97 Classes, SysUtils, Laz_AVL_Tree,
98 // LazUtils
99 AvgLvlTree,
100 // Codetools
101 FileProcs, BasicCodeTools, CCodeParserTool,
102 NonPascalCodeTools, KeywordFuncLists, CodeCache, CodeTree, CodeAtom;
103
104 const
105 DefaultMaxPascalIdentLen = 70;
106
107 h2pdnBase = 1000;
108 h2pdnNone = 0+h2pdnBase;
109 h2pdnRoot = 1+h2pdnBase;
110
111 h2pdnDefine = 11+h2pdnBase;
112 h2pdnUndefine = 12+h2pdnBase;
113
114 h2pdnIf = 21+h2pdnBase;
115 h2pdnIfDef = 22+h2pdnBase;
116 h2pdnIfNDef = 23+h2pdnBase;
117 h2pdnElseIf = 24+h2pdnBase;
118 h2pdnElse = 25+h2pdnBase;
119 h2pdnEndIf = 26+h2pdnBase;
120
121 h2pdnError = 31+h2pdnBase;
122
123 type
124 { TH2PBaseNode }
125
126 TH2PBaseNode = class
127 public
128 Parent, FirstChild, LastChild, NextBrother, PriorBrother: TH2PBaseNode;
Nextnull129 function Next: TH2PBaseNode;
NextSkipChildsnull130 function NextSkipChilds: TH2PBaseNode;
Priornull131 function Prior: TH2PBaseNode;
HasAsParentnull132 function HasAsParent(Node: TH2PBaseNode): boolean;
HasAsChildnull133 function HasAsChild(Node: TH2PBaseNode): boolean;
GetLevelnull134 function GetLevel: integer;
DescAsStringnull135 function DescAsString(CTool: TCCodeParserTool = nil): string; virtual; abstract;
136 procedure ConsistencyCheck; virtual;
137 procedure WriteDebugReport(const Prefix: string; WithChildren: boolean;
138 CTool: TCCodeParserTool = nil); virtual;
139 end;
140
141 TH2PNode = class;
142
143 { TH2PDirectiveNode }
144
145 TH2PDirectiveNode = class(TH2PBaseNode)
146 public
147 H2PNode: TH2PNode;
148 Desc: TCodeTreeNodeDesc;// e.g. h2pdnDefine
149 MacroName: string; // ifdef, ifndef, undef, define
150 MacroParams: string; // define
151 Expression: string; // if, elseif, define, error
DescAsStringnull152 function DescAsString(CTool: TCCodeParserTool = nil): string; override;
153 end;
154
155
156 { TH2PNode }
157
158 TH2PNode = class(TH2PBaseNode)
159 public
160 PascalName: string;
161 CName: string;
162 CNode: TCodeTreeNode;
163 PascalDesc: TCodeTreeNodeDesc;
164 PascalCode: string;
165 NormalizedPascalCode: string;
166 Directive: TH2PDirectiveNode;
DescAsStringnull167 function DescAsString(CTool: TCCodeParserTool = nil): string; override;
168 end;
169
170
171 { TH2PTree }
172
173 TH2PTree = class
174 private
175 FNodeCount: integer;
176 procedure Unbind(Node: TH2PBaseNode);
177 public
178 Root: TH2PBaseNode;
179 LastRoot: TH2PBaseNode;
180 constructor Create;
181 destructor Destroy; override;
182 procedure Clear;
183 property NodeCount: integer read FNodeCount;
184 procedure DeleteNode(ANode: TH2PBaseNode);
185 procedure AddNodeAsLastChild(ParentNode, ANode: TH2PBaseNode);
186 procedure AddNodeAsPreLastChild(ParentNode, ANode: TH2PBaseNode);
187 procedure AddNodeInFrontOf(NextBrotherNode, ANode: TH2PBaseNode);
188 procedure MoveChildsInFront(ANode: TH2PBaseNode);
ContainsNodenull189 function ContainsNode(ANode: TH2PBaseNode): boolean;
190 procedure ConsistencyCheck;
191 procedure WriteDebugReport(WithChildren: boolean);
192 end;
193
194
195 TH2PMacroStatus = (
196 hmsUnknown, // never seen
197 hmsDefined, // set to a specific value e.g. by $Define or by $IfDef
198 hmsUndefined, // undefined e.g. by $Undef
199 hmsComplex // value depends on complex expressions. e.g. {$if A or B}.
200 );
201
202 TH2PMacroStats = class
203 public
204 Name: string;
205 Value: string;
206 Status: TH2PMacroStatus;
207 LastDefineNode: TH2PNode;// define or undef node
208 LastReadNode: TH2PNode;// if node
209 end;
210
211
212 TIgnoreCSourcePart = (
213 icspInclude
214 );
215 TIgnoreCSourceParts = set of TIgnoreCSourcePart;
216
217 { TH2PasTool }
218
219 TH2PasTool = class
220 private
221 FCNames: TAVLTree;// tree of TH2PNode sorted for CName
222 FCurDirectiveNode: TH2PDirectiveNode;
223 FCurIndentStr: string;
224 FCurPasSection: TCodeTreeNodeDesc;
225 FCurPasStream: TStream;
226 FDefines: TStringToStringTree;
227 FDisableUnusedDefines: boolean;
228 FIgnoreCParts: TIgnoreCSourceParts;
229 FPascalNames: TAVLTree;// tree of TH2PNode sorted for PascalName
230 FPredefinedCTypes: TStringToStringTree;
231 FRemoveDisabledDirectives: boolean;
232 FSimplifyExpressions: boolean;
233 FSourceName: string;
234 FUndefines: TStringToStringTree;
235 FUseExternal: boolean;
236 // converting C nodes to H2P nodes
ConvertStructnull237 function ConvertStruct(CNode: TCodeTreeNode; ParentNode: TH2PNode): TH2PNode;
238 procedure ConvertVariable(CNode: TCodeTreeNode; ParentNode: TH2PNode);
ConvertEnumBlocknull239 function ConvertEnumBlock(CNode: TCodeTreeNode; ParentNode: TH2PNode): TH2PNode;
240 procedure ConvertFunction(CNode: TCodeTreeNode; ParentNode: TH2PNode);
241 procedure ConvertFuncParameter(CNode: TCodeTreeNode; ParentNode: TH2PNode);
242 procedure ConvertTypedef(CNode: TCodeTreeNode; ParentNode: TH2PNode);
243 procedure ConvertDirective(CNode: TCodeTreeNode; ParentNode: TH2PNode);
ConvertCToPascalDirectiveExpressionnull244 function ConvertCToPascalDirectiveExpression(const CCode: string;
245 StartPos, EndPos: integer; out PasExpr: string;
246 out ErrorPos: integer; out ErrorMsg: string): boolean;
247
248 // writing pascal
249 procedure WriteStr(const Line: string);
250 procedure WriteLnStr(const Line: string);
251 procedure W(const aStr: string);// write indent + aStr + lineend
252 procedure IncIndent;
253 procedure DecIndent;
254 procedure SetPasSection(NewSection: TCodeTreeNodeDesc);
255 procedure WriteGlobalVarNode(H2PNode: TH2PNode);
256 procedure WriteGlobalTypeNode(H2PNode: TH2PNode);
257 procedure WriteGlobalConstNode(H2PNode: TH2PNode);
258 procedure WriteGlobalProcedureNode(H2PNode: TH2PNode);
259 procedure WriteGlobalEnumerationTypeNode(H2PNode: TH2PNode);
260 procedure WriteGlobalRecordTypeNode(H2PNode: TH2PNode);
261 procedure WriteDirectiveNode(DirNode: TH2PDirectiveNode);
CreateDirectiveValuenull262 function CreateDirectiveValue(const s: string): string;
263
264 // simplification
265 procedure SimplifyUndefineDirective(Node: TH2PDirectiveNode;
266 var NextNode: TH2PDirectiveNode;
267 var Changed: boolean);
268 procedure SimplifyDefineDirective(Node: TH2PDirectiveNode;
269 var NextNode: TH2PDirectiveNode;
270 var Changed: boolean);
271 procedure SimplifyIfDirective(Node: TH2PDirectiveNode; Expression: string;
272 var NextNode: TH2PDirectiveNode;
273 var Changed: boolean);
SimplifyIfDirectiveExpressionnull274 function SimplifyIfDirectiveExpression(var Expression: string): boolean;
275 procedure SimplifyMacroRedefinition(var Node: TH2PDirectiveNode;
276 const NewValue: string; NewStatus: TH2PMacroStatus;
277 var NextNode: TH2PDirectiveNode; var Changed: boolean);
278 procedure SimplifyUnusedDefines(Changed: boolean);
MacroValueIsConstantnull279 function MacroValueIsConstant(Node: TH2PDirectiveNode;
280 out PasType, PasExpression: string): boolean;
281 procedure DeleteDirectiveNode(Node: TH2PDirectiveNode;
282 DeleteChilds: boolean;
283 AdaptNeighborhood: boolean);
284 procedure DeleteH2PNode(Node: TH2PNode);
285 public
286 Tree: TH2PTree; // TH2PNode
287 DirectivesTree: TH2PTree; // TH2PDirectiveNode
288 CTool: TCCodeParserTool;
289 Macros: TAVLTree;// tree of TH2PMacroStats
Convertnull290 function Convert(CCode, PascalCode: TCodeBuffer): boolean;
291 procedure BuildH2PTree(ParentNode: TH2PNode = nil; StartNode: TCodeTreeNode = nil);
FindEnclosingIFNDEFnull292 function FindEnclosingIFNDEF(CCode: TCodeBuffer): TCodeTreeNode;
293 procedure UndefineEnclosingIFNDEF(CCode: TCodeBuffer);
294 procedure SimplifyDirectives;
295 procedure WritePascal(PascalCode: TCodeBuffer);
296 procedure WritePascalToStream(s: TStream);
297
GetSimplePascalTypeOfCVarnull298 function GetSimplePascalTypeOfCVar(CVarNode: TCodeTreeNode): string;
GetSimplePascalTypeOfCParameternull299 function GetSimplePascalTypeOfCParameter(CParamNode: TCodeTreeNode): string;
GetSimplePascalTypeOfTypeDefnull300 function GetSimplePascalTypeOfTypeDef(TypeDefNode: TCodeTreeNode): string;
GetSimplePascalResultTypeOfCFunctionnull301 function GetSimplePascalResultTypeOfCFunction(CFuncNode: TCodeTreeNode): string;
ConvertSimpleCTypeToPascalTypenull302 function ConvertSimpleCTypeToPascalType(CType: string;
303 UseSingleIdentifierAsDefault: boolean): string;
304
CreateH2PNodenull305 function CreateH2PNode(var PascalName: string; const CName: string;
306 CNode: TCodeTreeNode;
307 PascalDesc: TCodeTreeNodeDesc; const PascalCode: string;
308 ParentNode: TH2PNode = nil; IsGlobal: boolean = true;
309 InsertAsPreLast: boolean = false): TH2PNode;
CreateAutoGeneratedH2PNodenull310 function CreateAutoGeneratedH2PNode(var PascalName: string; CNode: TCodeTreeNode;
311 PascalDesc: TCodeTreeNodeDesc; const PascalCode: string;
312 ParentNode: TH2PNode; IsGlobal: boolean;
313 InsertAsPreLast: boolean): TH2PNode;
CreateH2PNodeForComplexTypenull314 function CreateH2PNodeForComplexType(CNode: TCodeTreeNode;
315 CreateIfNotExists: boolean;
316 InsertAsPreLast: boolean): TH2PNode;
CreatePascalNameFromCCodenull317 function CreatePascalNameFromCCode(const CCode: string;
318 StartPos: integer = 1;
319 EndPos: integer = -1): string;
CreateUniquePascalNamenull320 function CreateUniquePascalName(const CName: string): string;
FindH2PNodeWithPascalNamenull321 function FindH2PNodeWithPascalName(const PascalName: string): TH2PNode;
FindH2PNodeWithCNamenull322 function FindH2PNodeWithCName(const CName: string): TH2PNode;
323
CreateH2PDirectiveNodenull324 function CreateH2PDirectiveNode(H2PNode: TH2PNode; Desc: TCodeTreeNodeDesc
325 ): TH2PDirectiveNode;
326
327 procedure WriteDebugReport;
328 procedure WriteH2PNodeReport;
329 procedure WriteH2PDirectivesNodeReport;
330 constructor Create;
331 destructor Destroy; override;
332 procedure Clear;
333 property PredefinedCTypes: TStringToStringTree read FPredefinedCTypes;
334 property IgnoreCParts: TIgnoreCSourceParts read FIgnoreCParts write FIgnoreCParts;
335 property SourceName: string read FSourceName write FSourceName;
336 property UseExternal: boolean read FUseExternal write FUseExternal;// use external instad of public
337
338 // directives
339 property SimplifyExpressions: boolean read FSimplifyExpressions
340 write FSimplifyExpressions;
341 property DisableUnusedDefines: boolean read FDisableUnusedDefines
342 write FDisableUnusedDefines;
343 property RemoveDisabledDirectives: boolean read FRemoveDisabledDirectives
344 write FRemoveDisabledDirectives;
345 property Defines: TStringToStringTree read FDefines;
346 property Undefines: TStringToStringTree read FUndefines;// undefines take precedence over defines
347 procedure AddCommonCDefines;
348
349 // macros - temporary values - use Defines and Undefines
350 procedure ResetMacros;
351 procedure ClearMacros;
352 procedure InitMacros;
FindMacronull353 function FindMacro(const MacroName: string;
354 CreateIfNotExists: boolean = false): TH2PMacroStats;
DefineMacronull355 function DefineMacro(const MacroName, AValue: string;
356 DefineNode: TH2PNode): TH2PMacroStats;// use Defines instead
UndefineMacronull357 function UndefineMacro(const MacroName: string;
358 UndefineNode: TH2PNode): TH2PMacroStats;// use Undefines instead
359 procedure MarkMacrosAsRead(Node: TH2PNode; const Src: string;
360 StartPos: integer = 1; EndPos: integer = -1);
MarkMacroAsReadnull361 function MarkMacroAsRead(const MacroName: string;
362 Node: TH2PNode): TH2PMacroStats;// use Undefines instead
363 end;
364
DefaultPredefinedCTypesnull365 function DefaultPredefinedCTypes: TStringToStringTree;// types in unit ctypes
366
CompareH2PNodePascalNamesnull367 function CompareH2PNodePascalNames(Data1, Data2: Pointer): integer;
CompareStringWithH2PNodePascalNamenull368 function CompareStringWithH2PNodePascalName(AString, ANode: Pointer): integer;
CompareH2PNodeCNamesnull369 function CompareH2PNodeCNames(Data1, Data2: Pointer): integer;
CompareStringWithH2PNodeCNamenull370 function CompareStringWithH2PNodeCName(AString, ANode: Pointer): integer;
CompareH2PMacroStatsnull371 function CompareH2PMacroStats(Data1, Data2: Pointer): integer;
ComparePCharWithH2PMacroStatsnull372 function ComparePCharWithH2PMacroStats(Name, MacroStats: Pointer): integer;
373
H2PDirectiveNodeDescriptionAsStringnull374 function H2PDirectiveNodeDescriptionAsString(Desc: TCodeTreeNodeDesc): string;
375
376
377 implementation
378
379
380 var
381 InternalPredefinedCTypes: TStringToStringTree = nil;// types in unit ctypes
382
DefaultPredefinedCTypesnull383 function DefaultPredefinedCTypes: TStringToStringTree;
384 begin
385 if InternalPredefinedCTypes=nil then begin
386 InternalPredefinedCTypes:=TStringToStringTree.Create(true);
387 with InternalPredefinedCTypes do begin
388 // int
389 Add('int','cint');
390 Add('int*','pcint');
391 Add('signed int','csint');
392 Add('signed int*','pcsint');
393 Add('unsigned int','cuint');
394 Add('unsigned int*','pcuint');
395 // ToDo: signed -> cint
396 // ToDo: unsigned -> cuint
397 // short
398 Add('short','cshort');
399 Add('short*','pcshort');
400 Add('signed short','csshort');
401 Add('signed short*','pcsshort');
402 Add('unsigned short','cushort');
403 Add('unsigned short*','pcushort');
404 Add('short int','cshort');
405 Add('short int*','pcshort');
406 Add('signed short int','csshort');
407 Add('signed short int*','pcsshort');
408 Add('short signed int','csshort');
409 Add('short signed int*','pcsshort');
410 Add('short unsigned int','cushort');
411 Add('short unsigned int*','pcushort');
412 // int8
413 Add('int8','cint8');
414 Add('int8*','pcint8');
415 Add('int8_t','cint8');
416 Add('int8_t*','pcint8');
417 Add('unsigned int8','cuint8');
418 Add('unsigned int8*','pcuint8');
419 Add('uint8_t','cuint8');
420 Add('uint8_t*','pcuint8');
421 // int16
422 Add('int16','cint16');
423 Add('int16*','pcint16');
424 Add('int16_t','cint16');
425 Add('int16_t*','pcint16');
426 Add('unsigned int16','cuint16');
427 Add('unsigned int16*','pcuint16');
428 Add('uint16_t','cuint16');
429 Add('uint16_t*','pcuint16');
430 // int32
431 Add('int32','cint32');
432 Add('int32*','pcint32');
433 Add('int32_t','cint32');
434 Add('int32_t*','pcint32');
435 Add('unsigned int32','cuint32');
436 Add('unsigned int32*','pcuint32');
437 Add('uint32_t','cuint32');
438 Add('uint32_t*','pcuint32');
439 // int64
440 Add('int64','cint64');
441 Add('int64*','pcint64');
442 Add('int64_t','cint64');
443 Add('int64_T*','pcint64');
444 Add('unsigned int64','cuint64');
445 Add('unsigned int64*','pcuint64');
446 Add('uint64_t','cuint64');
447 Add('uint64_t*','pcuint64');
448 // long
449 Add('long','clong');
450 Add('long*','pclong');
451 Add('signed long','cslong');
452 Add('signed long*','pcslong');
453 Add('unsigned long','culong');
454 Add('unsigned long*','pculong');
455 Add('long int','clong');
456 Add('long int*','pclong');
457 Add('signed long int','cslong');
458 Add('signed long int*','pcslong');
459 Add('long signed int','cslong');
460 Add('long signed int*','pcslong');
461 Add('unsigned long int','culong');
462 Add('unsigned long int*','pculong');
463 Add('long unsigned int','culong');
464 Add('long unsigned int*','pculong');
465 // long long
466 Add('long long','clonglong');
467 Add('long long*','pclonglong');
468 Add('signed long long','cslonglong');
469 Add('signed long long*','pcslonglong');
470 Add('unsigned long long','culonglong');
471 Add('unsigned long long*','pculonglong');
472 // bool
473 Add('bool','cbool');
474 Add('bool*','pcbool');
475 // char
476 Add('char','cchar');
477 Add('char*','pcchar');
478 Add('signed char','cschar');
479 Add('signed char*','pcschar');
480 Add('unsigned char','cuchar');
481 Add('unsigned char*','pcuchar');
482 // float
483 Add('float','cfloat');
484 Add('float*','pcfloat');
485 // double
486 Add('double','cdouble');
487 Add('double*','pcdouble');
488 Add('long double','clongdouble');
489 Add('long double*','pclongdouble');
490 // void
491 Add('void*','pointer');
492 // size_t
493 Add('size_t','PtrUInt');
494 end;
495 end;
496 Result:=InternalPredefinedCTypes;
497 end;
498
CompareH2PNodePascalNamesnull499 function CompareH2PNodePascalNames(Data1, Data2: Pointer): integer;
500 begin
501 Result:=CompareIdentifierPtrs(Pointer(TH2PNode(Data1).PascalName),
502 Pointer(TH2PNode(Data2).PascalName));
503 end;
504
CompareStringWithH2PNodePascalNamenull505 function CompareStringWithH2PNodePascalName(AString, ANode: Pointer): integer;
506 begin
507 Result:=CompareIdentifierPtrs(Pointer(AString),
508 Pointer(TH2PNode(ANode).PascalName));
509 end;
510
CompareH2PNodeCNamesnull511 function CompareH2PNodeCNames(Data1, Data2: Pointer): integer;
512 begin
513 Result:=CompareIdentifiersCaseSensitive(PChar(Pointer(TH2PNode(Data1).CName)),
514 PChar(Pointer(TH2PNode(Data2).CName)));
515 end;
516
CompareStringWithH2PNodeCNamenull517 function CompareStringWithH2PNodeCName(AString, ANode: Pointer): integer;
518 begin
519 Result:=CompareIdentifiersCaseSensitive(PChar(AString),
520 PChar(Pointer(TH2PNode(ANode).CName)));
521 end;
522
CompareH2PMacroStatsnull523 function CompareH2PMacroStats(Data1, Data2: Pointer): integer;
524 begin
525 Result:=CompareIdentifierPtrs(Pointer(TH2PMacroStats(Data1).Name),
526 Pointer(TH2PMacroStats(Data2).Name));
527 end;
528
ComparePCharWithH2PMacroStatsnull529 function ComparePCharWithH2PMacroStats(Name, MacroStats: Pointer): integer;
530 begin
531 Result:=CompareIdentifierPtrs(Name,
532 Pointer(TH2PMacroStats(MacroStats).Name));
533 end;
534
H2PDirectiveNodeDescriptionAsStringnull535 function H2PDirectiveNodeDescriptionAsString(Desc: TCodeTreeNodeDesc): string;
536 begin
537 case Desc of
538 h2pdnNone: Result:='none';
539 h2pdnRoot: Result:='root';
540
541 h2pdnDefine: Result:='Define';
542 h2pdnUndefine: Result:='Undef';
543
544 h2pdnIf: Result:='If';
545 h2pdnIfDef: Result:='IfDef';
546 h2pdnIfNDef: Result:='IfNDef';
547 h2pdnElseIf: Result:='ElseIf';
548 h2pdnElse: Result:='Else';
549 h2pdnEndIf: Result:='EndIf';
550
551 h2pdnError: Result:='Error';
552
553 else Result:='?('+IntToStr(Desc)+')';
554 end;
555 end;
556
557 { TH2PasTool }
558
TH2PasTool.ConvertStructnull559 function TH2PasTool.ConvertStruct(CNode: TCodeTreeNode; ParentNode: TH2PNode
560 ): TH2PNode;
561 var
562 CurName: String;
563 CurCName: String;
564 ChildCNode: TCodeTreeNode;
565 begin
566 Result:=nil;
567 CurName:=CTool.ExtractStructName(CNode);
568 if CurName='' then begin
569 // this is an anonymous struct -> ignore
570 {$IFDEF VerboseH2PasTool}
571 DebugLn(['TH2PasTool.ConvertStruct SKIPPING anonymous struct at ',CTool.CleanPosToStr(CNode.StartPos)]);
572 {$ENDIF}
573 end else begin
574 // this struct has a name
575 // create a type
576 CurCName:=CurName;
577 Result:=CreateH2PNode(CurName,CurCName,CNode,ctnRecordType,'',
578 nil,ParentNode=nil);
579 {$IFDEF VerboseH2PasTool}
580 DebugLn(['TH2PasTool.ConvertStruct ADDED ',Result.DescAsString(CTool)]);
581 {$ENDIF}
582 // build recursively
583 ChildCNode:=CNode.FirstChild;
584 while (ChildCNode<>nil) do begin
585 if (ChildCNode.Desc=ccnSubDefs) and (ChildCNode.FirstChild<>nil) then
586 BuildH2PTree(Result,ChildCNode.FirstChild);
587 ChildCNode:=ChildCNode.NextBrother;
588 end;
589 end;
590 end;
591
592 procedure TH2PasTool.ConvertVariable(CNode: TCodeTreeNode; ParentNode: TH2PNode);
593 var
594 CurName: String;
595 TypeH2PNode: TH2PNode;
596 {%H-}CurType: String;
597 SimpleType: String;
598 {%H-}H2PNode: TH2PNode;
599 SubTypeName: String;
600 CurCName: String;
601 begin
602 if (CNode.FirstChild<>nil) and (CNode.FirstChild.Desc=ccnUnion)
603 then begin
604 CurName:=CTool.ExtractDefinitionName(CNode);
605 if (ParentNode<>nil) and (ParentNode.PascalDesc=ctnRecordType)
606 then begin
607 // create a pascal 'record case'
608 CurCName:=CurName;
609 TypeH2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnRecordCase,'',
610 ParentNode,false);
611 {$IFDEF VerboseH2PasTool}
612 DebugLn(['TH2PasTool.ConvertVariable added record case for nested union']);
613 {$ENDIF}
614 // build recursively the record cases
615 if CNode.FirstChild.FirstChild<>nil then
616 BuildH2PTree(TypeH2PNode,CNode.FirstChild.FirstChild);
617 end else if (CurName<>'') and (ParentNode=nil) then begin
618 // this union has a name
619 // create a record type
620 SubTypeName:='T'+CurName;
621 TypeH2PNode:=CreateH2PNode(SubTypeName,'',CNode,ctnRecordCase,'',
622 nil,true);
623 {$IFDEF VerboseH2PasTool}
624 DebugLn(['TH2PasTool.ConvertVariable added record type for union: ',TypeH2PNode.DescAsString(CTool)]);
625 {$ENDIF}
626 // build recursively
627 if CNode.FirstChild.FirstChild<>nil then
628 BuildH2PTree(TypeH2PNode,CNode.FirstChild.FirstChild);
629 // create variable
630 CurName:=CTool.ExtractUnionName(CNode);
631 CurCName:=CurName;
632 H2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnVarDefinition,
633 TypeH2PNode.PascalName,
634 nil,ParentNode=nil);
635 {$IFDEF VerboseH2PasTool}
636 DebugLn(['TH2PasTool.ConvertVariable added variable for union: ',H2PNode.DescAsString(CTool)]);
637 {$ENDIF}
638 end else begin
639 {$IFDEF VerboseH2PasTool}
640 DebugLn(['TH2PasTool.ConvertVariable SKIPPING union variable at ',CTool.CleanPosToStr(CNode.StartPos)]);
641 {$ENDIF}
642 end;
643 end else begin
644 CurName:=CTool.ExtractDefinitionName(CNode);
645 SimpleType:=GetSimplePascalTypeOfCVar(CNode);
646 if SimpleType='' then begin
647 // this variable has a complex type
648 TypeH2PNode:=CreateH2PNodeForComplexType(CNode,true,ParentNode<>nil);
649 if TypeH2PNode<>nil then
650 SimpleType:=TypeH2PNode.PascalName;
651 end;
652 if CurName<>'' then begin
653 if SimpleType<>'' then begin
654 CurCName:=CurName;
655 H2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnVarDefinition,SimpleType,
656 ParentNode,ParentNode=nil);
657 {$IFDEF VerboseH2PasTool}
658 DebugLn(['TH2PasTool.ConvertVariable CurName=',CurName,' ',H2PNode.PascalName]);
659 DebugLn(['TH2PasTool.ConvertVariable added: ',H2PNode.DescAsString(CTool)]);
660 {$ENDIF}
661 end else begin
662 CurType:=CTool.ExtractDefinitionType(CNode);
663 {$IFDEF VerboseH2PasTool}
664 DebugLn(['TH2PasTool.ConvertVariable SKIPPING Variable Name="',CurName,'" Type="',CurType,'"']);
665 {$ENDIF}
666 end;
667 end;
668 end;
669 end;
670
ConvertEnumBlocknull671 function TH2PasTool.ConvertEnumBlock(CNode: TCodeTreeNode; ParentNode: TH2PNode
672 ): TH2PNode;
673 var
674 CurName: String;
675 CurValue: String;
676 {%H-}H2PNode: TH2PNode;
677 CurCName: String;
678 begin
679 CurName:=CTool.ExtractEnumBlockName(CNode);
680 if CurName='' then begin
681 // this is an anonymous enum block => auto generate a name
682 CurName:=CreatePascalNameFromCCode(CTool.Src,CNode.StartPos,CNode.EndPos);
683 Result:=CreateAutoGeneratedH2PNode(CurName,CNode,ctnEnumerationType,'',
684 nil,true,ParentNode<>nil);
685 end else begin
686 // this enum block has a name
687 CurCName:=CurName;
688 Result:=CreateH2PNode(CurName,CurCName,CNode,ctnEnumerationType,'',
689 nil,true);
690 end;
691 {$IFDEF VerboseH2PasTool}
692 DebugLn(['TH2PasTool.ConvertEnumBlock added: ',Result.DescAsString(CTool)]);
693 {$ENDIF}
694
695 CNode:=CNode.FirstChild;
696 while CNode<>nil do begin
697 if CNode.Desc=ccnEnumID then begin
698 CurName:=CTool.ExtractEnumIDName(CNode);
699 CurValue:=CTool.ExtractEnumIDValue(CNode);
700 CurCName:=CurName;
701 H2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnEnumIdentifier,CurValue,
702 Result,true);
703 {$IFDEF VerboseH2PasTool}
704 DebugLn(['TH2PasTool.ConvertEnumBlock added: ',H2PNode.DescAsString(CTool)]);
705 {$ENDIF}
706 end;
707 CNode:=CNode.NextBrother;
708 end;
709 end;
710
711 procedure TH2PasTool.ConvertFunction(CNode: TCodeTreeNode; ParentNode: TH2PNode);
712 var
713 CurName: String;
714 {%H-}CurType: String;
715 SimpleType: String;
Booleannull716 IsPointerToFunction: Boolean;
717 Ok: Boolean;
718 StatementNode: TCodeTreeNode;
719 TypeH2PNode: TH2PNode;
720 H2PNode: TH2PNode;
721 SubTypeName: String;
722 ParamsNode: TCodeTreeNode;
723 CurCName: String;
724 begin
725 CurName:=CTool.ExtractFunctionName(CNode);
726 CurType:=CTool.ExtractFunctionResultType(CNode);
Nodenull727 SimpleType:=GetSimplePascalResultTypeOfCFunction(CNode);
728 IsPointerToFunction:=CTool.IsPointerToFunction(CNode);
729 StatementNode:=nil;
730 Ok:=true;
731 if (CNode.LastChild<>nil) and (CNode.LastChild.Desc=ccnStatementBlock) then
732 StatementNode:=CNode.LastChild;
733 {$IFDEF VerboseH2PasTool}
734 DebugLn(['TH2PasTool.ConvertFunction Function Name="',CurName,'" ResultType="',CurType,'" SimpleType=',SimpleType,' HasStatements=',StatementNode<>nil,' IsPointer=',IsPointerToFunction,' ParentNode=',ParentNode<>nil]);
735 {$ENDIF}
736 if StatementNode<>nil then begin
hasnull737 // this function has a body
738 Ok:=false;
739 end;
740 if Ok and (SimpleType='') then begin
hasnull741 // this function has a complex result type
742 TypeH2PNode:=CreateH2PNodeForComplexType(CNode,true,ParentNode<>nil);
743 if TypeH2PNode<>nil then begin
744 SimpleType:=TypeH2PNode.PascalName;
745 end else
746 Ok:=false;
747 end;
748
749 if Ok then begin
thennull750 if IsPointerToFunction then begin
751 // create proc type
752 ParamsNode:=CTool.GetFunctionParamListNode(CNode);
753 SubTypeName:=CreatePascalNameFromCCode(CurName+CTool.ExtractFunctionParamList(CNode));
754 TypeH2PNode:=CreateAutoGeneratedH2PNode(SubTypeName,ParamsNode,
755 ctnProcedureType,SimpleType,nil,true,ParentNode<>nil);
756 {$IFDEF VerboseH2PasTool}
757 DebugLn(['TH2PasTool.ConvertFunction function type added: ',TypeH2PNode.DescAsString(CTool)]);
758 {$ENDIF}
759 // create variable
760 CurCName:=CurName;
761 H2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnVarDefinition,SubTypeName,
762 ParentNode,ParentNode=nil);
763 {$IFDEF VerboseH2PasTool}
764 DebugLn(['TH2PasTool.ConvertFunction variable added: ',H2PNode.DescAsString(CTool)]);
765 {$ENDIF}
766 // build parameters recursively
767 if ParamsNode.FirstChild<>nil then
768 BuildH2PTree(TypeH2PNode,ParamsNode.FirstChild);
769 end else begin
770 // create proc
771 CurCName:=CurName;
772 H2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnProcedure,SimpleType,
773 nil,true);
774 {$IFDEF VerboseH2PasTool}
775 DebugLn(['TH2PasTool.ConvertFunction function added: ',H2PNode.DescAsString(CTool)]);
776 {$ENDIF}
777 // build parameters recursively
778 if CNode.FirstChild<>nil then
779 BuildH2PTree(H2PNode);
780 end;
781 end else begin
782 {$IFDEF VerboseH2PasTool}
783 DebugLn(['TH2PasTool.ConvertFunction SKIPPING Function Name="',CurName,'" Type="',CurType,'" at ',CTool.CleanPosToStr(CNode.StartPos)]);
784 {$ENDIF}
785 end;
786 end;
787
788 procedure TH2PasTool.ConvertFuncParameter(CNode: TCodeTreeNode;
789 ParentNode: TH2PNode);
790 var
791 CurName: String;
792 CurType: String;
793 SimpleType: String;
794 TypeH2PNode: TH2PNode;
795 {%H-}H2PNode: TH2PNode;
796 CurCName: String;
797 begin
798 CurName:=CTool.ExtractParameterName(CNode);
799 CurType:=CTool.ExtractParameterType(CNode);
800 if CurType='void' then begin
withoutnull801 // for example int f(void) is a function without params
802 exit;
803 end;
804 SimpleType:=GetSimplePascalTypeOfCParameter(CNode);
805 {$IFDEF VerboseH2PasTool}
806 DebugLn(['TH2PasTool.ConvertFuncParameter Parameter: Name="',CurName,'" Type="',CurType,'" SimpleType="',SimpleType,'"']);
807 {$ENDIF}
808 if SimpleType='' then begin
809 // this variable has a complex type
810 TypeH2PNode:=CreateH2PNodeForComplexType(CNode,true,true);
811 if TypeH2PNode<>nil then
812 SimpleType:=TypeH2PNode.PascalName;
813 end;
814 if SimpleType<>'' then begin
815 CurCName:=CurName;
816 H2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnVarDefinition,SimpleType,
817 ParentNode,false);
818 {$IFDEF VerboseH2PasTool}
819 DebugLn(['TH2PasTool.ConvertFuncParameter added: ',H2PNode.DescAsString(CTool)]);
820 {$ENDIF}
821 end else begin
822 {$IFDEF VerboseH2PasTool}
823 DebugLn(['TH2PasTool.ConvertFuncParameter SKIPPING parameter Name="',CurName,'" Type="',CurType,'" at ',CTool.CleanPosToStr(CNode.StartPos)]);
824 {$ENDIF}
825 end;
826 end;
827
828 procedure TH2PasTool.ConvertTypedef(CNode: TCodeTreeNode; ParentNode: TH2PNode);
829 var
830 CurName: String;
831 ChildNode: TCodeTreeNode;
832 {%H-}CurType: String;
833 TypeH2PNode: TH2PNode;
Booleannull834 IsPointerToFunction: Boolean;
835 SimpleType: String;
836 H2PNode: TH2PNode;
837 CurCName: String;
838 CurValue: String;
839 SubChildNode: TCodeTreeNode;
840 TypeNode: TCodeTreeNode;
841 SubTypeName: String;
842 begin
843 if CNode.FirstChild=nil then begin
844 exit;
845 end;
846 CurName:=CTool.ExtractTypedefName(CNode);
847 {$IFDEF VerboseH2PasTool}
848 DebugLn(['TH2PasTool.ConvertTypedef Typedef name="',CurName,'"']);
849 {$ENDIF}
850 ChildNode:=CNode.FirstChild;
851 case ChildNode.Desc of
852
853 ccnName: // typedef simple-type name
854 begin
855 SimpleType:=GetSimplePascalTypeOfTypeDef(CNode);
856 if SimpleType='' then begin
857 // this variable has a complex type
858 TypeH2PNode:=CreateH2PNodeForComplexType(CNode,true,ParentNode<>nil);
859 if TypeH2PNode<>nil then
860 SimpleType:=TypeH2PNode.PascalName;
861 end;
862 if SimpleType<>'' then begin
863 CurCName:=CurName;
864 H2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnTypeDefinition,
865 SimpleType);
866 {$IFDEF VerboseH2PasTool}
867 DebugLn(['TH2PasTool.ConvertTypedef added: ',H2PNode.DescAsString(CTool)]);
868 {$ENDIF}
869 end else begin
870 CurType:=CTool.ExtractDefinitionType(ChildNode);
871 {$IFDEF VerboseH2PasTool}
872 DebugLn(['TH2PasTool.ConvertTypedef SKIPPING Typedef Variable Name="',CurName,'" Type="',CurType,'"']);
873 {$ENDIF}
874 end;
875 end;
876
877 ccnStruct: // typedef struct
878 begin
879 (* typedef struct a b; => alias b = a
880 typedef struct a {} b; => a = record + alias b = a
881 typedef struct {} b; => b = record
882 *)
883 if (ChildNode.FirstChild.Desc=ccnTypeName)
884 and (ChildNode.LastChild.Desc=ccnSubDefs) then begin
885 // for example: typedef struct a {} b;
886 // => create a new record type a and an alias b = a
887 TypeNode:=ChildNode.FirstChild;
888 SubChildNode:=ChildNode.LastChild;
889 // create a new record
890 CurCName:=GetIdentifier(@CTool.Src[TypeNode.StartPos]);
891 SubTypeName:=CurCName;
892 TypeH2PNode:=CreateH2PNode(SubTypeName,CurCName,TypeNode,ctnRecordType,'');
893 {$IFDEF VerboseH2PasTool}
894 DebugLn(['TH2PasTool.ConvertTypedef added record: ',TypeH2PNode.DescAsString(CTool)]);
895 {$ENDIF}
896 // build recursively
897 BuildH2PTree(TypeH2PNode,SubChildNode.FirstChild);
898 // create an alias b=a
899 CurCName:=CurName;
900 TypeH2PNode:=CreateH2PNode(CurName,CurCName,CNode,
901 ctnTypeDefinition,SubTypeName);
902 {$IFDEF VerboseH2PasTool}
903 DebugLn(['TH2PasTool.ConvertTypedef added type alias: ',TypeH2PNode.DescAsString(CTool)]);
904 {$ENDIF}
905 end else if ChildNode.FirstChild.Desc=ccnSubDefs then begin
906 // for example: typedef struct {} b; => b = record
907 // => create a new record type b
908 SubChildNode:=ChildNode.LastChild;
909 CurCName:=CurName;
910 TypeH2PNode:=CreateH2PNode(CurName,CurCName,ChildNode,ctnRecordType,'');
911 {$IFDEF VerboseH2PasTool}
912 DebugLn(['TH2PasTool.ConvertTypedef added record: ',TypeH2PNode.DescAsString(CTool)]);
913 {$ENDIF}
914 // build recursively
915 BuildH2PTree(TypeH2PNode,SubChildNode.FirstChild);
916 end else if (ChildNode.FirstChild.Desc=ccnTypeName)
917 and (ChildNode.FirstChild.NextBrother=nil) then begin
918 // for example: typedef struct a b;
919 // => create a type alias b = a
920 TypeNode:=ChildNode.FirstChild;
921 SubTypeName:=GetIdentifier(@CTool.Src[TypeNode.StartPos]);
922 CurCName:=CurName;
923 TypeH2PNode:=CreateH2PNode(CurName,CurCName,CNode,
924 ctnTypeDefinition,SubTypeName);
925 {$IFDEF VerboseH2PasTool}
926 DebugLn(['TH2PasTool.ConvertTypedef added type alias: ',TypeH2PNode.DescAsString(CTool)]);
927 {$ENDIF}
928 end else begin
929 raise Exception.Create('TH2PasTool.ConvertTypedef inconsistency: unknown format of typedef struct');
930 end;
931 end;
932
933 ccnFunction: // typedef function
934 begin
935 CurName:=CTool.ExtractFunctionName(ChildNode);
936 CurType:=CTool.ExtractFunctionResultType(ChildNode,false,false);
937 IsPointerToFunction:=CTool.IsPointerToFunction(ChildNode);
hildNodenull938 SimpleType:=GetSimplePascalResultTypeOfCFunction(ChildNode);
andnull939 if IsPointerToFunction and (SimpleType='') then begin
940 // this function has a complex result type
941 TypeH2PNode:=CreateH2PNodeForComplexType(ChildNode,true,ParentNode<>nil);
942 if TypeH2PNode<>nil then
943 SimpleType:=TypeH2PNode.PascalName;
944 end;
andnull945 if IsPointerToFunction and (SimpleType<>'') then begin
946 CurCName:=CurName;
947 H2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnProcedureType,SimpleType,
948 nil,true);
949 {$IFDEF VerboseH2PasTool}
950 DebugLn(['TH2PasTool.ConvertTypedef function type added: ',H2PNode.DescAsString(CTool)]);
951 {$ENDIF}
952 // build the param list
953 if ChildNode.FirstChild<>nil then
954 BuildH2PTree(H2PNode,ChildNode.FirstChild);
955 end else begin
956 {$IFDEF VerboseH2PasTool}
957 DebugLn(['TH2PasTool.ConvertTypedef typdef function CurName=',CurName,' CurType=',CTool.ExtractFunctionResultType(ChildNode),' SimpleType=',SimpleType,' IsPointerToFunction=',IsPointerToFunction]);
958 DebugLn(['TH2PasTool.ConvertTypedef SKIPPING typedef ',CCNodeDescAsString(ChildNode.Desc),' at ',CTool.CleanPosToStr(CNode.StartPos)]);
959 {$ENDIF}
960 end;
961 end;
962
963 ccnEnumBlock: // enum block
964 begin
965 // this enum block has a name
966 CurCName:=CurName;
967 TypeH2PNode:=CreateH2PNode(CurName,CurCName,CNode,ctnEnumerationType,'',
968 nil,true);
969 {$IFDEF VerboseH2PasTool}
970 DebugLn(['TH2PasTool.ConvertTypedef added: ',TypeH2PNode.DescAsString(CTool)]);
971 {$ENDIF}
972
973 SubChildNode:=ChildNode.FirstChild;
974 while SubChildNode<>nil do begin
975 if SubChildNode.Desc=ccnEnumID then begin
976 CurName:=CTool.ExtractEnumIDName(SubChildNode);
977 CurValue:=CTool.ExtractEnumIDValue(SubChildNode);
978 CurCName:=CurName;
979 H2PNode:=CreateH2PNode(CurName,CurCName,SubChildNode,
980 ctnEnumIdentifier,CurValue,
981 TypeH2PNode,true);
982 {$IFDEF VerboseH2PasTool}
983 DebugLn(['TH2PasTool.ConvertTypedef added: ',H2PNode.DescAsString(CTool)]);
984 {$ENDIF}
985 end;
986 SubChildNode:=SubChildNode.NextBrother;
987 end;
988 end;
989
990 else // typedef
991 {$IFDEF VerboseH2PasTool}
992 DebugLn(['TH2PasTool.ConvertTypedef SKIPPING typedef ',CTool.NodeAsString(ChildNode)]);
993 {$ENDIF}
994 end;
995 end;
996
997 procedure TH2PasTool.ConvertDirective(CNode: TCodeTreeNode; ParentNode: TH2PNode);
998 var
999 Directive: String;
1000 H2PNode: TH2PNode;
1001 CurName: String;
1002 PascalCode: String;
1003 ErrorPos: integer;
1004 ErrorMsg: string;
1005 StartPos: LongInt;
1006 EndPos: LongInt;
1007 MacroName,MacroParamList,MacroValue: string;
1008 DirNode: TH2PDirectiveNode;
1009 Desc: TCodeTreeNodeDesc;
1010 begin
1011 Directive:=CTool.ExtractDirectiveAction(CNode);
1012 if Directive='include' then begin
1013 // #include <filename> // search independent of source position
1014 // #include "filename" // search dependent on source position
1015 if icspInclude in IgnoreCParts then
1016 exit;
1017 end else if Directive='define' then begin
1018 // #define macrofunction(a,b) a here, then b
1019 // #define simplemacro some text here
1020 if CTool.ExtractDefine(CNode,MacroName,MacroParamList,MacroValue)
1021 then begin
1022 CurName:='$'+Directive;
1023 H2PNode:=CreateH2PNode(CurName,'#'+Directive,CNode,ctnNone,
1024 MacroName,ParentNode,false);
1025 {$IFDEF VerboseH2PasTool}
1026 DebugLn(['TH2PasTool.ConvertDirective added: ',H2PNode.DescAsString(CTool)]);
1027 {$ENDIF}
1028 DirNode:=CreateH2PDirectiveNode(H2PNode,h2pdnDefine);
1029 DirNode.MacroName:=MacroName;
1030 DirNode.MacroParams:=MacroParamList;
1031 if MacroValue='__BYTE_ORDER' then
1032 MacroValue:='FPC';
1033 DirNode.Expression:=MacroValue;
1034 exit;
1035 end;
1036 end else if (Directive='undef') or (Directive='ifdef')
1037 or (Directive='ifndef') then begin
1038 // #undef NAME
1039 // #ifdef NAME
1040 // #ifndef NAME
1041 CurName:='$'+Directive;
1042 PascalCode:=CTool.ExtractDirectiveFirstAtom(CNode);
1043 H2PNode:=CreateH2PNode(CurName,'#'+Directive,CNode,ctnNone,
1044 PascalCode,ParentNode,false);
1045 {$IFDEF VerboseH2PasTool}
1046 DebugLn(['TH2PasTool.ConvertDirective added: ',H2PNode.DescAsString(CTool)]);
1047 {$ENDIF}
1048 if (Directive='ifdef') then
1049 Desc:=h2pdnIfDef
1050 else if (Directive='ifndef') then
1051 Desc:=h2pdnIfNDef
1052 else
1053 Desc:=h2pdnUndefine;
1054 DirNode:=CreateH2PDirectiveNode(H2PNode,Desc);
1055 DirNode.MacroName:=PascalCode;
1056 if (Desc=h2pdnIfDef) or (Desc=h2pdnIfNDef) then begin
1057 // start block
1058 FCurDirectiveNode:=DirNode;
1059 end;
1060 exit;
1061 end else if (Directive='if') or (Directive='elif') then begin
1062 // #if EXPRESSION
1063 // #elif EXPRESSION
1064 CTool.MoveCursorToPos(CNode.StartPos+1);
1065 // read action
1066 CTool.ReadRawNextAtom;
1067 // convert expression
1068 StartPos:=CTool.SrcPos;
1069 EndPos:=CNode.EndPos;
1070 if not ConvertCToPascalDirectiveExpression(CTool.Src,StartPos,EndPos,
1071 PascalCode,ErrorPos,ErrorMsg) then
1072 begin
1073 {$IFDEF VerboseH2PasTool}
1074 DebugLn(['TH2PasTool.ConvertDirective failed to convert expression at ',
1075 CTool.CleanPosToStr(ErrorPos)+': '+ErrorMsg]);
1076 {$ENDIF}
1077 end else begin
1078 CurName:='$'+Directive;
1079 H2PNode:=CreateH2PNode(CurName,'#'+Directive,CNode,ctnNone,
1080 PascalCode,ParentNode,false);
1081 {$IFDEF VerboseH2PasTool}
1082 DebugLn(['TH2PasTool.ConvertDirective added: ',H2PNode.DescAsString(CTool)]);
1083 {$ENDIF}
1084 if (Directive='if') then
1085 Desc:=h2pdnIf
1086 else begin
1087 Desc:=h2pdnElseIf;
1088 // end block
1089 FCurDirectiveNode:=TH2PDirectiveNode(FCurDirectiveNode.Parent);
1090 end;
1091 DirNode:=CreateH2PDirectiveNode(H2PNode,Desc);
1092 DirNode.Expression:=PascalCode;
1093 // start block
1094 FCurDirectiveNode:=DirNode;
1095 exit;
1096 end;
1097 end else if (Directive='else') then begin
1098 // #else
1099 CurName:='$'+Directive;
1100 H2PNode:=CreateH2PNode(CurName,'#'+Directive,CNode,ctnNone,
1101 '',ParentNode,false);
1102 {$IFDEF VerboseH2PasTool}
1103 DebugLn(['TH2PasTool.ConvertDirective added: ',H2PNode.DescAsString(CTool)]);
1104 {$ENDIF}
1105 // end block
1106 FCurDirectiveNode:=TH2PDirectiveNode(FCurDirectiveNode.Parent);
1107 DirNode:=CreateH2PDirectiveNode(H2PNode,h2pdnElse);
1108 // start block
1109 FCurDirectiveNode:=DirNode;
1110 exit;
1111 end else if (Directive='endif') then begin
1112 // #endif
1113 CurName:='$'+Directive;
1114 H2PNode:=CreateH2PNode(CurName,'#'+Directive,CNode,ctnNone,
1115 '',ParentNode,false);
1116 {$IFDEF VerboseH2PasTool}
1117 DebugLn(['TH2PasTool.ConvertDirective added: ',H2PNode.DescAsString(CTool)]);
1118 {$ENDIF}
1119 // end block
1120 FCurDirectiveNode:=TH2PDirectiveNode(FCurDirectiveNode.Parent);
1121 DirNode:=CreateH2PDirectiveNode(H2PNode,h2pdnEndIf);
1122 exit;
1123 end else if Directive='line' then begin
1124 // #line: set the current line number -> ignore
1125 exit;
1126 end else if Directive='error' then begin
1127 // #error
1128 PascalCode:=CTool.ExtractCode(CNode.StartPos+length('#error'),
1129 CNode.EndPos);
1130 CurName:='$'+Directive;
1131 H2PNode:=CreateH2PNode(CurName,'#'+Directive,CNode,ctnNone,
1132 PascalCode,ParentNode,false);
1133 {$IFDEF VerboseH2PasTool}
1134 DebugLn(['TH2PasTool.ConvertDirective added $error: ',H2PNode.DescAsString(CTool)]);
1135 {$ENDIF}
1136 DirNode:=CreateH2PDirectiveNode(H2PNode,h2pdnError);
1137 DirNode.Expression:=PascalCode;
1138 exit;
1139 end else if Directive='pragma' then begin
1140 // #pragma: implementation specifics
1141 exit;
1142 end else if Directive='' then begin
1143 // # : null
1144 exit;
1145 end;
1146 {$IFDEF VerboseH2PasTool}
1147 DebugLn(['TH2PasTool.ConvertDirective SKIPPING directive at ',CTool.CleanPosToStr(CNode.StartPos),' Code="',dbgstr(CTool.ExtractCode(CNode.StartPos,CNode.EndPos)),'"']);
1148 {$ENDIF}
1149 end;
1150
ConvertCToPascalDirectiveExpressionnull1151 function TH2PasTool.ConvertCToPascalDirectiveExpression(const CCode: string;
1152 StartPos, EndPos: integer; out PasExpr: string;
1153 out ErrorPos: integer; out ErrorMsg: string): boolean;
1154 type
1155 TTokenType = (
1156 ttNone,
1157 ttValue,
1158 ttBinaryOperator,
1159 ttBracketOpen,
1160 ttBracketClose
1161 );
1162 var
1163 p: LongInt;
1164 AtomStart: integer;
1165 BracketLvl: Integer;
1166 LastToken: TTokenType;
1167 NeedBracket: Boolean;
1168
AtomIsnull1169 function AtomIs(const s: shortstring): boolean;
1170 var
1171 len: Integer;
1172 i: Integer;
1173 begin
1174 len:=length(s);
1175 if (len<>p-AtomStart) then exit(false);
1176 if p>EndPos then exit(false);
1177 for i:=1 to len do
1178 if CCode[AtomStart+i-1]<>s[i] then exit(false);
1179 Result:=true;
1180 end;
1181
GetAtomnull1182 function GetAtom: string;
1183 begin
1184 Result:=copy(CCode,AtomStart,p-AtomStart);
1185 end;
1186
1187 procedure ErrorExpectedButFound(const s: string);
1188 begin
1189 ErrorPos:=AtomStart;
1190 ErrorMsg:=s+' expected, but '+GetAtom+' found';
1191 end;
1192
1193 procedure Add(NewToken: TTokenType; const s: string);
1194 begin
1195 LastToken:=NewToken;
1196 if s='' then exit;
1197 if (IsIdentChar[s[1]])
1198 and (PasExpr<>'') and IsIdentChar[PasExpr[length(PasExpr)]] then
1199 PasExpr:=PasExpr+' ';
1200 PasExpr:=PasExpr+s;
1201 end;
1202
1203 procedure Add(NewToken: TTokenType);
1204 begin
1205 Add(NewToken,GetAtom);
1206 end;
1207
1208 procedure Replace(const OldText,NewText: string);
1209 var
1210 l: Integer;
1211 begin
1212 p:=1;
1213 l:=length(OldText);
1214 repeat
1215 ReadRawNextCAtom(PasExpr,p,AtomStart);
1216 if AtomStart>length(PasExpr) then break;
1217 if CompareMem(@PasExpr[AtomStart],@OldText[1],l)
1218 and ((not IsIdentChar[OldText[l]])
1219 or (AtomStart+l>length(PasExpr))
1220 or (not IsIdentChar[PasExpr[AtomStart+l]]))
1221 then begin
1222 {$IFDEF VerboseH2PasTool}
1223 DebugLn(['TH2PasTool.ConvertCToPascalDirectiveExpression.Replace Old="',OldText,'" New="',NewText,'"']);
1224 {$ENDIF}
1225 PasExpr:=copy(PasExpr,1,AtomStart-1)
1226 +NewText+copy(PasExpr,AtomStart+length(OldText),length(PasExpr));
1227 end;
1228 until false;
1229 end;
1230
1231 begin
1232 Result:=false;
1233 PasExpr:='';
1234 ErrorMsg:='';
1235 ErrorPos:=StartPos;
1236 LastToken:=ttNone;
1237 BracketLvl:=0;
1238 p:=StartPos;
1239 repeat
1240 ReadRawNextCAtom(CCode,p,AtomStart);
1241 if (AtomStart>=EndPos) or (CCode[AtomStart] in [#10,#13]) then begin
1242 if BracketLvl>0 then begin
1243 ErrorPos:=EndPos;
1244 ErrorMsg:='missing closing bracket';
1245 exit;
1246 end else if LastToken in [ttNone,ttBinaryOperator] then begin
1247 ErrorPos:=EndPos;
1248 ErrorMsg:='missing value';
1249 exit;
1250 end;
1251 Result:=true;
1252 break;
1253 end;
1254 if IsIdentChar[CCode[AtomStart]] then begin
1255 // value
1256 if LastToken in [ttValue,ttBracketClose] then begin
1257 ErrorPos:=AtomStart;
1258 ErrorMsg:='missing operator';
1259 exit;
1260 end;
1261 if AtomIs('defined') then begin
1262 Add(ttValue);
1263 // read defined(name) or defined name
1264 ReadRawNextCAtom(CCode,p,AtomStart);
1265 if AtomIs('(') then
1266 NeedBracket:=true
1267 else
1268 NeedBracket:=false;
1269 Add(ttBracketOpen);
1270 ReadRawNextCAtom(CCode,p,AtomStart);
1271 if (AtomStart>=EndPos) or (not IsIdentStartChar[CCode[AtomStart]])
1272 then begin
1273 ErrorExpectedButFound('identifier');
1274 exit;
1275 end;
1276 // convert defined(__BYTE_ORDER) to defined(FPC)
1277 if AtomIs('__BYTE_ORDER') then
1278 Add(ttValue,'FPC')
1279 else
1280 Add(ttValue);
1281 if NeedBracket then begin
1282 ReadRawNextCAtom(CCode,p,AtomStart);
1283 if not AtomIs(')') then begin
1284 ErrorExpectedButFound(')');
1285 exit;
1286 end;
1287 end;
1288 Add(ttBracketClose);
1289 end else begin
1290 Add(ttValue);
1291 end;
1292 end else if AtomIs('+') or AtomIs('-') or AtomIs('!') then begin
1293 if LastToken in [ttValue,ttBracketClose] then begin
1294 if AtomIs('!') then
1295 Add(ttBinaryOperator,'not')
1296 else
1297 Add(ttBinaryOperator);
1298 end else begin
1299 // just a modifier, not important for the type
1300 end;
1301 end else if AtomIs('*') or AtomIs('/') or AtomIs('!=') or AtomIs('==')
1302 then begin
1303 if LastToken in [ttValue,ttBracketClose] then begin
1304 if AtomIs('!=') then
1305 Add(ttBinaryOperator,'<>')
1306 else if AtomIs('==') then
1307 Add(ttBinaryOperator,'=')
1308 else
1309 Add(ttBinaryOperator);
1310 end else begin
1311 ErrorPos:=AtomStart;
1312 ErrorMsg:='value expected, but '+GetAtom+' found';
1313 exit;
1314 end;
1315 end else if AtomIs('(') then begin
1316 if LastToken in [ttNone,ttBinaryOperator] then begin
1317 Add(ttBracketOpen);
1318 inc(BracketLvl);
1319 end else begin
1320 ErrorPos:=AtomStart;
1321 ErrorMsg:='operator expected, but '+GetAtom+' found';
1322 exit;
1323 end;
1324 end else if AtomIs(')') then begin
1325 if BracketLvl=0 then begin
1326 ErrorPos:=AtomStart;
1327 ErrorMsg:='missing opening bracket';
1328 exit;
1329 end;
1330 if LastToken in [ttValue] then begin
1331 Add(ttBracketClose);
1332 dec(BracketLvl);
1333 end else begin
1334 ErrorPos:=AtomStart;
1335 ErrorMsg:='operator expected, but '+GetAtom+' found';
1336 exit;
1337 end;
1338 end else begin
1339 ErrorPos:=AtomStart;
1340 ErrorMsg:='invalid symbol '+GetAtom+' found';
1341 exit;
1342 end;
1343 until false;
1344
1345 // now convert a few common things:
1346 Replace('__BYTE_ORDER=__LITTLE_ENDIAN','defined(ENDIAN_LITTLE)');
1347 Replace('__LITTLE_ENDIAN=__BYTE_ORDER','defined(ENDIAN_LITTLE)');
1348 Replace('__BYTE_ORDER=__BIG_ENDIAN','defined(ENDIAN_BIG)');
1349 Replace('__BIG_ENDIAN=__BYTE_ORDER','defined(ENDIAN_BIG)');
1350 end;
1351
1352 procedure TH2PasTool.WriteStr(const Line: string);
1353 begin
1354 if Line='' then exit;
1355 FCurPasStream.Write(Line[1],length(Line));
1356 end;
1357
1358 procedure TH2PasTool.WriteLnStr(const Line: string);
1359 begin
1360 WriteStr(Line+LineEnding);
1361 end;
1362
1363 procedure TH2PasTool.W(const aStr: string);
1364 begin
1365 WriteLnStr(FCurIndentStr+aStr);
1366 end;
1367
1368 procedure TH2PasTool.IncIndent;
1369 begin
1370 FCurIndentStr:=FCurIndentStr+' ';
1371 end;
1372
1373 procedure TH2PasTool.DecIndent;
1374 begin
1375 FCurIndentStr:=copy(FCurIndentStr,1,length(FCurIndentStr)-2);
1376 end;
1377
1378 procedure TH2PasTool.SetPasSection(NewSection: TCodeTreeNodeDesc);
1379 begin
1380 if NewSection=FCurPasSection then exit;
1381 // close old section
1382 case FCurPasSection of
1383 ctnVarSection,ctnTypeSection,ctnConstSection:
1384 begin
1385 DecIndent;
1386 end;
1387 end;
1388 FCurPasSection:=NewSection;
1389 // start new section
1390 W('');
1391 case FCurPasSection of
1392 ctnVarSection,ctnTypeSection,ctnConstSection:
1393 begin
1394 case FCurPasSection of
1395 ctnVarSection: W('var');
1396 ctnTypeSection: W('type');
1397 ctnConstSection: W('const');
1398 end;
1399 IncIndent;
1400 end;
1401 end;
1402 end;
1403
1404 procedure TH2PasTool.WriteGlobalVarNode(H2PNode: TH2PNode);
1405 var
1406 PascalCode: String;
1407 begin
1408 // global variable
1409 SetPasSection(ctnVarSection);
1410 PascalCode:=H2PNode.PascalCode+';';
1411 if H2PNode.CName<>'' then begin
1412 PascalCode:=PascalCode+' cvar; ';
1413 if UseExternal then
1414 PascalCode:=PascalCode+'external'
1415 else
1416 PascalCode:=PascalCode+'public';
1417 if H2PNode.PascalName<>H2PNode.CName then begin
1418 PascalCode:=PascalCode+' name '''+H2PNode.CName+'''';
1419 end;
1420 PascalCode:=PascalCode+';';
1421 end;
1422 W(H2PNode.PascalName+': '+PascalCode);
1423 end;
1424
1425 procedure TH2PasTool.WriteGlobalTypeNode(H2PNode: TH2PNode);
1426 begin
1427 // global type
1428 SetPasSection(ctnTypeSection);
1429 if H2PNode.FirstChild=nil then begin
1430 W(H2PNode.PascalName+' = '+H2PNode.PascalCode+';');
1431 end else begin
1432 {$IFDEF VerboseH2PasTool}
1433 DebugLn(['TH2PasTool.WriteGlobalTypeNode SKIPPING ',H2PNode.DescAsString(CTool)]);
1434 {$ENDIF}
1435 end;
1436 end;
1437
1438 procedure TH2PasTool.WriteGlobalConstNode(H2PNode: TH2PNode);
1439 begin
1440 // global const
1441 SetPasSection(ctnConstSection);
1442 if H2PNode.FirstChild=nil then begin
1443 W(H2PNode.PascalName+H2PNode.PascalCode+';');
1444 end else begin
1445 {$IFDEF VerboseH2PasTool}
1446 DebugLn(['TH2PasTool.WriteGlobalTypeNode SKIPPING ',H2PNode.DescAsString(CTool)]);
1447 {$ENDIF}
1448 end;
1449 end;
1450
1451 procedure TH2PasTool.WriteGlobalProcedureNode(H2PNode: TH2PNode);
1452 var
1453 PascalCode: String;
1454 ChildNode: TH2PNode;
1455 NoNameCount: Integer;
1456 CurName: String;
1457 begin
1458 // global procedure or procedure type
1459 if H2PNode.PascalDesc=ctnProcedure then
1460 SetPasSection(ctnNone)
1461 else
1462 SetPasSection(ctnTypeSection);
1463 // create param list
1464 PascalCode:='';
1465 ChildNode:=TH2PNode(H2PNode.FirstChild);
1466 NoNameCount:=0;
1467 while ChildNode<>nil do begin
1468 if ChildNode.PascalDesc=ctnVarDefinition then begin
1469 if PascalCode<>'' then
1470 PascalCode:=PascalCode+'; ';
1471 CurName:=ChildNode.PascalName;
1472 if CurName='' then begin
1473 inc(NoNameCount);
1474 CurName:='param'+IntToStr(NoNameCount)
1475 +CreatePascalNameFromCCode(ChildNode.PascalCode);
1476 end;
1477 PascalCode:=PascalCode+CurName+': '+ChildNode.PascalCode;
1478 end else begin
1479 {$IFDEF VerboseH2PasTool}
1480 DebugLn(['TH2PasTool.WriteGlobalProcedureNode SKIPPING ',ChildNode.DescAsString(CTool)]);
1481 {$ENDIF}
1482 end;
1483 ChildNode:=TH2PNode(ChildNode.NextBrother);
1484 end;
1485 if PascalCode<>'' then
1486 PascalCode:='('+PascalCode+')';
1487 if H2PNode.PascalDesc=ctnProcedure then begin
1488 PascalCode:=H2PNode.PascalName+PascalCode;
1489 if H2PNode.PascalCode='void' then
1490 PascalCode:='procedure '+PascalCode
1491 else
1492 PascalCode:='function '+PascalCode+': '+H2PNode.PascalCode;
1493 PascalCode:=PascalCode+'; cdecl;';
1494 if H2PNode.CName<>'' then begin
1495 if H2PNode.CName<>H2PNode.PascalName then
1496 PascalCode:=PascalCode+' external name '''+H2PNode.CName+''';'
1497 else
1498 PascalCode:=PascalCode+' external;';
1499 end;
1500 end else begin
1501 if H2PNode.PascalCode='void' then
1502 PascalCode:='procedure'+PascalCode
1503 else
1504 PascalCode:='function'+PascalCode+': '+H2PNode.PascalCode;
1505 PascalCode:=PascalCode+'; cdecl;';
1506 PascalCode:=H2PNode.PascalName+' = '+PascalCode;
1507 end;
1508 W(PascalCode);
1509 end;
1510
1511 procedure TH2PasTool.WriteGlobalEnumerationTypeNode(H2PNode: TH2PNode);
1512 var
1513 PascalCode: String;
1514 ChildNode: TH2PNode;
1515 begin
1516 { for example:
1517 e2 = (
1518 a = 3,
1519 b = 9
1520 );
1521 }
1522 SetPasSection(ctnTypeSection);
1523 // write start
1524 PascalCode:=H2PNode.PascalName+' = (';
1525 W(PascalCode);
1526 // write enums
1527 IncIndent;
1528 ChildNode:=TH2PNode(H2PNode.FirstChild);
1529 while ChildNode<>nil do begin
1530 PascalCode:=ChildNode.PascalName;
1531 if ChildNode.PascalCode<>'' then
1532 PascalCode:=PascalCode+' = '+ChildNode.PascalCode;
1533 if ChildNode.NextBrother<>nil then
1534 PascalCode:=PascalCode+',';
1535 W(PascalCode);
1536 ChildNode:=TH2PNode(ChildNode.NextBrother);
1537 end;
1538 DecIndent;
1539 // write end
1540 W(');');
1541 end;
1542
1543 procedure TH2PasTool.WriteGlobalRecordTypeNode(H2PNode: TH2PNode);
1544 var
1545 PascalCode: String;
1546 ChildNode: TH2PNode;
1547 NoNameCount: Integer;
1548 SubChildNode: TH2PNode;
1549 begin
1550 { examples:
1551 TRecord = record
1552 end;
1553 }
1554 SetPasSection(ctnTypeSection);
1555 // write header
1556 PascalCode:=H2PNode.PascalName+' = record';
1557 W(PascalCode);
1558 // write sub variables
1559 IncIndent;
1560 ChildNode:=TH2PNode(H2PNode.FirstChild);
1561 while ChildNode<>nil do begin
1562 if ChildNode.PascalDesc=ctnVarDefinition then begin
1563 PascalCode:=ChildNode.PascalName+': '+ChildNode.PascalCode+';';
1564 W(PascalCode);
1565 end else if ChildNode.PascalDesc=ctnRecordCase then begin
1566 { record
1567 case longint of
1568 0: ( a: b );
1569 2: ( c: d );
1570 end;
1571 }
1572 // write header
1573 PascalCode:=ChildNode.PascalName+': record';
1574 W(PascalCode);
1575 IncIndent;
1576 // write children
1577 W('case longint of');
1578 IncIndent;
1579 NoNameCount:=0;
1580 SubChildNode:=TH2PNode(ChildNode.FirstChild);
1581 while SubChildNode<>nil do begin
1582 PascalCode:=IntToStr(NoNameCount)+': ('
1583 +SubChildNode.PascalName+': '+SubChildNode.PascalCode+' );';
1584 W(PascalCode);
1585 SubChildNode:=TH2PNode(SubChildNode.NextBrother);
1586 inc(NoNameCount);
1587 end;
1588 DecIndent;
1589 // write footer
1590 W('end;');
1591 DecIndent;
1592 end else begin
1593 {$IFDEF VerboseH2PasTool}
1594 DebugLn(['TH2PasTool.WriteGlobalRecordTypeNode SKIPPING record sub ',ChildNode.DescAsString(CTool)]);
1595 {$ENDIF}
1596 end;
1597 ChildNode:=TH2PNode(ChildNode.NextBrother);
1598 end;
1599 DecIndent;
1600 // write end
1601 W('end;');
1602 end;
1603
1604 procedure TH2PasTool.WriteDirectiveNode(DirNode: TH2PDirectiveNode);
1605 begin
1606 case DirNode.Desc of
1607 h2pdnIfDef:
1608 begin
1609 SetPasSection(ctnNone);
1610 W('{$IfDef '+DirNode.MacroName+'}');
1611 IncIndent;
1612 end;
1613 h2pdnIfNDef:
1614 begin
1615 SetPasSection(ctnNone);
1616 W('{$IfNDef '+DirNode.MacroName+'}');
1617 IncIndent;
1618 end;
1619 h2pdnIf:
1620 begin
1621 SetPasSection(ctnNone);
1622 W('{$If '+DirNode.Expression+'}');
1623 IncIndent;
1624 end;
1625 h2pdnElseIf:
1626 begin
1627 SetPasSection(ctnNone);
1628 DecIndent;
1629 W('{$ElseIf '+DirNode.Expression+'}');
1630 IncIndent;
1631 end;
1632 h2pdnElse:
1633 begin
1634 SetPasSection(ctnNone);
1635 DecIndent;
1636 W('{$Else}');
1637 IncIndent;
1638 end;
1639 h2pdnEndIf:
1640 begin
1641 SetPasSection(ctnNone);
1642 DecIndent;
1643 W('{$EndIf}');
1644 end;
1645 h2pdnError:
1646 begin
1647 SetPasSection(ctnNone);
1648 W('{$Error '+CreateDirectiveValue(DirNode.Expression)+'}');
1649 end;
1650 h2pdnUndefine:
1651 begin
1652 SetPasSection(ctnNone);
1653 W('{$UnDef '+DirNode.MacroName+'}');
1654 end;
1655 h2pdnDefine:
1656 if (DirNode.MacroParams='') then begin
1657 SetPasSection(ctnNone);
1658 if ExtractCCode(DirNode.Expression)='' then begin
1659 W('{$Define '+DirNode.MacroName+'}');
1660 end else begin
1661 W('{off $Define '+DirNode.MacroName+':='+CreateDirectiveValue(DirNode.Expression)+'}');
1662 end;
1663 end else begin
1664 {$IFDEF VerboseH2PasTool}
1665 DebugLn(['TH2PasTool.WriteDirectiveNode SKIPPING ',DirNode.DescAsString(CTool)]);
1666 {$ENDIF}
1667 end;
1668 else
1669 {$IFDEF VerboseH2PasTool}
1670 DebugLn(['TH2PasTool.WriteDirectiveNode SKIPPING ',DirNode.DescAsString(CTool)]);
1671 {$ENDIF}
1672 end;
1673 end;
1674
TH2PasTool.CreateDirectiveValuenull1675 function TH2PasTool.CreateDirectiveValue(const s: string): string;
1676 var
1677 p: Integer;
1678 begin
1679 Result:=s;
1680 p:=length(Result);
1681 while p>=1 do begin
1682 if (Result[p] in [#0..#31,'{','}']) then begin
1683 Result:=copy(Result,1,p-1)+'#'+IntToStr(ord(Result[p]))+copy(Result,p+1,length(Result));
1684 end;
1685 dec(p);
1686 end;
1687 end;
1688
1689 procedure TH2PasTool.SimplifyUndefineDirective(Node: TH2PDirectiveNode;
1690 var NextNode: TH2PDirectiveNode; var Changed: boolean);
1691 begin
1692 SimplifyMacroRedefinition(Node,'',hmsUndefined,NextNode,Changed);
1693 if Node=nil then exit;
1694 UndefineMacro(Node.MacroName,Node.H2PNode);
1695 end;
1696
1697 procedure TH2PasTool.SimplifyDefineDirective(Node: TH2PDirectiveNode;
1698 var NextNode: TH2PDirectiveNode; var Changed: boolean);
1699 { Examples:
1700
1701 Macro flag:
1702 #define MPI_FILE_DEFINED
1703 => $Define MPI_FILE_DEFINED
1704
1705 Simple constant:
1706 #define SOME_FLAG1 31
1707 => const SOME_FLAG1 = 31;
1708
1709 null pointer
1710 #define MPI_BOTTOM (void *)0
1711 => const MPI_BOTTOM = nil;
1712
1713 Alias:
1714 #define SOME_FLAG2 SOME_FLAG1
1715 => const SOME_FLAG2 = SOME_FLAG1;
1716 OR type SOME_FLAG2 = SOME_FLAG1;
1717
1718 Dummy function:
1719 #define htobs(d) (d)
1720 => comment
1721
1722 Function alias:
1723 #define htobs(d) bswap_16(d)
1724 => comment
1725
1726 Function without parameters:
1727 #define HIDPCONNADD _IOW('H', 200, int)
1728 => comment
1729 }
1730 var
1731 PasType: string;
1732 PasExpr: string;
1733 H2PNode: TH2PNode;
1734 begin
1735 if Node.H2PNode<>nil then
1736 MarkMacrosAsRead(Node.H2PNode,Node.Expression);
1737
1738 if (Node.H2PNode<>nil) and (Node.H2PNode.Parent<>nil) then begin
1739 // this directive is in a C block
1740 // ToDo: try to make it global
1741 if (Node.Parent<>nil) and (TH2PDirectiveNode(Node.Parent).Desc<>h2pdnRoot)
1742 then begin
1743 // this define is in a conditional
1744 end;
1745 exit;
1746 end;
1747
1748 if Node.MacroParams='' then begin
1749 // a macro without parameters
1750 if ExtractCCode(Node.Expression)='' then begin
1751 // example: #define MPI_FILE_DEFINED
1752 // => simple macro flag
1753 SimplifyMacroRedefinition(Node,'',hmsDefined,NextNode,Changed);
1754 if Node=nil then exit;
1755 DefineMacro(Node.MacroName,'',Node.H2PNode);
1756 end else if MacroValueIsConstant(Node,PasType,PasExpr) then begin
1757 // convert node to constant
1758 H2PNode:=Node.H2PNode;
1759 H2PNode.PascalName:=CreateUniquePascalName(Node.MacroName);
1760 H2PNode.CName:=Node.MacroName;
1761 H2PNode.PascalDesc:=ctnConstDefinition;
1762 H2PNode.PascalCode:=' = '+PasExpr;
1763 if PasType<>'' then
1764 H2PNode.PascalCode:=': '+PasType+H2PNode.PascalCode;
1765 FPascalNames.Add(H2PNode);
1766 FCNames.Add(H2PNode);
1767 DefineMacro(H2PNode.CName,PasExpr,nil);
1768 NextNode:=TH2PDirectiveNode(Node.NextSkipChilds);
1769 Node.H2PNode:=nil;
1770 H2PNode.Directive:=nil;
1771 DeleteDirectiveNode(Node,true,false);
1772 {$IFDEF VerboseH2PasTool}
1773 DebugLn(['TH2PasTool.SimplifyDefineDirective ADDED constant ',H2PNode.DescAsString(CTool)]);
1774 {$ENDIF}
1775 Changed:=true;
1776 end;
1777 end else begin
1778 DefineMacro(Node.MacroName,Node.Expression,Node.H2PNode);
1779 end;
1780 end;
1781
1782 procedure TH2PasTool.SimplifyIfDirective(Node: TH2PDirectiveNode;
1783 Expression: string; var NextNode: TH2PDirectiveNode;
1784 var Changed: boolean);
1785 begin
1786 if Node.H2PNode=nil then exit;
1787 MarkMacrosAsRead(Node.H2PNode,Expression);
1788
1789 if (Node.FirstChild=nil) and (Node.H2PNode.FirstChild=nil)
1790 and ((Node.NextBrother=nil)
1791 or (TH2PDirectiveNode(Node.NextBrother).H2PNode=Node.H2PNode.NextBrother))
1792 then begin
1793 // no content
1794 {$IFDEF VerboseH2PasTool}
1795 DebugLn(['TH2PasTool.SimplifyIfDirective REMOVING empty if directive: ',Node.DescAsString(CTool)]);
1796 {$ENDIF}
1797 if NextNode.HasAsParent(Node)
1798 or ((NextNode=Node.NextBrother) and (NextNode.Desc=h2pdnEndIf)) then
1799 NextNode:=TH2PDirectiveNode(NextNode.NextSkipChilds);
1800 DeleteDirectiveNode(Node,true,true);
1801 Changed:=true;
1802 exit;
1803 end;
1804
1805 Changed:=SimplifyIfDirectiveExpression(Expression);
1806 if Expression='0' then begin
1807 // always false
1808 {$IFDEF VerboseH2PasTool}
1809 DebugLn(['TH2PasTool.SimplifyIfDirective REMOVING directive, because always false: ',Node.DescAsString(CTool)]);
1810 {$ENDIF}
1811 if NextNode.HasAsParent(Node)
1812 or ((NextNode=Node.NextBrother) and (NextNode.Desc=h2pdnEndIf)) then
1813 NextNode:=TH2PDirectiveNode(NextNode.NextSkipChilds);
1814 DeleteDirectiveNode(Node,true,true);
1815 Changed:=true;
1816 exit;
1817 end;
1818
1819 if Changed and ((Node.Desc=h2pdnIf) or (Node.Desc=h2pdnElseIf)) then begin
1820 Node.Expression:=Expression;
1821 end;
1822 end;
1823
TH2PasTool.SimplifyIfDirectiveExpressionnull1824 function TH2PasTool.SimplifyIfDirectiveExpression(var Expression: string
1825 ): boolean;
1826 // returns true, if changed
1827 // uses current Undefines and Defines
1828 var
1829 p: Integer;
1830 AtomStart: integer;
1831 CurAtom: String;
1832 begin
1833 Result:=false;
1834 p:=1;
1835 repeat
1836 ReadRawNextCAtom(Expression,p,AtomStart);
1837 if AtomStart>length(Expression) then break;
1838 CurAtom:=copy(Expression,AtomStart,p-AtomStart);
1839 if CurAtom='' then ;
1840 until false;
1841 end;
1842
TH2PasTool.MacroValueIsConstantnull1843 function TH2PasTool.MacroValueIsConstant(Node: TH2PDirectiveNode;
1844 out PasType, PasExpression: string): boolean;
1845
TrimBracketsnull1846 function TrimBrackets(const s: string): string;
1847 begin
1848 Result:=s;
1849 end;
1850
1851 var
1852 AtomStart: integer;
1853 p: Integer;
1854
1855 procedure Replace(NewAtom: string);
1856 begin
1857 if IsIdentChar[NewAtom[1]]
1858 and (AtomStart>1) and (IsIdentChar[PasExpression[AtomStart-1]]) then
1859 NewAtom:=' '+NewAtom;
1860 if IsIdentChar[NewAtom[length(NewAtom)]]
1861 and (p<=length(PasExpression)) and (IsIdentChar[PasExpression[p]]) then
1862 NewAtom:=NewAtom+' ';
1863 PasExpression:=copy(PasExpression,1,AtomStart-1)+NewAtom
1864 +copy(PasExpression,p,length(PasExpression));
1865 p:=AtomStart+length(NewAtom);
1866 end;
1867
1868 var
1869 CurAtom: String;
1870 UsedNode: TH2PNode;
1871 begin
1872 //DebugLn(['TH2PasTool.MacroValueIsConstant ',Node.MacroName,':=',Node.Expression]);
1873 Result:=false;
1874 PasType:='';
1875 PasExpression:=TrimBrackets(Node.Expression);
1876
1877 // check for special constants
1878 if ExtractCCode(PasExpression)='(void*)0' then begin
1879 PasExpression:='nil';
1880 exit(true);
1881 end;
1882
1883 p:=1;
1884 repeat
1885 ReadRawNextCAtom(PasExpression,p,AtomStart);
1886 if AtomStart>length(PasExpression) then break;
1887 //DebugLn(['TH2PasTool.MacroValueIsConstant Atom=',copy(PasExpression,AtomStart,p-AtomStart)]);
1888 if IsIdentStartChar[PasExpression[AtomStart]] then begin
1889 CurAtom:=copy(PasExpression,AtomStart,p-AtomStart);
1890 if CurAtom='sizeof' then begin
isnull1891 // the sizeof(type) function is a C compiler built in function
1892 // read (
1893 ReadRawNextCAtom(PasExpression,p,AtomStart);
1894 if (AtomStart>length(PasExpression))
1895 or (PasExpression[AtomStart]<>'(') then break;
1896 // skip bracket content
1897 p:=AtomStart;
1898 ReadTilCBracketClose(PasExpression,p);
1899 AtomStart:=p-1;
1900 end else begin
1901 UsedNode:=FindH2PNodeWithCName(CurAtom);
1902 if (UsedNode<>nil) and (UsedNode.PascalDesc=ctnConstDefinition)
1903 then begin
1904 if UsedNode.PascalName<>CurAtom then
1905 Replace(UsedNode.PascalName);
1906 end else begin
1907 //
1908 {$IFDEF VerboseH2PasTool}
1909 DebugLn(['TH2PasTool.MacroValueIsConstant NO, because this is not a constant: ',CurAtom]);
1910 {$ENDIF}
1911 exit;
1912 end;
1913 end;
1914 end else if IsCHexNumber(PasExpression,AtomStart) then begin
1915 // hex number
1916 // replace 0x with $
1917 PasExpression:=copy(PasExpression,1,AtomStart-1)
1918 +'$'+copy(PasExpression,AtomStart+2,length(PasExpression));
1919 dec(p);
1920 if p-AtomStart>17 then begin
1921 // out of bounds
1922 {$IFDEF VerboseH2PasTool}
1923 DebugLn(['TH2PasTool.MacroValueIsConstant hex number out of bounds: "',PasExpression,'"']);
1924 {$ENDIF}
1925 exit;
1926 end;
1927 end else if IsCOctalNumber(PasExpression,AtomStart) then begin
1928 // octal number
1929 // replace 0 with &
1930 PasExpression[AtomStart]:='&';
1931 end else if IsCDecimalNumber(PasExpression,AtomStart) then begin
1932 // decimal number
1933 end else if PasExpression[AtomStart]='"' then begin
1934 PasExpression[AtomStart]:='''';
1935 PasExpression[p-1]:='''';
1936 end else begin
1937 CurAtom:=copy(PasExpression,AtomStart,p-AtomStart);
1938 if (CurAtom='(') or (CurAtom=')')
1939 or (CurAtom='+') or (CurAtom='-') then begin
1940 // same in pascal
1941 end else if (CurAtom='*') then begin
1942 // can be multiplication or dereference or pointer type
1943 if (AtomStart>1) and (IsNumberChar[PasExpression[AtomStart-1]]) then
1944 begin
1945 // is multiplication
1946 end else begin
1947 // don't know
1948 // At the moment all constants are allowed,
1949 // so it is most probable a multiplication
1950 end;
1951 end else if (CurAtom='|') or (CurAtom='||') then begin
1952 Replace('or');
1953 end else if (CurAtom='&') or (CurAtom='&&') then begin
1954 Replace('and');
1955 end else begin
1956 {$IFDEF VerboseH2PasTool}
1957 DebugLn(['TH2PasTool.MacroValueIsConstant NO ',CurAtom]);
1958 {$ENDIF}
1959 // unknown
1960 exit;
1961 end;
1962 end;
1963 until false;
1964 Result:=true;
1965 end;
1966
1967 procedure TH2PasTool.SimplifyMacroRedefinition(var Node: TH2PDirectiveNode;
1968 const NewValue: string; NewStatus: TH2PMacroStatus;
1969 var NextNode: TH2PDirectiveNode; var Changed: boolean);
1970 var
1971 Macro: TH2PMacroStats;
1972 Parent: TH2PBaseNode;
1973 begin
1974 if Node.MacroName='' then exit;
1975 Macro:=FindMacro(Node.MacroName);
1976 if Macro=nil then exit;
1977 if Macro.LastDefineNode=nil then exit;
1978 if Macro.LastReadNode=nil then begin
1979 // macro was read, so last define is needed
1980 if (Node.H2PNode<>nil)
1981 and (Macro.LastDefineNode.Parent=Node.H2PNode.Parent)
1982 and (Macro.Status=NewStatus) and (Macro.Value=NewValue) then
1983 begin
1984 // value is kept => the new Node is a redefinition
1985 if (NextNode=Node) or (Node.HasAsChild(NextNode)) then
1986 NextNode:=TH2PDirectiveNode(Node.NextSkipChilds);
1987 {$IFDEF VerboseH2PasTool}
1988 DebugLn(['TH2PasTool.SimplifyMacroRedefinition DELETE redefinition ',Node.DescAsString(CTool)]);
1989 {$ENDIF}
1990 DeleteDirectiveNode(Node,false,false);
1991 Node:=nil;
1992 Changed:=true;
1993 end;
1994 end else begin
1995 // macro was not read since last write
1996 Parent:=Macro.LastDefineNode.Parent;
1997 repeat
1998 if Parent=Node.Parent then begin
1999 // last write was on same or lower level
2000 // => last write is not needed
2001 {$IFDEF VerboseH2PasTool}
2002 DebugLn(['TH2PasTool.SimplifyMacroRedefinition DELETE unused ',Macro.LastDefineNode.DescAsString(CTool)]);
2003 {$ENDIF}
2004 DeleteH2PNode(Macro.LastDefineNode);
2005 Changed:=true;
2006 end;
2007 if Parent=nil then break;
2008 Parent:=Parent.Parent;
2009 until false;
2010 end;
2011 end;
2012
2013 procedure TH2PasTool.SimplifyUnusedDefines(Changed: boolean);
2014 var
2015 AVLNode: TAVLTreeNode;
2016 Macro: TH2PMacroStats;
2017 begin
2018 if Macros=nil then exit;
2019 AVLNode:=Macros.FindLowest;
2020 while AVLNode<>nil do begin
2021 Macro:=TH2PMacroStats(AVLNode.Data);
2022 if (Macro.LastDefineNode<>nil)
2023 and (Macro.LastReadNode=nil) then begin
2024 {$IFDEF VerboseH2PasTool}
2025 DebugLn(['TH2PasTool.SimplifyUnusedDefines DELETE unused ',Macro.LastDefineNode.DescAsString(CTool)]);
2026 {$ENDIF}
2027 DeleteH2PNode(Macro.LastDefineNode);
2028 Changed:=true;
2029 end;
2030 AVLNode:=Macros.FindSuccessor(AVLNode);
2031 end;
2032 if Changed then ;
2033 end;
2034
2035 procedure TH2PasTool.DeleteDirectiveNode(Node: TH2PDirectiveNode;
2036 DeleteChilds: boolean; AdaptNeighborhood: boolean);
2037 var
2038 Expression: String;
2039 Sibling: TH2PDirectiveNode;
2040 H2PNode: TH2PNode;
2041 EndIfNode: TH2PDirectiveNode;
2042 begin
2043 if (Node.H2PNode<>nil) and (Node.H2PNode.FirstChild<>nil) then begin
2044 raise Exception.Create('TH2PasTool.DeleteDirectiveNode: inconsistency: a directive can not have H2P children');
2045 end;
2046 {$IFDEF VerboseH2PasTool}
2047 DebugLn(['TH2PasTool.DeleteDirectiveNode ',Node.DescAsString(CTool)]);
2048 {$ENDIF}
2049
2050 if AdaptNeighborhood then begin
2051 // adapt following Else and ElseIf directives
2052 Expression:='';
2053 case Node.Desc of
2054 h2pdnIf,h2pdnElseIf: Expression:='not ('+Node.Expression+')';
2055 h2pdnIfDef: Expression:='not defined('+Node.MacroName+')';
2056 h2pdnIfNDef: Expression:='defined('+Node.MacroName+')';
2057 end;
2058 if Expression<>'' then begin
2059 Sibling:=TH2PDirectiveNode(Node.NextBrother);
2060 while Sibling<>nil do begin
2061 case Sibling.Desc of
2062 h2pdnElseIf:
2063 begin
2064 Sibling.Expression:='('+Sibling.Expression+') and '+Expression;
2065 if (Sibling.PriorBrother=Node) and (Node.Desc<>h2pdnElseIf) then
2066 Sibling.Desc:=h2pdnIf;
2067 {$IFDEF VerboseH2PasTool}
2068 DebugLn(['TH2PasTool.DeleteDirectiveNode ADAPTED neighbour: ',Sibling.DescAsString(CTool)]);
2069 {$ENDIF}
2070 end;
2071 h2pdnElse:
2072 begin
2073 Sibling.Expression:=Expression;
2074 if (Sibling.PriorBrother=Node) and (Node.Desc<>h2pdnElseIf) then
2075 Sibling.Desc:=h2pdnIf
2076 else
2077 Sibling.Desc:=h2pdnElseIf;
2078 {$IFDEF VerboseH2PasTool}
2079 DebugLn(['TH2PasTool.DeleteDirectiveNode ADAPTED neighbour: ',Sibling.DescAsString(CTool)]);
2080 {$ENDIF}
2081 end;
2082 else break;
2083 end;
2084 Sibling:=TH2PDirectiveNode(Sibling.NextBrother);
2085 end;
2086 end;
2087 end;
2088
2089 // delete or move children
2090 if Node.FirstChild<>nil then begin
2091 if DeleteChilds then begin
2092 // delete directive children
2093 while Node.FirstChild<>nil do begin
2094 DeleteDirectiveNode(TH2PDirectiveNode(Node.FirstChild),true,false);
2095 end;
2096 end else begin
2097 // keep children
2098 // => move directive children one level up (in front of Node)
2099 if (Node.Desc<>h2pdnIf) and (Node.Desc<>h2pdnIfDef) and (Node.Desc<>h2pdnIfNDef)
2100 then
2101 raise Exception.Create('TH2PasTool.DeleteDirectiveNode: inconsistency: can not move children in front');
2102 DirectivesTree.MoveChildsInFront(Node);
2103 end;
2104 end;
2105
2106 H2PNode:=Node.H2PNode;
2107 if H2PNode<>nil then begin
2108 H2PNode.Directive:=nil; // avoid circle between DeleteH2PNode and DeleteDirectiveNode
2109 Node.H2PNode:=nil;
2110 DeleteH2PNode(H2PNode);
2111 end;
2112
2113 EndIfNode:=TH2PDirectiveNode(Node.NextBrother);
2114 if (EndIfNode<>nil) and (EndIfNode.Desc<>h2pdnEndIf) then
2115 EndIfNode:=nil;
2116
2117 DirectivesTree.DeleteNode(Node);
2118 if AdaptNeighborhood and (EndIfNode<>nil) then
2119 DeleteDirectiveNode(EndIfNode,true,false);
2120 end;
2121
2122 procedure TH2PasTool.DeleteH2PNode(Node: TH2PNode);
2123 var
2124 DirNode: TH2PDirectiveNode;
2125 AVLNode: TAVLTreeNode;
2126 Macro: TH2PMacroStats;
2127 begin
2128 {$IFDEF VerboseH2PasTool}
2129 DebugLn(['TH2PasTool.DeleteH2PNode ',Node.DescAsString(CTool)]);
2130 {$ENDIF}
2131 if Node.PascalName<>'' then
2132 FPascalNames.Remove(Node);
2133 if Node.CName<>'' then
2134 FCNames.Remove(Node);
2135 // delete children
2136 while Node.FirstChild<>nil do
2137 DeleteH2PNode(TH2PNode(Node.FirstChild));
2138 // delete directives
2139 DirNode:=Node.Directive;
2140 if DirNode<>nil then begin
2141 Node.Directive:=nil; // avoid circle between DeleteH2PNode and DeleteDirectiveNode
2142 DirNode.H2PNode:=nil;
2143 DeleteDirectiveNode(DirNode,false,true);
2144 end;
2145 // check references
2146 if Macros<>nil then begin
2147 AVLNode:=Macros.FindLowest;
2148 while AVLNode<>nil do begin
2149 Macro:=TH2PMacroStats(AVLNode.Data);
2150 if Macro.LastDefineNode=Node then
2151 Macro.LastDefineNode:=nil;
2152 if Macro.LastReadNode=Node then
2153 Macro.LastReadNode:=nil;
2154 AVLNode:=Macros.FindSuccessor(AVLNode);
2155 end;
2156 end;
2157 Tree.DeleteNode(Node);
2158 end;
2159
Convertnull2160 function TH2PasTool.Convert(CCode, PascalCode: TCodeBuffer): boolean;
2161 begin
2162 Result:=false;
2163
2164 if CTool=nil then
2165 CTool:=TCCodeParserTool.Create;
2166 // parse C header file
2167 CTool.Parse(CCode);
2168 {$IFDEF VerboseH2PasTool}
2169 CTool.WriteDebugReport;
2170 {$ENDIF}
2171
2172 BuildH2PTree;
2173
2174 SimplifyDirectives;
2175
2176 WritePascal(PascalCode);
2177
2178 Result:=true;
2179 end;
2180
2181 procedure TH2PasTool.BuildH2PTree(ParentNode: TH2PNode;
2182 StartNode: TCodeTreeNode);
2183 var
2184 CNode: TCodeTreeNode;
2185 NextCNode: TCodeTreeNode;
2186 begin
2187 {$IFDEF VerboseH2PasTool}
2188 if ParentNode<>nil then begin
2189 DebugLn(['TH2PasTool.BuildH2PTree ParentNode=',ParentNode.DescAsString(CTool)]);
2190 end else begin
2191 debugln(['TH2PasTool.BuildH2PTree START']);
2192 end;
2193 {$ENDIF}
2194 if ParentNode<>nil then begin
2195 if StartNode=nil then
2196 StartNode:=ParentNode.CNode.FirstChild;
2197 end else begin
2198 Tree.Clear;
2199 if StartNode=nil then
2200 StartNode:=CTool.Tree.Root;
2201 DirectivesTree.Clear;
2202 FCurDirectiveNode:=TH2PDirectiveNode.Create;
2203 FCurDirectiveNode.Desc:=h2pdnRoot;
2204 DirectivesTree.AddNodeAsLastChild(nil,FCurDirectiveNode);
2205 end;
2206 CNode:=StartNode;
2207 while CNode<>nil do begin
2208 {$IFDEF VerboseH2PasTool}
2209 if ParentNode<>nil then begin
2210 DebugLn(['TH2PasTool.BuildH2PTree Current ParentNode=',ParentNode.DescAsString(CTool),' CNode=',CCNodeDescAsString(CNode.Desc)]);
2211 end else begin
2212 DebugLn(['TH2PasTool.BuildH2PTree Current ParentNode=nil CNode=',CCNodeDescAsString(CNode.Desc)]);
2213 end;
2214 {$ENDIF}
2215 NextCNode:=CNode.NextSkipChilds;
2216 case CNode.Desc of
2217 ccnRoot, ccnExternBlock:
2218 NextCNode:=CNode.Next;
2219
2220 ccnTypedef:
2221 ConvertTypedef(CNode,ParentNode);
2222
2223 ccnDefinition:
2224 ConvertVariable(CNode,ParentNode);
2225
2226 ccnFunction:
2227 ConvertFunction(CNode,ParentNode);
2228
2229 ccnFuncParamList:
2230 NextCNode:=CNode.FirstChild;
2231
2232 ccnFuncParameter:
2233 ConvertFuncParameter(CNode,ParentNode);
2234
2235 ccnEnumBlock:
2236 ConvertEnumBlock(CNode,ParentNode);
2237
2238 ccnStruct:
2239 ConvertStruct(CNode,ParentNode);
2240
2241 ccnName: ;
2242
2243 ccnDirective:
2244 ConvertDirective(CNode,ParentNode);
2245 else
2246 {$IFDEF VerboseH2PasTool}
2247 DebugLn(['TH2PasTool.BuildH2PTree SKIPPING ',CCNodeDescAsString(CNode.Desc),' at ',CTool.CleanPosToStr(CNode.StartPos)]);
2248 {$ENDIF}
2249 end;
2250 // next C node
2251 if (ParentNode<>nil) and (not ParentNode.CNode.HasAsChild(NextCNode)) then
2252 NextCNode:=nil;
2253 CNode:=NextCNode;
2254 end;
2255 end;
2256
FindEnclosingIFNDEFnull2257 function TH2PasTool.FindEnclosingIFNDEF(CCode: TCodeBuffer): TCodeTreeNode;
2258 begin
2259 if CTool=nil then
2260 CTool:=TCCodeParserTool.Create;
2261 // parse C header file
2262 CTool.Parse(CCode);
2263 Result:=CTool.FindEnclosingIFNDEF;
2264 end;
2265
2266 procedure TH2PasTool.UndefineEnclosingIFNDEF(CCode: TCodeBuffer);
2267 var
2268 Node: TCodeTreeNode;
2269 MacroName: String;
2270 begin
2271 Node:=FindEnclosingIFNDEF(CCode);
2272 if Node=nil then exit;
2273 MacroName:=CTool.ExtractDirectiveFirstAtom(Node);
2274 if MacroName='' then exit;
2275 //DebugLn(['TH2PasTool.UndefineEnclosingIFNDEF UNDEFINE ',MacroName]);
2276 Undefines.Add(MacroName,'');
2277 end;
2278
2279 procedure TH2PasTool.SimplifyDirectives;
2280 (* Check and improve the following cases
2281 1.a {$DEFINE Name} and Name is never used afterwards -> disable
2282
2283 1.b {$DEFINE Name}
2284 ... Name is not used here ...
2285 {$DEFINE Name}
2286 -> disable first
2287
2288 2. {$IFDEF Name}... only comments and spaces ...{$ENDIF}
2289 -> disable the whole block
2290
2291 3. {$IFNDEF Name}
2292 ... only comments and spaces ...
2293 {$DEFINE Name}
2294 ... only comments and spaces ...
2295 {$ENDIF}
2296 -> disable the IFNDEF and the ENDIF and keep the DEFINE
2297 *)
2298 var
2299 Node: TH2PDirectiveNode;
2300 NextNode: TH2PDirectiveNode;
2301 Changed: Boolean;
2302 H2PNode: TH2PNode;
2303 begin
2304 // Undefines.WriteDebugReport;
2305 repeat
2306 Changed:=false;
2307 InitMacros;
2308 Node:=TH2PDirectiveNode(DirectivesTree.Root);
2309 while Node<>nil do begin
2310 NextNode:=TH2PDirectiveNode(Node.Next);
2311 // mark all read macros between this node and NextNode
2312 H2PNode:=Node.H2PNode;
2313 if (H2PNode<>nil)
2314 and (NextNode<>nil) and (NextNode.H2PNode<>nil) then begin
2315 while H2PNode<>NextNode.H2PNode do begin
2316 if H2PNode.Directive=nil then
2317 MarkMacrosAsRead(H2PNode,H2PNode.PascalCode);
2318 H2PNode:=TH2PNode(H2PNode.Next);
2319 end;
2320 end;
2321 // simplify directive
2322 case Node.Desc of
2323 h2pdnUndefine:
2324 SimplifyUndefineDirective(Node,NextNode,Changed);
2325 h2pdnDefine:
2326 SimplifyDefineDirective(Node,NextNode,Changed);
2327 h2pdnIfDef:
2328 SimplifyIfDirective(Node,'defined('+Node.MacroName+')',NextNode,Changed);
2329 h2pdnIfNDef:
2330 SimplifyIfDirective(Node,'not defined('+Node.MacroName+')',NextNode,Changed);
2331 h2pdnIf:
2332 SimplifyIfDirective(Node,Node.Expression,NextNode,Changed);
2333 end;
2334
2335 Node:=NextNode;
2336 end;
2337 SimplifyUnusedDefines(Changed);
2338 until not Changed;
2339 end;
2340
2341 procedure TH2PasTool.WritePascal(PascalCode: TCodeBuffer);
2342 var
2343 ms: TMemoryStream;
2344 NewSrc: string;
2345 begin
2346 ms:=TMemoryStream.Create;
2347 try
2348 WritePascalToStream(ms);
2349
2350 SetLength(NewSrc,ms.Size);
2351 if NewSrc<>'' then begin
2352 ms.Position:=0;
2353 ms.Read(NewSrc[1],length(NewSrc));
2354 end;
2355 PascalCode.Source:=NewSrc;
2356 finally
2357 ms.Free;
2358 end;
2359 end;
2360
2361 procedure TH2PasTool.WritePascalToStream(s: TStream);
2362 var
2363 H2PNode: TH2PNode;
2364 UsesClause: String;
2365 begin
2366 FCurIndentStr:='';
2367 FCurPasSection:=ctnNone;
2368 FCurPasStream:=s;
2369
2370 // write header
2371 if SourceName<>'' then begin
2372 W('unit '+SourceName+';');
2373 W('');
2374 W('{$mode objfpc}{$H+}');
2375 W('');
2376 W('interface');
2377 W('');
2378 end;
2379
2380 // write uses
2381 UsesClause:='ctypes';
2382 if UsesClause<>'' then begin
2383 W('uses');
2384 IncIndent;
2385 W(UsesClause+';');
2386 DecIndent;
2387 W('');
2388 end;
2389
2390 // write interface nodes
2391 H2PNode:=TH2PNode(Tree.Root);
2392 while H2PNode<>nil do begin
2393 case H2PNode.PascalDesc of
2394
2395 ctnVarDefinition:
2396 WriteGlobalVarNode(H2PNode);
2397
2398 ctnTypeDefinition:
2399 WriteGlobalTypeNode(H2PNode);
2400
2401 ctnConstDefinition:
2402 WriteGlobalConstNode(H2PNode);
2403
2404 ctnProcedure, ctnProcedureType:
2405 WriteGlobalProcedureNode(H2PNode);
2406
2407 ctnEnumerationType:
2408 WriteGlobalEnumerationTypeNode(H2PNode);
2409
2410 ctnRecordType:
2411 WriteGlobalRecordTypeNode(H2PNode);
2412
2413 ctnNone:
2414 if H2PNode.Directive<>nil then begin
2415 WriteDirectiveNode(H2PNode.Directive);
2416 end else begin
2417 {$IFDEF VerboseH2PasTool}
2418 DebugLn(['TH2PasTool.WritePascalToStream SKIPPING ',H2PNode.DescAsString(CTool)]);
2419 {$ENDIF}
2420 end
2421
2422 else
2423 {$IFDEF VerboseH2PasTool}
2424 DebugLn(['TH2PasTool.WritePascalToStream SKIPPING ',H2PNode.DescAsString(CTool)]);
2425 {$ENDIF}
2426 end;
2427 H2PNode:=TH2PNode(H2PNode.NextBrother);
2428 end;
2429
2430 // write implementation
2431 SetPasSection(ctnNone);
2432 W('implementation');
2433 W('');
2434
2435 // write end.
2436 W('end.');
2437
2438 FCurPasStream:=nil;
2439 FCurIndentStr:='';
2440 end;
2441
GetSimplePascalTypeOfCVarnull2442 function TH2PasTool.GetSimplePascalTypeOfCVar(CVarNode: TCodeTreeNode): string;
2443 begin
2444 Result:=CTool.ExtractDefinitionType(CVarNode);
2445 if Result='' then exit;
2446 Result:=ConvertSimpleCTypeToPascalType(Result,true);
2447 end;
2448
GetSimplePascalTypeOfCParameternull2449 function TH2PasTool.GetSimplePascalTypeOfCParameter(CParamNode: TCodeTreeNode
2450 ): string;
2451 begin
2452 Result:=CTool.ExtractParameterType(CParamNode);
2453 if Result='' then exit;
2454 if (Result='...') then
2455 Result:='array of const'
2456 else
2457 Result:=ConvertSimpleCTypeToPascalType(Result,true);
2458 end;
2459
GetSimplePascalTypeOfTypeDefnull2460 function TH2PasTool.GetSimplePascalTypeOfTypeDef(TypeDefNode: TCodeTreeNode
2461 ): string;
2462 begin
2463 Result:=CTool.ExtractTypeDefType(TypeDefNode,false);
2464 if Result='' then exit;
2465 Result:=ConvertSimpleCTypeToPascalType(Result,true);
2466 end;
2467
GetSimplePascalResultTypeOfCFunctionnull2468 function TH2PasTool.GetSimplePascalResultTypeOfCFunction(
2469 CFuncNode: TCodeTreeNode): string;
2470 begin
2471 Result:=CTool.ExtractFunctionResultType(CFuncNode,false,false);
2472 if Result='' then exit;
2473 Result:=ConvertSimpleCTypeToPascalType(Result,true);
2474 end;
2475
ConvertSimpleCTypeToPascalTypenull2476 function TH2PasTool.ConvertSimpleCTypeToPascalType(CType: string;
2477 UseSingleIdentifierAsDefault: boolean): string;
2478 // the type must be normalized. That means no directives,
2479 // no unneeded spaces, no tabs, no comments, no newlines.
2480 var
2481 p: Integer;
2482 CurAtomStart: integer;
2483
2484 function TestIsAtomAndRemove(const s: shortstring): boolean;
2485 begin
2486 if (p-CurAtomStart<>length(s))
2487 or (not CompareMem(@s[1],@CType[CurAtomStart],length(s))) then
2488 exit(false);
2489 Result:=true;
2490 // remove token
2491 if IsIdentStartChar[s[1]] then begin
2492 // token is a word => remove one space too
2493 if (CurAtomStart>1) and (CType[CurAtomStart-1]=' ') then
2494 dec(CurAtomStart)
2495 else if (p<=length(CType)) and (CType[p]=' ') then
2496 inc(p);
2497 end;
2498 // remove token
2499 CType:=copy(CType,1,CurAtomStart-1)+copy(CType,p,length(CType));
2500 p:=CurAtomStart;
2501 //DebugLn(['TH2PasTool.ConvertSimpleCTypeToPascalType CType="',CType,'"']);
2502 end;
2503
2504 begin
2505 // remove 'const' and 'struct'
2506 p:=1;
2507 repeat
2508 ReadRawNextCAtom(CType,p,CurAtomStart);
2509 if CurAtomStart>length(CType) then break;
2510 //DebugLn(['TH2PasTool.ConvertSimpleCTypeToPascalType Atom=',copy(CType,CurAtomStart,p-CurAtomStart)]);
2511 TestIsAtomAndRemove('const');
2512 until false;
2513 // seach in predefined ctypes
2514 Result:=PredefinedCTypes[CType];
2515
2516 if (Result='') and (UseSingleIdentifierAsDefault) and IsValidIdent(CType) then
2517 Result:=CType;
2518 end;
2519
CreateH2PNodenull2520 function TH2PasTool.CreateH2PNode(var PascalName: string; const CName: string;
2521 CNode: TCodeTreeNode; PascalDesc: TCodeTreeNodeDesc;
2522 const PascalCode: string;
2523 ParentNode: TH2PNode; IsGlobal: boolean; InsertAsPreLast: boolean): TH2PNode;
2524 begin
2525 if (PascalDesc<>ctnNone) and IsValidIdent(PascalName) then
2526 begin
2527 if WordIsKeyWord.DoItCaseInsensitive(PChar(PascalName)) then begin
2528 // C name is keyword => auto rename
2529 PascalName:=PascalName+'_';
2530 end;
2531 if IsGlobal then
2532 PascalName:=CreateUniquePascalName(PascalName);
2533 end;
2534
2535 Result:=TH2PNode.Create;
2536 Result.PascalName:=PascalName;
2537 Result.CName:=CName;
2538 Result.CNode:=CNode;
2539 Result.PascalDesc:=PascalDesc;
2540 Result.PascalCode:=PascalCode;
2541 if InsertAsPreLast then
2542 Tree.AddNodeAsPreLastChild(ParentNode,Result)
2543 else
2544 Tree.AddNodeAsLastChild(ParentNode,Result);
2545 if IsGlobal then begin
2546 if PascalName<>'' then
2547 FPascalNames.Add(Result);
2548 if CName<>'' then
2549 FCNames.Add(Result);
2550 end;
2551 end;
2552
CreateAutoGeneratedH2PNodenull2553 function TH2PasTool.CreateAutoGeneratedH2PNode(var PascalName: string;
2554 CNode: TCodeTreeNode; PascalDesc: TCodeTreeNodeDesc;
2555 const PascalCode: string;
2556 ParentNode: TH2PNode;
2557 IsGlobal: boolean; InsertAsPreLast: boolean): TH2PNode;
2558
2559 function Check(TestName: string; out Node: TH2PNode): boolean;
2560 begin
2561 Node:=FindH2PNodeWithPascalName(TestName);
2562 if (Node=nil) then begin
2563 Node:=CreateH2PNode(TestName,'',CNode,PascalDesc,PascalCode,nil,
2564 true,InsertAsPreLast);
2565 Result:=true;
2566 end else if ((Node.CNode=CNode) and (Node.PascalDesc=PascalDesc)
2567 and (Node.PascalCode=PascalCode)
2568 and (Node.Parent=ParentNode))
2569 then begin
2570 Result:=true;
2571 end else begin
2572 Result:=false;
2573 Node:=nil;
2574 end;
2575 end;
2576
2577 var
2578 i: Integer;
2579 begin
2580 Result:=nil;
2581 if IsGlobal then ;
2582 if Check(PascalName,Result) then exit;
2583 i:=1;
2584 while not Check(PascalName+'_'+IntToStr(i),Result) do
2585 inc(i);
2586 end;
2587
CreateH2PNodeForComplexTypenull2588 function TH2PasTool.CreateH2PNodeForComplexType(CNode: TCodeTreeNode;
2589 CreateIfNotExists: boolean; InsertAsPreLast: boolean): TH2PNode;
2590 var
2591 CCode: String;
2592 PascalName: String;
2593 AtomStart: integer;
2594 p: Integer;
2595 CurAtom: String;
2596 BaseCType: String;
2597 BasePascalType: String;
2598 NewBasePascalType: String;
2599 SubH2PNode: TH2PNode;
2600 PascalCode: String;
2601 ConstantStartPos: LongInt;
2602 ConstantEndPos: LongInt;
2603 ConstantCode: String;
2604 ConstantNumber: int64;
2605 BracketOpenPos: LongInt;
2606 NeedH2PNode: Boolean;
2607 SubCNode: TCodeTreeNode;
2608 begin
2609 Result:=nil;
2610 if CreateIfNotExists then ;
2611 if (CNode.Desc=ccnDefinition) and (CNode.FirstChild<>nil) then begin
2612 SubCNode:=CNode.FirstChild;
2613 if SubCNode.Desc=ccnName then
2614 SubCNode:=SubCNode.NextBrother;
2615 if (SubCNode<>nil) then begin
2616 if (SubCNode.Desc=ccnEnumBlock) then begin
2617 Result:=ConvertEnumBlock(SubCNode,nil);
2618 exit;
2619 end;
2620 if (SubCNode.Desc=ccnStruct) then begin
2621 Result:=ConvertStruct(SubCNode,nil);
2622 exit;
2623 end;
2624 if SubCNode.Desc<>ccnConstant then begin
2625 {$IFDEF VerboseH2PasTool}
2626 debugln(['TH2PasTool.GetH2PNodeForComplexType TODO: ',CCNodeDescAsString(CNode.Desc),' of ',CCNodeDescAsString(SubCNode.Desc)]);
2627 {$ENDIF}
2628 exit;
2629 end;
2630 end;
2631 end;
2632
2633 SubH2PNode:=nil;
2634 {$IFDEF VerboseH2PasTool}
2635 debugln(['TH2PasTool.GetH2PNodeForComplexType CNode=',CCNodeDescAsString(CNode.Desc)]);
2636 {$ENDIF}
2637 if CNode.Desc=ccnDefinition then
2638 CCode:=CTool.ExtractDefinitionType(CNode)
2639 else if CNode.Desc=ccnFunction then
2640 CCode:=CTool.ExtractFunctionResultType(CNode)
2641 else if CNode.Desc=ccnFuncParameter then
2642 CCode:=CTool.ExtractParameterType(CNode)
2643 else if CNode.Desc=ccnTypedef then
2644 CCode:=CTool.ExtractTypeDefType(CNode)
2645 else begin
2646 {$IFDEF VerboseH2PasTool}
2647 debugln(['TH2PasTool.GetH2PNodeForComplexType not supported: CNode=',CCNodeDescAsString(CNode.Desc)]);
2648 {$ENDIF}
2649 exit;
2650 end;
2651
2652 {$IFDEF VerboseH2PasTool}
2653 DebugLn(['TH2PasTool.GetH2PNodeForComplexType CCode="',CCode,'"']);
2654 {$ENDIF}
2655 { int[][3] -> array of array[0..2] of cint
2656 char** -> PPchar
2657 int *[15] -> array[0..14] of pcint
2658
2659 }
2660 // read identifiers
2661 p:=1;
2662 BaseCType:='';
2663 repeat
2664 ReadRawNextCAtom(CCode,p,AtomStart);
2665 if AtomStart>length(CCode) then break;
2666 if IsIdentStartChar[CCode[AtomStart]] then begin
2667 CurAtom:=copy(CCode,AtomStart,p-AtomStart);
2668 if BaseCType<>'' then
2669 BaseCType:=BaseCType+' ';
2670 BaseCType:=BaseCType+CurAtom;
2671 end else
2672 break;
2673 until false;
2674 if BaseCType='' then begin
2675 {$IFDEF VerboseH2PasTool}
2676 DebugLn(['TH2PasTool.GetH2PNodeForComplexType no base type in c declaration: CCode="',dbgstr(CCode),'"']);
2677 {$ENDIF}
2678 exit;
2679 end;
2680 BasePascalType:=ConvertSimpleCTypeToPascalType(BaseCType,true);
2681 if (BasePascalType='') then begin
2682 {$IFDEF VerboseH2PasTool}
2683 DebugLn(['TH2PasTool.GetH2PNodeForComplexType unknown c type: "',BaseCType,'"']);
2684 {$ENDIF}
2685 exit;
2686 end;
2687 {$IFDEF VerboseH2PasTool}
2688 DebugLn(['TH2PasTool.GetH2PNodeForComplexType BasePascalType="',BasePascalType,'" BaseCType="',BaseCType,'"']);
2689 {$ENDIF}
2690
2691 // read pointer(s)
2692 while (AtomStart<=length(CCode)) do begin
2693 CurAtom:=copy(CCode,AtomStart,p-AtomStart);
2694 if (CurAtom='*') then begin
2695 BaseCType:=BaseCType+'*';
2696 NewBasePascalType:=ConvertSimpleCTypeToPascalType(BaseCType,true);
2697 if NewBasePascalType<>'' then begin
2698 // for this pointer type exists already a predefined simple type
2699 end else begin
2700 // a new pointer type is needed
2701 NewBasePascalType:='P'+BasePascalType;
2702 SubH2PNode:=CreateAutoGeneratedH2PNode(NewBasePascalType,nil,
2703 ctnTypeDefinition,'^'+BasePascalType,
2704 nil,true,InsertAsPreLast);
2705 {$IFDEF VerboseH2PasTool}
2706 DebugLn(['TH2PasTool.GetH2PNodeForComplexType added new pointer type: ',SubH2PNode.DescAsString(CTool)]);
2707 {$ENDIF}
2708 NewBasePascalType:=SubH2PNode.PascalName;
2709 end;
2710 BasePascalType:=NewBasePascalType;
2711 {$IFDEF VerboseH2PasTool}
2712 DebugLn(['TH2PasTool.GetH2PNodeForComplexType using pointer type: BasePascalType="',BasePascalType,'" BaseCType="',BaseCType,'"']);
2713 {$ENDIF}
2714 end else if (CurAtom='const') then begin
2715 // skip 'const'
2716 end else begin
2717 break;
2718 end;
2719 ReadRawNextCAtom(CCode,p,AtomStart);
2720 end;
2721
2722 PascalName:=BasePascalType;
2723 PascalCode:=PascalName;
2724
2725 // read arrays
2726 NeedH2PNode:=false;
2727 while (AtomStart<=length(CCode)) do begin
2728 CurAtom:=copy(CCode,AtomStart,p-AtomStart);
2729 if CurAtom='[' then begin
2730 NeedH2PNode:=true;
2731 BracketOpenPos:=AtomStart;
2732 ReadRawNextCAtom(CCode,p,AtomStart);
2733 if AtomStart>length(CCode) then begin
2734 {$IFDEF VerboseH2PasTool}
2735 DebugLn(['TH2PasTool.GetH2PNodeForComplexType untranslatable (missing ]): CCode="',dbgstr(CCode),'"']);
2736 {$ENDIF}
2737 exit;
2738 end;
2739 CurAtom:=copy(CCode,AtomStart,p-AtomStart);
2740 if CurAtom=']' then begin
2741 // [] -> open array
2742 PascalCode:='array of '+PascalCode;
2743 PascalName:='ArrayOf'+PascalName;
2744 //DebugLn(['TH2PasTool.GetTypeForVarType open array: ',PascalCode]);
2745 end else begin
2746 // [constant] -> array[0..constant-1]
2747 ConstantStartPos:=AtomStart;
2748 p:=BracketOpenPos;
2749 ReadTilCBracketClose(CCode,p);
2750 ConstantEndPos:=p-1;
2751 ConstantCode:=copy(CCode,ConstantStartPos,ConstantEndPos-ConstantStartPos);
2752 //DebugLn(['TH2PasTool.GetTypeForVarType ConstantCode="',ConstantCode,'"']);
2753 if CConstantToInt64(ConstantCode,ConstantNumber) then begin
2754 if ConstantNumber>0 then
2755 dec(ConstantNumber)
2756 else
2757 ConstantNumber:=0;
2758 ConstantCode:=IntToStr(ConstantNumber);
2759 end else begin
2760 ConstantCode:=ConstantCode+'-1';
2761 end;
2762 PascalCode:='array[0..'+ConstantCode+'] of '+PascalCode;
2763 PascalName:='Array0to'+CreatePascalNameFromCCode(ConstantCode)+'Of'+PascalName;
2764 //DebugLn(['TH2PasTool.GetTypeForVarType fixed array: ',PascalCode]);
2765 end;
2766 end else
2767 break;
2768 ReadRawNextCAtom(CCode,p,AtomStart);
2769 end;
2770 if NeedH2PNode then begin
2771 PascalName:='T'+PascalName;
2772 PascalName:=copy(PascalName,1,DefaultMaxPascalIdentLen);
2773 SubH2PNode:=CreateAutoGeneratedH2PNode(PascalName,nil,ctnTypeDefinition,
2774 PascalCode,nil,true,InsertAsPreLast);
2775 end;
2776
2777 // check if the whole declaration was translated
2778 if AtomStart<=length(CCode) then begin
2779 // unknown C type
2780 {$IFDEF VerboseH2PasTool}
2781 DebugLn(['TH2PasTool.GetTypeForVarType untranslatable: CCode="',dbgstr(CCode),'"']);
2782 {$ENDIF}
2783 exit;
2784 end;
2785
2786 {$IFDEF VerboseH2PasTool}
2787 DebugLn(['TH2PasTool.GetTypeForVarType CCode="',dbgstr(CCode),'" PascalName="',PascalName,'"']);
2788 {$ENDIF}
2789 Result:=SubH2PNode;
2790 end;
2791
CreatePascalNameFromCCodenull2792 function TH2PasTool.CreatePascalNameFromCCode(const CCode: string;
2793 StartPos: integer; EndPos: integer): string;
2794
2795 function Add(var PascalName: string; const Addition: string): boolean;
2796 begin
2797 Result:=true;
2798 if Addition='' then exit;
2799 if length(PascalName)+length(Addition)>DefaultMaxPascalIdentLen then
2800 exit(false);
2801 PascalName:=PascalName+Addition;
2802 end;
2803
2804 var
2805 p: Integer;
2806 AtomStart: integer;
2807 i: LongInt;
2808 c: Char;
2809 CurAtom: String;
2810 begin
2811 Result:='';
2812 if EndPos<1 then
2813 EndPos:=length(CCode)+1;
2814 p:=StartPos;
2815 if EndPos>length(CCode) then
2816 EndPos:=length(CCode);
2817 repeat
2818 ReadRawNextCAtom(CCode,p,AtomStart);
2819 if AtomStart>EndPos then exit;
2820
2821 if IsIdentStartChar[CCode[AtomStart]] then begin
2822 CurAtom:=copy(CCode,AtomStart,p-AtomStart);
2823 if (CurAtom<>'const')
2824 and (CurAtom<>'struct')
2825 and not Add(Result,CurAtom) then
2826 exit;
2827 end else begin
2828 if CCode[AtomStart] in ['0'..'9'] then begin
2829 CurAtom:=copy(CCode,AtomStart,p-AtomStart);
2830 for i:=AtomStart to p-1 do begin
2831 c:=CCode[i];
2832 if not IsIdentChar[c] then
2833 c:='_';
2834 if not Add(Result,c) then exit;
2835 end;
2836 end;
2837 end;
2838 until false;
2839 end;
2840
CreateUniquePascalNamenull2841 function TH2PasTool.CreateUniquePascalName(const CName: string): string;
2842 var
2843 i: Integer;
2844 begin
2845 Result:=CName;
2846 if FindH2PNodeWithPascalName(Result)=nil then exit;
2847 i:=1;
2848 repeat
2849 Result:=CName+'_'+IntToStr(i);
2850 if FindH2PNodeWithPascalName(Result)=nil then exit;
2851 inc(i);
2852 until false;
2853 end;
2854
FindH2PNodeWithPascalNamenull2855 function TH2PasTool.FindH2PNodeWithPascalName(const PascalName: string
2856 ): TH2PNode;
2857 var
2858 AVLNode: TAVLTreeNode;
2859 begin
2860 AVLNode:=FPascalNames.FindKey(Pointer(PascalName),
2861 @CompareStringWithH2PNodePascalName);
2862 if AVLNode<>nil then
2863 Result:=TH2PNode(AVLNode.Data)
2864 else
2865 Result:=nil;
2866 end;
2867
FindH2PNodeWithCNamenull2868 function TH2PasTool.FindH2PNodeWithCName(const CName: string): TH2PNode;
2869 var
2870 AVLNode: TAVLTreeNode;
2871 begin
2872 AVLNode:=FCNames.FindKey(Pointer(CName),
2873 @CompareStringWithH2PNodeCName);
2874 if AVLNode<>nil then
2875 Result:=TH2PNode(AVLNode.Data)
2876 else
2877 Result:=nil;
2878 end;
2879
CreateH2PDirectiveNodenull2880 function TH2PasTool.CreateH2PDirectiveNode(H2PNode: TH2PNode;
2881 Desc: TCodeTreeNodeDesc): TH2PDirectiveNode;
2882 begin
2883 Result:=TH2PDirectiveNode.Create;
2884 Result.Desc:=Desc;
2885 H2PNode.Directive:=Result;
2886 Result.H2PNode:=H2PNode;
2887 DirectivesTree.AddNodeAsLastChild(FCurDirectiveNode,Result);
2888 //DebugLn(['TH2PasTool.CreateH2PDirectiveNode Added ',Result.DescAsString,' ',FCurDirectiveNode.FirstChild<>nil]);
2889 end;
2890
2891 procedure TH2PasTool.WriteDebugReport;
2892 begin
2893 DebugLn(['TH2PasTool.WriteDebugReport ']);
2894 if CTool<>nil then
2895 CTool.WriteDebugReport;
2896 WriteH2PNodeReport;
2897 WriteH2PDirectivesNodeReport;
2898 end;
2899
2900 procedure TH2PasTool.WriteH2PNodeReport;
2901 var
2902 Node: TH2PBaseNode;
2903 begin
2904 if (Tree=nil) then begin
2905 DebugLn(['TH2PasTool.WriteH2PNodeReport Tree=nil']);
2906 end else if (Tree.Root=nil) then begin
2907 DebugLn(['TH2PasTool.WriteH2PNodeReport Tree.Root=nil']);
2908 end else begin
2909 //debugln(['TH2PasTool.WriteH2PNodeReport ']);
2910 Node:=Tree.Root;
2911 while Node<>nil do begin
2912 DebugLn([GetIndentStr(Node.GetLevel*2),Node.DescAsString(CTool)]);
2913 Node:=Node.Next;
2914 end;
2915 end;
2916 end;
2917
2918 procedure TH2PasTool.WriteH2PDirectivesNodeReport;
2919 var
2920 Node: TH2PBaseNode;
2921 begin
2922 if (DirectivesTree=nil) then begin
2923 DebugLn(['TH2PasTool.WriteH2PDirectivesNodeReport Tree=nil']);
2924 end else if (DirectivesTree.Root=nil) then begin
2925 DebugLn(['TH2PasTool.WriteH2PDirectivesNodeReport Tree.Root=nil']);
2926 end else begin
2927 Node:=DirectivesTree.Root;
2928 while Node<>nil do begin
2929 DebugLn([GetIndentStr(Node.GetLevel*2),Node.DescAsString(CTool)]);
2930 Node:=Node.Next;
2931 end;
2932 end;
2933 end;
2934
2935 constructor TH2PasTool.Create;
2936 begin
2937 FPredefinedCTypes:=DefaultPredefinedCTypes;
2938 Tree:=TH2PTree.Create;
2939 DirectivesTree:=TH2PTree.Create;
2940 FPascalNames:=TAVLTree.Create(@CompareH2PNodePascalNames);
2941 FCNames:=TAVLTree.Create(@CompareH2PNodeCNames);
2942 FIgnoreCParts:=[icspInclude];
2943 FDefines:=TStringToStringTree.Create(true);
2944 FUndefines:=TStringToStringTree.Create(true);
2945 UseExternal:=true;
2946 AddCommonCDefines;
2947 end;
2948
2949 destructor TH2PasTool.Destroy;
2950 begin
2951 FPredefinedCTypes:=nil;
2952 Clear;
2953 FreeAndNil(DirectivesTree);
2954 FreeAndNil(Tree);
2955 FreeAndNil(FPascalNames);
2956 FreeAndNil(FCNames);
2957 FreeAndNil(CTool);
2958 FreeAndNil(FDefines);
2959 FreeAndNil(FUndefines);
2960 inherited Destroy;
2961 end;
2962
2963 procedure TH2PasTool.Clear;
2964 begin
2965 FPascalNames.Clear;
2966 FCNames.Clear;
2967 Tree.Clear;
2968 DirectivesTree.Clear;
2969 ClearMacros;
2970 FDefines.Clear;
2971 FUndefines.Clear;
2972 AddCommonCDefines;
2973 end;
2974
2975 procedure TH2PasTool.AddCommonCDefines;
2976 begin
2977 Undefines['__cplusplus']:='1';// avoid C++ and use the easier c part
2978 Defines['__GNUC__']:='1';// assume the GNUC compiler
2979 end;
2980
2981 procedure TH2PasTool.ResetMacros;
2982 begin
2983 if Macros<>nil then
2984 Macros.FreeAndClear
2985 else
2986 Macros:=TAVLTree.Create(@CompareH2PMacroStats);
2987 end;
2988
2989 procedure TH2PasTool.ClearMacros;
2990 begin
2991 if Macros<>nil then begin
2992 Macros.FreeAndClear;
2993 FreeAndNil(Macros);
2994 end;
2995 end;
2996
2997 procedure TH2PasTool.InitMacros;
2998 var
2999 List: TStringList;
3000 i: Integer;
3001 CurName: string;
3002 CurValue: string;
3003 begin
3004 ResetMacros;
3005 if FDefines<>nil then begin
3006 List:=TStringList.Create;
3007 FDefines.GetNames(List);
3008 for i:=0 to List.Count-1 do begin
3009 CurName:=List[i];
3010 CurValue:=FDefines[CurName];
3011 DefineMacro(CurName,CurValue,nil);
3012 end;
3013 List.Free;
3014 end;
3015 if FUndefines<>nil then begin
3016 List:=TStringList.Create;
3017 FUndefines.GetNames(List);
3018 for i:=0 to List.Count-1 do begin
3019 CurName:=List[i];
3020 UndefineMacro(CurName,nil);
3021 end;
3022 List.Free;
3023 end;
3024 end;
3025
FindMacronull3026 function TH2PasTool.FindMacro(const MacroName: string;
3027 CreateIfNotExists: boolean): TH2PMacroStats;
3028 var
3029 AVLNode: TAVLTreeNode;
3030 begin
3031 Result:=nil;
3032 if Macros=nil then begin
3033 if not CreateIfNotExists then
3034 exit;
3035 Macros:=TAVLTree.Create(@CompareH2PMacroStats);
3036 end;
3037 AVLNode:=Macros.FindKey(Pointer(MacroName),
3038 @ComparePCharWithH2PMacroStats);
3039 if AVLNode<>nil then
3040 Result:=TH2PMacroStats(AVLNode.Data)
3041 else if CreateIfNotExists then begin
3042 Result:=TH2PMacroStats.Create;
3043 Result.Name:=MacroName;
3044 Result.Status:=hmsUnknown;
3045 Macros.Add(Result);
3046 end;
3047 end;
3048
DefineMacronull3049 function TH2PasTool.DefineMacro(const MacroName, AValue: string;
3050 DefineNode: TH2PNode): TH2PMacroStats;
3051 begin
3052 Result:=FindMacro(MacroName,true);
3053 Result.Value:=AValue;
3054 Result.Status:=hmsDefined;
3055 Result.LastDefineNode:=DefineNode;
3056 Result.LastReadNode:=nil;
3057 end;
3058
UndefineMacronull3059 function TH2PasTool.UndefineMacro(const MacroName: string;
3060 UndefineNode: TH2PNode): TH2PMacroStats;
3061 begin
3062 Result:=FindMacro(MacroName,true);
3063 Result.Value:='';
3064 Result.Status:=hmsUndefined;
3065 Result.LastDefineNode:=UndefineNode;
3066 Result.LastReadNode:=nil;
3067 end;
3068
3069 procedure TH2PasTool.MarkMacrosAsRead(Node: TH2PNode; const Src: string;
3070 StartPos: integer; EndPos: integer);
3071 var
3072 AtomStart: integer;
3073 begin
3074 if EndPos<1 then EndPos:=length(Src)+1;
3075 if EndPos>length(Src) then EndPos:=length(Src)+1;
3076 repeat
3077 ReadRawNextCAtom(Src,StartPos,AtomStart);
3078 if AtomStart>=EndPos then break;
3079 if IsIdentStartChar[Src[AtomStart]] then begin
3080 MarkMacroAsRead(GetIdentifier(@Src[AtomStart]),Node);
3081 end;
3082 until false;
3083 end;
3084
MarkMacroAsReadnull3085 function TH2PasTool.MarkMacroAsRead(const MacroName: string; Node: TH2PNode
3086 ): TH2PMacroStats;
3087 begin
3088 Result:=FindMacro(MacroName,false);
3089 if Result<>nil then
3090 Result.LastReadNode:=Node;
3091 end;
3092
3093 { TH2PNode }
3094
DescAsStringnull3095 function TH2PNode.DescAsString(CTool: TCCodeParserTool): string;
3096 begin
3097 if Self=nil then begin
3098 Result:='nil';
3099 exit;
3100 end;
3101 Result:='{PascalName="'+PascalName+'"';
3102 if PascalName<>CName then
3103 Result:=Result+',CName="'+CName+'"';
3104 Result:=Result+',PascalDesc="'+NodeDescriptionAsString(PascalDesc)+'"';
3105 if CNode<>nil then begin
3106 Result:=Result+',CNode='+CCNodeDescAsString(CNode.Desc);
3107 if CTool<>nil then
3108 Result:=Result+'('+CTool.CleanPosToStr(CNode.StartPos)+')';
3109 end else begin
3110 Result:=Result+', CNode=nil';
3111 end;
3112 if PascalCode<>'' then
3113 Result:=Result+',PascalCode="'+dbgstr(PascalCode)+'"';
3114 Result:=Result+'}';
3115 end;
3116
3117 { TH2PTree }
3118
3119 procedure TH2PTree.Unbind(Node: TH2PBaseNode);
3120 begin
3121 if Node=Root then Root:=Root.NextBrother;
3122 if Node=LastRoot then LastRoot:=LastRoot.PriorBrother;
3123 with Node do begin
3124 if (Parent<>nil) then begin
3125 if (Parent.FirstChild=Node) then
3126 Parent.FirstChild:=NextBrother;
3127 if (Parent.LastChild=Node) then
3128 Parent.LastChild:=PriorBrother;
3129 Parent:=nil;
3130 end;
3131 if NextBrother<>nil then NextBrother.PriorBrother:=PriorBrother;
3132 if PriorBrother<>nil then PriorBrother.NextBrother:=NextBrother;
3133 NextBrother:=nil;
3134 PriorBrother:=nil;
3135 end;
3136 dec(FNodeCount);
3137 end;
3138
3139 constructor TH2PTree.Create;
3140 begin
3141 Root:=nil;
3142 FNodeCount:=0;
3143 end;
3144
3145 destructor TH2PTree.Destroy;
3146 begin
3147 Clear;
3148 inherited Destroy;
3149 end;
3150
3151 procedure TH2PTree.Clear;
3152 var ANode: TH2PBaseNode;
3153 begin
3154 while Root<>nil do begin
3155 ANode:=Root;
3156 Root:=ANode.NextBrother;
3157 DeleteNode(ANode);
3158 end;
3159 end;
3160
3161 procedure TH2PTree.DeleteNode(ANode: TH2PBaseNode);
3162 begin
3163 if ANode=nil then exit;
3164 while (ANode.FirstChild<>nil) do DeleteNode(ANode.FirstChild);
3165 Unbind(ANode);
3166 ANode.Free;
3167 end;
3168
3169 procedure TH2PTree.AddNodeAsLastChild(ParentNode, ANode: TH2PBaseNode);
3170 begin
3171 if ParentNode=ANode then RaiseCatchableException('');
3172 ANode.Parent:=ParentNode;
3173 if Root=nil then begin
3174 // set as root
3175 Root:=ANode;
3176 while Root.Parent<>nil do Root:=Root.Parent;
3177 LastRoot:=Root;
3178 while LastRoot.NextBrother<>nil do
3179 LastRoot:=LastRoot.NextBrother;
3180 end else if ParentNode<>nil then begin
3181 if ParentNode.FirstChild=nil then begin
3182 // add as first child
3183 ParentNode.FirstChild:=ANode;
3184 ParentNode.LastChild:=ANode;
3185 end else begin
3186 // add as last child
3187 ANode.PriorBrother:=ParentNode.LastChild;
3188 ParentNode.LastChild:=ANode;
3189 if ANode.PriorBrother<>nil then ANode.PriorBrother.NextBrother:=ANode;
3190 end;
3191 end else begin
3192 // add as last brother of top nodes
3193 while (LastRoot.NextBrother<>nil) do LastRoot:=LastRoot.NextBrother;
3194 ANode.PriorBrother:=LastRoot;
3195 ANode.PriorBrother.NextBrother:=ANode;
3196 LastRoot:=ANode;
3197 while (LastRoot.NextBrother<>nil) do LastRoot:=LastRoot.NextBrother;
3198 end;
3199 inc(FNodeCount);
3200 end;
3201
3202 procedure TH2PTree.AddNodeAsPreLastChild(ParentNode, ANode: TH2PBaseNode);
3203 begin
3204 if (ParentNode=nil) and (LastRoot<>nil) then
3205 AddNodeInFrontOf(LastRoot,ANode)
3206 else if (ParentNode<>nil) and (ParentNode.FirstChild<>nil) then
3207 AddNodeInFrontOf(ParentNode.LastChild,ANode)
3208 else
3209 AddNodeAsLastChild(ParentNode,ANode);
3210 end;
3211
3212 procedure TH2PTree.AddNodeInFrontOf(NextBrotherNode, ANode: TH2PBaseNode);
3213 begin
3214 ANode.Parent:=NextBrotherNode.Parent;
3215 ANode.NextBrother:=NextBrotherNode;
3216 ANode.PriorBrother:=NextBrotherNode.PriorBrother;
3217 NextBrotherNode.PriorBrother:=ANode;
3218 if ANode.PriorBrother<>nil then
3219 ANode.PriorBrother.NextBrother:=ANode;
3220 if Root=NextBrotherNode then
3221 Root:=ANode;
3222 inc(FNodeCount);
3223 end;
3224
3225 procedure TH2PTree.MoveChildsInFront(ANode: TH2PBaseNode);
3226 var
3227 ChildNode: TH2PBaseNode;
3228 begin
3229 if ANode.FirstChild=nil then exit;
3230 ANode.LastChild.NextBrother:=ANode;
3231 if ANode.PriorBrother<>nil then begin
3232 ANode.FirstChild.PriorBrother:=ANode.PriorBrother;
3233 ANode.PriorBrother.NextBrother:=ANode.FirstChild;
3234 end;
3235 ANode.PriorBrother:=ANode.LastChild;
3236 if Root=ANode then Root:=ANode.FirstChild;
3237 ChildNode:=ANode.FirstChild;
3238 while ChildNode<>nil do begin
3239 ChildNode.Parent:=ANode.Parent;
3240 ChildNode:=ChildNode.NextBrother;
3241 end;
3242 ANode.FirstChild:=nil;
3243 ANode.LastChild:=nil;
3244 end;
3245
ContainsNodenull3246 function TH2PTree.ContainsNode(ANode: TH2PBaseNode): boolean;
3247 begin
3248 if ANode=nil then exit(false);
3249 while ANode.Parent<>nil do ANode:=ANode.Parent;
3250 while ANode.PriorBrother<>nil do ANode:=ANode.PriorBrother;
3251 Result:=ANode=Root;
3252 end;
3253
3254 procedure TH2PTree.ConsistencyCheck;
3255 // 0 = ok
3256 var RealNodeCount: integer;
3257
3258 procedure CountNodes(ANode: TH2PBaseNode);
3259 begin
3260 if ANode=nil then exit;
3261 inc(RealNodeCount);
3262 CountNodes(ANode.FirstChild);
3263 CountNodes(ANode.NextBrother);
3264 end;
3265
3266 begin
3267 if Root<>nil then begin
3268 Root.ConsistencyCheck;
3269 if Root.Parent<>nil then
3270 raise Exception.Create('Root.Parent<>nil');
3271 end;
3272 RealNodeCount:=0;
3273 CountNodes(Root);
3274 if RealNodeCount<>FNodeCount then
3275 raise Exception.Create('RealNodeCount<>FNodeCount');
3276 end;
3277
3278 procedure TH2PTree.WriteDebugReport(WithChildren: boolean);
3279 begin
3280 DebugLn('[TH2PTree.WriteDebugReport] Root=',dbgs(Root<>nil));
3281 if Root<>nil then
3282 Root.WriteDebugReport(' ',WithChildren);
3283 ConsistencyCheck;
3284 end;
3285
3286 { TH2PDirectiveNode }
3287
DescAsStringnull3288 function TH2PDirectiveNode.DescAsString(CTool: TCCodeParserTool): string;
3289 begin
3290 if Self=nil then begin
3291 Result:='nil';
3292 exit;
3293 end;
3294 Result:='{'+H2PDirectiveNodeDescriptionAsString(Desc);
3295 if (H2PNode<>nil) and (H2PNode.CNode<>nil) and (CTool<>nil) then begin
3296 Result:=Result+'('+CTool.CleanPosToStr(H2PNode.CNode.StartPos)+')';
3297 end;
3298 case Desc of
3299 h2pdnDefine,h2pdnUndefine,h2pdnIfDef,h2pdnIfNDef:
3300 Result:=Result+',MacroName="'+dbgstr(MacroName)+'"';
3301 end;
3302 case Desc of
3303 h2pdnDefine,h2pdnIf,h2pdnElseIf:
3304 Result:=Result+',Expression="'+dbgstr(Expression)+'"';
3305 end;
3306 Result:=Result+'}';
3307 end;
3308
3309 { TH2PBaseNode }
3310
Nextnull3311 function TH2PBaseNode.Next: TH2PBaseNode;
3312 begin
3313 if FirstChild<>nil then begin
3314 Result:=FirstChild;
3315 end else begin
3316 Result:=Self;
3317 while (Result<>nil) and (Result.NextBrother=nil) do
3318 Result:=Result.Parent;
3319 if Result<>nil then Result:=Result.NextBrother;
3320 end;
3321 end;
3322
NextSkipChildsnull3323 function TH2PBaseNode.NextSkipChilds: TH2PBaseNode;
3324 begin
3325 Result:=Self;
3326 while (Result<>nil) and (Result.NextBrother=nil) do
3327 Result:=Result.Parent;
3328 if Result<>nil then Result:=Result.NextBrother;
3329 end;
3330
Priornull3331 function TH2PBaseNode.Prior: TH2PBaseNode;
3332 begin
3333 if PriorBrother<>nil then begin
3334 Result:=PriorBrother;
3335 while Result.LastChild<>nil do
3336 Result:=Result.LastChild;
3337 end else
3338 Result:=Parent;
3339 end;
3340
HasAsParentnull3341 function TH2PBaseNode.HasAsParent(Node: TH2PBaseNode): boolean;
3342 var
3343 CurNode: TH2PBaseNode;
3344 begin
3345 Result:=false;
3346 if Node=nil then exit;
3347 CurNode:=Parent;
3348 while (CurNode<>nil) do begin
3349 if CurNode=Node then begin
3350 Result:=true;
3351 exit;
3352 end;
3353 CurNode:=CurNode.Parent;
3354 end;
3355 end;
3356
HasAsChildnull3357 function TH2PBaseNode.HasAsChild(Node: TH2PBaseNode): boolean;
3358 begin
3359 Result:=false;
3360 if Node=nil then exit;
3361 Result:=Node.HasAsParent(Self);
3362 end;
3363
GetLevelnull3364 function TH2PBaseNode.GetLevel: integer;
3365 var
3366 ANode: TH2PBaseNode;
3367 begin
3368 Result:=0;
3369 ANode:=Parent;
3370 while ANode<>nil do begin
3371 inc(Result);
3372 ANode:=ANode.Parent;
3373 end;
3374 end;
3375
3376 procedure TH2PBaseNode.ConsistencyCheck;
3377 begin
3378 if (Parent<>nil) then begin
3379 if (PriorBrother=nil) and (Parent.FirstChild<>Self) then
3380 raise Exception.Create('');
3381 if (NextBrother=nil) and (Parent.LastChild<>Self) then
3382 raise Exception.Create('');
3383 end;
3384 if (NextBrother<>nil) and (NextBrother.PriorBrother<>Self) then
3385 raise Exception.Create('');
3386 if (PriorBrother<>nil) and (PriorBrother.NextBrother<>Self) then
3387 raise Exception.Create('');
3388 if (FirstChild<>nil) then
3389 FirstChild.ConsistencyCheck;
3390 if NextBrother<>nil then
3391 NextBrother.ConsistencyCheck;
3392 end;
3393
3394 procedure TH2PBaseNode.WriteDebugReport(const Prefix: string;
3395 WithChildren: boolean; CTool: TCCodeParserTool);
3396 var
3397 Node: TH2PBaseNode;
3398 begin
3399 DebugLn([Prefix,DescAsString(CTool)]);
3400 if WithChildren then begin
3401 Node:=FirstChild;
3402 while Node<>nil do begin
3403 Node.WriteDebugReport(Prefix+' ',true,CTool);
3404 Node:=Node.NextBrother;
3405 end;
3406 end;
3407 end;
3408
3409 finalization
3410 FreeAndNil(InternalPredefinedCTypes);
3411
3412 end.
3413
3414