]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* M2GCCDeclare.mod declares Modula-2 types to GCC. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2001-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with GNU Modula-2; see the file COPYING3. If not see | |
20 | <http://www.gnu.org/licenses/>. *) | |
21 | ||
22 | IMPLEMENTATION MODULE M2GCCDeclare ; | |
23 | ||
24 | (* | |
25 | Title : M2GCCDeclare | |
26 | Author : Gaius Mulley | |
27 | System : UNIX (gm2) | |
28 | Date : Fri Jul 16 20:10:55 1999 | |
29 | Description: declares Modula-2 types to GCC, it attempts | |
30 | to only declare a type once all subcomponents are known. | |
31 | *) | |
32 | ||
33 | FROM SYSTEM IMPORT ADDRESS, ADR, WORD ; | |
34 | FROM ASCII IMPORT nul ; | |
35 | FROM Storage IMPORT ALLOCATE ; | |
36 | FROM M2Debug IMPORT Assert ; | |
37 | FROM M2Quads IMPORT DisplayQuadRange ; | |
38 | ||
39 | IMPORT FIO ; | |
40 | ||
41 | FROM M2Options IMPORT DisplayQuadruples, | |
42 | GenerateDebugging, GenerateLineDebug, Iso, Optimizing, WholeProgram, | |
43 | ScaffoldStatic, GetRuntimeModuleOverride ; | |
44 | ||
45 | FROM M2AsmUtil IMPORT GetFullSymName, GetFullScopeAsmName ; | |
46 | ||
47 | FROM M2Batch IMPORT MakeDefinitionSource ; | |
48 | FROM NameKey IMPORT Name, MakeKey, NulName, KeyToCharStar, makekey ; | |
49 | FROM M2FileName IMPORT CalculateFileName ; | |
50 | FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, Mark ; | |
51 | FROM FormatStrings IMPORT Sprintf1 ; | |
52 | FROM M2LexBuf IMPORT TokenToLineNo, FindFileNameFromToken, TokenToLocation, UnknownTokenNo, BuiltinTokenNo ; | |
53 | FROM M2MetaError IMPORT MetaError1, MetaError3 ; | |
54 | FROM M2Error IMPORT FlushErrors, InternalError ; | |
55 | FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ; | |
56 | ||
57 | FROM Indexing IMPORT Index, InitIndex, PutIndice, GetIndice, InBounds, | |
58 | IncludeIndiceIntoIndex, HighIndice, | |
59 | DebugIndex ; | |
60 | ||
61 | FROM Lists IMPORT List, InitList, IncludeItemIntoList, | |
62 | PutItemIntoList, GetItemFromList, | |
63 | RemoveItemFromList, ForeachItemInListDo, | |
64 | IsItemInList, NoOfItemsInList, KillList ; | |
65 | ||
66 | FROM Sets IMPORT Set, InitSet, KillSet, | |
67 | IncludeElementIntoSet, ExcludeElementFromSet, | |
68 | NoOfElementsInSet, IsElementInSet, ForeachElementInSetDo ; | |
69 | ||
70 | FROM SymbolTable IMPORT NulSym, | |
71 | ModeOfAddr, | |
72 | GetMode, | |
73 | GetScope, | |
74 | GetNth, SkipType, GetVarBackEndType, | |
75 | GetSType, GetLType, GetDType, | |
76 | MakeType, PutType, GetLowestType, | |
77 | GetSubrange, PutSubrange, GetArraySubscript, | |
78 | NoOfParam, GetNthParam, | |
79 | PushValue, PopValue, PopSize, | |
80 | IsTemporary, IsUnbounded, IsPartialUnbounded, | |
81 | IsEnumeration, IsVar, | |
82 | IsSubrange, IsPointer, IsRecord, IsArray, | |
83 | IsFieldEnumeration, | |
84 | IsProcedure, IsProcedureNested, IsModule, | |
85 | IsDefImp, | |
86 | IsSubscript, IsVarient, IsFieldVarient, | |
87 | IsType, IsProcType, IsSet, IsSetPacked, | |
88 | IsConst, IsConstSet, IsConstructor, | |
89 | IsFieldEnumeration, | |
90 | IsExported, IsImported, | |
91 | IsVarParam, IsRecordField, IsUnboundedParam, | |
92 | IsValueSolved, | |
93 | IsDefinitionForC, IsHiddenTypeDeclared, | |
94 | IsInnerModule, IsUnknown, | |
95 | IsProcedureReachable, IsParameter, IsConstLit, | |
96 | IsDummy, IsVarAParam, IsProcedureVariable, | |
97 | IsGnuAsm, IsGnuAsmVolatile, IsObject, IsTuple, | |
98 | IsError, IsHiddenType, | |
99 | IsComponent, IsPublic, IsExtern, IsCtor, | |
100 | GetMainModule, GetBaseModule, GetModule, GetLocalSym, | |
101 | PutModuleFinallyFunction, | |
102 | GetProcedureScope, GetProcedureQuads, | |
103 | IsRecordFieldAVarientTag, IsEmptyFieldVarient, | |
104 | GetVarient, GetUnbounded, PutArrayLarge, | |
105 | IsAModula2Type, UsesVarArgs, | |
106 | GetSymName, GetParent, | |
107 | GetDeclaredMod, GetVarBackEndType, | |
108 | GetProcedureBeginEnd, | |
109 | GetString, GetStringLength, IsConstString, | |
110 | IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul, | |
111 | GetAlignment, IsDeclaredPacked, PutDeclaredPacked, | |
112 | GetDefaultRecordFieldAlignment, IsDeclaredPackedResolved, | |
113 | GetPackedEquivalent, | |
114 | GetParameterShadowVar, | |
115 | GetUnboundedRecordType, | |
116 | GetModuleCtors, | |
117 | ForeachOAFamily, GetOAFamily, | |
118 | IsModuleWithinProcedure, IsVariableSSA, | |
119 | IsVariableAtAddress, IsConstructorConstant, | |
120 | ForeachLocalSymDo, ForeachFieldEnumerationDo, | |
121 | ForeachProcedureDo, ForeachModuleDo, | |
122 | ForeachInnerModuleDo, ForeachImportedDo, | |
123 | ForeachExportedDo ; | |
124 | ||
125 | FROM M2Base IMPORT IsPseudoBaseProcedure, IsPseudoBaseFunction, | |
126 | GetBaseTypeMinMax, MixTypes, | |
127 | Cardinal, Char, Proc, Integer, | |
128 | LongInt, LongCard, ShortCard, ShortInt, | |
129 | Real, LongReal, ShortReal, ZType, RType, | |
130 | CType, Complex, LongComplex, ShortComplex, | |
131 | Boolean, True, False, Nil, | |
132 | IsRealType, IsNeededAtRunTime, IsComplexType ; | |
133 | ||
134 | FROM M2System IMPORT IsPseudoSystemFunction, IsSystemType, | |
135 | GetSystemTypeMinMax, Address, Word, Byte, Loc, | |
136 | System, IntegerN, CardinalN, WordN, RealN, SetN, ComplexN, | |
137 | CSizeT, CSSizeT ; | |
138 | ||
139 | FROM M2Bitset IMPORT Bitset, Bitnum ; | |
140 | FROM SymbolConversion IMPORT AddModGcc, Mod2Gcc, GccKnowsAbout, Poison, RemoveMod2Gcc ; | |
141 | FROM M2GenGCC IMPORT ResolveConstantExpressions ; | |
142 | FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock, ForeachScopeBlockDo ; | |
143 | ||
144 | FROM M2ALU IMPORT Addn, Sub, Equ, GreEqu, Gre, Less, PushInt, PushCard, ConvertToType, | |
145 | PushIntegerTree, PopIntegerTree, PopRealTree, ConvertToInt, PopSetTree, | |
146 | IsConstructorDependants, WalkConstructorDependants, | |
147 | PopConstructorTree, PopComplexTree, PutConstructorSolved, | |
148 | ChangeToConstructor, EvaluateValue, TryEvaluateValue ; | |
149 | ||
150 | FROM M2Batch IMPORT IsSourceSeen, GetModuleFile, IsModuleSeen, LookupModule ; | |
151 | FROM m2tree IMPORT Tree ; | |
152 | FROM m2linemap IMPORT location_t, BuiltinsLocation ; | |
153 | ||
154 | FROM m2decl IMPORT BuildIntegerConstant, BuildStringConstant, BuildCStringConstant, | |
155 | BuildStartFunctionDeclaration, | |
156 | BuildParameterDeclaration, BuildEndFunctionDeclaration, | |
157 | DeclareKnownVariable, GetBitsPerBitset, BuildPtrToTypeString, | |
158 | DeclareM2linkStaticInitialization, | |
159 | DeclareM2linkForcedModuleInitOrder ; | |
160 | ||
161 | FROM m2type IMPORT MarkFunctionReferenced, BuildStartRecord, BuildStartVarient, BuildStartFunctionType, | |
162 | BuildStartFieldVarient, BuildStartVarient, BuildStartType, BuildStartArrayType, | |
163 | PutArrayType, BuildPointerType, BuildEndType, BuildCharConstant, | |
164 | BuildTypeDeclaration, GetDefaultType, GetBooleanType, GetBooleanTrue, | |
165 | GetBooleanFalse, BuildSubrangeType, GetM2ZType, GetM2RType, GetM2CType, | |
166 | GetM2CardinalType, GetM2IntegerType, GetM2CharType, GetISOLocType, GetIntegerType, | |
167 | GetISOByteType, GetISOWordType, GetByteType, GetWordType, GetProcType, GetPointerType, | |
168 | GetM2LongIntType, GetM2LongCardType, GetM2ShortIntType, GetM2ShortCardType, | |
169 | GetM2LongRealType, GetM2ShortRealType, GetM2RealType, GetBitnumType, GetBitsetType, | |
170 | GetM2ComplexType, GetM2ComplexType, GetM2LongComplexType, GetM2ShortComplexType, | |
171 | GetM2Integer8, GetM2Integer16, GetM2Integer32, GetM2Integer64, GetM2Cardinal8, | |
172 | GetM2Cardinal16, GetM2Cardinal32, GetM2Cardinal64, GetM2Word16, GetM2Word32, | |
173 | GetM2Word64, GetM2Bitset8, GetM2Bitset16, GetM2Bitset32, GetM2Real32, GetM2Real64, | |
174 | GetM2Real96, GetM2Real128, GetM2Complex32, GetM2Complex64, GetM2Complex96, | |
175 | GetM2Complex128, GetCSizeTType, GetCSSizeTType, | |
176 | GetPackedBooleanType, BuildConstPointerType, | |
177 | BuildPointerType, BuildEnumerator, BuildStartEnumeration, BuildEndEnumeration, | |
178 | SetAlignment, SetTypePacked, SetDeclPacked, BuildSmallestTypeRange, | |
179 | SetRecordFieldOffset, ChainOn, BuildEndRecord, BuildFieldRecord, | |
180 | BuildEndFieldVarient, BuildArrayIndexType, BuildEndFunctionType, | |
181 | BuildSetType, BuildEndVarient, BuildEndArrayType, InitFunctionTypeParameters, | |
182 | BuildProcTypeParameterDeclaration, | |
183 | ValueOutOfTypeRange, ExceedsTypeRange ; | |
184 | ||
185 | FROM m2convert IMPORT BuildConvert ; | |
186 | ||
187 | FROM m2expr IMPORT BuildSub, BuildLSL, BuildTBitSize, BuildAdd, BuildDivTrunc, BuildModTrunc, | |
188 | BuildSize, TreeOverflow, | |
189 | GetPointerZero, GetIntegerZero, GetIntegerOne ; | |
190 | ||
191 | FROM m2block IMPORT RememberType, pushGlobalScope, popGlobalScope, pushFunctionScope, popFunctionScope, | |
192 | finishFunctionDecl, RememberConstant, GetGlobalContext ; | |
193 | ||
194 | ||
195 | TYPE | |
196 | StartProcedure = PROCEDURE (location_t, ADDRESS) : Tree ; | |
197 | ListType = (fullydeclared, partiallydeclared, niltypedarrays, | |
198 | heldbyalignment, finishedalignment, todolist, tobesolvedbyquads) ; | |
199 | doDeclareProcedure = PROCEDURE (CARDINAL, CARDINAL) ; | |
200 | ||
201 | ||
202 | ||
203 | CONST | |
204 | Debugging = FALSE ; | |
205 | Progress = FALSE ; | |
206 | EnableSSA = FALSE ; | |
207 | ||
208 | TYPE | |
209 | M2LinkEntry = POINTER TO RECORD | |
210 | var : CARDINAL ; | |
211 | gcc : Tree ; | |
212 | varname, | |
213 | modname: Name ; | |
214 | END ; | |
215 | ||
216 | VAR | |
217 | ToBeSolvedByQuads, (* constants which must be solved *) | |
218 | (* by processing the quadruples. *) | |
219 | NilTypedArrays, (* arrays which have NIL as their *) | |
220 | (* type. *) | |
221 | FullyDeclared, (* those symbols which have been *) | |
222 | (* fully declared. *) | |
223 | PartiallyDeclared, (* those types which have need to *) | |
224 | (* be finished (but already *) | |
225 | (* started: records, function, *) | |
226 | (* and array type). *) | |
227 | HeldByAlignment, (* types which have a user *) | |
228 | (* specified alignment constant. *) | |
229 | FinishedAlignment, (* records for which we know *) | |
230 | (* their alignment value. *) | |
231 | VisitedList, | |
232 | ChainedList, | |
233 | ToDoList : Set ; (* Contains a set of all *) | |
234 | (* outstanding types that need to *) | |
235 | (* be declared to GCC once *) | |
236 | (* its dependants have *) | |
237 | (* been written. *) | |
238 | HaveInitDefaultTypes: BOOLEAN ; (* have we initialized them yet? *) | |
239 | WatchList : Set ; (* Set of symbols being watched *) | |
240 | EnumerationIndex : Index ; | |
241 | action : IsAction ; | |
242 | enumDeps : BOOLEAN ; | |
243 | M2LinkIndex : Index ; (* Array of M2LinkEntry. *) | |
244 | ||
245 | ||
246 | PROCEDURE mystop ; BEGIN END mystop ; | |
247 | ||
248 | (* *************************************************** | |
249 | (* | |
250 | PrintNum - | |
251 | *) | |
252 | ||
253 | PROCEDURE PrintNum (sym: WORD) ; | |
254 | BEGIN | |
255 | printf1 ('%d, ', sym) | |
256 | END PrintNum ; | |
257 | ||
258 | ||
259 | (* | |
260 | DebugSet - | |
261 | *) | |
262 | ||
263 | PROCEDURE DebugSet (a: ARRAY OF CHAR; l: Set) ; | |
264 | BEGIN | |
265 | printf0(a) ; | |
266 | printf0(' {') ; | |
267 | ForeachElementInSetDo (l, PrintNum) ; | |
268 | printf0('}\n') | |
269 | END DebugSet ; | |
270 | ||
271 | ||
272 | (* | |
273 | DebugSets - | |
274 | *) | |
275 | ||
276 | PROCEDURE DebugSets ; | |
277 | BEGIN | |
278 | DebugSet('ToDoList', ToDoList) ; | |
279 | DebugSet('HeldByAlignment', HeldByAlignment) ; | |
280 | DebugSet('FinishedAlignment', FinishedAlignment) ; | |
281 | DebugSet('PartiallyDeclared', PartiallyDeclared) ; | |
282 | DebugSet('FullyDeclared', FullyDeclared) ; | |
283 | DebugSet('NilTypedArrays', NilTypedArrays) ; | |
284 | DebugSet('ToBeSolvedByQuads', ToBeSolvedByQuads) | |
285 | END DebugSets ; | |
286 | ************************************************ *) | |
287 | ||
288 | ||
289 | (* | |
290 | DebugNumber - | |
291 | *) | |
292 | ||
293 | PROCEDURE DebugNumber (a: ARRAY OF CHAR; s: Set) ; | |
294 | VAR | |
295 | n: CARDINAL ; | |
296 | BEGIN | |
297 | n := NoOfElementsInSet(s) ; | |
298 | printf1(a, n) ; | |
299 | FIO.FlushBuffer(FIO.StdOut) | |
300 | END DebugNumber ; | |
301 | ||
302 | ||
303 | (* | |
304 | FindSetNumbers - | |
305 | *) | |
306 | ||
307 | PROCEDURE FindSetNumbers (VAR t, a, p, f, n, b: CARDINAL) : BOOLEAN ; | |
308 | VAR | |
309 | t1, p1, f1, n1, b1, a1: CARDINAL ; | |
310 | same : BOOLEAN ; | |
311 | BEGIN | |
312 | t1 := NoOfElementsInSet(ToDoList) ; | |
313 | a1 := NoOfElementsInSet(HeldByAlignment) ; | |
314 | p1 := NoOfElementsInSet(PartiallyDeclared) ; | |
315 | f1 := NoOfElementsInSet(FullyDeclared) ; | |
316 | n1 := NoOfElementsInSet(NilTypedArrays) ; | |
317 | b1 := NoOfElementsInSet(ToBeSolvedByQuads) ; | |
318 | same := ((t=t1) AND (a=a1) AND (p=p1) AND (f=f1) AND (n=n1) AND (b=b1)) ; | |
319 | t := t1 ; | |
320 | a := a1 ; | |
321 | p := p1 ; | |
322 | f := f1 ; | |
323 | n := n1 ; | |
324 | b := b1 ; | |
325 | RETURN( same ) | |
326 | END FindSetNumbers ; | |
327 | ||
328 | ||
329 | (* | |
330 | DebugSets - | |
331 | *) | |
332 | ||
333 | PROCEDURE DebugSetNumbers ; | |
334 | BEGIN | |
335 | DebugNumber('ToDoList : %d\n', ToDoList) ; | |
336 | DebugNumber('HeldByAlignment : %d\n', HeldByAlignment) ; | |
337 | DebugNumber('PartiallyDeclared : %d\n', PartiallyDeclared) ; | |
338 | DebugNumber('FullyDeclared : %d\n', FullyDeclared) ; | |
339 | DebugNumber('NilTypedArrays : %d\n', NilTypedArrays) ; | |
340 | DebugNumber('ToBeSolvedByQuads : %d\n', ToBeSolvedByQuads) | |
341 | END DebugSetNumbers ; | |
342 | ||
343 | ||
344 | (* | |
345 | AddSymToWatch - adds symbol, sym, to the list of symbols | |
346 | to watch and annotate their movement between | |
347 | lists. | |
348 | *) | |
349 | ||
350 | PROCEDURE AddSymToWatch (sym: WORD) ; | |
351 | BEGIN | |
352 | IF (sym#NulSym) AND (NOT IsElementInSet(WatchList, sym)) | |
353 | THEN | |
354 | IncludeElementIntoSet(WatchList, sym) ; | |
355 | WalkDependants(sym, AddSymToWatch) ; | |
356 | printf1("watching symbol %d\n", sym) ; | |
357 | FIO.FlushBuffer(FIO.StdOut) | |
358 | END | |
359 | END AddSymToWatch ; | |
360 | ||
361 | ||
362 | (* | |
363 | TryFindSymbol - | |
364 | *) | |
365 | ||
366 | (* | |
367 | PROCEDURE TryFindSymbol (module, symname: ARRAY OF CHAR) : CARDINAL ; | |
368 | VAR | |
369 | mn, sn: Name ; | |
370 | mod : CARDINAL ; | |
371 | BEGIN | |
372 | mn := MakeKey(module) ; | |
373 | sn := MakeKey(symname) ; | |
374 | IF IsModuleSeen(mn) | |
375 | THEN | |
376 | mod := LookupModule (UnknownTokenNo, mn) ; | |
377 | RETURN( GetLocalSym(mod, sn) ) | |
378 | ELSE | |
379 | RETURN( NulSym ) | |
380 | END | |
381 | END TryFindSymbol ; | |
382 | *) | |
383 | ||
384 | ||
385 | (* | |
386 | doInclude - | |
387 | *) | |
388 | ||
389 | PROCEDURE doInclude (l: Set; a: ARRAY OF CHAR; sym: CARDINAL) ; | |
390 | BEGIN | |
391 | IF NOT IsElementInSet(l, sym) | |
392 | THEN | |
393 | printf0('rule: ') ; | |
394 | WriteRule ; | |
395 | printf0(' ') ; | |
396 | printf1(a, sym) ; | |
397 | FIO.FlushBuffer(FIO.StdOut) ; | |
398 | IncludeElementIntoSet(l, sym) | |
399 | END | |
400 | END doInclude ; | |
401 | ||
402 | ||
403 | (* | |
404 | WatchIncludeList - include a symbol onto the set first checking | |
405 | whether it is already on the set and | |
406 | displaying a debug message if the set is | |
407 | changed. | |
408 | *) | |
409 | ||
410 | PROCEDURE WatchIncludeList (sym: CARDINAL; lt: ListType) ; | |
411 | BEGIN | |
412 | IF IsElementInSet(WatchList, sym) | |
413 | THEN | |
414 | CASE lt OF | |
415 | ||
416 | tobesolvedbyquads : doInclude(ToBeSolvedByQuads, "symbol %d -> ToBeSolvedByQuads\n", sym) | | |
417 | fullydeclared : doInclude(FullyDeclared, "symbol %d -> FullyDeclared\n", sym) ; | |
418 | IF sym=1265 | |
419 | THEN | |
420 | mystop | |
421 | END | | |
422 | partiallydeclared : doInclude(PartiallyDeclared, "symbol %d -> PartiallyDeclared\n", sym) | | |
423 | heldbyalignment : doInclude(HeldByAlignment, "symbol %d -> HeldByAlignment\n", sym) | | |
424 | finishedalignment : doInclude(FinishedAlignment, "symbol %d -> FinishedAlignment\n", sym) | | |
425 | todolist : doInclude(ToDoList, "symbol %d -> ToDoList\n", sym) | | |
426 | niltypedarrays : doInclude(NilTypedArrays, "symbol %d -> NilTypedArrays\n", sym) | |
427 | ||
428 | ELSE | |
429 | InternalError ('unknown list') | |
430 | END | |
431 | ELSE | |
432 | CASE lt OF | |
433 | ||
434 | tobesolvedbyquads : IncludeElementIntoSet(ToBeSolvedByQuads, sym) | | |
435 | fullydeclared : IncludeElementIntoSet(FullyDeclared, sym) | | |
436 | partiallydeclared : IncludeElementIntoSet(PartiallyDeclared, sym) | | |
437 | heldbyalignment : IncludeElementIntoSet(HeldByAlignment, sym) | | |
438 | finishedalignment : IncludeElementIntoSet(FinishedAlignment, sym) | | |
439 | todolist : IncludeElementIntoSet(ToDoList, sym) | | |
440 | niltypedarrays : IncludeElementIntoSet(NilTypedArrays, sym) | |
441 | ||
442 | ELSE | |
443 | InternalError ('unknown list') | |
444 | END | |
445 | END | |
446 | END WatchIncludeList ; | |
447 | ||
448 | ||
449 | (* | |
450 | doExclude - | |
451 | *) | |
452 | ||
453 | PROCEDURE doExclude (l: Set; a: ARRAY OF CHAR; sym: CARDINAL) ; | |
454 | BEGIN | |
455 | IF IsElementInSet(l, sym) | |
456 | THEN | |
457 | printf0('rule: ') ; | |
458 | WriteRule ; | |
459 | printf0(' ') ; | |
460 | printf1(a, sym) ; | |
461 | FIO.FlushBuffer(FIO.StdOut) ; | |
462 | ExcludeElementFromSet(l, sym) | |
463 | END | |
464 | END doExclude ; | |
465 | ||
466 | ||
467 | (* | |
468 | WatchRemoveList - remove a symbol onto the list first checking | |
469 | whether it is already on the list and | |
470 | displaying a debug message if the list is | |
471 | changed. | |
472 | *) | |
473 | ||
474 | PROCEDURE WatchRemoveList (sym: CARDINAL; lt: ListType) ; | |
475 | BEGIN | |
476 | IF IsElementInSet(WatchList, sym) | |
477 | THEN | |
478 | CASE lt OF | |
479 | ||
480 | tobesolvedbyquads : doExclude(ToBeSolvedByQuads, "symbol %d off ToBeSolvedByQuads\n", sym) | | |
481 | fullydeclared : doExclude(FullyDeclared, "symbol %d off FullyDeclared\n", sym) | | |
482 | partiallydeclared : doExclude(PartiallyDeclared, "symbol %d off PartiallyDeclared\n", sym) | | |
483 | heldbyalignment : doExclude(HeldByAlignment, "symbol %d -> HeldByAlignment\n", sym) | | |
484 | finishedalignment : doExclude(FinishedAlignment, "symbol %d -> FinishedAlignment\n", sym) | | |
485 | todolist : doExclude(ToDoList, "symbol %d off ToDoList\n", sym) | | |
486 | niltypedarrays : doExclude(NilTypedArrays, "symbol %d off NilTypedArrays\n", sym) | |
487 | ||
488 | ELSE | |
489 | InternalError ('unknown list') | |
490 | END | |
491 | ELSE | |
492 | CASE lt OF | |
493 | ||
494 | tobesolvedbyquads : ExcludeElementFromSet(ToBeSolvedByQuads, sym) | | |
495 | fullydeclared : ExcludeElementFromSet(FullyDeclared, sym) | | |
496 | partiallydeclared : ExcludeElementFromSet(PartiallyDeclared, sym) | | |
497 | heldbyalignment : ExcludeElementFromSet(HeldByAlignment, sym) | | |
498 | finishedalignment : ExcludeElementFromSet(FinishedAlignment, sym) | | |
499 | todolist : ExcludeElementFromSet(ToDoList, sym) | | |
500 | niltypedarrays : ExcludeElementFromSet(NilTypedArrays, sym) | |
501 | ||
502 | ELSE | |
503 | InternalError ('unknown list') | |
504 | END | |
505 | END | |
506 | END WatchRemoveList ; | |
507 | ||
508 | ||
509 | (* | |
510 | GetEnumList - | |
511 | *) | |
512 | ||
513 | PROCEDURE GetEnumList (sym: CARDINAL) : Tree ; | |
514 | BEGIN | |
515 | IF InBounds(EnumerationIndex, sym) | |
516 | THEN | |
517 | RETURN( GetIndice(EnumerationIndex, sym) ) | |
518 | ELSE | |
519 | RETURN( NIL ) | |
520 | END | |
521 | END GetEnumList ; | |
522 | ||
523 | ||
524 | (* | |
525 | PutEnumList - | |
526 | *) | |
527 | ||
528 | PROCEDURE PutEnumList (sym: CARDINAL; enumlist: Tree) ; | |
529 | BEGIN | |
530 | PutIndice(EnumerationIndex, sym, enumlist) | |
531 | END PutEnumList ; | |
532 | ||
533 | ||
534 | (* | |
535 | MarkExported - tell GCC to mark all exported procedures in module sym. | |
536 | *) | |
537 | ||
538 | PROCEDURE MarkExported (sym: CARDINAL) ; | |
539 | BEGIN | |
540 | IF Optimizing | |
541 | THEN | |
542 | MarkFunctionReferenced(Mod2Gcc(sym)) ; | |
543 | IF IsDefImp(sym) OR IsModule(sym) | |
544 | THEN | |
545 | ForeachExportedDo(sym, MarkExported) | |
546 | END | |
547 | END | |
548 | END MarkExported ; | |
549 | ||
550 | ||
551 | (* | |
552 | Chained - checks to see that, sym, has not already been placed on a chain. | |
553 | It returns the symbol, sym. | |
554 | *) | |
555 | ||
556 | PROCEDURE Chained (sym: CARDINAL) : CARDINAL ; | |
557 | BEGIN | |
558 | IF IsElementInSet(ChainedList, sym) | |
559 | THEN | |
560 | InternalError ('symbol has already been chained onto a previous list') | |
561 | END ; | |
562 | IncludeElementIntoSet(ChainedList, sym) ; | |
563 | RETURN( sym ) | |
564 | END Chained ; | |
565 | ||
566 | ||
567 | (* | |
568 | DoStartDeclaration - returns a tree representing a symbol which has | |
569 | not yet been finished. Used when declaring | |
570 | recursive types. | |
571 | *) | |
572 | ||
573 | PROCEDURE DoStartDeclaration (sym: CARDINAL; p: StartProcedure) : Tree ; | |
574 | VAR | |
575 | location: location_t ; | |
576 | BEGIN | |
577 | IF NOT GccKnowsAbout (sym) | |
578 | THEN | |
579 | location := TokenToLocation (GetDeclaredMod (sym)) ; | |
580 | PreAddModGcc(sym, p (location, KeyToCharStar (GetFullSymName (sym)))) | |
581 | END ; | |
582 | RETURN Mod2Gcc (sym) | |
583 | END DoStartDeclaration ; | |
584 | ||
585 | ||
586 | (* | |
587 | ArrayComponentsDeclared - returns TRUE if array, sym, | |
588 | subscripts and type are known. | |
589 | *) | |
590 | ||
591 | PROCEDURE ArrayComponentsDeclared (sym: CARDINAL) : BOOLEAN ; | |
592 | VAR | |
593 | Subscript : CARDINAL ; | |
594 | Type, High, Low: CARDINAL ; | |
595 | BEGIN | |
596 | Subscript := GetArraySubscript(sym) ; | |
597 | Assert(IsSubscript(Subscript)) ; | |
598 | Type := GetDType(Subscript) ; | |
599 | Low := GetTypeMin(Type) ; | |
600 | High := GetTypeMax(Type) ; | |
601 | RETURN( IsFullyDeclared(Type) AND | |
602 | IsFullyDeclared(Low) AND | |
603 | IsFullyDeclared(High) ) | |
604 | END ArrayComponentsDeclared ; | |
605 | ||
606 | ||
607 | (* | |
608 | GetRecordOfVarient - | |
609 | *) | |
610 | ||
611 | PROCEDURE GetRecordOfVarient (sym: CARDINAL) : CARDINAL ; | |
612 | BEGIN | |
613 | IF IsVarient(sym) OR IsFieldVarient(sym) | |
614 | THEN | |
615 | REPEAT | |
616 | sym := GetParent(sym) | |
617 | UNTIL IsRecord(sym) | |
618 | END ; | |
619 | RETURN( sym ) | |
620 | END GetRecordOfVarient ; | |
621 | ||
622 | ||
623 | (* | |
624 | CanDeclareRecordKind - | |
625 | *) | |
626 | ||
627 | PROCEDURE CanDeclareRecordKind (sym: CARDINAL) : BOOLEAN ; | |
628 | BEGIN | |
629 | sym := GetRecordOfVarient(sym) ; | |
630 | RETURN( IsRecord(sym) AND | |
631 | ((GetDefaultRecordFieldAlignment(sym)=NulSym) OR | |
632 | IsFullyDeclared(GetDefaultRecordFieldAlignment(sym))) ) | |
633 | END CanDeclareRecordKind ; | |
634 | ||
635 | ||
636 | (* | |
637 | DeclareRecordKind - works out whether record, sym, is packed or not. | |
638 | *) | |
639 | ||
640 | PROCEDURE DeclareRecordKind (sym: CARDINAL) ; | |
641 | BEGIN | |
642 | IF IsRecord(sym) | |
643 | THEN | |
644 | DetermineIfRecordPacked(sym) | |
645 | END ; | |
646 | WatchIncludeList(sym, todolist) ; | |
647 | WatchRemoveList(sym, heldbyalignment) ; | |
648 | WatchIncludeList(sym, finishedalignment) ; | |
649 | IF AllDependantsFullyDeclared(sym) | |
650 | THEN | |
651 | (* All good and ready to be solved. *) | |
652 | END | |
653 | END DeclareRecordKind ; | |
654 | ||
655 | ||
656 | (* | |
657 | CanDeclareRecord - | |
658 | *) | |
659 | ||
660 | PROCEDURE CanDeclareRecord (sym: CARDINAL) : BOOLEAN ; | |
661 | BEGIN | |
662 | TraverseDependants(sym) ; | |
663 | IF AllDependantsFullyDeclared(sym) | |
664 | THEN | |
665 | RETURN TRUE | |
666 | ELSE | |
667 | WatchIncludeList(sym, finishedalignment) ; | |
668 | RETURN FALSE | |
669 | END | |
670 | END CanDeclareRecord ; | |
671 | ||
672 | ||
673 | (* | |
674 | FinishDeclareRecord - | |
675 | *) | |
676 | ||
677 | PROCEDURE FinishDeclareRecord (sym: CARDINAL) ; | |
678 | BEGIN | |
679 | DeclareTypeConstFully(sym) ; | |
680 | WatchRemoveList(sym, heldbyalignment) ; | |
681 | WatchRemoveList(sym, finishedalignment) ; | |
682 | WatchRemoveList(sym, todolist) ; | |
683 | WatchIncludeList(sym, fullydeclared) | |
684 | END FinishDeclareRecord ; | |
685 | ||
686 | ||
687 | (* | |
688 | CanDeclareTypePartially - return TRUE if we are able to make a | |
689 | gcc partially created type. | |
690 | *) | |
691 | ||
692 | PROCEDURE CanDeclareTypePartially (sym: CARDINAL) : BOOLEAN ; | |
693 | VAR | |
694 | type: CARDINAL ; | |
695 | BEGIN | |
696 | IF IsElementInSet(PartiallyDeclared, sym) | |
697 | THEN | |
698 | RETURN( FALSE ) | |
699 | ELSIF IsProcType(sym) OR IsRecord(sym) OR IsVarient(sym) OR IsFieldVarient(sym) | |
700 | THEN | |
701 | RETURN( TRUE ) | |
702 | ELSIF IsType(sym) | |
703 | THEN | |
704 | type := GetSType(sym) ; | |
705 | IF (type#NulSym) AND IsNilTypedArrays(type) | |
706 | THEN | |
707 | RETURN( TRUE ) | |
708 | END | |
709 | END ; | |
710 | RETURN( FALSE ) | |
711 | END CanDeclareTypePartially ; | |
712 | ||
713 | ||
714 | (* | |
715 | DeclareTypePartially - create the gcc partial type symbol from, sym. | |
716 | *) | |
717 | ||
718 | PROCEDURE DeclareTypePartially (sym: CARDINAL) ; | |
719 | VAR | |
720 | location: location_t ; | |
721 | BEGIN | |
722 | (* check to see if we have already partially declared the symbol *) | |
723 | IF NOT IsElementInSet(PartiallyDeclared, sym) | |
724 | THEN | |
725 | IF IsRecord(sym) | |
726 | THEN | |
727 | Assert (NOT IsElementInSet (HeldByAlignment, sym)) ; | |
728 | Assert (DoStartDeclaration (sym, BuildStartRecord) # NIL) ; | |
729 | WatchIncludeList (sym, heldbyalignment) | |
730 | ELSIF IsVarient (sym) | |
731 | THEN | |
732 | Assert(NOT IsElementInSet(HeldByAlignment, sym)) ; | |
733 | Assert (DoStartDeclaration(sym, BuildStartVarient) # NIL) ; | |
734 | WatchIncludeList(sym, heldbyalignment) | |
735 | ELSIF IsFieldVarient(sym) | |
736 | THEN | |
737 | Assert(NOT IsElementInSet(HeldByAlignment, sym)) ; | |
738 | Assert (DoStartDeclaration(sym, BuildStartFieldVarient) # NIL) ; | |
739 | WatchIncludeList(sym, heldbyalignment) | |
740 | ELSIF IsProcType(sym) | |
741 | THEN | |
742 | Assert (DoStartDeclaration(sym, BuildStartFunctionType) # NIL) ; | |
743 | ELSIF IsType(sym) | |
744 | THEN | |
745 | IF NOT GccKnowsAbout(sym) | |
746 | THEN | |
747 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
748 | PreAddModGcc(sym, BuildStartType(location, | |
749 | KeyToCharStar(GetFullSymName(sym)), | |
750 | Mod2Gcc(GetSType(sym)))) | |
751 | END | |
752 | ELSE | |
753 | InternalError ('do not know how to create a partial type from this symbol') | |
754 | END ; | |
755 | WatchIncludeList(sym, partiallydeclared) ; | |
756 | TraverseDependants(sym) | |
757 | END | |
758 | END DeclareTypePartially ; | |
759 | ||
760 | ||
761 | (* | |
762 | CanDeclareArrayAsNil - | |
763 | *) | |
764 | ||
765 | PROCEDURE CanDeclareArrayAsNil (sym: CARDINAL) : BOOLEAN ; | |
766 | BEGIN | |
767 | RETURN( IsArray(sym) AND ArrayComponentsDeclared(sym) ) | |
768 | END CanDeclareArrayAsNil ; | |
769 | ||
770 | ||
771 | (* | |
772 | DeclareArrayAsNil - | |
773 | *) | |
774 | ||
775 | PROCEDURE DeclareArrayAsNil (sym: CARDINAL) ; | |
776 | BEGIN | |
777 | PreAddModGcc(sym, BuildStartArrayType(BuildIndex(GetDeclaredMod(sym), sym), NIL, GetDType(sym))) ; | |
778 | WatchIncludeList(sym, niltypedarrays) | |
779 | END DeclareArrayAsNil ; | |
780 | ||
781 | ||
782 | (* | |
783 | CanDeclareArrayPartially - | |
784 | *) | |
785 | ||
786 | PROCEDURE CanDeclareArrayPartially (sym: CARDINAL) : BOOLEAN ; | |
787 | VAR | |
788 | type: CARDINAL ; | |
789 | BEGIN | |
790 | IF IsArray(sym) | |
791 | THEN | |
792 | type := GetSType(sym) ; | |
793 | IF IsPartiallyOrFullyDeclared(type) OR | |
794 | (IsPointer(type) AND IsNilTypedArrays(type)) | |
795 | THEN | |
796 | RETURN( TRUE ) | |
797 | END | |
798 | END ; | |
799 | RETURN( FALSE ) | |
800 | END CanDeclareArrayPartially ; | |
801 | ||
802 | ||
803 | (* | |
804 | DeclareArrayPartially - | |
805 | *) | |
806 | ||
807 | PROCEDURE DeclareArrayPartially (sym: CARDINAL) ; | |
808 | BEGIN | |
809 | Assert(IsArray(sym) AND GccKnowsAbout(sym)) ; | |
810 | PutArrayType(Mod2Gcc(sym), Mod2Gcc(GetSType(sym))) ; | |
811 | WatchIncludeList(sym, partiallydeclared) | |
812 | END DeclareArrayPartially ; | |
813 | ||
814 | ||
815 | (* | |
816 | CanDeclarePointerToNilArray - | |
817 | *) | |
818 | ||
819 | PROCEDURE CanDeclarePointerToNilArray (sym: CARDINAL) : BOOLEAN ; | |
820 | BEGIN | |
821 | RETURN( IsPointer(sym) AND IsNilTypedArrays(GetSType(sym)) ) | |
822 | END CanDeclarePointerToNilArray ; | |
823 | ||
824 | ||
825 | (* | |
826 | DeclarePointerToNilArray - | |
827 | *) | |
828 | ||
829 | PROCEDURE DeclarePointerToNilArray (sym: CARDINAL) ; | |
830 | BEGIN | |
831 | PreAddModGcc(sym, BuildPointerType(Mod2Gcc(GetSType(sym)))) ; | |
832 | WatchIncludeList(sym, niltypedarrays) | |
833 | END DeclarePointerToNilArray ; | |
834 | ||
835 | ||
836 | (* | |
837 | CanPromotePointerFully - | |
838 | *) | |
839 | ||
840 | PROCEDURE CanPromotePointerFully (sym: CARDINAL) : BOOLEAN ; | |
841 | BEGIN | |
842 | RETURN( IsPointer(sym) AND IsPartiallyOrFullyDeclared(GetSType(sym)) ) | |
843 | END CanPromotePointerFully ; | |
844 | ||
845 | ||
846 | (* | |
847 | PromotePointerFully - | |
848 | *) | |
849 | ||
850 | PROCEDURE PromotePointerFully (sym: CARDINAL) ; | |
851 | BEGIN | |
852 | WatchIncludeList(sym, fullydeclared) | |
853 | END PromotePointerFully ; | |
854 | ||
855 | ||
856 | (* | |
857 | CompletelyResolved - returns TRUE if a symbols has been completely resolved | |
858 | and is not partically declared (such as a record). | |
859 | *) | |
860 | ||
861 | PROCEDURE CompletelyResolved (sym: CARDINAL) : BOOLEAN ; | |
862 | BEGIN | |
863 | RETURN( IsElementInSet(FullyDeclared, sym) ) | |
864 | END CompletelyResolved ; | |
865 | ||
866 | ||
867 | (* | |
868 | IsTypeQ - returns TRUE if all q(dependants) of, sym, | |
869 | return TRUE. | |
870 | *) | |
871 | ||
872 | PROCEDURE IsTypeQ (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
873 | BEGIN | |
874 | IF IsVar(sym) | |
875 | THEN | |
876 | RETURN( IsVarDependants(sym, q) ) | |
877 | ELSIF IsEnumeration(sym) | |
878 | THEN | |
879 | RETURN( IsEnumerationDependants(sym, q) ) | |
880 | ELSIF IsFieldEnumeration(sym) | |
881 | THEN | |
882 | RETURN( TRUE ) | |
883 | ELSIF IsSubrange(sym) | |
884 | THEN | |
885 | RETURN( IsSubrangeDependants(sym, q) ) | |
886 | ELSIF IsPointer(sym) | |
887 | THEN | |
888 | RETURN( IsPointerDependants(sym, q) ) | |
889 | ELSIF IsRecord(sym) | |
890 | THEN | |
891 | RETURN( IsRecordDependants(sym, q) ) | |
892 | ELSIF IsRecordField(sym) | |
893 | THEN | |
894 | RETURN( IsRecordFieldDependants(sym, q) ) | |
895 | ELSIF IsVarient(sym) | |
896 | THEN | |
897 | RETURN( IsVarientDependants(sym, q) ) | |
898 | ELSIF IsFieldVarient(sym) | |
899 | THEN | |
900 | RETURN( IsVarientFieldDependants(sym, q) ) | |
901 | ELSIF IsArray(sym) | |
902 | THEN | |
903 | RETURN( IsArrayDependants(sym, q) ) | |
904 | ELSIF IsProcType(sym) | |
905 | THEN | |
906 | RETURN( IsProcTypeDependants(sym, q) ) | |
907 | ELSIF IsUnbounded(sym) | |
908 | THEN | |
909 | RETURN( IsUnboundedDependants(sym, q) ) | |
910 | ELSIF IsPartialUnbounded(sym) | |
911 | THEN | |
912 | InternalError ('should not be declaring a partial unbounded symbol') | |
913 | ELSIF IsSet(sym) | |
914 | THEN | |
915 | RETURN( IsSetDependants(sym, q) ) | |
916 | ELSIF IsType(sym) | |
917 | THEN | |
918 | RETURN( IsTypeDependants(sym, q) ) | |
919 | ELSIF IsConst(sym) | |
920 | THEN | |
921 | RETURN( IsConstDependants(sym, q) ) | |
922 | ELSIF IsConstructor(sym) OR IsConstSet(sym) | |
923 | THEN | |
924 | (* sym can be a constructor, but at present we have not resolved whether | |
925 | all dependants are constants. | |
926 | *) | |
927 | RETURN( IsConstructorDependants(sym, q) ) | |
928 | ELSIF IsProcedure(sym) | |
929 | THEN | |
930 | RETURN( IsProcedureDependants(sym, q) ) | |
931 | ELSE | |
932 | RETURN( TRUE ) | |
933 | END | |
934 | END IsTypeQ ; | |
935 | ||
936 | ||
937 | (* | |
938 | IsNilTypedArrays - returns TRUE if, sym, is dependant upon a NIL typed array | |
939 | *) | |
940 | ||
941 | PROCEDURE IsNilTypedArrays (sym: CARDINAL) : BOOLEAN ; | |
942 | BEGIN | |
943 | RETURN( IsElementInSet(NilTypedArrays, sym) ) | |
944 | END IsNilTypedArrays ; | |
945 | ||
946 | ||
947 | (* | |
948 | IsFullyDeclared - returns TRUE if, sym, is fully declared. | |
949 | *) | |
950 | ||
951 | PROCEDURE IsFullyDeclared (sym: CARDINAL) : BOOLEAN ; | |
952 | BEGIN | |
953 | RETURN( IsElementInSet(FullyDeclared, sym) ) | |
954 | END IsFullyDeclared ; | |
955 | ||
956 | ||
957 | (* | |
958 | AllDependantsFullyDeclared - returns TRUE if all dependants of, | |
959 | sym, are declared. | |
960 | *) | |
961 | ||
962 | PROCEDURE AllDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ; | |
963 | BEGIN | |
964 | RETURN( IsTypeQ(sym, IsFullyDeclared) ) | |
965 | END AllDependantsFullyDeclared ; | |
966 | ||
967 | ||
968 | (* | |
969 | NotAllDependantsFullyDeclared - returns TRUE if any dependants of, | |
970 | sym, are not declared. | |
971 | *) | |
972 | ||
973 | PROCEDURE NotAllDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ; | |
974 | BEGIN | |
975 | RETURN( NOT IsTypeQ(sym, IsFullyDeclared) ) | |
976 | END NotAllDependantsFullyDeclared ; | |
977 | ||
978 | ||
979 | (* | |
980 | IsPartiallyDeclared - returns TRUE if, sym, is partially declared. | |
981 | *) | |
982 | ||
983 | PROCEDURE IsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ; | |
984 | BEGIN | |
985 | RETURN( IsElementInSet(PartiallyDeclared, sym) ) | |
986 | END IsPartiallyDeclared ; | |
987 | ||
988 | ||
989 | (* | |
990 | AllDependantsPartiallyDeclared - returns TRUE if all dependants of, | |
991 | sym, are partially declared. | |
992 | *) | |
993 | ||
994 | PROCEDURE AllDependantsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ; | |
995 | BEGIN | |
996 | RETURN( IsTypeQ(sym, IsPartiallyDeclared) ) | |
997 | END AllDependantsPartiallyDeclared ; | |
998 | ||
999 | ||
1000 | (* | |
1001 | NotAllDependantsPartiallyDeclared - returns TRUE if any dependants of, | |
1002 | sym, are not partially declared. | |
1003 | *) | |
1004 | ||
1005 | PROCEDURE NotAllDependantsPartiallyDeclared (sym: CARDINAL) : BOOLEAN ; | |
1006 | BEGIN | |
1007 | RETURN( NOT IsTypeQ(sym, IsPartiallyDeclared) ) | |
1008 | END NotAllDependantsPartiallyDeclared ; | |
1009 | ||
1010 | ||
1011 | (* | |
1012 | IsPartiallyOrFullyDeclared - returns TRUE if, sym, is partially or fully declared. | |
1013 | *) | |
1014 | ||
1015 | PROCEDURE IsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ; | |
1016 | BEGIN | |
1017 | RETURN( IsElementInSet(PartiallyDeclared, sym) OR | |
1018 | IsElementInSet(FullyDeclared, sym) ) | |
1019 | END IsPartiallyOrFullyDeclared ; | |
1020 | ||
1021 | ||
1022 | (* | |
1023 | AllDependantsPartiallyOrFullyDeclared - returns TRUE if all dependants of, | |
1024 | sym, are partially or fully declared. | |
1025 | *) | |
1026 | ||
1027 | PROCEDURE AllDependantsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ; | |
1028 | BEGIN | |
1029 | RETURN( IsTypeQ(sym, IsPartiallyOrFullyDeclared) ) | |
1030 | END AllDependantsPartiallyOrFullyDeclared ; | |
1031 | ||
1032 | ||
1033 | (* | |
1034 | NotAllDependantsPartiallyOrFullyDeclared - returns TRUE if all dependants of, | |
1035 | sym, are not partially and not fully | |
1036 | declared. | |
1037 | *) | |
1038 | ||
1039 | (* | |
1040 | PROCEDURE NotAllDependantsPartiallyOrFullyDeclared (sym: CARDINAL) : BOOLEAN ; | |
1041 | BEGIN | |
1042 | RETURN( IsTypeQ(sym, IsPartiallyOrFullyDeclared) ) | |
1043 | END NotAllDependantsPartiallyOrFullyDeclared ; | |
1044 | *) | |
1045 | ||
1046 | ||
1047 | (* | |
1048 | TypeConstDependantsFullyDeclared - returns TRUE if sym is a constant or | |
1049 | type and its dependants are fully | |
1050 | declared. | |
1051 | *) | |
1052 | ||
1053 | PROCEDURE TypeConstDependantsFullyDeclared (sym: CARDINAL) : BOOLEAN ; | |
1054 | BEGIN | |
1055 | RETURN( (NOT IsVar(sym)) AND | |
1056 | (NOT IsRecord(sym)) AND | |
1057 | (NOT IsParameter(sym)) AND | |
1058 | AllDependantsFullyDeclared(sym) ) | |
1059 | END TypeConstDependantsFullyDeclared ; | |
1060 | ||
1061 | ||
1062 | (* | |
1063 | CanBeDeclaredViaPartialDependants - returns TRUE if this symbol | |
1064 | can be declared by partial | |
1065 | dependants. Such a symbol must | |
1066 | be a record, proctype or | |
1067 | an array. | |
1068 | *) | |
1069 | ||
1070 | PROCEDURE CanBeDeclaredViaPartialDependants (sym: CARDINAL) : BOOLEAN ; | |
1071 | BEGIN | |
1072 | RETURN( (IsPointer(sym) OR IsProcType(sym)) AND | |
1073 | AllDependantsPartiallyOrFullyDeclared(sym) ) | |
1074 | END CanBeDeclaredViaPartialDependants ; | |
1075 | ||
1076 | ||
1077 | (* | |
1078 | DeclareConstFully - will add, sym, to the fully declared list and | |
1079 | also remove it from the to do list. This is | |
1080 | called indirectly from M2GenGCC as it calculates | |
1081 | constants during quadruple processing. | |
1082 | *) | |
1083 | ||
1084 | PROCEDURE DeclareConstFully (sym: CARDINAL) ; | |
1085 | BEGIN | |
1086 | WatchIncludeList(sym, fullydeclared) ; | |
1087 | WatchRemoveList(sym, todolist) ; | |
1088 | WatchRemoveList(sym, partiallydeclared) ; | |
1089 | WatchRemoveList(sym, tobesolvedbyquads) | |
1090 | END DeclareConstFully ; | |
1091 | ||
1092 | ||
1093 | (* | |
1094 | PutToBeSolvedByQuads - places, sym, to this list and returns, | |
1095 | sym. | |
1096 | *) | |
1097 | ||
1098 | PROCEDURE PutToBeSolvedByQuads (sym: CARDINAL) ; | |
1099 | BEGIN | |
1100 | WatchIncludeList(sym, tobesolvedbyquads) | |
1101 | END PutToBeSolvedByQuads ; | |
1102 | ||
1103 | ||
1104 | (* | |
1105 | DeclareTypeConstFully - declare the GCC type and add the double | |
1106 | book keeping entry. | |
1107 | *) | |
1108 | ||
1109 | PROCEDURE DeclareTypeConstFully (sym: CARDINAL) ; | |
1110 | VAR | |
1111 | t: Tree ; | |
1112 | BEGIN | |
1113 | IF NOT IsElementInSet(ToBeSolvedByQuads, sym) | |
1114 | THEN | |
1115 | IF IsModule(sym) OR IsDefImp(sym) | |
1116 | THEN | |
1117 | WatchIncludeList(sym, fullydeclared) ; | |
1118 | WatchRemoveList(sym, partiallydeclared) ; | |
1119 | WatchRemoveList(sym, todolist) | |
1120 | ELSIF IsProcedure(sym) | |
1121 | THEN | |
1122 | DeclareProcedureToGcc(sym) ; | |
1123 | WatchIncludeList(sym, fullydeclared) ; | |
1124 | WatchRemoveList(sym, partiallydeclared) ; | |
1125 | WatchRemoveList(sym, todolist) | |
1126 | ELSE | |
1127 | t := TypeConstFullyDeclared(sym) ; | |
1128 | IF t#NIL | |
1129 | THEN | |
1130 | (* add relationship between gccsym and sym *) | |
1131 | PreAddModGcc(sym, t) ; | |
1132 | WatchIncludeList(sym, fullydeclared) ; | |
1133 | WatchRemoveList(sym, partiallydeclared) ; | |
1134 | WatchRemoveList(sym, heldbyalignment) ; | |
1135 | WatchRemoveList(sym, finishedalignment) ; | |
1136 | WatchRemoveList(sym, todolist) | |
1137 | END | |
1138 | END | |
1139 | END | |
1140 | END DeclareTypeConstFully ; | |
1141 | ||
1142 | ||
1143 | (* | |
1144 | DeclareTypeFromPartial - declare the full GCC type from a partial type | |
1145 | and add the double book keeping entry. | |
1146 | *) | |
1147 | ||
1148 | PROCEDURE DeclareTypeFromPartial (sym: CARDINAL) ; | |
1149 | VAR | |
1150 | t: Tree ; | |
1151 | BEGIN | |
1152 | t := CompleteDeclarationOf(sym) ; | |
1153 | IF t=NIL | |
1154 | THEN | |
1155 | InternalError ('expecting to be able to create a gcc type') | |
1156 | ELSE | |
1157 | AddModGcc(sym, t) ; | |
1158 | WatchIncludeList(sym, fullydeclared) ; | |
1159 | WatchRemoveList(sym, partiallydeclared) | |
1160 | END | |
1161 | END DeclareTypeFromPartial ; | |
1162 | ||
1163 | ||
1164 | (* | |
1165 | DeclarePointerTypeFully - if, sym, is a pointer type then | |
1166 | declare it. | |
1167 | *) | |
1168 | ||
1169 | (* | |
1170 | PROCEDURE DeclarePointerTypeFully (sym: CARDINAL) ; | |
1171 | BEGIN | |
1172 | IF IsPointer(sym) | |
1173 | THEN | |
1174 | WatchIncludeList(sym, fullydeclared) ; | |
1175 | WatchRemoveList(sym, partiallydeclared) ; | |
1176 | WatchRemoveList(sym, todolist) ; | |
1177 | PreAddModGcc(sym, DeclarePointer(sym)) | |
1178 | ELSE | |
1179 | (* place sym and all dependants on the todolist | |
1180 | providing they are not already on the FullyDeclared list | |
1181 | *) | |
1182 | TraverseDependants(sym) | |
1183 | END | |
1184 | END DeclarePointerTypeFully ; | |
1185 | *) | |
1186 | ||
1187 | ||
1188 | (* | |
1189 | CanBeDeclaredPartiallyViaPartialDependants - returns TRUE if, sym, | |
1190 | can be partially declared via | |
1191 | another partially declared type. | |
1192 | *) | |
1193 | ||
1194 | PROCEDURE CanBeDeclaredPartiallyViaPartialDependants (sym: CARDINAL) : BOOLEAN ; | |
1195 | BEGIN | |
1196 | RETURN( IsType(sym) AND AllDependantsPartiallyDeclared(sym) ) | |
1197 | END CanBeDeclaredPartiallyViaPartialDependants ; | |
1198 | ||
1199 | ||
1200 | (* | |
1201 | EmitCircularDependancyError - issue a dependancy error. | |
1202 | *) | |
1203 | ||
1204 | PROCEDURE EmitCircularDependancyError (sym: CARDINAL) ; | |
1205 | BEGIN | |
1206 | MetaError1('circular dependancy error found when trying to resolve {%1Uad}', | |
1207 | sym) | |
1208 | END EmitCircularDependancyError ; | |
1209 | ||
1210 | ||
1211 | TYPE | |
1212 | Rule = (norule, partialtype, arraynil, pointernilarray, arraypartial, | |
1213 | pointerfully, recordkind, recordfully, typeconstfully, | |
1214 | pointerfrompartial, typefrompartial, partialfrompartial, | |
1215 | partialtofully, circulartodo, circularpartial, circularniltyped) ; | |
1216 | ||
1217 | VAR | |
1218 | bodyp : WalkAction ; | |
1219 | bodyq : IsAction ; | |
1220 | bodyt : ListType ; | |
1221 | bodyl : Set ; | |
1222 | bodyr : Rule ; | |
1223 | recursionCaught, | |
1224 | oneResolved, | |
1225 | noMoreWritten : BOOLEAN ; | |
1226 | ||
1227 | ||
1228 | (* | |
1229 | WriteRule - writes out the name of the rule. | |
1230 | *) | |
1231 | ||
1232 | PROCEDURE WriteRule ; | |
1233 | BEGIN | |
1234 | IF Debugging | |
1235 | THEN | |
1236 | CASE bodyr OF | |
1237 | ||
1238 | norule : printf0('norule') | | |
1239 | partialtype : printf0('partialtype') | | |
1240 | arraynil : printf0('arraynil') | | |
1241 | pointernilarray : printf0('pointernilarray') | | |
1242 | arraypartial : printf0('arraypartial') | | |
1243 | pointerfully : printf0('pointerfully') | | |
1244 | recordkind : printf0('recordkind') | | |
1245 | recordfully : printf0('recordfully') | | |
1246 | typeconstfully : printf0('typeconstfully') | | |
1247 | pointerfrompartial: printf0('pointerfrompartial') | | |
1248 | typefrompartial : printf0('typefrompartial') | | |
1249 | partialfrompartial: printf0('partialfrompartial') | | |
1250 | partialtofully : printf0('partialtofully') | | |
1251 | circulartodo : printf0('circulartodo') | | |
1252 | circularpartial : printf0('circularpartial') | | |
1253 | circularniltyped : printf0('circularniltyped') | |
1254 | ||
1255 | ELSE | |
1256 | InternalError ('unknown rule') | |
1257 | END | |
1258 | END | |
1259 | END WriteRule ; | |
1260 | ||
1261 | ||
1262 | (* | |
1263 | Body - | |
1264 | *) | |
1265 | ||
1266 | PROCEDURE Body (sym: CARDINAL) ; | |
1267 | BEGIN | |
1268 | IF bodyq(sym) | |
1269 | THEN | |
1270 | WatchRemoveList(sym, bodyt) ; | |
1271 | bodyp(sym) ; | |
1272 | (* bodyp(sym) might have replaced sym into the set *) | |
1273 | IF NOT IsElementInSet(bodyl, sym) | |
1274 | THEN | |
1275 | noMoreWritten := FALSE ; | |
1276 | oneResolved := TRUE | |
1277 | END | |
1278 | END | |
1279 | END Body ; | |
1280 | ||
1281 | ||
1282 | (* | |
1283 | ForeachTryDeclare - while q(of one sym in l) is true | |
1284 | for each symbol in, l, | |
1285 | if q(sym) | |
1286 | then | |
1287 | p(sym) | |
1288 | end | |
1289 | end | |
1290 | *) | |
1291 | ||
1292 | PROCEDURE ForeachTryDeclare (t: ListType; l: Set; r: Rule; | |
1293 | q: IsAction; p: WalkAction) : BOOLEAN ; | |
1294 | BEGIN | |
1295 | IF recursionCaught | |
1296 | THEN | |
1297 | InternalError ('caught recursive cycle in ForeachTryDeclare') | |
1298 | END ; | |
1299 | bodyt := t ; | |
1300 | bodyq := q ; | |
1301 | bodyp := p ; | |
1302 | bodyl := l ; | |
1303 | bodyr := r ; | |
1304 | recursionCaught := TRUE ; | |
1305 | oneResolved := FALSE ; | |
1306 | REPEAT | |
1307 | noMoreWritten := TRUE ; | |
1308 | ForeachElementInSetDo(l, Body) | |
1309 | UNTIL noMoreWritten ; | |
1310 | bodyr := norule ; | |
1311 | recursionCaught := FALSE ; | |
1312 | RETURN( oneResolved ) | |
1313 | END ForeachTryDeclare ; | |
1314 | ||
1315 | ||
1316 | (* | |
1317 | DeclaredOutandingTypes - writes out any types that have their | |
1318 | dependants solved. It returns TRUE if | |
1319 | all outstanding types have been written. | |
1320 | *) | |
1321 | ||
1322 | PROCEDURE DeclaredOutstandingTypes (ForceComplete: BOOLEAN) : BOOLEAN ; | |
1323 | VAR | |
1324 | finished : BOOLEAN ; | |
1325 | d, a, p, f, n, b: CARDINAL ; | |
1326 | BEGIN | |
1327 | d := 0 ; | |
1328 | a := 0 ; | |
1329 | p := 0 ; | |
1330 | f := 0 ; | |
1331 | n := 0 ; | |
1332 | b := 0 ; | |
1333 | finished := FALSE ; | |
1334 | REPEAT | |
1335 | IF FindSetNumbers (d, a, p, f, n, b) OR Progress | |
1336 | THEN | |
1337 | DebugSetNumbers | |
1338 | END ; | |
1339 | IF ForeachTryDeclare (todolist, ToDoList, | |
1340 | partialtype, | |
1341 | CanDeclareTypePartially, | |
1342 | DeclareTypePartially) | |
1343 | THEN | |
1344 | (* continue looping *) | |
1345 | ELSIF ForeachTryDeclare (todolist, ToDoList, | |
1346 | arraynil, | |
1347 | CanDeclareArrayAsNil, | |
1348 | DeclareArrayAsNil) | |
1349 | THEN | |
1350 | (* continue looping *) | |
1351 | ELSIF ForeachTryDeclare (todolist, ToDoList, | |
1352 | pointernilarray, | |
1353 | CanDeclarePointerToNilArray, | |
1354 | DeclarePointerToNilArray) | |
1355 | THEN | |
1356 | (* continue looping *) | |
1357 | ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays, | |
1358 | arraypartial, | |
1359 | CanDeclareArrayPartially, | |
1360 | DeclareArrayPartially) | |
1361 | THEN | |
1362 | (* continue looping *) | |
1363 | ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays, | |
1364 | pointerfully, | |
1365 | CanPromotePointerFully, | |
1366 | PromotePointerFully) | |
1367 | THEN | |
1368 | (* continue looping *) | |
1369 | ELSIF ForeachTryDeclare (heldbyalignment, HeldByAlignment, | |
1370 | recordkind, | |
1371 | CanDeclareRecordKind, | |
1372 | DeclareRecordKind) | |
1373 | THEN | |
1374 | (* continue looping *) | |
1375 | ELSIF ForeachTryDeclare (finishedalignment, FinishedAlignment, | |
1376 | recordfully, | |
1377 | CanDeclareRecord, | |
1378 | FinishDeclareRecord) | |
1379 | THEN | |
1380 | (* continue looping *) | |
1381 | ELSIF ForeachTryDeclare (todolist, ToDoList, | |
1382 | typeconstfully, | |
1383 | TypeConstDependantsFullyDeclared, | |
1384 | DeclareTypeConstFully) | |
1385 | THEN | |
1386 | (* continue looping *) | |
1387 | ELSIF ForeachTryDeclare (todolist, ToDoList, | |
1388 | (* partiallydeclared, PartiallyDeclared, *) | |
1389 | typefrompartial, | |
1390 | CanBeDeclaredViaPartialDependants, | |
1391 | DeclareTypeFromPartial) | |
1392 | THEN | |
1393 | (* continue looping *) | |
1394 | ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared, | |
1395 | partialfrompartial, | |
1396 | CanBeDeclaredPartiallyViaPartialDependants, | |
1397 | DeclareTypePartially) | |
1398 | THEN | |
1399 | (* continue looping *) | |
1400 | ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared, | |
1401 | partialtofully, | |
1402 | TypeConstDependantsFullyDeclared, | |
1403 | DeclareTypeConstFully) | |
1404 | THEN | |
1405 | (* continue looping *) | |
1406 | ELSE | |
1407 | (* nothing left to do (and constants are resolved elsewhere) *) | |
1408 | finished := TRUE | |
1409 | END | |
1410 | UNTIL finished ; | |
1411 | IF ForceComplete | |
1412 | THEN | |
1413 | IF ForeachTryDeclare (todolist, ToDoList, | |
1414 | circulartodo, | |
1415 | NotAllDependantsFullyDeclared, | |
1416 | EmitCircularDependancyError) | |
1417 | THEN | |
1418 | ELSIF ForeachTryDeclare (partiallydeclared, PartiallyDeclared, | |
1419 | circularpartial, | |
1420 | NotAllDependantsPartiallyDeclared, | |
1421 | EmitCircularDependancyError) | |
1422 | THEN | |
1423 | ELSIF ForeachTryDeclare (niltypedarrays, NilTypedArrays, | |
1424 | circularniltyped, | |
1425 | NotAllDependantsPartiallyDeclared, | |
1426 | EmitCircularDependancyError) | |
1427 | THEN | |
1428 | END | |
1429 | END ; | |
1430 | RETURN NoOfElementsInSet (ToDoList) = 0 | |
1431 | END DeclaredOutstandingTypes ; | |
1432 | ||
1433 | ||
1434 | (* | |
1435 | CompleteDeclarationOf - returns the GCC Tree for, sym, if it can | |
1436 | be created from partially or fully declared | |
1437 | dependents. | |
1438 | *) | |
1439 | ||
1440 | PROCEDURE CompleteDeclarationOf (sym: CARDINAL) : Tree ; | |
1441 | BEGIN | |
1442 | IF IsArray(sym) | |
1443 | THEN | |
1444 | RETURN( DeclareArray(sym) ) | |
1445 | ELSIF IsProcType(sym) | |
1446 | THEN | |
1447 | RETURN( DeclareProcType(sym) ) | |
1448 | ELSIF IsRecordField(sym) | |
1449 | THEN | |
1450 | RETURN( DeclareRecordField(sym) ) | |
1451 | ELSIF IsPointer(sym) | |
1452 | THEN | |
1453 | RETURN( DeclarePointer(sym) ) | |
1454 | ELSE | |
1455 | RETURN( NIL ) | |
1456 | END | |
1457 | END CompleteDeclarationOf ; | |
1458 | ||
1459 | ||
1460 | (* | |
1461 | DeclareType - here a type has been created via TYPE foo = bar, | |
1462 | we must tell GCC about it. | |
1463 | *) | |
1464 | ||
1465 | PROCEDURE DeclareType (sym: CARDINAL) : Tree ; | |
1466 | VAR | |
1467 | t : Tree ; | |
1468 | location: location_t ; | |
1469 | BEGIN | |
1470 | IF GetSType(sym)=NulSym | |
1471 | THEN | |
1472 | MetaError1('base type {%1Ua} not understood', sym) ; | |
1473 | InternalError ('base type should have been declared') | |
1474 | ELSE | |
1475 | IF GetSymName(sym)=NulName | |
1476 | THEN | |
1477 | RETURN( Tree(Mod2Gcc(GetSType(sym))) ) | |
1478 | ELSE | |
1479 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
1480 | IF GccKnowsAbout(sym) | |
1481 | THEN | |
1482 | t := Mod2Gcc(sym) | |
1483 | ELSE | |
1484 | (* not partially declared therefore start it *) | |
1485 | t := BuildStartType(location, | |
1486 | KeyToCharStar(GetFullSymName(sym)), Mod2Gcc(GetSType(sym))) | |
1487 | END ; | |
1488 | t := BuildEndType(location, t) ; (* now finish it *) | |
1489 | RETURN( t ) | |
1490 | END | |
1491 | END | |
1492 | END DeclareType ; | |
1493 | ||
1494 | ||
1495 | (* | |
1496 | DeclareIntegerConstant - declares an integer constant. | |
1497 | *) | |
1498 | ||
1499 | (* | |
1500 | PROCEDURE DeclareIntegerConstant (sym: CARDINAL; value: INTEGER) ; | |
1501 | BEGIN | |
1502 | PreAddModGcc(sym, BuildIntegerConstant(value)) ; | |
1503 | WatchRemoveList(sym, todolist) ; | |
1504 | WatchIncludeList(sym, fullydeclared) | |
1505 | END DeclareIntegerConstant ; | |
1506 | *) | |
1507 | ||
1508 | ||
1509 | (* | |
1510 | DeclareIntegerFromTree - declares an integer constant from a Tree, value. | |
1511 | *) | |
1512 | ||
1513 | PROCEDURE DeclareConstantFromTree (sym: CARDINAL; value: Tree) ; | |
1514 | BEGIN | |
1515 | PreAddModGcc(sym, value) ; | |
1516 | WatchRemoveList(sym, todolist) ; | |
1517 | WatchIncludeList(sym, fullydeclared) | |
1518 | END DeclareConstantFromTree ; | |
1519 | ||
1520 | ||
1521 | (* | |
1522 | DeclareCharConstant - declares a character constant. | |
1523 | *) | |
1524 | ||
1525 | PROCEDURE DeclareCharConstant (sym: CARDINAL) ; | |
1526 | VAR | |
1527 | location: location_t ; | |
1528 | BEGIN | |
1529 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
1530 | PreAddModGcc(sym, BuildCharConstant(location, KeyToCharStar(GetString(sym)))) ; | |
1531 | WatchRemoveList(sym, todolist) ; | |
1532 | WatchIncludeList(sym, fullydeclared) | |
1533 | END DeclareCharConstant ; | |
1534 | ||
1535 | ||
1536 | (* | |
1537 | DeclareStringConstant - declares a string constant. | |
1538 | *) | |
1539 | ||
1540 | PROCEDURE DeclareStringConstant (sym: CARDINAL) ; | |
1541 | VAR | |
1542 | symtree : Tree ; | |
1543 | BEGIN | |
1544 | IF IsConstStringM2nul (sym) OR IsConstStringCnul (sym) | |
1545 | THEN | |
1546 | (* in either case the string needs a nul terminator. If the string | |
1547 | is a C variant it will already have had any escape characters applied. | |
1548 | The BuildCStringConstant only adds the nul terminator. *) | |
1549 | symtree := BuildCStringConstant (KeyToCharStar (GetString (sym)), | |
1550 | GetStringLength (sym)) | |
1551 | ELSE | |
1552 | symtree := BuildStringConstant (KeyToCharStar (GetString (sym)), | |
1553 | GetStringLength (sym)) | |
1554 | END ; | |
1555 | PreAddModGcc (sym, symtree) ; | |
1556 | WatchRemoveList (sym, todolist) ; | |
1557 | WatchIncludeList (sym, fullydeclared) | |
1558 | END DeclareStringConstant ; | |
1559 | ||
1560 | ||
1561 | (* | |
1562 | PromoteToString - declare, sym, and then promote it to a string. | |
1563 | Note that if sym is a single character we do | |
1564 | *not* record it as a string | |
1565 | but as a char however we always | |
1566 | return a string constant. | |
1567 | *) | |
1568 | ||
1569 | PROCEDURE PromoteToString (tokenno: CARDINAL; sym: CARDINAL) : Tree ; | |
1570 | VAR | |
1571 | size: CARDINAL ; | |
1572 | BEGIN | |
1573 | DeclareConstant (tokenno, sym) ; | |
1574 | size := GetStringLength (sym) ; | |
1575 | IF size > 1 | |
1576 | THEN | |
1577 | (* will be a string anyway *) | |
1578 | RETURN Tree (Mod2Gcc (sym)) | |
1579 | ELSE | |
1580 | RETURN BuildStringConstant (KeyToCharStar (GetString (sym)), | |
1581 | GetStringLength (sym)) | |
1582 | END | |
1583 | END PromoteToString ; | |
1584 | ||
1585 | ||
1586 | (* | |
1587 | WalkConstructor - walks all dependants of, sym. | |
1588 | *) | |
1589 | ||
1590 | PROCEDURE WalkConstructor (sym: CARDINAL; p: WalkAction) ; | |
1591 | VAR | |
1592 | type: CARDINAL ; | |
1593 | BEGIN | |
1594 | type := GetSType(sym) ; | |
1595 | IF type#NulSym | |
1596 | THEN | |
1597 | WalkDependants(type, p) ; | |
1598 | WalkConstructorDependants(sym, p) | |
1599 | END | |
1600 | END WalkConstructor ; | |
1601 | ||
1602 | ||
1603 | (* | |
1604 | DeclareConstructor - declares a constructor. | |
1605 | *) | |
1606 | ||
1607 | PROCEDURE DeclareConstructor (tokenno: CARDINAL; quad: CARDINAL; sym: CARDINAL) ; | |
1608 | BEGIN | |
1609 | IF sym=NulSym | |
1610 | THEN | |
1611 | InternalError ('trying to declare the NulSym') | |
1612 | END ; | |
1613 | IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym)) | |
1614 | THEN | |
1615 | WalkConstructor(sym, TraverseDependants) ; | |
1616 | DeclareTypesConstantsProceduresInRange(quad, quad) ; | |
1617 | Assert(IsConstructorDependants(sym, IsFullyDeclared)) ; | |
1618 | PushValue(sym) ; | |
1619 | DeclareConstantFromTree(sym, PopConstructorTree(tokenno)) | |
1620 | END | |
1621 | END DeclareConstructor ; | |
1622 | ||
1623 | ||
1624 | (* | |
1625 | TryDeclareConstructor - try and declare a constructor. If, sym, is a | |
1626 | constructor try and declare it, if we cannot | |
1627 | then enter it into the to do list. | |
1628 | *) | |
1629 | ||
1630 | PROCEDURE TryDeclareConstructor (tokenno: CARDINAL; sym: CARDINAL) ; | |
1631 | BEGIN | |
1632 | IF sym#NulSym | |
1633 | THEN | |
1634 | IF IsConstructor(sym) AND (NOT GccKnowsAbout(sym)) | |
1635 | THEN | |
1636 | WalkConstructor(sym, TraverseDependants) ; | |
1637 | IF NOT IsElementInSet(ToBeSolvedByQuads, sym) | |
1638 | THEN | |
1639 | TryEvaluateValue(sym) ; | |
1640 | IF IsConstructorDependants(sym, IsFullyDeclared) | |
1641 | THEN | |
1642 | PushValue(sym) ; | |
1643 | DeclareConstantFromTree(sym, PopConstructorTree(tokenno)) | |
1644 | END | |
1645 | END | |
1646 | END | |
1647 | END | |
1648 | END TryDeclareConstructor ; | |
1649 | ||
1650 | ||
1651 | (* | |
1652 | WalkConst - walks all dependants of, sym. | |
1653 | *) | |
1654 | ||
1655 | PROCEDURE WalkConst (sym: CARDINAL; p: WalkAction) ; | |
1656 | VAR | |
1657 | type: CARDINAL ; | |
1658 | BEGIN | |
1659 | Assert (IsConst (sym)) ; | |
1660 | type := GetSType (sym) ; | |
1661 | IF type # NulSym | |
1662 | THEN | |
1663 | p (type) | |
1664 | END ; | |
1665 | IF IsConstSet (sym) OR IsConstructor (sym) | |
1666 | THEN | |
1667 | WalkConstructor (sym, p) | |
1668 | END | |
1669 | END WalkConst ; | |
1670 | ||
1671 | ||
1672 | (* | |
1673 | IsConstDependants - returns TRUE if the symbol, sym, | |
1674 | q(dependants) all return TRUE. | |
1675 | *) | |
1676 | ||
1677 | PROCEDURE IsConstDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
1678 | VAR | |
1679 | type: CARDINAL ; | |
1680 | BEGIN | |
1681 | Assert (IsConst (sym)) ; | |
1682 | type := GetSType (sym) ; | |
1683 | IF type # NulSym | |
1684 | THEN | |
1685 | IF NOT q (type) | |
1686 | THEN | |
1687 | RETURN FALSE | |
1688 | END | |
1689 | END ; | |
1690 | IF IsConstSet (sym) OR IsConstructor (sym) | |
1691 | THEN | |
1692 | RETURN IsConstructorDependants (sym, q) | |
1693 | END ; | |
1694 | RETURN IsValueSolved (sym) | |
1695 | END IsConstDependants ; | |
1696 | ||
1697 | ||
1698 | (* | |
1699 | TryDeclareConstant - try and declare a constant. If, sym, is a | |
1700 | constant try and declare it, if we cannot | |
1701 | then enter it into the to do list. | |
1702 | *) | |
1703 | ||
1704 | PROCEDURE TryDeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ; | |
1705 | VAR | |
1706 | type: CARDINAL ; | |
1707 | BEGIN | |
1708 | TryDeclareConstructor(tokenno, sym) ; | |
1709 | IF IsConst(sym) | |
1710 | THEN | |
1711 | TraverseDependants(sym) ; | |
1712 | type := GetSType(sym) ; | |
1713 | IF (type#NulSym) AND (NOT CompletelyResolved(type)) | |
1714 | THEN | |
1715 | TraverseDependants(sym) ; | |
1716 | (* | |
1717 | WatchIncludeList(sym, todolist) ; | |
1718 | WatchIncludeList(type, todolist) ; | |
1719 | *) | |
1720 | RETURN | |
1721 | END ; | |
1722 | IF IsConstructor(sym) AND (NOT IsConstructorConstant(sym)) | |
1723 | THEN | |
1724 | TraverseDependants(sym) ; | |
1725 | (* | |
1726 | WatchIncludeList(sym, todolist) ; | |
1727 | *) | |
1728 | RETURN | |
1729 | END ; | |
1730 | IF (IsConstructor(sym) OR IsConstSet(sym)) AND (type=NulSym) | |
1731 | THEN | |
1732 | (* | |
1733 | WatchIncludeList(sym, todolist) ; | |
1734 | *) | |
1735 | TraverseDependants(sym) ; | |
1736 | RETURN | |
1737 | END ; | |
1738 | IF IsElementInSet(ToBeSolvedByQuads, sym) | |
1739 | THEN | |
1740 | (* we allow the above rules to be executed even if it is fully declared | |
1741 | so to ensure that types of compiler builtin constants (BitsetSize | |
1742 | etc) are fully declared. | |
1743 | ||
1744 | However at this point if, sym, is fully declared we return | |
1745 | *) | |
1746 | IF IsFullyDeclared(sym) | |
1747 | THEN | |
1748 | RETURN | |
1749 | END ; | |
1750 | TraverseDependants(sym) ; | |
1751 | (* | |
1752 | WatchIncludeList(sym, todolist) | |
1753 | *) | |
1754 | ELSE | |
1755 | TryDeclareConst(tokenno, sym) | |
1756 | END | |
1757 | END | |
1758 | END TryDeclareConstant ; | |
1759 | ||
1760 | ||
1761 | (* | |
1762 | DeclareConstant - checks to see whether, sym, is a constant and | |
1763 | declares the constant to gcc. | |
1764 | *) | |
1765 | ||
1766 | PROCEDURE DeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ; | |
1767 | VAR | |
1768 | type: CARDINAL ; | |
1769 | t : Tree ; | |
1770 | BEGIN | |
1771 | IF IsConst(sym) | |
1772 | THEN | |
1773 | TraverseDependants(sym) ; | |
1774 | type := GetSType(sym) ; | |
1775 | Assert((type=NulSym) OR CompletelyResolved(type)) ; | |
1776 | Assert((NOT IsConstructor(sym)) OR IsConstructorConstant(sym)) ; | |
1777 | Assert((type#NulSym) OR (NOT (IsConstructor(sym) OR IsConstSet(sym)))) ; | |
1778 | t := DeclareConst(tokenno, sym) ; | |
1779 | Assert(t#NIL) | |
1780 | END | |
1781 | END DeclareConstant ; | |
1782 | ||
1783 | ||
1784 | (* | |
1785 | TryDeclareConst - try to declare a const to gcc. If it cannot | |
1786 | declare the symbol it places it into the | |
1787 | todolist. | |
1788 | *) | |
1789 | ||
1790 | PROCEDURE TryDeclareConst (tokenno: CARDINAL; sym: CARDINAL) ; | |
1791 | VAR | |
1792 | type, | |
1793 | size: CARDINAL ; | |
1794 | BEGIN | |
1795 | IF NOT GccKnowsAbout(sym) | |
1796 | THEN | |
1797 | IF IsConstructor(sym) OR IsConstSet(sym) | |
1798 | THEN | |
1799 | WalkConstructorDependants(sym, TraverseDependants) ; | |
1800 | TryEvaluateValue(sym) ; | |
1801 | IF NOT IsConstructorDependants(sym, IsFullyDeclared) | |
1802 | THEN | |
1803 | (* | |
1804 | WatchIncludeList(sym, todolist) ; | |
1805 | *) | |
1806 | TraverseDependants(sym) ; | |
1807 | RETURN | |
1808 | END ; | |
1809 | IF NOT IsConstructorConstant(sym) | |
1810 | THEN | |
1811 | RETURN | |
1812 | END | |
1813 | END ; | |
1814 | IF IsConstString(sym) | |
1815 | THEN | |
1816 | size := GetStringLength(sym) ; | |
1817 | IF size=1 | |
1818 | THEN | |
1819 | DeclareCharConstant(sym) | |
1820 | ELSE | |
1821 | DeclareStringConstant (sym) | |
1822 | END | |
1823 | ELSIF IsValueSolved(sym) | |
1824 | THEN | |
1825 | PushValue(sym) ; | |
1826 | IF IsConstSet(sym) | |
1827 | THEN | |
1828 | DeclareConstantFromTree(sym, PopSetTree(tokenno)) | |
1829 | ELSIF IsConstructor(sym) | |
1830 | THEN | |
1831 | DeclareConstantFromTree(sym, PopConstructorTree(tokenno)) | |
1832 | ELSIF IsRealType(GetDType(sym)) | |
1833 | THEN | |
1834 | type := GetDType(sym) ; | |
1835 | DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopRealTree(), TRUE)) | |
1836 | ELSIF IsComplexType(GetDType(sym)) | |
1837 | THEN | |
1838 | type := GetDType(sym) ; | |
1839 | DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopComplexTree(), TRUE)) | |
1840 | ELSE | |
1841 | IF GetSType(sym)=NulSym | |
1842 | THEN | |
1843 | type := ZType | |
1844 | ELSE | |
1845 | type := GetDType(sym) | |
1846 | END ; | |
1847 | DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopIntegerTree(), TRUE)) | |
1848 | END | |
1849 | ELSE | |
1850 | TraverseDependants(sym) | |
1851 | END | |
1852 | END | |
1853 | END TryDeclareConst ; | |
1854 | ||
1855 | ||
1856 | (* | |
1857 | DeclareConst - declares a const to gcc and returns a Tree. | |
1858 | *) | |
1859 | ||
1860 | PROCEDURE DeclareConst (tokenno: CARDINAL; sym: CARDINAL) : Tree ; | |
1861 | VAR | |
1862 | type: CARDINAL ; | |
1863 | size: CARDINAL ; | |
1864 | BEGIN | |
1865 | IF GccKnowsAbout(sym) | |
1866 | THEN | |
1867 | RETURN( Mod2Gcc(sym) ) | |
1868 | END ; | |
1869 | IF IsConstructor(sym) OR IsConstSet(sym) | |
1870 | THEN | |
1871 | EvaluateValue(sym) | |
1872 | END ; | |
1873 | IF IsConstString(sym) | |
1874 | THEN | |
1875 | size := GetStringLength(sym) ; | |
1876 | IF size=1 | |
1877 | THEN | |
1878 | DeclareCharConstant(sym) | |
1879 | ELSE | |
1880 | DeclareStringConstant (sym) | |
1881 | END | |
1882 | ELSIF IsValueSolved(sym) | |
1883 | THEN | |
1884 | PushValue(sym) ; | |
1885 | IF IsConstSet(sym) | |
1886 | THEN | |
1887 | DeclareConstantFromTree(sym, PopSetTree(tokenno)) | |
1888 | ELSIF IsConstructor(sym) | |
1889 | THEN | |
1890 | DeclareConstantFromTree(sym, PopConstructorTree(tokenno)) | |
1891 | ELSIF IsRealType(GetDType(sym)) | |
1892 | THEN | |
1893 | type := GetDType(sym) ; | |
1894 | DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopRealTree(), TRUE)) | |
1895 | ELSIF IsComplexType(GetDType(sym)) | |
1896 | THEN | |
1897 | type := GetDType(sym) ; | |
1898 | DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopComplexTree(), TRUE)) | |
1899 | ELSE | |
1900 | IF GetSType(sym)=NulSym | |
1901 | THEN | |
1902 | type := ZType | |
1903 | ELSE | |
1904 | type := GetDType(sym) | |
1905 | END ; | |
1906 | DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopIntegerTree(), TRUE)) | |
1907 | END | |
1908 | END ; | |
1909 | IF GccKnowsAbout(sym) | |
1910 | THEN | |
1911 | RETURN( Mod2Gcc(sym) ) | |
1912 | ELSE | |
1913 | RETURN( NIL ) | |
1914 | END | |
1915 | END DeclareConst ; | |
1916 | ||
1917 | ||
1918 | (* | |
1919 | DeclareParameters - | |
1920 | *) | |
1921 | ||
1922 | PROCEDURE DeclareParameters (sym: CARDINAL) ; | |
1923 | BEGIN | |
1924 | DeclareUnboundedProcedureParameters(sym) | |
1925 | END DeclareParameters ; | |
1926 | ||
1927 | ||
1928 | VAR | |
1929 | unboundedp: WalkAction ; | |
1930 | ||
1931 | ||
1932 | (* | |
1933 | WalkFamilyOfUnbounded - | |
1934 | *) | |
1935 | ||
1936 | PROCEDURE WalkFamilyOfUnbounded (oaf: CARDINAL <* unused *> ; dim: CARDINAL <* unused *> ; unbounded: CARDINAL) ; | |
1937 | BEGIN | |
1938 | IF unbounded # NulSym | |
1939 | THEN | |
1940 | unboundedp (unbounded) | |
1941 | END | |
1942 | END WalkFamilyOfUnbounded ; | |
1943 | ||
1944 | ||
1945 | (* | |
1946 | WalkAssociatedUnbounded - | |
1947 | *) | |
1948 | ||
1949 | PROCEDURE WalkAssociatedUnbounded (sym: CARDINAL; p: WalkAction) ; | |
1950 | VAR | |
1951 | oaf: CARDINAL ; | |
1952 | o : WalkAction ; | |
1953 | BEGIN | |
1954 | oaf := GetOAFamily(sym) ; | |
1955 | o := unboundedp ; | |
1956 | unboundedp := p ; | |
1957 | ForeachOAFamily (oaf, WalkFamilyOfUnbounded) ; | |
1958 | unboundedp := o | |
1959 | END WalkAssociatedUnbounded ; | |
1960 | ||
1961 | ||
1962 | (* | |
1963 | WalkProcedureParameterDependants - | |
1964 | *) | |
1965 | ||
1966 | (* | |
1967 | PROCEDURE WalkProcedureParameterDependants (sym: CARDINAL; p: WalkAction) ; | |
1968 | VAR | |
1969 | son, | |
1970 | type, | |
1971 | n, i: CARDINAL ; | |
1972 | BEGIN | |
1973 | IF IsProcedure(sym) | |
1974 | THEN | |
1975 | n := NoOfParam(sym) ; | |
1976 | i := n ; | |
1977 | WHILE i>0 DO | |
1978 | IF IsUnboundedParam(sym, i) | |
1979 | THEN | |
1980 | son := GetNthParam(sym, i) | |
1981 | ELSE | |
1982 | son := GetNth(sym, i) ; | |
1983 | END ; | |
1984 | type := GetSType(son) ; | |
1985 | p(type) ; | |
1986 | WalkDependants(type, p) ; | |
1987 | DEC(i) | |
1988 | END | |
1989 | END | |
1990 | END WalkProcedureParameterDependants ; | |
1991 | *) | |
1992 | ||
1993 | ||
1994 | (* | |
1995 | WalkDependants - walks through all dependants of, Sym, | |
1996 | calling, p, for each dependant. | |
1997 | *) | |
1998 | ||
1999 | PROCEDURE WalkDependants (sym: CARDINAL; p: WalkAction) ; | |
2000 | BEGIN | |
2001 | WalkAssociatedUnbounded(sym, p) ; | |
2002 | IF IsComponent(sym) | |
2003 | THEN | |
2004 | WalkComponentDependants(sym, p) | |
2005 | ELSIF IsEnumeration(sym) | |
2006 | THEN | |
2007 | WalkEnumerationDependants(sym, p) | |
2008 | ELSIF IsSubrange(sym) | |
2009 | THEN | |
2010 | WalkSubrangeDependants(sym, p) | |
2011 | ELSIF IsPointer(sym) | |
2012 | THEN | |
2013 | WalkPointerDependants(sym, p) | |
2014 | ELSIF IsRecord(sym) | |
2015 | THEN | |
2016 | WalkRecordDependants(sym, p) | |
2017 | ELSIF IsVarient(sym) | |
2018 | THEN | |
2019 | WalkVarientDependants(sym, p) | |
2020 | ELSIF IsRecordField(sym) | |
2021 | THEN | |
2022 | WalkRecordFieldDependants(sym, p) | |
2023 | ELSIF IsFieldVarient(sym) | |
2024 | THEN | |
2025 | WalkVarientFieldDependants(sym, p) | |
2026 | ELSIF IsArray(sym) | |
2027 | THEN | |
2028 | WalkArrayDependants(sym, p) | |
2029 | ELSIF IsProcType(sym) | |
2030 | THEN | |
2031 | WalkProcTypeDependants(sym, p) | |
2032 | ELSIF IsUnbounded(sym) | |
2033 | THEN | |
2034 | WalkUnboundedDependants(sym, p) | |
2035 | ELSIF IsSet(sym) | |
2036 | THEN | |
2037 | WalkSetDependants(sym, p) | |
2038 | ELSIF IsType(sym) | |
2039 | THEN | |
2040 | WalkTypeDependants(sym, p) | |
2041 | ELSIF IsConst(sym) | |
2042 | THEN | |
2043 | WalkConst(sym, p) | |
2044 | ELSIF IsVar(sym) | |
2045 | THEN | |
2046 | WalkVarDependants(sym, p) | |
2047 | ELSIF IsProcedure(sym) | |
2048 | THEN | |
2049 | WalkProcedureDependants(sym, p) | |
2050 | END | |
2051 | END WalkDependants ; | |
2052 | ||
2053 | ||
2054 | (* | |
2055 | TraverseDependantsInner - | |
2056 | *) | |
2057 | ||
2058 | PROCEDURE TraverseDependantsInner (sym: WORD) ; | |
2059 | BEGIN | |
2060 | IF (NOT IsElementInSet(FullyDeclared, sym)) AND | |
2061 | (NOT IsElementInSet(ToDoList, sym)) | |
2062 | THEN | |
2063 | WatchIncludeList(sym, todolist) | |
2064 | END ; | |
2065 | IF NOT IsElementInSet(VisitedList, sym) | |
2066 | THEN | |
2067 | IncludeElementIntoSet(VisitedList, sym) ; | |
2068 | WalkDependants(sym, TraverseDependantsInner) | |
2069 | END | |
2070 | END TraverseDependantsInner ; | |
2071 | ||
2072 | ||
2073 | (* | |
2074 | TraverseDependants - walks, sym, dependants. But it checks | |
2075 | to see that, sym, is not on the | |
2076 | FullyDeclared and not on the ToDoList. | |
2077 | *) | |
2078 | ||
2079 | PROCEDURE TraverseDependants (sym: WORD) ; | |
2080 | BEGIN | |
2081 | IF VisitedList=NIL | |
2082 | THEN | |
2083 | VisitedList := InitSet(1) ; | |
2084 | TraverseDependantsInner(sym) ; | |
2085 | VisitedList := KillSet(VisitedList) | |
2086 | ELSE | |
2087 | InternalError ('recursive call to TraverseDependants caught') | |
2088 | END | |
2089 | END TraverseDependants ; | |
2090 | ||
2091 | ||
2092 | (* | |
2093 | WalkTypeInfo - walks type, sym, and its dependants. | |
2094 | *) | |
2095 | ||
2096 | PROCEDURE WalkTypeInfo (sym: WORD) ; | |
2097 | BEGIN | |
2098 | IF IsVarient(sym) | |
2099 | THEN | |
2100 | InternalError ('why have we reached here?') | |
2101 | ELSIF IsVar(sym) | |
2102 | THEN | |
2103 | WalkTypeInfo(GetSType(sym)) ; | |
2104 | IF GetVarBackEndType(sym)#NulSym | |
2105 | THEN | |
2106 | WalkTypeInfo(GetVarBackEndType(sym)) | |
2107 | END | |
2108 | ELSIF IsAModula2Type(sym) | |
2109 | THEN | |
2110 | TraverseDependants(sym) | |
2111 | END | |
2112 | END WalkTypeInfo ; | |
2113 | ||
2114 | ||
2115 | (* | |
2116 | DeclareUnboundedProcedureParameters - | |
2117 | *) | |
2118 | ||
2119 | PROCEDURE DeclareUnboundedProcedureParameters (sym: WORD) ; | |
2120 | VAR | |
2121 | son, type, | |
2122 | p, i : CARDINAL ; | |
2123 | location : location_t ; | |
2124 | BEGIN | |
2125 | IF IsProcedure(sym) | |
2126 | THEN | |
2127 | p := NoOfParam(sym) ; | |
2128 | i := p ; | |
2129 | WHILE i>0 DO | |
2130 | IF IsUnboundedParam(sym, i) | |
2131 | THEN | |
2132 | son := GetNthParam(sym, i) ; | |
2133 | type := GetSType(son) ; | |
2134 | TraverseDependants(type) ; | |
2135 | IF GccKnowsAbout(type) | |
2136 | THEN | |
2137 | location := TokenToLocation(GetDeclaredMod(type)) ; | |
2138 | BuildTypeDeclaration(location, Mod2Gcc(type)) | |
2139 | END | |
2140 | ELSE | |
2141 | son := GetNth(sym, i) ; | |
2142 | type := GetSType(son) ; | |
2143 | TraverseDependants(type) | |
2144 | END ; | |
2145 | DEC(i) | |
2146 | END | |
2147 | END | |
2148 | END DeclareUnboundedProcedureParameters ; | |
2149 | ||
2150 | ||
2151 | (* | |
2152 | WalkUnboundedProcedureParameters - | |
2153 | *) | |
2154 | ||
2155 | PROCEDURE WalkUnboundedProcedureParameters (sym: WORD) ; | |
2156 | VAR | |
2157 | son, | |
2158 | type, | |
2159 | p, i: CARDINAL ; | |
2160 | BEGIN | |
2161 | IF IsProcedure(sym) | |
2162 | THEN | |
2163 | p := NoOfParam(sym) ; | |
2164 | i := p ; | |
2165 | WHILE i>0 DO | |
2166 | IF IsUnboundedParam(sym, i) | |
2167 | THEN | |
2168 | son := GetNthParam(sym, i) ; | |
2169 | type := GetSType(son) ; | |
2170 | WalkTypeInfo(type) ; | |
2171 | (* | |
2172 | type := GetUnboundedRecordType(type) ; | |
2173 | Assert(IsRecord(type)) ; | |
2174 | RecordNotPacked(type) (* which is never packed. *) | |
2175 | *) | |
2176 | ELSE | |
2177 | son := GetNth(sym, i) ; | |
2178 | type := GetSType(son) ; | |
2179 | WalkTypeInfo(type) | |
2180 | END ; | |
2181 | DEC(i) | |
2182 | END | |
2183 | END | |
2184 | END WalkUnboundedProcedureParameters ; | |
2185 | ||
2186 | ||
2187 | (* | |
2188 | WalkTypesInProcedure - walk all types in procedure, Sym. | |
2189 | *) | |
2190 | ||
2191 | PROCEDURE WalkTypesInProcedure (sym: WORD) ; | |
2192 | BEGIN | |
2193 | ForeachLocalSymDo(sym, TraverseDependants) | |
2194 | END WalkTypesInProcedure ; | |
2195 | ||
2196 | ||
2197 | (* | |
2198 | WalkTypesInModule - declare all types in module, Sym, to GCC. | |
2199 | *) | |
2200 | ||
2201 | PROCEDURE WalkTypesInModule (sym: WORD) ; | |
2202 | VAR | |
2203 | n: Name ; | |
2204 | BEGIN | |
2205 | IF Debugging | |
2206 | THEN | |
2207 | n := GetSymName(sym) ; | |
2208 | printf1('Declaring types in MODULE %a\n', n) | |
2209 | END ; | |
2210 | ForeachLocalSymDo(sym, WalkTypeInfo) ; | |
2211 | ForeachLocalSymDo(sym, WalkUnboundedProcedureParameters) ; | |
2212 | ForeachInnerModuleDo(sym, WalkTypesInModule) | |
2213 | END WalkTypesInModule ; | |
2214 | ||
2215 | ||
2216 | (* | |
2217 | IsRecordFieldDependants - returns TRUE if the record field | |
2218 | symbol, sym, p(dependants) all return TRUE. | |
2219 | *) | |
2220 | ||
2221 | PROCEDURE IsRecordFieldDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
2222 | VAR | |
2223 | align: CARDINAL ; | |
2224 | final: BOOLEAN ; | |
2225 | BEGIN | |
2226 | final := TRUE ; | |
2227 | IF NOT q(GetSType(sym)) | |
2228 | THEN | |
2229 | final := FALSE | |
2230 | END ; | |
2231 | align := GetAlignment(sym) ; | |
2232 | IF (align#NulSym) AND (NOT q(align)) | |
2233 | THEN | |
2234 | final := FALSE | |
2235 | END ; | |
2236 | RETURN( final ) | |
2237 | END IsRecordFieldDependants ; | |
2238 | ||
2239 | ||
2240 | (* | |
2241 | GetModuleWhereDeclared - returns the module where, Sym, was created. | |
2242 | *) | |
2243 | ||
2244 | PROCEDURE GetModuleWhereDeclared (sym: CARDINAL) : CARDINAL ; | |
2245 | VAR | |
2246 | s: CARDINAL ; | |
2247 | BEGIN | |
2248 | s := GetScope(sym) ; | |
2249 | IF (s=NulSym) OR IsDefImp(s) OR | |
2250 | (IsModule(s) AND (GetScope(s)=NulSym)) | |
2251 | THEN | |
2252 | RETURN( s ) | |
2253 | ELSE | |
2254 | RETURN( GetModuleWhereDeclared(s) ) | |
2255 | END | |
2256 | END GetModuleWhereDeclared ; | |
2257 | ||
2258 | ||
2259 | (* | |
2260 | IsPseudoProcFunc - returns TRUE if Sym is a pseudo function or procedure. | |
2261 | *) | |
2262 | ||
2263 | PROCEDURE IsPseudoProcFunc (Sym: CARDINAL) : BOOLEAN ; | |
2264 | BEGIN | |
2265 | RETURN( | |
2266 | IsPseudoBaseProcedure(Sym) OR IsPseudoBaseFunction(Sym) OR | |
2267 | IsPseudoSystemFunction(Sym) | |
2268 | ) | |
2269 | END IsPseudoProcFunc ; | |
2270 | ||
2271 | ||
2272 | (* | |
2273 | IsProcedureGccNested - returns TRUE if procedure, sym, will be considered | |
2274 | as nested by GCC. | |
2275 | This will occur if either its outer defining scope | |
2276 | is a procedure or is a module which is inside a | |
2277 | procedure. | |
2278 | *) | |
2279 | ||
2280 | PROCEDURE IsProcedureGccNested (sym: CARDINAL) : BOOLEAN ; | |
2281 | BEGIN | |
2282 | RETURN( | |
2283 | IsProcedureNested(sym) OR | |
2284 | (IsModule(GetScope(sym)) AND IsModuleWithinProcedure(GetScope(sym))) | |
2285 | ) | |
2286 | END IsProcedureGccNested ; | |
2287 | ||
2288 | ||
2289 | (* | |
2290 | IsExternal - | |
2291 | *) | |
2292 | ||
2293 | PROCEDURE IsExternal (sym: CARDINAL) : BOOLEAN ; | |
2294 | VAR | |
2295 | mod: CARDINAL ; | |
2296 | BEGIN | |
d423e8dc IS |
2297 | Assert (NOT IsDefImp (sym)) ; |
2298 | IF IsProcedure (sym) AND IsExtern (sym) | |
2299 | THEN | |
2300 | RETURN TRUE | |
2301 | END ; | |
1eee94d3 GM |
2302 | mod := GetScope(sym) ; |
2303 | REPEAT | |
2304 | IF mod=NulSym | |
2305 | THEN | |
2306 | RETURN( FALSE ) | |
2307 | ELSIF IsDefImp(mod) | |
2308 | THEN | |
2309 | RETURN( mod#GetMainModule() ) | |
2310 | END ; | |
2311 | mod := GetScope(mod) | |
2312 | UNTIL mod=NulSym ; | |
2313 | RETURN( FALSE ) | |
2314 | END IsExternal ; | |
2315 | ||
2316 | ||
2317 | (* | |
2318 | IsExternalToWholeProgram - return TRUE if the symbol, sym, is external to the | |
2319 | sources that we have parsed. | |
2320 | *) | |
2321 | ||
2322 | PROCEDURE IsExternalToWholeProgram (sym: CARDINAL) : BOOLEAN ; | |
2323 | VAR | |
2324 | mod: CARDINAL ; | |
2325 | BEGIN | |
2326 | mod := GetScope(sym) ; | |
2327 | REPEAT | |
2328 | IF mod=NulSym | |
2329 | THEN | |
2330 | RETURN( FALSE ) | |
2331 | ELSIF IsDefImp(mod) | |
2332 | THEN | |
2333 | (* return TRUE if we have no source file. *) | |
2334 | RETURN( GetModuleFile(mod)=NIL ) | |
2335 | END ; | |
2336 | mod := GetScope(mod) | |
2337 | UNTIL mod=NulSym ; | |
2338 | RETURN( FALSE ) | |
2339 | END IsExternalToWholeProgram ; | |
2340 | ||
2341 | ||
2342 | (* | |
2343 | DeclareProcedureToGccWholeProgram - | |
2344 | *) | |
2345 | ||
2346 | PROCEDURE DeclareProcedureToGccWholeProgram (Sym: CARDINAL) ; | |
2347 | VAR | |
2348 | GccParam : Tree ; | |
2349 | scope, | |
2350 | Son, | |
2351 | p, i : CARDINAL ; | |
2352 | b, e : CARDINAL ; | |
2353 | begin, end, | |
2354 | location : location_t ; | |
2355 | BEGIN | |
2356 | IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym)) | |
2357 | THEN | |
2358 | BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ; | |
2359 | p := NoOfParam(Sym) ; | |
2360 | i := p ; | |
2361 | WHILE i>0 DO | |
2362 | (* note we dont use GetNthParam as we want the parameter that is seen by the procedure block | |
2363 | remember that this is treated exactly the same as a variable, just its position on | |
2364 | the activation record is special (ie a parameter) | |
2365 | *) | |
2366 | Son := GetNth(Sym, i) ; | |
2367 | location := TokenToLocation(GetDeclaredMod(Son)) ; | |
2368 | IF IsUnboundedParam(Sym, i) | |
2369 | THEN | |
2370 | GccParam := BuildParameterDeclaration(location, | |
2371 | KeyToCharStar(GetSymName(Son)), | |
2372 | Mod2Gcc(GetLType(Son)), | |
2373 | FALSE) | |
2374 | ELSE | |
2375 | GccParam := BuildParameterDeclaration(location, | |
2376 | KeyToCharStar(GetSymName(Son)), | |
2377 | Mod2Gcc(GetLType(Son)), | |
2378 | IsVarParam(Sym, i)) | |
2379 | END ; | |
2380 | PreAddModGcc(Son, GccParam) ; | |
2381 | WatchRemoveList(Son, todolist) ; | |
2382 | WatchIncludeList(Son, fullydeclared) ; | |
2383 | DEC(i) | |
2384 | END ; | |
2385 | GetProcedureBeginEnd(Sym, b, e) ; | |
2386 | begin := TokenToLocation(b) ; | |
2387 | end := TokenToLocation(e) ; | |
2388 | scope := GetScope(Sym) ; | |
2389 | PushBinding(scope) ; | |
2390 | IF GetSType(Sym)=NulSym | |
2391 | THEN | |
2392 | PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end, | |
2393 | KeyToCharStar(GetFullSymName(Sym)), | |
2394 | NIL, | |
2395 | IsExternalToWholeProgram(Sym), | |
2396 | IsProcedureGccNested(Sym), | |
2397 | IsExported(GetModuleWhereDeclared(Sym), Sym))) | |
2398 | ELSE | |
2399 | PreAddModGcc(Sym, BuildEndFunctionDeclaration(begin, end, | |
2400 | KeyToCharStar(GetFullSymName(Sym)), | |
2401 | Mod2Gcc(GetSType(Sym)), | |
2402 | IsExternalToWholeProgram(Sym), | |
2403 | IsProcedureGccNested(Sym), | |
2404 | IsExported(GetModuleWhereDeclared(Sym), Sym))) | |
2405 | END ; | |
2406 | PopBinding(scope) ; | |
2407 | WatchRemoveList(Sym, todolist) ; | |
2408 | WatchIncludeList(Sym, fullydeclared) | |
2409 | END | |
2410 | END DeclareProcedureToGccWholeProgram ; | |
2411 | ||
2412 | ||
2413 | (* | |
2414 | DeclareProcedureToGccSeparateProgram - | |
2415 | *) | |
2416 | ||
2417 | PROCEDURE DeclareProcedureToGccSeparateProgram (Sym: CARDINAL) ; | |
2418 | VAR | |
2419 | returnType, | |
2420 | GccParam : Tree ; | |
2421 | scope, | |
2422 | Son, | |
2423 | p, i : CARDINAL ; | |
2424 | b, e : CARDINAL ; | |
2425 | begin, end, | |
2426 | location : location_t ; | |
2427 | tok : CARDINAL ; | |
2428 | BEGIN | |
2429 | tok := GetDeclaredMod(Sym) ; | |
2430 | IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym)) AND | |
2431 | (IsEffectivelyImported(GetMainModule(), Sym) OR | |
2432 | (GetModuleWhereDeclared (Sym) = GetMainModule()) OR | |
2433 | IsNeededAtRunTime (tok, Sym) OR | |
2434 | IsImported (GetBaseModule (), Sym) OR | |
2435 | IsExported(GetModuleWhereDeclared (Sym), Sym) OR | |
2436 | IsExtern (Sym)) | |
2437 | THEN | |
2438 | BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ; | |
2439 | p := NoOfParam(Sym) ; | |
2440 | i := p ; | |
2441 | WHILE i>0 DO | |
2442 | (* note we dont use GetNthParam as we want the parameter that is seen by | |
2443 | the procedure block remember that this is treated exactly the same as | |
2444 | a variable, just its position on the activation record is special (ie | |
2445 | a parameter). *) | |
2446 | Son := GetNth(Sym, i) ; | |
2447 | location := TokenToLocation(GetDeclaredMod(Son)) ; | |
2448 | IF IsUnboundedParam(Sym, i) | |
2449 | THEN | |
2450 | GccParam := BuildParameterDeclaration(location, | |
2451 | KeyToCharStar(GetSymName(Son)), | |
2452 | Mod2Gcc(GetLType(Son)), | |
2453 | FALSE) | |
2454 | ELSE | |
2455 | GccParam := BuildParameterDeclaration(location, | |
2456 | KeyToCharStar(GetSymName(Son)), | |
2457 | Mod2Gcc(GetLType(Son)), | |
2458 | IsVarParam(Sym, i)) | |
2459 | END ; | |
2460 | PreAddModGcc(Son, GccParam) ; | |
2461 | WatchRemoveList(Son, todolist) ; | |
2462 | WatchIncludeList(Son, fullydeclared) ; | |
2463 | DEC(i) | |
2464 | END ; | |
2465 | GetProcedureBeginEnd(Sym, b, e) ; | |
2466 | begin := TokenToLocation(b) ; | |
2467 | end := TokenToLocation(e) ; | |
2468 | scope := GetScope(Sym) ; | |
2469 | PushBinding(scope) ; | |
2470 | IF GetSType(Sym)=NulSym | |
2471 | THEN | |
2472 | returnType := NIL | |
2473 | ELSE | |
2474 | returnType := Mod2Gcc(GetSType(Sym)) | |
2475 | END ; | |
2476 | PreAddModGcc (Sym, BuildEndFunctionDeclaration (begin, end, | |
2477 | KeyToCharStar (GetFullSymName (Sym)), | |
2478 | returnType, | |
2479 | IsExternal (Sym), (* Extern relative to the main module. *) | |
2480 | IsProcedureGccNested (Sym), | |
2481 | (* Exported from the module where it was declared. *) | |
2482 | IsExported (GetModuleWhereDeclared (Sym), Sym) OR IsExtern (Sym))) ; | |
2483 | PopBinding(scope) ; | |
2484 | WatchRemoveList(Sym, todolist) ; | |
2485 | WatchIncludeList(Sym, fullydeclared) | |
2486 | END | |
2487 | END DeclareProcedureToGccSeparateProgram ; | |
2488 | ||
2489 | ||
2490 | (* | |
2491 | DeclareProcedureToGcc - traverses all parameters and interfaces to gm2gcc. | |
2492 | *) | |
2493 | ||
2494 | PROCEDURE DeclareProcedureToGcc (sym: CARDINAL) ; | |
2495 | BEGIN | |
2496 | IF sym # NulSym | |
2497 | THEN | |
2498 | IF WholeProgram | |
2499 | THEN | |
2500 | DeclareProcedureToGccWholeProgram (sym) | |
2501 | ELSE | |
2502 | DeclareProcedureToGccSeparateProgram (sym) | |
2503 | END | |
2504 | END | |
2505 | END DeclareProcedureToGcc ; | |
2506 | ||
2507 | ||
2508 | (* | |
2509 | DeclareProcedure - declares procedure, sym, or all procedures inside | |
2510 | module sym. | |
2511 | *) | |
2512 | ||
2513 | PROCEDURE DeclareProcedure (sym: WORD) ; | |
2514 | BEGIN | |
2515 | IF IsProcedure(sym) | |
2516 | THEN | |
2517 | DeclareProcedureToGcc(sym) | |
2518 | ELSIF IsModule(sym) OR IsDefImp(sym) | |
2519 | THEN | |
2520 | ForeachProcedureDo(sym, DeclareProcedure) | |
2521 | ELSE | |
2522 | InternalError ('expecting procedure') | |
2523 | END | |
2524 | END DeclareProcedure ; | |
2525 | ||
2526 | ||
2527 | (* | |
2528 | FoldConstants - a wrapper for ResolveConstantExpressions. | |
2529 | *) | |
2530 | ||
2531 | PROCEDURE FoldConstants (start, end: CARDINAL) ; | |
2532 | BEGIN | |
2533 | IF ResolveConstantExpressions(DeclareConstFully, start, end) | |
2534 | THEN | |
2535 | END | |
2536 | END FoldConstants ; | |
2537 | ||
2538 | ||
2539 | (* | |
2540 | DeclareTypesConstantsProceduresInRange - | |
2541 | *) | |
2542 | ||
2543 | PROCEDURE DeclareTypesConstantsProceduresInRange (start, end: CARDINAL) ; | |
2544 | VAR | |
2545 | n, m: CARDINAL ; | |
2546 | BEGIN | |
2547 | IF DisplayQuadruples | |
2548 | THEN | |
2549 | DisplayQuadRange(start, end) | |
2550 | END ; | |
2551 | REPEAT | |
2552 | n := NoOfElementsInSet(ToDoList) ; | |
2553 | WHILE ResolveConstantExpressions(DeclareConstFully, start, end) DO | |
2554 | END ; | |
2555 | (* we need to evaluate some constant expressions to resolve these types *) | |
2556 | IF DeclaredOutstandingTypes (FALSE) | |
2557 | THEN | |
2558 | END ; | |
2559 | m := NoOfElementsInSet(ToDoList) | |
2560 | UNTIL (NOT ResolveConstantExpressions(DeclareConstFully, start, end)) AND | |
2561 | (n=m) | |
2562 | END DeclareTypesConstantsProceduresInRange ; | |
2563 | ||
2564 | ||
2565 | (* | |
2566 | SkipModuleScope - skips all module scopes for, scope. | |
2567 | It returns either NulSym or a procedure sym. | |
2568 | *) | |
2569 | ||
2570 | PROCEDURE SkipModuleScope (scope: CARDINAL) : CARDINAL ; | |
2571 | BEGIN | |
2572 | IF (scope=NulSym) OR IsProcedure(scope) | |
2573 | THEN | |
2574 | RETURN( scope ) | |
2575 | ELSE | |
2576 | RETURN( SkipModuleScope(GetScope(scope)) ) | |
2577 | END | |
2578 | END SkipModuleScope ; | |
2579 | ||
2580 | ||
2581 | (* | |
2582 | PushBinding - | |
2583 | *) | |
2584 | ||
2585 | PROCEDURE PushBinding (scope: CARDINAL) ; | |
2586 | BEGIN | |
2587 | scope := SkipModuleScope(scope) ; | |
2588 | IF scope=NulSym | |
2589 | THEN | |
2590 | pushGlobalScope | |
2591 | ELSE | |
2592 | pushFunctionScope(Mod2Gcc(scope)) | |
2593 | END | |
2594 | END PushBinding ; | |
2595 | ||
2596 | ||
2597 | (* | |
2598 | PopBinding - | |
2599 | *) | |
2600 | ||
2601 | PROCEDURE PopBinding (scope: CARDINAL) ; | |
2602 | BEGIN | |
2603 | scope := SkipModuleScope(scope) ; | |
2604 | IF scope=NulSym | |
2605 | THEN | |
2606 | popGlobalScope | |
2607 | ELSE | |
2608 | Assert(IsProcedure(scope)) ; | |
2609 | finishFunctionDecl(TokenToLocation(GetDeclaredMod(scope)), Mod2Gcc(scope)) ; | |
2610 | Assert (popFunctionScope () # NIL) | |
2611 | END | |
2612 | END PopBinding ; | |
2613 | ||
2614 | ||
2615 | (* | |
2616 | DeclareTypesConstantsProcedures - | |
2617 | *) | |
2618 | ||
2619 | PROCEDURE DeclareTypesConstantsProcedures (scope: CARDINAL) ; | |
2620 | VAR | |
2621 | s, t: CARDINAL ; | |
2622 | sb : ScopeBlock ; | |
2623 | BEGIN | |
2624 | sb := InitScopeBlock(scope) ; | |
2625 | PushBinding(scope) ; | |
2626 | REPEAT | |
2627 | s := NoOfElementsInSet(ToDoList) ; | |
2628 | (* ForeachLocalSymDo(scope, DeclareTypeInfo) ; *) | |
2629 | ForeachScopeBlockDo(sb, DeclareTypesConstantsProceduresInRange) ; | |
2630 | t := NoOfElementsInSet(ToDoList) ; | |
2631 | UNTIL s=t ; | |
2632 | PopBinding(scope) ; | |
2633 | KillScopeBlock(sb) | |
2634 | END DeclareTypesConstantsProcedures ; | |
2635 | ||
2636 | ||
2637 | (* | |
2638 | AssertAllTypesDeclared - asserts that all types for variables are declared in, scope. | |
2639 | *) | |
2640 | ||
2641 | PROCEDURE AssertAllTypesDeclared (scope: CARDINAL) ; | |
2642 | VAR | |
2643 | n, Var: CARDINAL ; | |
2644 | failed: BOOLEAN ; | |
2645 | BEGIN | |
2646 | failed := FALSE ; | |
2647 | n := 1 ; | |
2648 | Var := GetNth(scope, n) ; | |
2649 | WHILE Var#NulSym DO | |
2650 | IF NOT AllDependantsFullyDeclared(GetSType(Var)) | |
2651 | THEN | |
2652 | mystop | |
2653 | END ; | |
2654 | IF NOT AllDependantsFullyDeclared(GetSType(Var)) | |
2655 | THEN | |
2656 | EmitCircularDependancyError(GetSType(Var)) ; | |
2657 | failed := TRUE | |
2658 | END ; | |
2659 | INC(n) ; | |
2660 | Var := GetNth(scope, n) | |
2661 | END ; | |
2662 | IF failed | |
2663 | THEN | |
2664 | FlushErrors | |
2665 | END | |
2666 | END AssertAllTypesDeclared ; | |
2667 | ||
2668 | ||
2669 | (* | |
2670 | DeclareModuleInit - declare all the ctor related functions within | |
2671 | a module. | |
2672 | *) | |
2673 | ||
2674 | PROCEDURE DeclareModuleInit (moduleSym: WORD) ; | |
2675 | VAR | |
2676 | ctor, init, fini, dep: CARDINAL ; | |
2677 | BEGIN | |
2678 | GetModuleCtors (moduleSym, ctor, init, fini, dep) ; | |
2679 | DeclareProcedureToGcc (ctor) ; | |
2680 | DeclareProcedureToGcc (init) ; | |
2681 | DeclareProcedureToGcc (fini) ; | |
2682 | DeclareProcedureToGcc (dep) | |
2683 | END DeclareModuleInit ; | |
2684 | ||
2685 | ||
2686 | (* | |
2687 | StartDeclareProcedureScope - | |
2688 | *) | |
2689 | ||
2690 | PROCEDURE StartDeclareProcedureScope (scope: CARDINAL) ; | |
2691 | BEGIN | |
2692 | WalkTypesInProcedure(scope) ; | |
2693 | DeclareProcedure(scope) ; | |
2694 | ForeachInnerModuleDo(scope, WalkTypesInModule) ; | |
2695 | DeclareTypesConstantsProcedures(scope) ; | |
2696 | ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ; | |
2697 | DeclareLocalVariables(scope) ; | |
2698 | ForeachInnerModuleDo(scope, DeclareModuleVariables) ; | |
2699 | AssertAllTypesDeclared(scope) ; | |
2700 | ForeachProcedureDo(scope, DeclareProcedure) ; | |
2701 | ForeachInnerModuleDo(scope, StartDeclareScope) | |
2702 | END StartDeclareProcedureScope ; | |
2703 | ||
2704 | ||
2705 | (* | |
2706 | StartDeclareModuleScopeSeparate - | |
2707 | *) | |
2708 | ||
2709 | PROCEDURE StartDeclareModuleScopeSeparate (scope: CARDINAL) ; | |
2710 | BEGIN | |
2711 | IF scope=GetMainModule() | |
2712 | THEN | |
2713 | ForeachModuleDo(WalkTypesInModule) ; (* will populate the TYPE and CONST ToDo list *) | |
2714 | DeclareTypesConstantsProcedures(scope) ; (* will resolved TYPEs and CONSTs on the ToDo *) | |
2715 | (* lists. *) | |
2716 | ForeachModuleDo(DeclareProcedure) ; | |
2717 | (* | |
2718 | now that all types have been resolved it is safe to declare | |
2719 | variables | |
2720 | *) | |
2721 | AssertAllTypesDeclared(scope) ; | |
2722 | DeclareGlobalVariables(scope) ; | |
2723 | ForeachImportedDo(scope, DeclareImportedVariables) ; | |
2724 | (* now it is safe to declare all procedures *) | |
2725 | ForeachProcedureDo(scope, DeclareProcedure) ; | |
2726 | ForeachInnerModuleDo(scope, WalkTypesInModule) ; | |
2727 | ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ; | |
2728 | ForeachInnerModuleDo(scope, StartDeclareScope) ; | |
2729 | DeclareModuleInit(scope) | |
2730 | ELSE | |
2731 | DeclareTypesConstantsProcedures(scope) ; | |
2732 | AssertAllTypesDeclared(scope) ; | |
2733 | ForeachProcedureDo(scope, DeclareProcedure) ; | |
2734 | DeclareModuleInit(scope) ; | |
2735 | ForeachInnerModuleDo(scope, StartDeclareScope) | |
2736 | END | |
2737 | END StartDeclareModuleScopeSeparate ; | |
2738 | ||
2739 | ||
2740 | (* | |
2741 | StartDeclareModuleScopeWholeProgram - | |
2742 | *) | |
2743 | ||
2744 | PROCEDURE StartDeclareModuleScopeWholeProgram (scope: CARDINAL) ; | |
2745 | BEGIN | |
2746 | IF IsSourceSeen(scope) | |
2747 | THEN | |
2748 | ForeachModuleDo(WalkTypesInModule) ; (* will populate the TYPE and CONST ToDo list *) | |
2749 | DeclareTypesConstantsProcedures(scope) ; (* will resolved TYPEs and CONSTs on the ToDo *) | |
2750 | (* lists. *) | |
2751 | ForeachModuleDo(DeclareProcedure) ; | |
2752 | ForeachModuleDo(DeclareModuleInit) ; | |
2753 | (* | |
2754 | now that all types have been resolved it is safe to declare | |
2755 | variables | |
2756 | *) | |
2757 | AssertAllTypesDeclared(scope) ; | |
2758 | DeclareGlobalVariablesWholeProgram(scope) ; | |
2759 | ForeachImportedDo(scope, DeclareImportedVariablesWholeProgram) ; | |
2760 | (* now it is safe to declare all procedures *) | |
2761 | ForeachProcedureDo(scope, DeclareProcedure) ; | |
2762 | ForeachInnerModuleDo(scope, WalkTypesInModule) ; | |
2763 | ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ; | |
2764 | ForeachInnerModuleDo(scope, StartDeclareScope) ; | |
2765 | DeclareModuleInit(scope) | |
2766 | ELSE | |
2767 | DeclareTypesConstantsProcedures(scope) ; | |
2768 | AssertAllTypesDeclared(scope) ; | |
2769 | ForeachProcedureDo(scope, DeclareProcedure) ; | |
2770 | DeclareModuleInit(scope) ; | |
2771 | ForeachInnerModuleDo(scope, StartDeclareScope) | |
2772 | END | |
2773 | END StartDeclareModuleScopeWholeProgram ; | |
2774 | ||
2775 | ||
2776 | (* | |
2777 | StartDeclareModuleScope - | |
2778 | *) | |
2779 | ||
2780 | PROCEDURE StartDeclareModuleScope (scope: CARDINAL) ; | |
2781 | BEGIN | |
2782 | IF WholeProgram | |
2783 | THEN | |
2784 | StartDeclareModuleScopeWholeProgram(scope) | |
2785 | ELSE | |
2786 | StartDeclareModuleScopeSeparate(scope) | |
2787 | END | |
2788 | END StartDeclareModuleScope ; | |
2789 | ||
2790 | ||
2791 | (* | |
2792 | StartDeclareScope - declares types, variables associated with this scope. | |
2793 | *) | |
2794 | ||
2795 | PROCEDURE StartDeclareScope (scope: CARDINAL) ; | |
2796 | VAR | |
2797 | n: Name ; | |
2798 | BEGIN | |
2799 | (* AddSymToWatch (1265) ; *) | |
2800 | (* AddSymToWatch (1157) ; *) (* watch goes here *) | |
2801 | (* AddSymToWatch(TryFindSymbol('IOLink', 'DeviceId')) ; *) | |
2802 | (* AddSymToWatch(819) ; *) | |
2803 | (* | |
2804 | AddSymToWatch(2125) ; (* watch goes here *) | |
2805 | DebugSets ; | |
2806 | *) | |
2807 | (* | |
2808 | AddSymToWatch(2125) ; (* watch goes here *) | |
2809 | *) | |
2810 | (* | |
2811 | IncludeElementIntoSet(WatchList, 369) ; | |
2812 | IncludeElementIntoSet(WatchList, 709) ; | |
2813 | *) | |
2814 | (* | |
2815 | IncludeElementIntoSet(WatchList, 1006) ; | |
2816 | *) | |
2817 | (* AddSymToWatch(8) ; *) | |
2818 | (* IncludeElementIntoSet(WatchList, 4188) ; *) | |
2819 | (* AddSymToWatch(1420) ; *) | |
2820 | (* AddSymToWatch(5889) ; *) | |
2821 | (* IncludeElementIntoSet(WatchList, 717) ; *) | |
2822 | (* IncludeElementIntoSet(WatchList, 829) ; *) | |
2823 | (* IncludeElementIntoSet(WatchList, 2714) ; *) | |
2824 | (* IncludeElementIntoSet(WatchList, 23222) ; *) | |
2825 | (* IncludeElementIntoSet(WatchList, 1104) ; *) | |
2826 | (* IncludeElementIntoSet(WatchList, 859) ; *) | |
2827 | (* IncludeElementIntoSet(WatchList, 858) ; *) | |
2828 | ||
2829 | (* IncludeElementIntoSet(WatchList, 720) ; *) | |
2830 | (* IncludeElementIntoSet(WatchList, 706) ; *) | |
2831 | (* IncludeElementIntoSet(WatchList, 1948) ; *) | |
2832 | (* IncludeElementIntoSet(WatchList, 865) ; *) | |
2833 | ||
2834 | IF Debugging | |
2835 | THEN | |
2836 | n := GetSymName (scope) ; | |
2837 | printf1 ('declaring symbols in BLOCK %a\n', n) | |
2838 | END ; | |
2839 | IF IsProcedure (scope) | |
2840 | THEN | |
2841 | StartDeclareProcedureScope (scope) | |
2842 | ELSE | |
2843 | StartDeclareModuleScope (scope) | |
2844 | END ; | |
2845 | IF Debugging | |
2846 | THEN | |
2847 | n := GetSymName (scope) ; | |
2848 | printf1('\nEND declaring symbols in BLOCK %a\n', n) | |
2849 | END | |
2850 | END StartDeclareScope ; | |
2851 | ||
2852 | ||
2853 | (* | |
2854 | EndDeclareScope - | |
2855 | *) | |
2856 | ||
2857 | PROCEDURE EndDeclareScope ; | |
2858 | BEGIN | |
2859 | (* no need to do anything *) | |
2860 | END EndDeclareScope ; | |
2861 | ||
2862 | ||
2863 | (* | |
2864 | PreAddModGcc - adds a relationship between sym and t. | |
2865 | It also determines whether an unbounded | |
2866 | for sym is required and if so this is also | |
2867 | created. | |
2868 | *) | |
2869 | ||
2870 | PROCEDURE PreAddModGcc (sym: CARDINAL; t: Tree) ; | |
2871 | BEGIN | |
2872 | AddModGcc(sym, t) | |
2873 | END PreAddModGcc ; | |
2874 | ||
2875 | ||
2876 | (* | |
2877 | DeclareDefaultType - declares a default type, sym, with, name. | |
2878 | *) | |
2879 | ||
2880 | PROCEDURE DeclareDefaultType (sym: CARDINAL; name: ARRAY OF CHAR; gcctype: Tree) ; | |
2881 | VAR | |
2882 | t : Tree ; | |
2883 | high, low: CARDINAL ; | |
2884 | location : location_t ; | |
2885 | BEGIN | |
2886 | (* DeclareDefaultType will declare a new identifier as a type of, gcctype, if it has not already been | |
2887 | declared by gccgm2.c *) | |
2888 | location := BuiltinsLocation () ; | |
2889 | t := GetDefaultType(location, KeyToCharStar(MakeKey(name)), gcctype) ; | |
2890 | AddModGcc(sym, t) ; | |
2891 | IncludeElementIntoSet(FullyDeclared, sym) ; | |
2892 | WalkAssociatedUnbounded(sym, TraverseDependants) ; | |
2893 | (* | |
2894 | this is very simplistic and assumes that the caller only uses Subranges, Sets and GCC types. | |
2895 | We need to declare any constants with the types so that AllDependantsFullyDeclared works. | |
2896 | *) | |
2897 | IF IsSubrange(sym) | |
2898 | THEN | |
2899 | GetSubrange(sym, high, low) ; | |
2900 | DeclareConstant(GetDeclaredMod(sym), high) ; | |
2901 | DeclareConstant(GetDeclaredMod(sym), low) | |
2902 | ELSIF IsSet(sym) | |
2903 | THEN | |
2904 | IF IsSubrange(GetSType(sym)) | |
2905 | THEN | |
2906 | IF NOT GccKnowsAbout(GetSType(sym)) | |
2907 | THEN | |
2908 | (* only true for internal types of course *) | |
2909 | InternalError ('subrange type within the set type must be declared before the set type') | |
2910 | END ; | |
2911 | GetSubrange(GetSType(sym), high, low) ; | |
2912 | DeclareConstant(GetDeclaredMod(sym), high) ; | |
2913 | DeclareConstant(GetDeclaredMod(sym), low) | |
2914 | ELSIF IsEnumeration(GetSType(sym)) | |
2915 | THEN | |
2916 | IF NOT GccKnowsAbout(GetSType(sym)) | |
2917 | THEN | |
2918 | (* only true for internal types of course *) | |
2919 | InternalError ('enumeration type within the set type must be declared before the set type') | |
2920 | END | |
2921 | END | |
2922 | END | |
2923 | END DeclareDefaultType ; | |
2924 | ||
2925 | ||
2926 | (* | |
2927 | DeclareBoolean - declares the Boolean type together with true and false. | |
2928 | *) | |
2929 | ||
2930 | PROCEDURE DeclareBoolean ; | |
2931 | BEGIN | |
2932 | AddModGcc(Boolean, GetBooleanType()) ; | |
2933 | AddModGcc(True, GetBooleanTrue()) ; | |
2934 | AddModGcc(False, GetBooleanFalse()) ; | |
2935 | IncludeElementIntoSet(FullyDeclared, Boolean) ; | |
2936 | IncludeElementIntoSet(FullyDeclared, True) ; | |
2937 | IncludeElementIntoSet(FullyDeclared, False) ; | |
2938 | WalkAssociatedUnbounded(Boolean, TraverseDependants) | |
2939 | END DeclareBoolean ; | |
2940 | ||
2941 | ||
2942 | (* | |
2943 | DeclareFixedSizedType - declares the GNU Modula-2 fixed types | |
2944 | (if the back end support such a type). | |
2945 | *) | |
2946 | ||
2947 | PROCEDURE DeclareFixedSizedType (name: ARRAY OF CHAR; type: CARDINAL; t: Tree) ; | |
2948 | VAR | |
2949 | location : location_t ; | |
2950 | typetype, | |
2951 | low, high: CARDINAL ; | |
2952 | BEGIN | |
2953 | IF type#NulSym | |
2954 | THEN | |
2955 | IF IsSet(type) AND (NOT GccKnowsAbout(GetSType(type))) | |
2956 | THEN | |
2957 | typetype := GetSType(type) ; | |
2958 | GetSubrange(typetype, high, low) ; | |
2959 | DeclareConstant(GetDeclaredMod(type), high) ; | |
2960 | DeclareConstant(GetDeclaredMod(type), low) ; | |
2961 | location := TokenToLocation(GetDeclaredMod(typetype)) ; | |
2962 | PreAddModGcc(typetype, BuildSubrangeType(location, | |
2963 | KeyToCharStar(GetFullSymName(typetype)), | |
2964 | Mod2Gcc(GetSType(typetype)), | |
2965 | Mod2Gcc(low), Mod2Gcc(high))) ; | |
2966 | IncludeElementIntoSet(FullyDeclared, typetype) ; | |
2967 | WalkAssociatedUnbounded(typetype, TraverseDependants) | |
2968 | END ; | |
2969 | (* gcc back end supports, type *) | |
2970 | DeclareDefaultType(type, name, t) | |
2971 | END | |
2972 | END DeclareFixedSizedType ; | |
2973 | ||
2974 | ||
2975 | (* | |
2976 | DeclareDefaultSimpleTypes - declares the simple types. | |
2977 | *) | |
2978 | ||
2979 | PROCEDURE DeclareDefaultSimpleTypes ; | |
2980 | BEGIN | |
2981 | AddModGcc(ZType, GetM2ZType()) ; | |
2982 | AddModGcc(RType, GetM2RType()) ; | |
2983 | AddModGcc(CType, GetM2CType()) ; | |
2984 | IncludeElementIntoSet(FullyDeclared, ZType) ; | |
2985 | IncludeElementIntoSet(FullyDeclared, RType) ; | |
2986 | IncludeElementIntoSet(FullyDeclared, CType) ; | |
2987 | ||
2988 | DeclareDefaultType(Cardinal , "CARDINAL" , GetM2CardinalType()) ; | |
2989 | DeclareDefaultType(Integer , "INTEGER" , GetM2IntegerType()) ; | |
2990 | DeclareDefaultType(Char , "CHAR" , GetM2CharType()) ; | |
2991 | DeclareDefaultType(Loc , "LOC" , GetISOLocType()) ; | |
2992 | ||
2993 | IF Iso | |
2994 | THEN | |
2995 | DeclareDefaultType(Byte , "BYTE" , GetISOByteType()) ; | |
2996 | DeclareDefaultType(Word , "WORD" , GetISOWordType()) | |
2997 | ELSE | |
2998 | DeclareDefaultType(Byte , "BYTE" , GetByteType()) ; | |
2999 | DeclareDefaultType(Word , "WORD" , GetWordType()) | |
3000 | END ; | |
3001 | ||
3002 | DeclareDefaultType(Proc , "PROC" , GetProcType()) ; | |
3003 | DeclareDefaultType(Address , "ADDRESS" , GetPointerType()) ; | |
3004 | DeclareDefaultType(LongInt , "LONGINT" , GetM2LongIntType()) ; | |
3005 | DeclareDefaultType(LongCard , "LONGCARD" , GetM2LongCardType()) ; | |
3006 | DeclareDefaultType(ShortInt , "SHORTINT" , GetM2ShortIntType()) ; | |
3007 | DeclareDefaultType(ShortCard , "SHORTCARD" , GetM2ShortCardType()) ; | |
3008 | DeclareDefaultType(ShortReal , "SHORTREAL" , GetM2ShortRealType()) ; | |
3009 | DeclareDefaultType(Real , "REAL" , GetM2RealType()) ; | |
3010 | DeclareDefaultType(LongReal , "LONGREAL" , GetM2LongRealType()) ; | |
3011 | DeclareDefaultType(Bitnum , "BITNUM" , GetBitnumType()) ; | |
3012 | DeclareDefaultType(Bitset , "BITSET" , GetBitsetType()) ; | |
3013 | DeclareDefaultType(Complex , "COMPLEX" , GetM2ComplexType()) ; | |
3014 | DeclareDefaultType(LongComplex , "LONGCOMPLEX" , GetM2LongComplexType()) ; | |
3015 | DeclareDefaultType(ShortComplex, "SHORTCOMPLEX", GetM2ShortComplexType()) ; | |
3016 | DeclareDefaultType(CSizeT , "CSIZE_T" , GetCSizeTType()) ; | |
3017 | DeclareDefaultType(CSSizeT , "CSSIZE_T" , GetCSSizeTType()) ; | |
3018 | ||
3019 | DeclareBoolean ; | |
3020 | ||
3021 | DeclareFixedSizedType("INTEGER8" , IntegerN(8) , GetM2Integer8()) ; | |
3022 | DeclareFixedSizedType("INTEGER16" , IntegerN(16) , GetM2Integer16()) ; | |
3023 | DeclareFixedSizedType("INTEGER32" , IntegerN(32) , GetM2Integer32()) ; | |
3024 | DeclareFixedSizedType("INTEGER64" , IntegerN(64) , GetM2Integer64()) ; | |
3025 | DeclareFixedSizedType("CARDINAL8" , CardinalN(8) , GetM2Cardinal8()) ; | |
3026 | DeclareFixedSizedType("CARDINAL16", CardinalN(16), GetM2Cardinal16()) ; | |
3027 | DeclareFixedSizedType("CARDINAL32", CardinalN(32), GetM2Cardinal32()) ; | |
3028 | DeclareFixedSizedType("CARDINAL64", CardinalN(64), GetM2Cardinal64()) ; | |
3029 | DeclareFixedSizedType("WORD16" , WordN(16) , GetM2Word16()) ; | |
3030 | DeclareFixedSizedType("WORD32" , WordN(32) , GetM2Word32()) ; | |
3031 | DeclareFixedSizedType("WORD64" , WordN(64) , GetM2Word64()) ; | |
3032 | DeclareFixedSizedType("BITSET8" , SetN(8) , GetM2Bitset8()) ; | |
3033 | DeclareFixedSizedType("BITSET16" , SetN(16) , GetM2Bitset16()) ; | |
3034 | DeclareFixedSizedType("BITSET32" , SetN(32) , GetM2Bitset32()) ; | |
3035 | DeclareFixedSizedType("REAL32" , RealN(32) , GetM2Real32()) ; | |
3036 | DeclareFixedSizedType("REAL64" , RealN(64) , GetM2Real64()) ; | |
3037 | DeclareFixedSizedType("REAL96" , RealN(96) , GetM2Real96()) ; | |
3038 | DeclareFixedSizedType("REAL128" , RealN(128) , GetM2Real128()) ; | |
3039 | DeclareFixedSizedType("COMPLEX32" , ComplexN(32) , GetM2Complex32()) ; | |
3040 | DeclareFixedSizedType("COMPLEX64" , ComplexN(64) , GetM2Complex64()) ; | |
3041 | DeclareFixedSizedType("COMPLEX96" , ComplexN(96) , GetM2Complex96()) ; | |
3042 | DeclareFixedSizedType("COMPLEX128", ComplexN(128), GetM2Complex128()) | |
3043 | END DeclareDefaultSimpleTypes ; | |
3044 | ||
3045 | ||
3046 | (* | |
3047 | DeclarePackedBoolean - | |
3048 | *) | |
3049 | ||
3050 | PROCEDURE DeclarePackedBoolean ; | |
3051 | VAR | |
3052 | e: CARDINAL ; | |
3053 | BEGIN | |
3054 | e := GetPackedEquivalent(Boolean) ; | |
3055 | AddModGcc(e, GetPackedBooleanType()) ; | |
3056 | IncludeElementIntoSet(FullyDeclared, e) | |
3057 | END DeclarePackedBoolean ; | |
3058 | ||
3059 | ||
3060 | (* | |
3061 | DeclarePackedDefaultSimpleTypes - | |
3062 | *) | |
3063 | ||
3064 | PROCEDURE DeclarePackedDefaultSimpleTypes ; | |
3065 | BEGIN | |
3066 | DeclarePackedBoolean | |
3067 | END DeclarePackedDefaultSimpleTypes ; | |
3068 | ||
3069 | ||
3070 | (* | |
3071 | DeclareDefaultTypes - makes default types known to GCC | |
3072 | *) | |
3073 | ||
3074 | PROCEDURE DeclareDefaultTypes ; | |
3075 | BEGIN | |
3076 | IF NOT HaveInitDefaultTypes | |
3077 | THEN | |
3078 | HaveInitDefaultTypes := TRUE ; | |
3079 | pushGlobalScope ; | |
3080 | DeclareDefaultSimpleTypes ; | |
3081 | DeclarePackedDefaultSimpleTypes ; | |
3082 | popGlobalScope | |
3083 | END | |
3084 | END DeclareDefaultTypes ; | |
3085 | ||
3086 | ||
3087 | (* | |
3088 | DeclareDefaultConstants - make default constants known to GCC | |
3089 | *) | |
3090 | ||
3091 | PROCEDURE DeclareDefaultConstants ; | |
3092 | BEGIN | |
3093 | AddModGcc(Nil, GetPointerZero(BuiltinsLocation ())) ; | |
3094 | IncludeElementIntoSet(FullyDeclared, Nil) | |
3095 | END DeclareDefaultConstants ; | |
3096 | ||
3097 | ||
3098 | (* | |
3099 | FindContext - returns the scope where the symbol | |
3100 | should be created. | |
3101 | ||
3102 | Symbols created in a module will | |
3103 | return the global context tree, but symbols created | |
3104 | in a module which is declared inside | |
3105 | a procedure will return the procedure Tree. | |
3106 | *) | |
3107 | ||
3108 | PROCEDURE FindContext (sym: CARDINAL) : Tree ; | |
3109 | BEGIN | |
3110 | sym := GetProcedureScope(sym) ; | |
3111 | IF sym=NulSym | |
3112 | THEN | |
3113 | RETURN( GetGlobalContext() ) | |
3114 | ELSE | |
3115 | RETURN( Mod2Gcc(sym) ) | |
3116 | END | |
3117 | END FindContext ; | |
3118 | ||
3119 | ||
3120 | (* | |
3121 | IsEffectivelyImported - returns TRUE if symbol, Sym, was | |
3122 | effectively imported into ModSym. | |
3123 | *) | |
3124 | ||
3125 | PROCEDURE IsEffectivelyImported (ModSym, sym: CARDINAL) : BOOLEAN ; | |
3126 | BEGIN | |
3127 | RETURN( | |
3128 | IsImported(ModSym, sym) OR | |
3129 | (IsImported(ModSym, GetModuleWhereDeclared(sym)) AND | |
3130 | IsExported(GetModuleWhereDeclared(sym), sym)) | |
3131 | ) | |
3132 | END IsEffectivelyImported ; | |
3133 | ||
3134 | ||
3135 | (* | |
3136 | FindOuterModule - returns the out most module where, sym, | |
3137 | was declared. It returns NulSym if the | |
3138 | symbol or the module was declared inside | |
3139 | a procedure. | |
3140 | *) | |
3141 | ||
3142 | PROCEDURE FindOuterModule (sym: CARDINAL) : CARDINAL ; | |
3143 | BEGIN | |
3144 | sym := GetScope(sym) ; | |
3145 | WHILE (NOT IsDefImp(sym)) DO | |
3146 | IF IsModule(sym) | |
3147 | THEN | |
3148 | IF GetScope(sym)=NulSym | |
3149 | THEN | |
3150 | RETURN( sym ) | |
3151 | ELSE | |
3152 | sym := GetScope(sym) | |
3153 | END | |
3154 | ELSIF IsProcedure(sym) | |
3155 | THEN | |
3156 | sym := GetScope(sym) | |
3157 | END | |
3158 | END ; | |
3159 | RETURN( sym ) | |
3160 | END FindOuterModule ; | |
3161 | ||
3162 | ||
3163 | (* | |
3164 | DoVariableDeclaration - | |
3165 | *) | |
3166 | ||
3167 | PROCEDURE DoVariableDeclaration (var, module: CARDINAL; name: ADDRESS; | |
3168 | isImported, isExported, | |
3169 | isTemporary, isGlobal: BOOLEAN; | |
3170 | scope: Tree) ; | |
3171 | VAR | |
3172 | type, initial: Tree ; | |
3173 | varType : CARDINAL ; | |
3174 | location : location_t ; | |
3175 | BEGIN | |
3176 | IF IsComponent (var) | |
3177 | THEN | |
3178 | RETURN | |
3179 | END ; | |
3180 | IF GetMode (var) = LeftValue | |
3181 | THEN | |
3182 | (* | |
3183 | There are two issues to deal with: | |
3184 | ||
3185 | (i) LeftValue is really a pointer to GetSType(Son), which is built | |
3186 | here. | |
3187 | (ii) Front end might have specified the back end use a particular | |
3188 | data type, in which case we use the specified type. | |
3189 | We do not add an extra pointer if this is the case. | |
3190 | *) | |
3191 | varType := SkipType (GetVarBackEndType (var)) ; | |
3192 | IF varType=NulSym | |
3193 | THEN | |
3194 | (* we have not explicity told back end the type, so build it *) | |
3195 | varType := GetSType (var) ; | |
3196 | IF IsVariableAtAddress (var) | |
3197 | THEN | |
3198 | type := BuildConstPointerType (Mod2Gcc (varType)) | |
3199 | ELSE | |
3200 | type := BuildPointerType (Mod2Gcc (varType)) | |
3201 | END | |
3202 | ELSE | |
3203 | type := Mod2Gcc (varType) | |
3204 | END ; | |
3205 | Assert (AllDependantsFullyDeclared (varType)) | |
3206 | ELSE | |
3207 | type := Mod2Gcc (GetDType (var)) | |
3208 | END ; | |
3209 | location := TokenToLocation (GetDeclaredMod (var)) ; | |
3210 | (* The M2LINK module global variables are a special case and have initializers. *) | |
3211 | initial := DetectM2LinkInitial (location, var, module) ; | |
3212 | PreAddModGcc (var, DeclareKnownVariable (location, | |
3213 | name, type, | |
3214 | isExported, isImported, isTemporary, | |
3215 | isGlobal, scope, initial)) ; | |
3216 | IF initial # NIL | |
3217 | THEN | |
3218 | (* Remember special case has been created. *) | |
3219 | AddEntryM2Link (var, module, Mod2Gcc (var)) | |
3220 | END ; | |
3221 | WatchRemoveList (var, todolist) ; | |
3222 | WatchIncludeList (var, fullydeclared) | |
3223 | END DoVariableDeclaration ; | |
3224 | ||
3225 | ||
3226 | (* | |
3227 | AddEntryM2Link - remember module_var has been created. | |
3228 | *) | |
3229 | ||
3230 | PROCEDURE AddEntryM2Link (var, module: CARDINAL; gcc: Tree) ; | |
3231 | VAR | |
3232 | entry: M2LinkEntry ; | |
3233 | BEGIN | |
3234 | IF M2LinkIndex = NIL | |
3235 | THEN | |
3236 | M2LinkIndex := InitIndex (1) | |
3237 | END ; | |
3238 | NEW (entry) ; | |
3239 | entry^.var := var ; | |
3240 | entry^.gcc := gcc ; | |
3241 | entry^.varname := GetSymName (var) ; | |
3242 | entry^.modname := GetSymName (module) ; | |
3243 | IncludeIndiceIntoIndex (M2LinkIndex, entry) | |
3244 | END AddEntryM2Link ; | |
3245 | ||
3246 | ||
3247 | (* | |
3248 | GetEntryM2Link - return the gcc tree matching varname modname. | |
3249 | *) | |
3250 | ||
3251 | PROCEDURE GetEntryM2Link (varname, modname: Name) : Tree ; | |
3252 | VAR | |
3253 | entry : M2LinkEntry ; | |
3254 | high, i: CARDINAL ; | |
3255 | BEGIN | |
3256 | IF M2LinkIndex # NIL | |
3257 | THEN | |
3258 | i := 1 ; | |
3259 | high := HighIndice (M2LinkIndex) ; | |
3260 | WHILE i <= high DO | |
3261 | entry := GetIndice (M2LinkIndex, i) ; | |
3262 | IF (entry^.varname = varname) AND (entry^.modname = modname) | |
3263 | THEN | |
3264 | RETURN entry^.gcc | |
3265 | END ; | |
3266 | INC (i) | |
3267 | END | |
3268 | END ; | |
3269 | RETURN NIL | |
3270 | END GetEntryM2Link ; | |
3271 | ||
3272 | ||
3273 | (* | |
3274 | DeclareM2linkGlobals - will create M2LINK.StaticInitialization | |
3275 | and M2LINK.ForcedModuleInitOrder providing | |
3276 | they have not already been created. | |
3277 | *) | |
3278 | ||
3279 | PROCEDURE DeclareM2linkGlobals (tokenno: CARDINAL) ; | |
3280 | VAR | |
3281 | m2link: Name ; | |
3282 | BEGIN | |
3283 | m2link := MakeKey ('M2LINK') ; | |
3284 | IF GetEntryM2Link (MakeKey ('StaticInitialization'), m2link) = NIL | |
3285 | THEN | |
3286 | Assert (DeclareM2linkStaticInitialization (TokenToLocation (tokenno), | |
3287 | VAL (INTEGER, ScaffoldStatic)) # NIL) | |
3288 | END ; | |
3289 | IF GetEntryM2Link (MakeKey ('ForcedModuleInitOrder'), m2link) = NIL | |
3290 | THEN | |
3291 | Assert (DeclareM2linkForcedModuleInitOrder (TokenToLocation (tokenno), | |
3292 | GetRuntimeModuleOverride ()) # NIL) | |
3293 | END ; | |
3294 | END DeclareM2linkGlobals ; | |
3295 | ||
3296 | ||
3297 | (* | |
3298 | IsGlobal - is the variable not in a procedure scope. | |
3299 | *) | |
3300 | ||
3301 | PROCEDURE IsGlobal (sym: CARDINAL) : BOOLEAN ; | |
3302 | VAR | |
3303 | s: CARDINAL ; | |
3304 | BEGIN | |
3305 | s := GetScope(sym) ; | |
3306 | WHILE (s#NulSym) AND (NOT IsDefImp (s)) AND (NOT IsModule (s)) DO | |
3307 | IF IsProcedure (s) | |
3308 | THEN | |
3309 | RETURN FALSE | |
3310 | END ; | |
3311 | s := GetScope (s) | |
3312 | END ; | |
3313 | RETURN TRUE | |
3314 | END IsGlobal ; | |
3315 | ||
3316 | ||
3317 | (* | |
3318 | DeclareVariable - declares a global variable to GCC. | |
3319 | *) | |
3320 | ||
3321 | PROCEDURE DeclareVariable (ModSym, variable: CARDINAL) ; | |
3322 | VAR | |
3323 | scope: Tree ; | |
3324 | decl : CARDINAL ; | |
3325 | BEGIN | |
3326 | IF NOT GccKnowsAbout (variable) | |
3327 | THEN | |
3328 | scope := FindContext (ModSym) ; | |
3329 | decl := FindOuterModule (variable) ; | |
3330 | Assert (AllDependantsFullyDeclared (GetSType (variable))) ; | |
3331 | PushBinding (ModSym) ; | |
3332 | DoVariableDeclaration (variable, decl, | |
3333 | KeyToCharStar (GetFullSymName (variable)), | |
3334 | (* in Modula-2 we are allowed to import from ourselves, but we do not present this to GCC *) | |
3335 | IsEffectivelyImported(ModSym, variable) AND (GetMainModule () # decl), | |
3336 | IsExported(ModSym, variable), | |
3337 | IsTemporary (variable), | |
3338 | IsGlobal (variable), | |
3339 | scope) ; | |
3340 | PopBinding (ModSym) | |
3341 | END | |
3342 | END DeclareVariable ; | |
3343 | ||
3344 | ||
3345 | (* | |
3346 | DetectM2LinkInitial - | |
3347 | *) | |
3348 | ||
3349 | PROCEDURE DetectM2LinkInitial (location: location_t; variable, decl: CARDINAL) : Tree ; | |
3350 | BEGIN | |
3351 | IF (decl # NulSym) AND WholeProgram AND (GetSymName (decl) = MakeKey ('M2LINK')) | |
3352 | THEN | |
3353 | IF GetSymName (variable) = MakeKey ('StaticInitialization') | |
3354 | THEN | |
3355 | RETURN BuildIntegerConstant (VAL (INTEGER, ScaffoldStatic)) | |
3356 | ELSIF GetSymName (variable) = MakeKey ('ForcedModuleInitOrder') | |
3357 | THEN | |
3358 | RETURN BuildPtrToTypeString (location, | |
3359 | GetRuntimeModuleOverride (), | |
3360 | Mod2Gcc (GetSType (variable))) | |
3361 | END | |
3362 | END ; | |
3363 | RETURN NIL | |
3364 | END DetectM2LinkInitial ; | |
3365 | ||
3366 | ||
3367 | (* | |
3368 | DeclareVariableWholeProgram - declares a global variable to GCC when using -fm2-whole-program. | |
3369 | *) | |
3370 | ||
3371 | PROCEDURE DeclareVariableWholeProgram (mainModule, variable: CARDINAL) ; | |
3372 | VAR | |
3373 | scope: Tree ; | |
3374 | decl : CARDINAL ; | |
3375 | BEGIN | |
3376 | IF NOT GccKnowsAbout (variable) | |
3377 | THEN | |
3378 | scope := FindContext (mainModule) ; | |
3379 | decl := FindOuterModule (variable) ; | |
3380 | Assert (AllDependantsFullyDeclared (GetSType (variable))) ; | |
3381 | PushBinding (mainModule) ; | |
3382 | DoVariableDeclaration (variable, decl, | |
3383 | KeyToCharStar (GetFullSymName (variable)), | |
3384 | (NOT IsSourceSeen (decl)) AND | |
3385 | IsEffectivelyImported (mainModule, variable) AND (GetMainModule () # decl), | |
3386 | IsExported (mainModule, variable), | |
3387 | IsTemporary (variable), | |
3388 | IsGlobal (variable), | |
3389 | scope) ; | |
3390 | PopBinding (mainModule) | |
3391 | END | |
3392 | END DeclareVariableWholeProgram ; | |
3393 | ||
3394 | ||
3395 | (* | |
3396 | DeclareGlobalVariablesWholeProgram - | |
3397 | *) | |
3398 | ||
3399 | PROCEDURE DeclareGlobalVariablesWholeProgram (ModSym: CARDINAL) ; | |
3400 | VAR | |
3401 | n, Son: CARDINAL ; | |
3402 | BEGIN | |
3403 | n := 1 ; | |
3404 | Son := GetNth(ModSym, n) ; | |
3405 | WHILE Son#NulSym DO | |
3406 | DeclareVariableWholeProgram(ModSym, Son) ; | |
3407 | INC(n) ; | |
3408 | Son := GetNth(ModSym, n) | |
3409 | END ; | |
3410 | ForeachInnerModuleDo(ModSym, DeclareGlobalVariablesWholeProgram) | |
3411 | END DeclareGlobalVariablesWholeProgram ; | |
3412 | ||
3413 | ||
3414 | (* | |
3415 | DeclareGlobalVariables - lists the Global variables for | |
3416 | Module ModSym together with their offset. | |
3417 | *) | |
3418 | ||
3419 | PROCEDURE DeclareGlobalVariables (ModSym: CARDINAL) ; | |
3420 | VAR | |
3421 | n, variable: CARDINAL ; | |
3422 | BEGIN | |
3423 | n := 1 ; | |
3424 | variable := GetNth (ModSym, n) ; | |
3425 | WHILE variable # NulSym DO | |
3426 | DeclareVariable (ModSym, variable) ; | |
3427 | INC (n) ; | |
3428 | variable := GetNth (ModSym, n) | |
3429 | END ; | |
3430 | ForeachInnerModuleDo (ModSym, DeclareGlobalVariables) | |
3431 | END DeclareGlobalVariables ; | |
3432 | ||
3433 | ||
3434 | (* | |
3435 | DeclareImportedVariables - declares all imported variables to GM2. | |
3436 | *) | |
3437 | ||
3438 | PROCEDURE DeclareImportedVariables (sym: WORD) ; | |
3439 | BEGIN | |
3440 | IF IsVar (sym) | |
3441 | THEN | |
3442 | DeclareVariable (GetMainModule (), sym) | |
3443 | ELSIF IsDefImp (sym) | |
3444 | THEN | |
3445 | ForeachExportedDo (sym, DeclareImportedVariables) | |
3446 | END | |
3447 | END DeclareImportedVariables ; | |
3448 | ||
3449 | ||
3450 | (* | |
3451 | DeclareImportedVariablesWholeProgram - declares all imported variables. | |
3452 | *) | |
3453 | ||
3454 | PROCEDURE DeclareImportedVariablesWholeProgram (sym: WORD) ; | |
3455 | BEGIN | |
3456 | IF IsVar (sym) | |
3457 | THEN | |
3458 | IF NOT IsSourceSeen (FindOuterModule (sym)) | |
3459 | THEN | |
3460 | (* import is necessary, even for -fm2-whole-program as we | |
3461 | cannot see the source. *) | |
3462 | DeclareVariableWholeProgram (GetMainModule (), sym) | |
3463 | END | |
3464 | ELSIF IsDefImp (sym) | |
3465 | THEN | |
3466 | ForeachExportedDo (sym, DeclareImportedVariablesWholeProgram) | |
3467 | END | |
3468 | END DeclareImportedVariablesWholeProgram ; | |
3469 | ||
3470 | ||
3471 | (* | |
3472 | DeclareLocalVariable - declare a local variable var. | |
3473 | *) | |
3474 | ||
3475 | PROCEDURE DeclareLocalVariable (var: CARDINAL) ; | |
3476 | BEGIN | |
3477 | Assert (AllDependantsFullyDeclared (var)) ; | |
3478 | DoVariableDeclaration (var, NulSym, | |
3479 | KeyToCharStar (GetFullSymName (var)), | |
3480 | FALSE, (* local variables cannot be imported *) | |
3481 | FALSE, (* or exported *) | |
3482 | IsTemporary (var), | |
3483 | FALSE, (* and are not global *) | |
3484 | Mod2Gcc (GetScope (var))) | |
3485 | END DeclareLocalVariable ; | |
3486 | ||
3487 | ||
3488 | (* | |
3489 | DeclareLocalVariables - declares Local variables for procedure. | |
3490 | *) | |
3491 | ||
3492 | PROCEDURE DeclareLocalVariables (procedure: CARDINAL) ; | |
3493 | VAR | |
3494 | i, var: CARDINAL ; | |
3495 | BEGIN | |
3496 | i := NoOfParam (procedure) + 1 ; | |
3497 | var := GetNth (procedure, i) ; | |
3498 | WHILE var # NulSym DO | |
3499 | Assert (procedure = GetScope (var)) ; | |
3500 | DeclareLocalVariable (var) ; | |
3501 | INC (i) ; | |
3502 | var := GetNth (procedure, i) | |
3503 | END | |
3504 | END DeclareLocalVariables ; | |
3505 | ||
3506 | ||
3507 | (* | |
3508 | DeclareModuleVariables - declares Module variables for a module | |
3509 | which was declared inside a procedure. | |
3510 | *) | |
3511 | ||
3512 | PROCEDURE DeclareModuleVariables (sym: CARDINAL) ; | |
3513 | VAR | |
3514 | scope : Tree ; | |
3515 | i, Var: CARDINAL ; | |
3516 | BEGIN | |
3517 | i := 1 ; | |
3518 | scope := Mod2Gcc (GetProcedureScope (sym)) ; | |
3519 | Var := GetNth (sym, i) ; | |
3520 | WHILE Var # NulSym DO | |
3521 | Assert (AllDependantsFullyDeclared (GetSType (Var))) ; | |
3522 | DoVariableDeclaration (Var, NulSym, | |
3523 | KeyToCharStar (GetFullSymName (Var)), | |
3524 | FALSE, (* inner module variables cannot be imported *) | |
3525 | FALSE, (* or exported (as far as GCC is concerned) *) | |
3526 | IsTemporary (Var), | |
3527 | FALSE, (* and are not global *) | |
3528 | scope) ; | |
3529 | INC (i) ; | |
3530 | Var := GetNth (sym, i) | |
3531 | END | |
3532 | END DeclareModuleVariables ; | |
3533 | ||
3534 | ||
3535 | (* | |
3536 | DeclareFieldValue - | |
3537 | *) | |
3538 | ||
3539 | PROCEDURE DeclareFieldValue (sym: CARDINAL; value: Tree; VAR list: Tree) : Tree ; | |
3540 | VAR | |
3541 | location: location_t ; | |
3542 | BEGIN | |
3543 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
3544 | IF (GetModuleWhereDeclared(sym)=NulSym) OR | |
3545 | (GetModuleWhereDeclared(sym)=GetMainModule()) | |
3546 | THEN | |
3547 | RETURN( BuildEnumerator(location, KeyToCharStar(GetSymName(sym)), value, list) ) | |
3548 | ELSE | |
3549 | RETURN( BuildEnumerator(location, KeyToCharStar(GetFullScopeAsmName(sym)), value, list) ) | |
3550 | END | |
3551 | END DeclareFieldValue ; | |
3552 | ||
3553 | ||
3554 | (* | |
3555 | DeclareFieldEnumeration - declares an enumerator within the current enumeration type. | |
3556 | *) | |
3557 | ||
3558 | PROCEDURE DeclareFieldEnumeration (sym: WORD) : Tree ; | |
3559 | VAR | |
3560 | type : CARDINAL ; | |
3561 | field, | |
3562 | enumlist: Tree ; | |
3563 | BEGIN | |
3564 | (* add relationship between gccSym and sym *) | |
3565 | type := GetSType (sym) ; | |
3566 | enumlist := GetEnumList (type) ; | |
3567 | PushValue (sym) ; | |
3568 | field := DeclareFieldValue (sym, PopIntegerTree (), enumlist) ; | |
3569 | PutEnumList (type, enumlist) ; | |
3570 | RETURN field | |
3571 | END DeclareFieldEnumeration ; | |
3572 | ||
3573 | ||
3574 | (* | |
3575 | DeclareEnumeration - declare an enumerated type. | |
3576 | *) | |
3577 | ||
3578 | PROCEDURE DeclareEnumeration (sym: WORD) : Tree ; | |
3579 | VAR | |
3580 | enumlist, | |
3581 | gccenum : Tree ; | |
3582 | location: location_t ; | |
3583 | BEGIN | |
3584 | location := TokenToLocation (GetDeclaredMod (sym)) ; | |
3585 | gccenum := BuildStartEnumeration (location, KeyToCharStar (GetFullSymName (sym)), FALSE) ; | |
3586 | enumlist := GetEnumList (sym) ; | |
3587 | RETURN BuildEndEnumeration (location, gccenum, enumlist) | |
3588 | END DeclareEnumeration ; | |
3589 | ||
3590 | ||
3591 | (* | |
3592 | DeclareSubrange - declare a subrange type. | |
3593 | *) | |
3594 | ||
3595 | PROCEDURE DeclareSubrange (sym: CARDINAL) : Tree ; | |
3596 | VAR | |
3597 | type, | |
3598 | gccsym : Tree ; | |
3599 | high, low: CARDINAL ; | |
3600 | location: location_t ; | |
3601 | BEGIN | |
3602 | location := TokenToLocation (GetDeclaredMod (sym)) ; | |
3603 | GetSubrange (sym, high, low) ; | |
3604 | (* type := BuildSmallestTypeRange (location, Mod2Gcc(low), Mod2Gcc(high)) ; *) | |
3605 | type := Mod2Gcc (GetSType (sym)) ; | |
3606 | gccsym := BuildSubrangeType (location, | |
3607 | KeyToCharStar (GetFullSymName(sym)), | |
3608 | type, Mod2Gcc (low), Mod2Gcc (high)) ; | |
3609 | RETURN gccsym | |
3610 | END DeclareSubrange ; | |
3611 | ||
3612 | ||
3613 | (* | |
3614 | IncludeGetNth - | |
3615 | *) | |
3616 | ||
3617 | PROCEDURE IncludeGetNth (l: List; sym: CARDINAL) ; | |
3618 | VAR | |
3619 | i: CARDINAL ; | |
3620 | BEGIN | |
3621 | printf0(' ListOfSons [') ; | |
3622 | i := 1 ; | |
3623 | WHILE GetNth(sym, i)#NulSym DO | |
3624 | IF i>1 | |
3625 | THEN | |
3626 | printf0(', ') ; | |
3627 | END ; | |
3628 | IncludeItemIntoList(l, GetNth(sym, i)) ; | |
3629 | PrintTerse(GetNth(sym, i)) ; | |
3630 | INC(i) | |
3631 | END ; | |
3632 | printf0(']') | |
3633 | END IncludeGetNth ; | |
3634 | ||
3635 | ||
3636 | (* | |
3637 | IncludeType - | |
3638 | *) | |
3639 | ||
3640 | PROCEDURE IncludeType (l: List; sym: CARDINAL) ; | |
3641 | VAR | |
3642 | t: CARDINAL ; | |
3643 | BEGIN | |
3644 | t := GetSType(sym) ; | |
3645 | IF t#NulSym | |
3646 | THEN | |
3647 | printf0(' type [') ; | |
3648 | PrintTerse(t) ; | |
3649 | IncludeItemIntoList(l, t) ; | |
3650 | printf0(']') ; | |
3651 | t := GetVarBackEndType(sym) ; | |
3652 | IF t#NulSym | |
3653 | THEN | |
3654 | printf0(' gcc type [') ; | |
3655 | PrintTerse(t) ; | |
3656 | IncludeItemIntoList(l, t) ; | |
3657 | printf0(']') | |
3658 | END | |
3659 | END | |
3660 | END IncludeType ; | |
3661 | ||
3662 | ||
3663 | (* | |
3664 | IncludeSubscript - | |
3665 | *) | |
3666 | ||
3667 | PROCEDURE IncludeSubscript (l: List; sym: CARDINAL) ; | |
3668 | VAR | |
3669 | t: CARDINAL ; | |
3670 | BEGIN | |
3671 | t := GetArraySubscript(sym) ; | |
3672 | IF t#NulSym | |
3673 | THEN | |
3674 | printf0(' subrange [') ; | |
3675 | PrintTerse(t) ; | |
3676 | IncludeItemIntoList(l, t) ; | |
3677 | printf0(']') ; | |
3678 | END | |
3679 | END IncludeSubscript ; | |
3680 | ||
3681 | ||
3682 | (* | |
3683 | PrintLocalSymbol - | |
3684 | *) | |
3685 | ||
3686 | PROCEDURE PrintLocalSymbol (sym: CARDINAL) ; | |
3687 | BEGIN | |
3688 | PrintTerse(sym) ; printf0(', ') | |
3689 | END PrintLocalSymbol ; | |
3690 | ||
3691 | ||
3692 | (* | |
3693 | PrintLocalSymbols - | |
3694 | *) | |
3695 | ||
3696 | PROCEDURE PrintLocalSymbols (sym: CARDINAL) ; | |
3697 | BEGIN | |
3698 | printf0('Local Symbols {') ; | |
3699 | ForeachLocalSymDo(sym, PrintLocalSymbol) ; | |
3700 | printf0('}') | |
3701 | END PrintLocalSymbols ; | |
3702 | ||
3703 | ||
3704 | (* | |
3705 | IncludeGetVarient - | |
3706 | *) | |
3707 | ||
3708 | PROCEDURE IncludeGetVarient (l: List; sym: CARDINAL) ; | |
3709 | BEGIN | |
3710 | IF GetVarient(sym)#NulSym | |
3711 | THEN | |
3712 | printf0(' Varient [') ; | |
3713 | PrintTerse(GetVarient(sym)) ; | |
3714 | printf0(']') ; | |
3715 | IncludeItemIntoList(l, GetVarient(sym)) | |
3716 | END | |
3717 | END IncludeGetVarient ; | |
3718 | ||
3719 | ||
3720 | (* | |
3721 | IncludeUnbounded - includes the record component of an unbounded type. | |
3722 | *) | |
3723 | ||
3724 | PROCEDURE IncludeUnbounded (l: List; sym: CARDINAL) ; | |
3725 | BEGIN | |
3726 | IF GetUnboundedRecordType(sym)#NulSym | |
3727 | THEN | |
3728 | IncludeItemIntoList(l, GetUnboundedRecordType(sym)) | |
3729 | END | |
3730 | END IncludeUnbounded ; | |
3731 | ||
3732 | ||
3733 | (* | |
3734 | IncludePartialUnbounded - includes the type component of a partial unbounded symbol. | |
3735 | *) | |
3736 | ||
3737 | PROCEDURE IncludePartialUnbounded (l: List; sym: CARDINAL) ; | |
3738 | BEGIN | |
3739 | IF GetSType(sym)#NulSym | |
3740 | THEN | |
3741 | IncludeItemIntoList(l, GetSType(sym)) | |
3742 | END | |
3743 | END IncludePartialUnbounded ; | |
3744 | ||
3745 | ||
3746 | (* | |
3747 | PrintDeclared - prints out where, sym, was declared. | |
3748 | *) | |
3749 | ||
3750 | PROCEDURE PrintDeclared (sym: CARDINAL) ; | |
3751 | VAR | |
3752 | filename: String ; | |
3753 | lineno, | |
3754 | tokenno : CARDINAL ; | |
3755 | BEGIN | |
3756 | tokenno := GetDeclaredMod(sym) ; | |
3757 | filename := FindFileNameFromToken(tokenno, 0) ; | |
3758 | lineno := TokenToLineNo(tokenno, 0) ; | |
3759 | printf2(" declared in %s:%d", filename, lineno) | |
3760 | END PrintDeclared ; | |
3761 | ||
3762 | ||
3763 | (* | |
3764 | PrintAlignment - | |
3765 | *) | |
3766 | ||
3767 | PROCEDURE PrintAlignment (sym: CARDINAL) ; | |
3768 | VAR | |
3769 | align: CARDINAL ; | |
3770 | BEGIN | |
3771 | IF IsRecord(sym) OR IsType(sym) OR IsRecordField(sym) OR IsPointer(sym) OR IsArray(sym) | |
3772 | THEN | |
3773 | align := GetAlignment(sym) ; | |
3774 | IF align#NulSym | |
3775 | THEN | |
3776 | printf1(" aligned [%d]", align) | |
3777 | END | |
3778 | END | |
3779 | END PrintAlignment ; | |
3780 | ||
3781 | ||
3782 | (* | |
3783 | IncludeGetParent - | |
3784 | *) | |
3785 | ||
3786 | PROCEDURE IncludeGetParent (l: List; sym: CARDINAL) ; | |
3787 | BEGIN | |
3788 | printf0(' Parent [') ; | |
3789 | IncludeItemIntoList(l, GetParent(sym)) ; | |
3790 | PrintTerse(GetParent(sym)) ; | |
3791 | printf0(']') | |
3792 | END IncludeGetParent ; | |
3793 | ||
3794 | ||
3795 | (* | |
3796 | PrintDecl - | |
3797 | *) | |
3798 | ||
3799 | PROCEDURE PrintDecl (sym: CARDINAL) ; | |
3800 | BEGIN | |
3801 | IF IsDeclaredPackedResolved(sym) | |
3802 | THEN | |
3803 | IF IsDeclaredPacked(sym) | |
3804 | THEN | |
3805 | printf0(' packed') | |
3806 | ELSE | |
3807 | printf0(' unpacked') | |
3808 | END | |
3809 | ELSE | |
3810 | printf0(' unknown if packed') | |
3811 | END | |
3812 | END PrintDecl ; | |
3813 | ||
3814 | ||
3815 | (* | |
3816 | PrintScope - displays the scope and line number of declaration of symbol, sym. | |
3817 | *) | |
3818 | ||
3819 | PROCEDURE PrintScope (sym: CARDINAL) ; | |
3820 | VAR | |
3821 | name : Name ; | |
3822 | scope, | |
3823 | line : CARDINAL ; | |
3824 | BEGIN | |
3825 | line := TokenToLineNo (GetDeclaredMod (sym), 0) ; | |
3826 | scope := GetScope (sym) ; | |
3827 | name := GetSymName (scope) ; | |
3828 | printf3 (' scope %a:%d %d', name, line, scope) | |
3829 | END PrintScope ; | |
3830 | ||
3831 | ||
3832 | (* | |
3833 | PrintProcedure - | |
3834 | *) | |
3835 | ||
3836 | PROCEDURE PrintProcedure (sym: CARDINAL) ; | |
3837 | VAR | |
3838 | n: Name ; | |
3839 | BEGIN | |
3840 | n := GetSymName (sym) ; | |
3841 | printf2('sym %d IsProcedure (%a)', sym, n); | |
3842 | IF IsProcedureReachable(sym) | |
3843 | THEN | |
3844 | printf0(' IsProcedureReachable') | |
3845 | END ; | |
3846 | PrintScope (sym) ; | |
3847 | IF IsExtern (sym) | |
3848 | THEN | |
3849 | printf0 (' extern') | |
3850 | END ; | |
3851 | IF IsPublic (sym) | |
3852 | THEN | |
3853 | printf0 (' public') | |
3854 | END ; | |
3855 | IF IsCtor (sym) | |
3856 | THEN | |
3857 | printf0 (' ctor') | |
3858 | END ; | |
3859 | PrintDeclared(sym) | |
3860 | END PrintProcedure ; | |
3861 | ||
3862 | ||
3863 | (* | |
3864 | PrintVerboseFromList - prints the, i, th element in the list, l. | |
3865 | *) | |
3866 | ||
3867 | PROCEDURE PrintVerboseFromList (l: List; i: CARDINAL) ; | |
3868 | VAR | |
3869 | type, | |
3870 | low, | |
3871 | high, | |
3872 | sym : CARDINAL ; | |
3873 | n, n2 : Name ; | |
3874 | BEGIN | |
3875 | sym := GetItemFromList(l, i) ; | |
3876 | n := GetSymName(sym) ; | |
3877 | IF IsError(sym) | |
3878 | THEN | |
3879 | printf2('sym %d IsError (%a)', sym, n) | |
3880 | ELSIF IsDefImp(sym) | |
3881 | THEN | |
3882 | printf2('sym %d IsDefImp (%a)', sym, n) ; | |
3883 | IF IsDefinitionForC(sym) | |
3884 | THEN | |
3885 | printf0('and IsDefinitionForC') | |
3886 | END ; | |
3887 | IF IsHiddenTypeDeclared(sym) | |
3888 | THEN | |
3889 | printf0(' IsHiddenTypeDeclared') | |
3890 | END ; | |
3891 | ForeachProcedureDo (sym, PrintProcedure) | |
3892 | ELSIF IsModule(sym) | |
3893 | THEN | |
3894 | printf2('sym %d IsModule (%a)', sym, n) ; | |
3895 | IF IsModuleWithinProcedure(sym) | |
3896 | THEN | |
3897 | printf0(' and IsModuleWithinProcedure') | |
3898 | END | |
3899 | ELSIF IsInnerModule(sym) | |
3900 | THEN | |
3901 | printf2('sym %d IsInnerModule (%a)', sym, n) | |
3902 | ELSIF IsUnknown(sym) | |
3903 | THEN | |
3904 | printf2('sym %d IsUnknown (%a)', sym, n) | |
3905 | ELSIF IsType(sym) | |
3906 | THEN | |
3907 | printf2('sym %d IsType (%a)', sym, n) ; | |
3908 | IncludeType(l, sym) ; | |
3909 | PrintAlignment(sym) | |
3910 | ELSIF IsProcedure(sym) | |
3911 | THEN | |
3912 | PrintProcedure (sym) | |
3913 | ELSIF IsParameter(sym) | |
3914 | THEN | |
3915 | printf2('sym %d IsParameter (%a)', sym, n) ; | |
3916 | IF GetParameterShadowVar(sym)=NulSym | |
3917 | THEN | |
3918 | printf0(' no shadow local variable') | |
3919 | ELSE | |
3920 | printf0(' shadow ') ; | |
3921 | IncludeType(l, GetParameterShadowVar(sym)) | |
3922 | (* PrintVerboseFromList(l, GetParameterShadowVar(sym)) *) | |
3923 | END ; | |
3924 | IncludeType(l, sym) | |
3925 | ELSIF IsPointer(sym) | |
3926 | THEN | |
3927 | printf2('sym %d IsPointer (%a)', sym, n) ; | |
3928 | IncludeType(l, sym) ; | |
3929 | PrintAlignment(sym) | |
3930 | ELSIF IsRecord(sym) | |
3931 | THEN | |
3932 | printf2('sym %d IsRecord (%a)', sym, n) ; | |
3933 | PrintLocalSymbols(sym) ; | |
3934 | IncludeGetNth(l, sym) ; | |
3935 | PrintAlignment(sym) ; | |
3936 | PrintDecl(sym) | |
3937 | ELSIF IsVarient(sym) | |
3938 | THEN | |
3939 | printf2('sym %d IsVarient (%a)', sym, n) ; | |
3940 | PrintDecl(sym) ; | |
3941 | IncludeGetNth(l, sym) ; | |
3942 | IncludeGetVarient(l, sym) ; | |
3943 | IncludeGetParent(l, sym) | |
3944 | ELSIF IsFieldVarient(sym) | |
3945 | THEN | |
3946 | printf2('sym %d IsFieldVarient (%a)', sym, n) ; | |
3947 | PrintDecl(sym) ; | |
3948 | IncludeGetNth(l, sym) ; | |
3949 | IncludeGetVarient(l, sym) ; | |
3950 | IncludeGetParent(l, sym) | |
3951 | ELSIF IsFieldEnumeration(sym) | |
3952 | THEN | |
3953 | printf2('sym %d IsFieldEnumeration (%a)', sym, n) | |
3954 | ELSIF IsArray(sym) | |
3955 | THEN | |
3956 | printf2('sym %d IsArray (%a)', sym, n) ; | |
3957 | IncludeSubscript(l, sym) ; | |
3958 | IncludeType(l, sym) ; | |
3959 | PrintAlignment(sym) | |
3960 | ELSIF IsEnumeration(sym) | |
3961 | THEN | |
3962 | printf2('sym %d IsEnumeration (%a)', sym, n) | |
3963 | ELSIF IsSet(sym) | |
3964 | THEN | |
3965 | printf2('sym %d IsSet (%a)', sym, n) ; | |
3966 | IncludeType(l, sym) | |
3967 | ELSIF IsUnbounded(sym) | |
3968 | THEN | |
3969 | printf2('sym %d IsUnbounded (%a)', sym, n) ; | |
3970 | IncludeUnbounded(l, sym) | |
3971 | ELSIF IsPartialUnbounded(sym) | |
3972 | THEN | |
3973 | printf2('sym %d IsPartialUnbounded (%a)', sym, n) ; | |
3974 | IncludePartialUnbounded(l, sym) | |
3975 | ELSIF IsRecordField(sym) | |
3976 | THEN | |
3977 | printf2('sym %d IsRecordField (%a)', sym, n) ; | |
3978 | IF IsRecordFieldAVarientTag(sym) | |
3979 | THEN | |
3980 | printf0(' variant tag') | |
3981 | END ; | |
3982 | IncludeType(l, sym) ; | |
3983 | IncludeGetVarient(l, sym) ; | |
3984 | IncludeGetParent(l, sym) ; | |
3985 | PrintAlignment(sym) ; | |
3986 | PrintDecl(sym) | |
3987 | ELSIF IsProcType(sym) | |
3988 | THEN | |
3989 | printf2('sym %d IsProcType (%a)', sym, n) | |
3990 | ELSIF IsVar(sym) | |
3991 | THEN | |
3992 | printf2('sym %d IsVar (%a) declared in ', sym, n) ; | |
3993 | PrintScope (sym) ; | |
3994 | printf0 ('mode ') ; | |
3995 | CASE GetMode(sym) OF | |
3996 | ||
3997 | LeftValue : printf0('l ') | | |
3998 | RightValue : printf0('r ') | | |
3999 | ImmediateValue: printf0('i ') | | |
4000 | NoValue : printf0('n ') | |
4001 | ||
4002 | END ; | |
4003 | IF IsTemporary(sym) | |
4004 | THEN | |
4005 | printf0('temporary ') | |
4006 | END ; | |
4007 | IF IsComponent(sym) | |
4008 | THEN | |
4009 | printf0('component ') | |
4010 | END ; | |
4011 | IncludeType(l, sym) | |
4012 | ELSIF IsConst(sym) | |
4013 | THEN | |
4014 | printf2('sym %d IsConst (%a)', sym, n) ; | |
4015 | IF IsConstString(sym) | |
4016 | THEN | |
4017 | printf1(' also IsConstString (%a)', n) ; | |
4018 | IF IsConstStringM2 (sym) | |
4019 | THEN | |
4020 | printf0(' a Modula-2 string') | |
4021 | ELSIF IsConstStringC (sym) | |
4022 | THEN | |
4023 | printf0(' a C string') | |
4024 | ELSIF IsConstStringM2nul (sym) | |
4025 | THEN | |
4026 | printf0(' a nul terminated Modula-2 string') | |
4027 | ELSIF IsConstStringCnul (sym) | |
4028 | THEN | |
4029 | printf0(' a nul terminated C string') | |
4030 | END | |
4031 | ELSIF IsConstructor(sym) | |
4032 | THEN | |
4033 | printf0(' constant constructor ') ; | |
4034 | IncludeType(l, sym) | |
4035 | ELSIF IsConstSet(sym) | |
4036 | THEN | |
4037 | printf0(' constant constructor set ') ; | |
4038 | IncludeType(l, sym) | |
4039 | ELSE | |
4040 | IncludeType(l, sym) | |
4041 | END | |
4042 | ELSIF IsConstructor(sym) | |
4043 | THEN | |
4044 | printf2('sym %d IsConstructor (non constant) (%a)', sym, n) ; | |
4045 | IncludeType(l, sym) | |
4046 | ELSIF IsConstLit(sym) | |
4047 | THEN | |
4048 | printf2('sym %d IsConstLit (%a)', sym, n) | |
4049 | ELSIF IsDummy(sym) | |
4050 | THEN | |
4051 | printf2('sym %d IsDummy (%a)', sym, n) | |
4052 | ELSIF IsTemporary(sym) | |
4053 | THEN | |
4054 | printf2('sym %d IsTemporary (%a)', sym, n) | |
4055 | ELSIF IsVarAParam(sym) | |
4056 | THEN | |
4057 | printf2('sym %d IsVarAParam (%a)', sym, n) | |
4058 | ELSIF IsSubscript(sym) | |
4059 | THEN | |
4060 | printf2('sym %d IsSubscript (%a)', sym, n) | |
4061 | ELSIF IsSubrange(sym) | |
4062 | THEN | |
4063 | GetSubrange(sym, high, low) ; | |
4064 | printf2('sym %d IsSubrange (%a)', sym, n) ; | |
4065 | IF (low#NulSym) AND (high#NulSym) | |
4066 | THEN | |
4067 | type := GetSType(sym) ; | |
4068 | IF type#NulSym | |
4069 | THEN | |
4070 | IncludeType(l, sym) ; | |
4071 | n := GetSymName(type) ; | |
4072 | printf1(' %a', n) | |
4073 | END ; | |
4074 | n := GetSymName(low) ; | |
4075 | n2 := GetSymName(high) ; | |
4076 | printf2('[%a..%a]', n, n2) | |
4077 | END | |
4078 | ELSIF IsProcedureVariable(sym) | |
4079 | THEN | |
4080 | printf2('sym %d IsProcedureVariable (%a)', sym, n) | |
4081 | ELSIF IsProcedureNested(sym) | |
4082 | THEN | |
4083 | printf2('sym %d IsProcedureNested (%a)', sym, n) | |
4084 | ELSIF IsAModula2Type(sym) | |
4085 | THEN | |
4086 | printf2('sym %d IsAModula2Type (%a)', sym, n) | |
4087 | ELSIF IsObject(sym) | |
4088 | THEN | |
4089 | printf2('sym %d IsObject (%a)', sym, n) | |
4090 | ELSIF IsTuple(sym) | |
4091 | THEN | |
4092 | printf2('sym %d IsTuple (%a)', sym, n) ; | |
4093 | low := GetNth(sym, 1) ; | |
4094 | high := GetNth(sym, 2) ; | |
4095 | printf2('%d, %d\n', low, high) | |
4096 | ELSIF IsGnuAsm(sym) | |
4097 | THEN | |
4098 | IF IsGnuAsmVolatile(sym) | |
4099 | THEN | |
4100 | printf2('sym %d IsGnuAsmVolatile (%a)', sym, n) | |
4101 | ELSE | |
4102 | printf2('sym %d IsGnuAsm (%a)', sym, n) | |
4103 | END | |
4104 | ELSIF IsComponent(sym) | |
4105 | THEN | |
4106 | printf2('sym %d IsComponent (%a) ', sym, n) ; | |
4107 | i := 1 ; | |
4108 | REPEAT | |
4109 | type := GetNth(sym, i) ; | |
4110 | IF type#NulSym | |
4111 | THEN | |
4112 | IncludeItemIntoList(l, type) ; | |
4113 | n := GetSymName(type) ; | |
4114 | printf2("[%a %d] ", n, type) ; | |
4115 | INC(i) | |
4116 | END ; | |
4117 | UNTIL type=NulSym | |
4118 | END ; | |
4119 | ||
4120 | IF IsHiddenType(sym) | |
4121 | THEN | |
4122 | printf0(' IsHiddenType') | |
4123 | END ; | |
4124 | printf0('\n') | |
4125 | END PrintVerboseFromList ; | |
4126 | ||
4127 | ||
4128 | (* | |
4129 | PrintVerbose - prints limited information about a symbol. | |
4130 | *) | |
4131 | ||
4132 | PROCEDURE PrintVerbose (sym: CARDINAL) ; | |
4133 | VAR | |
4134 | l: List ; | |
4135 | i: CARDINAL ; | |
4136 | BEGIN | |
4137 | InitList (l) ; | |
4138 | IncludeItemIntoList (l, sym) ; | |
4139 | i := 1 ; | |
4140 | WHILE i<=NoOfItemsInList (l) DO | |
4141 | PrintVerboseFromList (l, i) ; | |
4142 | INC (i) | |
4143 | END ; | |
4144 | KillList (l) | |
4145 | END PrintVerbose ; | |
4146 | ||
4147 | ||
4148 | (* | |
4149 | PrintSym - prints limited information about a symbol. | |
4150 | This procedure is externally visible. | |
4151 | *) | |
4152 | ||
4153 | PROCEDURE PrintSym (sym: CARDINAL) ; | |
4154 | BEGIN | |
4155 | printf1 ('information about symbol: %d\n', sym) ; | |
4156 | printf0 ('==============================\n') ; | |
4157 | PrintVerbose (sym) | |
4158 | END PrintSym ; | |
4159 | ||
4160 | ||
4161 | (* ******************************** | |
4162 | (* | |
4163 | PrintSymbol - prints limited information about a symbol. | |
4164 | *) | |
4165 | ||
4166 | PROCEDURE PrintSymbol (sym: CARDINAL) ; | |
4167 | BEGIN | |
4168 | PrintTerse(sym) ; | |
4169 | printf0('\n') | |
4170 | END PrintSymbol ; | |
4171 | ******************************************* *) | |
4172 | ||
4173 | (* | |
4174 | PrintTerse - | |
4175 | *) | |
4176 | ||
4177 | PROCEDURE PrintTerse (sym: CARDINAL) ; | |
4178 | VAR | |
4179 | n: Name ; | |
4180 | BEGIN | |
4181 | n := GetSymName(sym) ; | |
4182 | IF IsError(sym) | |
4183 | THEN | |
4184 | printf2('sym %d IsError (%a)', sym, n) | |
4185 | ELSIF IsDefImp(sym) | |
4186 | THEN | |
4187 | printf2('sym %d IsDefImp (%a)', sym, n) ; | |
4188 | IF IsDefinitionForC(sym) | |
4189 | THEN | |
4190 | printf0('and IsDefinitionForC') | |
4191 | END ; | |
4192 | IF IsHiddenTypeDeclared(sym) | |
4193 | THEN | |
4194 | printf0(' IsHiddenTypeDeclared') | |
4195 | END | |
4196 | ELSIF IsModule(sym) | |
4197 | THEN | |
4198 | printf2('sym %d IsModule (%a)', sym, n) ; | |
4199 | IF IsModuleWithinProcedure(sym) | |
4200 | THEN | |
4201 | printf0(' and IsModuleWithinProcedure') | |
4202 | END | |
4203 | ELSIF IsInnerModule(sym) | |
4204 | THEN | |
4205 | printf2('sym %d IsInnerModule (%a)', sym, n) | |
4206 | ELSIF IsUnknown(sym) | |
4207 | THEN | |
4208 | printf2('sym %d IsUnknown (%a)', sym, n) | |
4209 | ELSIF IsType(sym) | |
4210 | THEN | |
4211 | printf2('sym %d IsType (%a)', sym, n) | |
4212 | ELSIF IsProcedure(sym) | |
4213 | THEN | |
4214 | printf2('sym %d IsProcedure (%a)', sym, n); | |
4215 | IF IsProcedureReachable(sym) | |
4216 | THEN | |
4217 | printf0(' and IsProcedureReachable') | |
4218 | END | |
4219 | ELSIF IsParameter(sym) | |
4220 | THEN | |
4221 | printf2('sym %d IsParameter (%a)', sym, n) | |
4222 | ELSIF IsPointer(sym) | |
4223 | THEN | |
4224 | printf2('sym %d IsPointer (%a)', sym, n) | |
4225 | ELSIF IsRecord(sym) | |
4226 | THEN | |
4227 | printf2('sym %d IsRecord (%a)', sym, n) | |
4228 | ELSIF IsVarient(sym) | |
4229 | THEN | |
4230 | printf2('sym %d IsVarient (%a)', sym, n) | |
4231 | ELSIF IsFieldVarient(sym) | |
4232 | THEN | |
4233 | printf2('sym %d IsFieldVarient (%a)', sym, n) | |
4234 | ELSIF IsFieldEnumeration(sym) | |
4235 | THEN | |
4236 | printf2('sym %d IsFieldEnumeration (%a)', sym, n) | |
4237 | ELSIF IsArray(sym) | |
4238 | THEN | |
4239 | printf2('sym %d IsArray (%a)', sym, n) | |
4240 | ELSIF IsEnumeration(sym) | |
4241 | THEN | |
4242 | printf2('sym %d IsEnumeration (%a)', sym, n) | |
4243 | ELSIF IsSet(sym) | |
4244 | THEN | |
4245 | printf2('sym %d IsSet (%a)', sym, n) | |
4246 | ELSIF IsUnbounded(sym) | |
4247 | THEN | |
4248 | printf2('sym %d IsUnbounded (%a)', sym, n) | |
4249 | ELSIF IsRecordField(sym) | |
4250 | THEN | |
4251 | printf2('sym %d IsRecordField (%a)', sym, n) | |
4252 | ELSIF IsProcType(sym) | |
4253 | THEN | |
4254 | printf2('sym %d IsProcType (%a)', sym, n) | |
4255 | ELSIF IsVar(sym) | |
4256 | THEN | |
4257 | printf2('sym %d IsVar (%a)', sym, n) | |
4258 | ELSIF IsConstString(sym) | |
4259 | THEN | |
4260 | printf2('sym %d IsConstString (%a)', sym, n) | |
4261 | ELSIF IsConst(sym) | |
4262 | THEN | |
4263 | printf2('sym %d IsConst (%a)', sym, n) | |
4264 | ELSIF IsConstLit(sym) | |
4265 | THEN | |
4266 | printf2('sym %d IsConstLit (%a)', sym, n) | |
4267 | ELSIF IsDummy(sym) | |
4268 | THEN | |
4269 | printf2('sym %d IsDummy (%a)', sym, n) | |
4270 | ELSIF IsTemporary(sym) | |
4271 | THEN | |
4272 | printf2('sym %d IsTemporary (%a)', sym, n) | |
4273 | ELSIF IsVarAParam(sym) | |
4274 | THEN | |
4275 | printf2('sym %d IsVarAParam (%a)', sym, n) | |
4276 | ELSIF IsSubscript(sym) | |
4277 | THEN | |
4278 | printf2('sym %d IsSubscript (%a)', sym, n) | |
4279 | ELSIF IsSubrange(sym) | |
4280 | THEN | |
4281 | printf2('sym %d IsSubrange (%a)', sym, n) | |
4282 | ELSIF IsProcedureVariable(sym) | |
4283 | THEN | |
4284 | printf2('sym %d IsProcedureVariable (%a)', sym, n) | |
4285 | ELSIF IsProcedureNested(sym) | |
4286 | THEN | |
4287 | printf2('sym %d IsProcedureNested (%a)', sym, n) | |
4288 | ELSIF IsAModula2Type(sym) | |
4289 | THEN | |
4290 | printf2('sym %d IsAModula2Type (%a)', sym, n) | |
4291 | ELSIF IsGnuAsmVolatile(sym) | |
4292 | THEN | |
4293 | printf2('sym %d IsGnuAsmVolatile (%a)', sym, n) | |
4294 | END ; | |
4295 | ||
4296 | IF IsHiddenType(sym) | |
4297 | THEN | |
4298 | printf0(' IsHiddenType') | |
4299 | END | |
4300 | END PrintTerse ; | |
4301 | ||
4302 | ||
4303 | (* | |
4304 | CheckAlignment - | |
4305 | *) | |
4306 | ||
4307 | PROCEDURE CheckAlignment (type: Tree; sym: CARDINAL) : Tree ; | |
4308 | VAR | |
4309 | align: CARDINAL ; | |
4310 | BEGIN | |
4311 | align := GetAlignment(sym) ; | |
4312 | IF align#NulSym | |
4313 | THEN | |
4314 | PushInt(0) ; | |
4315 | PushValue(align) ; | |
4316 | IF NOT Equ(GetDeclaredMod(sym)) | |
4317 | THEN | |
4318 | RETURN( SetAlignment(type, Mod2Gcc(GetAlignment(sym))) ) | |
4319 | END | |
4320 | END ; | |
4321 | RETURN( type ) | |
4322 | END CheckAlignment ; | |
4323 | ||
4324 | ||
4325 | (* | |
4326 | CheckPragma - | |
4327 | *) | |
4328 | ||
4329 | PROCEDURE CheckPragma (type: Tree; sym: CARDINAL) : Tree ; | |
4330 | BEGIN | |
4331 | IF IsDeclaredPacked (sym) | |
4332 | THEN | |
4333 | IF IsRecordField (sym) OR IsFieldVarient (sym) | |
4334 | THEN | |
4335 | type := SetDeclPacked (type) | |
4336 | ELSIF IsRecord (sym) OR IsVarient (sym) | |
4337 | THEN | |
4338 | type := SetTypePacked (type) | |
4339 | END | |
4340 | END ; | |
4341 | RETURN CheckAlignment (type, sym) | |
4342 | END CheckPragma ; | |
4343 | ||
4344 | ||
4345 | (* | |
4346 | IsZero - returns TRUE if symbol, sym, is zero. | |
4347 | *) | |
4348 | ||
4349 | PROCEDURE IsZero (sym: CARDINAL) : BOOLEAN ; | |
4350 | BEGIN | |
4351 | PushIntegerTree(Mod2Gcc(sym)) ; | |
4352 | PushInt(0) ; | |
4353 | RETURN( Equ(GetDeclaredMod(sym)) ) | |
4354 | END IsZero ; | |
4355 | ||
4356 | ||
4357 | (* | |
4358 | SetFieldPacked - sets Varient, VarientField and RecordField symbols | |
4359 | as packed. | |
4360 | *) | |
4361 | ||
4362 | PROCEDURE SetFieldPacked (field: CARDINAL) ; | |
4363 | BEGIN | |
4364 | IF IsVarient(field) OR IsFieldVarient(field) OR IsRecordField(field) | |
4365 | THEN | |
4366 | PutDeclaredPacked(field, TRUE) | |
4367 | END | |
4368 | END SetFieldPacked ; | |
4369 | ||
4370 | ||
4371 | (* | |
4372 | RecordPacked - indicates that record, sym, and its fields | |
4373 | are all packed. | |
4374 | *) | |
4375 | ||
4376 | PROCEDURE RecordPacked (sym: CARDINAL) ; | |
4377 | BEGIN | |
4378 | PutDeclaredPacked(sym, TRUE) ; | |
4379 | WalkRecordDependants(sym, SetFieldPacked) | |
4380 | END RecordPacked ; | |
4381 | ||
4382 | ||
4383 | (* | |
4384 | SetFieldNotPacked - sets Varient, VarientField and RecordField symbols | |
4385 | as not packed. | |
4386 | *) | |
4387 | ||
4388 | PROCEDURE SetFieldNotPacked (field: CARDINAL) ; | |
4389 | BEGIN | |
4390 | IF IsVarient(field) OR IsFieldVarient(field) OR IsRecordField(field) | |
4391 | THEN | |
4392 | PutDeclaredPacked(field, FALSE) | |
4393 | END | |
4394 | END SetFieldNotPacked ; | |
4395 | ||
4396 | ||
4397 | (* | |
4398 | RecordNotPacked - indicates that record, sym, and its fields | |
4399 | are all not packed. | |
4400 | *) | |
4401 | ||
4402 | PROCEDURE RecordNotPacked (sym: CARDINAL) ; | |
4403 | BEGIN | |
4404 | PutDeclaredPacked(sym, FALSE) ; | |
4405 | WalkRecordDependants(sym, SetFieldNotPacked) | |
4406 | END RecordNotPacked ; | |
4407 | ||
4408 | ||
4409 | (* | |
4410 | DetermineIfRecordPacked - | |
4411 | *) | |
4412 | ||
4413 | PROCEDURE DetermineIfRecordPacked (sym: CARDINAL) ; | |
4414 | VAR | |
4415 | defaultAlignment: CARDINAL ; | |
4416 | BEGIN | |
4417 | defaultAlignment := GetDefaultRecordFieldAlignment(sym) ; | |
4418 | IF (defaultAlignment#NulSym) AND IsZero(defaultAlignment) | |
4419 | THEN | |
4420 | RecordPacked(sym) | |
4421 | ELSE | |
4422 | RecordNotPacked(sym) | |
4423 | END | |
4424 | END DetermineIfRecordPacked ; | |
4425 | ||
4426 | ||
4427 | (* | |
4428 | DeclarePackedSubrange - | |
4429 | *) | |
4430 | ||
4431 | PROCEDURE DeclarePackedSubrange (equiv, sym: CARDINAL) ; | |
4432 | VAR | |
4433 | type, | |
4434 | gccsym : Tree ; | |
4435 | high, low: CARDINAL ; | |
4436 | location : location_t ; | |
4437 | BEGIN | |
4438 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
4439 | GetSubrange(sym, high, low) ; | |
4440 | type := BuildSmallestTypeRange(location, Mod2Gcc(low), Mod2Gcc(high)) ; | |
4441 | gccsym := BuildSubrangeType(location, KeyToCharStar(GetFullSymName(sym)), | |
4442 | type, Mod2Gcc(low), Mod2Gcc(high)) ; | |
4443 | AddModGcc(equiv, gccsym) | |
4444 | END DeclarePackedSubrange ; | |
4445 | ||
4446 | ||
4447 | (* | |
4448 | DeclarePackedSet - | |
4449 | *) | |
4450 | ||
4451 | PROCEDURE DeclarePackedSet (equiv, sym: CARDINAL) ; | |
4452 | VAR | |
4453 | highLimit, | |
4454 | range, | |
4455 | gccsym : Tree ; | |
4456 | type, | |
4457 | high, low: CARDINAL ; | |
4458 | location: location_t ; | |
4459 | BEGIN | |
4460 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
4461 | Assert(IsSet(sym)) ; | |
4462 | type := GetDType(sym) ; | |
4463 | low := GetTypeMin(type) ; | |
4464 | high := GetTypeMax(type) ; | |
4465 | highLimit := BuildSub(location, Mod2Gcc(high), Mod2Gcc(low), FALSE) ; | |
4466 | (* --fixme-- we need to check that low <= WORDLENGTH. *) | |
4467 | highLimit := BuildLSL(location, GetIntegerOne(location), highLimit, FALSE) ; | |
4468 | range := BuildSmallestTypeRange(location, GetIntegerZero(location), highLimit) ; | |
4469 | gccsym := BuildSubrangeType(location, KeyToCharStar(GetFullSymName(sym)), | |
4470 | range, GetIntegerZero(location), highLimit) ; | |
4471 | AddModGcc(equiv, gccsym) | |
4472 | END DeclarePackedSet ; | |
4473 | ||
4474 | ||
4475 | (* | |
4476 | DeclareFieldEnumeration - declares an enumerator within the current enumeration type. | |
4477 | *) | |
4478 | ||
4479 | PROCEDURE DeclarePackedFieldEnumeration (sym: WORD) ; | |
4480 | VAR | |
4481 | equiv, | |
4482 | type : CARDINAL ; | |
4483 | field, | |
4484 | enumlist: Tree ; | |
4485 | BEGIN | |
4486 | (* add relationship between gccSym and sym *) | |
4487 | type := GetSType (sym) ; | |
4488 | equiv := GetPackedEquivalent (type) ; | |
4489 | enumlist := GetEnumList (equiv) ; | |
4490 | PushValue (sym) ; | |
4491 | field := DeclareFieldValue (sym, PopIntegerTree(), enumlist) ; | |
4492 | Assert (field # NIL) ; | |
4493 | PutEnumList (equiv, enumlist) | |
4494 | END DeclarePackedFieldEnumeration ; | |
4495 | ||
4496 | ||
4497 | (* | |
4498 | DeclarePackedEnumeration - | |
4499 | *) | |
4500 | ||
4501 | PROCEDURE DeclarePackedEnumeration (equiv, sym: CARDINAL) ; | |
4502 | VAR | |
4503 | enumlist, | |
4504 | gccenum : Tree ; | |
4505 | location: location_t ; | |
4506 | BEGIN | |
4507 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
4508 | gccenum := BuildStartEnumeration(location, KeyToCharStar(GetFullSymName(sym)), TRUE) ; | |
4509 | ForeachLocalSymDo(sym, DeclarePackedFieldEnumeration) ; | |
4510 | enumlist := GetEnumList(equiv) ; | |
4511 | gccenum := BuildEndEnumeration(location, gccenum, enumlist) ; | |
4512 | AddModGcc(equiv, gccenum) | |
4513 | END DeclarePackedEnumeration ; | |
4514 | ||
4515 | ||
4516 | (* | |
4517 | DeclarePackedType - | |
4518 | *) | |
4519 | ||
4520 | PROCEDURE DeclarePackedType (equiv, sym: CARDINAL) ; | |
4521 | VAR | |
4522 | type: CARDINAL ; | |
4523 | BEGIN | |
4524 | type := GetSType(sym) ; | |
4525 | IF type=NulSym | |
4526 | THEN | |
4527 | IF sym=Boolean | |
4528 | THEN | |
4529 | AddModGcc(equiv, GetPackedBooleanType()) | |
4530 | ELSE | |
4531 | AddModGcc(equiv, Mod2Gcc(sym)) | |
4532 | END | |
4533 | ELSE | |
4534 | DeclarePackedType(GetPackedEquivalent(type), type) ; | |
4535 | AddModGcc(equiv, Mod2Gcc(GetPackedEquivalent(type))) | |
4536 | END | |
4537 | END DeclarePackedType ; | |
4538 | ||
4539 | ||
4540 | (* | |
4541 | doDeclareEquivalent - | |
4542 | *) | |
4543 | ||
4544 | PROCEDURE doDeclareEquivalent (sym: CARDINAL; p: doDeclareProcedure) : Tree ; | |
4545 | VAR | |
4546 | equiv: CARDINAL ; | |
4547 | BEGIN | |
4548 | equiv := GetPackedEquivalent(sym) ; | |
4549 | IF NOT GccKnowsAbout(equiv) | |
4550 | THEN | |
4551 | p(equiv, sym) ; | |
4552 | IncludeElementIntoSet(FullyDeclared, equiv) | |
4553 | END ; | |
4554 | RETURN( Mod2Gcc(equiv) ) | |
4555 | END doDeclareEquivalent ; | |
4556 | ||
4557 | ||
4558 | (* | |
4559 | PossiblyPacked - | |
4560 | *) | |
4561 | ||
4562 | PROCEDURE PossiblyPacked (sym: CARDINAL; isPacked: BOOLEAN) : Tree ; | |
4563 | BEGIN | |
4564 | IF isPacked | |
4565 | THEN | |
4566 | IF IsSubrange(sym) | |
4567 | THEN | |
4568 | RETURN( doDeclareEquivalent(sym, DeclarePackedSubrange) ) | |
4569 | ELSIF IsType(sym) | |
4570 | THEN | |
4571 | RETURN( doDeclareEquivalent(sym, DeclarePackedType) ) | |
4572 | ELSIF IsEnumeration(sym) | |
4573 | THEN | |
4574 | RETURN( doDeclareEquivalent(sym, DeclarePackedEnumeration) ) | |
4575 | ELSIF IsSet(sym) | |
4576 | THEN | |
4577 | RETURN( doDeclareEquivalent(sym, DeclarePackedSet) ) | |
4578 | END | |
4579 | END ; | |
4580 | RETURN( Mod2Gcc(sym) ) | |
4581 | END PossiblyPacked ; | |
4582 | ||
4583 | ||
4584 | (* | |
4585 | GetPackedType - returns a possibly packed type for field. | |
4586 | *) | |
4587 | ||
4588 | PROCEDURE GetPackedType (sym: CARDINAL) : Tree ; | |
4589 | BEGIN | |
4590 | IF IsSubrange(sym) | |
4591 | THEN | |
4592 | RETURN( doDeclareEquivalent(sym, DeclarePackedSubrange) ) | |
4593 | ELSIF IsType(sym) | |
4594 | THEN | |
4595 | RETURN( doDeclareEquivalent(sym, DeclarePackedType) ) | |
4596 | ELSIF IsEnumeration(sym) | |
4597 | THEN | |
4598 | RETURN( doDeclareEquivalent(sym, DeclarePackedEnumeration) ) | |
4599 | END ; | |
4600 | RETURN( Mod2Gcc(sym) ) | |
4601 | END GetPackedType ; | |
4602 | ||
4603 | ||
4604 | (* | |
4605 | MaybeAlignField - checks to see whether, field, is packed or aligned and it updates | |
4606 | the offsets if appropriate. | |
4607 | *) | |
4608 | ||
4609 | PROCEDURE MaybeAlignField (field: CARDINAL; VAR byteOffset, bitOffset: Tree) : Tree ; | |
4610 | VAR | |
4611 | f, ftype, | |
4612 | nbits : Tree ; | |
4613 | location: location_t ; | |
4614 | BEGIN | |
4615 | f := Mod2Gcc(field) ; | |
4616 | IF IsDeclaredPacked(field) | |
4617 | THEN | |
4618 | location := TokenToLocation(GetDeclaredMod(field)) ; | |
4619 | f := SetDeclPacked(f) ; | |
4620 | ftype := GetPackedType(GetSType(field)) ; | |
4621 | nbits := BuildTBitSize(location, ftype) ; | |
4622 | f := SetRecordFieldOffset(f, byteOffset, bitOffset, ftype, nbits) ; | |
4623 | bitOffset := BuildAdd(location, bitOffset, nbits, FALSE) ; | |
4624 | RETURN( f ) | |
4625 | ELSE | |
4626 | RETURN( CheckAlignment(f, field) ) | |
4627 | END | |
4628 | END MaybeAlignField ; | |
4629 | ||
4630 | ||
4631 | (* | |
4632 | DeclareRecord - declares a record and its fields to gcc. | |
4633 | The final gcc record type is returned. | |
4634 | *) | |
4635 | ||
4636 | PROCEDURE DeclareRecord (Sym: CARDINAL) : Tree ; | |
4637 | VAR | |
4638 | Field : CARDINAL ; | |
4639 | i : CARDINAL ; | |
4640 | nbits, | |
4641 | ftype, | |
4642 | field, | |
4643 | byteOffset, | |
4644 | bitOffset, | |
4645 | FieldList, | |
4646 | RecordType: Tree ; | |
4647 | location : location_t ; | |
4648 | BEGIN | |
4649 | i := 1 ; | |
4650 | FieldList := Tree(NIL) ; | |
4651 | RecordType := DoStartDeclaration(Sym, BuildStartRecord) ; | |
4652 | location := TokenToLocation(GetDeclaredMod(Sym)) ; | |
4653 | byteOffset := GetIntegerZero(location) ; | |
4654 | bitOffset := GetIntegerZero(location) ; | |
4655 | REPEAT | |
4656 | Field := GetNth(Sym, i) ; | |
4657 | IF Field#NulSym | |
4658 | THEN | |
4659 | IF IsRecordField(Field) AND IsRecordFieldAVarientTag(Field) AND (GetSymName(Field)=NulName) | |
4660 | THEN | |
4661 | (* do not include a nameless tag into the C struct *) | |
4662 | ELSIF IsVarient(Field) | |
4663 | THEN | |
4664 | Field := Chained(Field) ; | |
4665 | field := Mod2Gcc(Field) ; | |
4666 | IF IsDeclaredPacked(Field) | |
4667 | THEN | |
4668 | location := TokenToLocation(GetDeclaredMod(Field)) ; | |
4669 | field := SetDeclPacked(field) ; | |
4670 | ftype := GetPackedType(GetSType(Field)) ; | |
4671 | nbits := BuildTBitSize(location, ftype) ; | |
4672 | field := SetRecordFieldOffset(field, byteOffset, bitOffset, ftype, nbits) ; | |
4673 | bitOffset := BuildAdd(location, bitOffset, nbits, FALSE) ; | |
4674 | byteOffset := BuildAdd(location, byteOffset, | |
4675 | BuildDivTrunc(location, bitOffset, BuildIntegerConstant(8), FALSE), | |
4676 | FALSE) ; | |
4677 | bitOffset := BuildModTrunc(location, bitOffset, BuildIntegerConstant(8), FALSE) | |
4678 | END ; | |
4679 | FieldList := ChainOn(FieldList, field) | |
4680 | ELSE | |
4681 | IF Debugging | |
4682 | THEN | |
4683 | printf0('chaining ') ; PrintTerse(Field) ; printf0('\n') | |
4684 | END ; | |
4685 | FieldList := ChainOn(FieldList, MaybeAlignField(Chained(Field), byteOffset, bitOffset)) | |
4686 | END | |
4687 | END ; | |
4688 | INC(i) | |
4689 | UNTIL Field=NulSym ; | |
4690 | WatchRemoveList(Sym, partiallydeclared) ; | |
4691 | WatchRemoveList(Sym, heldbyalignment) ; | |
4692 | WatchRemoveList(Sym, finishedalignment) ; | |
4693 | location := TokenToLocation(GetDeclaredMod(Sym)) ; | |
4694 | RETURN( BuildEndRecord(location, RecordType, FieldList, IsDeclaredPacked(Sym)) ) | |
4695 | END DeclareRecord ; | |
4696 | ||
4697 | ||
4698 | (* | |
4699 | DeclareRecordField - | |
4700 | *) | |
4701 | ||
4702 | PROCEDURE DeclareRecordField (sym: CARDINAL) : Tree ; | |
4703 | VAR | |
4704 | field, | |
4705 | GccFieldType: Tree ; | |
4706 | location : location_t ; | |
4707 | BEGIN | |
4708 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
4709 | GccFieldType := PossiblyPacked(GetSType(sym), IsDeclaredPacked(sym)) ; | |
4710 | field := BuildFieldRecord(location, KeyToCharStar(GetFullSymName(sym)), GccFieldType) ; | |
4711 | RETURN( field ) | |
4712 | END DeclareRecordField ; | |
4713 | ||
4714 | ||
4715 | (* | |
4716 | DeclareVarient - declares a record and its fields to gcc. | |
4717 | The final gcc record type is returned. | |
4718 | *) | |
4719 | ||
4720 | PROCEDURE DeclareVarient (sym: CARDINAL) : Tree ; | |
4721 | VAR | |
4722 | Field : CARDINAL ; | |
4723 | i : CARDINAL ; | |
4724 | byteOffset, | |
4725 | bitOffset, | |
4726 | FieldList, | |
4727 | VarientType : Tree ; | |
4728 | location : location_t ; | |
4729 | BEGIN | |
4730 | i := 1 ; | |
4731 | FieldList := Tree(NIL) ; | |
4732 | VarientType := DoStartDeclaration(sym, BuildStartVarient) ; | |
4733 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
4734 | byteOffset := GetIntegerZero(location) ; | |
4735 | bitOffset := GetIntegerZero(location) ; | |
4736 | WHILE GetNth(sym, i)#NulSym DO | |
4737 | Field := GetNth(sym, i) ; | |
4738 | IF IsRecordField(Field) AND IsRecordFieldAVarientTag(Field) AND (GetSymName(Field)=NulName) | |
4739 | THEN | |
4740 | (* do not include a nameless tag into the C struct *) | |
4741 | ELSE | |
4742 | IF Debugging | |
4743 | THEN | |
4744 | printf0('chaining ') ; PrintTerse(Field) ; printf0('\n') | |
4745 | END ; | |
4746 | FieldList := ChainOn(FieldList, MaybeAlignField(Chained(Field), byteOffset, bitOffset)) | |
4747 | END ; | |
4748 | INC(i) | |
4749 | END ; | |
4750 | WatchRemoveList(sym, partiallydeclared) ; | |
4751 | WatchRemoveList(sym, heldbyalignment) ; | |
4752 | WatchRemoveList(sym, finishedalignment) ; | |
4753 | VarientType := BuildEndVarient(location, VarientType, FieldList, IsDeclaredPacked(sym)) ; | |
4754 | RETURN( VarientType ) | |
4755 | END DeclareVarient ; | |
4756 | ||
4757 | ||
4758 | (* | |
4759 | DeclareFieldVarient - | |
4760 | *) | |
4761 | ||
4762 | PROCEDURE DeclareFieldVarient (sym: CARDINAL) : Tree ; | |
4763 | VAR | |
4764 | i, f : CARDINAL ; | |
4765 | VarientList, | |
4766 | VarientType, | |
4767 | byteOffset, | |
4768 | bitOffset, | |
4769 | GccFieldType: Tree ; | |
4770 | location : location_t ; | |
4771 | BEGIN | |
4772 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
4773 | i := 1 ; | |
4774 | VarientList := Tree(NIL) ; | |
4775 | VarientType := DoStartDeclaration(sym, BuildStartFieldVarient) ; | |
4776 | (* no need to store the [sym, RecordType] tuple as it is stored by DeclareRecord which calls us *) | |
4777 | byteOffset := GetIntegerZero(location) ; | |
4778 | bitOffset := GetIntegerZero(location) ; | |
4779 | WHILE GetNth(sym, i)#NulSym DO | |
4780 | f := GetNth(sym, i) ; | |
4781 | IF IsFieldVarient(f) AND IsEmptyFieldVarient(f) | |
4782 | THEN | |
4783 | (* do not include empty varient fields (created via 'else end' in variant records *) | |
4784 | ELSE | |
4785 | IF Debugging | |
4786 | THEN | |
4787 | printf0('chaining ') ; PrintTerse(f) ; printf0('\n') | |
4788 | END ; | |
4789 | VarientList := ChainOn(VarientList, MaybeAlignField(Chained(f), byteOffset, bitOffset)) | |
4790 | END ; | |
4791 | INC(i) | |
4792 | END ; | |
4793 | WatchRemoveList(sym, partiallydeclared) ; | |
4794 | GccFieldType := BuildEndFieldVarient(location, VarientType, VarientList, IsDeclaredPacked(sym)) ; | |
4795 | RETURN( GccFieldType ) | |
4796 | END DeclareFieldVarient ; | |
4797 | ||
4798 | ||
4799 | (* | |
4800 | DeclarePointer - declares a pointer type to gcc and returns the Tree. | |
4801 | *) | |
4802 | ||
4803 | PROCEDURE DeclarePointer (sym: CARDINAL) : Tree ; | |
4804 | BEGIN | |
4805 | RETURN( BuildPointerType(Mod2Gcc(GetSType(sym))) ) | |
4806 | END DeclarePointer ; | |
4807 | ||
4808 | ||
4809 | (* | |
4810 | DeclareUnbounded - builds an unbounded type and returns the gcc tree. | |
4811 | *) | |
4812 | ||
4813 | PROCEDURE DeclareUnbounded (sym: CARDINAL) : Tree ; | |
4814 | VAR | |
4815 | record: CARDINAL ; | |
4816 | BEGIN | |
4817 | Assert(IsUnbounded(sym)) ; | |
4818 | IF GccKnowsAbout(sym) | |
4819 | THEN | |
4820 | RETURN( Mod2Gcc(sym) ) | |
4821 | ELSE | |
4822 | record := GetUnboundedRecordType(sym) ; | |
4823 | Assert(IsRecord(record)) ; | |
4824 | Assert(AllDependantsFullyDeclared(record)) ; | |
4825 | IF (NOT GccKnowsAbout(record)) | |
4826 | THEN | |
4827 | DeclareTypeConstFully(record) ; | |
4828 | WatchRemoveList(record, todolist) | |
4829 | END ; | |
4830 | RETURN( Mod2Gcc(record) ) | |
4831 | END | |
4832 | END DeclareUnbounded ; | |
4833 | ||
4834 | ||
4835 | (* | |
4836 | BuildIndex - | |
4837 | *) | |
4838 | ||
4839 | PROCEDURE BuildIndex (tokenno: CARDINAL; array: CARDINAL) : Tree ; | |
4840 | VAR | |
4841 | Subscript: CARDINAL ; | |
4842 | Type, | |
4843 | High, Low: CARDINAL ; | |
4844 | n, | |
4845 | low, high: Tree ; | |
4846 | location : location_t ; | |
4847 | BEGIN | |
4848 | location := TokenToLocation(tokenno) ; | |
4849 | Subscript := GetArraySubscript (array) ; | |
4850 | Assert (IsSubscript (Subscript)) ; | |
4851 | Type := GetDType (Subscript) ; | |
4852 | Low := GetTypeMin (Type) ; | |
4853 | High := GetTypeMax (Type) ; | |
4854 | DeclareConstant (tokenno, Low) ; | |
4855 | DeclareConstant (tokenno, High) ; | |
4856 | low := Mod2Gcc (Low) ; | |
4857 | high := Mod2Gcc (High) ; | |
4858 | IF ExceedsTypeRange (GetIntegerType (), low, high) | |
4859 | THEN | |
4860 | location := TokenToLocation (tokenno) ; | |
4861 | n := BuildConvert (location, GetIntegerType (), BuildSub (location, high, low, FALSE), FALSE) ; | |
4862 | IF TreeOverflow(n) OR ValueOutOfTypeRange (GetIntegerType (), n) | |
4863 | THEN | |
4864 | MetaError3('implementation restriction, array is too large {%1EDM}, the range {%2ad}..{%3ad} exceeds the integer range', | |
4865 | array, Low, High) ; | |
4866 | RETURN BuildArrayIndexType (GetIntegerZero (location), GetIntegerZero (location)) | |
4867 | ELSE | |
4868 | PutArrayLarge (array) ; | |
4869 | RETURN BuildArrayIndexType (GetIntegerZero (location), n) | |
4870 | END | |
4871 | ELSE | |
4872 | low := BuildConvert (location, GetIntegerType (), low, FALSE) ; | |
4873 | high := BuildConvert (location, GetIntegerType (), high, FALSE) ; | |
4874 | RETURN BuildArrayIndexType (low, high) | |
4875 | END | |
4876 | END BuildIndex ; | |
4877 | ||
4878 | ||
4879 | (* | |
4880 | DeclareArray - declares an array to gcc and returns the gcc tree. | |
4881 | *) | |
4882 | ||
4883 | PROCEDURE DeclareArray (Sym: CARDINAL) : Tree ; | |
4884 | VAR | |
4885 | typeOfArray: CARDINAL ; | |
4886 | ArrayType, | |
4887 | GccArray, | |
4888 | GccIndex : Tree ; | |
4889 | Subscript : CARDINAL ; | |
4890 | tokenno : CARDINAL ; | |
4891 | location : location_t ; | |
4892 | BEGIN | |
4893 | Assert(IsArray(Sym)) ; | |
4894 | ||
4895 | tokenno := GetDeclaredMod(Sym) ; | |
4896 | location := TokenToLocation(tokenno) ; | |
4897 | ||
4898 | Subscript := GetArraySubscript(Sym) ; | |
4899 | typeOfArray := GetDType(Sym) ; | |
4900 | GccArray := Mod2Gcc(typeOfArray) ; | |
4901 | GccIndex := BuildIndex(tokenno, Sym) ; | |
4902 | ||
4903 | IF GccKnowsAbout(Sym) | |
4904 | THEN | |
4905 | ArrayType := Mod2Gcc(Sym) | |
4906 | ELSE | |
4907 | ArrayType := BuildStartArrayType(GccIndex, GccArray, typeOfArray) ; | |
4908 | PreAddModGcc(Sym, ArrayType) | |
4909 | END ; | |
4910 | ||
4911 | PreAddModGcc(Subscript, GccArray) ; (* we save the type of this array as the subscript *) | |
4912 | PushIntegerTree(BuildSize(location, GccArray, FALSE)) ; (* and the size of this array so far *) | |
4913 | PopSize(Subscript) ; | |
4914 | ||
4915 | GccArray := BuildEndArrayType(ArrayType, GccArray, GccIndex, typeOfArray) ; | |
4916 | Assert(GccArray=ArrayType) ; | |
4917 | ||
4918 | RETURN( GccArray ) | |
4919 | END DeclareArray ; | |
4920 | ||
4921 | ||
4922 | (* | |
4923 | DeclareProcType - declares a procedure type to gcc and returns the gcc type tree. | |
4924 | *) | |
4925 | ||
4926 | PROCEDURE DeclareProcType (Sym: CARDINAL) : Tree ; | |
4927 | VAR | |
4928 | i, p, Son, | |
4929 | ReturnType: CARDINAL ; | |
4930 | func, | |
4931 | GccParam : Tree ; | |
4932 | location : location_t ; | |
4933 | BEGIN | |
4934 | ReturnType := GetSType(Sym) ; | |
4935 | func := DoStartDeclaration(Sym, BuildStartFunctionType) ; | |
4936 | InitFunctionTypeParameters ; | |
4937 | p := NoOfParam(Sym) ; | |
4938 | i := p ; | |
4939 | WHILE i>0 DO | |
4940 | Son := GetNthParam(Sym, i) ; | |
4941 | location := TokenToLocation(GetDeclaredMod(Son)) ; | |
4942 | GccParam := BuildProcTypeParameterDeclaration(location, Mod2Gcc(GetSType(Son)), IsVarParam(Sym, i)) ; | |
4943 | PreAddModGcc(Son, GccParam) ; | |
4944 | DEC(i) | |
4945 | END ; | |
4946 | IF ReturnType=NulSym | |
4947 | THEN | |
4948 | RETURN( BuildEndFunctionType(func, NIL, UsesVarArgs(Sym)) ) | |
4949 | ELSE | |
4950 | RETURN( BuildEndFunctionType(func, Mod2Gcc(ReturnType), UsesVarArgs(Sym)) ) | |
4951 | END | |
4952 | END DeclareProcType ; | |
4953 | ||
4954 | ||
4955 | VAR | |
4956 | MaxEnumerationField, | |
4957 | MinEnumerationField: CARDINAL ; | |
4958 | ||
4959 | ||
4960 | (* | |
4961 | FindMinMaxEnum - finds the minimum and maximum enumeration fields. | |
4962 | *) | |
4963 | ||
4964 | PROCEDURE FindMinMaxEnum (field: WORD) ; | |
4965 | BEGIN | |
4966 | IF MaxEnumerationField=NulSym | |
4967 | THEN | |
4968 | MaxEnumerationField := field | |
4969 | ELSE | |
4970 | PushValue(field) ; | |
4971 | PushValue(MaxEnumerationField) ; | |
4972 | IF Gre(GetDeclaredMod(field)) | |
4973 | THEN | |
4974 | MaxEnumerationField := field | |
4975 | END | |
4976 | END ; | |
4977 | IF MinEnumerationField=NulSym | |
4978 | THEN | |
4979 | MinEnumerationField := field | |
4980 | ELSE | |
4981 | PushValue(field) ; | |
4982 | PushValue(MinEnumerationField) ; | |
4983 | IF Less(GetDeclaredMod(field)) | |
4984 | THEN | |
4985 | MinEnumerationField := field | |
4986 | END | |
4987 | END | |
4988 | END FindMinMaxEnum ; | |
4989 | ||
4990 | ||
4991 | (* | |
4992 | GetTypeMin - | |
4993 | *) | |
4994 | ||
4995 | PROCEDURE GetTypeMin (type: CARDINAL) : CARDINAL ; | |
4996 | VAR | |
4997 | min, max: CARDINAL ; | |
4998 | BEGIN | |
4999 | IF IsSubrange(type) | |
5000 | THEN | |
5001 | GetSubrange(type, max, min) ; | |
5002 | RETURN( min ) | |
5003 | ELSIF IsSet(type) | |
5004 | THEN | |
5005 | RETURN( GetTypeMin(GetSType(type)) ) | |
5006 | ELSIF IsEnumeration(type) | |
5007 | THEN | |
5008 | MinEnumerationField := NulSym ; | |
5009 | MaxEnumerationField := NulSym ; | |
5010 | ForeachFieldEnumerationDo(type, FindMinMaxEnum) ; | |
5011 | RETURN( MinEnumerationField ) | |
5012 | ELSIF IsBaseType(type) | |
5013 | THEN | |
5014 | GetBaseTypeMinMax(type, min, max) ; | |
5015 | RETURN( min ) | |
5016 | ELSIF IsSystemType(type) | |
5017 | THEN | |
5018 | GetSystemTypeMinMax(type, min, max) ; | |
5019 | RETURN( min ) | |
5020 | ELSIF GetSType(type)=NulSym | |
5021 | THEN | |
5022 | MetaError1('unable to obtain the MIN value for type {%1as}', type) | |
5023 | ELSE | |
5024 | RETURN( GetTypeMin(GetSType(type)) ) | |
5025 | END | |
5026 | END GetTypeMin ; | |
5027 | ||
5028 | ||
5029 | (* | |
5030 | GetTypeMax - | |
5031 | *) | |
5032 | ||
5033 | PROCEDURE GetTypeMax (type: CARDINAL) : CARDINAL ; | |
5034 | VAR | |
5035 | min, max: CARDINAL ; | |
5036 | BEGIN | |
5037 | IF IsSubrange(type) | |
5038 | THEN | |
5039 | GetSubrange(type, max, min) ; | |
5040 | RETURN( max ) | |
5041 | ELSIF IsSet(type) | |
5042 | THEN | |
5043 | RETURN( GetTypeMax(GetSType(type)) ) | |
5044 | ELSIF IsEnumeration(type) | |
5045 | THEN | |
5046 | MinEnumerationField := NulSym ; | |
5047 | MaxEnumerationField := NulSym ; | |
5048 | ForeachFieldEnumerationDo(type, FindMinMaxEnum) ; | |
5049 | RETURN( MaxEnumerationField ) | |
5050 | ELSIF IsBaseType(type) | |
5051 | THEN | |
5052 | GetBaseTypeMinMax(type, min, max) ; | |
5053 | RETURN( max ) | |
5054 | ELSIF IsSystemType(type) | |
5055 | THEN | |
5056 | GetSystemTypeMinMax(type, min, max) ; | |
5057 | RETURN( max ) | |
5058 | ELSIF GetSType(type)=NulSym | |
5059 | THEN | |
5060 | MetaError1('unable to obtain the MAX value for type {%1as}', type) | |
5061 | ELSE | |
5062 | RETURN( GetTypeMax(GetSType(type)) ) | |
5063 | END | |
5064 | END GetTypeMax ; | |
5065 | ||
5066 | ||
5067 | (* | |
5068 | PushNoOfBits - pushes the integer value of the number of bits required | |
5069 | to maintain a set of type. | |
5070 | *) | |
5071 | ||
5072 | PROCEDURE PushNoOfBits (type: CARDINAL; low, high: CARDINAL) ; | |
5073 | BEGIN | |
5074 | PushValue(high) ; | |
5075 | ConvertToType(type) ; | |
5076 | PushValue(low) ; | |
5077 | ConvertToType(type) ; | |
5078 | Sub ; | |
5079 | ConvertToType(Cardinal) | |
5080 | END PushNoOfBits ; | |
5081 | ||
5082 | ||
5083 | (* | |
5084 | DeclareLargeSet - n is the name of the set. | |
5085 | type is the subrange type (or simple type) | |
5086 | low and high are the limits of the subrange. | |
5087 | *) | |
5088 | ||
5089 | PROCEDURE DeclareLargeSet (n: Name; type: CARDINAL; low, high: CARDINAL) : Tree ; | |
5090 | VAR | |
5091 | lowtree, | |
5092 | hightree, | |
5093 | BitsInSet, | |
5094 | RecordType, | |
5095 | GccField, | |
5096 | FieldList : Tree ; | |
5097 | bpw : CARDINAL ; | |
5098 | location : location_t ; | |
5099 | BEGIN | |
5100 | location := TokenToLocation(GetDeclaredMod(type)) ; | |
5101 | bpw := GetBitsPerBitset() ; | |
5102 | PushValue(low) ; | |
5103 | lowtree := PopIntegerTree() ; | |
5104 | PushValue(high) ; | |
5105 | hightree := PopIntegerTree() ; | |
5106 | FieldList := Tree(NIL) ; | |
5107 | RecordType := BuildStartRecord(location, KeyToCharStar(n)) ; (* no problem with recursive types here *) | |
5108 | PushNoOfBits(type, low, high) ; | |
5109 | PushCard(1) ; | |
5110 | Addn ; | |
5111 | BitsInSet := PopIntegerTree() ; | |
5112 | PushIntegerTree(BitsInSet) ; | |
5113 | PushCard(0) ; | |
5114 | WHILE Gre(GetDeclaredMod(type)) DO | |
5115 | PushIntegerTree(BitsInSet) ; | |
5116 | PushCard(bpw-1) ; | |
5117 | IF GreEqu(GetDeclaredMod(type)) | |
5118 | THEN | |
5119 | PushIntegerTree(lowtree) ; | |
5120 | PushCard(bpw-1) ; | |
5121 | Addn ; | |
5122 | GccField := BuildFieldRecord(location, NIL, BuildSetType(location, NIL, Mod2Gcc(type), lowtree, PopIntegerTree(), FALSE)) ; | |
5123 | PushIntegerTree(lowtree) ; | |
5124 | PushCard(bpw) ; | |
5125 | Addn ; | |
5126 | lowtree := PopIntegerTree() ; | |
5127 | PushIntegerTree(BitsInSet) ; | |
5128 | PushCard(bpw) ; | |
5129 | Sub ; | |
5130 | BitsInSet := PopIntegerTree() | |
5131 | ELSE | |
5132 | (* printf2('range is %a..%a\n', GetSymName(low), GetSymName(high)) ; *) | |
5133 | GccField := BuildFieldRecord(location, NIL, BuildSetType(location, NIL, Mod2Gcc(type), lowtree, hightree, FALSE)) ; | |
5134 | PushCard(0) ; | |
5135 | BitsInSet := PopIntegerTree() | |
5136 | END ; | |
5137 | FieldList := ChainOn(FieldList, GccField) ; | |
5138 | PushIntegerTree(BitsInSet) ; | |
5139 | PushCard(0) | |
5140 | END ; | |
5141 | RETURN( BuildEndRecord(location, RecordType, FieldList, FALSE) ) | |
5142 | END DeclareLargeSet ; | |
5143 | ||
5144 | ||
5145 | (* | |
5146 | DeclareLargeOrSmallSet - works out whether the set will exceed TSIZE(WORD). If it does | |
5147 | we manufacture a set using: | |
5148 | ||
5149 | settype = RECORD | |
5150 | w1: SET OF [...] | |
5151 | w2: SET OF [...] | |
5152 | END | |
5153 | ||
5154 | We do this as GCC and GDB (stabs) only knows about WORD sized sets. | |
5155 | If the set will fit into a WORD then we call gccgm2 directly. | |
5156 | *) | |
5157 | ||
5158 | PROCEDURE DeclareLargeOrSmallSet (sym: CARDINAL; | |
5159 | n: Name; type: CARDINAL; low, high: CARDINAL) : Tree ; | |
5160 | VAR | |
5161 | location: location_t ; | |
5162 | packed : BOOLEAN ; | |
5163 | BEGIN | |
5164 | PushNoOfBits(type, low, high) ; | |
5165 | PushCard(GetBitsPerBitset()) ; | |
5166 | packed := IsSetPacked (sym) ; | |
5167 | IF Less(GetDeclaredMod(type)) | |
5168 | THEN | |
5169 | location := TokenToLocation(GetDeclaredMod(sym)) ; | |
5170 | (* small set *) | |
5171 | (* PutSetSmall(sym) ; *) | |
5172 | RETURN BuildSetType (location, KeyToCharStar(n), | |
5173 | Mod2Gcc(type), Mod2Gcc(low), Mod2Gcc(high), packed) | |
5174 | ELSE | |
5175 | (* PutSetLarge(sym) ; *) | |
5176 | RETURN DeclareLargeSet (n, type, low, high) (* --fixme-- finish packed here as well. *) | |
5177 | END | |
5178 | END DeclareLargeOrSmallSet ; | |
5179 | ||
5180 | ||
5181 | (* | |
5182 | DeclareSet - declares a set type to gcc and returns a Tree. | |
5183 | *) | |
5184 | ||
5185 | PROCEDURE DeclareSet (sym: CARDINAL) : Tree ; | |
5186 | VAR | |
5187 | gccsym : Tree ; | |
5188 | type, | |
5189 | high, low: CARDINAL ; | |
5190 | BEGIN | |
5191 | type := GetDType(sym) ; | |
5192 | IF IsSubrange(type) | |
5193 | THEN | |
5194 | GetSubrange(type, high, low) ; | |
5195 | gccsym := DeclareLargeOrSmallSet(sym, GetFullSymName(sym), GetSType(type), low, high) | |
5196 | ELSE | |
5197 | gccsym := DeclareLargeOrSmallSet(sym, GetFullSymName(sym), type, GetTypeMin(type), GetTypeMax(type)) | |
5198 | END ; | |
5199 | RETURN( gccsym ) | |
5200 | END DeclareSet ; | |
5201 | ||
5202 | ||
5203 | (* | |
5204 | CheckResolveSubrange - checks to see whether we can determine | |
5205 | the subrange type. We are able to do | |
5206 | this once low, high and the type are known. | |
5207 | *) | |
5208 | ||
5209 | PROCEDURE CheckResolveSubrange (sym: CARDINAL) ; | |
5210 | VAR | |
5211 | size, high, low, type: CARDINAL ; | |
5212 | BEGIN | |
5213 | GetSubrange(sym, high, low) ; | |
5214 | type := GetSType(sym) ; | |
5215 | IF type=NulSym | |
5216 | THEN | |
5217 | IF GccKnowsAbout(low) AND GccKnowsAbout(high) | |
5218 | THEN | |
5219 | IF IsConstString(low) | |
5220 | THEN | |
5221 | size := GetStringLength(low) ; | |
5222 | IF size=1 | |
5223 | THEN | |
5224 | PutSubrange(sym, low, high, Char) | |
5225 | ELSE | |
5226 | MetaError1('cannot have a subrange of a string type {%1Uad}', | |
5227 | sym) | |
5228 | END | |
5229 | ELSIF IsFieldEnumeration(low) | |
5230 | THEN | |
5231 | IF GetSType(low)=GetSType(high) | |
5232 | THEN | |
5233 | PutSubrange(sym, low, high, GetSType(low)) | |
5234 | ELSE | |
5235 | MetaError1('subrange limits must be of the same type {%1Uad}', sym) | |
5236 | END | |
5237 | ELSIF IsValueSolved(low) | |
5238 | THEN | |
5239 | IF GetSType(low)=LongReal | |
5240 | THEN | |
5241 | MetaError1('cannot have a subrange of a SHORTREAL, REAL or LONGREAL type {%1Uad}', sym) | |
5242 | ELSE | |
5243 | PutSubrange(sym, low, high, MixTypes(GetSType(low), GetSType(high), GetDeclaredMod(sym))) | |
5244 | END | |
5245 | END | |
5246 | END | |
5247 | END | |
5248 | END CheckResolveSubrange ; | |
5249 | ||
5250 | ||
5251 | (* | |
5252 | TypeConstFullyDeclared - all, sym, dependents are declared, so create and | |
5253 | return the GCC Tree equivalent. | |
5254 | *) | |
5255 | ||
5256 | PROCEDURE TypeConstFullyDeclared (sym: CARDINAL) : Tree ; | |
5257 | VAR | |
5258 | t: Tree ; | |
5259 | n: Name ; | |
5260 | BEGIN | |
5261 | IF IsEnumeration(sym) | |
5262 | THEN | |
5263 | t := DeclareEnumeration(sym) | |
5264 | ELSIF IsFieldEnumeration(sym) | |
5265 | THEN | |
5266 | t := DeclareFieldEnumeration(sym) | |
5267 | ELSIF IsSubrange(sym) | |
5268 | THEN | |
5269 | t := DeclareSubrange(sym) | |
5270 | ELSIF IsRecord(sym) | |
5271 | THEN | |
5272 | t := CheckPragma(DeclareRecord(sym), sym) | |
5273 | ELSIF IsRecordField(sym) | |
5274 | THEN | |
5275 | t := CheckPragma(DeclareRecordField(sym), sym) | |
5276 | ELSIF IsFieldVarient(sym) | |
5277 | THEN | |
5278 | t := DeclareFieldVarient(sym) | |
5279 | ELSIF IsVarient(sym) | |
5280 | THEN | |
5281 | t := DeclareVarient(sym) | |
5282 | ELSIF IsPointer(sym) | |
5283 | THEN | |
5284 | t := CheckAlignment(DeclarePointer(sym), sym) | |
5285 | ELSIF IsUnbounded(sym) | |
5286 | THEN | |
5287 | t := DeclareUnbounded(sym) | |
5288 | ELSIF IsArray(sym) | |
5289 | THEN | |
5290 | t := CheckAlignment(DeclareArray(sym), sym) | |
5291 | ELSIF IsProcType(sym) | |
5292 | THEN | |
5293 | t := DeclareProcType(sym) | |
5294 | ELSIF IsSet(sym) | |
5295 | THEN | |
5296 | t := DeclareSet(sym) | |
5297 | ELSIF IsConst(sym) | |
5298 | THEN | |
5299 | IF IsConstructor(sym) | |
5300 | THEN | |
5301 | PushValue(sym) ; | |
5302 | ChangeToConstructor(GetDeclaredMod(sym), GetSType(sym)) ; | |
5303 | PopValue(sym) ; | |
5304 | EvaluateValue(sym) ; | |
5305 | PutConstructorSolved(sym) ; | |
5306 | ELSIF IsConstSet(sym) | |
5307 | THEN | |
5308 | EvaluateValue(sym) | |
5309 | END ; | |
5310 | IF NOT IsValueSolved(sym) | |
5311 | THEN | |
5312 | RETURN( NIL ) | |
5313 | END ; | |
5314 | t := DeclareConst(GetDeclaredMod(sym), sym) ; | |
5315 | Assert(t#NIL) | |
5316 | ELSIF IsConstructor(sym) | |
5317 | THEN | |
5318 | (* not yet known as a constant *) | |
5319 | RETURN( NIL ) | |
5320 | ELSE | |
5321 | t := DeclareType(sym) ; | |
5322 | IF IsType(sym) | |
5323 | THEN | |
5324 | t := CheckAlignment(t, sym) | |
5325 | END | |
5326 | END ; | |
5327 | IF GetSymName(sym)#NulName | |
5328 | THEN | |
5329 | IF Debugging | |
5330 | THEN | |
5331 | n := GetSymName(sym) ; | |
5332 | printf1('declaring type %a\n', n) | |
5333 | END ; | |
5334 | t := RememberType(t) | |
5335 | END ; | |
5336 | RETURN( t ) | |
5337 | END TypeConstFullyDeclared ; | |
5338 | ||
5339 | ||
5340 | (* | |
5341 | IsBaseType - returns true if a type, Sym, is a base type and | |
5342 | we use predefined GDB information to represent this | |
5343 | type. | |
5344 | *) | |
5345 | ||
5346 | PROCEDURE IsBaseType (Sym: CARDINAL) : BOOLEAN ; | |
5347 | BEGIN | |
5348 | RETURN( (Sym=Cardinal) OR (Sym=Integer) OR | |
5349 | (Sym=Char) OR (Sym=Proc) ) | |
5350 | END IsBaseType ; | |
5351 | ||
5352 | ||
5353 | (* | |
5354 | IsFieldEnumerationDependants - sets enumDeps to FALSE if action(Sym) | |
5355 | is also FALSE. | |
5356 | *) | |
5357 | ||
5358 | PROCEDURE IsFieldEnumerationDependants (Sym: WORD) ; | |
5359 | BEGIN | |
5360 | IF NOT action(Sym) | |
5361 | THEN | |
5362 | enumDeps := FALSE | |
5363 | END | |
5364 | END IsFieldEnumerationDependants ; | |
5365 | ||
5366 | ||
5367 | (* | |
5368 | IsEnumerationDependants - returns true if the enumeration | |
5369 | p(dependants) all return true. | |
5370 | *) | |
5371 | ||
5372 | PROCEDURE IsEnumerationDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5373 | BEGIN | |
5374 | action := q ; | |
5375 | enumDeps := TRUE ; | |
5376 | ForeachFieldEnumerationDo(sym, IsFieldEnumerationDependants) ; | |
5377 | RETURN( enumDeps ) | |
5378 | END IsEnumerationDependants ; | |
5379 | ||
5380 | ||
5381 | (* | |
5382 | WalkEnumerationDependants - returns walks all dependants of Sym. | |
5383 | *) | |
5384 | ||
5385 | PROCEDURE WalkEnumerationDependants (sym: CARDINAL; p: WalkAction) ; | |
5386 | BEGIN | |
5387 | ForeachFieldEnumerationDo(sym, p) | |
5388 | END WalkEnumerationDependants ; | |
5389 | ||
5390 | ||
5391 | (* | |
5392 | WalkSubrangeDependants - calls p(dependants) for each dependant of, sym. | |
5393 | *) | |
5394 | ||
5395 | PROCEDURE WalkSubrangeDependants (sym: CARDINAL; p: WalkAction) ; | |
5396 | VAR | |
5397 | type, | |
5398 | high, low: CARDINAL ; | |
5399 | BEGIN | |
5400 | GetSubrange(sym, high, low) ; | |
5401 | CheckResolveSubrange(sym) ; | |
5402 | type := GetSType(sym) ; | |
5403 | IF type#NulSym | |
5404 | THEN | |
5405 | p(type) | |
5406 | END ; | |
5407 | (* low and high are not types but constants and they are resolved by M2GenGCC *) | |
5408 | p(low) ; | |
5409 | p(high) | |
5410 | END WalkSubrangeDependants ; | |
5411 | ||
5412 | ||
5413 | (* | |
5414 | IsSubrangeDependants - returns TRUE if the subrange | |
5415 | q(dependants) all return TRUE. | |
5416 | *) | |
5417 | ||
5418 | PROCEDURE IsSubrangeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5419 | VAR | |
5420 | result : BOOLEAN ; | |
5421 | type, | |
5422 | high, low: CARDINAL ; | |
5423 | BEGIN | |
5424 | GetSubrange(sym, high, low) ; | |
5425 | (* low and high are not types but constants and they are resolved by M2GenGCC *) | |
5426 | CheckResolveSubrange(sym) ; | |
5427 | result := TRUE ; | |
5428 | type := GetSType(sym) ; | |
5429 | IF (type=NulSym) OR (NOT q(type)) | |
5430 | THEN | |
5431 | result := FALSE | |
5432 | END ; | |
5433 | IF NOT q(low) | |
5434 | THEN | |
5435 | result := FALSE | |
5436 | END ; | |
5437 | IF NOT q(high) | |
5438 | THEN | |
5439 | result := FALSE | |
5440 | END ; | |
5441 | RETURN( result ) | |
5442 | END IsSubrangeDependants ; | |
5443 | ||
5444 | ||
5445 | (* | |
5446 | WalkComponentDependants - | |
5447 | *) | |
5448 | ||
5449 | PROCEDURE WalkComponentDependants (sym: CARDINAL; p: WalkAction) ; | |
5450 | VAR | |
5451 | i : CARDINAL ; | |
5452 | type: CARDINAL ; | |
5453 | BEGIN | |
5454 | (* need to walk record and field *) | |
5455 | i := 1 ; | |
5456 | REPEAT | |
5457 | type := GetNth(sym, i) ; | |
5458 | IF type#NulSym | |
5459 | THEN | |
5460 | IF IsVar(type) | |
5461 | THEN | |
5462 | p(GetSType(type)) | |
5463 | ELSE | |
5464 | p(type) | |
5465 | END ; | |
5466 | INC(i) | |
5467 | END | |
5468 | UNTIL type=NulSym | |
5469 | END WalkComponentDependants ; | |
5470 | ||
5471 | ||
5472 | (* | |
5473 | IsComponentDependants - | |
5474 | *) | |
5475 | ||
5476 | PROCEDURE IsComponentDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5477 | VAR | |
5478 | type : CARDINAL ; | |
5479 | i : CARDINAL ; | |
5480 | result: BOOLEAN ; | |
5481 | BEGIN | |
5482 | (* need to check record is completely resolved *) | |
5483 | result := TRUE ; | |
5484 | i := 1 ; | |
5485 | REPEAT | |
5486 | type := GetNth(sym, i) ; | |
5487 | IF type#NulSym | |
5488 | THEN | |
5489 | IF IsVar(type) | |
5490 | THEN | |
5491 | type := GetSType(type) | |
5492 | END ; | |
5493 | IF NOT q(type) | |
5494 | THEN | |
5495 | result := FALSE | |
5496 | END ; | |
5497 | INC(i) | |
5498 | END | |
5499 | UNTIL type=NulSym ; | |
5500 | RETURN( result ) | |
5501 | END IsComponentDependants ; | |
5502 | ||
5503 | ||
5504 | (* | |
5505 | WalkVarDependants - walks all dependants of sym. | |
5506 | *) | |
5507 | ||
5508 | PROCEDURE WalkVarDependants (sym: CARDINAL; p: WalkAction) ; | |
5509 | VAR | |
5510 | type: CARDINAL ; | |
5511 | BEGIN | |
5512 | p(GetSType(sym)) ; | |
5513 | IF IsComponent(sym) | |
5514 | THEN | |
5515 | WalkComponentDependants(sym, p) | |
5516 | END ; | |
5517 | type := GetVarBackEndType(sym) ; | |
5518 | IF type#NulSym | |
5519 | THEN | |
5520 | p(type) | |
5521 | END | |
5522 | END WalkVarDependants ; | |
5523 | ||
5524 | ||
5525 | (* | |
5526 | IsVarDependants - returns TRUE if the pointer symbol, sym, | |
5527 | p(dependants) all return TRUE. | |
5528 | *) | |
5529 | ||
5530 | PROCEDURE IsVarDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5531 | VAR | |
5532 | type : CARDINAL ; | |
5533 | result: BOOLEAN ; | |
5534 | BEGIN | |
5535 | result := TRUE ; | |
5536 | IF NOT q(GetSType(sym)) | |
5537 | THEN | |
5538 | result := FALSE | |
5539 | END ; | |
5540 | IF IsComponent(sym) | |
5541 | THEN | |
5542 | IF NOT IsComponentDependants(sym, q) | |
5543 | THEN | |
5544 | result := FALSE | |
5545 | END | |
5546 | END ; | |
5547 | type := GetVarBackEndType(sym) ; | |
5548 | IF type#NulSym | |
5549 | THEN | |
5550 | IF NOT q(type) | |
5551 | THEN | |
5552 | result := FALSE | |
5553 | END | |
5554 | END ; | |
5555 | RETURN( result ) | |
5556 | END IsVarDependants ; | |
5557 | ||
5558 | ||
5559 | (* | |
5560 | WalkPointerDependants - walks all dependants of sym. | |
5561 | *) | |
5562 | ||
5563 | PROCEDURE WalkPointerDependants (sym: CARDINAL; p: WalkAction) ; | |
5564 | VAR | |
5565 | align: CARDINAL ; | |
5566 | BEGIN | |
5567 | p(GetSType(sym)) ; | |
5568 | align := GetAlignment(sym) ; | |
5569 | IF align#NulSym | |
5570 | THEN | |
5571 | p(align) | |
5572 | END | |
5573 | END WalkPointerDependants ; | |
5574 | ||
5575 | ||
5576 | (* | |
5577 | IsPointerDependants - returns TRUE if the pointer symbol, sym, | |
5578 | p(dependants) all return TRUE. | |
5579 | *) | |
5580 | ||
5581 | PROCEDURE IsPointerDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5582 | VAR | |
5583 | align: CARDINAL ; | |
5584 | final: BOOLEAN ; | |
5585 | BEGIN | |
5586 | final := TRUE ; | |
5587 | IF NOT q(GetSType(sym)) | |
5588 | THEN | |
5589 | final := FALSE | |
5590 | END ; | |
5591 | align := GetAlignment (sym) ; | |
5592 | IF final AND (align # NulSym) | |
5593 | THEN | |
5594 | IF NOT q(align) | |
5595 | THEN | |
5596 | final := FALSE | |
5597 | END | |
5598 | END ; | |
5599 | RETURN final | |
5600 | END IsPointerDependants ; | |
5601 | ||
5602 | ||
5603 | (* | |
5604 | IsRecordAlignment - | |
5605 | *) | |
5606 | ||
5607 | PROCEDURE IsRecordAlignment (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5608 | BEGIN | |
5609 | IF GetDefaultRecordFieldAlignment(sym)#NulSym | |
5610 | THEN | |
5611 | IF NOT q(GetDefaultRecordFieldAlignment(sym)) | |
5612 | THEN | |
5613 | RETURN( FALSE ) | |
5614 | END | |
5615 | END ; | |
5616 | RETURN( TRUE ) | |
5617 | END IsRecordAlignment ; | |
5618 | ||
5619 | ||
5620 | (* | |
5621 | IsRecordDependants - returns TRUE if the symbol, sym, | |
5622 | q(dependants) all return TRUE. | |
5623 | *) | |
5624 | ||
5625 | PROCEDURE IsRecordDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5626 | VAR | |
5627 | result: BOOLEAN ; | |
5628 | i : CARDINAL ; | |
5629 | field : CARDINAL ; | |
5630 | BEGIN | |
5631 | result := IsRecordAlignment(sym, q) ; | |
5632 | i := 1 ; | |
5633 | REPEAT | |
5634 | field := GetNth(sym, i) ; | |
5635 | IF field#NulSym | |
5636 | THEN | |
5637 | IF IsRecordField(field) | |
5638 | THEN | |
5639 | IF (NOT IsRecordFieldAVarientTag(field)) OR (GetSymName(field)#NulName) | |
5640 | THEN | |
5641 | IF NOT q(field) | |
5642 | THEN | |
5643 | result := FALSE | |
5644 | END | |
5645 | END | |
5646 | ELSIF IsVarient(field) | |
5647 | THEN | |
5648 | IF NOT q(field) | |
5649 | THEN | |
5650 | result := FALSE | |
5651 | END | |
5652 | ELSIF IsFieldVarient(field) | |
5653 | THEN | |
5654 | InternalError ('should not see a field varient') | |
5655 | ELSE | |
5656 | InternalError ('unknown symbol in record') | |
5657 | END | |
5658 | END ; | |
5659 | INC(i) | |
5660 | UNTIL field=NulSym ; | |
5661 | RETURN( result ) | |
5662 | END IsRecordDependants ; | |
5663 | ||
5664 | ||
5665 | (* | |
5666 | WalkRecordAlignment - walks the alignment constant associated with | |
5667 | record, sym. | |
5668 | *) | |
5669 | ||
5670 | PROCEDURE WalkRecordAlignment (sym: CARDINAL; p: WalkAction) ; | |
5671 | BEGIN | |
5672 | IF GetDefaultRecordFieldAlignment(sym)#NulSym | |
5673 | THEN | |
5674 | p(GetDefaultRecordFieldAlignment(sym)) | |
5675 | END | |
5676 | END WalkRecordAlignment ; | |
5677 | ||
5678 | ||
5679 | (* | |
5680 | WalkRecordDependants - walks symbol, sym, dependants. It only | |
5681 | walks the fields if the alignment is | |
5682 | unused or fully declared. | |
5683 | *) | |
5684 | ||
5685 | PROCEDURE WalkRecordDependants (sym: CARDINAL; p: WalkAction) ; | |
5686 | BEGIN | |
5687 | WalkRecordAlignment(sym, p) ; | |
5688 | WalkRecordDependants2(sym, p) | |
5689 | END WalkRecordDependants ; | |
5690 | ||
5691 | ||
5692 | (* | |
5693 | WalkRecordFieldDependants - | |
5694 | *) | |
5695 | ||
5696 | PROCEDURE WalkRecordFieldDependants (sym: CARDINAL; p: WalkAction) ; | |
5697 | VAR | |
5698 | v : CARDINAL ; | |
5699 | align: CARDINAL ; | |
5700 | BEGIN | |
5701 | Assert(IsRecordField(sym)) ; | |
5702 | p(GetSType(sym)) ; | |
5703 | v := GetVarient(sym) ; | |
5704 | IF v#NulSym | |
5705 | THEN | |
5706 | p(v) | |
5707 | END ; | |
5708 | align := GetAlignment(sym) ; | |
5709 | IF align#NulSym | |
5710 | THEN | |
5711 | p(align) | |
5712 | END | |
5713 | END WalkRecordFieldDependants ; | |
5714 | ||
5715 | ||
5716 | (* | |
5717 | WalkVarient - | |
5718 | *) | |
5719 | ||
5720 | (* | |
5721 | PROCEDURE WalkVarient (sym: CARDINAL; p: WalkAction) ; | |
5722 | VAR | |
5723 | v : CARDINAL ; | |
5724 | var, | |
5725 | align: CARDINAL ; | |
5726 | BEGIN | |
5727 | p(sym) ; | |
5728 | v := GetVarient(sym) ; | |
5729 | IF v#NulSym | |
5730 | THEN | |
5731 | p(v) | |
5732 | END ; | |
5733 | var := GetRecordOfVarient(sym) ; | |
5734 | align := GetDefaultRecordFieldAlignment(var) ; | |
5735 | IF align#NulSym | |
5736 | THEN | |
5737 | p(align) | |
5738 | END | |
5739 | END WalkVarient ; | |
5740 | *) | |
5741 | ||
5742 | ||
5743 | (* | |
5744 | WalkRecordDependants2 - walks the fields of record, sym, calling | |
5745 | p on every dependant. | |
5746 | *) | |
5747 | ||
5748 | PROCEDURE WalkRecordDependants2 (sym: CARDINAL; p: WalkAction) ; | |
5749 | VAR | |
5750 | i : CARDINAL ; | |
5751 | Field: CARDINAL ; | |
5752 | BEGIN | |
5753 | i := 1 ; | |
5754 | WHILE GetNth(sym, i)#NulSym DO | |
5755 | Field := GetNth(sym, i) ; | |
5756 | p(Field) ; | |
5757 | IF IsRecordField(Field) | |
5758 | THEN | |
5759 | WalkRecordFieldDependants(Field, p) | |
5760 | ELSIF IsVarient(Field) | |
5761 | THEN | |
5762 | WalkVarientDependants(Field, p) | |
5763 | ELSIF IsFieldVarient(Field) | |
5764 | THEN | |
5765 | InternalError ('should not see a field varient') | |
5766 | ELSE | |
5767 | InternalError ('unknown symbol in record') | |
5768 | END ; | |
5769 | INC(i) | |
5770 | END | |
5771 | END WalkRecordDependants2 ; | |
5772 | ||
5773 | ||
5774 | (* | |
5775 | IsVarientAlignment - | |
5776 | *) | |
5777 | ||
5778 | PROCEDURE IsVarientAlignment (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5779 | VAR | |
5780 | align: CARDINAL ; | |
5781 | BEGIN | |
5782 | sym := GetRecordOfVarient(sym) ; | |
5783 | align := GetDefaultRecordFieldAlignment(sym) ; | |
5784 | IF (align#NulSym) AND (NOT q(align)) | |
5785 | THEN | |
5786 | RETURN( FALSE ) | |
5787 | END ; | |
5788 | RETURN( TRUE ) | |
5789 | END IsVarientAlignment ; | |
5790 | ||
5791 | ||
5792 | (* | |
5793 | IsVarientDependants - returns TRUE if the symbol, sym, | |
5794 | q(dependants) all return TRUE. | |
5795 | *) | |
5796 | ||
5797 | PROCEDURE IsVarientDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5798 | VAR | |
5799 | result: BOOLEAN ; | |
5800 | i : CARDINAL ; | |
5801 | Field : CARDINAL ; | |
5802 | BEGIN | |
5803 | result := IsVarientAlignment(sym, q) ; | |
5804 | i := 1 ; | |
5805 | WHILE GetNth(sym, i)#NulSym DO | |
5806 | Field := GetNth(sym, i) ; | |
5807 | Assert(IsFieldVarient(Field)) ; | |
5808 | IF NOT q(Field) | |
5809 | THEN | |
5810 | result := FALSE | |
5811 | END ; | |
5812 | INC(i) | |
5813 | END ; | |
5814 | RETURN( result ) | |
5815 | END IsVarientDependants ; | |
5816 | ||
5817 | ||
5818 | (* | |
5819 | WalkVarientAlignment - | |
5820 | *) | |
5821 | ||
5822 | PROCEDURE WalkVarientAlignment (sym: CARDINAL; p: WalkAction) ; | |
5823 | VAR | |
5824 | align: CARDINAL ; | |
5825 | BEGIN | |
5826 | sym := GetRecordOfVarient(sym) ; | |
5827 | align := GetDefaultRecordFieldAlignment(sym) ; | |
5828 | IF align#NulSym | |
5829 | THEN | |
5830 | p(align) | |
5831 | END | |
5832 | END WalkVarientAlignment ; | |
5833 | ||
5834 | ||
5835 | (* | |
5836 | WalkVarientDependants - walks symbol, sym, dependants. | |
5837 | *) | |
5838 | ||
5839 | PROCEDURE WalkVarientDependants (sym: CARDINAL; p: WalkAction) ; | |
5840 | VAR | |
5841 | i : CARDINAL ; | |
5842 | v, | |
5843 | Field: CARDINAL ; | |
5844 | BEGIN | |
5845 | WalkVarientAlignment(sym, p) ; | |
5846 | IF GetSType(sym)#NulSym | |
5847 | THEN | |
5848 | p(GetSType(sym)) | |
5849 | END ; | |
5850 | v := GetVarient(sym) ; | |
5851 | IF v#NulSym | |
5852 | THEN | |
5853 | p(v) | |
5854 | END ; | |
5855 | i := 1 ; | |
5856 | WHILE GetNth(sym, i)#NulSym DO | |
5857 | Field := GetNth(sym, i) ; | |
5858 | Assert(IsFieldVarient(Field)) ; (* field varients do _not_ have a type *) | |
5859 | p(Field) ; | |
5860 | WalkVarientFieldDependants(Field, p) ; | |
5861 | INC(i) | |
5862 | END | |
5863 | END WalkVarientDependants ; | |
5864 | ||
5865 | ||
5866 | (* | |
5867 | IsVarientFieldDependants - returns TRUE if the symbol, sym, | |
5868 | q(dependants) all return TRUE. | |
5869 | *) | |
5870 | ||
5871 | PROCEDURE IsVarientFieldDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5872 | VAR | |
5873 | i : CARDINAL ; | |
5874 | type, | |
5875 | Field : CARDINAL ; | |
5876 | result: BOOLEAN ; | |
5877 | BEGIN | |
5878 | i := 1 ; | |
5879 | result := IsVarientAlignment(sym, q) ; | |
5880 | WHILE GetNth(sym, i)#NulSym DO | |
5881 | Field := GetNth(sym, i) ; | |
5882 | IF NOT q(Field) | |
5883 | THEN | |
5884 | result := FALSE | |
5885 | END ; | |
5886 | type := GetSType(Field) ; | |
5887 | IF type#NulSym | |
5888 | THEN | |
5889 | IF NOT q(type) | |
5890 | THEN | |
5891 | result := FALSE | |
5892 | END | |
5893 | END ; | |
5894 | INC(i) | |
5895 | END ; | |
5896 | RETURN( result ) | |
5897 | END IsVarientFieldDependants ; | |
5898 | ||
5899 | ||
5900 | (* | |
5901 | WalkVarientFieldDependants - | |
5902 | *) | |
5903 | ||
5904 | PROCEDURE WalkVarientFieldDependants (sym: CARDINAL; p: WalkAction) ; | |
5905 | VAR | |
5906 | i : CARDINAL ; | |
5907 | type, | |
5908 | Field: CARDINAL ; | |
5909 | BEGIN | |
5910 | WalkVarientAlignment(sym, p) ; | |
5911 | i := 1 ; | |
5912 | WHILE GetNth(sym, i)#NulSym DO | |
5913 | Field := GetNth(sym, i) ; | |
5914 | p(Field) ; | |
5915 | type := GetSType(Field) ; | |
5916 | IF type#NulSym | |
5917 | THEN | |
5918 | p(type) | |
5919 | END ; | |
5920 | INC(i) | |
5921 | END | |
5922 | END WalkVarientFieldDependants ; | |
5923 | ||
5924 | ||
5925 | (* | |
5926 | IsArrayDependants - returns TRUE if the symbol, sym, | |
5927 | q(dependants) all return TRUE. | |
5928 | ||
5929 | *) | |
5930 | ||
5931 | PROCEDURE IsArrayDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
5932 | VAR | |
5933 | result : BOOLEAN ; | |
5934 | align : CARDINAL ; | |
5935 | subscript: CARDINAL ; | |
5936 | high, low: CARDINAL ; | |
5937 | type : CARDINAL ; | |
5938 | BEGIN | |
5939 | result := TRUE ; | |
5940 | Assert(IsArray(sym)) ; | |
5941 | type := GetSType(sym) ; | |
5942 | ||
5943 | IF NOT q(type) | |
5944 | THEN | |
5945 | result := FALSE | |
5946 | END ; | |
5947 | subscript := GetArraySubscript(sym) ; | |
5948 | IF subscript#NulSym | |
5949 | THEN | |
5950 | Assert(IsSubscript(subscript)) ; | |
5951 | type := GetSType(subscript) ; | |
5952 | IF NOT q(type) | |
5953 | THEN | |
5954 | result := FALSE | |
5955 | END ; | |
5956 | type := SkipType(type) ; | |
5957 | (* the array might be declared as ARRAY type OF foo *) | |
5958 | low := GetTypeMin(type) ; | |
5959 | high := GetTypeMax(type) ; | |
5960 | IF NOT q(low) | |
5961 | THEN | |
5962 | result := FALSE | |
5963 | END ; | |
5964 | IF NOT q(high) | |
5965 | THEN | |
5966 | result := FALSE | |
5967 | END ; | |
5968 | align := GetAlignment(sym) ; | |
5969 | IF (align#NulSym) AND (NOT q(align)) | |
5970 | THEN | |
5971 | result := FALSE | |
5972 | END | |
5973 | END ; | |
5974 | RETURN( result ) | |
5975 | END IsArrayDependants ; | |
5976 | ||
5977 | ||
5978 | (* | |
5979 | WalkArrayDependants - walks symbol, sym, dependants. | |
5980 | *) | |
5981 | ||
5982 | PROCEDURE WalkArrayDependants (sym: CARDINAL; p: WalkAction) ; | |
5983 | VAR | |
5984 | align : CARDINAL ; | |
5985 | subscript: CARDINAL ; | |
5986 | high, low: CARDINAL ; | |
5987 | type : CARDINAL ; | |
5988 | BEGIN | |
5989 | Assert(IsArray(sym)) ; | |
5990 | type := GetSType(sym) ; | |
5991 | p(type) ; | |
5992 | subscript := GetArraySubscript(sym) ; | |
5993 | IF subscript#NulSym | |
5994 | THEN | |
5995 | Assert(IsSubscript(subscript)) ; | |
5996 | type := GetSType(subscript) ; | |
5997 | p(type) ; | |
5998 | type := SkipType(type) ; | |
5999 | (* the array might be declared as ARRAY type OF foo *) | |
6000 | low := GetTypeMin(type) ; | |
6001 | high := GetTypeMax(type) ; | |
6002 | p(low) ; | |
6003 | p(high) ; | |
6004 | align := GetAlignment (sym) ; | |
6005 | IF align#NulSym | |
6006 | THEN | |
6007 | p(align) | |
6008 | END | |
6009 | END | |
6010 | END WalkArrayDependants ; | |
6011 | ||
6012 | ||
6013 | (* | |
6014 | IsSetDependants - returns TRUE if the symbol, sym, | |
6015 | q(dependants) all return TRUE. | |
6016 | *) | |
6017 | ||
6018 | PROCEDURE IsSetDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
6019 | VAR | |
6020 | result : BOOLEAN ; | |
6021 | type, low, high: CARDINAL ; | |
6022 | BEGIN | |
6023 | result := TRUE ; | |
6024 | Assert(IsSet(sym)) ; | |
6025 | ||
6026 | type := GetDType(sym) ; | |
6027 | IF NOT q(type) | |
6028 | THEN | |
6029 | result := FALSE | |
6030 | END ; | |
6031 | low := GetTypeMin(type) ; | |
6032 | high := GetTypeMax(type) ; | |
6033 | IF NOT q(low) | |
6034 | THEN | |
6035 | result := FALSE | |
6036 | END ; | |
6037 | IF NOT q(high) | |
6038 | THEN | |
6039 | result := FALSE | |
6040 | END ; | |
6041 | RETURN( result ) | |
6042 | END IsSetDependants ; | |
6043 | ||
6044 | ||
6045 | (* | |
6046 | WalkSetDependants - walks dependants, sym. | |
6047 | *) | |
6048 | ||
6049 | PROCEDURE WalkSetDependants (sym: CARDINAL; p: WalkAction) ; | |
6050 | VAR | |
6051 | type, low, high: CARDINAL ; | |
6052 | BEGIN | |
6053 | Assert(IsSet(sym)) ; | |
6054 | ||
6055 | type := GetDType(sym) ; | |
6056 | p(type) ; | |
6057 | low := GetTypeMin(type) ; | |
6058 | p(low) ; | |
6059 | high := GetTypeMax(type) ; | |
6060 | p(high) | |
6061 | END WalkSetDependants ; | |
6062 | ||
6063 | ||
6064 | (* | |
6065 | IsProcTypeDependants - | |
6066 | *) | |
6067 | ||
6068 | PROCEDURE IsProcTypeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
6069 | VAR | |
6070 | i, p, son : CARDINAL ; | |
6071 | ParamType, | |
6072 | ReturnType: CARDINAL ; | |
6073 | result : BOOLEAN ; | |
6074 | BEGIN | |
6075 | result := TRUE ; | |
6076 | Assert(IsProcType(sym)) ; | |
6077 | i := 1 ; | |
6078 | ReturnType := GetSType(sym) ; | |
6079 | p := NoOfParam(sym) ; | |
6080 | WHILE i<=p DO | |
6081 | son := GetNthParam(sym, i) ; | |
6082 | ParamType := GetSType(son) ; | |
6083 | IF NOT q(ParamType) | |
6084 | THEN | |
6085 | result := FALSE | |
6086 | END ; | |
6087 | INC(i) | |
6088 | END ; | |
6089 | IF (ReturnType=NulSym) OR q(ReturnType) | |
6090 | THEN | |
6091 | RETURN( result ) | |
6092 | ELSE | |
6093 | RETURN( FALSE ) | |
6094 | END | |
6095 | END IsProcTypeDependants ; | |
6096 | ||
6097 | ||
6098 | (* | |
6099 | WalkProcTypeDependants - walks dependants, sym. | |
6100 | *) | |
6101 | ||
6102 | PROCEDURE WalkProcTypeDependants (sym: CARDINAL; p: WalkAction) ; | |
6103 | VAR | |
6104 | i, n, son : CARDINAL ; | |
6105 | ParamType, | |
6106 | ReturnType: CARDINAL ; | |
6107 | BEGIN | |
6108 | Assert(IsProcType(sym)) ; | |
6109 | i := 1 ; | |
6110 | ReturnType := GetSType(sym) ; | |
6111 | n := NoOfParam(sym) ; | |
6112 | WHILE i<=n DO | |
6113 | son := GetNthParam(sym, i) ; | |
6114 | ParamType := GetSType(son) ; | |
6115 | p(ParamType) ; | |
6116 | INC(i) | |
6117 | END ; | |
6118 | IF ReturnType#NulSym | |
6119 | THEN | |
6120 | p(ReturnType) | |
6121 | END | |
6122 | END WalkProcTypeDependants ; | |
6123 | ||
6124 | ||
6125 | (* | |
6126 | IsProcedureDependants - | |
6127 | *) | |
6128 | ||
6129 | PROCEDURE IsProcedureDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
6130 | VAR | |
6131 | i, son : CARDINAL ; | |
6132 | type, | |
6133 | ReturnType: CARDINAL ; | |
6134 | result : BOOLEAN ; | |
6135 | BEGIN | |
6136 | result := TRUE ; | |
6137 | Assert(IsProcedure(sym)) ; | |
6138 | i := 1 ; | |
6139 | ReturnType := GetSType(sym) ; | |
6140 | WHILE GetNth(sym, i)#NulSym DO | |
6141 | son := GetNth(sym, i) ; | |
6142 | type := GetSType(son) ; | |
6143 | IF NOT q(type) | |
6144 | THEN | |
6145 | result := FALSE | |
6146 | END ; | |
6147 | INC(i) | |
6148 | END ; | |
6149 | IF (ReturnType=NulSym) OR q(ReturnType) | |
6150 | THEN | |
6151 | RETURN( result ) | |
6152 | ELSE | |
6153 | RETURN( FALSE ) | |
6154 | END | |
6155 | END IsProcedureDependants ; | |
6156 | ||
6157 | ||
6158 | (* | |
6159 | WalkProcedureDependants - walks dependants, sym. | |
6160 | *) | |
6161 | ||
6162 | PROCEDURE WalkProcedureDependants (sym: CARDINAL; p: WalkAction) ; | |
6163 | VAR | |
6164 | i, son : CARDINAL ; | |
6165 | type, | |
6166 | ReturnType: CARDINAL ; | |
6167 | BEGIN | |
6168 | Assert(IsProcedure(sym)) ; | |
6169 | i := 1 ; | |
6170 | ReturnType := GetSType(sym) ; | |
6171 | WHILE GetNth(sym, i)#NulSym DO | |
6172 | son := GetNth(sym, i) ; | |
6173 | type := GetSType(son) ; | |
6174 | p(type) ; | |
6175 | INC(i) | |
6176 | END ; | |
6177 | IF ReturnType#NulSym | |
6178 | THEN | |
6179 | p(ReturnType) | |
6180 | END | |
6181 | END WalkProcedureDependants ; | |
6182 | ||
6183 | ||
6184 | (* | |
6185 | IsUnboundedDependants - returns TRUE if the symbol, sym, | |
6186 | q(dependants) all return TRUE. | |
6187 | *) | |
6188 | ||
6189 | PROCEDURE IsUnboundedDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
6190 | VAR | |
6191 | result: BOOLEAN ; | |
6192 | BEGIN | |
6193 | result := TRUE ; | |
6194 | IF NOT q(GetUnboundedRecordType(sym)) | |
6195 | THEN | |
6196 | result := FALSE | |
6197 | END ; | |
6198 | IF NOT q(Cardinal) | |
6199 | THEN | |
6200 | result := FALSE | |
6201 | END ; | |
6202 | IF NOT q(GetSType(sym)) | |
6203 | THEN | |
6204 | result := FALSE | |
6205 | END ; | |
6206 | RETURN( result ) | |
6207 | END IsUnboundedDependants ; | |
6208 | ||
6209 | ||
6210 | (* | |
6211 | WalkUnboundedDependants - walks the dependants of, sym. | |
6212 | *) | |
6213 | ||
6214 | PROCEDURE WalkUnboundedDependants (sym: CARDINAL; p: WalkAction) ; | |
6215 | BEGIN | |
6216 | p(GetUnboundedRecordType(sym)) ; | |
6217 | p(Cardinal) ; | |
6218 | p(GetSType(sym)) | |
6219 | END WalkUnboundedDependants ; | |
6220 | ||
6221 | ||
6222 | (* | |
6223 | IsTypeDependants - returns TRUE if all q(dependants) return | |
6224 | TRUE. | |
6225 | *) | |
6226 | ||
6227 | PROCEDURE IsTypeDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ; | |
6228 | VAR | |
6229 | align: CARDINAL ; | |
6230 | type : CARDINAL ; | |
6231 | final: BOOLEAN ; | |
6232 | BEGIN | |
6233 | type := GetSType(sym) ; | |
6234 | final := TRUE ; | |
6235 | IF (type#NulSym) AND (NOT q(type)) | |
6236 | THEN | |
6237 | final := FALSE | |
6238 | END ; | |
6239 | align := GetAlignment(sym) ; | |
6240 | IF (align#NulSym) AND (NOT q(align)) | |
6241 | THEN | |
6242 | final := FALSE | |
6243 | END ; | |
6244 | RETURN( final ) | |
6245 | END IsTypeDependants ; | |
6246 | ||
6247 | ||
6248 | (* | |
6249 | WalkTypeDependants - walks all dependants of, sym. | |
6250 | *) | |
6251 | ||
6252 | PROCEDURE WalkTypeDependants (sym: CARDINAL; p: WalkAction) ; | |
6253 | VAR | |
6254 | align: CARDINAL ; | |
6255 | type : CARDINAL ; | |
6256 | BEGIN | |
6257 | type := GetSType(sym) ; | |
6258 | IF type#NulSym | |
6259 | THEN | |
6260 | p(type) | |
6261 | END ; | |
6262 | align := GetAlignment(sym) ; | |
6263 | IF align#NulSym | |
6264 | THEN | |
6265 | p(align) | |
6266 | END | |
6267 | END WalkTypeDependants ; | |
6268 | ||
6269 | ||
6270 | (* | |
6271 | PoisonSymbols - poisons all gcc symbols from procedure, sym. | |
6272 | A debugging aid. | |
6273 | *) | |
6274 | ||
6275 | PROCEDURE PoisonSymbols (sym: CARDINAL) ; | |
6276 | BEGIN | |
6277 | IF IsProcedure(sym) | |
6278 | THEN | |
6279 | ForeachLocalSymDo(sym, Poison) | |
6280 | END | |
6281 | END PoisonSymbols ; | |
6282 | ||
6283 | ||
6284 | (* | |
6285 | ConstantKnownAndUsed - | |
6286 | *) | |
6287 | ||
6288 | PROCEDURE ConstantKnownAndUsed (sym: CARDINAL; t: Tree) ; | |
6289 | BEGIN | |
6290 | DeclareConstantFromTree(sym, RememberConstant(t)) | |
6291 | END ConstantKnownAndUsed ; | |
6292 | ||
6293 | ||
6294 | (* | |
6295 | InitM2LinkModule - | |
6296 | *) | |
6297 | ||
6298 | PROCEDURE InitM2LinkModule ; | |
6299 | BEGIN | |
6300 | M2LinkIndex := NIL | |
6301 | END InitM2LinkModule ; | |
6302 | ||
6303 | ||
6304 | (* | |
6305 | InitDeclarations - initializes default types and the source filename. | |
6306 | *) | |
6307 | ||
6308 | PROCEDURE InitDeclarations ; | |
6309 | BEGIN | |
6310 | DeclareDefaultTypes ; | |
6311 | DeclareDefaultConstants | |
6312 | END InitDeclarations ; | |
6313 | ||
6314 | ||
6315 | BEGIN | |
6316 | ToDoList := InitSet(1) ; | |
6317 | FullyDeclared := InitSet(1) ; | |
6318 | PartiallyDeclared := InitSet(1) ; | |
6319 | NilTypedArrays := InitSet(1) ; | |
6320 | HeldByAlignment := InitSet(1) ; | |
6321 | FinishedAlignment := InitSet(1) ; | |
6322 | ToBeSolvedByQuads := InitSet(1) ; | |
6323 | ChainedList := InitSet(1) ; | |
6324 | WatchList := InitSet(1) ; | |
6325 | VisitedList := NIL ; | |
6326 | EnumerationIndex := InitIndex(1) ; | |
6327 | IncludeElementIntoSet(WatchList, 8) ; | |
6328 | HaveInitDefaultTypes := FALSE ; | |
6329 | recursionCaught := FALSE ; | |
6330 | InitM2LinkModule | |
6331 | END M2GCCDeclare. |