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 simple C parser.
25
26 Predefined C macros:
27 __LINE__ current source file line number as decimal
28 __FILE__ current source filename
29 __DATE__ current date: Apr 21 1990 or Jan 1 2008 (note the space in front of the 1)
30 __TIME__ current time "hh:mm:ss"
31 __STDC__ 1
32
33
34 }
35 // Predefined gcc macros:
36 // __attribute__((packed))
37 // Examples:
38 // typedef struct {
39 // uint8_t b[6];
40 // } __attribute__((packed)) bdaddr_t;
41 // struct __attribute__((packed)) {
42 // typeof(*(ptr)) __v;
43 // } *__p = (void *) (ptr);
44
45 //union _GFloatIEEE754
46 //{
47 // gfloat v_float;
48 // struct {
49 // guint mantissa : 23;
50 // guint biased_exponent : 8;
51 // guint sign : 1;
52 // } mpn;
53 //};
54
55 //ToDo:
56
57 // void * __strong _reserved0;
58
59 //struct {
60 // NSUInteger _isEmpty:1;
61 // NSUInteger _hasSingleRange:1;
62 // NSUInteger _cacheValid:1;
63 // NSUInteger _reservedArrayBinderController:29;
64 // } _indexSetFlags;
65 //
66 //_indexSetFlags: bitpacked record
67 // _isEmty: 0..1;
68 // _hasSingleRange: 0..1;
69 // _cacheValid: 0..1;
70 // _reservedArrayBinderController: 0..((1 shl 29)-1);
71 //end;
72
73 //union {
74 // struct {
75 // NSRange _range;
76 // } _singleRange;
77 // struct {
78 // void *__strong _data;
79 // void *_reserved;
80 // } _multipleRanges;
81 // } _internal;
82 //
83 //_internal: record
84 // case byte of
85 // 0: (_singleRange:
86 // record
87 // _range: NSRange;
88 // end;
89 // );
90 // 1: (_multipleRanges:
91 // record
92 // _data: pointer;
93 // _reserved: pointer;
94 // end;
95 // );
96 //end;
97
98 unit CCodeParserTool;
99
100 {$mode objfpc}{$H+}
101
102 interface
103
104 {$I codetools.inc}
105
106 {off $DEFINE VerboseCCodeParser}
107 {off $DEFINE VerboseCDirectives}
108
109 uses
110 {$IFDEF MEM_CHECK}
111 MemCheck,
112 {$ENDIF}
113 // RTL + FCL
114 Classes, SysUtils, Laz_AVL_Tree,
115 // CodeTools
116 FileProcs, BasicCodeTools, KeywordFuncLists, CodeCache, CodeTree,
117 NonPascalCodeTools, CodeToolsStructs,
118 // LazUtils
119 LazFileUtils, AvgLvlTree;
120
121 type
122 TCCodeNodeDesc = word;
123
124 const
125 // descriptors
126 ccnBase = 1000;
127 ccnNone = 0+ccnBase;
128
129 ccnRoot = 1+ccnBase;
130 ccnDirective = 2+ccnBase;// e.g. "#define a" ,can be multiple lines, EndPos at line end
131 ccnExternBlock = 3+ccnBase;// e.g. extern "C" {}
132 ccnEnumBlock = 4+ccnBase;// e.g. enum {};
133 ccnEnumID = 5+ccnBase;// e.g. name = value;
134 ccnConstant = 6+ccnBase;// e.g. 1
135 ccnTypedef = 7+ccnBase;// e.g. typedef int TInt; last child is ccnName
136 ccnStruct = 8+ccnBase;// e.g. struct{}, child is ccnTypeName or ccnTypeName+ccnSubDefs or ccnSubDefs
137 ccnUnion = 9+ccnBase;// e.g. union{}
138 ccnDefinition = 10+ccnBase;// e.g. variable: int i, type: struct typename {} or both: union typename {} varname
139 ccnFunction = 11+ccnBase;// e.g. int i()
140 ccnName = 12+ccnBase;// e.g. i
141 ccnTypeName = 13+ccnBase;// e.g. i
142 ccnSubDefs = 14+ccnBase;// e.g. the {} of a struct
143 ccnFuncParamList = 15+ccnBase;// e.g. ()
144 ccnFuncParameter = 16+ccnBase;// e.g. ()
145 ccnStatementBlock = 17+ccnBase;// e.g. {}
146 ccnBitCount = 18+ccnBase;// e.g. int i:3
147 ccnExternDef = 19+ccnBase;// e.g. extern int i;
148
149 // values for Node.SubDesc
150 ccnsNone = 0;
151 // values for Node.SubDesc if Node.Desc=ccnDirective
152 ccnsDirectiveIf = 1;
153 ccnsDirectiveIfDef = 2;
154 ccnsDirectiveIfNDef = 3;
155 ccnsDirectiveElIf = 4;
156 ccnsDirectiveElse = 5;
157 ccnsDirectiveEndIf = 6;
158 ccnsDirectiveDefine = 7;
159 ccnsDirectiveUndef = 8;
160 ccnsDirectiveInclude = 9;
161 ccnsDirectiveLine = 10;
162 ccnsDirectiveError = 11;
163 ccnsDirectivePragma = 12;
164
165 type
166 TCCodeParserTool = class;
167
168 { ECCodeParserException }
169
170 ECCodeParserException = class(Exception)
171 public
172 Sender: TCCodeParserTool;
173 constructor Create(ASender: TCCodeParserTool; const AMessage: string);
174 end;
175
176 TCCodeParserIfStackItem = record
177 StartPos: integer;
178 end;
179 PCCodeParserIfStackItem = ^TCCodeParserIfStackItem;
180
181 { TCCodeParserTool }
182
183 TCCodeParserTool = class
184 private
185 FChangeStep: integer;
186 FDefaultTokenList: TKeyWordFunctionList;
187 FIfStack: PCCodeParserIfStackItem;
188 FIfStackCapacity: integer;
189
OtherTokennull190 function OtherToken: boolean;
DirectiveTokennull191 function DirectiveToken: boolean;
ExternTokennull192 function ExternToken: boolean;
CurlyBracketCloseTokennull193 function CurlyBracketCloseToken: boolean;
194 procedure InitKeyWordList;
195
196 procedure InitParser;
197 procedure CreateChildNode(Desc: TCCodeNodeDesc);
198 procedure EndChildNode;
199 procedure CloseNodes;
200
201 procedure ReadDefinition(AsParameter: boolean);
202 procedure ReadParameterList;
203 procedure ReadEnum;
204 procedure ReadUnionStruct(IsStruct: boolean);
205 procedure ReadConstant;
206 procedure Read__attribute__;
207
208 procedure IncIfLevel(StartPos: integer);
209
210 procedure RaiseException(const AMessage: string; ReportPos: integer = 0);
211 procedure RaiseExpectedButAtomFound(const AToken: string; ReportPos: integer = 0);
212 public
213 Code: TCodeBuffer;
214 Src: string;
215 SrcLen: integer;
216 Tree: TCodeTree;
217 CurNode: TCodeTreeNode;
218 SrcPos: Integer;
219 AtomStart: integer;
220 IfLevel: integer;
221 ParseChangeStep: integer;// = Code.ChangeStep at the time of last Parse
222
223 VisibleEditorLines: integer;
224 JumpCentered: boolean;
225 CursorBeyondEOL: boolean;
226 ParseDirectives: boolean;// default is true
227
228 LastSrcPos: integer;
229 LastAtomStart: integer;
230
231 LastErrorMsg: string;
232 LastErrorPos: integer; // the position where the code does no make sense
233 LastErrorReportPos: integer; // if the position that gives a human a clue what went wrong
234 // normally LastErrorReportPos=LastErrorPos
235 // but if a closing bracket is missing LastErrorReportPos points
236 // to ( and ErrorPos to next atom
237
238 constructor Create;
239 destructor Destroy; override;
240 procedure Clear;
241
242 procedure Parse;
243 procedure Parse(aCode: TCodeBuffer);
UpdateNeedednull244 function UpdateNeeded: boolean;
245
FindDeepestNodeAtPosnull246 function FindDeepestNodeAtPos(P: integer;
247 ExceptionOnNotFound: boolean): TCodeTreeNode; inline;
FindDeepestNodeAtPosnull248 function FindDeepestNodeAtPos(StartNode: TCodeTreeNode; P: integer;
249 ExceptionOnNotFound: boolean): TCodeTreeNode;
CaretToCleanPosnull250 function CaretToCleanPos(Caret: TCodeXYPosition;
251 out CleanPos: integer): integer; // 0=valid CleanPos
252 //-1=CursorPos was skipped, CleanPos between two links
253 // 1=CursorPos beyond scanned code
254 //-2=X,Y beyond source
CleanPosToCodePosnull255 function CleanPosToCodePos(CleanPos: integer;
256 out CodePos:TCodePosition): boolean; // true=ok, false=invalid CleanPos
CleanPosToCaretnull257 function CleanPosToCaret(CleanPos: integer;
258 out Caret:TCodeXYPosition): boolean; // true=ok, false=invalid CleanPos
CleanPosToCaretAndTopLinenull259 function CleanPosToCaretAndTopLine(CleanPos: integer;
260 out Caret:TCodeXYPosition; out NewTopLine: integer): boolean; // true=ok, false=invalid CleanPos
CleanPosToStrnull261 function CleanPosToStr(CleanPos: integer): string;
MainFilenamenull262 function MainFilename: string;
263
264 procedure MoveCursorToPos(p: integer);
265 procedure MoveCursorToNode(Node: TCodeTreeNode);
266 procedure ReadNextAtom;
267 procedure ReadNextAtomSkipDirectives;
268 procedure ReadRawNextAtom;
269 procedure UndoReadNextAtom;
ReadTilBracketClosenull270 function ReadTilBracketClose(ExceptionOnNotFound: boolean): boolean;
AtomIsnull271 function AtomIs(const s: shortstring): boolean;
AtomIsCharnull272 function AtomIsChar(const c: char): boolean;
AtomIsCharOfSetnull273 function AtomIsCharOfSet(const s: shortstring): boolean;
UpAtomIsnull274 function UpAtomIs(const s: shortstring): boolean;
AtomIsIdentifiernull275 function AtomIsIdentifier: boolean;
AtomIsStringConstantnull276 function AtomIsStringConstant: boolean;
AtomIsNumbernull277 function AtomIsNumber: boolean;
GetAtomnull278 function GetAtom: string;
LastAtomIsnull279 function LastAtomIs(const s: shortstring): boolean;
GetLastAtomnull280 function GetLastAtom: string;
ExtractCodenull281 function ExtractCode(StartPos, EndPos: integer;
282 WithDirectives: boolean = false): string;// extract code without comments
283
GetFirstNameNodenull284 function GetFirstNameNode(Node: TCodeTreeNode): TCodeTreeNode;
ExtractNamenull285 function ExtractName(NameNode: TCodeTreeNode): string;
ExtractDefinitionNamenull286 function ExtractDefinitionName(VarNode: TCodeTreeNode): string;
ExtractDefinitionTypenull287 function ExtractDefinitionType(VarNode: TCodeTreeNode;
288 WithDirectives: boolean = false): string;
ExtractTypeDefTypenull289 function ExtractTypeDefType(TypeDefNode: TCodeTreeNode;
290 WithDirectives: boolean = false): string;
ExtractFunctionNamenull291 function ExtractFunctionName(FuncNode: TCodeTreeNode): string;
GetFunctionParamListNodenull292 function GetFunctionParamListNode(Node: TCodeTreeNode): TCodeTreeNode;
ExtractFunctionParamListnull293 function ExtractFunctionParamList(FuncNode: TCodeTreeNode): string;
ExtractFunctionTypenull294 function ExtractFunctionType(FuncNode: TCodeTreeNode;
295 WithDirectives: boolean = false): string;
ExtractFunctionResultTypenull296 function ExtractFunctionResultType(FuncNode: TCodeTreeNode;
297 WithDirectives: boolean = false;
298 WithBrackets: boolean = true): string;
IsPointerToFunctionnull299 function IsPointerToFunction(FuncNode: TCodeTreeNode): boolean;
ExtractParameterNamenull300 function ExtractParameterName(ParamNode: TCodeTreeNode): string;
ExtractParameterTypenull301 function ExtractParameterType(ParamNode: TCodeTreeNode;
302 WithDirectives: boolean = false): string;
ExtractEnumBlockNamenull303 function ExtractEnumBlockName(EnumBlockNode: TCodeTreeNode): string;
ExtractEnumIDNamenull304 function ExtractEnumIDName(EnumIDNode: TCodeTreeNode): string;
ExtractEnumIDValuenull305 function ExtractEnumIDValue(EnumIDNode: TCodeTreeNode;
306 WithDirectives: boolean = false): string;
ExtractStructNamenull307 function ExtractStructName(StructNode: TCodeTreeNode): string;
ExtractUnionNamenull308 function ExtractUnionName(UnionNode: TCodeTreeNode): string;
ExtractTypedefNamenull309 function ExtractTypedefName(TypedefNode: TCodeTreeNode): string;
IsDirectivenull310 function IsDirective(DirectiveNode: TCodeTreeNode; const Action: shortstring): boolean;
ExtractDirectiveActionnull311 function ExtractDirectiveAction(DirectiveNode: TCodeTreeNode): string;
ExtractDirectiveFirstAtomnull312 function ExtractDirectiveFirstAtom(DirectiveNode: TCodeTreeNode): string;
ExtractDirectiveParamsnull313 function ExtractDirectiveParams(DirectiveNode: TCodeTreeNode): string;
ExtractDefinenull314 function ExtractDefine(DefineNode: TCodeTreeNode;
315 out MacroName, MacroParamList, MacroValue: string): boolean;
316
FindDirectiveBlockEndnull317 function FindDirectiveBlockEnd(InnerNode: TCodeTreeNode): TCodeTreeNode;
FindElseOrEndIfnull318 function FindElseOrEndIf(IfOrElseNode: TCodeTreeNode): TCodeTreeNode;// find corresponding #EndIf or #Else or #ElIf
FindEndIfnull319 function FindEndIf(IfOrElseNode: TCodeTreeNode): TCodeTreeNode;// find corresponding #EndIf
FindEnclosingIFNDEFnull320 function FindEnclosingIFNDEF: TCodeTreeNode;// finds the typical IFNDEF that encloses the whole header source
321
322 procedure Replace(FromPos, ToPos: integer; const NewSrc: string);
323
324 procedure IncreaseChangeStep;
325 procedure WriteDebugReport;
326 procedure CheckNodeTool(Node: TCodeTreeNode);
NodeAsStringnull327 function NodeAsString(Node: TCodeTreeNode): string;
328
329 property ChangeStep: integer read FChangeStep;
330 end;
331
332 { TCHeaderFileMerger }
333
334 TCHFileLink = record
335 MergedPos: integer;
336 Code: TCodeBuffer; // can be nil
337 SrcPos: integer;
338 end;
339 PCHFileLink = ^TCHFileLink;
340
341 TCHFileMergeFlag = (
342 chfmfIgnoreIncludes, // do not merge at includes, but simply append
343 chfmfAll // merge all files, otherwise merge only the first
344 );
345 TCHFileMergeFlags = set of TCHFileMergeFlag;
346
347 TCHeaderFileMerger = class
348 private
349 procedure AddLink(aMergedPos: integer; aCode: TCodeBuffer; aSrcPos: integer);
350 public
351 CombinedSource: TCodeBuffer;
352 LinkCount: integer;
353 Links: PCHFileLink;
354 LinksCapacity: integer;
355 Macros: TIdentStringToStringTree;
356 constructor Create;
357 destructor Destroy; override;
358 procedure Clear;
359 procedure Merge(SourceFiles: TStrings; CodeCache: TCodeCache;
360 const Flags: TCHFileMergeFlags);
361 procedure Merge(SourceBuffers: TFPList { list of TCodeBuffer };
362 const Flags: TCHFileMergeFlags);
MergedPosToOriginalnull363 function MergedPosToOriginal(MergedPos: integer;
364 out Code: TCodeBuffer; out CodePos: integer): boolean;
MergedPosToOriginalnull365 function MergedPosToOriginal(MergedX, MergedY: integer;
366 out Code: TCodeBuffer; out X, Y: integer): boolean;
LinkIndexOfMergedPosnull367 function LinkIndexOfMergedPos(MergedPos: integer): integer;
GetLinkLengthnull368 function GetLinkLength(Index: integer): integer;
369
370 procedure WriteDebugReport;
371 end;
372
CCNodeDescAsStringnull373 function CCNodeDescAsString(Desc: TCCodeNodeDesc; SubDesc: TCCodeNodeDesc = 0): string;
374 procedure InitCCodeKeyWordLists;
375
GetNodeIndentnull376 function GetNodeIndent(Node: TCodeTreeNode): string;
377
378 var
379 IsCCodeFunctionModifier: TKeyWordFunctionList = nil;
380 IsCCodeCustomOperator: TKeyWordFunctionList = nil;
381
382 implementation
383
384 var
385 KeyWordLists: TFPList;
386
CCNodeDescAsStringnull387 function CCNodeDescAsString(Desc: TCCodeNodeDesc; SubDesc: TCCodeNodeDesc): string;
388 begin
389 case Desc of
390 ccnNone : Result:='None';
391 ccnRoot : Result:='Root';
392 ccnDirective :
393 begin
394 Result:='Directive';
395 case SubDesc of
396 ccnsDirectiveIf : Result:=Result+'.If';
397 ccnsDirectiveIfDef : Result:=Result+'.IfDef';
398 ccnsDirectiveIfNDef : Result:=Result+'.IfNDef';
399 ccnsDirectiveElIf : Result:=Result+'.ElIf';
400 ccnsDirectiveElse : Result:=Result+'.Else';
401 ccnsDirectiveEndIf : Result:=Result+'.EndIf';
402 ccnsDirectiveDefine : Result:=Result+'.Define';
403 ccnsDirectiveUndef : Result:=Result+'.Undef';
404 ccnsDirectiveInclude : Result:=Result+'.Include';
405 ccnsDirectiveLine : Result:=Result+'.Line';
406 ccnsDirectiveError : Result:=Result+'.Error';
407 ccnsDirectivePragma : Result:=Result+'.Pragma';
408 end;
409 end;
410 ccnExternBlock : Result:='extern-block';
411 ccnEnumBlock : Result:='enum-block';
412 ccnEnumID : Result:='enum-ID';
413 ccnConstant : Result:='constant';
414 ccnTypedef : Result:='typedef';
415 ccnStruct : Result:='struct';
416 ccnUnion : Result:='union';
417 ccnDefinition : Result:='definition(var/type/const)';
418 ccnFunction : Result:='function';
419 ccnName : Result:='name';
420 ccnTypeName : Result:='type-name';
421 ccnSubDefs : Result:='sub-defs';
422 ccnFuncParamList : Result:='function-param-list';
423 ccnFuncParameter : Result:='function-parameter';
424 ccnStatementBlock: Result:='statement-block';
425 ccnBitCount : Result:='bit-count';
426 ccnExternDef : Result:='extern-def';
427 else Result:='?('+IntToStr(Desc)+')';
428 end;
429 end;
430
431 procedure InitCCodeKeyWordLists;
432 begin
433 if KeyWordLists<>nil then exit;
434 KeyWordLists:=TFPList.Create;
435
436 IsCCodeFunctionModifier:=TKeyWordFunctionList.Create('IsCCodeFunctionModifier');
437 KeyWordLists.Add(IsCCodeFunctionModifier);
438 with IsCCodeFunctionModifier do begin
439 Add('static' ,{$ifdef FPC}@{$endif}AllwaysTrue);
440 Add('inline' ,{$ifdef FPC}@{$endif}AllwaysTrue);
441 end;
442
443 IsCCodeCustomOperator:=TKeyWordFunctionList.Create('IsCCodeCustomOperator');
444 KeyWordLists.Add(IsCCodeCustomOperator);
445 with IsCCodeCustomOperator do begin
446 Add('+' ,{$ifdef FPC}@{$endif}AllwaysTrue);
447 Add('-' ,{$ifdef FPC}@{$endif}AllwaysTrue);
448 Add('*' ,{$ifdef FPC}@{$endif}AllwaysTrue);
449 Add('/' ,{$ifdef FPC}@{$endif}AllwaysTrue);
450 Add('|' ,{$ifdef FPC}@{$endif}AllwaysTrue);
451 Add('&' ,{$ifdef FPC}@{$endif}AllwaysTrue);
452 Add('=' ,{$ifdef FPC}@{$endif}AllwaysTrue);
453 Add('++' ,{$ifdef FPC}@{$endif}AllwaysTrue);
454 Add('--' ,{$ifdef FPC}@{$endif}AllwaysTrue);
455 Add('+=' ,{$ifdef FPC}@{$endif}AllwaysTrue);
456 Add('-=' ,{$ifdef FPC}@{$endif}AllwaysTrue);
457 Add('*=' ,{$ifdef FPC}@{$endif}AllwaysTrue);
458 Add('/=' ,{$ifdef FPC}@{$endif}AllwaysTrue);
459 Add('&=' ,{$ifdef FPC}@{$endif}AllwaysTrue);
460 Add('|=' ,{$ifdef FPC}@{$endif}AllwaysTrue);
461 Add('==' ,{$ifdef FPC}@{$endif}AllwaysTrue);
462 Add('!=' ,{$ifdef FPC}@{$endif}AllwaysTrue);
463 end;
464 end;
465
GetNodeIndentnull466 function GetNodeIndent(Node: TCodeTreeNode): string;
467 begin
468 if Node=nil then
469 Result:=''
470 else
471 Result:=GetIndentStr(Node.GetLevel*2);
472 end;
473
474 { TCHeaderFileMerger }
475
476 procedure TCHeaderFileMerger.AddLink(aMergedPos: integer; aCode: TCodeBuffer;
477 aSrcPos: integer);
478 begin
479 if LinkCount=LinksCapacity then begin
480 if LinksCapacity<4 then
481 LinksCapacity:=4
482 else
483 LinksCapacity:=LinksCapacity*2;
484 ReAllocMem(Links,LinksCapacity*SizeOf(TCHFileLink));
485 end;
486 with Links[LinkCount] do begin
487 MergedPos:=aMergedPos;
488 Code:=aCode;
489 SrcPos:=aSrcPos;
490 end;
491 inc(LinkCount);
492 end;
493
494 constructor TCHeaderFileMerger.Create;
495 begin
496 Macros:=TIdentStringToStringTree.Create(true);
497 end;
498
499 destructor TCHeaderFileMerger.Destroy;
500 begin
501 Clear;
502 FreeAndNil(Macros);
503 inherited Destroy;
504 end;
505
506 procedure TCHeaderFileMerger.Clear;
507 begin
508 FreeAndNil(CombinedSource);
509 ReAllocMem(Links,0);
510 LinkCount:=0;
511 LinksCapacity:=0;
512 end;
513
514 procedure TCHeaderFileMerger.Merge(SourceFiles: TStrings;
515 CodeCache: TCodeCache; const Flags: TCHFileMergeFlags);
516 var
517 SourceBuffers: TFPList;
518 i: Integer;
519 Buf: TCodeBuffer;
520 begin
521 Clear;
522 SourceBuffers:=TFPList.Create;
523 try
524 for i:=0 to SourceFiles.Count-1 do begin
525 Buf:=CodeCache.LoadFile(SourceFiles[i]);
526 if Buf=nil then
527 raise Exception.Create('TCHeaderFileCombine.Combine: ERROR loading file '+SourceFiles[i]);
528 SourceBuffers.Add(Buf);
529 end;
530 Merge(SourceBuffers,Flags);
531 finally
532 SourceBuffers.Free;
533 end;
534 end;
535
536 procedure TCHeaderFileMerger.Merge(SourceBuffers: TFPList;
537 const Flags: TCHFileMergeFlags);
538 var
539 MergedBuffers: TFPList; // list of TCodeBuffer
540 StrStream: TStringStream;
541
542 procedure Append(Code: TCodeBuffer; FromPos, EndPos: integer);
543
544 procedure Error(p: integer; const Msg: string);
545 var
546 Line: integer;
547 Column: integer;
548 s: String;
549 begin
550 Code.AbsoluteToLineCol(p,Line,Column);
551 s:=Code.Filename+'('+IntToStr(Line)+','+IntToStr(Column)+') Error: '+Msg;
552 raise Exception.Create(s);
553 end;
554
555 var
556 StartP: PChar;
557 AtomStart: integer;
558 p: LongInt;
559 MacroValue: string;
560 MacroNode: TAVLTreeNode;
561 MacroItem: PStringToStringItem;
562 Src: String;
563 BracketLvl: Integer;
564 begin
565 if FromPos<1 then FromPos:=1;
566 if EndPos>Code.SourceLength then EndPos:=Code.SourceLength+1;
567 if (EndPos<=FromPos) or (FromPos>Code.SourceLength) then exit;
568 p:=FromPos;
569 Src:=Code.Source;
570 while p<EndPos do begin
571 ReadRawNextCAtom(Src,p,AtomStart);
572 if AtomStart>=EndPos then break;
573 StartP:=@Src[AtomStart];
574 if (StartP^='#') and IsFirstNonSpaceCharInLine(Code.Source,AtomStart) then
575 begin
576 // directive
577 ReadRawNextCAtom(Src,p,AtomStart);
578 if AtomStart>=EndPos then break;
579 StartP:=@Src[AtomStart];
580 if (CompareIdentifiersCaseSensitive(StartP,'define')=0)
581 or (CompareIdentifiersCaseSensitive(StartP,'undef')=0)
582 or (CompareIdentifiersCaseSensitive(StartP,'ifdef')=0)
583 or (CompareIdentifiersCaseSensitive(StartP,'ifndef')=0)
584 then begin
585 // a ifdef/ifndef/define/undefine directive
586 // the next identifier must not be replaced as macro
587 ReadRawNextCAtom(Src,p,AtomStart);
588 if AtomStart>=EndPos then break;
589 end;
590 end
591 else if IsIdentStartChar[StartP^] then begin
592 MacroNode:=Macros.FindNodeWithIdentifierAsPrefix(StartP);
593 if MacroNode<>nil then begin
594 // macro found
595 MacroItem:=PStringToStringItem(MacroNode.Data);
596 MacroValue:=MacroItem^.Value;
597 //debugln(['Append MacroName=',MacroItem^.Name,' Src=',GetIdentifier(@Src[AtomStart]),' Value=',dbgstr(MacroValue)]);
598 // write source in front of macro
599 if AtomStart>FromPos then begin
600 //debugln(['Append source in front of macro=',dbgstr(copy(Src,FromPos,AtomStart-FromPos))]);
601 AddLink(StrStream.Position+1,Code,FromPos);
602 StrStream.Write(Src[FromPos],AtomStart-FromPos);
603 end;
604 FromPos:=p;
605 if System.Pos('(',MacroItem^.Name)>0
606 then begin
607 // a macro function
608 // => read parameters
609 ReadRawNextCAtom(Src,p,AtomStart);
610 if AtomStart>=EndPos then begin
611 Error(p+GetIdentLen(@Src[FromPos]),
612 'missing ( after macro function "'+GetIdentifier(@Src[FromPos])+'"');
613 end;
614 if Src[AtomStart]<>'(' then begin
615 Error(AtomStart,'expected ( after macro function "'+GetIdentifier(@Src[FromPos])+'"'
616 +' but found "'+copy(Src,AtomStart,p-AtomStart)+'"');
617 end;
618 BracketLvl:=1;
619 repeat
620 ReadRawNextCAtom(Src,p,AtomStart);
621 if AtomStart>=EndPos then begin
622 Error(p+GetIdentLen(@Src[FromPos]),
623 'missing ) for macro function "'+GetIdentifier(@Src[FromPos])+'"');
624 end;
625 case Src[AtomStart] of
626 '(': inc(BracketLvl);
627 ')':
628 begin
629 dec(BracketLvl);
630 if BracketLvl=0 then break;
631 end;
632 end;
633 until false;
634 FromPos:=p;
635 end;
636 //debugln(['Append Macro found: ',MacroItem^.Name]);
637 if MacroValue<>'' then begin
638 // write macro value
639 AddLink(StrStream.Position+1,nil,0);
640 //debugln(['Append macrovalue=',dbgstr(MacroValue)]);
641 StrStream.Write(MacroValue[1],length(MacroValue));
642 end;
643 end;
644 end;
645 end;
646 if FromPos<EndPos then begin
647 AddLink(StrStream.Position+1,Code,FromPos);
648 //debugln(['Append source after macro=',dbgstr(copy(Src,FromPos,EndPos-FromPos))]);
649 StrStream.Write(Src[FromPos],EndPos-FromPos);
650 end;
651 end;
652
653 procedure Append(const s: string);
654 begin
655 if s='' then exit;
656 AddLink(StrStream.Position+1,nil,0);
657 StrStream.Write(s[1],length(s));
658 end;
659
660 procedure Parse(Code: TCodeBuffer);
661 var
662 i: Integer;
663 Line: String;
664 IncludeParam: String;
665 j: Integer;
666 IncCode: TCodeBuffer;
667 IncFilename: String;
668 MergePos: Integer;
669 begin
670 if MergedBuffers.IndexOf(Code)>=0 then exit;
671 MergedBuffers.Add(Code);
672 MergePos:=1;
673 if not (chfmfIgnoreIncludes in Flags) then begin
674 for i:=0 to Code.LineCount-1 do begin
675 Line:=Code.GetLine(i,false);
676 if length(Line)<length('#include')+2 then continue;
677 if copy(Line,1,length('#include'))<>'#include' then continue;
678 if not (Line[length('#include')+1] in [' ',#9]) then continue;
679 IncludeParam:=Trim(copy(Line,length('#include')+1,length(Line)));
680 if (IncludeParam<>'') and (IncludeParam[1] in ['<','"']) then
681 IncludeParam:=copy(IncludeParam,2,length(IncludeParam)-2);
682 if IncludeParam<>'' then begin
683 // for example: glib/gutils.h
684 {$IFDEF VerboseCCodeParser}
685 debugln(['TCHeaderFileMerger.Merge Param=',IncludeParam]);
686 {$ENDIF}
687 // search file in list
688 for j:=1 to SourceBuffers.Count-1 do begin
689 IncCode:=TCodeBuffer(SourceBuffers[j]);
690 IncFilename:=IncCode.Filename;
691 if CompareFilenames(IncludeParam,
692 RightStr(IncFilename,length(IncludeParam)))<>0 then continue;
693 if (length(IncFilename)=length(IncludeParam))
694 or (IncFilename[length(IncFilename)-length(IncludeParam)]=PathDelim)
695 then begin
696 // include file found
697 if MergedBuffers.IndexOf(IncCode)<0 then begin
698 {$IFDEF VerboseCCodeParser}
699 debugln(['TCHeaderFileMerger.Merge file '+IncFilename+' into '+Code.Filename]);
700 {$ENDIF}
701 Append(Code,MergePos,Code.GetLineStart(i));
702 MergePos:=Code.GetLineStart(i+1);
703 Append('/* h2pas: merged '+IncludeParam+' into '+ExtractFileName(Code.Filename)+' */'+LineEnding);
704 Parse(IncCode);
705 Append('/* h2pas: end of merged '+IncludeParam+' into '+ExtractFileName(Code.Filename)+' */'+LineEnding+LineEnding);
706 end;
707 end;
708 end;
709 end;
710 end;
711 end;
712 if MergePos<=Code.SourceLength then
713 Append(Code,MergePos,Code.SourceLength+1);
714 Append(LineEnding);
715 end;
716
717 var
718 i: Integer;
719 begin
720 Clear;
721 MergedBuffers:=TFPList.Create;
722 StrStream:=TStringStream.Create('');
723 try
724 for i:=0 to SourceBuffers.Count-1 do begin
725 Parse(TCodeBuffer(SourceBuffers[i]));
726 if not (chfmfAll in Flags) then break;
727 end;
728 finally
729 CombinedSource:=TCodeBuffer.Create;
730 CombinedSource.Source:=StrStream.DataString;
731 StrStream.Free;
732 MergedBuffers.Free;
733 end;
734 end;
735
TCHeaderFileMerger.MergedPosToOriginalnull736 function TCHeaderFileMerger.MergedPosToOriginal(MergedPos: integer;
737 out Code: TCodeBuffer; out CodePos: integer): boolean;
738 var
739 Link: PCHFileLink;
740 LinkIndex: LongInt;
741 begin
742 Code:=nil;
743 CodePos:=0;
744 LinkIndex:=LinkIndexOfMergedPos(MergedPos);
745 if LinkIndex<0 then exit(false);
746 Link:=@Links[LinkIndex];
747 Code:=Link^.Code;
748 //dbgout(['TCHeaderFileMerger.MergedPosToOriginal LinkIndex=',LinkIndex,
749 // ' SearchPos=',MergedPos,' LinkMergePos=',Link^.MergedPos,' LinkSrcPos=',Link^.SrcPos]);
750 //if Code<>nil then dbgout(' File=',ExtractFileName(Code.Filename));
751 CodePos:=MergedPos-Link^.MergedPos+Link^.SrcPos;
752 //debugln([' CodePos=',CodePos]);
753 Result:=true;
754 end;
755
TCHeaderFileMerger.MergedPosToOriginalnull756 function TCHeaderFileMerger.MergedPosToOriginal(MergedX, MergedY: integer;
757 out Code: TCodeBuffer; out X, Y: integer): boolean;
758 var
759 MergedPos: integer;
760 CodePos: integer;
761 begin
762 Result:=false;
763 Code:=nil;
764 X:=0;
765 Y:=0;
766 CombinedSource.LineColToPosition(MergedY,MergedX,MergedPos);
767 //debugln(['TCHeaderFileMerger.MergedPosToOriginal MergedX=',MergedX,' MergedY=',MergedY,' MergedPos=',MergedPos,' ',dbgstr(copy(CombinedSource.Source,MergedPos-20,20)),'|',dbgstr(copy(CombinedSource.Source,MergedPos,20))]);
768 if not MergedPosToOriginal(MergedPos,Code,CodePos) then exit;
769 Code.AbsoluteToLineCol(CodePos,Y,X);
770 Result:=Y>=1;
771 end;
772
LinkIndexOfMergedPosnull773 function TCHeaderFileMerger.LinkIndexOfMergedPos(MergedPos: integer): integer;
774 var
775 l: Integer;
776 r: Integer;
777 begin
778 Result:=-1;
779 if LinkCount=0 then exit;
780 if (MergedPos<1) then exit;
781 if MergedPos>CombinedSource.SourceLength+1 then
782 exit;
783 // MergedPos is in source
784 if MergedPos>=Links[LinkCount-1].MergedPos then
785 exit(LinkCount-1);
786 // MergedPos is in one of the regular links (that have a successor)
787 l:=0;
788 r:=LinkCount-2;
789 while (l<=r) do begin
790 Result:=(l+r) div 2;
791 if MergedPos<Links[Result].MergedPos then
792 r:=Result-1
793 else if MergedPos<Links[Result+1].MergedPos then
794 exit
795 else
796 l:=Result+1;
797 end;
798 end;
799
TCHeaderFileMerger.GetLinkLengthnull800 function TCHeaderFileMerger.GetLinkLength(Index: integer): integer;
801 begin
802 if (Index<0) or (Index>=LinkCount) then
803 Result:=0
804 else if Index=LinkCount-1 then
805 Result:=CombinedSource.SourceLength-Links[Index].MergedPos
806 else
807 Result:=Links[Index+1].MergedPos-Links[Index].MergedPos;
808 end;
809
810 procedure TCHeaderFileMerger.WriteDebugReport;
811 var
812 i: Integer;
813 Link: PCHFileLink;
814 Line: integer;
815 Column: integer;
816 l: LongInt;
817 begin
818 debugln(['TCHeaderFileMerger.WriteDebugReport LinkCount=',LinkCount]);
819 debugln(' # MergePos Line');
820 for i:=0 to LinkCount-1 do begin
821 Link:=@Links[i];
822 CombinedSource.AbsoluteToLineCol(Link^.MergedPos,Line,Column);
823 dbgout([' ',i,' ',Link^.MergedPos,' y=',Line]);
824 if Link^.Code<>nil then begin
825 Link^.Code.AbsoluteToLineCol(Link^.SrcPos,Line,Column);
826 DbgOut([' ',ExtractFilename(Link^.Code.Filename),' Y=',Line,' X=',Column,' SrcPos=',Link^.SrcPos]);
827 end else begin
828 DbgOut(' no source');
829 end;
830 l:=GetLinkLength(i);
831 if l<45 then
832 debugln([' [ ',dbgstr(copy(CombinedSource.Source,Link^.MergedPos,l)),' ]'])
833 else
834 debugln([' [ ',dbgstr(copy(CombinedSource.Source,Link^.MergedPos,20)),' ... ',
835 dbgstr(copy(CombinedSource.Source,Link^.MergedPos+GetLinkLength(i)-20,20)),' ]']);
836 end;
837 end;
838
839 { ECCodeParserException }
840
841 constructor ECCodeParserException.Create(ASender: TCCodeParserTool;
842 const AMessage: string);
843 begin
844 inherited Create(AMessage);
845 Sender:=ASender;
846 end;
847
848 { TCCodeParserTool }
849
OtherTokennull850 function TCCodeParserTool.OtherToken: boolean;
851 begin
852 Result:=true;
853 if AtomIsChar(';') then
854 // ignore
855 else if AtomIsIdentifier then begin
856 ReadDefinition(false);
thennull857 if CurNode.LastChild.Desc<>ccnFunction then begin
858 ReadNextAtom;
859 if not AtomIsChar(';') then
860 RaiseExpectedButAtomFound(';');
861 end;
862 end else
863 RaiseException('unexpected token '+GetAtom);
864 end;
865
DirectiveTokennull866 function TCCodeParserTool.DirectiveToken: boolean;
867
868 procedure ReadExpression;
869 var
870 BracketLevel: Integer;
871 NeedBracket: Boolean;
872 begin
873 BracketLevel:=0;
874 repeat
875 ReadRawNextAtom;
876 {$IFDEF VerboseCCodeParser}
877 debugln([GetNodeIndent(CurNode),'ReadExpression Atom ',GetAtom]);
878 {$ENDIF}
879 if AtomStart>SrcLen then
880 RaiseException('missing expression');
881 if Src[AtomStart] in [#10,#13] then begin
882 if BracketLevel>0 then
883 RaiseException('missing )');
884 break;
885 end;
886 if AtomIsChar('(') then begin
887 // in front of a ( there can
888 inc(BracketLevel);
889 end else if AtomIsChar(')') then begin
890 if BracketLevel=0 then
891 RaiseException(') without (');
892 dec(BracketLevel);
893 end else if AtomIsCharOfSet('!+-*/><')
894 or AtomIs('!=') or AtomIs('==') or AtomIs('<=') or AtomIs('>=')
895 or AtomIs('&&') or AtomIs('||') or AtomIs('<<') or AtomIs('>>')
896 then begin
897 // valid operator
898 end else if IsIdentChar[Src[AtomStart]] then begin
899 if AtomIs('defined') then begin
900 // read defined(macro)
901 // or read defined macro
902 ReadRawNextAtom;
903 if AtomIsChar('(') then begin
904 NeedBracket:=true;
905 ReadRawNextAtom;
906 end else begin
907 NeedBracket:=false;
908 end;
909 if not AtomIsIdentifier then
910 RaiseExpectedButAtomFound('macro');
911 if NeedBracket then begin
912 ReadRawNextAtom;
913 if not AtomIsChar(')') then
914 RaiseExpectedButAtomFound(')');
915 end;
916 end else begin
917 // constant
918 end;
919 end else begin
920 RaiseExpectedButAtomFound('constant');
921 end;
922 until false;
923 end;
924
925 var
926 StartPos: LongInt;
927 begin
928 Result:=true;
929 CreateChildNode(ccnDirective);
930 if ParseDirectives then begin
931 // read directive
932 ReadRawNextAtom;
933 if AtomIs('include') then begin
934 CurNode.SubDesc:=ccnsDirectiveInclude;
935 ReadRawNextAtom;
936 if AtomIsChar('<') then begin
937 // #include <filename> // search independent of source position
938 StartPos:=SrcPos;
939 repeat
940 ReadRawNextAtom;
941 if AtomStart>SrcLen then begin
942 MoveCursorToPos(StartPos);
943 RaiseExpectedButAtomFound('>');
944 end;
945 until AtomIsChar('>');
946 end else if AtomIsStringConstant then begin
947 // #include "filename" // search dependent on source position
948 end else begin
949 RaiseExpectedButAtomFound('< or "');
950 end;
951 end else if AtomIs('define') then begin
952 // #define FMAC(a,b) a here, then b
953 // #define NONFMAC some text here
954 CurNode.SubDesc:=ccnsDirectiveDefine;
955 ReadRawNextAtom;
956 if not AtomIsIdentifier then
957 RaiseExpectedButAtomFound('identifier');
958 // if a ( follows immediately (without spaces) then it is a macro function
ifnull959 if (SrcPos<=SrcLen) and (Src[SrcPos]='(') then begin
960 AtomStart:=SrcPos;
961 SrcPos:=AtomStart+1;
962 ReadTilBracketClose(true);
963 end;
964 end else if AtomIs('undef') then begin
965 CurNode.SubDesc:=ccnsDirectiveUndef;
966 ReadRawNextAtom;
967 if not AtomIsIdentifier then
968 RaiseExpectedButAtomFound('identifier');
969 end else if AtomIs('if') then begin
970 {$IFDEF VerboseCDirectives}
971 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.DirectiveToken ',GetIndentStr(IfLevel*2),GetAtom]);
972 {$ENDIF}
973 CurNode.SubDesc:=ccnsDirectiveIf;
974 IncIfLevel(AtomStart);
975 ReadExpression;
976 end else if AtomIs('ifdef') then begin
977 {$IFDEF VerboseCDirectives}
978 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.DirectiveToken ',GetIndentStr(IfLevel*2),GetAtom]);
979 {$ENDIF}
980 CurNode.SubDesc:=ccnsDirectiveIfDef;
981 IncIfLevel(AtomStart);
982 ReadRawNextAtom;
983 if not AtomIsIdentifier then
984 RaiseExpectedButAtomFound('identifier');
985 end else if AtomIs('ifndef') then begin
986 {$IFDEF VerboseCDirectives}
987 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.DirectiveToken ',GetIndentStr(IfLevel*2),GetAtom]);
988 {$ENDIF}
989 CurNode.SubDesc:=ccnsDirectiveIfNDef;
990 IncIfLevel(AtomStart);
991 ReadRawNextAtom;
992 if not AtomIsIdentifier then
993 RaiseExpectedButAtomFound('identifier');
994 end else if AtomIs('elif') then begin
995 {$IFDEF VerboseCDirectives}
996 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.DirectiveToken ',GetIndentStr(IfLevel*2-2),GetAtom]);
997 {$ENDIF}
998 CurNode.SubDesc:=ccnsDirectiveElIf;
999 if IfLevel=0 then
1000 RaiseException('elif without if');
1001 ReadExpression;
1002 end else if AtomIs('else') then begin
1003 {$IFDEF VerboseCDirectives}
1004 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.DirectiveToken ',GetIndentStr(IfLevel*2-2),GetAtom]);
1005 {$ENDIF}
1006 CurNode.SubDesc:=ccnsDirectiveElse;
1007 if IfLevel=0 then
1008 RaiseException('else without if');
1009 end else if AtomIs('endif') then begin
1010 CurNode.SubDesc:=ccnsDirectiveEndIf;
1011 if IfLevel=0 then
1012 RaiseException('endif without if');
1013 dec(IfLevel);
1014 {$IFDEF VerboseCDirectives}
1015 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.DirectiveToken ',GetIndentStr(IfLevel*2),GetAtom]);
1016 {$ENDIF}
1017 end else if AtomIs('line') then begin
1018 CurNode.SubDesc:=ccnsDirectiveLine;
1019 end else if AtomIs('error') then begin
1020 CurNode.SubDesc:=ccnsDirectiveError;
1021 end else if AtomIs('pragma') then begin
1022 CurNode.SubDesc:=ccnsDirectivePragma;
1023 end else begin
1024 RaiseExpectedButAtomFound('directive')
1025 end;
1026 end;
1027 // read til end of line
1028 ReadTilCLineEnd(Src,AtomStart);
1029 SrcPos:=AtomStart;
1030 //DebugLn(['TCCodeParserTool.DirectiveToken ',copy(Src,CurNode.StartPos,AtomStart-CurNode.Startpos)]);
1031 EndChildNode;
1032 end;
1033
ExternTokennull1034 function TCCodeParserTool.ExternToken: boolean;
1035 begin
1036 Result:=true;
1037 CreateChildNode(ccnExternBlock);
1038 ReadNextAtom;
1039 if AtomIsStringConstant then begin
1040 // for example: extern "C" {
1041 ReadNextAtom;
1042 if not AtomIsChar('{') then
1043 RaiseExpectedButAtomFound('{');
1044 end else if AtomIsIdentifier then begin
1045 // for example: extern void a();
1046 CurNode.Desc:=ccnExternDef;
1047 ReadDefinition(false);
1048 EndChildNode;
1049 end else
1050 RaiseExpectedButAtomFound('extern definition');
1051 end;
1052
CurlyBracketCloseTokennull1053 function TCCodeParserTool.CurlyBracketCloseToken: boolean;
1054 // examples:
1055 // end of 'extern "C" {'
1056 begin
1057 Result:=true;
1058 if CurNode.Desc=ccnExternBlock then
1059 EndChildNode
1060 else
1061 RaiseException('} without {');
1062 end;
1063
1064 procedure TCCodeParserTool.ReadEnum;
1065 (* For example:
1066 enum {
1067 TEST_ENUM1 = 1, /* Enum starts at 1 */
1068 TEST_ENUM2,
1069 TEST_ENUM3
1070 };
1071 enum e1{dark, light};
1072
1073 *)
1074 begin
1075 CreateChildNode(ccnEnumBlock);
1076 ReadNextAtom;
1077 // read optional name
1078 if AtomIsIdentifier then begin
1079 CreateChildNode(ccnName);
1080 EndChildNode;
1081 ReadNextAtom;
1082 end;
1083 if not AtomIsChar('{') then
1084 RaiseExpectedButAtomFound('{');
1085 // read enums. Examples
1086 // name,
1087 // name = constant,
1088 ReadNextAtom;
1089 repeat
1090 if AtomIsIdentifier then begin
1091 // read enum
1092 CreateChildNode(ccnEnumID);
1093 CurNode.EndPos:=SrcPos;
1094 ReadNextAtom;
1095 if AtomIsChar('=') then begin
1096 // read value
1097 ReadNextAtom;
1098 ReadConstant;
1099 CurNode.EndPos:=SrcPos;
1100 ReadNextAtom;
1101 end;
1102 EndChildNode;
1103 end;
1104 if AtomIsChar(',') then begin
1105 // next enum
1106 ReadNextAtom;
1107 if not AtomIsIdentifier then
1108 RaiseExpectedButAtomFound('identifier');
1109 end else if AtomIsChar('}') then begin
1110 break;
1111 end else
1112 RaiseExpectedButAtomFound('}');
1113 until false;
1114 EndChildNode;
1115 end;
1116
1117 procedure TCCodeParserTool.ReadUnionStruct(IsStruct: boolean);
1118 (* Examples:
1119
1120 union sign /* A definition and a declaration */
1121 {
1122 int svar;
1123 unsigned uvar;
1124 } number;
1125
1126
1127 As typedef:
1128 typedef struct {
1129 uint8_t b[6]; // implicit type
1130 } __attribute__((packed)) bdaddr_t;
1131
1132 typedef struct _sdp_list sdp_list_t;
1133
1134 As implicit typedef:
1135 struct hidp_connadd_req {
1136 int ctrl_sock;
1137 }
1138 struct SwsContext; // no content
1139
1140 As variable:
1141 struct hidp_conninfo *ci;
1142 *)
1143 //
1144 // As typecast in macros:
1145 // struct __attribute__((packed)) {
1146 // typeof(*(ptr)) __v;
1147 // } *__p = (void *) (ptr);
1148 //
1149 begin
1150 if IsStruct then
1151 CreateChildNode(ccnStruct)
1152 else
1153 CreateChildNode(ccnUnion);
1154
1155 ReadNextAtom;
1156 if AtomIsIdentifier then begin
1157 CreateChildNode(ccnTypeName);
1158 EndChildNode;
1159 ReadNextAtom;
1160 end;
1161
1162 // read front attributes
1163 if AtomIs('__attribute__') then begin
1164 Read__attribute__;
1165 ReadNextAtom;
1166 end;
1167 if AtomIsChar('{') then begin
1168 // read block {}
1169 CreateChildNode(ccnSubDefs);
1170 repeat
1171 ReadNextAtom;
1172 // read variables
1173 if AtomIsIdentifier then begin
1174 ReadDefinition(false);
1175 ReadNextAtom;
1176 if AtomIsChar('}') then
1177 break
1178 else if AtomIsChar(';') then begin
1179 // next identifier
1180 end else
1181 RaiseExpectedButAtomFound('}');
1182 end else if AtomIsChar('}') then
1183 break
1184 else if AtomIsChar('#') then
1185 DirectiveToken
1186 else
1187 RaiseExpectedButAtomFound('identifier');
1188 until false;
1189 EndChildNode;
1190 // read after attributes
1191 ReadNextAtom;
1192 if AtomIs('__attribute__') then begin
1193 Read__attribute__;
1194 end else begin
1195 UndoReadNextAtom;
1196 end;
1197 end else
1198 UndoReadNextAtom;
1199
1200 // close node
1201 EndChildNode;
1202 end;
1203
1204 procedure TCCodeParserTool.InitKeyWordList;
1205 begin
1206 if FDefaultTokenList=nil then begin
1207 FDefaultTokenList:=TKeyWordFunctionList.Create('TCCodeParserTool.DefaultTokenList');
1208 with FDefaultTokenList do begin
1209 Add('#',{$ifdef FPC}@{$endif}DirectiveToken);
1210 Add('extern',{$ifdef FPC}@{$endif}ExternToken);
1211 Add('}',{$ifdef FPC}@{$endif}CurlyBracketCloseToken);
1212 DefaultKeyWordFunction:={$ifdef FPC}@{$endif}OtherToken;
1213 end;
1214 end;
1215 end;
1216
1217 procedure TCCodeParserTool.InitParser;
1218 begin
1219 ParseChangeStep:=Code.ChangeStep;
1220 IncreaseChangeStep;
1221 InitKeyWordList;
1222 Src:=Code.Source;
1223 SrcLen:=length(Src);
1224 if Tree=nil then
1225 Tree:=TCodeTree.Create
1226 else
1227 Tree.Clear;
1228 SrcPos:=1;
1229 AtomStart:=1;
1230 CurNode:=nil;
1231 CreateChildNode(ccnRoot);
1232 IfLevel:=0;
1233 end;
1234
1235 procedure TCCodeParserTool.CreateChildNode(Desc: TCCodeNodeDesc);
1236 var
1237 NewNode: TCodeTreeNode;
1238 begin
1239 NewNode:=TCodeTreeNode.Create;
1240 Tree.AddNodeAsLastChild(CurNode,NewNode);
1241 NewNode.Desc:=Desc;
1242 CurNode:=NewNode;
1243 CurNode.StartPos:=AtomStart;
1244 {$IFDEF VerboseCCodeParser}
1245 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.CreateChildNode ',CCNodeDescAsString(Desc)]);
1246 {$ENDIF}
1247 end;
1248
1249 procedure TCCodeParserTool.EndChildNode;
1250 begin
1251 {$IFDEF VerboseCCodeParser}
1252 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.EndChildNode ',CCNodeDescAsString(CurNode.Desc)]);
1253 {$ENDIF}
1254 if CurNode.EndPos<=0 then
1255 CurNode.EndPos:=SrcPos;
1256 CurNode:=CurNode.Parent;
1257 end;
1258
1259 procedure TCCodeParserTool.CloseNodes;
1260 var
1261 Node: TCodeTreeNode;
1262 begin
1263 Node:=CurNode;
1264 while Node<>nil do begin
1265 Node.EndPos:=AtomStart;
1266 Node:=Node.Parent;
1267 end;
1268 end;
1269
1270 procedure TCCodeParserTool.ReadConstant;
1271 // ends on last atom of constant
1272 begin
1273 if AtomIsChar(',') or AtomIsChar(';') or AtomIsChar(')') then
1274 RaiseExpectedButAtomFound('identifier');
1275 CreateChildNode(ccnConstant);
1276 repeat
1277 if AtomIsChar('(') or AtomIsChar('[') then
1278 ReadTilBracketClose(true);
1279 CurNode.EndPos:=SrcPos;
1280 ReadNextAtom;
1281 if AtomIsChar(',') or AtomIsChar(';')
1282 or AtomIsChar(')') or AtomIsChar(']') or AtomIsChar('}')
1283 then
1284 break;
1285 until false;
1286 UndoReadNextAtom;
1287 EndChildNode;
1288 end;
1289
1290 procedure TCCodeParserTool.Read__attribute__;
1291 begin
1292 ReadNextAtom;
1293 if not AtomIsChar('(') then
1294 RaiseExpectedButAtomFound('(');
1295 ReadTilBracketClose(true);
1296 end;
1297
1298 procedure TCCodeParserTool.IncIfLevel(StartPos: integer);
1299 begin
1300 inc(IfLevel);
1301 if FIfStackCapacity<IfLevel then begin
1302 FIfStackCapacity:=5+FIfStackCapacity*2;
1303 ReAllocMem(FIfStack,FIfStackCapacity*SizeOf(TCCodeParserIfStackItem));
1304 end;
1305 FIfStack[IfLevel-1].StartPos:=StartPos;
1306 end;
1307
1308 procedure TCCodeParserTool.ReadDefinition(AsParameter: boolean);
1309 (* Read type name [specifiers]
1310
1311 if AsParameter=true then name can be omitted.
1312
1313 Examples:
1314
1315 int i
1316 uint8_t b[6]
1317 uint8_t lap[MAX_IAC_LAP][3];
1318 int y = 7;
1319
1320 static inline int bacmp(const bdaddr_t *ba1, const bdaddr_t *ba2)
1321 {
1322 return memcmp(ba1, ba2, sizeof(bdaddr_t));
1323 }
1324 bdaddr_t *strtoba(const char *str);
1325
1326 void av_log(void*, int level, const char *fmt, ...) __attribute__ ((__format__ (__printf__, 3, 4)));
1327
1328 *)
1329 {
1330 const char* (*item_name)(void* ctx);
1331 int (*fp)(char*); // pointer to function taking a char* argument; returns an int
1332 int * f(char*); // function taking a char* argument; returns a pointer to int
1333
1334 complex operator+(complex, complex);
1335 }
1336 var
Booleannull1337 IsFunction: Boolean;
1338 NeedEnd: Boolean;
1339 LastIsName: Boolean;
1340 MainNode: TCodeTreeNode;
1341 begin
1342 {$IFDEF VerboseCCodeParser}
1343 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.ReadVariable START ',GetAtom]);
1344 {$ENDIF}
1345 if AtomIs('typedef') then begin
1346 if AsParameter then
1347 RaiseException('typedef not allowed as function parameter');
1348 CreateChildNode(ccnTypedef);
1349 ReadNextAtom;
1350 end else if AsParameter then begin
1351 CreateChildNode(ccnFuncParameter);
1352 if AtomIs('...') then begin
1353 EndChildNode;
1354 exit;
1355 end;
1356 end else
1357 CreateChildNode(ccnDefinition);
1358 MainNode:=CurNode;
1359 IsFunction:=false;
1360 if AtomIs('volatile') then ReadNextAtom;
1361 if AtomIs('const') then ReadNextAtom;
1362
1363 if AtomIs('struct') then begin
1364 ReadUnionStruct(true);
1365 ReadNextAtom;
1366 end else if AtomIs('union') then begin
1367 ReadUnionStruct(false);
1368 ReadNextAtom;
1369 end else if AtomIs('enum') then begin
1370 ReadEnum;
1371 ReadNextAtom;
1372 end else begin
1373 if IsCCodeFunctionModifier.DoItCaseSensitive(Src,AtomStart,SrcPos-AtomStart)
1374 then begin
modifiersnull1375 // read function modifiers
1376 if AsParameter then
1377 RaiseException('function modifier not allowed in parameter');
1378 repeat
1379 IsFunction:=true;
1380 MainNode.Desc:=ccnFunction;
ReadNextAtomnull1381 ReadNextAtom;
1382 if not AtomIsIdentifier then
1383 RaiseExpectedButAtomFound('identifier');
1384 until not IsCCodeFunctionModifier.DoItCaseSensitive(Src,AtomStart,SrcPos-AtomStart);
1385 end;
1386 if AtomIs('const') then ReadNextAtom;
1387
1388 // prefixes: signed, unsigned
1389 // prefixes and/or names long, short
1390
1391 // int, short int, short signed int
1392 // char, signed char, unsigned char
1393 // singed short, unsigned short, short
1394 // long, long long, signed long, signed long long, unsigned long, unsigned long long
1395 LastIsName:=false;
1396 repeat
1397 if AtomIs('signed') or AtomIs('unsigned') then begin
1398 LastIsName:=false;
1399 ReadNextAtom;
1400 end else if AtomIs('short') or AtomIs('long') then begin
1401 LastIsName:=true;
1402 ReadNextAtom;
1403 end else
1404 break;
1405 until false;
1406 if not LastIsName then
1407 ReadNextAtom;
1408 end;
1409
1410 while AtomIsChar('*') or AtomIs('const') do begin
1411 // pointer or const
1412 ReadNextAtom;
1413 end;
1414 if AtomIs('operator') then begin
1415 if AsParameter then
1416 RaiseException('operator not allowed as parameter');
1417 IsFunction:=true;
1418 MainNode.Desc:=ccnFunction;
1419 // read operator
1420 ReadNextAtom;
1421 if not IsCCodeCustomOperator.DoItCaseSensitive(Src,AtomStart,SrcPos-AtomStart)
1422 then
1423 RaiseExpectedButAtomFound('operator');
1424 CreateChildNode(ccnName);
1425 CurNode.StartPos:=AtomStart;
1426 CurNode.EndPos:=SrcPos;
1427 end else if AtomIsChar('(') then begin
1428 IsFunction:=true;
1429 MainNode.Desc:=ccnFunction;
1430 // example: int (*fp)(char*);
takingnull1431 // pointer to function taking a char* argument; returns an int
1432 ReadNextAtom;
1433 while AtomIsChar('*') or AtomIs('const') do begin
1434 // pointer or const
1435 ReadNextAtom;
1436 end;
1437 {$IFDEF VerboseCCodeParser}
1438 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.ReadVariable name=',GetAtom]);
1439 {$ENDIF}
1440 if AtomIsIdentifier then begin
1441 CreateChildNode(ccnName);
1442 CurNode.StartPos:=AtomStart;
1443 CurNode.EndPos:=SrcPos;
1444 ReadNextAtom;
1445 end else if not AsParameter then
1446 RaiseExpectedButAtomFound('identifier');
1447 if not AtomIsChar(')') then
1448 RaiseExpectedButAtomFound(')');
1449 end else begin
1450 {$IFDEF VerboseCCodeParser}
1451 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.ReadVariable name=',GetAtom]);
1452 {$ENDIF}
1453 if AtomIsIdentifier then begin
1454 CreateChildNode(ccnName);
1455 CurNode.StartPos:=AtomStart;
1456 CurNode.EndPos:=SrcPos;
1457 end else begin
1458 UndoReadNextAtom;
1459 end;
1460 end;
1461 // end of name
1462 if CurNode.Desc=ccnName then
1463 EndChildNode;
1464
1465 ReadNextAtom;
andnull1466 if IsFunction and (not AtomIsChar('(')) then
1467 RaiseExpectedButAtomFound('(');
1468 NeedEnd:=true;
1469 if AtomIsChar('(') then begin
1470 // this is a function => read parameter list
1471 IsFunction:=true;
1472 MainNode.Desc:=ccnFunction;
ReadParameterListnull1473 ReadParameterList;
1474 ReadNextAtom;
1475 if AtomIs('__attribute__') then begin
1476 Read__attribute__;
1477 ReadNextAtom;
1478 end;
1479 if (CurNode.Parent.Desc=ccnTypedef) then begin
1480 if AtomIsChar('{') then
1481 RaiseException('a typedef can not have a statement block');
1482 end else if AsParameter then begin
1483 if AtomIsChar('{') then
1484 RaiseException('a parameter can not have a statement block');
1485 end else begin
1486 if AtomIsChar('{') then begin
1487 // read statements {}
1488 CreateChildNode(ccnStatementBlock);
1489 ReadTilBracketClose(true);
1490 CurNode.EndPos:=SrcPos;
1491 EndChildNode;
1492 ReadNextAtom;
1493 end else if not AtomIsChar(';') then begin
1494 // functions without statements are external and must end with a semicolon
1495 RaiseExpectedButAtomFound(';');
1496 end;
1497 NeedEnd:=false;
1498 end;
1499 end else if AtomIsChar('[') then begin
1500 // read array brackets
1501 while AtomIsChar('[') do begin
1502 ReadTilBracketClose(true);
1503 ReadNextAtom;
1504 end;
1505 end else if AtomIsChar(':') then begin
1506 // bits
1507 ReadNextAtom;
1508 if not AtomIsNumber then
1509 RaiseExpectedButAtomFound('bit count number');
1510 CreateChildNode(ccnBitCount);
1511 EndChildNode;
1512 ReadNextAtom;
1513 end;
1514
1515 // read initial constant
1516 if NeedEnd and AtomIsChar('=') then begin
1517 if CurNode.HasParentOfType(ccnTypedef) then
1518 RaiseException('typedef can not have an initial value');
1519 ReadNextAtom;
1520 ReadConstant;
1521 ReadNextAtom;
1522 NeedEnd:=true;
1523 end;
1524
1525 // sanity check
1526 if (SrcPos<=SrcLen) and NeedEnd
1527 and not (AtomIsChar(';') or AtomIsChar(',') or AtomIsChar(')')) then
1528 RaiseExpectedButAtomFound('"end of variable"');
1529
1530 UndoReadNextAtom;
1531
1532 EndChildNode;
1533 end;
1534
1535 procedure TCCodeParserTool.ReadParameterList;
1536 // start on (, end on )
1537 var
1538 StartPos: LongInt;
1539 begin
1540 CreateChildNode(ccnFuncParamList);
1541 StartPos:=AtomStart;
1542 repeat
1543 ReadNextAtom;
1544 if AtomStart>SrcLen then begin
1545 // missing closing bracket
1546 AtomStart:=StartPos;
1547 SrcPos:=AtomStart+1;
1548 RaiseException('closing bracket not found');
1549 end;
1550 if AtomIsChar(')') then break;
1551 if AtomIsChar(',') then
1552 RaiseExpectedButAtomFound('parameter type');
1553 // read parameter
1554 ReadDefinition(true);
1555 // read next
1556 ReadNextAtom;
1557 if AtomIsChar(')') then break;
1558 if not AtomIsChar(',') then
1559 RaiseExpectedButAtomFound(',');
1560 until false;
1561 CurNode.EndPos:=SrcPos;
1562 EndChildNode;
1563 end;
1564
1565 procedure TCCodeParserTool.RaiseException(const AMessage: string; ReportPos: integer);
1566 begin
1567 LastErrorMsg:=AMessage;
1568 LastErrorPos:=AtomStart;
1569 LastErrorReportPos:=LastErrorPos;
1570 if ReportPos>0 then
1571 LastErrorReportPos:=ReportPos;
1572 CloseNodes;
1573 {$IFDEF VerboseCCodeParser}
1574 CTDumpStack;
1575 {$ENDIF}
1576 raise ECCodeParserException.Create(Self,AMessage);
1577 end;
1578
1579 procedure TCCodeParserTool.RaiseExpectedButAtomFound(const AToken: string;
1580 ReportPos: integer);
1581 begin
1582 RaiseException(AToken+' expected, but '+GetAtom+' found',ReportPos);
1583 end;
1584
1585 constructor TCCodeParserTool.Create;
1586 begin
1587 Tree:=TCodeTree.Create;
1588 InitCCOdeKeyWordLists;
1589 VisibleEditorLines:=25;
1590 JumpCentered:=true;
1591 CursorBeyondEOL:=true;
1592 ParseDirectives:=true;
1593 end;
1594
1595 destructor TCCodeParserTool.Destroy;
1596 begin
1597 Clear;
1598 FreeAndNil(Tree);
1599 ReAllocMem(FIfStack,0);
1600 FIfStackCapacity:=0;
1601 FreeAndNil(FDefaultTokenList);
1602 inherited Destroy;
1603 end;
1604
1605 procedure TCCodeParserTool.Clear;
1606 begin
1607 IfLevel:=0;
1608 if FIfStackCapacity>10 then begin
1609 ReAllocMem(FIfStack,0);
1610 FIfStackCapacity:=0;
1611 end;
1612 Tree.Clear;
1613 end;
1614
1615 procedure TCCodeParserTool.Parse;
1616 begin
1617 Parse(Code);
1618 end;
1619
1620 procedure TCCodeParserTool.Parse(aCode: TCodeBuffer);
1621 begin
1622 if (Code=aCode) and (not UpdateNeeded) then
1623 exit;
1624 Code:=aCode;
1625 InitParser;
1626 repeat
1627 ReadNextAtom;
1628 if SrcPos<=SrcLen then begin
1629 FDefaultTokenList.DoItCaseSensitive(Src,AtomStart,SrcPos-AtomStart);
1630 end else begin
1631 break;
1632 end;
1633 until false;
1634 if (CurNode=nil) or (CurNode.Desc<>ccnRoot) then
1635 RaiseException('TCCodeParserTool.Parse: internal parser error');
1636 EndChildNode;
1637 end;
1638
UpdateNeedednull1639 function TCCodeParserTool.UpdateNeeded: boolean;
1640 begin
1641 Result:=true;
1642 if (Code=nil) or (Tree=nil) or (Tree.Root=nil) then exit;
1643 if Code.ChangeStep<>ParseChangeStep then exit;
1644 Result:=false;
1645 end;
1646
TCCodeParserTool.FindDeepestNodeAtPosnull1647 function TCCodeParserTool.FindDeepestNodeAtPos(P: integer;
1648 ExceptionOnNotFound: boolean): TCodeTreeNode; inline;
1649 begin
1650 Result:=FindDeepestNodeAtPos(Tree.Root,P,ExceptionOnNotFound);
1651 end;
1652
TCCodeParserTool.FindDeepestNodeAtPosnull1653 function TCCodeParserTool.FindDeepestNodeAtPos(StartNode: TCodeTreeNode;
1654 P: integer; ExceptionOnNotFound: boolean): TCodeTreeNode;
1655
1656 procedure RaiseNoNodeFoundAtCursor;
1657 var
1658 Msg: String;
1659 Node: TCodeTreeNode;
1660 LastPos: Integer;
1661 begin
1662 //DebugLn('RaiseNoNodeFoundAtCursor ',MainFilename);
1663 MoveCursorToPos(P);
1664 // check if p is in parsed code
1665 if (Tree=nil) or (Tree.Root=nil) then begin
1666 RaiseException('no pascal code or not yet parsed');
1667 end;
1668 if p<Tree.Root.StartPos then begin
1669 Msg:='In front of code.';
1670 if Tree.Root.StartPos<=SrcLen then begin
1671 MoveCursorToPos(Tree.Root.StartPos);
1672 ReadNextAtom;
1673 Msg:=Msg+' The pascal code starts with "'+GetAtom+'" at '
1674 +CleanPosToStr(Tree.Root.StartPos)+'. No code';
1675 end;
1676 MoveCursorToPos(P);
1677 RaiseException(Msg);
1678 end;
1679 Node:=Tree.Root;
1680 while Node.NextBrother<>nil do Node:=Node.NextBrother;
1681 if (Node.EndPos>0) and (p>Node.EndPos) then
1682 LastPos:=Node.EndPos
1683 else
1684 LastPos:=Node.StartPos;
1685 if p>LastPos then begin
1686 Msg:='Behind code. The last valid pascal code is at '+CleanPosToStr(LastPos)+'. No code';
1687 RaiseException(Msg);
1688 end;
1689
1690 // p is in parsed code, the StartNode is wrong
1691 CTDumpStack;
1692 if (StartNode<>nil) then
1693 RaiseException('Invalid search. The search for pascal started at '
1694 +CleanPosToStr(StartNode.StartPos)+'. Invalid search')
1695 else
1696 RaiseException('Inconsistency error in TCustomCodeTool.FindDeepestNodeAtPos');
1697 end;
1698
1699 var
1700 ChildNode: TCodeTreeNode;
1701 Brother: TCodeTreeNode;
1702 begin
1703 {$IFDEF CheckNodeTool}CheckNodeTool(StartNode);{$ENDIF}
1704 Result:=nil;
1705 while StartNode<>nil do begin
1706 //DebugLn('SearchInNode ',NodeDescriptionAsString(ANode.Desc),
1707 //',',ANode.StartPos,',',ANode.EndPos,', p=',p,
1708 //' "',copy(Src,ANode.StartPos,4),'" - "',copy(Src,ANode.EndPos-5,4),'"');
1709 if (StartNode.StartPos<=P)
1710 and ((StartNode.EndPos>P) or (StartNode.EndPos<1)) then begin
1711 // StartNode contains P
1712 Result:=StartNode;
1713 // -> search for a child that contains P
1714 Brother:=StartNode;
1715 while (Brother<>nil)
1716 and (Brother.StartPos<=P) do begin
1717 // brother also contains P
1718 if Brother.FirstChild<>nil then begin
1719 ChildNode:=FindDeepestNodeAtPos(Brother.FirstChild,P,false);
1720 if ChildNode<>nil then begin
1721 Result:=ChildNode;
1722 exit;
1723 end;
1724 end;
1725 Brother:=Brother.NextBrother;
1726 end;
1727 break;
1728 end else begin
1729 // search in next node
1730 StartNode:=StartNode.NextBrother;
1731 end;
1732 end;
1733 if (Result=nil) and ExceptionOnNotFound then begin
1734 MoveCursorToPos(P);
1735 RaiseNoNodeFoundAtCursor;
1736 end;
1737 end;
1738
CaretToCleanPosnull1739 function TCCodeParserTool.CaretToCleanPos(Caret: TCodeXYPosition; out
1740 CleanPos: integer): integer;
1741 begin
1742 CleanPos:=0;
1743 if Caret.Code<>Code then
1744 exit(-1);
1745 Code.LineColToPosition(Caret.Y,Caret.X,CleanPos);
1746 if (CleanPos>=1) then
1747 Result:=0
1748 else
1749 Result:=-2; // x,y beyond source
1750 end;
1751
CleanPosToCodePosnull1752 function TCCodeParserTool.CleanPosToCodePos(CleanPos: integer; out
1753 CodePos: TCodePosition): boolean;
1754 begin
1755 CodePos.Code:=Code;
1756 CodePos.P:=CleanPos;
1757 Result:=(Code<>nil) and (CleanPos>0) and (CleanPos<Code.SourceLength);
1758 end;
1759
CleanPosToCaretnull1760 function TCCodeParserTool.CleanPosToCaret(CleanPos: integer; out
1761 Caret: TCodeXYPosition): boolean;
1762 begin
1763 Caret.Code:=Code;
1764 Code.AbsoluteToLineCol(CleanPos,Caret.Y,Caret.X);
1765 Result:=CleanPos>0;
1766 end;
1767
TCCodeParserTool.CleanPosToCaretAndTopLinenull1768 function TCCodeParserTool.CleanPosToCaretAndTopLine(CleanPos: integer; out
1769 Caret: TCodeXYPosition; out NewTopLine: integer): boolean;
1770 begin
1771 Caret:=CleanCodeXYPosition;
1772 NewTopLine:=0;
1773 Result:=CleanPosToCaret(CleanPos,Caret);
1774 if Result then begin
1775 if JumpCentered then begin
1776 NewTopLine:=Caret.Y-(VisibleEditorLines shr 1);
1777 if NewTopLine<1 then NewTopLine:=1;
1778 end else
1779 NewTopLine:=Caret.Y;
1780 end;
1781 end;
1782
TCCodeParserTool.CleanPosToStrnull1783 function TCCodeParserTool.CleanPosToStr(CleanPos: integer): string;
1784 var
1785 CodePos: TCodeXYPosition;
1786 begin
1787 if CleanPosToCaret(CleanPos,CodePos) then
1788 Result:='y='+IntToStr(CodePos.Y)+',x='+IntToStr(CodePos.X)
1789 else
1790 Result:='y=?,x=?';
1791 end;
1792
TCCodeParserTool.MainFilenamenull1793 function TCCodeParserTool.MainFilename: string;
1794 begin
1795 Result:=Code.Filename;
1796 end;
1797
1798 procedure TCCodeParserTool.MoveCursorToPos(p: integer);
1799 begin
1800 SrcPos:=p;
1801 AtomStart:=p;
1802 LastAtomStart:=0;
1803 LastSrcPos:=0;
1804 end;
1805
1806 procedure TCCodeParserTool.MoveCursorToNode(Node: TCodeTreeNode);
1807 begin
1808 MoveCursorToPos(Node.StartPos);
1809 end;
1810
1811 procedure TCCodeParserTool.ReadNextAtom;
1812 begin
1813 //DebugLn(['TCCodeParserTool.ReadNextAtom START ',AtomStart,'-',SrcPos,' ',Src[SrcPos]]);
1814 LastSrcPos:=SrcPos;
1815 LastAtomStart:=AtomStart;
1816 repeat
1817 ReadRawNextCAtom(Src,SrcPos,AtomStart);
1818 until (SrcPos>SrcLen) or (not (Src[AtomStart] in [#10,#13]));
1819 {$IFDEF VerboseCCodeParser}
1820 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.ReadNextAtom END ',AtomStart,'-',SrcPos,' "',copy(Src,AtomStart,SrcPos-AtomStart),'"']);
1821 {$ENDIF}
1822 end;
1823
1824 procedure TCCodeParserTool.ReadNextAtomSkipDirectives;
1825 begin
1826 //DebugLn(['TCCodeParserTool.ReadNextAtom START ',AtomStart,'-',SrcPos,' ',Src[SrcPos]]);
1827 LastSrcPos:=SrcPos;
1828 LastAtomStart:=AtomStart;
1829 repeat
1830 ReadRawNextCAtom(Src,SrcPos,AtomStart);
1831 if (AtomStart>SrcLen) then break;
1832 if Src[AtomStart]='#' then begin
1833 ReadTilCLineEnd(Src,SrcPos);
1834 if (SrcPos>SrcLen) then break;
1835 end;
1836 until (not (Src[AtomStart] in [#10,#13]));
1837 {$IFDEF VerboseCCodeParser}
1838 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.ReadNextAtom END ',AtomStart,'-',SrcPos,' "',copy(Src,AtomStart,SrcPos-AtomStart),'"']);
1839 {$ENDIF}
1840 end;
1841
1842 procedure TCCodeParserTool.ReadRawNextAtom;
1843 begin
1844 LastSrcPos:=SrcPos;
1845 LastAtomStart:=AtomStart;
1846 ReadRawNextCAtom(Src,SrcPos,AtomStart);
1847 end;
1848
1849 procedure TCCodeParserTool.UndoReadNextAtom;
1850 begin
1851 if LastSrcPos>0 then begin
1852 SrcPos:=LastSrcPos;
1853 AtomStart:=LastAtomStart;
1854 LastSrcPos:=0;
1855 LastAtomStart:=0;
1856 end else begin
1857 SrcPos:=AtomStart;
1858 end;
1859 {$IFDEF VerboseCCodeParser}
1860 DebugLn([GetNodeIndent(CurNode),'TCCodeParserTool.UndoReadNextAtom END ',AtomStart,'-',SrcPos,' "',copy(Src,AtomStart,SrcPos-AtomStart),'"']);
1861 {$ENDIF}
1862 end;
1863
1864 {$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF}
1865 {$R-}
ReadTilBracketClosenull1866 function TCCodeParserTool.ReadTilBracketClose(
1867 ExceptionOnNotFound: boolean): boolean;
1868 // AtomStart must be on bracket open
1869 // after reading AtomStart is on closing bracket
1870 var
1871 CloseBracket: Char;
1872 StartPos: LongInt;
1873 begin
1874 Result:=false;
1875 case Src[AtomStart] of
1876 '{': CloseBracket:='}';
1877 '[': CloseBracket:=']';
1878 '(': CloseBracket:=')';
1879 '<': CloseBracket:='>';
1880 else
1881 if ExceptionOnNotFound then
1882 RaiseExpectedButAtomFound('(');
1883 exit;
1884 end;
1885 StartPos:=AtomStart;
1886 repeat
1887 ReadRawNextCAtom(Src,SrcPos,AtomStart);
1888 if AtomStart>SrcLen then begin
1889 AtomStart:=StartPos;
1890 SrcPos:=AtomStart+1;
1891 if ExceptionOnNotFound then
1892 RaiseException('closing bracket not found');
1893 exit;
1894 end;
1895 case Src[AtomStart] of
1896 '{','(','[':
1897 // skip nested bracketss
1898 begin
1899 if not ReadTilBracketClose(ExceptionOnNotFound) then
1900 exit;
1901 end;
1902 else
1903 if Src[AtomStart]=CloseBracket then exit(true);
1904 end;
1905 until false;
1906 end;
1907 {$IFDEF RangeChecking}{$R+}{$UNDEF RangeChecking}{$ENDIF}
1908
TCCodeParserTool.AtomIsnull1909 function TCCodeParserTool.AtomIs(const s: shortstring): boolean;
1910 var
1911 len: Integer;
1912 i: Integer;
1913 begin
1914 len:=length(s);
1915 if (len<>SrcPos-AtomStart) then exit(false);
1916 if SrcPos>SrcLen then exit(false);
1917 for i:=1 to len do
1918 if Src[AtomStart+i-1]<>s[i] then exit(false);
1919 Result:=true;
1920 end;
1921
TCCodeParserTool.AtomIsCharnull1922 function TCCodeParserTool.AtomIsChar(const c: char): boolean;
1923 begin
1924 if SrcPos-AtomStart<>1 then exit(false);
1925 if AtomStart>SrcLen then exit(false);
1926 if Src[AtomStart]<>c then exit(false);
1927 Result:=true;
1928 end;
1929
AtomIsCharOfSetnull1930 function TCCodeParserTool.AtomIsCharOfSet(const s: shortstring): boolean;
1931 var
1932 i: Integer;
1933 c: Char;
1934 begin
1935 if SrcPos-AtomStart<>1 then exit(false);
1936 if SrcPos>SrcLen then exit(false);
1937 c:=Src[AtomStart];
1938 for i:=1 to length(s) do
1939 if s[i]=c then exit(true);
1940 Result:=false;
1941 end;
1942
UpAtomIsnull1943 function TCCodeParserTool.UpAtomIs(const s: shortstring): boolean;
1944 var
1945 len: Integer;
1946 i: Integer;
1947 begin
1948 len:=length(s);
1949 if (len<>SrcPos-AtomStart) then exit(false);
1950 if SrcPos>SrcLen then exit(false);
1951 for i:=1 to len do
1952 if UpChars[Src[AtomStart+i-1]]<>s[i] then exit(false);
1953 Result:=true;
1954 end;
1955
TCCodeParserTool.AtomIsIdentifiernull1956 function TCCodeParserTool.AtomIsIdentifier: boolean;
1957 var
1958 p: Integer;
1959 begin
1960 if (AtomStart>=SrcPos) then exit(false);
1961 if (SrcPos>SrcLen) or (SrcPos-AtomStart>255) then exit(false);
1962 if not IsIdentStartChar[Src[AtomStart]] then exit(false);
1963 p:=AtomStart+1;
1964 while (p<SrcPos) do begin
1965 if not IsIdentChar[Src[p]] then exit(false);
1966 inc(p);
1967 end;
1968 Result:=true;
1969 end;
1970
AtomIsStringConstantnull1971 function TCCodeParserTool.AtomIsStringConstant: boolean;
1972 begin
1973 Result:=(AtomStart<SrcLen) and (Src[AtomStart]='"');
1974 end;
1975
AtomIsNumbernull1976 function TCCodeParserTool.AtomIsNumber: boolean;
1977 begin
1978 Result:=(AtomStart<SrcLen) and (Src[AtomStart] in ['0'..'9']);
1979 end;
1980
TCCodeParserTool.LastAtomIsnull1981 function TCCodeParserTool.LastAtomIs(const s: shortstring): boolean;
1982 var
1983 len: Integer;
1984 i: Integer;
1985 begin
1986 if LastAtomStart<=LastSrcPos then exit(false);
1987 len:=length(s);
1988 if (len<>LastSrcPos-LastAtomStart) then exit(false);
1989 if LastSrcPos>SrcLen then exit(false);
1990 for i:=1 to len do
1991 if Src[LastAtomStart+i-1]<>s[i] then exit(false);
1992 Result:=true;
1993 end;
1994
GetLastAtomnull1995 function TCCodeParserTool.GetLastAtom: string;
1996 begin
1997 Result:=copy(Src,LastAtomStart,LastSrcPos-LastAtomStart);
1998 end;
1999
TCCodeParserTool.ExtractCodenull2000 function TCCodeParserTool.ExtractCode(StartPos, EndPos: integer;
2001 WithDirectives: boolean): string;
2002 var
2003 s: string;
2004 p: integer;
2005
2006 procedure ReadIt;
2007 var
2008 l: Integer;
2009 NextChar: Char;
2010 LastChar: Char;
2011 begin
2012 MoveCursorToPos(StartPos);
2013 p:=1;
2014 LastChar:=' ';
2015 repeat
2016 // read next token
2017 if WithDirectives then
2018 ReadNextAtom
2019 else
2020 ReadNextAtomSkipDirectives;
2021 if (AtomStart>=EndPos) then break;
2022
2023 NextChar:=Src[AtomStart];
2024 if IsIdentChar[LastChar] and IsIdentStartChar[NextChar] then begin
2025 // add space
2026 if s<>'' then
2027 s[p]:=' ';
2028 inc(p);
2029 end;
2030 // add token
2031 l:=SrcPos-AtomStart;
2032 if s<>'' then begin
2033 // copy token
2034 System.Move(Src[AtomStart],s[p],SrcPos-AtomStart);
2035 end;
2036 inc(p,l);
2037 // remember last char
2038 LastChar:=Src[SrcPos-1];
2039 until false;
2040 end;
2041
2042 begin
2043 if EndPos>SrcLen then EndPos:=SrcLen+1;
2044 // first read and compute needed length
2045 ReadIt;
2046 // allocate space and copy tokens
2047 SetLength(s,p-1);
2048 ReadIt;
2049 Result:=s;
2050 end;
2051
GetFirstNameNodenull2052 function TCCodeParserTool.GetFirstNameNode(Node: TCodeTreeNode): TCodeTreeNode;
2053 begin
2054 Result:=Node.FirstChild;
2055 while (Result<>nil) and (Result.Desc<>ccnName) do Result:=Result.NextBrother;
2056 end;
2057
ExtractNamenull2058 function TCCodeParserTool.ExtractName(NameNode: TCodeTreeNode): string;
2059 begin
2060 Result:=copy(Src,NameNode.StartPos,NameNode.EndPos-NameNode.StartPos);
2061 end;
2062
ExtractDefinitionNamenull2063 function TCCodeParserTool.ExtractDefinitionName(VarNode: TCodeTreeNode): string;
2064 var
2065 NameNode: TCodeTreeNode;
2066 begin
2067 NameNode:=GetFirstNameNode(VarNode);
2068 if (NameNode=nil) then
2069 Result:=''
2070 else
2071 Result:=copy(Src,NameNode.StartPos,NameNode.EndPos-NameNode.StartPos);
2072 end;
2073
TCCodeParserTool.ExtractDefinitionTypenull2074 function TCCodeParserTool.ExtractDefinitionType(VarNode: TCodeTreeNode;
2075 WithDirectives: boolean): string;
2076 var
2077 NameNode: TCodeTreeNode;
2078 s: String;
2079 AfterNameNode: TCodeTreeNode;
2080 StartPos: Integer;
2081 begin
2082 Result:='';
2083 NameNode:=GetFirstNameNode(VarNode);
2084 if (NameNode<>nil) then begin
2085 Result:=ExtractCode(VarNode.StartPos,NameNode.StartPos,WithDirectives);
2086 AfterNameNode:=NameNode.NextBrother;
2087 StartPos:=NameNode.EndPos;
2088 end else begin
2089 AfterNameNode:=VarNode.FirstChild;
2090 StartPos:=VarNode.StartPos;
2091 end;
2092 if (AfterNameNode<>nil)
2093 and (AfterNameNode.Desc=ccnConstant) then begin
2094 // omit constant
2095 s:=ExtractCode(StartPos,AfterNameNode.StartPos,WithDirectives);
2096 if (s<>'') and (s[length(s)]='=') then
2097 s:=Trim(copy(s,1,length(s)-1));
2098 Result:=Result+s;
2099 end else begin
2100 Result:=Result+ExtractCode(StartPos,VarNode.EndPos,WithDirectives);
2101 end;
2102 end;
2103
TCCodeParserTool.ExtractTypeDefTypenull2104 function TCCodeParserTool.ExtractTypeDefType(TypeDefNode: TCodeTreeNode;
2105 WithDirectives: boolean): string;
2106 var
2107 NameNode: TCodeTreeNode;
2108 StartPos: Integer;
2109 begin
2110 Result:='';
2111 StartPos:=TypeDefNode.StartPos+length('typedef');
2112 NameNode:=GetFirstNameNode(TypeDefNode);
2113 if (NameNode<>nil) then begin
2114 Result:=ExtractCode(StartPos,NameNode.StartPos,WithDirectives);
2115 end else
2116 Result:=ExtractCode(StartPos,TypeDefNode.EndPos,WithDirectives);
2117 end;
2118
ExtractFunctionNamenull2119 function TCCodeParserTool.ExtractFunctionName(FuncNode: TCodeTreeNode): string;
2120 var
2121 NameNode: TCodeTreeNode;
2122 begin
2123 NameNode:=GetFirstNameNode(FuncNode);
2124 if (NameNode=nil) then
2125 Result:=''
2126 else
2127 Result:=copy(Src,NameNode.StartPos,NameNode.EndPos-NameNode.StartPos);
2128 end;
2129
GetFunctionParamListNodenull2130 function TCCodeParserTool.GetFunctionParamListNode(Node: TCodeTreeNode
2131 ): TCodeTreeNode;
2132 begin
2133 Result:=Node.FirstChild;
2134 while (Result<>nil) and (Result.Desc<>ccnFuncParamList) do
2135 Result:=Result.NextBrother;
2136 end;
2137
ExtractFunctionParamListnull2138 function TCCodeParserTool.ExtractFunctionParamList(FuncNode: TCodeTreeNode
2139 ): string;
2140 var
2141 ParamsNode: TCodeTreeNode;
2142 begin
2143 ParamsNode:=GetFunctionParamListNode(FuncNode);
2144 if (ParamsNode=nil) then
2145 Result:=''
2146 else
2147 Result:=ExtractCode(ParamsNode.StartPos,ParamsNode.EndPos);
2148 end;
2149
TCCodeParserTool.ExtractFunctionTypenull2150 function TCCodeParserTool.ExtractFunctionType(FuncNode: TCodeTreeNode;
2151 WithDirectives: boolean): string;
2152 var
2153 NameNode: TCodeTreeNode;
2154 begin
2155 NameNode:=GetFirstNameNode(FuncNode);
2156 if (NameNode=nil) then begin
2157 Result:='';
2158 exit;
2159 end;
2160 Result:=ExtractCode(FuncNode.StartPos,NameNode.StartPos,WithDirectives);
2161 if (NameNode.NextBrother<>nil)
2162 and (NameNode.NextBrother.Desc=ccnFuncParamList) then begin
2163 // The name is in between.
2164 // The type is result type + parameter list
2165 Result:=Result+ExtractCode(NameNode.EndPos,NameNode.NextBrother.EndPos,
2166 WithDirectives);
2167 end else begin
2168 Result:=Result+ExtractCode(NameNode.EndPos,FuncNode.EndPos,
2169 WithDirectives);
2170 end;
2171 end;
2172
TCCodeParserTool.ExtractFunctionResultTypenull2173 function TCCodeParserTool.ExtractFunctionResultType(FuncNode: TCodeTreeNode;
2174 WithDirectives: boolean; WithBrackets: boolean): string;
2175 var
2176 NameNode: TCodeTreeNode;
2177 p: Integer;
2178 CurAtomStart: integer;
2179 begin
2180 NameNode:=GetFirstNameNode(FuncNode);
2181 if (NameNode=nil) then begin
2182 Result:='';
2183 exit;
2184 end;
2185
modifiersnull2186 // skip function modifiers
2187 MoveCursorToNode(FuncNode);
2188 repeat
2189 ReadNextAtom;
2190 if AtomStart>=NameNode.StartPos then break;
2191 if not IsCCodeFunctionModifier.DoItCaseSensitive(Src,AtomStart,SrcPos-AtomStart)
2192 then
2193 break;
2194 until false;
2195
2196 Result:=ExtractCode(AtomStart,NameNode.StartPos,WithDirectives);
2197 if (NameNode.NextBrother<>nil)
2198 and (NameNode.NextBrother.Desc=ccnFuncParamList) then begin
2199 // The name is in between.
2200 Result:=Result+ExtractCode(NameNode.EndPos,NameNode.NextBrother.StartPos,
2201 WithDirectives);
2202 end else begin
2203 Result:=Result+ExtractCode(NameNode.EndPos,FuncNode.EndPos,
2204 WithDirectives);
2205 end;
2206
2207 if not WithBrackets then begin
2208 p:=1;
2209 repeat
2210 ReadRawNextCAtom(Result,p,CurAtomStart);
2211 if CurAtomStart>length(Result) then break;
2212 if Result[CurAtomStart]='(' then begin
2213 p:=CurAtomStart;
2214 if ReadTilCBracketClose(Result,p) then begin
2215 Result:=copy(Result,1,CurAtomStart-1)
2216 +copy(Result,p,length(Result));
2217 end;
2218 break;
2219 end;
2220 until false;
2221 end;
2222 end;
2223
IsPointerToFunctionnull2224 function TCCodeParserTool.IsPointerToFunction(FuncNode: TCodeTreeNode
2225 ): boolean;
2226 // for example: int *(*fp)();
2227 var
2228 NameNode: TCodeTreeNode;
2229 begin
2230 NameNode:=FuncNode.FirstChild;
2231 if (NameNode=nil) or (NameNode.Desc<>ccnName) then exit(false);
2232 MoveCursorToNode(FuncNode);
2233 repeat
2234 ReadNextAtom;
2235 if AtomStart>SrcLen then exit(false);
2236 if AtomIs('(') then exit(true);
2237 if (IsIdentStartChar[Src[AtomStart]])
2238 or (AtomIs('*')) then begin
2239 // skip words and *
2240 end else begin
2241 break;
2242 end;
2243 until AtomStart>=NameNode.StartPos;
2244 Result:=false;
2245 end;
2246
ExtractParameterNamenull2247 function TCCodeParserTool.ExtractParameterName(ParamNode: TCodeTreeNode
2248 ): string;
2249 var
2250 NameNode: TCodeTreeNode;
2251 begin
2252 NameNode:=GetFirstNameNode(ParamNode);
2253 if (NameNode=nil) then
2254 Result:=''
2255 else
2256 Result:=copy(Src,NameNode.StartPos,NameNode.EndPos-NameNode.StartPos);
2257 end;
2258
ExtractParameterTypenull2259 function TCCodeParserTool.ExtractParameterType(ParamNode: TCodeTreeNode;
2260 WithDirectives: boolean): string;
2261 var
2262 NameNode: TCodeTreeNode;
2263 s: String;
2264 ConstantNode: TCodeTreeNode;
2265 begin
2266 NameNode:=GetFirstNameNode(ParamNode);
2267 if (ParamNode.LastChild<>nil)
2268 and (ParamNode.LastChild.Desc=ccnConstant) then
2269 ConstantNode:=ParamNode.LastChild
2270 else
2271 ConstantNode:=nil;
2272 if (NameNode=nil) then begin
2273 if ConstantNode<>nil then begin
2274 // a parameter with an initial value
2275 // omit the constant
2276 Result:=ExtractCode(ParamNode.StartPos,ConstantNode.StartPos,WithDirectives);
2277 Result:=copy(Result,1,length(Result)-1);
2278 end else begin
2279 Result:=ExtractCode(ParamNode.StartPos,ParamNode.EndPos,WithDirectives);
2280 end;
2281 end else begin
2282 Result:=ExtractCode(ParamNode.StartPos,NameNode.StartPos,WithDirectives);
2283 if (NameNode.NextBrother<>nil)
2284 and (NameNode.NextBrother.Desc=ccnConstant) then begin
2285 // a parameter with an initial value
2286 // omit the constant
2287 s:=ExtractCode(NameNode.EndPos,NameNode.NextBrother.StartPos,
2288 WithDirectives);
2289 s:=copy(s,1,length(s)-1);
2290 Result:=Result+s;
2291 end else begin
2292 Result:=Result+ExtractCode(NameNode.EndPos,ParamNode.EndPos,
2293 WithDirectives);
2294 end;
2295 end;
2296 end;
2297
ExtractEnumBlockNamenull2298 function TCCodeParserTool.ExtractEnumBlockName(EnumBlockNode: TCodeTreeNode
2299 ): string;
2300 var
2301 NameNode: TCodeTreeNode;
2302 begin
2303 if (EnumBlockNode.FirstChild<>nil)
2304 and (EnumBlockNode.FirstChild.Desc=ccnName) then begin
2305 NameNode:=EnumBlockNode.FirstChild;
2306 Result:=copy(Src,NameNode.StartPos,NameNode.EndPos-NameNode.StartPos);
2307 end else begin
2308 Result:='';
2309 end;
2310 end;
2311
ExtractEnumIDNamenull2312 function TCCodeParserTool.ExtractEnumIDName(EnumIDNode: TCodeTreeNode): string;
2313 begin
2314 Result:=GetIdentifier(@Src[EnumIDNode.StartPos]);
2315 end;
2316
ExtractEnumIDValuenull2317 function TCCodeParserTool.ExtractEnumIDValue(EnumIDNode: TCodeTreeNode;
2318 WithDirectives: boolean): string;
2319 var
2320 ConstantNode: TCodeTreeNode;
2321 begin
2322 ConstantNode:=EnumIDNode.FirstChild;
2323 if (ConstantNode=nil)
2324 or (ConstantNode.Desc<>ccnConstant) then
2325 Result:=''
2326 else
2327 Result:=ExtractCode(ConstantNode.StartPos,ConstantNode.EndPos,
2328 WithDirectives);
2329 end;
2330
ExtractStructNamenull2331 function TCCodeParserTool.ExtractStructName(StructNode: TCodeTreeNode): string;
2332 var
2333 NameNode: TCodeTreeNode;
2334 begin
2335 NameNode:=StructNode.FirstChild;
2336 if (NameNode<>nil) and (NameNode.Desc=ccnTypeName) then
2337 Result:=GetIdentifier(@Src[NameNode.StartPos])
2338 else
2339 Result:='';
2340 end;
2341
ExtractUnionNamenull2342 function TCCodeParserTool.ExtractUnionName(UnionNode: TCodeTreeNode): string;
2343 var
2344 NameNode: TCodeTreeNode;
2345 begin
2346 NameNode:=UnionNode.FirstChild;
2347 if (NameNode<>nil) and (NameNode.Desc=ccnName) then
2348 Result:=GetIdentifier(@Src[NameNode.StartPos])
2349 else
2350 Result:='';
2351 end;
2352
ExtractTypedefNamenull2353 function TCCodeParserTool.ExtractTypedefName(TypedefNode: TCodeTreeNode
2354 ): string;
2355 var
2356 Node: TCodeTreeNode;
2357 begin
2358 Node:=TypedefNode.LastChild;
2359 while (Node<>nil) and (Node.Desc<>ccnName) do
2360 Node:=Node.PriorBrother;
2361 if Node=nil then begin
2362 if (TypedefNode.FirstChild<>nil)
2363 and (TypedefNode.FirstChild.Desc=ccnFunction) then
2364 Result:=ExtractFunctionName(TypedefNode.FirstChild)
2365 else
2366 Result:='';
2367 end else
2368 Result:=GetIdentifier(@Src[Node.StartPos]);
2369 end;
2370
IsDirectivenull2371 function TCCodeParserTool.IsDirective(DirectiveNode: TCodeTreeNode;
2372 const Action: shortstring): boolean;
2373 begin
2374 Result:=false;
2375 if (DirectiveNode=nil) or (DirectiveNode.Desc<>ccnDirective) then exit;
2376 MoveCursorToPos(DirectiveNode.StartPos+1);
2377 ReadNextAtom;
2378 Result:=AtomIs(Action);
2379 end;
2380
ExtractDirectiveActionnull2381 function TCCodeParserTool.ExtractDirectiveAction(DirectiveNode: TCodeTreeNode
2382 ): string;
2383 begin
2384 if DirectiveNode.StartPos<SrcLen then
2385 Result:=GetIdentifier(@Src[DirectiveNode.StartPos+1])
2386 else
2387 Result:='';
2388 end;
2389
ExtractDirectiveFirstAtomnull2390 function TCCodeParserTool.ExtractDirectiveFirstAtom(DirectiveNode: TCodeTreeNode
2391 ): string;
2392 begin
2393 MoveCursorToPos(DirectiveNode.StartPos+1);
2394 // read action
2395 ReadRawNextAtom;
2396 // read first atom
2397 ReadRawNextAtom;
2398 Result:=GetAtom;
2399 end;
2400
ExtractDirectiveParamsnull2401 function TCCodeParserTool.ExtractDirectiveParams(DirectiveNode: TCodeTreeNode
2402 ): string;
2403 begin
2404 MoveCursorToPos(DirectiveNode.StartPos+1);
2405 // read action
2406 ReadRawNextAtom;
2407 // read first atom
2408 ReadRawNextAtom;
2409 Result:=ExtractCode(AtomStart,DirectiveNode.EndPos);
2410 end;
2411
ExtractDefinenull2412 function TCCodeParserTool.ExtractDefine(DefineNode: TCodeTreeNode; out
2413 MacroName, MacroParamList, MacroValue: string): boolean;
2414 var
2415 StartPos: LongInt;
2416 EndPos: LongInt;
2417 begin
2418 Result:=false;
2419 MacroName:='';
2420 MacroParamList:='';
2421 MacroValue:='';
2422 MoveCursorToPos(DefineNode.StartPos+1);
2423 // read action
2424 ReadRawNextAtom;
2425 if not AtomIs('define') then exit;
2426 // read first atom
2427 ReadRawNextAtom;
2428 MacroName:=GetAtom;
2429 StartPos:=SrcPos;
2430 // read param list
2431 if (SrcPos<=SrcLen) and (Src[SrcPos]='(') then begin
2432 StartPos:=SrcPos;
2433 AtomStart:=SrcPos;
2434 SrcPos:=AtomStart+1;
2435 if not ReadTilBracketClose(false) then exit;
2436 EndPos:=SrcPos;
2437 MacroParamList:=ExtractCode(StartPos,EndPos);
2438 StartPos:=EndPos;
2439 end;
2440 // read value
2441 while (StartPos<=SrcLen) and (IsSpaceChar[Src[StartPos]]) do
2442 inc(StartPos);
2443 EndPos:=DefineNode.EndPos;
2444 while (EndPos>StartPos) and (IsSpaceChar[Src[EndPos-1]]) do
2445 dec(EndPos);
2446 MacroValue:=copy(Src,StartPos,EndPos-StartPos);
2447 Result:=true;
2448 end;
2449
FindDirectiveBlockEndnull2450 function TCCodeParserTool.FindDirectiveBlockEnd(InnerNode: TCodeTreeNode
2451 ): TCodeTreeNode;
2452 // find the end of block that contains InnerNode
2453 begin
2454 Result:=InnerNode;
2455 if Result=nil then exit;
2456 Result:=Result.Next;
2457 IfLevel:=0;
2458 while Result<>nil do begin
2459 if Result.Desc=ccnDirective then begin
2460 //DebugLn(['TCCodeParserTool.FindDirectiveBlockEnd ',NodeAsString(Result),' ',IfLevel]);
2461 case Result.SubDesc of
2462 ccnsDirectiveIf,ccnsDirectiveIfDef,ccnsDirectiveIfNDef:
2463 IncIfLevel(Result.StartPos);
2464 ccnsDirectiveElse,ccnsDirectiveElIf:
2465 begin
2466 if IfLevel=0 then
2467 exit;
2468 dec(IfLevel);
2469 IncIfLevel(Result.StartPos);
2470 end;
2471 ccnsDirectiveEndIf:
2472 begin
2473 if IfLevel=0 then
2474 exit;
2475 dec(IfLevel);
2476 end;
2477 end;
2478 end;
2479 Result:=Result.Next;
2480 end;
2481 end;
2482
FindElseOrEndIfnull2483 function TCCodeParserTool.FindElseOrEndIf(IfOrElseNode: TCodeTreeNode
2484 ): TCodeTreeNode;
2485 // find corresponding #EndIf or #Else or #ElIf
2486 begin
2487 Result:=IfOrElseNode;
2488 // check if IfOrElseNode is valid
2489 if (Result=nil) or (Result.Desc<>ccnDirective)
2490 or (not (Result.SubDesc in [ccnsDirectiveIf,ccnsDirectiveIfDef,
2491 ccnsDirectiveIfNDef,ccnsDirectiveElIf,ccnsDirectiveElse]))
2492 then
2493 exit(nil);
2494 // check if next node is the end of the block
2495 Result:=Result.Next;
2496 if Result=nil then exit;
2497 if (Result.Desc=ccnDirective)
2498 and (Result.SubDesc in [ccnsDirectiveElIf,ccnsDirectiveElse,ccnsDirectiveEndIf])
2499 then
2500 exit;
2501 // Result is a node in the block => search end of block
2502 Result:=FindDirectiveBlockEnd(Result);
2503 end;
2504
FindEndIfnull2505 function TCCodeParserTool.FindEndIf(IfOrElseNode: TCodeTreeNode): TCodeTreeNode;
2506 // find corresponding #EndIf
2507 begin
2508 Result:=IfOrElseNode;
2509 repeat
2510 Result:=FindElseOrEndIf(Result);
2511 if (Result=nil)
2512 or ((Result.Desc=ccnDirective) and (Result.SubDesc=ccnsDirectiveEndIf))
2513 then
2514 exit;
2515 until false;
2516 end;
2517
FindEnclosingIFNDEFnull2518 function TCCodeParserTool.FindEnclosingIFNDEF: TCodeTreeNode;
2519 { Search for the typical enclosing IFNDEF of c header file:
2520 - No code in front
2521 - #IFNDEF NAME
2522 - #DEFINE NAME
2523 - ...
2524 - #ENDIF
2525 - No code behind
2526 }
2527 var
2528 IfNDefNode: TCodeTreeNode;
2529 MacroName: String;
2530 DefNode: TCodeTreeNode;
2531 DefMacroName: String;
2532 EndIfNode: TCodeTreeNode;
2533 Node: TCodeTreeNode;
2534 begin
2535 Result:=nil;
2536 {$IFDEF VerboseCCodeParser}
2537 WriteDebugReport;
2538 {$ENDIF}
2539 IfNDefNode:=Tree.Root;
2540 // skip root and extern nodes
2541 while (IfNDefNode<>nil) do begin
2542 if (IfNDefNode.Desc<>ccnRoot)
2543 and (IfNDefNode.Desc<>ccnExternBlock) then
2544 break;
2545 IfNDefNode:=IfNDefNode.Next;
2546 end;
2547 if IfNDefNode=nil then exit;
2548 // check if IfNDefNode is #IFNDEF name
2549 if (IfNDefNode.Desc<>ccnDirective)
2550 or (IfNDefNode.SubDesc<>ccnsDirectiveIfNDef) then
2551 exit;
2552 MacroName:=ExtractDirectiveFirstAtom(IfNDefNode);
2553 // check if next node is #DEFINE name
2554 DefNode:=IfNDefNode.Next;
2555 if (DefNode=nil) or (DefNode.Desc<>ccnDirective)
2556 or (DefNode.SubDesc<>ccnsDirectiveDefine) then exit;
2557 DefMacroName:=ExtractDirectiveFirstAtom(DefNode);
2558 if CompareIdentifiers(PChar(MacroName),PChar(DefMacroName))<>0 then exit;
2559 // find #endif
2560 EndIfNode:=FindEndIf(IfNDefNode);
2561 if EndIfNode=nil then exit;
2562 // check that no code comes after the #EndIf
2563 Node:=EndIfNode;
2564 while (Node<>nil) do begin
2565 if (Node.Desc=ccnExternBlock)
2566 or ((Node.Desc=ccnDirective)
2567 and (Node.SubDesc in [ccnsDirectiveIf,ccnsDirectiveIfDef,
2568 ccnsDirectiveIfNDef,ccnsDirectiveElIf,ccnsDirectiveEndIf]))
2569 then
2570 Node:=Node.Next
2571 else
2572 exit;
2573 end;
2574 Result:=IfNDefNode;
2575 end;
2576
GetAtomnull2577 function TCCodeParserTool.GetAtom: string;
2578 begin
2579 Result:=copy(Src,AtomStart,SrcPos-AtomStart);
2580 end;
2581
2582 procedure TCCodeParserTool.Replace(FromPos, ToPos: integer; const NewSrc: string);
2583 var
2584 Node: TCodeTreeNode;
2585 DiffPos: Integer;
2586 begin
2587 {$IFDEF VerboseCCodeParser}
2588 DebugLn(['TCCodeParserTool.Replace ',FromPos,'-',ToPos,' Old="',copy(Src,FromPos,ToPos-FromPos),'" New="',NewSrc,'"']);
2589 {$ENDIF}
2590 IncreaseChangeStep;
2591 Code.Replace(FromPos,ToPos-FromPos,NewSrc);
2592 Src:=Code.Source;
2593 SrcLen:=length(Src);
2594 // update positions
2595 DiffPos:=length(NewSrc)-(ToPos-FromPos);
2596 if DiffPos<>0 then begin
2597 Node:=Tree.Root;
2598 while Node<>nil do begin
2599 AdjustPositionAfterInsert(Node.StartPos,true,FromPos,ToPos,DiffPos);
2600 AdjustPositionAfterInsert(Node.EndPos,false,FromPos,ToPos,DiffPos);
2601 Node:=Node.Next;
2602 end;
2603 end;
2604 end;
2605
2606 procedure TCCodeParserTool.IncreaseChangeStep;
2607 begin
2608 if FChangeStep<>$7fffffff then
2609 inc(FChangeStep)
2610 else
2611 FChangeStep:=-$7fffffff;
2612 end;
2613
2614 procedure TCCodeParserTool.WriteDebugReport;
2615 var
2616 Node: TCodeTreeNode;
2617 begin
2618 DebugLn(['TCCodeParserTool.WriteDebugReport ']);
2619 if Tree<>nil then begin
2620 Node:=Tree.Root;
2621 while Node<>nil do begin
2622 DebugLn([GetNodeIndent(Node)+NodeAsString(Node)]);
2623 Node:=Node.Next;
2624 end;
2625 end;
2626 end;
2627
2628 procedure TCCodeParserTool.CheckNodeTool(Node: TCodeTreeNode);
2629
2630 procedure RaiseForeignNode;
2631 begin
2632 RaiseCatchableException('TCCodeParserTool.CheckNodeTool '+DbgSName(Self)+' '+CCNodeDescAsString(Node.Desc));
2633 end;
2634
2635 begin
2636 if Node=nil then exit;
2637 while Node.Parent<>nil do Node:=Node.Parent;
2638 while Node.PriorBrother<>nil do Node:=Node.PriorBrother;
2639 if (Tree=nil) or (Tree.Root<>Node) then
2640 RaiseForeignNode;
2641 end;
2642
NodeAsStringnull2643 function TCCodeParserTool.NodeAsString(Node: TCodeTreeNode): string;
2644 begin
2645 if Node=nil then begin
2646 Result:='nil';
2647 exit;
2648 end;
2649 case Node.Desc of
2650 ccnName, ccnTypeName: Result:=copy(Src,Node.StartPos,Node.EndPos-Node.StartPos);
2651 else Result:='';
2652 end;
2653 Result:=Result+'('+CCNodeDescAsString(Node.Desc,Node.SubDesc)
2654 +' at '+CleanPosToStr(Node.StartPos)+')';
2655 end;
2656
2657 procedure InternalFinal;
2658 var
2659 i: Integer;
2660 begin
2661 if KeyWordLists<>nil then begin
2662 for i:=0 to KeyWordLists.Count-1 do
2663 TObject(KeyWordLists[i]).Free;
2664 FreeAndNil(KeyWordLists);
2665 end;
2666 end;
2667
2668 finalization
2669 InternalFinal;
2670
2671 end.
2672
2673