79
79
procedure ConsistencyCheck;
80
80
property Tool: TPascalParserTool read FTool;
81
81
property Complete: boolean read FComplete write SetComplete;
82
property Items: TAVLTree read FItems;
82
property Items: TAVLTree read FItems; // Tree of PInterfaceIdentCacheEntry
83
83
function CalcMemSize: PtrUInt;
102
102
These are: class, interface, proc, record, withstatement
104
104
Because node caches can store information of used units, the cache must be
105
deleted every time a used unit is changed. Currently all node caches are
106
resetted every time the GlobalWriteLock increases.
105
deleted every time a used unit is changed.
110
108
AllNodeCacheDescs =
111
AllClasses+[ctnProcedure, ctnRecordType, ctnWithStatement];
109
AllClasses+[ctnProcedure, ctnWithStatement];
114
112
TNodeCacheEntryFlag = (ncefSearchedInParents, ncefSearchedInAncestors);
172
170
4. 'longint' identifier node points points to its range.
174
172
FindBaseTypeOfNode will search this chain, and on success will create
175
TBaseTypeCache(s). All four nodes will point directly to the range.
173
TBaseTypeCache(s). The All four nodes will point directly to the range.
181
179
TBaseTypeCache = class
184
NewNode: TCodeTreeNode;
185
NewTool: TPascalParserTool;
186
Next: TBaseTypeCache; // used for mem manager
182
BaseNode: TCodeTreeNode; // final base type
183
BaseTool: TPascalParserTool;
184
NextNode: TCodeTreeNode; // next node on path to the BaseNode
185
NextTool: TPascalParserTool;
186
NextCache: TBaseTypeCache; // used for mem manager
187
187
Owner: TCodeTreeNode;
188
188
procedure BindToOwner(NewOwner: TCodeTreeNode);
189
189
procedure UnbindFromOwner;
198
198
Node- and BaseTypeCache depends on their codetool and the
199
199
node- and basetypecaches of other codetools (=used codetools). The used
200
200
codetools dependencies are saved in the TCodeToolDependencies, which is
201
simple an TAVLTree of codetools. This allows to decide, wether the cache of
201
simple an TAVLTree of codetools. This allows one to decide, wether the cache of
202
202
a codetools must be rebuild.
207
206
//----------------------------------------------------------------------------
270
269
//----------------------------------------------------------------------------
271
270
// stacks for circle checking
272
CodeTreeNodeFixedItemCount = 12;
273
TCodeTreeNodeStackEntry = TCodeTreeNode;
274
TCodeTreeNodeStackEntry = record
275
Tool: TPascalParserTool;
278
PCodeTreeNodeStackEntry = ^TCodeTreeNodeStackEntry;
275
280
TCodeTreeNodeStack = record
276
Fixedtems: array[0..9] of TCodeTreeNodeStackEntry;
277
DynItems: TFPList; // list of TCodeTreeNodeStackEntry
281
FixedItems: array[0..CodeTreeNodeFixedItemCount-1] of TCodeTreeNodeStackEntry;
282
DynItems: PCodeTreeNodeStackEntry;
278
283
StackPtr: integer;
284
Capacity: integer; // size of DynItems in entries
280
286
PCodeTreeNodeStack = ^TCodeTreeNodeStack;
282
288
procedure InitializeNodeStack(NodeStack: PCodeTreeNodeStack);
283
289
function GetNodeStackEntry(NodeStack: PCodeTreeNodeStack;
284
Index: integer): TCodeTreeNodeStackEntry;
290
Index: integer): PCodeTreeNodeStackEntry;
285
291
procedure AddNodeToStack(NodeStack: PCodeTreeNodeStack;
286
NewNode: TCodeTreeNode);
292
NewTool: TPascalParserTool; NewNode: TCodeTreeNode);
287
293
function NodeExistsInStack(NodeStack: PCodeTreeNodeStack;
288
294
Node: TCodeTreeNode): boolean;
289
295
procedure FinalizeNodeStack(NodeStack: PCodeTreeNodeStack);
1185
1191
procedure InitializeNodeStack(NodeStack: PCodeTreeNodeStack);
1187
NodeStack^.StackPtr:=0;
1193
NodeStack^.StackPtr:=-1;
1188
1194
NodeStack^.DynItems:=nil;
1195
NodeStack^.Capacity:=0;
1191
1198
function GetNodeStackEntry(NodeStack: PCodeTreeNodeStack;
1192
Index: integer): TCodeTreeNodeStackEntry;
1199
Index: integer): PCodeTreeNodeStackEntry;
1194
if Index<=High(NodeStack^.Fixedtems) then begin
1195
Result:=NodeStack^.Fixedtems[Index];
1201
if Index<CodeTreeNodeFixedItemCount then begin
1202
Result:=@NodeStack^.FixedItems[Index];
1197
Result:=TCodeTreeNodeStackEntry(
1198
NodeStack^.DynItems[Index-High(NodeStack^.Fixedtems)-1]);
1204
Result:=@NodeStack^.DynItems[Index-CodeTreeNodeFixedItemCount];
1202
1208
procedure AddNodeToStack(NodeStack: PCodeTreeNodeStack;
1203
NewNode: TCodeTreeNode);
1209
NewTool: TPascalParserTool; NewNode: TCodeTreeNode);
1211
Entry: PCodeTreeNodeStackEntry;
1205
if (NodeStack^.StackPtr<=High(NodeStack^.Fixedtems)) then begin
1206
NodeStack^.Fixedtems[NodeStack^.StackPtr]:=NewNode;
1208
if NodeStack^.DynItems=nil then begin
1209
NodeStack^.DynItems:=TFPList.Create;
1211
NodeStack^.DynItems.Add(NewNode);
1213
1214
inc(NodeStack^.StackPtr);
1215
if NodeStack^.StackPtr<CodeTreeNodeFixedItemCount then begin
1216
Entry:=@NodeStack^.FixedItems[NodeStack^.StackPtr];
1218
i:=NodeStack^.StackPtr-CodeTreeNodeFixedItemCount;
1219
if NodeStack^.Capacity<=i then begin
1220
inc(NodeStack^.Capacity,CodeTreeNodeFixedItemCount);
1221
ReAllocMem(NodeStack^.DynItems,NodeStack^.Capacity*SizeOf(TCodeTreeNodeStackEntry));
1223
Entry:=@NodeStack^.DynItems[i];
1225
Entry^.Tool:=NewTool;
1226
Entry^.Node:=NewNode;
1216
1229
function NodeExistsInStack(NodeStack: PCodeTreeNodeStack;
1222
while i<NodeStack^.StackPtr do begin
1223
if i<=High(NodeStack^.Fixedtems) then begin
1224
if NodeStack^.Fixedtems[i]=Node then exit;
1235
while i<=NodeStack^.StackPtr do begin
1236
if i<CodeTreeNodeFixedItemCount then begin
1237
if NodeStack^.FixedItems[i].Node=Node then exit;
1226
if NodeStack^.DynItems[i-High(NodeStack^.Fixedtems)-1]=Pointer(Node) then
1239
if NodeStack^.DynItems[i-CodeTreeNodeFixedItemCount].Node=Node then
1234
1247
procedure FinalizeNodeStack(NodeStack: PCodeTreeNodeStack);
1236
NodeStack^.DynItems.Free;
1249
if NodeStack^.DynItems=nil then exit;
1250
ReAllocMem(NodeStack^.DynItems,0);
1246
1260
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
1248
1262
// add Entry to Free list
1249
BaseTypeCache.Next:=TBaseTypeCache(FFirstFree);
1263
BaseTypeCache.NextCache:=TBaseTypeCache(FFirstFree);
1250
1264
TBaseTypeCache(FFirstFree):=BaseTypeCache;
1251
1265
inc(FFreeCount);
1273
1287
if FFirstFree<>nil then begin
1274
1288
// take from free list
1275
1289
Result:=TBaseTypeCache(FFirstFree);
1276
TBaseTypeCache(FFirstFree):=Result.Next;
1290
TBaseTypeCache(FFirstFree):=Result.NextCache;
1277
1291
Result.BindToOwner(AnOwner);
1278
1292
dec(FFreeCount);