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 TCodeTree is the product of a code tool. Every TCodeTreeNode describes a
25 logical block in the code (e.g. a class, a procedure or an identifier).
26
27 This unit defines also all valid CodeTree-Node-Descriptors, constants for
28 TCodeTreeNode types.
29
30 }
31 unit CodeTree;
32
33 {$ifdef FPC}{$mode objfpc}{$endif}{$H+}
34
35 interface
36
37 {$I codetools.inc}
38
39 {$IMPLICITEXCEPTIONS OFF} // no automatic try..finally (exceptions in all functions are fatal)
40
41 uses
42 {$IFDEF MEM_CHECK}
43 MemCheck,
44 {$ENDIF}
45 Classes, SysUtils, Laz_AVL_Tree,
46 // LazUtils
47 LazDbgLog,
48 // Codetools
49 FileProcs, CodeToolsStructs, BasicCodeTools;
50
51 //-----------------------------------------------------------------------------
52
53 type
54 TCodeTreeNodeDesc = word;
55 TCodeTreeNodeSubDesc = word;
56
57 const
58 // CodeTreeNodeDescriptors
59 ctnNone = 0;
60
61 ctnProgram = 1; // children are ctnSrcName, ctnUsesSection
62 ctnPackage = 2;
63 ctnLibrary = 3;
64 ctnUnit = 4;
65 ctnInterface = 5;
66 ctnImplementation = 6;
67 ctnInitialization = 7;
68 ctnFinalization = 8;
69 ctnEndPoint = 9;
70
71 ctnTypeSection = 10;
72 ctnVarSection = 11;
73 ctnConstSection = 12;
74 ctnResStrSection = 13;
75 ctnLabelSection = 14;
76 ctnPropertySection = 15;
77 ctnUsesSection = 16; // child nodes are ctnUseUnit, parent is ctnInterface,ctnImplementation,ctnProgram,ctnPackage,ctnLibrary
78 ctnRequiresSection = 17;
79 ctnContainsSection = 18; // child nodes are ctnUseUnit
80 ctnExportsSection = 19;
81
82 ctnTypeDefinition = 20;
83 ctnVarDefinition = 21;
84 ctnConstDefinition = 22;
85 ctnGlobalProperty = 23;
86 ctnVarArgs = 24;
87 ctnSrcName = 25; // children are ctnIdentifier
88 ctnUseUnit = 26; // StartPos=unit, EndPos=unitname+inFilename, children ctnUseUnitNamespace, ctnUseUnitClearName, parent ctnUsesSection
89 ctnUseUnitNamespace = 27; // <namespace>.clearname.pas, parent ctnUseUnit
90 ctnUseUnitClearName = 28; // namespace.<clearname>.pas, parent ctnUseUnit
91
92 ctnClass = 30;
93 ctnClassInterface = 31;
94 ctnDispinterface = 32;
95 ctnObject = 33;
96 ctnObjCClass = 34;
97 ctnObjCCategory = 35;
98 ctnObjCProtocol = 36;
99 ctnCPPClass = 37;
100 ctnTypeHelper = 38;//"type helper", parent/child similar to ctnClass
101 ctnRecordHelper = 39;//"record helper", parent/child similar to ctnClass
102
103 ctnClassAbstract = 40;
104 ctnClassSealed = 41;
105 ctnClassExternal = 42; // parent: jvm: ctnClass, ObjCClass, ObjCProtocol
106 ctnClassHelper = 43;//"class helper", parent/child similar to ctnClass
107 ctnClassInheritance = 44;
108 ctnHelperFor = 45;//class/record/type helper for, only child is ctnIdentifier
109 ctnClassGUID = 46;
110 ctnClassClassVar = 47; // child of visibility section
111 ctnClassPrivate = 48; // child of AllClassObjects
112 ctnClassProtected = 49;
113 ctnClassPublic = 50;
114 ctnClassPublished = 51;
115 ctnClassRequired = 52; // parent: ObjCProtocol
116 ctnClassOptional = 53; // parent: ObjCProtocol
117 ctnProperty = 54; // child of visibility section or AllClassInterfaces
118 ctnMethodMap = 55; // child of visibility section or AllClassInterfaces
119
120 ctnProcedure = 60; // children: ctnProcedureHead, sections, ctnBeginBlock/ctnAsmBlock
ctnIdentifiernull121 ctnProcedureHead = 61; // children: ctnParameterList, operator: ctnVarDefinition, operator/function: ctnIdentifier
122 ctnParameterList = 62; // children: ctnVarDefinition
123
124 ctnIdentifier = 70;
125 ctnRangedArrayType = 71;
126 ctnOpenArrayType = 72;
127 ctnOfConstType = 73;
128 ctnRecordType = 74;
129 ctnRecordCase = 75; // children: ctnVarDefinition plus 0..n ctnRecordVariant
130 ctnRecordVariant = 76; // children: 0..n ctnVarDefinition plus may be a ctnRecordCase
131 ctnProcedureType = 77;
132 ctnSetType = 78;
133 ctnRangeType = 79;
134 ctnEnumerationType = 80;
135 ctnEnumIdentifier = 81;
136 ctnLabel = 82;
137 ctnTypeType = 83;
138 ctnFileType = 84;
139 ctnPointerType = 85;
140 ctnClassOfType = 86; // 1st child = ctnIdentifier
141 ctnVariantType = 87;
142 ctnGenericType = 88;// 1st child = ctnGenericName, 2nd child = ctnGenericParams, 3th child = type
143 ctnGenericName = 89; // parent = ctnGenericType
144 ctnGenericParams = 90; // parent = ctnGenericType, children = ctnGenericParameter
145 ctnGenericParameter = 91; // can has a child ctnGenericConstraint
146 ctnGenericConstraint = 92; // parent = ctnGenericParameter
147 ctnSpecialize = 93; // 1st child = ctnSpecializeType, 2nd child = ctnSpecializeParams, in mode ObjFPC it starts at keyword 'specialize'
148 ctnSpecializeType = 94; // parent = ctnSpecialize
149 ctnSpecializeParams = 95; // list of ctnSpecializeParam, parent = ctnSpecialize
150 ctnSpecializeParam = 96; // parent = ctnSpecializeParams
151
152 ctnBeginBlock =100;
153 ctnAsmBlock =101;
154
155 ctnWithVariable =110;
156 ctnWithStatement =111;
157 ctnOnBlock =112;// childs: ctnOnIdentifier+ctnOnStatement, or ctnVarDefinition(with child ctnIdentifier)+ctnOnStatement
158 ctnOnIdentifier =113;// e.g. 'on Exception', Note: on E:Exception creates a ctnVarDefinition
159 ctnOnStatement =114;
160 ctnParamsRound =115;
161
162 ctnReferenceTo =120; // 1st child = ctnProcedureType
163 ctnConstant =121;
164 ctnHintModifier =122; // deprecated, platform, unimplemented, library, experimental
165 ctnAttribute =123; // children are ctnAttribParam
166 ctnAttribParam =124; // 1st child: ctnIdentifier, optional 2nd: ctnParamsRound
167
168 ctnUser =1000; // user constants start here
169
170 // combined values
171 AllSourceTypes =
172 [ctnProgram,ctnPackage,ctnLibrary,ctnUnit];
173 AllUsableSourceTypes =
174 [ctnUnit];
175 AllCodeSections = AllSourceTypes
176 + [ctnInterface, ctnImplementation, ctnInitialization, ctnFinalization];
177 AllClassBaseSections =
178 [ctnClassPublic,ctnClassPublished,ctnClassPrivate,ctnClassProtected,
179 ctnClassRequired,ctnClassOptional];
180 AllClassSubSections =
181 [ctnConstSection, ctnTypeSection, ctnVarSection, ctnClassClassVar];
182 AllClassSections =
183 AllClassBaseSections+AllClassSubSections;
184 AllClassInterfaces = [ctnClassInterface,ctnDispinterface,ctnObjCProtocol];
185 AllClassObjects = [ctnClass,ctnObject,ctnRecordType,
186 ctnObjCClass,ctnObjCCategory,ctnCPPClass,
187 ctnClassHelper,ctnRecordHelper,ctnTypeHelper];
188 AllClasses = AllClassObjects+AllClassInterfaces;
189 AllClassModifiers = [ctnClassAbstract, ctnClassSealed, ctnClassExternal];
190 AllDefinitionSections =
191 [ctnTypeSection,ctnVarSection,ctnConstSection,ctnResStrSection,
192 ctnLabelSection,ctnPropertySection];
193 AllSimpleIdentifierDefinitions =
194 [ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition];
195 AllIdentifierDefinitions = AllSimpleIdentifierDefinitions
196 +[ctnGenericType,ctnGlobalProperty];
197 AllPascalTypes =
198 AllClasses+
199 [ctnGenericType,ctnSpecialize,
200 ctnIdentifier,ctnOpenArrayType,ctnRangedArrayType,
201 ctnRecordCase,ctnRecordVariant,
202 ctnProcedureType,ctnReferenceTo,
203 ctnSetType,ctnRangeType,ctnEnumerationType,
204 ctnEnumIdentifier,ctnLabel,ctnTypeType,ctnFileType,ctnPointerType,
205 ctnClassOfType,ctnVariantType,ctnConstant];
206 AllProcTypes = [ctnProcedureType,ctnReferenceTo];
207 AllPascalStatements = [ctnBeginBlock,ctnWithStatement,ctnWithVariable,
208 ctnOnBlock,ctnOnIdentifier,ctnOnStatement,
209 ctnInitialization,ctnFinalization];
210 AllFindContextDescs = AllIdentifierDefinitions + AllCodeSections + AllClasses +
211 [ctnProcedure];
212 AllPointContexts = AllClasses+AllSourceTypes+
213 [ctnEnumerationType,ctnInterface,ctnImplementation,ctnTypeType,
214 ctnUseUnitNamespace,ctnUseUnitClearName,ctnRangedArrayType,ctnOpenArrayType];
215
216
217 // CodeTreeNodeSubDescriptors
218 ctnsNone = 0;
219 ctnsNeedJITParsing = 1 shl 1;
220 ctnsHasParseError = 1 shl 2;
221 ctnsForwardDeclaration = 1 shl 3;
222 ctnsHasDefaultValue = 1 shl 4;
223
224 ClassSectionNodeType: array[TPascalClassSection] of TCodeTreeNodeDesc = (
225 ctnClassPrivate,
226 ctnClassProtected,
227 ctnClassPublic,
228 ctnClassPublished
229 );
230
231
232 type
233 // Procedure Specifiers
234 TProcedureSpecifier = (
235 psStdCall,
236 psRegister,
237 psPopStack,
238 psVirtual,
239 psAbstract,
240 psDynamic,
241 psOverload,
242 psOverride,
243 psReintroduce,
244 psCDecl,
245 psInline,
246 psMessage,
247 psExternal,
248 psForward,
249 psPascal,
250 psAssembler,
251 psSaveRegisters,
252 psFar,
253 psNear,
254 psFinal,
255 psStatic,
256 psMWPascal,
257 psNoStackframe,
258 psDeprecated,
259 psDispID,
260 psPlatform,
261 psSafeCall,
262 psUnimplemented,
263 psExperimental,
264 psLibrary,
265 psEnumerator,
266 psVarargs,
267 psVectorCall,
268 psEdgedBracket
269 );
270 TAllProcedureSpecifiers = set of TProcedureSpecifier;
271
272 const
273 ProcedureSpecifierNames: array[TProcedureSpecifier] of shortstring = (
274 'STDCALL', 'REGISTER', 'POPSTACK', 'VIRTUAL', 'ABSTRACT', 'DYNAMIC',
275 'OVERLOAD', 'OVERRIDE', 'REINTRODUCE', 'CDECL', 'INLINE', 'MESSAGE',
276 'EXTERNAL', 'FORWARD', 'PASCAL', 'ASSEMBLER', 'SAVEREGISTERS',
277 'FAR', 'NEAR', 'FINAL', 'STATIC', 'MWPASCAL', 'NOSTACKFRAME',
278 'DEPRECATED', 'DISPID', 'PLATFORM', 'SAFECALL', 'UNIMPLEMENTED',
279 'EXPERIMENTAL', 'LIBRARY', 'ENUMERATOR', 'VARARGS', 'VECTORCALL',
280 '['
281 );
282
283
284 type
285
286 { TCodeTreeNode }
287
288 TCodeTreeNode = packed class
289 public
290 Parent, NextBrother, PriorBrother, FirstChild, LastChild: TCodeTreeNode;
291 Cache: TObject;
292 StartPos, EndPos: integer;
293 Desc: TCodeTreeNodeDesc;
294 SubDesc: TCodeTreeNodeSubDesc;
Nextnull295 function Next: TCodeTreeNode;
NextSkipChildsnull296 function NextSkipChilds: TCodeTreeNode;
Priornull297 function Prior: TCodeTreeNode;
GetNodeInFrontOfPosnull298 function GetNodeInFrontOfPos(p: integer): TCodeTreeNode;
GetRootnull299 function GetRoot: TCodeTreeNode;
ChildCountnull300 function ChildCount: integer;
HasAsParentnull301 function HasAsParent(Node: TCodeTreeNode): boolean;
HasAsChildnull302 function HasAsChild(Node: TCodeTreeNode): boolean;
HasParentOfTypenull303 function HasParentOfType(ParentDesc: TCodeTreeNodeDesc): boolean;
HasAsRootnull304 function HasAsRoot(RootNode: TCodeTreeNode): boolean;
GetNodeOfTypenull305 function GetNodeOfType(ADesc: TCodeTreeNodeDesc): TCodeTreeNode;
GetNodeOfTypesnull306 function GetNodeOfTypes(const Descriptors: array of TCodeTreeNodeDesc): TCodeTreeNode;
GetTopMostNodeOfTypenull307 function GetTopMostNodeOfType(ADesc: TCodeTreeNodeDesc): TCodeTreeNode;
GetFindContextParentnull308 function GetFindContextParent: TCodeTreeNode;
GetLevelnull309 function GetLevel: integer;
GetLastNodenull310 function GetLastNode: TCodeTreeNode;
DescAsStringnull311 function DescAsString: string;
FindOwnernull312 function FindOwner: TObject;
313 procedure Clear;
314 constructor Create;
315 procedure ConsistencyCheck;
316 procedure WriteDebugReport(const Prefix: string; WithChilds: boolean);
317 end;
318
319 { TCodeTree }
320
321 TCodeTree = class
322 private
323 FNodeCount: integer;
324 public
325 Root: TCodeTreeNode;
326 property NodeCount: integer read FNodeCount;
327 procedure RemoveNode(ANode: TCodeTreeNode);
328 procedure DeleteNode(ANode: TCodeTreeNode);
329 procedure AddNodeAsLastChild(ParentNode, ANode: TCodeTreeNode);
330 procedure AddNodeInFrontOf(NextBrotherNode, ANode: TCodeTreeNode);
FindFirstPositionnull331 function FindFirstPosition: integer;
FindLastPositionnull332 function FindLastPosition: integer;
ContainsNodenull333 function ContainsNode(ANode: TCodeTreeNode): boolean;
FindRootNodenull334 function FindRootNode(Desc: TCodeTreeNodeDesc): TCodeTreeNode;
GetLastNodenull335 function GetLastNode: TCodeTreeNode;
336 procedure Clear;
337 constructor Create;
338 destructor Destroy; override;
339 procedure ConsistencyCheck;
340 procedure WriteDebugReport(WithChildren: boolean);
341 end;
342
343
344 { TCodeTreeNodeExtension }
345
346 TCodeTreeNodeExtension = class
347 public
348 Node: TCodeTreeNode;
349 Txt: string;
350 ExtTxt1, ExtTxt2, ExtTxt3, ExtTxt4: string;
351 Position: integer;
352 Data: Pointer;
353 Flags: cardinal;
354 Next: TCodeTreeNodeExtension;
355 procedure Clear;
356 constructor Create;
ConsistencyChecknull357 function ConsistencyCheck: integer; // 0 = ok
358 procedure WriteDebugReport;
CalcMemSizenull359 function CalcMemSize: PtrUInt;
360 end;
361
362
363 //-----------------------------------------------------------------------------
364 // useful functions
NodeDescriptionAsStringnull365 function NodeDescriptionAsString(Desc: TCodeTreeNodeDesc): string;
366 procedure WriteNodeExtTree(Tree: TAVLTree);
FindCodeTreeNodeExtnull367 function FindCodeTreeNodeExt(Tree: TAVLTree; const Txt: string
368 ): TCodeTreeNodeExtension;
FindCodeTreeNodeExtAVLNodenull369 function FindCodeTreeNodeExtAVLNode(Tree: TAVLTree; const Txt: string
370 ): TAVLTreeNode;
FindCodeTreeNodeExtWithIdentifiernull371 function FindCodeTreeNodeExtWithIdentifier(Tree: TAVLTree; Identifier: PChar
372 ): TCodeTreeNodeExtension;
FindCodeTreeNodeExtAVLNodeWithIdentifiernull373 function FindCodeTreeNodeExtAVLNodeWithIdentifier(Tree: TAVLTree;
374 Identifier: PChar): TAVLTreeNode;
375 procedure AddNodeExtToTree(var TreeOfNodeExt: TAVLTree;
376 DefNodeExt: TCodeTreeNodeExtension);
377 procedure ClearNodeExtData(TreeOfNodeExt: TAVLTree);
378 procedure DisposeAVLTree(var Tree: TAVLTree);
CompareTxtWithCodeTreeNodeExtnull379 function CompareTxtWithCodeTreeNodeExt(p: Pointer;
380 NodeData: pointer): integer;
CompareIdentifierWithCodeTreeNodeExtnull381 function CompareIdentifierWithCodeTreeNodeExt(p: Pointer;
382 NodeData: pointer): integer;
CompareCodeTreeNodeExtnull383 function CompareCodeTreeNodeExt(NodeData1, NodeData2: pointer): integer; // Txt
CompareCodeTreeNodeExtWithPosnull384 function CompareCodeTreeNodeExtWithPos(NodeData1, NodeData2: pointer): integer; // Position
CompareCodeTreeNodeExtWithNodeStartPosnull385 function CompareCodeTreeNodeExtWithNodeStartPos(
386 NodeData1, NodeData2: pointer): integer; // Node.StartPos
CompareCodeTreeNodeExtTxtAndPosnull387 function CompareCodeTreeNodeExtTxtAndPos(NodeData1, NodeData2: pointer): integer; // Txt, then Position
CompareCodeTreeNodeExtWithNodenull388 function CompareCodeTreeNodeExtWithNode(NodeData1, NodeData2: pointer): integer;
ComparePointerWithCodeTreeNodeExtNodenull389 function ComparePointerWithCodeTreeNodeExtNode(p: Pointer;
390 NodeExt: pointer): integer;
391
392 type
393 TOnFindOwnerOfCodeTreeNode = function (ANode: TCodeTreeNode): TObject;
394
395 var
396 OnFindOwnerOfCodeTreeNode: TOnFindOwnerOfCodeTreeNode;
397
FindOwnerOfCodeTreeNodenull398 function FindOwnerOfCodeTreeNode(ANode: TCodeTreeNode): TObject;
399
400
401 implementation
402
403
NodeDescriptionAsStringnull404 function NodeDescriptionAsString(Desc: TCodeTreeNodeDesc): string;
405 begin
406 case Desc of
407 ctnNone: Result:='None';
408
409 ctnClass: Result:='Class';
410 ctnClassInterface: Result:='Class Interface';
411 ctnDispinterface: Result:='Dispinterface';
412 ctnObject: Result:='Object';
413 ctnObjCClass: Result:='ObjCClass';
414 ctnObjCCategory: Result:='ObjCCategory';
415 ctnObjCProtocol: Result:='ObjCProtocol';
416 ctnCPPClass: Result:='CPPClass';
417 ctnTypeHelper: Result:='Type Helper';
418 ctnRecordHelper: Result:='Record Helper';
419
420 ctnClassInheritance: Result:='Class inheritance';
421 ctnClassGUID: Result:='GUID';
422 ctnClassPrivate: Result:='Private';
423 ctnClassProtected: Result:='Protected';
424 ctnClassPublic: Result:='Public';
425 ctnClassPublished: Result:='Published';
426 ctnClassRequired: Result:='Required section';
427 ctnClassOptional: Result:='Optional section';
428 ctnClassClassVar: Result:='Class Var';
429 ctnClassAbstract: Result:='abstract';
430 ctnClassSealed: Result:='sealed';
431 ctnClassExternal: Result:='external';
432 ctnClassHelper: Result:='Class Helper';
433 ctnHelperFor: Result:='(helper) for';
434
435 ctnProcedure: Result:='Procedure';
436 ctnProcedureHead: Result:='ProcedureHead';
437 ctnParameterList: Result:='ParameterList';
438
439 ctnBeginBlock: Result:='BeginBlock';
440 ctnAsmBlock: Result:='AsmBlock';
441
442 ctnProgram: Result:='Program';
443 ctnPackage: Result:='Package';
444 ctnLibrary: Result:='Library';
445 ctnUnit: Result:='Unit';
446 ctnSrcName: Result:='SourceName';
447 ctnUseUnit: Result:='use unit';
448 ctnUseUnitNamespace: Result:='Namespace';
449 ctnUseUnitClearName: Result:='Use unit name';
450 ctnInterface: Result:='Interface Section';
451 ctnImplementation: Result:='Implementation';
452 ctnInitialization: Result:='Initialization';
453 ctnFinalization: Result:='Finalization';
454 ctnEndPoint: Result:='End.';
455
456 ctnTypeSection: Result:='Type Section';
457 ctnVarSection: Result:='Var Section';
458 ctnConstSection: Result:='Const Section';
459 ctnResStrSection: Result:='Resource String Section';
460 ctnPropertySection: Result:='Property Section';
461 ctnUsesSection: Result:='Uses Section';
462 ctnRequiresSection: Result:='Requires Section';
463 ctnContainsSection: Result:='Contains Section';
464 ctnExportsSection: Result:='Exports Section';
465
466 ctnTypeDefinition: Result:='Type';
467 ctnVarDefinition: Result:='Var';
468 ctnConstDefinition: Result:='Const';
469 ctnGlobalProperty: Result:='Global Property';
470 ctnVarArgs: Result:='VarArgs';
471
472 ctnProperty: Result:='Property'; // can start with 'class property'
473 ctnMethodMap: Result:='Method Map';
474
475 ctnIdentifier: Result:='Identifier';
476 ctnOpenArrayType: Result:='Open Array Type';
477 ctnOfConstType: Result:='Of Const';
478 ctnRangedArrayType: Result:='Ranged Array Type';
479 ctnRecordType: Result:='Record Type';
480 ctnRecordCase: Result:='Record Case';
481 ctnRecordVariant: Result:='Record Variant';
482 ctnProcedureType: Result:='Procedure Type';
483 ctnSetType: Result:='Set Type';
484 ctnRangeType: Result:='Subrange Type';
485 ctnEnumerationType: Result:='Enumeration Type';
486 ctnEnumIdentifier: Result:='Enumeration Identifier';
487 ctnLabel: Result:='Label Identifier';
488 ctnTypeType: Result:='''Type'' Type';
489 ctnFileType: Result:='File Type';
490 ctnPointerType: Result:='Pointer ^ Type';
491 ctnClassOfType: Result:='Class Of Type';
492 ctnVariantType: Result:='Variant Type';
493 ctnSpecialize: Result:='Specialize Type';
494 ctnSpecializeType: Result:='Specialize Typename';
495 ctnSpecializeParams: Result:='Specialize Parameterlist';
496 ctnSpecializeParam: Result:='Specialize Parameter';
497 ctnGenericType: Result:='Generic Type';
498 ctnGenericName: Result:='Generic Type Name';
499 ctnGenericParams: Result:='Generic Type Params';
500 ctnGenericParameter: Result:='Generic Type Parameter';
501 ctnGenericConstraint: Result:='Generic Type Parameter Constraint';
502
503 ctnWithVariable: Result:='With Variable';
504 ctnWithStatement: Result:='With Statement';
505 ctnOnBlock: Result:='On Block';
506 ctnOnIdentifier: Result:='On Identifier';
507 ctnOnStatement: Result:='On Statement';
508 ctnParamsRound: Result:='Params()';
509
510 ctnReferenceTo: Result:='Reference To';
511 ctnConstant: Result:='Constant';
512 ctnHintModifier: Result:='Hint Modifier';
513 ctnAttribute: Result:='Attribute';
514 ctnAttribParam: Result:='Attribute Param';
515 else
516 Result:='invalid descriptor ('+IntToStr(Desc)+')';
517 end;
518 end;
519
520 procedure WriteNodeExtTree(Tree: TAVLTree);
521 var
522 Node: TAVLTreeNode;
523 NodeExt: TCodeTreeNodeExtension;
524 begin
525 if Tree=nil then begin
526 DebugLn(['WriteNodeExtTree Tree=nil']);
527 exit;
528 end;
529 DebugLn(['WriteNodeExtTree ']);
530 Node:=Tree.FindLowest;
531 while Node<>nil do begin
532 NodeExt:=TCodeTreeNodeExtension(Node.Data);
533 if NodeExt=nil then
534 DebugLn([' NodeExt=nil'])
535 else
536 NodeExt.WriteDebugReport;
537 Node:=Tree.FindSuccessor(Node);
538 end;
539 end;
540
FindCodeTreeNodeExtnull541 function FindCodeTreeNodeExt(Tree: TAVLTree; const Txt: string
542 ): TCodeTreeNodeExtension;
543 var
544 AVLNode: TAVLTreeNode;
545 begin
546 AVLNode:=FindCodeTreeNodeExtAVLNode(Tree,Txt);
547 if AVLNode<>nil then
548 Result:=TCodeTreeNodeExtension(AVLNode.Data)
549 else
550 Result:=nil;
551 end;
552
FindCodeTreeNodeExtAVLNodenull553 function FindCodeTreeNodeExtAVLNode(Tree: TAVLTree; const Txt: string
554 ): TAVLTreeNode;
555 begin
556 Result:=Tree.FindKey(Pointer(Txt),@CompareTxtWithCodeTreeNodeExt);
557 end;
558
FindCodeTreeNodeExtWithIdentifiernull559 function FindCodeTreeNodeExtWithIdentifier(Tree: TAVLTree; Identifier: PChar
560 ): TCodeTreeNodeExtension;
561 var
562 AVLNode: TAVLTreeNode;
563 begin
564 AVLNode:=FindCodeTreeNodeExtAVLNodeWithIdentifier(Tree,Identifier);
565 if AVLNode<>nil then
566 Result:=TCodeTreeNodeExtension(AVLNode.Data)
567 else
568 Result:=nil;
569 end;
570
FindCodeTreeNodeExtAVLNodeWithIdentifiernull571 function FindCodeTreeNodeExtAVLNodeWithIdentifier(Tree: TAVLTree;
572 Identifier: PChar): TAVLTreeNode;
573 begin
574 Result:=Tree.FindKey(Identifier,@CompareIdentifierWithCodeTreeNodeExt);
575 end;
576
577 procedure AddNodeExtToTree(var TreeOfNodeExt: TAVLTree;
578 DefNodeExt: TCodeTreeNodeExtension);
579 begin
580 if TreeOfNodeExt=nil then
581 TreeOfNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
582 TreeOfNodeExt.Add(DefNodeExt);
583 end;
584
585 procedure ClearNodeExtData(TreeOfNodeExt: TAVLTree);
586 var
587 AVLNode: TAVLTreeNode;
588 begin
589 if TreeOfNodeExt=nil then exit;
590 AVLNode:=TreeOfNodeExt.FindLowest;
591 while AVLNode<>nil do begin
592 TCodeTreeNodeExtension(AVLNode.Data).Data:=nil;
593 AVLNode:=TreeOfNodeExt.FindSuccessor(AVLNode);
594 end;
595 end;
596
597 procedure DisposeAVLTree(var Tree: TAVLTree);
598 begin
599 if Tree=nil then exit;
600 Tree.FreeAndClear;
601 Tree.Free;
602 Tree:=nil;
603 end;
604
CompareTxtWithCodeTreeNodeExtnull605 function CompareTxtWithCodeTreeNodeExt(p: Pointer; NodeData: pointer
606 ): integer;
607 var
608 NodeExt: TCodeTreeNodeExtension absolute NodeData;
609 begin
610 Result:=CompareTextIgnoringSpace(Ansistring(p),NodeExt.Txt,false);
611 end;
612
CompareIdentifierWithCodeTreeNodeExtnull613 function CompareIdentifierWithCodeTreeNodeExt(p: Pointer; NodeData: pointer
614 ): integer;
615 var
616 NodeExt: TCodeTreeNodeExtension absolute NodeData;
617 begin
618 NodeExt:=TCodeTreeNodeExtension(NodeData);
619 Result:=CompareIdentifierPtrs(p,Pointer(NodeExt.Txt));
620 end;
621
CompareCodeTreeNodeExtnull622 function CompareCodeTreeNodeExt(NodeData1, NodeData2: pointer): integer;
623 var
624 NodeExt1: TCodeTreeNodeExtension absolute NodeData1;
625 NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
626 begin
627 Result:=CompareTextIgnoringSpace(NodeExt1.Txt,NodeExt2.Txt,false);
628 end;
629
CompareCodeTreeNodeExtWithPosnull630 function CompareCodeTreeNodeExtWithPos(NodeData1, NodeData2: pointer): integer;
631 var NodeExt1Pos, NodeExt2Pos: integer;
632 begin
633 NodeExt1Pos:=TCodeTreeNodeExtension(NodeData1).Position;
634 NodeExt2Pos:=TCodeTreeNodeExtension(NodeData2).Position;
635 if NodeExt1Pos<NodeExt2Pos then
636 Result:=1
637 else if NodeExt1Pos>NodeExt2Pos then
638 Result:=-1
639 else
640 Result:=0;
641 end;
642
CompareCodeTreeNodeExtWithNodeStartPosnull643 function CompareCodeTreeNodeExtWithNodeStartPos(
644 NodeData1, NodeData2: pointer): integer;
645 var NodeExt1Pos, NodeExt2Pos: integer;
646 begin
647 NodeExt1Pos:=TCodeTreeNodeExtension(NodeData1).Node.StartPos;
648 NodeExt2Pos:=TCodeTreeNodeExtension(NodeData2).Node.StartPos;
649 if NodeExt1Pos<NodeExt2Pos then
650 Result:=1
651 else if NodeExt1Pos>NodeExt2Pos then
652 Result:=-1
653 else
654 Result:=0;
655 end;
656
CompareCodeTreeNodeExtTxtAndPosnull657 function CompareCodeTreeNodeExtTxtAndPos(NodeData1, NodeData2: pointer
658 ): integer;
659 var
660 NodeExt1: TCodeTreeNodeExtension absolute NodeData1;
661 NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
662 begin
663 Result:=CompareTextIgnoringSpace(NodeExt1.Txt,NodeExt2.Txt,false);
664 if Result<>0 then exit;
665 if NodeExt1.Position<NodeExt2.Position then
666 Result:=1
667 else if NodeExt1.Position>NodeExt2.Position then
668 Result:=-1
669 else
670 Result:=0;
671 end;
672
CompareCodeTreeNodeExtWithNodenull673 function CompareCodeTreeNodeExtWithNode(NodeData1, NodeData2: pointer): integer;
674 var
675 Node1: TCodeTreeNode;
676 Node2: TCodeTreeNode;
677 begin
678 Node1:=TCodeTreeNodeExtension(NodeData1).Node;
679 Node2:=TCodeTreeNodeExtension(NodeData2).Node;
680 if Pointer(Node1)>Pointer(Node2) then
681 Result:=1
682 else if Pointer(Node1)<Pointer(Node2) then
683 Result:=-1
684 else
685 Result:=0;
686 end;
687
ComparePointerWithCodeTreeNodeExtNodenull688 function ComparePointerWithCodeTreeNodeExtNode(p: Pointer; NodeExt: pointer
689 ): integer;
690 var
691 Node: TCodeTreeNode;
692 begin
693 Node:=TCodeTreeNodeExtension(NodeExt).Node;
694 if p>Pointer(Node) then
695 Result:=1
696 else if p<Pointer(Node) then
697 Result:=-1
698 else
699 Result:=0;
700 end;
701
FindOwnerOfCodeTreeNodenull702 function FindOwnerOfCodeTreeNode(ANode: TCodeTreeNode): TObject;
703 begin
704 if Assigned(OnFindOwnerOfCodeTreeNode) then
705 Result:=OnFindOwnerOfCodeTreeNode(ANode)
706 else
707 Result:=nil;
708 end;
709
710 { TCodeTreeNode }
711
712 constructor TCodeTreeNode.Create;
713 begin
714 StartPos:=-1;
715 EndPos:=-1;
716 end;
717
718 procedure TCodeTreeNode.Clear;
719 begin
720 Desc:=ctnNone;
721 SubDesc:=ctnsNone;
722 Parent:=nil;
723 NextBrother:=nil;
724 PriorBrother:=nil;
725 FirstChild:=nil;
726 LastChild:=nil;
727 StartPos:=-1;
728 EndPos:=-1;
729 Cache:=nil;
730 end;
731
Nextnull732 function TCodeTreeNode.Next: TCodeTreeNode;
733 begin
734 if FirstChild<>nil then begin
735 Result:=FirstChild;
736 end else begin
737 Result:=Self;
738 while (Result<>nil) and (Result.NextBrother=nil) do
739 Result:=Result.Parent;
740 if Result<>nil then Result:=Result.NextBrother;
741 end;
742 end;
743
NextSkipChildsnull744 function TCodeTreeNode.NextSkipChilds: TCodeTreeNode;
745 begin
746 Result:=Self;
747 while (Result<>nil) and (Result.NextBrother=nil) do
748 Result:=Result.Parent;
749 if Result<>nil then Result:=Result.NextBrother;
750 end;
751
TCodeTreeNode.Priornull752 function TCodeTreeNode.Prior: TCodeTreeNode;
753 begin
754 if PriorBrother<>nil then begin
755 Result:=PriorBrother;
756 while Result.LastChild<>nil do
757 Result:=Result.LastChild;
758 end else
759 Result:=Parent;
760 end;
761
GetNodeInFrontOfPosnull762 function TCodeTreeNode.GetNodeInFrontOfPos(p: integer): TCodeTreeNode;
763 // if p<=StartPos then next node with Node.StartPos<=p
764 // else returns the next child node with Node.EndPos<=p
765 begin
766 if p<=StartPos then begin
767 if (Parent<>nil) and (p<Parent.StartPos) then begin
768 // p is in front of parent
769 Result:=Parent;
770 while (Result<>nil) and (p<Result.StartPos) do
771 Result:=Result.Parent;
772 end else begin
773 // p is in parent and in front of node => prior brothers
774 Result:=PriorBrother;
775 while (Result<>nil) and (p<Result.StartPos) do
776 Result:=Result.PriorBrother;
777 end;
778 if Result=nil then exit;
779 // p is in Result => search in children
780 Result:=Result.GetNodeInFrontOfPos(p);
781 end else begin
782 Result:=LastChild;
783 while (Result<>nil) and (Result.EndPos>p) do
784 Result:=Result.PriorBrother;
785 if Result=nil then exit;
786 while (Result.LastChild<>nil) and (Result.LastChild.EndPos=Result.EndPos) do
787 Result:=Result.LastChild;
788 end;
789 end;
790
791 procedure TCodeTreeNode.ConsistencyCheck;
792 begin
793 if (EndPos>0) and (StartPos>EndPos) then
794 raise Exception.Create('');
795 if (Parent<>nil) then begin
796 if (PriorBrother=nil) and (Parent.FirstChild<>Self) then
797 raise Exception.Create('');
798 if (NextBrother=nil) and (Parent.LastChild<>Self) then
799 raise Exception.Create('');
800 end;
801 if (NextBrother<>nil) and (NextBrother.Parent<>Parent) then
802 raise Exception.Create('');
803 if (PriorBrother<>nil) and (PriorBrother.Parent<>Parent) then
804 raise Exception.Create('');
805 if (FirstChild<>nil) and (FirstChild.Parent<>Self) then
806 raise Exception.Create('');
807 if (FirstChild=nil) <> (LastChild=nil) then
808 raise Exception.Create('');
809 if (NextBrother<>nil) and (NextBrother.PriorBrother<>Self) then
810 raise Exception.Create('');
811 if (PriorBrother<>nil) and (PriorBrother.NextBrother<>Self) then
812 raise Exception.Create('');
813 if (FirstChild<>nil) then
814 FirstChild.ConsistencyCheck;
815 if NextBrother<>nil then
816 NextBrother.ConsistencyCheck;
817 end;
818
819 procedure TCodeTreeNode.WriteDebugReport(const Prefix: string;
820 WithChilds: boolean);
821 var
822 Node: TCodeTreeNode;
823 begin
824 DebugLn([Prefix,DescAsString,' Range=',StartPos,'..',EndPos,' Cache=',DbgSName(Cache)]);
825 if WithChilds then begin
826 Node:=FirstChild;
827 while Node<>nil do begin
828 Node.WriteDebugReport(Prefix+' ',true);
829 Node:=Node.NextBrother;
830 end;
831 end;
832 end;
833
HasAsParentnull834 function TCodeTreeNode.HasAsParent(Node: TCodeTreeNode): boolean;
835 var CurNode: TCodeTreeNode;
836 begin
837 Result:=false;
838 if Node=nil then exit;
839 CurNode:=Parent;
840 while (CurNode<>nil) do begin
841 if CurNode=Node then begin
842 Result:=true;
843 exit;
844 end;
845 CurNode:=CurNode.Parent;
846 end;
847 end;
848
HasAsChildnull849 function TCodeTreeNode.HasAsChild(Node: TCodeTreeNode): boolean;
850 begin
851 Result:=false;
852 if Node=nil then exit;
853 Result:=Node.HasAsParent(Self);
854 end;
855
HasParentOfTypenull856 function TCodeTreeNode.HasParentOfType(ParentDesc: TCodeTreeNodeDesc): boolean;
857 var ANode: TCodeTreeNode;
858 begin
859 ANode:=Parent;
860 while (ANode<>nil) and (ANode.Desc<>ParentDesc) do
861 ANode:=ANode.Parent;
862 Result:=ANode<>nil;
863 end;
864
TCodeTreeNode.HasAsRootnull865 function TCodeTreeNode.HasAsRoot(RootNode: TCodeTreeNode): boolean;
866 begin
867 Result:=(RootNode<>nil) and (RootNode=GetRoot);
868 end;
869
GetNodeOfTypenull870 function TCodeTreeNode.GetNodeOfType(ADesc: TCodeTreeNodeDesc
871 ): TCodeTreeNode;
872 begin
873 Result:=Self;
874 while (Result<>nil) and (Result.Desc<>ADesc) do
875 Result:=Result.Parent;
876 end;
877
GetNodeOfTypesnull878 function TCodeTreeNode.GetNodeOfTypes(const Descriptors: array of TCodeTreeNodeDesc
879 ): TCodeTreeNode;
880 var
881 i: Integer;
882 begin
883 Result:=Self;
884 while (Result<>nil) do begin
885 for i:=Low(Descriptors) to High(Descriptors) do
886 if Result.Desc=Descriptors[i] then exit;
887 Result:=Result.Parent;
888 end;
889 end;
890
TCodeTreeNode.GetTopMostNodeOfTypenull891 function TCodeTreeNode.GetTopMostNodeOfType(ADesc: TCodeTreeNodeDesc
892 ): TCodeTreeNode;
893 var
894 Node: TCodeTreeNode;
895 begin
896 Result:=nil;
897 Node:=Self;
898 while Node<>nil do begin
899 if Node.Desc=ADesc then
900 Result:=Node;
901 Node:=Node.Parent;
902 end;
903 end;
904
GetFindContextParentnull905 function TCodeTreeNode.GetFindContextParent: TCodeTreeNode;
906 begin
907 Result:=Parent;
908 while (Result<>nil) and (not (Result.Desc in AllFindContextDescs)) do
909 Result:=Result.Parent;
910 end;
911
GetLevelnull912 function TCodeTreeNode.GetLevel: integer;
913 var ANode: TCodeTreeNode;
914 begin
915 Result:=0;
916 ANode:=Parent;
917 while ANode<>nil do begin
918 inc(Result);
919 ANode:=ANode.Parent;
920 end;
921 end;
922
GetLastNodenull923 function TCodeTreeNode.GetLastNode: TCodeTreeNode;
924 begin
925 Result:=Self;
926 while Result.LastChild<>nil do
927 Result:=Result.LastChild;
928 end;
929
TCodeTreeNode.DescAsStringnull930 function TCodeTreeNode.DescAsString: string;
931 begin
932 if Self=nil then
933 Result:='nil'
934 else
935 Result:=NodeDescriptionAsString(Desc);
936 end;
937
GetRootnull938 function TCodeTreeNode.GetRoot: TCodeTreeNode;
939 begin
940 Result:=Self;
941 while (Result.Parent<>nil) do Result:=Result.Parent;
942 while (Result.PriorBrother<>nil) do Result:=Result.PriorBrother;
943 end;
944
TCodeTreeNode.ChildCountnull945 function TCodeTreeNode.ChildCount: integer;
946 var
947 Node: TCodeTreeNode;
948 begin
949 Result:=0;
950 Node:=FirstChild;
951 while Node<>nil do begin
952 inc(Result);
953 Node:=Node.NextBrother;
954 end;
955 end;
956
FindOwnernull957 function TCodeTreeNode.FindOwner: TObject;
958 begin
959 Result:=FindOwnerOfCodeTreeNode(Self);
960 end;
961
962 { TCodeTree }
963
964 constructor TCodeTree.Create;
965 begin
966 Root:=nil;
967 FNodeCount:=0;
968 end;
969
970 destructor TCodeTree.Destroy;
971 begin
972 Clear;
973 inherited Destroy;
974 end;
975
976 procedure TCodeTree.Clear;
977 begin
978 while Root<>nil do
979 DeleteNode(Root);
980 end;
981
982 procedure TCodeTree.RemoveNode(ANode: TCodeTreeNode);
983 begin
984 if ANode=nil then exit;
985 if ANode=Root then Root:=ANode.NextBrother;
986 with ANode do begin
987 if (Parent<>nil) then begin
988 if (Parent.FirstChild=ANode) then
989 Parent.FirstChild:=NextBrother;
990 if (Parent.LastChild=ANode) then
991 Parent.LastChild:=PriorBrother;
992 Parent:=nil;
993 end;
994 if NextBrother<>nil then NextBrother.PriorBrother:=PriorBrother;
995 if PriorBrother<>nil then PriorBrother.NextBrother:=NextBrother;
996 NextBrother:=nil;
997 PriorBrother:=nil;
998 end;
999 dec(FNodeCount);
1000 end;
1001
1002 procedure TCodeTree.DeleteNode(ANode: TCodeTreeNode);
1003 begin
1004 while (ANode.FirstChild<>nil) do DeleteNode(ANode.FirstChild);
1005 RemoveNode(ANode);
1006 ANode.Clear; // clear to spot dangling pointers early
1007 ANode.Free;
1008 end;
1009
1010 procedure TCodeTree.AddNodeAsLastChild(ParentNode, ANode: TCodeTreeNode);
1011 var TopNode: TCodeTreeNode;
1012 begin
1013 ANode.Parent:=ParentNode;
1014 if Root=nil then begin
1015 // set as root
1016 Root:=ANode;
1017 while Root.Parent<>nil do Root:=Root.Parent;
1018 end else if ParentNode<>nil then begin
1019 if ParentNode.FirstChild=nil then begin
1020 // add as first child
1021 ParentNode.FirstChild:=ANode;
1022 ParentNode.LastChild:=ANode;
1023 end else begin
1024 // add as last child
1025 ANode.PriorBrother:=ParentNode.LastChild;
1026 ParentNode.LastChild:=ANode;
1027 if ANode.PriorBrother<>nil then ANode.PriorBrother.NextBrother:=ANode;
1028 end;
1029 end else begin
1030 // add as last brother of top nodes
1031 TopNode:=Root;
1032 while (TopNode.NextBrother<>nil) do TopNode:=TopNode.NextBrother;
1033 ANode.PriorBrother:=TopNode;
1034 ANode.PriorBrother.NextBrother:=ANode;
1035 end;
1036 inc(FNodeCount);
1037 end;
1038
1039 procedure TCodeTree.AddNodeInFrontOf(NextBrotherNode, ANode: TCodeTreeNode);
1040 begin
1041 ANode.Parent:=NextBrotherNode.Parent;
1042 ANode.NextBrother:=NextBrotherNode;
1043 ANode.PriorBrother:=NextBrotherNode.PriorBrother;
1044 NextBrotherNode.PriorBrother:=ANode;
1045 if ANode.PriorBrother<>nil then
1046 ANode.PriorBrother.NextBrother:=ANode;
1047 end;
1048
FindFirstPositionnull1049 function TCodeTree.FindFirstPosition: integer;
1050 begin
1051 Result:=-1;
1052 if Root=nil then exit;
1053 Result:=Root.StartPos;
1054 end;
1055
FindLastPositionnull1056 function TCodeTree.FindLastPosition: integer;
1057 var
1058 ANode: TCodeTreeNode;
1059 begin
1060 Result:=-1;
1061 if Root=nil then exit;
1062 ANode:=Root;
1063 while (ANode.NextBrother<>nil) do ANode:=ANode.NextBrother;
1064 //debugln('TCodeTree.FindLastPosition A ',Anode.DescAsString,' ANode.StartPos=',dbgs(ANode.StartPos),' ANode.EndPos=',dbgs(ANode.EndPos));
1065 Result:=ANode.EndPos;
1066 end;
1067
ContainsNodenull1068 function TCodeTree.ContainsNode(ANode: TCodeTreeNode): boolean;
1069 begin
1070 if ANode=nil then exit(false);
1071 while ANode.Parent<>nil do ANode:=ANode.Parent;
1072 while ANode.PriorBrother<>nil do ANode:=ANode.PriorBrother;
1073 Result:=ANode=Root;
1074 end;
1075
TCodeTree.FindRootNodenull1076 function TCodeTree.FindRootNode(Desc: TCodeTreeNodeDesc): TCodeTreeNode;
1077 begin
1078 Result:=Root;
1079 while (Result<>nil) and (Result.Desc<>Desc) do
1080 Result:=Result.NextBrother;
1081 end;
1082
GetLastNodenull1083 function TCodeTree.GetLastNode: TCodeTreeNode;
1084 begin
1085 Result:=Root;
1086 if Result=nil then exit;
1087 while Result.NextBrother<>nil do
1088 Result:=Result.NextBrother;
1089 Result:=Result.GetLastNode;
1090 end;
1091
1092 procedure TCodeTree.ConsistencyCheck;
1093 var RealNodeCount: integer;
1094
1095 procedure CountNodes(ANode: TCodeTreeNode);
1096 begin
1097 if ANode=nil then exit;
1098 inc(RealNodeCount);
1099 CountNodes(ANode.FirstChild);
1100 CountNodes(ANode.NextBrother);
1101 end;
1102
1103 begin
1104 if Root<>nil then begin
1105 if Root.Parent<>nil then
1106 raise Exception.Create('');
1107 Root.ConsistencyCheck;
1108 end;
1109 RealNodeCount:=0;
1110 CountNodes(Root);
1111 if RealNodeCount<>FNodeCount then
1112 raise Exception.Create('');
1113 end;
1114
1115 procedure TCodeTree.WriteDebugReport(WithChildren: boolean);
1116 begin
1117 DebugLn('[TCodeTree.WriteDebugReport] Root=',dbgs(Root<>nil));
1118 if Root<>nil then
1119 Root.WriteDebugReport(' ',WithChildren);
1120 end;
1121
1122 { TCodeTreeNodeExtension }
1123
1124 procedure TCodeTreeNodeExtension.Clear;
1125 begin
1126 Next:=nil;
1127 Txt:='';
1128 ExtTxt1:='';
1129 ExtTxt2:='';
1130 ExtTxt3:='';
1131 ExtTxt4:='';
1132 Node:=nil;
1133 Position:=-1;
1134 Data:=nil;
1135 Flags:=0;
1136 end;
1137
1138 constructor TCodeTreeNodeExtension.Create;
1139 begin
1140 Position:=-1;
1141 end;
1142
TCodeTreeNodeExtension.ConsistencyChecknull1143 function TCodeTreeNodeExtension.ConsistencyCheck: integer;
1144 // 0 = ok
1145 begin
1146 Result:=0;
1147 end;
1148
1149 procedure TCodeTreeNodeExtension.WriteDebugReport;
1150 begin
1151 // nothing special
1152 DbgOut(' ');
1153 if Node<>nil then
1154 DbgOut('Node=',NodeDescriptionAsString(Node.Desc))
1155 else
1156 DbgOut('Node=nil');
1157 DbgOut(' Position=',dbgs(Position),' Txt="'+Txt+'" ExtTxt1="'+ExtTxt1+'" ExtTxt2="'+ExtTxt2+'" ExtTxt3="'+ExtTxt3+'" ExtTxt4="'+ExtTxt4+'"');
1158 debugln;
1159 end;
1160
CalcMemSizenull1161 function TCodeTreeNodeExtension.CalcMemSize: PtrUInt;
1162 begin
1163 Result:=PtrUInt(InstanceSize)
1164 +MemSizeString(Txt)
1165 +MemSizeString(ExtTxt1)
1166 +MemSizeString(ExtTxt2)
1167 +MemSizeString(ExtTxt3)
1168 +MemSizeString(ExtTxt4);
1169 end;
1170
1171 end.
1172
1173