1 (* SymbolTable.mod provides access to the symbol table.
3 Copyright (C) 2001-2023 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
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)
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.
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/>. *)
22 IMPLEMENTATION MODULE SymbolTable ;
25 FROM SYSTEM IMPORT ADDRESS, ADR ;
26 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
27 FROM M2Debug IMPORT Assert ;
28 FROM libc IMPORT printf ;
31 FROM Indexing IMPORT InitIndex, InBounds, LowIndice, HighIndice, PutIndice, GetIndice ;
32 FROM Sets IMPORT Set, InitSet, IncludeElementIntoSet, IsElementInSet ;
33 FROM m2linemap IMPORT location_t ;
35 FROM M2Options IMPORT Pedantic, ExtendedOpaque, DebugFunctionLineNumbers, ScaffoldDynamic, DebugBuiltins ;
37 FROM M2LexBuf IMPORT UnknownTokenNo, TokenToLineNo,
38 FindFileNameFromToken, TokenToLocation ;
40 FROM M2ALU IMPORT InitValue, PtrToValue, PushCard, PopInto,
41 PushString, PushFrom, PushChar, PushInt,
42 IsSolved, IsValueConst ;
44 FROM M2Error IMPORT Error, NewError, ChainError, InternalError,
45 ErrorFormat0, ErrorFormat1, ErrorFormat2,
46 WriteFormat0, WriteFormat1, WriteFormat2, ErrorString,
47 ErrorAbort0, FlushErrors, ErrorScope, GetCurrentErrorScope ;
49 FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3, MetaErrors1,
52 MetaErrorStringT0, MetaErrorStringT1,
53 MetaErrorT1, MetaErrorT2 ;
55 FROM M2LexBuf IMPORT GetTokenNo ;
56 FROM FormatStrings IMPORT Sprintf1 ;
57 FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ;
59 FROM DynamicStrings IMPORT String, string, InitString,
60 InitStringCharStar, Mark, KillString, Length, ConCat,
63 FROM Lists IMPORT List, InitList, GetItemFromList, PutItemIntoList,
64 IsItemInList, IncludeItemIntoList, NoOfItemsInList,
65 RemoveItemFromList, ForeachItemInListDo ;
67 FROM NameKey IMPORT Name, MakeKey, makekey, NulName, WriteKey, LengthKey, GetKey, KeyToCharStar ;
69 FROM SymbolKey IMPORT NulKey, SymbolTree, IsSymbol,
71 GetSymKey, PutSymKey, DelSymKey, IsEmptyTree,
72 DoesTreeContainAny, ForeachNodeDo, ForeachNodeConditionDo,
75 FROM M2Base IMPORT MixTypes, InitBase, Char, Integer, LongReal,
76 Cardinal, LongInt, LongCard, ZType, RType ;
78 FROM M2System IMPORT Address ;
79 FROM m2expr IMPORT OverflowZType ;
80 FROM m2tree IMPORT Tree ;
81 FROM m2linemap IMPORT BuiltinsLocation ;
82 FROM StrLib IMPORT StrEqual ;
83 FROM m2builtins IMPORT BuiltinExists ;
85 FROM M2Comp IMPORT CompilingDefinitionModule,
86 CompilingImplementationModule ;
88 FROM FormatStrings IMPORT HandleEscape ;
89 FROM M2Scaffold IMPORT DeclareArgEnvParams ;
91 FROM M2SymInit IMPORT InitDesc, InitSymInit, GetInitialized, ConfigSymInit,
92 SetInitialized, SetFieldInitialized, GetFieldInitialized,
99 DebugUnknowns = FALSE ;
102 The Unbounded is a pseudo type used within the compiler
103 to implement dynamic parameter arrays. It is implmented
104 as a record structure which has the following fields:
107 _m2_contents: POINTER TO type ;
108 _m2_high : CARDINAL ;
112 UnboundedAddressName = "_m2_contents" ;
113 UnboundedHighName = "_m2_high_%d" ;
116 ConstLitPoolEntry = POINTER TO RECORD
120 constType: CARDINAL ;
121 next : ConstLitPoolEntry ;
124 LRLists = ARRAY [RightValue..LeftValue] OF List ;
126 LRInitDesc = ARRAY [RightValue..LeftValue] OF InitDesc ;
128 TypeOfSymbol = (RecordSym, VarientSym, DummySym,
129 VarSym, EnumerationSym, SubrangeSym, ArraySym,
130 ConstStringSym, ConstVarSym, ConstLitSym,
131 VarParamSym, ParamSym, PointerSym,
132 UndefinedSym, TypeSym,
133 RecordFieldSym, VarientFieldSym, EnumerationFieldSym,
134 DefImpSym, ModuleSym, SetSym, ProcedureSym, ProcTypeSym,
135 SubscriptSym, UnboundedSym, GnuAsmSym, InterfaceSym,
136 ObjectSym, PartialUnboundedSym, TupleSym, OAFamilySym,
137 ImportSym, ImportStatementSym,
138 EquivSym, ErrorSym) ;
143 FirstUsed : CARDINAL ;
147 IsPacked : BOOLEAN ; (* is this type packed? *)
148 PackedEquiv : CARDINAL ; (* the equivalent packed type *)
151 PtrToAsmConstraint = POINTER TO RECORD
154 str : CARDINAL ; (* regnames or constraints *)
155 obj : CARDINAL ; (* list of M2 syms *)
159 ctor: CARDINAL ; (* Procedure which will become a ctor. *)
160 init: CARDINAL ; (* Module initialization block proc. *)
161 fini: CARDINAL ; (* Module Finalization block proc. *)
162 dep : CARDINAL ; (* Module dependency proc. *)
165 (* Each import list has a import statement symbol. *)
167 SymImportStatement = RECORD
168 listNo : CARDINAL ; (* The import list no. *)
169 ListOfImports: List ; (* Vector of SymImports. *)
170 at : Where ; (* The FROM or IMPORT token. *)
174 module : CARDINAL ; (* The module imported. *)
175 listNo : CARDINAL ; (* The import list no. *)
176 qualified: BOOLEAN ; (* Is the complete module imported? *)
177 at : Where ; (* token corresponding to the *)
178 (* module name in the import. *)
182 packedInfo: PackedInfo ;
183 nonPacked : CARDINAL ;
187 MaxDimensions: CARDINAL ;
188 SimpleType : CARDINAL ;
189 Dimensions : Indexing.Index ;
195 list : Indexing.Index ;
200 At : Where ; (* Where was sym declared/used *)
205 At : Where ; (* Where was sym declared/used *)
208 SymUndefined = RECORD
209 name : Name ; (* Index into name array, name *)
211 oafamily : CARDINAL ; (* The oafamily for this sym *)
212 errorScope: ErrorScope ; (* Title scope used if an *)
213 (* error is emitted. *)
214 At : Where ; (* Where was sym declared/used *)
218 String : CARDINAL ; (* (ConstString) the assembly *)
220 At : Where ; (* Where was sym declared/used *)
223 Trashed : CARDINAL ; (* The interface symbols. *)
224 Volatile : BOOLEAN ; (* Declared as ASM VOLATILE ? *)
225 Simple : BOOLEAN ; (* is a simple kind? *)
228 SymInterface = RECORD
229 Parameters: Indexing.Index ;
230 (* regnames or constraints *)
231 (* list of M2 syms. *)
232 At : Where ; (* Where was sym declared/used *)
236 Size : PtrToValue ; (* Size at runtime of symbol. *)
237 ListOfSons : List ; (* ListOfSons contains a list *)
238 (* of SymRecordField and *)
240 (* declared by the source *)
242 DeclPacked : BOOLEAN ; (* Is this varient packed? *)
243 DeclResolved: BOOLEAN ; (* has we resolved packed? *)
244 Parent : CARDINAL ; (* Points to the parent symbol *)
245 Varient : CARDINAL ; (* Index into symbol table to *)
246 (* determine the associated *)
247 (* varient symbol. *)
248 tag : CARDINAL ; (* The tag of the varient *)
249 (* this can either be a type *)
250 (* or a varient field. *)
251 Scope : CARDINAL ; (* Scope of declaration. *)
252 At : Where ; (* Where was sym declared/used *)
256 name : Name ; (* Index into name array, name *)
258 LocalSymbols : SymbolTree ; (* Contains all record fields. *)
259 Size : PtrToValue ; (* Size at runtime of symbol. *)
260 ListOfSons : List ; (* ListOfSons contains a list *)
261 (* of SymRecordField and *)
263 (* declared by the source *)
265 Align : CARDINAL ; (* The alignment of this type. *)
266 DefaultAlign : CARDINAL ; (* The default field alignment *)
267 DeclPacked : BOOLEAN ; (* Is this record packed? *)
268 DeclResolved : BOOLEAN ; (* has we resolved packed? *)
269 oafamily : CARDINAL ; (* The oafamily for this sym. *)
270 Parent : CARDINAL ; (* Points to the parent symbol *)
271 Scope : CARDINAL ; (* Scope of declaration. *)
272 At : Where ; (* Where was sym declared/used *)
276 name : Name ; (* Index into name array, name *)
278 Low : CARDINAL ; (* Index to symbol for lower *)
279 High : CARDINAL ; (* Index to symbol for higher *)
280 Size : PtrToValue ; (* Size of subrange type. *)
281 Type : CARDINAL ; (* Index to type symbol for *)
282 (* the type of subrange. *)
283 Align : CARDINAL ; (* Alignment for this type. *)
284 ConstLitTree: SymbolTree ; (* constants of this type. *)
285 packedInfo : PackedInfo ; (* the equivalent packed type *)
286 oafamily : CARDINAL ; (* The oafamily for this sym *)
287 Scope : CARDINAL ; (* Scope of declaration. *)
288 At : Where ; (* Where was sym declared/used *)
293 name : Name ; (* Index into name array, name *)
294 (* of enumeration. *)
295 NoOfElements: CARDINAL ; (* No elements in enumeration *)
296 LocalSymbols: SymbolTree ; (* Contains all enumeration *)
297 (* fields (alphabetical). *)
298 ListOfFields: List ; (* Ordered as declared. *)
299 Size : PtrToValue ; (* Size at runtime of symbol. *)
300 packedInfo : PackedInfo ; (* the equivalent packed type *)
301 oafamily : CARDINAL ; (* The oafamily for this sym *)
302 Scope : CARDINAL ; (* Scope of declaration. *)
303 At : Where ; (* Where was sym declared/used *)
307 name : Name ; (* Index into name array, name *)
309 Subscript : CARDINAL ; (* the subscript for this *)
311 Size : PtrToValue ; (* Size at runtime of symbol. *)
312 Offset : PtrToValue ; (* Offset at runtime of symbol *)
313 Type : CARDINAL ; (* Type of the Array. *)
314 Align : CARDINAL ; (* Alignment for this type. *)
315 Large : BOOLEAN ; (* is this a large array? *)
316 oafamily : CARDINAL ; (* The oafamily for this sym *)
317 Scope : CARDINAL ; (* Scope of declaration. *)
318 At : Where ; (* Where was sym declared/used *)
321 SymSubscript = RECORD
322 Type : CARDINAL ; (* Index to a subrange symbol. *)
323 Size : PtrToValue ; (* Size of this indice in*Size *)
324 Offset : PtrToValue ; (* Offset at runtime of symbol *)
325 (* Pseudo ie: Offset+Size*i *)
326 (* 1..n. The array offset is *)
327 (* the real memory offset. *)
328 (* This offset allows the a[i] *)
329 (* to be calculated without *)
330 (* the need to perform *)
331 (* subtractions when a[4..10] *)
332 (* needs to be indexed. *)
333 At : Where ; (* Where was sym declared/used *)
336 SymUnbounded = RECORD
337 Type : CARDINAL ; (* Index to Simple type symbol *)
338 Size : PtrToValue ;(* Max No of words ever *)
339 (* passed to this type. *)
340 RecordType : CARDINAL ; (* Record type used to *)
341 (* implement the unbounded. *)
342 Dimensions : CARDINAL ; (* No of dimensions this
344 Scope : CARDINAL ; (* Scope of declaration. *)
345 At : Where ; (* Where was sym declared/used *)
348 SymPartialUnbounded = RECORD
349 Type: CARDINAL ; (* Index to Simple type symbol *)
350 NDim: CARDINAL ; (* dimensions associated *)
355 name : Name ; (* Index into name array, name *)
357 ListOfParam : List ; (* Contains a list of all the *)
358 (* parameters in this procedure. *)
359 ParamDefined : BOOLEAN ; (* Have the parameters been *)
361 DefinedInDef : BOOLEAN ; (* Were the parameters defined *)
362 (* in the Definition module? *)
363 (* Note that this depends on *)
364 (* whether the compiler has read *)
365 (* the .def or .mod first. *)
366 (* The second occurence is *)
367 (* compared to the first. *)
368 DefinedInImp : BOOLEAN ; (* Were the parameters defined *)
369 (* in the Implementation module? *)
370 (* Note that this depends on *)
371 (* whether the compiler has read *)
372 (* the .def or .mod first. *)
373 (* The second occurence is *)
374 (* compared to the first. *)
375 HasVarArgs : BOOLEAN ; (* Does this procedure use ... ? *)
376 HasOptArg : BOOLEAN ; (* Does this procedure use [ ] ? *)
377 OptArgInit : CARDINAL ; (* The optarg initial value. *)
378 IsBuiltin : BOOLEAN ; (* Was it declared __BUILTIN__ ? *)
379 BuiltinName : Name ; (* name of equivalent builtin *)
380 IsInline : BOOLEAN ; (* Was it declared __INLINE__ ? *)
381 IsNoReturn : BOOLEAN ; (* Attribute noreturn ? *)
382 ReturnOptional: BOOLEAN ; (* Is the return value optional? *)
383 IsExtern : BOOLEAN ; (* Make this procedure extern. *)
384 IsPublic : BOOLEAN ; (* Make this procedure visible. *)
385 IsCtor : BOOLEAN ; (* Is this procedure a ctor? *)
386 IsMonoName : BOOLEAN ; (* Ignores module name prefix. *)
387 Unresolved : SymbolTree ; (* All symbols currently *)
388 (* unresolved in this procedure. *)
389 ScopeQuad : CARDINAL ; (* Index into quads for scope *)
390 StartQuad : CARDINAL ; (* Index into quads for start *)
392 EndQuad : CARDINAL ; (* Index into quads for end of *)
394 Reachable : BOOLEAN ; (* Defines if procedure will *)
395 (* ever be called by the main *)
397 SavePriority : BOOLEAN ; (* Does procedure need to save *)
398 (* and restore interrupts? *)
399 ReturnType : CARDINAL ; (* Return type for function. *)
400 Offset : CARDINAL ; (* Location of procedure used *)
401 (* in Pass 2 and if procedure *)
403 LocalSymbols: SymbolTree ; (* Contains all symbols declared *)
404 (* within this procedure. *)
405 EnumerationScopeList: List ;
406 (* Enumeration scope list which *)
407 (* contains a list of all *)
408 (* enumerations which are *)
409 (* visable within this scope. *)
410 ListOfVars : List ; (* List of variables in this *)
412 ListOfProcs : List ; (* List of all procedures *)
413 (* declared within this *)
415 NamedObjects : SymbolTree ; (* Names of all items declared. *)
416 Size : PtrToValue ; (* Activation record size. *)
417 TotalParamSize: PtrToValue ; (* size of all parameters. *)
419 ExceptionBlock: BOOLEAN ; (* does it have an exception? *)
420 Scope : CARDINAL ; (* Scope of declaration. *)
421 errorScope : ErrorScope ; (* The title scope. *)
422 ListOfModules : List ; (* List of all inner modules. *)
423 Begin, End : CARDINAL ; (* Tokens marking the BEGIN END *)
424 At : Where ; (* Where was sym declared/used *)
429 name : Name ; (* Index into name array, name *)
431 ListOfParam : List ; (* Contains a list of all the *)
432 (* parameters in this procedure. *)
433 HasVarArgs : BOOLEAN ; (* Does this proc type use ... ? *)
434 HasOptArg : BOOLEAN ; (* Does this procedure use [ ] ? *)
435 OptArgInit : CARDINAL ; (* The optarg initial value. *)
436 ReturnType : CARDINAL ; (* Return type for function. *)
437 ReturnOptional: BOOLEAN ; (* Is the return value optional? *)
438 Scope : CARDINAL ; (* Scope of declaration. *)
439 Size : PtrToValue ; (* Runtime size of symbol. *)
440 TotalParamSize: PtrToValue ; (* size of all parameters. *)
441 oafamily : CARDINAL ; (* The oafamily for this sym *)
442 At : Where ; (* Where was sym declared/used *)
446 name : Name ; (* Index into name array, name *)
448 Type : CARDINAL ; (* Index to the type of param. *)
449 IsUnbounded : BOOLEAN ; (* Is it an ARRAY OF Type? *)
450 ShadowVar : CARDINAL ; (* The local variable used to *)
451 (* shadow this parameter. *)
452 At : Where ; (* Where was sym declared/used *)
456 name : Name ; (* Index into name array, name *)
458 Type : CARDINAL ;(* Index to the type of param. *)
459 IsUnbounded : BOOLEAN ; (* Is it an ARRAY OF Type? *)
460 HeapVar : CARDINAL ;(* The pointer value on heap. *)
461 (* Only used by static *)
463 ShadowVar : CARDINAL ;(* The local variable used to *)
464 (* shadow this parameter. *)
465 At : Where ; (* Where was sym declared/used *)
468 ConstStringVariant = (m2str, cstr, m2nulstr, cnulstr) ;
472 name : Name ; (* Index into name array, name *)
474 Contents : Name ; (* Contents of the string. *)
475 Length : CARDINAL ; (* StrLen (Contents) *)
479 NulCVariant : CARDINAL ; (* variants of the same string *)
480 StringVariant : ConstStringVariant ;
481 Scope : CARDINAL ; (* Scope of declaration. *)
482 At : Where ; (* Where was sym declared/used *)
486 name : Name ; (* Index into name array, name *)
488 Value : PtrToValue ; (* Value of the constant. *)
489 Type : CARDINAL ; (* TYPE of constant, char etc *)
490 IsSet : BOOLEAN ; (* is the constant a set? *)
491 IsConstructor: BOOLEAN ; (* is the constant a set? *)
492 FromType : CARDINAL ; (* type is determined FromType *)
493 RangeError : BOOLEAN ; (* Have we reported an error? *)
494 UnresFromType: BOOLEAN ; (* is Type unresolved? *)
495 Scope : CARDINAL ; (* Scope of declaration. *)
496 At : Where ; (* Where was sym declared/used *)
500 name : Name ; (* Index into name array, name *)
502 Value : PtrToValue ; (* Value of the constant *)
503 Type : CARDINAL ; (* TYPE of constant, char etc *)
504 IsSet : BOOLEAN ; (* is the constant a set? *)
505 IsConstructor: BOOLEAN ; (* is the constant a set? *)
506 FromType : CARDINAL ; (* type is determined FromType *)
507 UnresFromType: BOOLEAN ; (* is Type resolved? *)
508 IsTemp : BOOLEAN ; (* is it a temporary? *)
509 Scope : CARDINAL ; (* Scope of declaration. *)
510 At : Where ; (* Where was sym declared/used *)
514 name : Name ; (* Index into name array, name *)
516 Type : CARDINAL ; (* Index to a type symbol. *)
517 BackType : CARDINAL ; (* specific back end symbol. *)
518 Size : PtrToValue ; (* Runtime size of symbol. *)
519 Offset : PtrToValue ; (* Offset at runtime of symbol *)
520 AddrMode : ModeOfAddr ; (* Type of Addressing mode. *)
521 Scope : CARDINAL ; (* Scope of declaration. *)
522 AtAddress : BOOLEAN ; (* Is declared at address? *)
523 Address : CARDINAL ; (* Address at which declared *)
524 IsComponentRef: BOOLEAN ; (* Is temporary referencing a *)
526 list : Indexing.Index ; (* the record and fields *)
527 IsTemp : BOOLEAN ; (* Is variable a temporary? *)
528 IsParam : BOOLEAN ; (* Is variable a parameter? *)
529 IsPointerCheck: BOOLEAN ; (* Is variable used to *)
530 (* dereference a pointer? *)
531 IsWritten : BOOLEAN ; (* Is variable written to? *)
532 IsSSA : BOOLEAN ; (* Is variable a SSA? *)
533 IsConst : BOOLEAN ; (* Is variable read/only? *)
534 ArrayRef : BOOLEAN ; (* Is variable used to point *)
536 Heap : BOOLEAN ; (* Is var on the heap? *)
537 InitState : LRInitDesc ; (* Initialization state. *)
538 At : Where ; (* Where was sym declared/used *)
539 ReadUsageList, (* list of var read quads *)
540 WriteUsageList: LRLists ; (* list of var write quads *)
544 name : Name ; (* Index into name array, name *)
546 Type : CARDINAL ; (* Index to a type symbol. *)
547 IsHidden : BOOLEAN ; (* Was it declared as hidden? *)
548 ConstLitTree: SymbolTree ; (* constants of this type. *)
549 Size : PtrToValue ; (* Runtime size of symbol. *)
550 packedInfo : PackedInfo ; (* the equivalent packed type *)
551 oafamily : CARDINAL ; (* The oafamily for this sym *)
552 Align : CARDINAL ; (* The alignment of this type *)
553 Scope : CARDINAL ; (* Scope of declaration. *)
554 At : Where ; (* Where was sym declared/used *)
559 name : Name ; (* Index into name array, name *)
561 Type : CARDINAL ; (* Index to a type symbol. *)
562 Size : PtrToValue ; (* Runtime size of symbol. *)
563 Align : CARDINAL ; (* The alignment of this type *)
564 ConstLitTree: SymbolTree ; (* constants of this type. *)
565 oafamily : CARDINAL ; (* The oafamily for this sym *)
566 Scope : CARDINAL ; (* Scope of declaration. *)
567 At : Where ; (* Where was sym declared/used *)
572 name : Name ; (* Index into name array, name *)
573 (* of record field. *)
574 Type : CARDINAL ; (* Index to a type symbol. *)
575 Tag : BOOLEAN ; (* is the record field really *)
577 Size : PtrToValue ; (* Runtime size of symbol. *)
578 Offset : PtrToValue ; (* Offset at runtime of symbol *)
579 Parent : CARDINAL ; (* Index into symbol table to *)
580 (* determine the parent symbol *)
581 (* for this record field. Used *)
582 (* for BackPatching. *)
583 Varient : CARDINAL ; (* Index into symbol table to *)
584 (* determine the associated *)
585 (* varient symbol. *)
586 Align : CARDINAL ; (* The alignment of this type *)
587 Used : BOOLEAN ; (* pragma usused unsets this. *)
588 DeclPacked: BOOLEAN ; (* Is this declared packed? *)
589 DeclResolved: BOOLEAN ; (* has we resolved packed? *)
590 Scope : CARDINAL ; (* Scope of declaration. *)
591 At : Where ; (* Where was sym declared/used *)
596 name : Name ; (* Index into name array, name *)
597 (* of varient field (internal) *)
598 Size : PtrToValue ; (* Runtime size of symbol. *)
599 Offset : PtrToValue ; (* Offset at runtime of symbol *)
600 Parent : CARDINAL ; (* Index into symbol table to *)
601 (* determine the parent symbol *)
602 (* for this record field. Used *)
603 (* for BackPatching. *)
604 Varient : CARDINAL ; (* Index into symbol table to *)
605 (* determine the associated *)
606 (* varient symbol. *)
607 ListOfSons: List ; (* Contains a list of the *)
608 (* RecordField symbols and *)
610 DeclPacked: BOOLEAN ; (* Is this varient field *)
612 DeclResolved: BOOLEAN ; (* is it resolved? *)
613 Scope : CARDINAL ; (* Scope of declaration. *)
614 At : Where ; (* Where was sym declared/used *)
617 SymEnumerationField =
619 name : Name ; (* Index into name array, name *)
620 (* of enumeration field. *)
621 Value : PtrToValue ; (* Enumeration field value. *)
622 Type : CARDINAL ; (* Index to the enumeration. *)
623 Scope : CARDINAL ; (* Scope of declaration. *)
624 At : Where ; (* Where was sym declared/used *)
628 name : Name ; (* Index into name array, name *)
630 Type : CARDINAL ; (* Index to a type symbol. *)
631 (* (subrange or enumeration). *)
632 packedInfo: PackedInfo ; (* the equivalent packed type *)
634 Size : PtrToValue ; (* Runtime size of symbol. *)
635 oafamily : CARDINAL ; (* The oafamily for this sym *)
636 Scope : CARDINAL ; (* Scope of declaration. *)
637 At : Where ; (* Where was sym declared/used *)
642 name : Name ; (* Index into name array, name *)
643 (* of record field. *)
644 libname : Name ; (* Library (dialect) with module *)
645 ctors : ModuleCtor ; (* All the ctor functions. *)
647 ModListOfDep : List ; (* Vector of SymDependency. *)
648 ExportQualifiedTree: SymbolTree ;
649 (* Holds all the export *)
650 (* Qualified identifiers. *)
651 (* This tree may be *)
652 (* deleted at the end of Pass 1. *)
653 ExportUnQualifiedTree: SymbolTree ;
654 (* Holds all the export *)
655 (* UnQualified identifiers. *)
656 (* This tree may be *)
657 (* deleted at the end of Pass 1. *)
658 ExportRequest : SymbolTree ; (* Contains all identifiers that *)
659 (* have been requested by other *)
660 (* modules before this module *)
661 (* declared its export list. *)
662 (* This tree should be empty at *)
663 (* the end of the compilation. *)
664 (* Each time a symbol is *)
665 (* exported it is removed from *)
667 IncludeList : List ; (* Contains all included symbols *)
668 (* which are included by *)
669 (* IMPORT modulename ; *)
670 (* modulename.Symbol *)
671 DefIncludeList: List ; (* Contains all included symbols *)
672 (* which are included by *)
673 (* IMPORT modulename ; *)
674 (* in the definition module only *)
675 ImportTree : SymbolTree ; (* Contains all IMPORTed *)
677 ExportUndeclared: SymbolTree ;
678 (* ExportUndeclared contains all *)
679 (* the identifiers which were *)
680 (* exported but have not yet *)
682 NeedToBeImplemented: SymbolTree ;
683 (* NeedToBeImplemented contains *)
684 (* the identifiers which have *)
685 (* been exported and declared *)
686 (* but have not yet been *)
688 LocalSymbols : SymbolTree ; (* The LocalSymbols hold all the *)
689 (* variables declared local to *)
690 (* the block. It contains the *)
692 (* FROM _ IMPORT x, y, x ; *)
694 (* MODULE WeAreHere ; *)
695 (* x y z visible by localsym *)
697 (* EXPORT x, y, z ; *)
700 EnumerationScopeList: List ; (* Enumeration scope list which *)
701 (* contains a list of all *)
702 (* enumerations which are *)
703 (* visible within this scope. *)
704 NamedObjects : SymbolTree ; (* Names of all items declared. *)
705 NamedImports : SymbolTree ; (* Names of items imported. *)
706 WhereImported : SymbolTree ; (* Sym to TokenNo where import *)
707 (* occurs. Error message use. *)
708 Priority : CARDINAL ; (* Priority of the module. This *)
709 (* is an index to a constant. *)
710 Unresolved : SymbolTree ; (* All symbols currently *)
711 (* unresolved in this module. *)
712 StartQuad : CARDINAL ; (* Signify the initialization *)
714 EndQuad : CARDINAL ; (* EndQuad should point to a *)
716 StartFinishQuad: CARDINAL ; (* Signify the finalization *)
718 EndFinishQuad : CARDINAL ; (* should point to a finish *)
719 FinallyFunction: Tree ; (* The GCC function for finally *)
721 ExceptionBlock: BOOLEAN ; (* does it have an exception? *)
722 ContainsHiddenType: BOOLEAN ;(* True if this module *)
723 (* implements a hidden type. *)
724 ContainsBuiltin: BOOLEAN ; (* Does the module define a *)
725 (* builtin procedure? *)
726 ForC : BOOLEAN ; (* Is it a definition for "C" *)
727 NeedExportList: BOOLEAN ; (* Must user supply export list? *)
728 ModLink, (* Is the Def/Mod module parsed *)
729 DefLink : BOOLEAN ; (* for linkage only? *)
730 Builtin : BOOLEAN ; (* Is the module builtin? *)
731 ListOfVars : List ; (* List of variables in this *)
733 ListOfProcs : List ; (* List of all procedures *)
734 (* declared within this module. *)
735 ListOfModules : List ; (* List of all inner modules. *)
736 errorScope : ErrorScope ; (* The title scope. *)
737 At : Where ; (* Where was sym declared/used *)
742 name : Name ; (* Index into name array, name *)
743 (* of record field. *)
744 libname : Name ; (* Library (dialect) with module *)
745 ctors : ModuleCtor ; (* All the ctor functions. *)
746 ModListOfDep : List ; (* Vector of SymDependency. *)
747 LocalSymbols : SymbolTree ; (* The LocalSymbols hold all the *)
748 (* variables declared local to *)
749 (* the block. It contains the *)
751 (* FROM _ IMPORT x, y, x ; *)
753 (* MODULE WeAreHere ; *)
754 (* x y z visible by localsym *)
756 (* EXPORT x, y, z ; *)
759 ExportTree : SymbolTree ; (* Holds all the exported *)
761 (* This tree may be *)
762 (* deleted at the end of Pass 1. *)
763 IncludeList : List ; (* Contains all included symbols *)
764 (* which are included by *)
765 (* IMPORT modulename ; *)
766 (* modulename.Symbol *)
767 ImportTree : SymbolTree ; (* Contains all IMPORTed *)
769 ExportUndeclared: SymbolTree ;
770 (* ExportUndeclared contains all *)
771 (* the identifiers which were *)
772 (* exported but have not yet *)
774 EnumerationScopeList: List ; (* Enumeration scope list which *)
775 (* contains a list of all *)
776 (* enumerations which are *)
777 (* visable within this scope. *)
778 NamedObjects : SymbolTree ; (* Names of all items declared. *)
779 NamedImports : SymbolTree ; (* Names of items imported. *)
780 WhereImported : SymbolTree ; (* Sym to TokenNo where import *)
781 (* occurs. Error message use. *)
782 Scope : CARDINAL ; (* Scope of declaration. *)
783 Priority : CARDINAL ; (* Priority of the module. This *)
784 (* is an index to a constant. *)
785 Unresolved : SymbolTree ; (* All symbols currently *)
786 (* unresolved in this module. *)
787 StartQuad : CARDINAL ; (* Signify the initialization *)
789 EndQuad : CARDINAL ; (* EndQuad should point to a *)
791 StartFinishQuad: CARDINAL ; (* Signify the finalization *)
793 EndFinishQuad : CARDINAL ; (* should point to a finish *)
794 FinallyFunction: Tree ; (* The GCC function for finally *)
796 ExceptionBlock: BOOLEAN ; (* does it have an exception? *)
797 ModLink : BOOLEAN ; (* Is the module parsed for *)
799 Builtin : BOOLEAN ; (* Is the module builtin? *)
800 ListOfVars : List ; (* List of variables in this *)
802 ListOfProcs : List ; (* List of all procedures *)
803 (* declared within this module. *)
804 ListOfModules : List ; (* List of all inner modules. *)
805 errorScope : ErrorScope ; (* The title scope. *)
806 At : Where ; (* Where was sym declared/used *)
811 NextFree : CARDINAL ; (* Link to the next free symbol. *)
816 CASE SymbolType : TypeOfSymbol OF
817 (* Determines the type of symbol *)
819 OAFamilySym : OAFamily : SymOAFamily |
820 ObjectSym : Object : SymObject |
821 EquivSym : Equiv : SymEquiv |
822 RecordSym : Record : SymRecord |
823 VarientSym : Varient : SymVarient |
824 VarSym : Var : SymVar |
825 EnumerationSym : Enumeration : SymEnumeration |
826 SubrangeSym : Subrange : SymSubrange |
827 SubscriptSym : Subscript : SymSubscript |
828 ArraySym : Array : SymArray |
829 UnboundedSym : Unbounded : SymUnbounded |
830 PartialUnboundedSym : PartialUnbounded : SymPartialUnbounded |
831 ConstVarSym : ConstVar : SymConstVar |
832 ConstLitSym : ConstLit : SymConstLit |
833 ConstStringSym : ConstString : SymConstString |
834 VarParamSym : VarParam : SymVarParam |
835 ParamSym : Param : SymParam |
836 ErrorSym : Error : SymError |
837 UndefinedSym : Undefined : SymUndefined |
838 TypeSym : Type : SymType |
839 PointerSym : Pointer : SymPointer |
840 RecordFieldSym : RecordField : SymRecordField |
841 VarientFieldSym : VarientField : SymVarientField |
842 EnumerationFieldSym : EnumerationField : SymEnumerationField |
843 DefImpSym : DefImp : SymDefImp |
844 ModuleSym : Module : SymModule |
845 SetSym : Set : SymSet |
846 ProcedureSym : Procedure : SymProcedure |
847 ProcTypeSym : ProcType : SymProcType |
848 ImportStatementSym : ImportStatement : SymImportStatement |
849 ImportSym : Import : SymImport |
850 GnuAsmSym : GnuAsm : SymGnuAsm |
851 InterfaceSym : Interface : SymInterface |
852 TupleSym : Tuple : SymTuple |
853 DummySym : Dummy : SymDummy
859 Main : CARDINAL ; (* Main scope for insertions *)
860 Search: CARDINAL ; (* Search scope for symbol searches *)
861 Start : CARDINAL ; (* ScopePtr value before StartScope *)
865 PtrToSymbol = POINTER TO Symbol ;
866 PtrToCallFrame = POINTER TO CallFrame ;
868 CheckProcedure = PROCEDURE (CARDINAL) ;
871 Symbols : Indexing.Index ; (* ARRAY [1..MaxSymbols] OF Symbol. *)
872 ScopeCallFrame: Indexing.Index ; (* ARRAY [1..MaxScopes] OF CallFrame. *)
873 FreeSymbol : CARDINAL ; (* The next free symbol indice. *)
874 DefModuleTree : SymbolTree ;
875 ModuleTree : SymbolTree ; (* Tree of all modules ever used. *)
877 : SymbolTree ; (* String Literal Constants only need *)
878 (* to be declared once. *)
879 CurrentModule : CARDINAL ; (* Index into symbols determining the *)
880 (* current module being compiled. *)
881 (* This maybe an inner module. *)
882 MainModule : CARDINAL ; (* Index into symbols determining the *)
883 (* module the user requested to *)
885 FileModule : CARDINAL ; (* Index into symbols determining *)
886 (* which module (file) is being *)
887 (* compiled. (Maybe an import def) *)
888 ScopePtr : CARDINAL ; (* An index to the ScopeCallFrame. *)
889 (* ScopePtr determines the top of the *)
890 (* ScopeCallFrame. *)
891 BaseScopePtr : CARDINAL ; (* An index to the ScopeCallFrame of *)
892 (* the top of BaseModule. BaseModule *)
893 (* is always left at the bottom of *)
894 (* stack since it is used so *)
895 (* frequently. When the BaseModule *)
896 (* needs to be searched the ScopePtr *)
897 (* is temporarily altered to *)
898 (* BaseScopePtr and GetScopeSym is *)
900 BaseModule : CARDINAL ; (* Index to the symbol table of the *)
901 (* Base pseudo modeule declaration. *)
902 TemporaryNo : CARDINAL ; (* The next temporary number. *)
903 CurrentError : Error ; (* Current error chain. *)
904 AddressTypes : List ; (* A list of type symbols which must *)
905 (* be declared as ADDRESS or pointer *)
906 UnresolvedConstructorType: List ; (* all constructors whose type *)
907 (* is not yet known. *)
908 AnonymousName : CARDINAL ; (* anonymous type name unique id *)
909 ReportedUnknowns : Set ; (* set of symbols already reported as *)
910 (* unknowns to the user. *)
911 ConstLitPoolTree : SymbolTree ; (* Pool of constants to ensure *)
912 (* constants are reused between *)
913 (* passes and reduce duplicate *)
915 ConstLitArray : Indexing.Index ;
919 CheckAnonymous - checks to see whether the name is NulName and if so
920 it creates a unique anonymous name.
923 PROCEDURE CheckAnonymous (name: Name) : Name ;
928 name := makekey(string(Mark(Sprintf1(Mark(InitString('$$%d')), AnonymousName))))
935 IsNameAnonymous - returns TRUE if the symbol, sym, has an anonymous name
939 PROCEDURE IsNameAnonymous (sym: CARDINAL) : BOOLEAN ;
941 a: ARRAY [0..1] OF CHAR ;
944 n := GetSymName(sym) ;
950 RETURN( StrEqual(a, '$$') )
952 END IsNameAnonymous ;
956 InitWhereDeclared - sets the Declared and FirstUsed fields of record, at.
959 PROCEDURE InitWhereDeclaredTok (tok: CARDINAL; VAR at: Where) ;
962 IF CompilingDefinitionModule ()
965 ModDeclared := UnknownTokenNo
967 DefDeclared := UnknownTokenNo ;
970 FirstUsed := tok (* we assign this field to something legal *)
972 END InitWhereDeclaredTok ;
976 InitWhereDeclared - sets the Declared and FirstUsed fields of record, at.
979 PROCEDURE InitWhereDeclared (VAR at: Where) ;
981 InitWhereDeclaredTok (GetTokenNo (), at)
982 END InitWhereDeclared ;
986 InitWhereFirstUsed - sets the FirstUsed field of record, at.
989 PROCEDURE InitWhereFirstUsed (VAR at: Where) ;
991 InitWhereFirstUsedTok (GetTokenNo (), at)
992 END InitWhereFirstUsed ;
996 InitWhereFirstUsedTok - sets the FirstUsed field of record, at.
999 PROCEDURE InitWhereFirstUsedTok (tok: CARDINAL; VAR at: Where) ;
1004 END InitWhereFirstUsedTok ;
1008 FinalSymbol - returns the highest number symbol used.
1011 PROCEDURE FinalSymbol () : CARDINAL ;
1013 RETURN( FreeSymbol-1 )
1018 NewSym - Sets Sym to a new symbol index.
1021 PROCEDURE NewSym (VAR sym: CARDINAL) ;
1028 SymbolType := DummySym
1030 PutIndice(Symbols, sym, pSym) ;
1036 GetPsym - returns the pointer to, sym.
1039 PROCEDURE GetPsym (sym: CARDINAL) : PtrToSymbol ;
1043 IF InBounds(Symbols, sym)
1045 pSym := GetIndice(Symbols, sym) ;
1048 InternalError ('symbol out of bounds')
1054 GetPcall - returns the pointer to the CallFrame.
1057 PROCEDURE GetPcall (call: CARDINAL) : PtrToCallFrame ;
1059 pCall: PtrToCallFrame ;
1061 IF InBounds(ScopeCallFrame, call)
1063 pCall := GetIndice(ScopeCallFrame, call) ;
1066 InternalError ('symbol out of bounds')
1072 MakeImport - create and return an import symbol.
1073 moduleSym is the symbol being imported.
1074 isqualified is FALSE if it were IMPORT modulename and
1075 TRUE for the qualified FROM modulename IMPORT etc.
1076 listno is the import list count for this module.
1077 tok should match this modulename position.
1080 PROCEDURE MakeImport (tok: CARDINAL;
1081 moduleSym: CARDINAL;
1083 isqualified: BOOLEAN) : CARDINAL ;
1085 importSym: CARDINAL ;
1086 pSym : PtrToSymbol ;
1088 NewSym (importSym) ;
1089 pSym := GetPsym (importSym) ;
1091 SymbolType := ImportSym ;
1093 module := moduleSym ;
1095 qualified := isqualified ;
1096 InitWhereDeclaredTok (tok, at)
1104 MakeImportStatement - return a dependent symbol which represents an import statement
1105 or a qualified import statement. The tok should either match
1106 the FROM token or the IMPORT token. listno is the import list
1107 count for the module.
1110 PROCEDURE MakeImportStatement (tok: CARDINAL; listno: CARDINAL) : CARDINAL ;
1112 dependentSym: CARDINAL ;
1113 pSym : PtrToSymbol ;
1115 NewSym (dependentSym) ;
1116 pSym := GetPsym (dependentSym) ;
1118 SymbolType := ImportStatementSym ;
1119 WITH ImportStatement DO
1121 InitList (ListOfImports) ;
1122 InitWhereDeclaredTok (tok, at)
1126 END MakeImportStatement ;
1130 AppendModuleImportStatement - appends the ImportStatement symbol onto the
1135 FROM x IMPORT y, z ;
1142 will result in a new ImportStatement symbol added
1143 to the current module import list.
1144 The statement symbol is expected to be created
1145 by MakeImportStatement using the token positions
1149 PROCEDURE AppendModuleImportStatement (module, statement: CARDINAL) ;
1153 IF IsDefImp (module)
1155 pSym := GetPsym (module) ;
1156 IF CompilingDefinitionModule ()
1158 IncludeItemIntoList (pSym^.DefImp.DefListOfDep, statement)
1160 IncludeItemIntoList (pSym^.DefImp.ModListOfDep, statement)
1162 ELSIF IsModule (module)
1164 pSym := GetPsym (module) ;
1165 IncludeItemIntoList (pSym^.Module.ModListOfDep, statement)
1167 InternalError ('expecting DefImp or Module symbol')
1169 END AppendModuleImportStatement ;
1173 AppendModuleOnImportStatement - appends the import symbol onto the
1174 dependent list (chain).
1178 FROM x IMPORT y, z ;
1180 x are added to the dependent list.
1186 will result in p, q and r added to
1187 to the dependent list.
1189 The import symbol is created by MakeImport
1190 and the token is expected to match the module
1191 name position outlined above.
1194 PROCEDURE AppendModuleOnImportStatement (module, import: CARDINAL) ;
1197 lastImportStatement: CARDINAL ;
1199 Assert (IsImport (import)) ;
1200 IF CompilingDefinitionModule ()
1202 l := GetModuleDefImportStatementList (module)
1204 l := GetModuleModImportStatementList (module)
1207 Assert (NoOfItemsInList (l) > 0) ; (* There should always be one on the list. *)
1208 lastImportStatement := GetItemFromList (l, NoOfItemsInList (l)) ;
1209 Assert (IsImportStatement (lastImportStatement)) ;
1210 l := GetImportStatementList (lastImportStatement) ;
1211 IncludeItemIntoList (l, import)
1212 END AppendModuleOnImportStatement ;
1216 IsImport - returns TRUE if sym is an import symbol.
1219 PROCEDURE IsImport (sym: CARDINAL) : BOOLEAN ;
1223 pSym := GetPsym (sym) ;
1224 RETURN pSym^.SymbolType=ImportSym
1229 IsImportStatement - returns TRUE if sym is a dependent symbol.
1232 PROCEDURE IsImportStatement (sym: CARDINAL) : BOOLEAN ;
1236 pSym := GetPsym (sym) ;
1237 RETURN pSym^.SymbolType=ImportStatementSym
1238 END IsImportStatement ;
1242 GetImportModule - returns the module associated with the import symbol.
1245 PROCEDURE GetImportModule (sym: CARDINAL) : CARDINAL ;
1249 Assert (IsImport (sym)) ;
1250 pSym := GetPsym (sym) ;
1251 RETURN pSym^.Import.module
1252 END GetImportModule ;
1256 GetImportDeclared - returns the token associated with the import symbol.
1259 PROCEDURE GetImportDeclared (sym: CARDINAL) : CARDINAL ;
1263 Assert (IsImport (sym)) ;
1264 tok := GetDeclaredDefinition (sym) ;
1265 IF tok = UnknownTokenNo
1267 RETURN GetDeclaredModule (sym)
1270 END GetImportDeclared ;
1274 GetImportStatementList - returns the list of imports for this dependent.
1275 Each import symbol corresponds to a module.
1278 PROCEDURE GetImportStatementList (sym: CARDINAL) : List ;
1282 Assert (IsImportStatement (sym)) ;
1283 pSym := GetPsym (sym) ;
1284 RETURN pSym^.ImportStatement.ListOfImports
1285 END GetImportStatementList ;
1289 GetModuleDefImportStatementList - returns the list of dependents associated with
1290 the definition module.
1293 PROCEDURE GetModuleDefImportStatementList (sym: CARDINAL) : List ;
1297 Assert (IsModule (sym) OR IsDefImp (sym)) ;
1300 pSym := GetPsym (sym) ;
1301 RETURN pSym^.DefImp.DefListOfDep
1304 END GetModuleDefImportStatementList ;
1308 GetModuleModImportStatementList - returns the list of dependents associated with
1309 the implementation or program module.
1312 PROCEDURE GetModuleModImportStatementList (sym: CARDINAL) : List ;
1316 Assert (IsModule (sym) OR IsDefImp (sym)) ;
1317 pSym := GetPsym (sym) ;
1320 RETURN pSym^.DefImp.ModListOfDep
1322 RETURN pSym^.Module.ModListOfDep
1324 END GetModuleModImportStatementList ;
1328 DebugProcedureLineNumber -
1331 PROCEDURE DebugProcedureLineNumber (sym: CARDINAL) ;
1333 begin, end: CARDINAL ;
1338 GetProcedureBeginEnd (sym, begin, end) ;
1339 n := GetSymName(sym) ;
1342 f := FindFileNameFromToken (begin, 0) ;
1343 l := TokenToLineNo(begin, 0) ;
1344 printf3 ('%s:%d:%a:begin\n', f, l, n)
1348 f := FindFileNameFromToken (end, 0) ;
1349 l := TokenToLineNo(end, 0) ;
1350 printf3 ('%s:%d:%a:end\n', f, l, n)
1352 END DebugProcedureLineNumber ;
1356 DebugLineNumbers - internal debugging, emit all procedure names in this module
1357 together with the line numbers for the corresponding begin/end
1361 PROCEDURE DebugLineNumbers (sym: CARDINAL) ;
1363 IF DebugFunctionLineNumbers
1365 printf0 ('<lines>\n') ;
1366 ForeachProcedureDo(sym, DebugProcedureLineNumber) ;
1367 printf0 ('</lines>\n')
1369 END DebugLineNumbers ;
1373 IsPartialUnbounded - returns TRUE if, sym, is a partially unbounded symbol.
1376 PROCEDURE IsPartialUnbounded (sym: CARDINAL) : BOOLEAN ;
1382 pSym := GetPsym(sym) ;
1386 PartialUnboundedSym: RETURN( TRUE )
1395 END IsPartialUnbounded ;
1399 PutPartialUnbounded -
1402 PROCEDURE PutPartialUnbounded (sym: CARDINAL; type: CARDINAL; ndim: CARDINAL) ;
1406 pSym := GetPsym(sym) ;
1409 pSym^.SymbolType := PartialUnboundedSym
1414 PartialUnboundedSym: PartialUnbounded.Type := type ;
1415 PartialUnbounded.NDim := ndim
1418 InternalError ('not expecting this type')
1421 END PutPartialUnbounded ;
1425 AlreadyDeclaredError - generate an error message, a, and two areas of code showing
1426 the places where the symbols were declared.
1429 PROCEDURE AlreadyDeclaredError (s: String; name: Name; OtherOccurance: CARDINAL) ;
1433 IF (OtherOccurance=0) OR (OtherOccurance=GetTokenNo())
1435 e := NewError(GetTokenNo()) ;
1438 e := NewError(GetTokenNo()) ;
1440 e := ChainError(OtherOccurance, e) ;
1441 ErrorFormat1(e, 'and symbol (%a) is also declared here', name)
1443 END AlreadyDeclaredError ;
1447 AlreadyImportedError - generate an error message, a, and two areas of code showing
1448 the places where the symbols was imported and also declared.
1452 PROCEDURE AlreadyImportedError (s: String; name: Name; OtherOccurance: CARDINAL) ;
1456 IF (OtherOccurance=0) OR (OtherOccurance=GetTokenNo())
1458 e := NewError(GetTokenNo()) ;
1461 e := NewError(GetTokenNo()) ;
1463 e := ChainError(OtherOccurance, e) ;
1464 ErrorFormat1(e, 'and symbol (%a) was also seen here', name)
1466 END AlreadyImportedError ;
1471 MakeError - creates an error node, which can be used in MetaError messages.
1472 It will be removed from ExportUndeclared and Unknown trees.
1475 PROCEDURE MakeError (tok: CARDINAL; name: Name) : CARDINAL ;
1480 (* if Sym is present on the unknown tree then remove it *)
1481 Sym := FetchUnknownSym (name) ;
1487 remove symbol from this tree as we have already generated
1488 a meaningful error message
1490 RemoveExportUndeclared(GetCurrentModuleScope(), Sym)
1492 pSym := GetPsym(Sym) ;
1494 SymbolType := ErrorSym ;
1495 Error.name := name ;
1496 InitWhereDeclaredTok(tok, Error.At) ;
1497 InitWhereFirstUsedTok(tok, Error.At)
1504 MakeErrorS - creates an error node from a string, which can be used
1505 in MetaError messages.
1506 It will be removed from ExportUndeclared and Unknown trees.
1509 PROCEDURE MakeErrorS (tok: CARDINAL; name: String) : CARDINAL ;
1511 RETURN MakeError (tok, makekey (string (name)))
1516 IsError - returns TRUE if the symbol is an error symbol.
1519 PROCEDURE IsError (Sym: CARDINAL) : BOOLEAN ;
1524 pSym := GetPsym(Sym) ;
1525 RETURN( pSym^.SymbolType=ErrorSym )
1530 MakeObject - creates an object node.
1533 PROCEDURE MakeObject (name: Name) : CARDINAL ;
1539 pSym := GetPsym(Sym) ;
1541 SymbolType := ObjectSym ;
1542 Object.name := name ;
1543 InitWhereDeclared(Object.At) ;
1544 InitWhereFirstUsed(Object.At)
1551 IsTuple - returns TRUE if the symbol is a tuple symbol.
1554 PROCEDURE IsTuple (Sym: CARDINAL) : BOOLEAN ;
1559 pSym := GetPsym(Sym) ;
1560 RETURN( pSym^.SymbolType=TupleSym )
1565 IsObject - returns TRUE if the symbol is an object symbol.
1568 PROCEDURE IsObject (Sym: CARDINAL) : BOOLEAN ;
1573 pSym := GetPsym(Sym) ;
1574 RETURN( pSym^.SymbolType=ObjectSym )
1579 DeclareSym - returns a symbol which was either in the unknown tree or
1580 a New symbol, since name is about to be declared.
1583 PROCEDURE DeclareSym (tok: CARDINAL; name: Name) : CARDINAL ;
1590 ELSIF IsAlreadyDeclaredSym (name)
1592 Sym := GetSym (name) ;
1593 IF IsImported (GetCurrentModuleScope (), Sym)
1595 MetaErrorT1 (GetWhereImported(Sym),
1596 'symbol {%1Rad} is already present in this scope, check both definition and implementation modules, use a different name or remove the import',
1598 MetaErrorT1 (tok, 'symbol {%1Cad} also declared in this module', Sym) ;
1599 IF Sym # GetVisibleSym (name)
1601 MetaErrorT1 (tok, 'symbol {%1CMad} also declared in this module', GetVisibleSym (name))
1604 MetaErrorT1 (tok, 'symbol {%1RMad} is already declared in this scope, use a different name or remove the declaration', Sym) ;
1605 MetaErrorT1 (tok, 'symbol {%1Cad} also declared in this module', Sym) ;
1606 IF Sym # GetVisibleSym(name)
1608 MetaErrorT1(tok, 'symbol {%1CMad} also declared in this module', GetVisibleSym (name))
1611 Sym := MakeError (tok, name)
1613 Sym := FetchUnknownSym (name) ;
1618 CheckForExportedDeclaration (Sym)
1625 Init - Initializes the data structures and variables in this module.
1626 Initialize the trees.
1631 pCall: PtrToCallFrame ;
1633 AnonymousName := 0 ;
1634 CurrentError := NIL ;
1635 InitTree (ConstLitPoolTree) ;
1636 InitTree (ConstLitStringTree) ;
1637 InitTree (DefModuleTree) ;
1638 InitTree (ModuleTree) ;
1639 Symbols := InitIndex (1) ;
1640 ConstLitArray := InitIndex (1) ;
1643 ScopeCallFrame := InitIndex(1) ;
1649 PutIndice(ScopeCallFrame, ScopePtr, pCall) ;
1650 CurrentModule := NulSym ;
1651 MainModule := NulSym ;
1652 FileModule := NulSym ;
1655 InitList(FreeFVarientList) ; (* Lists used to maintain GC of field *)
1656 InitList(UsedFVarientList) ; (* varients. *)
1658 InitList(UnresolvedConstructorType) ;
1660 InitBase(BuiltinsLocation(), BaseModule) ;
1661 StartScope(BaseModule) ; (* BaseModule scope placed at the bottom of the stack *)
1662 BaseScopePtr := ScopePtr ; (* BaseScopePtr points to the top of the BaseModule scope *)
1663 InitList(AddressTypes) ;
1664 ReportedUnknowns := InitSet(1)
1669 FromModuleGetSym - attempts to find a symbol of name, n, in the
1670 module, mod, scope. An unknown symbol is created
1671 at token position tok if necessary.
1674 PROCEDURE FromModuleGetSym (tok: CARDINAL; n: Name; mod: CARDINAL) : CARDINAL ;
1678 OldScopePtr: CARDINAL ;
1680 OldScopePtr := ScopePtr ;
1682 sym := RequestSym (tok, n) ;
1686 (* --fixme-- can sym ever be NulSym? *)
1687 n1 := GetSymName(mod) ;
1688 WriteFormat2('cannot find procedure %a in module, %a',
1691 ScopePtr := OldScopePtr ;
1693 END FromModuleGetSym ;
1700 PROCEDURE AddSymToUnknown (scope: CARDINAL; name: Name; Sym: CARDINAL) ;
1707 n := GetSymName(scope) ;
1708 printf3('adding unknown %a (%d) to scope %a\n', name, Sym, n)
1711 (* Add symbol to unknown tree *)
1712 pSym := GetPsym(scope) ;
1716 DefImpSym : PutSymKey(DefImp.Unresolved, name, Sym) |
1717 ModuleSym : PutSymKey(Module.Unresolved, name, Sym) |
1718 ProcedureSym: PutSymKey(Procedure.Unresolved, name, Sym)
1721 InternalError ('expecting DefImp, Module or Procedure symbol')
1724 END AddSymToUnknown ;
1728 AddSymToUnknownTree - adds a symbol with name, name, and Sym to the
1732 PROCEDURE AddSymToUnknownTree (ScopeId: INTEGER; name: Name; Sym: CARDINAL) ;
1734 pCall : PtrToCallFrame ;
1735 ScopeSym: CARDINAL ;
1739 (* choose to place the unknown symbol in the first module scope
1740 outside the current scope *)
1742 pCall := GetPcall(ScopeId) ;
1743 ScopeSym := pCall^.Main ;
1744 IF (ScopeSym>0) AND (IsDefImp(ScopeSym) OR IsModule(ScopeSym))
1746 AddSymToUnknown(ScopeSym, name, Sym) ;
1752 AddSymToUnknown(CurrentModule, name, Sym)
1753 END AddSymToUnknownTree ;
1757 SubSymFromUnknownTree - removes a symbol with name, name, from the
1761 PROCEDURE SubSymFromUnknownTree (name: Name) ;
1763 pCall : PtrToCallFrame ;
1765 ScopeId : CARDINAL ;
1769 ScopeId := ScopePtr ;
1771 pCall := GetPcall(ScopeId) ;
1772 ScopeSym := pCall^.Search ;
1773 IF IsModule(ScopeSym) OR IsDefImp(ScopeSym) OR IsProcedure(ScopeSym)
1775 IF RemoveFromUnresolvedTree(ScopeSym, name)
1781 UNTIL (ScopeId>0) AND (IsModule(ScopeSym) OR IsDefImp(ScopeSym))
1783 IF RemoveFromUnresolvedTree(CurrentModule, name)
1786 END SubSymFromUnknownTree ;
1790 GetSymFromUnknownTree - returns a symbol with name, name, from the
1792 If no symbol with name is found then NulSym
1796 PROCEDURE GetSymFromUnknownTree (name: Name) : CARDINAL ;
1798 pCall : PtrToCallFrame ;
1805 ScopeId := ScopePtr ;
1807 pCall := GetPcall(ScopeId) ;
1808 ScopeSym := pCall^.Search ;
1809 IF IsModule(ScopeSym) OR IsDefImp(ScopeSym) OR IsProcedure(ScopeSym)
1811 Sym := ExamineUnresolvedTree(ScopeSym, name) ;
1818 UNTIL (ScopeId>0) AND (IsModule(ScopeSym) OR IsDefImp(ScopeSym))
1820 (* Get symbol from unknown tree *)
1821 RETURN( ExamineUnresolvedTree(CurrentModule, name) )
1822 END GetSymFromUnknownTree ;
1826 ExamineUnresolvedTree - returns a symbol with name, name, from the
1827 unresolved tree of module, ModSym.
1828 If no symbol with name is found then NulSym
1832 PROCEDURE ExamineUnresolvedTree (ScopeSym: CARDINAL; name: Name) : CARDINAL ;
1837 (* Get symbol from unknown tree *)
1838 pSym := GetPsym(ScopeSym) ;
1842 DefImpSym : Sym := GetSymKey(DefImp.Unresolved, name) |
1843 ModuleSym : Sym := GetSymKey(Module.Unresolved, name) |
1844 ProcedureSym: Sym := GetSymKey(Procedure.Unresolved, name)
1847 InternalError ('expecting DefImp, Module or Procedure symbol')
1851 END ExamineUnresolvedTree ;
1855 TryMoveUndeclaredSymToInnerModule - attempts to move a symbol of
1856 name, name, which is
1857 currently undefined in the
1858 outer scope to the inner scope.
1859 If successful then the symbol is
1860 returned otherwise NulSym is
1864 PROCEDURE TryMoveUndeclaredSymToInnerModule (OuterScope,
1865 InnerScope: CARDINAL;
1866 name: Name) : CARDINAL ;
1871 (* assume this should not be called if OuterScope was a procedure
1872 as this case is handled by the caller (P1SymBuild)
1874 Assert(IsModule(OuterScope) OR IsDefImp(OuterScope)) ;
1875 sym := GetExportUndeclared(OuterScope, name) ;
1878 Assert(IsUnknown(sym)) ;
1879 RemoveExportUndeclared(OuterScope, sym) ;
1880 AddSymToModuleScope(OuterScope, sym) ;
1881 AddVarToScopeList(OuterScope, sym) ;
1882 pSym := GetPsym(OuterScope) ;
1886 DefImpSym: IF GetSymKey(DefImp.Unresolved, name)=sym
1888 DelSymKey(DefImp.Unresolved, name)
1890 ModuleSym: IF GetSymKey(Module.Unresolved, name)=sym
1892 DelSymKey(Module.Unresolved, name)
1896 InternalError ('expecting DefImp, Module symbol')
1899 AddSymToUnknown(InnerScope, name, sym) ;
1900 PutExportUndeclared(InnerScope, sym)
1903 END TryMoveUndeclaredSymToInnerModule ;
1907 RemoveFromUnresolvedTree - removes a symbol with name, name, from the
1908 unresolved tree of symbol, ScopeSym.
1911 PROCEDURE RemoveFromUnresolvedTree (ScopeSym: CARDINAL; name: Name) : BOOLEAN ;
1915 (* Get symbol from unknown tree *)
1916 pSym := GetPsym(ScopeSym) ;
1920 DefImpSym : IF GetSymKey(DefImp.Unresolved, name)#NulKey
1922 DelSymKey(DefImp.Unresolved, name) ;
1925 ModuleSym : IF GetSymKey(Module.Unresolved, name)#NulKey
1927 DelSymKey(Module.Unresolved, name) ;
1930 ProcedureSym: IF GetSymKey(Procedure.Unresolved, name)#NulKey
1932 DelSymKey(Procedure.Unresolved, name) ;
1937 InternalError ('expecting DefImp, Module or Procedure symbol')
1941 END RemoveFromUnresolvedTree ;
1945 FetchUnknownSym - returns a symbol from the unknown tree if one is
1946 available. It also updates the unknown tree.
1949 PROCEDURE FetchUnknownSym (name: Name) : CARDINAL ;
1953 Sym := GetSymFromUnknownTree(name) ;
1956 SubSymFromUnknownTree(name)
1959 END FetchUnknownSym ;
1963 TransparentScope - returns true is the scope symbol Sym is allowed
1964 to look to an outer level for a symbol.
1965 ie is the symbol allowed to look to the parent
1969 PROCEDURE TransparentScope (Sym: CARDINAL) : BOOLEAN ;
1973 pSym := GetPsym(Sym) ;
1975 RETURN( (SymbolType#DefImpSym) AND (SymbolType#ModuleSym) )
1977 END TransparentScope ;
1981 AddSymToModuleScope - adds a symbol, Sym, to the scope of the module
1985 PROCEDURE AddSymToModuleScope (ModSym: CARDINAL; Sym: CARDINAL) ;
1989 pSym := GetPsym(ModSym) ;
1993 DefImpSym : IF GetSymKey(DefImp.LocalSymbols, GetSymName(Sym))=NulKey
1995 PutSymKey(DefImp.LocalSymbols, GetSymName(Sym), Sym)
1997 MetaError1 ('{%kIMPORT} name clash with symbol {%1Ead} symbol already declared ', Sym)
1999 ModuleSym : IF GetSymKey(Module.LocalSymbols, GetSymName(Sym))=NulKey
2001 PutSymKey(Module.LocalSymbols, GetSymName(Sym), Sym)
2003 MetaError1 ('{%kIMPORT} name clash with symbol {%1Ead} symbol already declared ', Sym)
2005 ProcedureSym: IF GetSymKey(Procedure.LocalSymbols, GetSymName(Sym))=NulKey
2007 PutSymKey(Procedure.LocalSymbols, GetSymName(Sym), Sym)
2009 MetaError1 ('{%kIMPORT} name clash with symbol {%1Ead} symbol already declared ', Sym)
2013 InternalError ('expecting Module or DefImp symbol')
2016 END AddSymToModuleScope ;
2020 GetCurrentModuleScope - returns the module symbol which forms the
2021 current (possibly inner most) module.
2024 PROCEDURE GetCurrentModuleScope () : CARDINAL ;
2026 pCall: PtrToCallFrame ;
2030 pCall := GetPcall(i) ;
2031 WHILE (NOT IsModule(pCall^.Search)) AND
2032 (NOT IsDefImp(pCall^.Search)) DO
2035 pCall := GetPcall(i)
2037 RETURN( pCall^.Search )
2038 END GetCurrentModuleScope ;
2042 GetLastModuleScope - returns the last module scope encountered,
2043 the module scope before the Current Module Scope.
2046 PROCEDURE GetLastModuleScope () : CARDINAL ;
2048 pCall: PtrToCallFrame ;
2052 pCall := GetPcall(i) ;
2053 WHILE (NOT IsModule(pCall^.Search)) AND
2054 (NOT IsDefImp(pCall^.Search)) DO
2057 pCall := GetPcall(i)
2059 (* Found module at position, i. *)
2060 DEC(i) ; (* Move to an outer level module scope *)
2061 pCall := GetPcall(i) ;
2062 WHILE (NOT IsModule(pCall^.Search)) AND
2063 (NOT IsDefImp(pCall^.Search)) DO
2066 pCall := GetPcall(i)
2068 (* Found module at position, i. *)
2069 RETURN( pCall^.Search )
2070 END GetLastModuleScope ;
2074 GetLastModuleOrProcedureScope - returns the last module or procedure scope encountered,
2075 the scope before the current module scope.
2078 PROCEDURE GetLastModuleOrProcedureScope () : CARDINAL ;
2080 pCall: PtrToCallFrame ;
2083 (* find current inner module *)
2085 pCall := GetPcall(i) ;
2086 WHILE (NOT IsModule(pCall^.Search)) AND
2087 (NOT IsDefImp(pCall^.Search)) DO
2090 pCall := GetPcall(i)
2092 (* found module at position, i. *)
2093 DEC(i) ; (* Move to an outer level module or procedure scope *)
2094 pCall := GetPcall(i) ;
2095 WHILE (NOT IsModule(pCall^.Search)) AND
2096 (NOT IsDefImp(pCall^.Search)) AND
2097 (NOT IsProcedure(pCall^.Search)) DO
2100 pCall := GetPcall(i)
2102 (* Found module at position, i. *)
2103 RETURN( pCall^.Search )
2104 END GetLastModuleOrProcedureScope ;
2108 AddSymToScope - adds a symbol Sym with name name to
2109 the current scope symbol tree.
2112 PROCEDURE AddSymToScope (Sym: CARDINAL; name: Name) ;
2114 pSym : PtrToSymbol ;
2115 pCall : PtrToCallFrame ;
2118 pCall := GetPcall(ScopePtr) ;
2119 ScopeId := pCall^.Main ;
2121 WriteString('Adding ') ; WriteKey(name) ; WriteString(' :') ; WriteCard(Sym, 4) ; WriteString(' to scope: ') ;
2122 WriteKey(GetSymName(ScopeId)) ; WriteLn ;
2124 pSym := GetPsym(ScopeId) ;
2128 DefImpSym : IF name#NulName
2130 PutSymKey(DefImp.LocalSymbols, name, Sym)
2132 IF IsEnumeration(Sym)
2134 CheckEnumerationInList(DefImp.EnumerationScopeList, Sym)
2136 ModuleSym : IF name#NulName
2138 PutSymKey(Module.LocalSymbols, name, Sym)
2140 IF IsEnumeration(Sym)
2142 CheckEnumerationInList(Module.EnumerationScopeList, Sym)
2144 ProcedureSym: IF name#NulName
2146 PutSymKey(Procedure.LocalSymbols, name, Sym)
2148 IF IsEnumeration(Sym)
2150 CheckEnumerationInList(Procedure.EnumerationScopeList, Sym)
2154 InternalError ('should never get here')
2161 GetCurrentScope - returns the symbol who is responsible for the current
2162 scope. Note that it ignore pseudo scopes.
2165 PROCEDURE GetCurrentScope () : CARDINAL ;
2167 pCall: PtrToCallFrame ;
2169 pCall := GetPcall(ScopePtr) ;
2170 RETURN( pCall^.Main )
2171 END GetCurrentScope ;
2175 StartScope - starts a block scope at Sym. Transparent determines
2176 whether the search for a symbol will look at the
2177 previous ScopeCallFrame if Sym does not contain the
2178 symbol that GetSym is searching.
2180 WITH statements are partially implemented by calling
2181 StartScope. Therefore we must retain the old Main from
2182 the previous ScopePtr when a record is added to the scope
2183 stack. (Main contains the symbol where all identifiers
2187 PROCEDURE StartScope (Sym: CARDINAL) ;
2190 pCall: PtrToCallFrame ;
2192 Sym := SkipType(Sym) ;
2194 WriteString('New scope is: ') ; WriteKey(GetSymName(Sym)) ; WriteLn ;
2197 IF InBounds(ScopeCallFrame, ScopePtr)
2199 pCall := GetPcall(ScopePtr)
2202 PutIndice(ScopeCallFrame, ScopePtr, pCall)
2205 Start := ScopePtr-1 ; (* Previous ScopePtr value before StartScope *)
2208 (* If Sym is a record then maintain the old Main scope for adding *)
2209 (* new symbols to ie temporary variables. *)
2212 oCall := GetPcall(ScopePtr-1) ;
2216 PlaceMajorScopesEnumerationListOntoStack(Sym)
2219 (* ; DisplayScopes *)
2224 PlaceMajorScopesEnumerationListOntoStack - places the DefImp, Module and
2225 Procedure symbols enumeration
2226 list onto the scope stack.
2229 PROCEDURE PlaceMajorScopesEnumerationListOntoStack (Sym: CARDINAL) ;
2233 pSym := GetPsym(Sym) ;
2237 DefImpSym : PlaceEnumerationListOntoScope(DefImp.EnumerationScopeList) |
2238 ModuleSym : PlaceEnumerationListOntoScope(Module.EnumerationScopeList) |
2239 ProcedureSym: PlaceEnumerationListOntoScope(Procedure.EnumerationScopeList)
2242 InternalError ('expecting - DefImp, Module or Procedure symbol')
2245 END PlaceMajorScopesEnumerationListOntoStack ;
2249 PlaceEnumerationListOntoScope - places an enumeration list, l, onto the
2250 scope stack. This list will automatically
2251 removed via one call to EndScope which
2252 matches the StartScope by which this
2253 procedure is invoked.
2256 PROCEDURE PlaceEnumerationListOntoScope (l: List) ;
2260 n := NoOfItemsInList(l) ;
2263 PseudoScope(GetItemFromList(l, i)) ;
2266 END PlaceEnumerationListOntoScope ;
2270 EndScope - ends a block scope started by StartScope. The current
2271 head of the symbol scope reverts back to the symbol
2272 which was the Head of the symbol scope before the
2273 last StartScope was called.
2276 PROCEDURE EndScope ;
2278 pCall: PtrToCallFrame ;
2281 ; WriteString('EndScope - ending scope: ') ;
2282 pCall := GetPcall(ScopePtr) ;
2283 ; WriteKey(GetSymName(pCall^.Search)) ; WriteLn ;
2285 pCall := GetPcall(ScopePtr) ;
2286 ScopePtr := pCall^.Start
2287 (* ; DisplayScopes *)
2292 PseudoScope - starts a pseudo scope at Sym.
2293 We always connect parent up to the last scope,
2294 to determine the transparancy of a scope we call
2297 A Pseudo scope has no end block,
2298 but is terminated when the next EndScope is used.
2299 The function of the pseudo scope is to provide an
2300 automatic mechanism to solve enumeration types.
2301 A declared enumeration type is a Pseudo scope and
2302 identifiers used with the name of an enumeration
2303 type field will find the enumeration symbol by
2304 the scoping algorithm.
2307 PROCEDURE PseudoScope (Sym: CARDINAL) ;
2310 pCall: PtrToCallFrame ;
2312 IF IsEnumeration(Sym)
2315 IF InBounds(ScopeCallFrame, ScopePtr)
2317 pCall := GetPcall(ScopePtr)
2320 PutIndice(ScopeCallFrame, ScopePtr, pCall)
2323 oCall := GetPcall(ScopePtr-1) ;
2324 Main := oCall^.Main ;
2325 Start := oCall^.Start ;
2329 InternalError ('expecting EnumerationSym')
2335 IsDeclaredIn - returns TRUE if a symbol was declared in, scope.
2338 PROCEDURE IsDeclaredIn (scope, sym: CARDINAL) : BOOLEAN ;
2342 s := GetScope(sym) ;
2344 IF (s=NulSym) OR IsProcedure(s) OR IsModule(s) OR IsDefImp(s)
2356 SetFirstUsed - assigns the FirstUsed field in at to tok providing
2357 it has not already been set.
2360 PROCEDURE SetFirstUsed (tok: CARDINAL; VAR at: Where) ;
2362 IF at.FirstUsed = UnknownTokenNo
2370 PutFirstUsed - sets tok to the first used providing it has not already been set.
2371 It also includes the read and write quad into the usage list
2372 providing the quad numbers are not 0.
2375 PROCEDURE PutFirstUsed (object: CARDINAL; tok: CARDINAL; read, write: CARDINAL) ;
2381 pSym := GetPsym (object) ;
2382 SetFirstUsed (tok, pSym^.Var.At) ;
2385 PutReadQuad (object, GetMode (object), read)
2389 PutWriteQuad (object, GetMode (object), write)
2396 MakeGnuAsm - create a GnuAsm symbol.
2399 PROCEDURE MakeGnuAsm () : CARDINAL ;
2405 pSym := GetPsym (Sym) ;
2407 SymbolType := GnuAsmSym ;
2410 InitWhereDeclared (At) ;
2423 PutGnuAsm - places the instruction textual name into the GnuAsm symbol.
2426 PROCEDURE PutGnuAsm (sym: CARDINAL; string: CARDINAL) ;
2430 Assert (IsConstString (string)) ;
2431 pSym := GetPsym(sym) ;
2435 GnuAsmSym: GnuAsm.String := string
2438 InternalError ('expecting PutGnuAsm symbol')
2445 GetGnuAsm - returns the string symbol, representing the instruction textual
2446 of the GnuAsm symbol. It will return a ConstString.
2449 PROCEDURE GetGnuAsm (sym: CARDINAL) : CARDINAL ;
2453 pSym := GetPsym(sym) ;
2457 GnuAsmSym: RETURN GnuAsm.String
2460 InternalError ('expecting GnuAsm symbol')
2467 PutGnuAsmOutput - places the interface object, out, into GnuAsm symbol, sym.
2470 PROCEDURE PutGnuAsmOutput (sym: CARDINAL; out: CARDINAL) ;
2474 pSym := GetPsym(sym) ;
2478 GnuAsmSym: GnuAsm.Outputs := out
2481 InternalError ('expecting PutGnuAsm symbol')
2484 END PutGnuAsmOutput ;
2488 PutGnuAsmInput - places the interface object, in, into GnuAsm symbol, sym.
2491 PROCEDURE PutGnuAsmInput (sym: CARDINAL; in: CARDINAL) ;
2495 pSym := GetPsym (sym) ;
2499 GnuAsmSym: GnuAsm.Inputs := in
2502 InternalError ('expecting PutGnuAsm symbol')
2505 END PutGnuAsmInput ;
2509 PutGnuAsmTrash - places the interface object, trash, into GnuAsm symbol, sym.
2512 PROCEDURE PutGnuAsmTrash (sym: CARDINAL; trash: CARDINAL) ;
2516 pSym := GetPsym (sym) ;
2520 GnuAsmSym: GnuAsm.Trashed := trash
2523 InternalError ('expecting PutGnuAsm symbol')
2526 END PutGnuAsmTrash ;
2530 GetGnuAsmInput - returns the input list of registers.
2533 PROCEDURE GetGnuAsmInput (sym: CARDINAL) : CARDINAL ;
2537 pSym := GetPsym (sym) ;
2541 GnuAsmSym: RETURN GnuAsm.Inputs
2544 InternalError ('expecting PutGnuAsm symbol')
2547 END GetGnuAsmInput ;
2551 GetGnuAsmOutput - returns the output list of registers.
2554 PROCEDURE GetGnuAsmOutput (sym: CARDINAL) : CARDINAL ;
2558 pSym := GetPsym (sym) ;
2562 GnuAsmSym: RETURN GnuAsm.Outputs
2565 InternalError ('expecting PutGnuAsm symbol')
2568 END GetGnuAsmOutput ;
2572 GetGnuAsmTrash - returns the list of trashed registers.
2575 PROCEDURE GetGnuAsmTrash (sym: CARDINAL) : CARDINAL ;
2579 pSym := GetPsym (sym) ;
2583 GnuAsmSym: RETURN GnuAsm.Trashed
2586 InternalError ('expecting PutGnuAsm symbol')
2589 END GetGnuAsmTrash ;
2593 PutGnuAsmVolatile - defines a GnuAsm symbol as VOLATILE.
2596 PROCEDURE PutGnuAsmVolatile (Sym: CARDINAL) ;
2600 pSym := GetPsym (Sym) ;
2604 GnuAsmSym: GnuAsm.Volatile := TRUE
2607 InternalError ('expecting GnuAsm symbol')
2610 END PutGnuAsmVolatile ;
2614 PutGnuAsmSimple - defines a GnuAsm symbol as a simple kind.
2617 PROCEDURE PutGnuAsmSimple (Sym: CARDINAL) ;
2621 pSym := GetPsym (Sym) ;
2625 GnuAsmSym: GnuAsm.Simple := TRUE
2628 InternalError ('expecting GnuAsm symbol')
2631 END PutGnuAsmSimple ;
2635 MakeRegInterface - creates and returns a register interface symbol.
2638 PROCEDURE MakeRegInterface () : CARDINAL ;
2644 pSym := GetPsym (Sym) ;
2646 SymbolType := InterfaceSym ;
2648 Parameters := InitIndex (1) ;
2649 InitWhereDeclared (At)
2653 END MakeRegInterface ;
2657 PutRegInterface - places a, name, string, and, object, into the interface array,
2658 sym, at position, i.
2659 The string symbol will either be a register name or a constraint.
2660 The object is an optional Modula-2 variable or constant symbol.
2661 read and write are the quadruple numbers representing any read
2665 PROCEDURE PutRegInterface (tok: CARDINAL;
2666 sym: CARDINAL; i: CARDINAL; n: Name; string, object: CARDINAL;
2667 read, write: CARDINAL) ;
2669 pSym : PtrToSymbol ;
2670 p : PtrToAsmConstraint ;
2672 pSym := GetPsym(sym) ;
2676 InterfaceSym: IF Indexing.InBounds(Interface.Parameters, i)
2678 p := Indexing.GetIndice(Interface.Parameters, i)
2679 ELSIF i=Indexing.HighIndice(Interface.Parameters)+1
2682 Indexing.PutIndice(Interface.Parameters, i, p)
2684 InternalError ('expecting to add parameters sequentially')
2692 PutFirstUsed (object, tok, read, write)
2695 InternalError ('expecting Interface symbol')
2698 END PutRegInterface ;
2702 GetRegInterface - gets a, name, string, and, object, from the interface array,
2703 sym, from position, i.
2706 PROCEDURE GetRegInterface (sym: CARDINAL; i: CARDINAL;
2707 VAR tok: CARDINAL; VAR n: Name; VAR string, object: CARDINAL) ;
2710 p : PtrToAsmConstraint ;
2712 pSym := GetPsym(sym) ;
2716 InterfaceSym: IF Indexing.InBounds(Interface.Parameters, i)
2718 p := Indexing.GetIndice(Interface.Parameters, i) ;
2726 tok := UnknownTokenNo ;
2733 InternalError ('expecting Interface symbol')
2736 END GetRegInterface ;
2740 GetSubrange - returns HighSym and LowSym - two constants which make up the
2744 PROCEDURE GetSubrange (Sym: CARDINAL; VAR HighSym, LowSym: CARDINAL) ;
2748 pSym := GetPsym(Sym) ;
2752 SubrangeSym: HighSym := Subrange.High ;
2753 LowSym := Subrange.Low
2756 InternalError ('expecting Subrange symbol')
2763 PutSubrange - places LowSym and HighSym as two symbols
2764 which provide the limits of the range.
2767 PROCEDURE PutSubrange (Sym: CARDINAL; LowSym, HighSym: CARDINAL;
2768 TypeSymbol: CARDINAL) ;
2772 pSym := GetPsym(Sym) ;
2776 SubrangeSym: Subrange.Low := LowSym ; (* Index to symbol for lower *)
2777 Subrange.High := HighSym ; (* Index to symbol for higher *)
2778 Subrange.Type := TypeSymbol ; (* Index to type symbol for *)
2779 (* the type of subrange. *)
2781 InternalError ('expecting Subrange symbol')
2788 SetCurrentModule - Used to set the CurrentModule to a symbol, Sym.
2789 This Sym must represent the module name of the
2790 file currently being compiled.
2793 PROCEDURE SetCurrentModule (Sym: CARDINAL) ;
2795 CurrentModule := Sym
2796 END SetCurrentModule ;
2800 GetCurrentModule - returns the current module Sym that is being
2804 PROCEDURE GetCurrentModule () : CARDINAL ;
2806 RETURN( CurrentModule )
2807 END GetCurrentModule ;
2811 SetMainModule - Used to set the MainModule to a symbol, Sym.
2812 This Sym must represent the main module which was
2813 envoked by the user to be compiled.
2816 PROCEDURE SetMainModule (Sym: CARDINAL) ;
2823 GetMainModule - returns the main module symbol that was requested by
2824 the user to be compiled.
2827 PROCEDURE GetMainModule () : CARDINAL ;
2829 RETURN( MainModule )
2834 SetFileModule - Used to set the FileModule to a symbol, Sym.
2835 This Sym must represent the current program module
2836 file which is being parsed.
2839 PROCEDURE SetFileModule (Sym: CARDINAL) ;
2846 GetFileModule - returns the FileModule symbol that was requested by
2847 the user to be compiled.
2850 PROCEDURE GetFileModule () : CARDINAL ;
2852 RETURN( FileModule )
2857 GetBaseModule - returns the base module symbol that contains Modula-2
2858 base types, procedures and functions.
2861 PROCEDURE GetBaseModule () : CARDINAL ;
2863 RETURN( BaseModule )
2868 GetSym - searches the current scope (and previous scopes if the
2869 scope tranparent allows) for a symbol with name.
2872 PROCEDURE GetSym (name: Name) : CARDINAL ;
2875 OldScopePtr: CARDINAL ;
2877 Sym := GetScopeSym(name, TRUE) ;
2880 (* Check default base types for symbol *)
2881 OldScopePtr := ScopePtr ; (* Save ScopePtr *)
2882 ScopePtr := BaseScopePtr ; (* Alter ScopePtr to point to top of BaseModule *)
2883 Sym := GetScopeSym(name, FALSE) ; (* Search BaseModule for name *)
2884 ScopePtr := OldScopePtr (* Restored ScopePtr *)
2891 CanLookThroughScope - by default this procedure returns TRUE. It only returns
2892 FALSE if, throughProcedure, is FALSE and the ScopeSym is
2896 PROCEDURE CanLookThroughScope (ScopeSym: CARDINAL; throughProcedure: BOOLEAN) : BOOLEAN ;
2898 IF IsProcedure(ScopeSym)
2900 RETURN( throughProcedure )
2904 END CanLookThroughScope ;
2908 GetScopeSym - searches the current scope and below, providing that the
2909 scopes are transparent, for a symbol with name, name.
2910 It only passes over procedure scopes if, throughProcedure,
2914 PROCEDURE GetScopeSym (name: Name; throughProcedure: BOOLEAN) : CARDINAL ;
2916 pCall : PtrToCallFrame ;
2921 (* DisplayScopes ; *)
2922 ScopeId := ScopePtr ;
2923 pCall := GetPcall(ScopeId) ;
2924 ScopeSym := pCall^.Search ;
2925 (* WriteString(' scope: ') ; WriteKey(GetSymName(ScopeSym)) ; *)
2926 Sym := CheckScopeForSym(ScopeSym, name) ;
2927 WHILE (ScopeId>0) AND (Sym=NulSym) AND TransparentScope(ScopeSym) AND
2928 CanLookThroughScope(ScopeSym, throughProcedure) DO
2930 pCall := GetPcall(ScopeId) ;
2931 ScopeSym := pCall^.Search ;
2932 Sym := CheckScopeForSym(ScopeSym, name) ;
2933 (* WriteString(' scope: ') ; WriteKey(GetSymName(ScopeSym)) *)
2935 (* IF Sym#NulSym THEN WriteKey(GetSymName(Sym)) END ; WriteLn ; *)
2941 CheckScopeForSym - checks the scope, ScopeSym, for an identifier
2942 of name, name. CheckScopeForSym checks for
2943 the symbol by the GetLocalSym and also
2944 ExamineUnresolvedTree.
2947 PROCEDURE CheckScopeForSym (ScopeSym: CARDINAL; name: Name) : CARDINAL ;
2951 Sym := GetLocalSym(ScopeSym, name) ;
2952 IF (Sym=NulSym) AND (IsModule(ScopeSym) OR IsDefImp(ScopeSym) OR
2953 IsProcedure(ScopeSym))
2955 Sym := ExamineUnresolvedTree(ScopeSym, name)
2958 END CheckScopeForSym ;
2962 DisplayScopes - displays the scopes that will be searched to find
2967 PROCEDURE DisplayScopes ;
2969 pCall: PtrToCallFrame ;
2975 printf0('Displaying scopes\n') ;
2977 pCall := GetPcall(i) ;
2978 Sym := pCall^.Search ;
2979 printf1('Symbol %4d', Sym) ;
2982 n := GetSymName(Sym) ;
2983 printf1(' : name %a is ', n) ;
2984 IF NOT TransparentScope(Sym)
2988 printf0(' transparent\n')
2998 GetModuleScopeId - returns the scope index to the next module starting
3000 Id will either point to a null scope (NulSym) or
3001 alternatively point to a Module or DefImp symbol.
3004 PROCEDURE GetModuleScopeId (Id: CARDINAL) : CARDINAL ;
3006 pCall: PtrToCallFrame ;
3009 pCall := GetPcall(Id) ;
3010 s := pCall^.Search ;
3011 WHILE (Id>0) AND (s#NulSym) AND
3012 ((NOT IsModule(s)) AND
3013 (NOT IsDefImp(s))) DO
3015 pCall := GetPcall(Id) ;
3016 s := pCall^.Search ;
3019 END GetModuleScopeId ;
3026 PROCEDURE GetVisibleSym (name: Name) : CARDINAL ;
3028 pCall: PtrToCallFrame ;
3034 pCall := GetPcall(i) ;
3038 RETURN( GetLocalSym(Main, name) )
3040 IF IsEnumeration(Search)
3042 Sym := GetLocalSym(Search, name) ;
3057 IsAlreadyDeclaredSym - returns true if Sym has already been declared
3058 in the current main scope.
3061 PROCEDURE IsAlreadyDeclaredSym (name: Name) : BOOLEAN ;
3063 pCall: PtrToCallFrame ;
3068 pCall := GetPcall(i) ;
3072 RETURN( GetLocalSym(Main, name)#NulSym )
3074 IF IsEnumeration(Search) AND (GetLocalSym(Search, name)#NulSym)
3083 END IsAlreadyDeclaredSym ;
3087 IsImplicityExported - returns TRUE if, Sym, is implicitly exported from module, ModSym.
3088 ModSym must be a defimp symbol.
3091 PROCEDURE IsImplicityExported (ModSym, Sym: CARDINAL) : BOOLEAN ;
3096 IF IsDefImp(ModSym) AND IsFieldEnumeration(Sym)
3098 pSym := GetPsym(ModSym) ;
3099 type := SkipType(GetType(Sym)) ;
3100 RETURN( IsItemInList(pSym^.DefImp.EnumerationScopeList, type) )
3103 END IsImplicityExported ;
3107 MakeProcedureCtorExtern - creates an extern ctor procedure
3110 PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; libname, modulename: Name) : CARDINAL ;
3114 ctor := MakeProcedure (tokenno, GenName (libname, '_M2_', modulename, '_ctor')) ;
3115 PutExtern (ctor, TRUE) ;
3117 END MakeProcedureCtorExtern ;
3121 GenName - returns a new name consisting of pre, name, post concatenation.
3124 PROCEDURE GenName (libname: Name; pre: ARRAY OF CHAR; name: Name; post: ARRAY OF CHAR) : Name ;
3129 str := InitStringCharStar (KeyToCharStar (libname)) ;
3130 str := ConCat (str, Mark (InitString (pre))) ;
3131 str := ConCat (str, Mark (InitStringCharStar (KeyToCharStar (name)))) ;
3132 str := ConCat (str, InitString (post)) ;
3133 result := makekey (string (str)) ;
3134 str := KillString (str) ;
3140 InitCtor - initialize the ModuleCtor fields to NulSym.
3143 PROCEDURE InitCtor (VAR ctor: ModuleCtor) ;
3145 ctor.ctor := NulSym ;
3146 ctor.dep := NulSym ;
3147 ctor.init := NulSym ;
3153 MakeModuleCtor - for a defimp or module symbol create all the ctor
3157 PROCEDURE MakeModuleCtor (moduleTok, beginTok, finallyTok: CARDINAL;
3158 moduleSym: CARDINAL) ;
3162 Assert (IsDefImp (moduleSym) OR IsModule (moduleSym)) ;
3163 pSym := GetPsym (moduleSym) ;
3164 IF IsDefImp (moduleSym)
3166 InitCtorFields (moduleTok, beginTok, finallyTok,
3168 pSym^.DefImp.ctors, GetSymName (moduleSym),
3171 InitCtorFields (moduleTok, beginTok, finallyTok,
3173 pSym^.Module.ctors, GetSymName (moduleSym),
3174 IsInnerModule (moduleSym), TRUE)
3176 END MakeModuleCtor ;
3180 InitCtorFields - initialize the ModuleCtor fields. An inner module has no
3184 PROCEDURE InitCtorFields (moduleTok, beginTok, finallyTok: CARDINAL;
3185 moduleSym: CARDINAL;
3186 VAR ctor: ModuleCtor; name: Name;
3187 inner, pub: BOOLEAN) ;
3189 IF ScaffoldDynamic AND (NOT inner)
3191 (* The ctor procedure must be public. *)
3192 ctor.ctor := MakeProcedure (moduleTok,
3193 GenName (GetLibName (moduleSym),
3194 "_M2_", name, "_ctor")) ;
3195 PutCtor (ctor.ctor, TRUE) ;
3197 PutPublic (ctor.ctor, pub) ;
3198 PutExtern (ctor.ctor, NOT pub) ;
3199 PutMonoName (ctor.ctor, TRUE) ;
3200 (* The dep procedure is local to the module. *)
3201 ctor.dep := MakeProcedure (moduleTok,
3202 GenName (GetLibName (moduleSym),
3203 "_M2_", name, "_dep")) ;
3204 PutMonoName (ctor.dep, TRUE)
3206 ctor.ctor := NulSym ;
3209 (* The init/fini procedures must be public. *)
3210 ctor.init := MakeProcedure (beginTok,
3211 GenName (GetLibName (moduleSym),
3212 "_M2_", name, "_init")) ;
3213 PutPublic (ctor.init, pub) ;
3214 PutExtern (ctor.init, NOT pub) ;
3215 PutMonoName (ctor.init, NOT inner) ;
3216 DeclareArgEnvParams (beginTok, ctor.init) ;
3217 ctor.fini := MakeProcedure (finallyTok,
3218 GenName (GetLibName (moduleSym),
3219 "_M2_", name, "_fini")) ;
3220 PutPublic (ctor.fini, pub) ;
3221 PutExtern (ctor.fini, NOT pub) ;
3222 PutMonoName (ctor.fini, NOT inner) ;
3223 DeclareArgEnvParams (beginTok, ctor.fini)
3224 END InitCtorFields ;
3228 GetModuleCtors - mod can be a DefImp or Module symbol. ctor, init and fini
3229 are assigned for this module. An inner module ctor value will
3233 PROCEDURE GetModuleCtors (mod: CARDINAL; VAR ctor, init, fini, dep: CARDINAL) ;
3235 pSym : PtrToSymbol ;
3237 pSym := GetPsym (mod) ;
3241 ModuleSym: ctor := Module.ctors.ctor ;
3242 init := Module.ctors.init ;
3243 fini := Module.ctors.fini ;
3244 dep := Module.ctors.dep |
3245 DefImpSym: ctor := DefImp.ctors.ctor ;
3246 init := DefImp.ctors.init ;
3247 fini := DefImp.ctors.fini ;
3248 dep := DefImp.ctors.dep
3251 InternalError ('expecting Module or DefImp symbol')
3254 END GetModuleCtors ;
3258 MakeModule - creates a module sym with ModuleName. It returns the
3262 PROCEDURE MakeModule (tok: CARDINAL; ModuleName: Name) : CARDINAL ;
3264 pSym : PtrToSymbol ;
3265 pCall: PtrToCallFrame ;
3269 Make a new symbol since we are at the outer scope level.
3270 DeclareSym examines the current scope level for any symbols
3271 that have the correct name, but are yet undefined.
3272 Therefore we must not call DeclareSym but create a symbol
3276 pSym := GetPsym(Sym) ;
3278 SymbolType := ModuleSym ;
3280 name := ModuleName ; (* Index into name array, name *)
3281 (* of record field. *)
3282 libname := NulName ; (* Library association. *)
3283 InitCtor (ctors) ; (* Init all ctor functions. *)
3284 InitList(ModListOfDep) ; (* Vector of SymDependency. *)
3285 InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
3286 (* variables declared local to *)
3287 (* the block. It contains the *)
3288 (* FROM _ IMPORT x, y, x ; *)
3291 (* MODULE WeAreHere ; *)
3292 (* x y z visiable by localsym *)
3293 (* MODULE Inner ; *)
3294 (* EXPORT x, y, z ; *)
3296 (* END WeAreHere. *)
3297 InitTree(ExportTree) ; (* Holds all the exported *)
3299 (* This tree may be *)
3300 (* deleted at the end of Pass 1. *)
3301 InitTree(ImportTree) ; (* Contains all IMPORTed *)
3303 InitList(IncludeList) ; (* Contains all included symbols *)
3304 (* which are included by *)
3305 (* IMPORT modulename ; *)
3306 (* modulename.Symbol *)
3307 InitTree(ExportUndeclared) ; (* ExportUndeclared contains all *)
3308 (* the identifiers which were *)
3309 (* exported but have not yet *)
3310 (* been declared. *)
3311 InitList(EnumerationScopeList) ; (* Enumeration scope list which *)
3312 (* contains a list of all *)
3313 (* enumerations which are *)
3314 (* visable within this scope. *)
3316 InitTree(NamedObjects) ; (* Names of all items declared. *)
3317 InitTree(NamedImports) ; (* Names of items imported. *)
3318 InitTree(WhereImported) ; (* Sym to TokenNo where import *)
3319 (* occurs. Error message use. *)
3320 Priority := NulSym ; (* Priority of the module. This *)
3321 (* is an index to a constant. *)
3322 InitTree(Unresolved) ; (* All symbols currently *)
3323 (* unresolved in this module. *)
3324 StartQuad := 0 ; (* Signify the initialization *)
3326 EndQuad := 0 ; (* EndQuad should point to a *)
3328 StartFinishQuad := 0 ; (* Signify the finalization *)
3330 EndFinishQuad := 0 ; (* should point to a finish *)
3331 FinallyFunction := NIL ; (* The GCC function for finally *)
3332 ExceptionFinally := FALSE ; (* does it have an exception? *)
3333 ExceptionBlock := FALSE ; (* does it have an exception? *)
3334 ModLink := GetLink () ; (* Is this parsed for linkage? *)
3335 Builtin := FALSE ; (* Is the module builtin? *)
3336 InitList(ListOfVars) ; (* List of variables in this *)
3338 InitList(ListOfProcs) ; (* List of all procedures *)
3339 (* declared within this module. *)
3340 InitList(ListOfModules) ; (* List of all inner modules. *)
3341 InitWhereDeclaredTok(tok, At) ; (* Where symbol declared. *)
3342 InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
3343 pCall := GetPcall(ScopePtr) ;
3344 IF pCall^.Main=GetBaseModule()
3348 Scope := pCall^.Main
3350 errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
3353 PutSymKey(ModuleTree, ModuleName, Sym) ;
3359 PutModLink - assigns link to module sym.
3362 PROCEDURE PutModLink (sym: CARDINAL; link: BOOLEAN) ;
3368 pSym := GetPsym (sym) ;
3369 pSym^.Module.ModLink := link
3370 ELSIF IsDefImp (sym)
3372 pSym := GetPsym (sym) ;
3373 pSym^.DefImp.ModLink := link
3375 InternalError ('expecting a DefImp or Module symbol')
3381 IsModLink - returns the ModLink value associated with the module symbol.
3384 PROCEDURE IsModLink (sym: CARDINAL) : BOOLEAN ;
3390 pSym := GetPsym (sym) ;
3391 RETURN pSym^.Module.ModLink
3392 ELSIF IsDefImp (sym)
3394 pSym := GetPsym (sym) ;
3395 RETURN pSym^.DefImp.ModLink
3397 InternalError ('expecting a DefImp or Module symbol')
3403 PutDefLink - assigns link to the definition module sym.
3406 PROCEDURE PutDefLink (sym: CARDINAL; link: BOOLEAN) ;
3412 pSym := GetPsym (sym) ;
3413 pSym^.DefImp.DefLink := link
3415 InternalError ('expecting a DefImp symbol')
3421 IsDefLink - returns the DefLink value associated with the definition module symbol.
3424 PROCEDURE IsDefLink (sym: CARDINAL) : BOOLEAN ;
3430 pSym := GetPsym (sym) ;
3431 RETURN pSym^.DefImp.DefLink
3433 InternalError ('expecting a DefImp symbol')
3439 GetLink - returns TRUE if the current module is only used for linkage.
3442 PROCEDURE GetLink () : BOOLEAN ;
3444 OuterModule: CARDINAL ;
3446 OuterModule := GetCurrentModule () ;
3447 IF OuterModule # NulSym
3449 IF CompilingDefinitionModule ()
3451 RETURN IsDefLink (OuterModule)
3453 RETURN IsModLink (OuterModule)
3456 (* Default is that the module is for compiling. *)
3462 IsModuleBuiltin - returns TRUE if the module is a builtin module.
3463 (For example _BaseTypes).
3466 PROCEDURE IsModuleBuiltin (sym: CARDINAL) : BOOLEAN ;
3472 pSym := GetPsym (sym) ;
3473 RETURN pSym^.DefImp.Builtin
3474 ELSIF IsModule (sym)
3476 pSym := GetPsym (sym) ;
3477 RETURN pSym^.Module.Builtin
3480 END IsModuleBuiltin ;
3484 PutModuleBuiltin - sets the Builtin flag to value.
3485 Currently the procedure expects sym to be a DefImp
3489 PROCEDURE PutModuleBuiltin (sym: CARDINAL; value: BOOLEAN) ;
3495 pSym := GetPsym (sym) ;
3496 pSym^.DefImp.Builtin := value
3497 ELSIF IsModule (sym)
3499 pSym := GetPsym (sym) ;
3500 pSym^.Module.Builtin := value
3502 InternalError ('expecting Module or DefImp symbol')
3504 END PutModuleBuiltin ;
3508 AddModuleToParent - adds symbol, Sym, to module, Parent.
3511 PROCEDURE AddModuleToParent (Sym: CARDINAL; Parent: CARDINAL) ;
3515 pSym := GetPsym(Parent) ;
3519 DefImpSym : PutItemIntoList(DefImp.ListOfModules, Sym) |
3520 ModuleSym : PutItemIntoList(Module.ListOfModules, Sym) |
3521 ProcedureSym: PutItemIntoList(Procedure.ListOfModules, Sym)
3524 InternalError ('expecting DefImp or Module symbol')
3527 END AddModuleToParent ;
3531 MakeInnerModule - creates an inner module sym with ModuleName. It returns the
3535 PROCEDURE MakeInnerModule (tok: CARDINAL; ModuleName: Name) : CARDINAL ;
3540 Sym := DeclareSym (tok, ModuleName) ;
3543 pSym := GetPsym(Sym) ;
3545 SymbolType := ModuleSym ;
3547 name := ModuleName ; (* Index into name array, name *)
3548 (* of record field. *)
3549 libname := NulName ; (* Library association. *)
3550 InitCtor (ctors) ; (* Init all ctor functions. *)
3551 InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
3552 (* variables declared local to *)
3553 (* the block. It contains the *)
3554 (* FROM _ IMPORT x, y, x ; *)
3557 (* MODULE WeAreHere ; *)
3558 (* x y z visiable by localsym *)
3559 (* MODULE Inner ; *)
3560 (* EXPORT x, y, z ; *)
3562 (* END WeAreHere. *)
3563 InitTree(ExportTree) ; (* Holds all the exported *)
3565 (* This tree may be *)
3566 (* deleted at the end of Pass 1. *)
3567 InitTree(ImportTree) ; (* Contains all IMPORTed *)
3569 InitList(IncludeList) ; (* Contains all included symbols *)
3570 (* which are included by *)
3571 (* IMPORT modulename ; *)
3572 (* modulename.Symbol *)
3573 InitTree(ExportUndeclared) ; (* ExportUndeclared contains all *)
3574 (* the identifiers which were *)
3575 (* exported but have not yet *)
3576 (* been declared. *)
3577 InitList(EnumerationScopeList) ;(* Enumeration scope list which *)
3578 (* contains a list of all *)
3579 (* enumerations which are *)
3580 (* visable within this scope. *)
3581 InitTree(NamedObjects) ; (* Names of all items declared. *)
3582 InitTree(NamedImports) ; (* Names of items imported. *)
3583 InitTree(WhereImported) ; (* Sym to TokenNo where import *)
3584 (* occurs. Error message use. *)
3585 Priority := NulSym ; (* Priority of the module. This *)
3586 (* is an index to a constant. *)
3587 InitTree(Unresolved) ; (* All symbols currently *)
3588 (* unresolved in this module. *)
3589 StartQuad := 0 ; (* Signify the initialization *)
3591 EndQuad := 0 ; (* EndQuad should point to a *)
3593 StartFinishQuad := 0 ; (* Signify the finalization *)
3595 EndFinishQuad := 0 ; (* should point to a finish *)
3596 FinallyFunction := NIL ; (* The GCC function for finally *)
3597 ExceptionFinally := FALSE ; (* does it have an exception? *)
3598 ExceptionBlock := FALSE ; (* does it have an exception? *)
3599 ModLink := GetLink () ; (* Is this parsed for linkage? *)
3600 InitList(ListOfVars) ; (* List of variables in this *)
3602 InitList(ListOfProcs) ; (* List of all procedures *)
3603 (* declared within this module. *)
3604 InitList(ListOfModules) ; (* List of all inner modules. *)
3605 InitWhereDeclaredTok(tok, At) ; (* Where symbol declared. *)
3606 InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
3607 IF GetCurrentScope()=GetBaseModule()
3611 Scope := GetCurrentScope() ;
3612 AddModuleToParent(Sym, Scope)
3614 errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
3617 AddSymToScope(Sym, ModuleName)
3620 END MakeInnerModule ;
3624 MakeDefImp - creates a definition and implementation module sym
3625 with name DefImpName. It returns the symbol index.
3628 PROCEDURE MakeDefImp (tok: CARDINAL; DefImpName: Name) : CARDINAL ;
3633 (* Make a new symbol since we are at the outer scope level. *)
3634 (* We cannot use DeclareSym as it examines the current scope *)
3635 (* for any symbols which have the correct name, but are yet *)
3639 pSym := GetPsym(Sym) ;
3641 SymbolType := DefImpSym ;
3643 name := DefImpName ; (* Index into name array, name *)
3644 (* of record field. *)
3645 libname := NulName ; (* Library association. *)
3647 (* Init all ctor functions. *)
3648 InitList(DefListOfDep) ; (* Vector of SymDependency. *)
3649 InitList(ModListOfDep) ; (* Vector of SymDependency. *)
3650 InitTree(ExportQualifiedTree) ;
3651 (* Holds all the EXPORT *)
3652 (* QUALIFIED identifiers. *)
3653 (* This tree may be *)
3654 (* deleted at the end of Pass 1. *)
3655 InitTree(ExportUnQualifiedTree) ;
3656 (* Holds all the EXPORT *)
3657 (* UNQUALIFIED identifiers. *)
3658 (* This tree may be *)
3659 (* deleted at the end of Pass 1. *)
3660 InitTree(ExportRequest) ; (* Contains all identifiers that *)
3661 (* have been requested by other *)
3662 (* modules before this module *)
3663 (* declared its export list. *)
3664 (* This tree should be empty at *)
3665 (* the end of the compilation. *)
3666 (* Each time a symbol is *)
3667 (* exported it is removed from *)
3669 InitTree(ImportTree) ; (* Contains all IMPORTed *)
3671 InitList(IncludeList) ; (* Contains all included symbols *)
3672 (* which are included by *)
3673 (* IMPORT modulename ; *)
3674 (* modulename.Symbol *)
3675 InitList(DefIncludeList) ; (* Contains all included symbols *)
3676 (* which are included by *)
3677 (* IMPORT modulename ; *)
3678 (* in the definition module only *)
3679 InitTree(ExportUndeclared) ; (* ExportUndeclared contains all *)
3680 (* the identifiers which were *)
3681 (* exported but have not yet *)
3682 (* been declared. *)
3683 InitTree(NeedToBeImplemented) ;
3684 (* NeedToBeImplemented contains *)
3685 (* the identifiers which have *)
3686 (* been exported and declared *)
3687 (* but have not yet been *)
3689 InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
3690 (* variables declared local to *)
3691 (* the block. It contains the *)
3693 (* FROM _ IMPORT x, y, x ; *)
3695 (* MODULE WeAreHere ; *)
3696 (* x y z visiable by localsym *)
3697 (* MODULE Inner ; *)
3698 (* EXPORT x, y, z ; *)
3700 (* END WeAreHere. *)
3701 InitList(EnumerationScopeList) ;
3702 (* Enumeration scope list which *)
3703 (* contains a list of all *)
3704 (* enumerations which are *)
3705 (* visable within this scope. *)
3706 InitTree(NamedObjects) ; (* names of all items declared. *)
3707 InitTree(NamedImports) ; (* Names of items imported. *)
3708 InitTree(WhereImported) ; (* Sym to TokenNo where import *)
3709 (* occurs. Error message use. *)
3710 Priority := NulSym ; (* Priority of the module. This *)
3711 (* is an index to a constant. *)
3712 InitTree(Unresolved) ; (* All symbols currently *)
3713 (* unresolved in this module. *)
3714 StartQuad := 0 ; (* Signify the initialization *)
3716 EndQuad := 0 ; (* EndQuad should point to a *)
3718 StartFinishQuad := 0 ; (* Signify the finalization *)
3720 EndFinishQuad := 0 ; (* should point to a finish *)
3721 FinallyFunction := NIL ; (* The GCC function for finally *)
3722 ExceptionFinally := FALSE ; (* does it have an exception? *)
3723 ExceptionBlock := FALSE ; (* does it have an exception? *)
3724 ContainsHiddenType := FALSE ;(* True if this module *)
3725 (* implements a hidden type. *)
3726 ContainsBuiltin := FALSE ; (* Does module define a builtin *)
3728 ForC := FALSE ; (* Is it a definition for "C" *)
3729 NeedExportList := FALSE ; (* Must user supply export list? *)
3730 DefLink := GetLink () ; (* Is the def/mod file only *)
3731 ModLink := GetLink () ; (* parsed for linkage? *)
3732 Builtin := FALSE ; (* Is the module builtin? *)
3733 InitList(ListOfVars) ; (* List of variables in this *)
3735 InitList(ListOfProcs) ; (* List of all procedures *)
3736 (* declared within this module. *)
3737 InitList(ListOfModules) ; (* List of all inner modules. *)
3738 InitWhereDeclaredTok(tok, At) ; (* Where symbol declared. *)
3739 InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
3740 errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
3743 PutSymKey(ModuleTree, DefImpName, Sym) ;
3749 PutLibName - places libname into defimp or module sym.
3752 PROCEDURE PutLibName (sym: CARDINAL; libname: Name) ;
3756 Assert (IsModule (sym) OR IsDefImp (sym)) ;
3757 pSym := GetPsym (sym) ;
3761 DefImpSym: DefImp.libname := libname |
3762 ModuleSym: Module.libname := libname
3765 InternalError ('expecting DefImp or Module symbol')
3772 GetLibName - returns libname associated with a defimp or module sym.
3775 PROCEDURE GetLibName (sym: CARDINAL) : Name ;
3779 Assert (IsModule (sym) OR IsDefImp (sym)) ;
3780 pSym := GetPsym (sym) ;
3784 DefImpSym: RETURN DefImp.libname |
3785 ModuleSym: RETURN Module.libname
3788 InternalError ('expecting DefImp or Module symbol')
3795 PutProcedureExternPublic - if procedure is not NulSym set extern
3796 and public booleans.
3799 PROCEDURE PutProcedureExternPublic (procedure: CARDINAL; extern, pub: BOOLEAN) ;
3801 IF procedure # NulSym
3803 PutExtern (procedure, extern) ;
3804 PutPublic (procedure, pub)
3806 END PutProcedureExternPublic ;
3813 PROCEDURE PutCtorExtern (tok: CARDINAL; sym: CARDINAL;
3814 VAR ctor: ModuleCtor; extern: BOOLEAN) ;
3816 (* If the ctor does not exist then make it extern/ (~extern) public. *)
3817 IF ctor.ctor = NulSym
3819 ctor.ctor := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_ctor")) ;
3820 PutMonoName (ctor.ctor, TRUE)
3822 PutProcedureExternPublic (ctor.ctor, extern, NOT extern) ;
3823 PutCtor (ctor.ctor, TRUE) ;
3824 (* If the ctor does not exist then make it extern/ (~extern) public. *)
3825 IF ctor.dep = NulSym
3827 ctor.dep := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_dep")) ;
3828 PutMonoName (ctor.dep, TRUE)
3830 PutProcedureExternPublic (ctor.dep, extern, NOT extern) ;
3831 (* If init/fini do not exist then create them. *)
3832 IF ctor.init = NulSym
3834 ctor.init := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_init")) ;
3835 DeclareArgEnvParams (tok, ctor.init) ;
3836 PutMonoName (ctor.init, NOT IsInnerModule (sym))
3838 PutProcedureExternPublic (ctor.init, extern, NOT extern) ;
3839 IF ctor.fini = NulSym
3841 ctor.fini := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_fini")) ;
3842 DeclareArgEnvParams (tok, ctor.fini) ;
3843 PutMonoName (ctor.fini, NOT IsInnerModule (sym))
3845 PutProcedureExternPublic (ctor.fini, extern, NOT extern)
3850 PutModuleCtorExtern - for every ctor related procedure in module sym.
3851 Make it external. It will create any missing
3852 init/fini procedures but not any missing dep/ctor
3856 PROCEDURE PutModuleCtorExtern (tok: CARDINAL; sym: CARDINAL; external: BOOLEAN) ;
3860 Assert (IsModule (sym) OR IsDefImp (sym)) ;
3861 pSym := GetPsym (sym) ;
3865 DefImpSym: PutCtorExtern (tok, sym, DefImp.ctors, external) |
3866 ModuleSym: PutCtorExtern (tok, sym, Module.ctors, external)
3869 InternalError ('expecting DefImp or Module symbol')
3872 END PutModuleCtorExtern ;
3876 MakeProcedure - creates a procedure sym with name. It returns
3880 PROCEDURE MakeProcedure (tok: CARDINAL; ProcedureName: Name) : CARDINAL ;
3885 Sym := DeclareSym(tok, ProcedureName) ;
3888 pSym := GetPsym(Sym) ;
3890 SymbolType := ProcedureSym ;
3892 name := ProcedureName ;
3893 InitList(ListOfParam) ; (* Contains a list of all the *)
3894 (* parameters in this procedure. *)
3895 ParamDefined := FALSE ; (* Have the parameters been *)
3897 DefinedInDef := FALSE ; (* Were the parameters defined *)
3898 (* in the Definition module? *)
3899 (* Note that this depends on *)
3900 (* whether the compiler has read *)
3901 (* the .def or .mod first. *)
3902 (* The second occurence is *)
3903 (* compared to the first. *)
3904 DefinedInImp := FALSE ; (* Were the parameters defined *)
3905 (* in the Implementation module? *)
3906 (* Note that this depends on *)
3907 (* whether the compiler has read *)
3908 (* the .def or .mod first. *)
3909 (* The second occurence is *)
3910 (* compared to the first. *)
3911 HasVarArgs := FALSE ; (* Does the procedure use ... ? *)
3912 HasOptArg := FALSE ; (* Does this procedure use [ ] ? *)
3913 OptArgInit := NulSym ; (* The optarg initial value. *)
3914 IsBuiltin := FALSE ; (* Was it declared __BUILTIN__ ? *)
3915 BuiltinName := NulName ; (* name of equivalent builtin *)
3916 IsInline := FALSE ; (* Was is declared __INLINE__ ? *)
3917 IsNoReturn := FALSE ; (* Declared attribute noreturn ? *)
3918 ReturnOptional := FALSE ; (* Is the return value optional? *)
3919 IsExtern := FALSE ; (* Make this procedure external. *)
3920 IsPublic := FALSE ; (* Make this procedure visible. *)
3921 IsCtor := FALSE ; (* Is this procedure a ctor? *)
3922 IsMonoName := FALSE ; (* Overrides module name prefix. *)
3923 Scope := GetCurrentScope() ; (* Scope of procedure. *)
3924 InitTree(Unresolved) ; (* All symbols currently *)
3925 (* unresolved in this procedure. *)
3926 ScopeQuad := 0 ; (* Index into list of quads, *)
3927 StartQuad := 0 ; (* defining the scope, start and *)
3928 EndQuad := 0 ; (* end of the procedure. *)
3929 Reachable := FALSE ; (* Procedure not known to be *)
3931 SavePriority := FALSE ; (* Does procedure need to save *)
3932 (* and restore interrupts? *)
3933 ReturnType := NulSym ; (* Not a function yet! *)
3934 Offset := 0 ; (* Location of procedure. *)
3935 InitTree(LocalSymbols) ;
3936 InitList(EnumerationScopeList) ;
3937 (* Enumeration scope list which *)
3938 (* contains a list of all *)
3939 (* enumerations which are *)
3940 (* visable within this scope. *)
3941 InitTree(NamedObjects) ; (* Names of all items declared. *)
3942 InitList(ListOfVars) ; (* List of variables in this *)
3944 InitList(ListOfProcs) ; (* List of all procedures *)
3945 (* declared within this *)
3947 InitList(ListOfModules) ; (* List of all inner modules. *)
3948 ExceptionFinally := FALSE ; (* does it have an exception? *)
3949 ExceptionBlock := FALSE ; (* does it have an exception? *)
3950 Size := InitValue() ; (* Activation record size. *)
3952 := InitValue() ; (* size of all parameters. *)
3953 Begin := 0 ; (* token number for BEGIN *)
3954 End := 0 ; (* token number for END *)
3955 InitWhereDeclaredTok(tok, At) ; (* Where symbol declared. *)
3956 errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
3959 (* Now add this procedure to the symbol table of the current scope *)
3960 AddSymToScope(Sym, ProcedureName) ;
3961 AddProcedureToList(GetCurrentScope(), Sym)
3968 PutProcedureNoReturn - places value into the no return attribute
3969 field of procedure sym.
3972 PROCEDURE PutProcedureNoReturn (Sym: CARDINAL; value: BOOLEAN) ;
3976 pSym := GetPsym (Sym) ;
3980 ProcedureSym: Procedure.IsNoReturn := value
3983 InternalError ('expecting ProcedureSym symbol')
3986 END PutProcedureNoReturn ;
3990 IsProcedureNoReturn - returns TRUE if this procedure never returns.
3993 PROCEDURE IsProcedureNoReturn (Sym: CARDINAL) : BOOLEAN ;
3997 pSym := GetPsym (Sym) ;
4001 ProcedureSym: RETURN Procedure.IsNoReturn
4004 InternalError ('expecting ProcedureSym symbol')
4007 END IsProcedureNoReturn ;
4011 PutMonoName - changes the IsMonoName boolean inside the procedure.
4014 PROCEDURE PutMonoName (sym: CARDINAL; value: BOOLEAN) ;
4018 pSym := GetPsym (sym) ;
4022 ProcedureSym: Procedure.IsMonoName := value
4025 InternalError ('expecting ProcedureSym symbol')
4032 IsMonoName - returns the public boolean associated with a procedure.
4035 PROCEDURE IsMonoName (sym: CARDINAL) : BOOLEAN ;
4039 pSym := GetPsym (sym) ;
4043 ProcedureSym: RETURN Procedure.IsMonoName
4046 InternalError ('expecting ProcedureSym symbol')
4053 PutExtern - changes the extern boolean inside the procedure.
4056 PROCEDURE PutExtern (sym: CARDINAL; value: BOOLEAN) ;
4060 pSym := GetPsym (sym) ;
4064 ProcedureSym: Procedure.IsExtern := value
4067 InternalError ('expecting ProcedureSym symbol')
4074 IsExtern - returns the public boolean associated with a procedure.
4077 PROCEDURE IsExtern (sym: CARDINAL) : BOOLEAN ;
4081 pSym := GetPsym (sym) ;
4085 ProcedureSym: RETURN Procedure.IsExtern
4088 InternalError ('expecting ProcedureSym symbol')
4095 PutPublic - changes the public boolean inside the procedure.
4098 PROCEDURE PutPublic (sym: CARDINAL; value: BOOLEAN) ;
4102 pSym := GetPsym (sym) ;
4106 ProcedureSym : Procedure.IsPublic := value
4109 InternalError ('expecting ProcedureSym symbol')
4116 IsPublic - returns the public boolean associated with a procedure.
4119 PROCEDURE IsPublic (sym: CARDINAL) : BOOLEAN ;
4123 pSym := GetPsym (sym) ;
4127 ProcedureSym : RETURN Procedure.IsPublic
4130 InternalError ('expecting ProcedureSym symbol')
4137 PutCtor - changes the ctor boolean inside the procedure.
4140 PROCEDURE PutCtor (sym: CARDINAL; value: BOOLEAN) ;
4144 pSym := GetPsym (sym) ;
4148 ProcedureSym : Procedure.IsCtor := value
4151 InternalError ('expecting ProcedureSym symbol')
4158 IsCtor - returns the ctor boolean associated with a procedure.
4161 PROCEDURE IsCtor (sym: CARDINAL) : BOOLEAN ;
4165 pSym := GetPsym (sym) ;
4169 ProcedureSym : RETURN Procedure.IsCtor
4172 InternalError ('expecting ProcedureSym symbol')
4179 AddProcedureToList - adds a procedure, Proc, to the list of procedures
4183 PROCEDURE AddProcedureToList (Mod, Proc: CARDINAL) ;
4187 pSym := GetPsym(Mod) ;
4191 DefImpSym : PutItemIntoList(DefImp.ListOfProcs, Proc) |
4192 ModuleSym : PutItemIntoList(Module.ListOfProcs, Proc) |
4193 ProcedureSym: PutItemIntoList(Procedure.ListOfProcs, Proc)
4196 InternalError ('expecting ModuleSym, DefImpSym or ProcedureSym symbol')
4199 END AddProcedureToList ;
4203 AddVarToScopeList - adds symbol, sym, to, scope.
4206 PROCEDURE AddVarToScopeList (scope, sym: CARDINAL) ;
4210 pSym := GetPsym(scope) ;
4214 ProcedureSym: PutItemIntoList(Procedure.ListOfVars, sym) |
4215 ModuleSym : PutItemIntoList(Module.ListOfVars, sym) |
4216 DefImpSym : PutItemIntoList(DefImp.ListOfVars, sym)
4219 InternalError ('expecting Procedure or Module symbol')
4222 END AddVarToScopeList ;
4226 AddVarToList - add a variable symbol to the list of variables maintained
4227 by the inner most scope. (Procedure or Module).
4230 PROCEDURE AddVarToList (Sym: CARDINAL) ;
4232 pCall: PtrToCallFrame ;
4234 pCall := GetPcall(ScopePtr) ;
4235 AddVarToScopeList(pCall^.Main, Sym)
4240 MakeVar - creates a variable sym with VarName. It returns the
4244 PROCEDURE MakeVar (tok: CARDINAL; VarName: Name) : CARDINAL ;
4249 Sym := DeclareSym (tok, VarName) ;
4252 pSym := GetPsym(Sym) ;
4254 SymbolType := VarSym ;
4258 BackType := NulSym ;
4259 Size := InitValue() ;
4260 Offset := InitValue() ;
4261 AddrMode := RightValue ;
4262 Scope := GetCurrentScope() ; (* Procedure or Module? *)
4263 AtAddress := FALSE ;
4264 Address := NulSym ; (* Address at which declared. *)
4266 IsComponentRef := FALSE ;
4268 IsPointerCheck := FALSE ;
4269 IsWritten := FALSE ;
4274 InitWhereDeclaredTok(tok, At) ;
4275 InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
4276 InitList(ReadUsageList[RightValue]) ;
4277 InitList(WriteUsageList[RightValue]) ;
4278 InitList(ReadUsageList[LeftValue]) ;
4279 InitList(WriteUsageList[LeftValue]) ;
4280 InitState[LeftValue] := InitSymInit () ;
4281 InitState[RightValue] := InitSymInit ()
4284 (* Add Var to Procedure or Module variable list. *)
4286 (* Now add this Var to the symbol table of the current scope. *)
4287 AddSymToScope(Sym, VarName)
4294 PutExceptionBlock - sets a BOOLEAN in block module/procedure/defimp,
4295 sym, indicating that this block as an EXCEPT
4299 PROCEDURE PutExceptionBlock (sym: CARDINAL) ;
4303 pSym := GetPsym(sym) ;
4307 ProcedureSym: Procedure.ExceptionBlock := TRUE |
4308 ModuleSym : Module.ExceptionBlock := TRUE |
4309 DefImpSym : DefImp.ExceptionBlock := TRUE
4312 InternalError ('expecting Procedure')
4315 END PutExceptionBlock ;
4319 HasExceptionBlock - returns a BOOLEAN determining whether
4320 module/procedure/defimp, sym, has
4321 an EXCEPT statement sequence.
4324 PROCEDURE HasExceptionBlock (sym: CARDINAL) : BOOLEAN ;
4328 pSym := GetPsym(sym) ;
4332 ProcedureSym: RETURN( Procedure.ExceptionBlock ) |
4333 ModuleSym : RETURN( Module.ExceptionBlock ) |
4334 DefImpSym : RETURN( DefImp.ExceptionBlock )
4337 InternalError ('expecting Procedure')
4340 END HasExceptionBlock ;
4344 PutExceptionFinally - sets a BOOLEAN in block module/defimp,
4345 sym, indicating that this FINALLY block
4346 as an EXCEPT statement sequence.
4349 PROCEDURE PutExceptionFinally (sym: CARDINAL) ;
4353 pSym := GetPsym(sym) ;
4357 ProcedureSym: Procedure.ExceptionFinally := TRUE |
4358 ModuleSym : Module.ExceptionFinally := TRUE |
4359 DefImpSym : DefImp.ExceptionFinally := TRUE
4362 InternalError ('expecting DefImp or Module symbol')
4365 END PutExceptionFinally ;
4369 HasExceptionFinally - returns a BOOLEAN determining whether
4370 module/defimp, sym, has
4371 an EXCEPT statement sequence.
4374 PROCEDURE HasExceptionFinally (sym: CARDINAL) : BOOLEAN ;
4378 pSym := GetPsym(sym) ;
4382 ProcedureSym: RETURN( Procedure.ExceptionFinally ) |
4383 ModuleSym : RETURN( Module.ExceptionFinally ) |
4384 DefImpSym : RETURN( DefImp.ExceptionFinally )
4387 InternalError ('expecting DefImp or Module symbol')
4390 END HasExceptionFinally ;
4394 FillInRecordFields - given a new symbol, sym, make it a record symbol
4395 and initialize its fields.
4398 PROCEDURE FillInRecordFields (tok: CARDINAL; sym: CARDINAL; RecordName: Name;
4399 scope: CARDINAL; oaf: CARDINAL) ;
4405 pSym := GetPsym (sym) ;
4407 SymbolType := RecordSym ;
4409 name := RecordName ;
4410 InitTree (LocalSymbols) ;
4411 Size := InitValue () ;
4412 InitList (ListOfSons) ; (* List of RecordFieldSym and VarientSym *)
4416 DefaultAlign := NulSym ;
4417 DeclPacked := FALSE ;
4418 DeclResolved := FALSE ;
4420 InitWhereDeclaredTok (tok, At)
4424 END FillInRecordFields ;
4428 HandleHiddenOrDeclare -
4431 PROCEDURE HandleHiddenOrDeclare (tok: CARDINAL; name: Name; VAR oaf: CARDINAL) : CARDINAL ;
4435 sym := CheckForHiddenType (name) ;
4438 sym := DeclareSym (tok, name) ;
4439 IF NOT IsError (sym)
4441 (* Now add this type to the symbol table of the current scope *)
4442 AddSymToScope (sym, name)
4445 oaf := GetOAFamily (sym) ;
4447 END HandleHiddenOrDeclare ;
4451 MakeRecord - makes a Record symbol with name RecordName.
4454 PROCEDURE MakeRecord (tok: CARDINAL; RecordName: Name) : CARDINAL ;
4456 oaf, sym: CARDINAL ;
4458 sym := HandleHiddenOrDeclare (tok, RecordName, oaf) ;
4459 FillInRecordFields (tok, sym, RecordName, GetCurrentScope (), oaf) ;
4460 ForeachOAFamily (oaf, doFillInOAFamily) ;
4466 MakeVarient - creates a new symbol, a varient symbol for record or varient field
4467 symbol, RecOrVarFieldSym.
4470 PROCEDURE MakeVarient (tok: CARDINAL; RecOrVarFieldSym: CARDINAL) : CARDINAL ;
4476 pSym := GetPsym(Sym) ;
4478 SymbolType := VarientSym ;
4480 Size := InitValue() ;
4481 Parent := RecOrVarFieldSym ; (* GetRecord(RecOrVarFieldSym) ; *)
4482 IF IsRecord(RecOrVarFieldSym)
4486 Varient := RecOrVarFieldSym
4489 DeclPacked := FALSE ;
4490 Scope := GetCurrentScope() ;
4491 InitList(ListOfSons) ;
4492 InitWhereDeclaredTok(tok, At)
4495 (* Now add Sym to the record RecSym field list *)
4496 pSym := GetPsym(RecOrVarFieldSym) ;
4500 RecordSym : PutItemIntoList(Record.ListOfSons, Sym) |
4501 VarientFieldSym: PutItemIntoList(VarientField.ListOfSons, Sym)
4504 InternalError ('expecting Record or VarientField symbol')
4512 GetRecord - fetches the record symbol from the parent of Sym.
4513 Sym maybe a varient symbol in which case its parent is searched
4517 PROCEDURE GetRecord (Sym: CARDINAL) : CARDINAL ;
4521 pSym := GetPsym (Sym) ;
4525 RecordSym : RETURN Sym |
4526 VarientSym : RETURN GetRecord(Varient.Parent) |
4527 VarientFieldSym: RETURN GetRecord(VarientField.Parent)
4530 InternalError ('expecting Record or Varient symbol')
4537 PutDeclaredPacked - sets the Packed field of the record or record field symbol.
4540 PROCEDURE PutDeclaredPacked (sym: CARDINAL; b: BOOLEAN) ;
4544 pSym := GetPsym(sym) ;
4548 RecordSym : Record.DeclPacked := b ;
4549 Record.DeclResolved := TRUE |
4550 RecordFieldSym : RecordField.DeclPacked := b ;
4551 RecordField.DeclResolved := TRUE |
4552 VarientFieldSym: VarientField.DeclPacked := b ;
4553 VarientField.DeclResolved := TRUE |
4554 VarientSym : Varient.DeclPacked := b ;
4555 Varient.DeclResolved := TRUE
4558 InternalError ('expecting a record or field record symbol')
4561 END PutDeclaredPacked ;
4565 IsDeclaredPacked - was the record symbol or record field, sym,
4569 PROCEDURE IsDeclaredPacked (sym: CARDINAL) : BOOLEAN ;
4573 pSym := GetPsym (sym) ;
4577 RecordSym : RETURN Record.DeclPacked |
4578 RecordFieldSym : RETURN RecordField.DeclPacked |
4579 VarientFieldSym: RETURN VarientField.DeclPacked |
4580 VarientSym : RETURN Varient.DeclPacked
4583 InternalError ('expecting a record or a record field symbol')
4586 END IsDeclaredPacked ;
4590 IsDeclaredPackedResolved - do we know if the record symbol or record
4591 field, sym, declared as packed or not packed?
4594 PROCEDURE IsDeclaredPackedResolved (sym: CARDINAL) : BOOLEAN ;
4598 pSym := GetPsym (sym) ;
4602 RecordSym : RETURN Record.DeclResolved |
4603 RecordFieldSym : RETURN RecordField.DeclResolved |
4604 VarientFieldSym: RETURN VarientField.DeclResolved |
4605 VarientSym : RETURN Varient.DeclResolved
4608 InternalError ('expecting a record or a record field symbol')
4611 END IsDeclaredPackedResolved ;
4615 MakeEnumeration - places a new symbol in the current scope, the symbol
4616 is an enumeration symbol. The symbol index is returned.
4619 PROCEDURE MakeEnumeration (tok: CARDINAL; EnumerationName: Name) : CARDINAL ;
4621 pSym : PtrToSymbol ;
4622 sym, oaf: CARDINAL ;
4624 sym := CheckForHiddenType (EnumerationName) ;
4627 sym := DeclareSym (tok, EnumerationName) ;
4628 oaf := GetOAFamily (sym) ;
4629 IF NOT IsError (sym)
4631 pSym := GetPsym (sym) ;
4632 pSym^.SymbolType := EnumerationSym ; (* To satisfy AddSymToScope *)
4633 (* Now add this type to the symbol table of the current scope *)
4634 AddSymToScope (sym, EnumerationName)
4637 oaf := GetOAFamily (sym)
4639 IF NOT IsError (sym)
4641 pSym := GetPsym (sym) ;
4643 SymbolType := EnumerationSym ;
4645 name := EnumerationName ; (* Name of enumeration. *)
4646 NoOfElements := 0 ; (* No of elements in the *)
4647 (* enumeration type. *)
4648 Size := InitValue () ; (* Size at runtime of sym *)
4649 InitTree (LocalSymbols) ; (* Enumeration fields. *)
4650 InitList (ListOfFields) ; (* Ordered as declared. *)
4651 InitPacked (packedInfo) ; (* not packed and no *)
4652 (* equivalent (yet). *)
4653 oafamily := oaf ; (* The open array family *)
4654 Scope := GetCurrentScope () ; (* Which scope created it *)
4655 InitWhereDeclaredTok (tok, At) (* Declared here *)
4658 CheckIfEnumerationExported (sym, ScopePtr)
4660 ForeachOAFamily (oaf, doFillInOAFamily) ;
4662 END MakeEnumeration ;
4666 MakeType - makes a type symbol with name TypeName.
4669 PROCEDURE MakeType (tok: CARDINAL; TypeName: Name) : CARDINAL ;
4671 pSym : PtrToSymbol ;
4672 sym, oaf: CARDINAL ;
4674 sym := HandleHiddenOrDeclare (tok, TypeName, oaf) ;
4677 pSym := GetPsym(sym) ;
4679 SymbolType := TypeSym ;
4681 name := TypeName ; (* Index into name array, name *)
4683 Type := NulSym ; (* Index to a type symbol. *)
4684 IsHidden := FALSE ; (* Was it declared as hidden? *)
4685 InitTree(ConstLitTree) ; (* constants of this type. *)
4686 Size := InitValue() ; (* Runtime size of symbol. *)
4687 Align := NulSym ; (* Alignment of this type. *)
4688 InitPacked(packedInfo) ; (* not packed and no *)
4689 (* equivalent yet. *)
4690 oafamily := oaf ; (* The open array family. *)
4691 Scope := GetCurrentScope() ; (* Which scope created it *)
4692 InitWhereDeclaredTok(tok, At) (* Declared here *)
4696 ForeachOAFamily(oaf, doFillInOAFamily) ;
4702 MakeHiddenType - makes a type symbol that is hidden from the
4704 This symbol is placed into the UnImplemented list of
4705 the definition/implementation module.
4706 The type will be filled in when the implementation module
4710 PROCEDURE MakeHiddenType (tok: CARDINAL; TypeName: Name) : CARDINAL ;
4715 Sym := DeclareSym (tok, TypeName) ;
4718 pSym := GetPsym(Sym) ;
4720 SymbolType := TypeSym ;
4722 name := TypeName ; (* Index into name array, name *)
4724 IsHidden := GetMainModule()#GetCurrentScope() ;
4725 IF ExtendedOpaque OR (NOT IsHidden)
4727 Type := NulSym (* will be filled in later *)
4731 Align := NulSym ; (* Alignment of this type. *)
4732 Scope := GetCurrentScope() ; (* Which scope created it *)
4733 oafamily := NulSym ;
4734 IF NOT ExtendedOpaque
4736 IncludeItemIntoList(AddressTypes, Sym)
4738 Size := InitValue() ; (* Runtime size of symbol. *)
4739 InitWhereDeclaredTok(tok, At) (* Declared here *)
4742 PutExportUnImplemented (tok, Sym) ;
4743 IF ExtendedOpaque OR (GetMainModule()=GetCurrentScope())
4745 PutHiddenTypeDeclared
4747 (* Now add this type to the symbol table of the current scope *)
4748 AddSymToScope(Sym, TypeName)
4751 END MakeHiddenType ;
4755 GetConstFromTypeTree - return a constant symbol from the tree owned by constType.
4756 NulSym is returned if the symbol is unknown.
4760 PROCEDURE GetConstFromTypeTree (constName: Name; constType: CARDINAL) : CARDINAL ;
4766 RETURN GetSymKey(ConstLitTree, constName)
4768 pSym := GetPsym(constType) ;
4769 Assert(IsType(constType) OR IsSubrange(constType) OR IsPointer(constType)) ;
4773 TypeSym : RETURN GetSymKey (Type.ConstLitTree, constName) |
4774 SubrangeSym: RETURN GetSymKey (Subrange.ConstLitTree, constName) |
4775 PointerSym : RETURN GetSymKey (Pointer.ConstLitTree, constName)
4778 InternalError ('expecting Type symbol')
4782 END GetConstFromTypeTree ;
4787 PutConstIntoTypeTree - places, constSym, into the tree of constants owned by, constType.
4788 constName is the name of constSym.
4792 PROCEDURE PutConstIntoTypeTree (constName: Name; constType: CARDINAL; constSym: CARDINAL) ;
4798 PutSymKey(ConstLitTree, constName, constSym)
4800 pSym := GetPsym(constType) ;
4801 Assert(IsType(constType) OR IsSubrange(constType) OR IsPointer(constType)) ;
4805 TypeSym : PutSymKey (Type.ConstLitTree, constName, constSym) |
4806 SubrangeSym: PutSymKey (Subrange.ConstLitTree, constName, constSym) |
4807 PointerSym : PutSymKey (Pointer.ConstLitTree, constName, constSym)
4810 InternalError ('expecting Type symbol')
4814 END PutConstIntoTypeTree ;
4819 MakeConstant - create a constant cardinal and return the symbol.
4822 PROCEDURE MakeConstant (tok: CARDINAL; value: CARDINAL) : CARDINAL ;
4827 str := Sprintf1 (Mark (InitString ("%d")), value) ;
4828 sym := MakeConstLit (tok, makekey (string (str)), Cardinal) ;
4829 str := KillString (str) ;
4838 PROCEDURE CreateConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
4840 pSym : PtrToSymbol ;
4842 overflow : BOOLEAN ;
4847 constType := GetConstLitType (tok, constName, overflow, TRUE)
4850 pSym := GetPsym (Sym) ;
4852 SymbolType := ConstLitSym ;
4855 ConstLitSym : ConstLit.name := constName ;
4856 ConstLit.Value := InitValue () ;
4857 PushString (tok, constName, NOT overflow) ;
4858 PopInto (ConstLit.Value) ;
4859 ConstLit.Type := constType ;
4860 ConstLit.IsSet := FALSE ;
4861 ConstLit.IsConstructor := FALSE ;
4862 ConstLit.FromType := NulSym ; (* type is determined FromType *)
4863 ConstLit.RangeError := overflow ;
4864 ConstLit.UnresFromType := FALSE ; (* is Type resolved? *)
4865 ConstLit.Scope := GetCurrentScope () ;
4866 InitWhereDeclaredTok (tok, ConstLit.At) ;
4867 InitWhereFirstUsedTok (tok, ConstLit.At)
4870 InternalError ('expecting ConstLit symbol')
4874 END CreateConstLit ;
4878 LookupConstLitPoolEntry - return a ConstLit symbol from the constant pool which
4879 matches tok, constName and constType.
4882 PROCEDURE LookupConstLitPoolEntry (tok: CARDINAL;
4883 constName: Name; constType: CARDINAL) : CARDINAL ;
4885 pe : ConstLitPoolEntry ;
4886 rootIndex: CARDINAL ;
4888 rootIndex := GetSymKey (ConstLitPoolTree, constName) ;
4891 pe := Indexing.GetIndice (ConstLitArray, rootIndex) ;
4893 IF (pe^.tok = tok) AND
4894 (pe^.constName = constName) AND
4895 (pe^.constType = constType)
4903 END LookupConstLitPoolEntry ;
4907 AddConstLitPoolEntry - adds sym to the constlit pool.
4910 PROCEDURE AddConstLitPoolEntry (sym: CARDINAL; tok: CARDINAL;
4911 constName: Name; constType: CARDINAL) ;
4913 pe, old : ConstLitPoolEntry ;
4914 rootIndex, high: CARDINAL ;
4916 rootIndex := GetSymKey (ConstLitPoolTree, constName) ;
4917 IF rootIndex = NulKey
4919 high := Indexing.HighIndice (ConstLitArray) ;
4923 InternalError ('out of memory')
4927 pe^.constName := constName ;
4928 pe^.constType := constType ;
4930 PutSymKey (ConstLitPoolTree, constName, high+1) ;
4931 Indexing.PutIndice (ConstLitArray, high+1, pe)
4937 InternalError ('out of memory')
4939 old := Indexing.GetIndice (ConstLitArray, rootIndex) ;
4942 pe^.constName := constName ;
4943 pe^.constType := constType ;
4945 Indexing.PutIndice (ConstLitArray, rootIndex, pe)
4948 END AddConstLitPoolEntry ;
4952 MakeConstLit - returns a constant literal of type, constType, with a constName,
4956 PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
4960 sym := LookupConstLitPoolEntry (tok, constName, constType) ;
4963 sym := CreateConstLit (tok, constName, constType) ;
4964 AddConstLitPoolEntry (sym, tok, constName, constType)
4971 MakeConstVar - makes a ConstVar type with
4975 PROCEDURE MakeConstVar (tok: CARDINAL; ConstVarName: Name) : CARDINAL ;
4980 Sym := DeclareSym (tok, ConstVarName) ;
4983 pSym := GetPsym(Sym) ;
4985 SymbolType := ConstVarSym ;
4987 name := ConstVarName ;
4988 Value := InitValue() ;
4991 IsConstructor := FALSE ;
4992 FromType := NulSym ; (* type is determined FromType *)
4993 UnresFromType := FALSE ; (* is Type resolved? *)
4995 Scope := GetCurrentScope () ;
4996 InitWhereDeclaredTok (tok, At)
4999 (* Now add this constant to the symbol table of the current scope *)
5000 AddSymToScope(Sym, ConstVarName)
5007 MakeConstLitString - put a constant which has the string described by
5008 ConstName into the ConstantTree.
5009 The symbol number is returned.
5010 This symbol is known as a String Constant rather than a
5011 ConstLit which indicates a number.
5012 If the constant already exits
5013 then a duplicate constant is not entered in the tree.
5014 All values of constant strings
5015 are ignored in Pass 1 and evaluated in Pass 2 via
5016 character manipulation.
5017 In this procedure ConstName is the string.
5020 PROCEDURE MakeConstLitString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
5025 sym := GetSymKey (ConstLitStringTree, ConstName) ;
5029 PutSymKey (ConstLitStringTree, ConstName, sym) ;
5030 pSym := GetPsym (sym) ;
5032 SymbolType := ConstStringSym ;
5035 ConstStringSym: InitConstString (tok, sym, ConstName, ConstName,
5037 sym, NulSym, NulSym, NulSym)
5040 InternalError ('expecting ConstString symbol')
5045 END MakeConstLitString ;
5052 PROCEDURE BackFillString (sym, m2sym, m2nulsym, csym, cnulsym: CARDINAL) ;
5058 pSym := GetPsym (sym) ;
5062 ConstStringSym: ConstString.M2Variant := m2sym ;
5063 ConstString.NulM2Variant := m2nulsym ;
5064 ConstString.CVariant := csym ;
5065 ConstString.NulCVariant := cnulsym
5068 InternalError ('expecting ConstStringSym')
5072 END BackFillString ;
5076 InitConstString - initialize the constant string and back fill any
5077 previous string variants.
5080 PROCEDURE InitConstString (tok: CARDINAL; sym: CARDINAL; name, contents: Name;
5081 kind: ConstStringVariant;
5082 m2sym, m2nulsym, csym, cnulsym: CARDINAL) ;
5086 pSym := GetPsym (sym) ;
5088 SymbolType := ConstStringSym ;
5091 ConstStringSym: ConstString.name := name ;
5092 ConstString.StringVariant := kind ;
5093 PutConstString (tok, sym, contents) ;
5094 BackFillString (sym,
5095 m2sym, m2nulsym, csym, cnulsym) ;
5096 BackFillString (m2sym,
5097 m2sym, m2nulsym, csym, cnulsym) ;
5098 BackFillString (m2nulsym,
5099 m2sym, m2nulsym, csym, cnulsym) ;
5100 BackFillString (csym,
5101 m2sym, m2nulsym, csym, cnulsym) ;
5102 BackFillString (cnulsym,
5103 m2sym, m2nulsym, csym, cnulsym) ;
5104 ConstString.Scope := GetCurrentScope() ;
5105 InitWhereDeclaredTok (tok, ConstString.At)
5108 InternalError ('expecting ConstStringSym')
5111 END InitConstString ;
5115 GetConstStringM2 - returns the Modula-2 variant of a string
5116 (with no added nul terminator).
5119 PROCEDURE GetConstStringM2 (sym: CARDINAL) : CARDINAL ;
5123 pSym := GetPsym (sym) ;
5127 ConstStringSym: RETURN ConstString.M2Variant
5130 InternalError ('expecting ConstStringSym')
5133 END GetConstStringM2 ;
5137 GetConstStringC - returns the C variant of a string
5138 (with no added nul terminator).
5141 PROCEDURE GetConstStringC (sym: CARDINAL) : CARDINAL ;
5145 pSym := GetPsym (sym) ;
5149 ConstStringSym: RETURN ConstString.CVariant
5152 InternalError ('expecting ConstStringSym')
5155 END GetConstStringC ;
5159 GetConstStringM2nul - returns the Modula-2 variant of a string
5160 (with added nul terminator).
5163 PROCEDURE GetConstStringM2nul (sym: CARDINAL) : CARDINAL ;
5167 pSym := GetPsym (sym) ;
5171 ConstStringSym: RETURN ConstString.NulM2Variant
5174 InternalError ('expecting ConstStringSym')
5177 END GetConstStringM2nul ;
5181 GetConstStringCnul - returns the C variant of a string
5182 (with no added nul terminator).
5185 PROCEDURE GetConstStringCnul (sym: CARDINAL) : CARDINAL ;
5189 pSym := GetPsym (sym) ;
5193 ConstStringSym: RETURN ConstString.NulCVariant
5196 InternalError ('expecting ConstStringSym')
5199 END GetConstStringCnul ;
5203 IsConstStringNulTerminated - returns TRUE if the constant string, sym,
5204 should be created with a nul terminator.
5207 PROCEDURE IsConstStringNulTerminated (sym: CARDINAL) : BOOLEAN ;
5211 pSym := GetPsym (sym) ;
5215 ConstStringSym: RETURN ((ConstString.StringVariant = m2nulstr) OR
5216 (ConstString.StringVariant = cnulstr))
5219 InternalError ('expecting ConstStringSym')
5222 END IsConstStringNulTerminated ;
5226 MakeConstStringCnul - creates a constant string nul terminated string suitable for C.
5227 sym is a ConstString and a new symbol is returned
5228 with the escape sequences converted into characters.
5231 PROCEDURE MakeConstStringCnul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
5233 pSym : PtrToSymbol ;
5236 pSym := GetPsym (GetConstStringM2 (sym)) ;
5240 ConstStringSym: Assert (ConstString.StringVariant = m2str) ;
5241 ConstString.CVariant := MakeConstStringC (tok, sym) ;
5242 IF ConstString.NulCVariant = NulSym
5245 ConstString.NulCVariant := newstr ;
5246 InitConstString (tok, newstr, ConstString.name, GetString (ConstString.CVariant),
5248 ConstString.M2Variant, ConstString.NulM2Variant, ConstString.CVariant, ConstString.NulCVariant)
5250 RETURN ConstString.NulCVariant
5253 InternalError ('expecting ConstStringSym')
5256 END MakeConstStringCnul ;
5260 MakeConstStringM2nul - creates a constant string nul terminated string.
5261 sym is a ConstString and a new symbol is returned.
5264 PROCEDURE MakeConstStringM2nul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
5268 pSym := GetPsym (GetConstStringM2 (sym)) ;
5272 ConstStringSym: Assert (ConstString.StringVariant = m2str) ;
5273 IF ConstString.NulM2Variant = NulSym
5275 NewSym (ConstString.NulM2Variant) ;
5276 InitConstString (tok, ConstString.NulM2Variant,
5277 ConstString.name, ConstString.Contents,
5279 ConstString.M2Variant, ConstString.NulM2Variant,
5280 ConstString.CVariant, ConstString.NulCVariant)
5282 RETURN ConstString.NulM2Variant
5285 InternalError ('expecting ConstStringSym')
5288 END MakeConstStringM2nul ;
5292 MakeConstStringC - creates a constant string suitable for C.
5293 sym is a Modula-2 ConstString and a new symbol is returned
5294 with the escape sequences converted into characters.
5295 It is not nul terminated.
5298 PROCEDURE MakeConstStringC (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
5300 pSym : PtrToSymbol ;
5303 pSym := GetPsym (sym) ;
5307 ConstStringSym: IF ConstString.StringVariant = cstr
5309 RETURN sym (* this is already the C variant. *)
5310 ELSIF ConstString.CVariant = NulSym
5312 Assert (ConstString.StringVariant = m2str) ; (* we can only derive string variants from Modula-2 strings. *)
5313 Assert (sym = ConstString.M2Variant) ;
5314 (* we need to create a new one and return the new symbol. *)
5315 s := HandleEscape (InitStringCharStar (KeyToCharStar (GetString (ConstString.M2Variant)))) ;
5316 NewSym (ConstString.CVariant) ;
5317 InitConstString (tok, ConstString.CVariant, ConstString.name, makekey (string (s)),
5319 ConstString.M2Variant, ConstString.NulM2Variant, ConstString.CVariant, ConstString.NulCVariant) ;
5322 RETURN ConstString.CVariant
5325 InternalError ('expecting ConstStringSym')
5328 END MakeConstStringC ;
5332 MakeConstString - puts a constant into the symboltable which is a string.
5333 The string value is unknown at this time and will be
5334 filled in later by PutString.
5337 PROCEDURE MakeConstString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
5343 PutSymKey (ConstLitStringTree, ConstName, sym) ;
5344 pSym := GetPsym (sym) ;
5346 SymbolType := ConstStringSym ;
5349 ConstStringSym : InitConstString (tok, sym, ConstName, NulName,
5350 m2str, sym, NulSym, NulSym, NulSym)
5353 InternalError ('expecting ConstString symbol')
5357 END MakeConstString ;
5361 PutConstString - places a string, String, into a constant symbol, Sym.
5362 Sym maybe a ConstString or a ConstVar. If the later is
5363 true then the ConstVar is converted to a ConstString.
5366 PROCEDURE PutConstString (tok: CARDINAL; sym: CARDINAL; contents: Name) ;
5370 pSym := GetPsym (sym) ;
5374 ConstStringSym: ConstString.Length := LengthKey (contents) ;
5375 ConstString.Contents := contents ;
5376 InitWhereFirstUsedTok (tok, ConstString.At) |
5378 ConstVarSym : (* ok altering this to ConstString *)
5379 (* copy name and alter symbol. *)
5380 InitConstString (tok, sym, ConstVar.name, contents,
5382 sym, NulSym, NulSym, NulSym)
5385 InternalError ('expecting ConstString or ConstVar symbol')
5388 END PutConstString ;
5392 IsConstStringM2 - returns whether this conststring is an unaltered Modula-2 string.
5395 PROCEDURE IsConstStringM2 (sym: CARDINAL) : BOOLEAN ;
5399 pSym := GetPsym (sym) ;
5403 ConstStringSym: RETURN ConstString.StringVariant = m2str
5406 InternalError ('expecting ConstString symbol')
5409 END IsConstStringM2 ;
5413 IsConstStringC - returns whether this conststring is a C style string
5414 which will have any escape translated.
5417 PROCEDURE IsConstStringC (sym: CARDINAL) : BOOLEAN ;
5421 pSym := GetPsym (sym) ;
5425 ConstStringSym: RETURN ConstString.StringVariant = cstr
5428 InternalError ('expecting ConstString symbol')
5431 END IsConstStringC ;
5435 IsConstStringM2nul - returns whether this conststring is a Modula-2 string which
5436 contains a nul terminator.
5439 PROCEDURE IsConstStringM2nul (sym: CARDINAL) : BOOLEAN ;
5443 pSym := GetPsym (sym) ;
5447 ConstStringSym: RETURN ConstString.StringVariant = m2nulstr
5450 InternalError ('expecting ConstString symbol')
5453 END IsConstStringM2nul ;
5457 IsConstStringCnul - returns whether this conststring is a C style string
5458 which will have any escape translated and also contains
5462 PROCEDURE IsConstStringCnul (sym: CARDINAL) : BOOLEAN ;
5466 pSym := GetPsym (sym) ;
5470 ConstStringSym: RETURN ConstString.StringVariant = cnulstr
5473 InternalError ('expecting ConstString symbol')
5476 END IsConstStringCnul ;
5480 GetString - returns the contents of the string symbol sym, note that
5481 this is not the same as GetName (unless it was a literal).
5484 PROCEDURE GetString (Sym: CARDINAL) : Name ;
5488 pSym := GetPsym (Sym) ;
5492 ConstStringSym: RETURN ConstString.Contents
5495 InternalError ('expecting ConstString symbol')
5502 GetStringLength - returns the length of the string symbol Sym.
5505 PROCEDURE GetStringLength (Sym: CARDINAL) : CARDINAL ;
5509 pSym := GetPsym (Sym) ;
5513 ConstStringSym: RETURN ConstString.Length
5516 InternalError ('expecting ConstString symbol')
5519 END GetStringLength ;
5523 PutVariableAtAddress - determines that a variable, sym, is declared at
5527 PROCEDURE PutVariableAtAddress (sym: CARDINAL; address: CARDINAL) ;
5531 Assert(sym#NulSym) ;
5532 pSym := GetPsym(sym) ;
5536 VarSym: Var.AtAddress := TRUE ;
5537 Var.Address := address
5540 InternalError ('expecting a variable symbol')
5543 END PutVariableAtAddress ;
5547 GetVariableAtAddress - returns the address at which variable, sym, is declared.
5550 PROCEDURE GetVariableAtAddress (sym: CARDINAL) : CARDINAL ;
5554 Assert(sym#NulSym) ;
5555 pSym := GetPsym(sym) ;
5559 VarSym: RETURN( Var.Address )
5562 InternalError ('expecting a variable symbol')
5565 END GetVariableAtAddress ;
5569 IsVariableAtAddress - returns TRUE if a variable, sym, was declared at
5573 PROCEDURE IsVariableAtAddress (sym: CARDINAL) : BOOLEAN ;
5577 Assert(sym#NulSym) ;
5578 pSym := GetPsym(sym) ;
5582 VarSym: RETURN( Var.AtAddress )
5585 InternalError ('expecting a variable symbol')
5588 END IsVariableAtAddress ;
5592 PutVariableSSA - assigns value to the SSA field within variable sym.
5595 PROCEDURE PutVariableSSA (sym: CARDINAL; value: BOOLEAN) ;
5599 Assert (sym#NulSym) ;
5600 pSym := GetPsym (sym) ;
5604 VarSym: Var.IsSSA := value
5607 InternalError ('expecting a variable symbol')
5610 END PutVariableSSA ;
5614 IsVariableSSA - returns TRUE if variable is known to be a SSA.
5617 PROCEDURE IsVariableSSA (sym: CARDINAL) : BOOLEAN ;
5621 Assert (sym#NulSym) ;
5622 pSym := GetPsym (sym) ;
5626 VarSym: RETURN Var.IsSSA
5629 InternalError ('expecting a variable symbol')
5636 PutPriority - places a interrupt, priority, value into module, module.
5639 PROCEDURE PutPriority (module: CARDINAL; priority: CARDINAL) ;
5643 Assert(module#NulSym) ;
5644 pSym := GetPsym(module) ;
5648 DefImpSym: DefImp.Priority := priority |
5649 ModuleSym: Module.Priority := priority
5652 InternalError ('expecting DefImp or Module symbol')
5659 GetPriority - returns the interrupt priority which was assigned to
5663 PROCEDURE GetPriority (module: CARDINAL) : CARDINAL ;
5667 Assert(module#NulSym) ;
5668 pSym := GetPsym(module) ;
5672 DefImpSym: RETURN( DefImp.Priority ) |
5673 ModuleSym: RETURN( Module.Priority )
5676 InternalError ('expecting DefImp or Module symbol')
5683 PutNeedSavePriority - set a boolean flag indicating that this procedure
5684 needs to save and restore interrupts.
5687 PROCEDURE PutNeedSavePriority (sym: CARDINAL) ;
5691 pSym := GetPsym(sym) ;
5695 ProcedureSym: Procedure.SavePriority := TRUE
5698 InternalError ('expecting procedure symbol')
5701 END PutNeedSavePriority ;
5705 GetNeedSavePriority - returns the boolean flag indicating whether this procedure
5706 needs to save and restore interrupts.
5709 PROCEDURE GetNeedSavePriority (sym: CARDINAL) : BOOLEAN ;
5713 pSym := GetPsym(sym) ;
5717 ProcedureSym: RETURN( Procedure.SavePriority )
5720 InternalError ('expecting procedure symbol')
5723 END GetNeedSavePriority ;
5727 GetProcedureBuiltin - returns the builtin name for the equivalent procedure, Sym.
5730 PROCEDURE GetProcedureBuiltin (Sym: CARDINAL) : Name ;
5734 pSym := GetPsym(Sym) ;
5738 ProcedureSym: RETURN( Procedure.BuiltinName )
5741 InternalError ('expecting procedure symbol')
5744 END GetProcedureBuiltin ;
5748 PutProcedureBuiltin - assigns the builtin name for the equivalent procedure, Sym.
5751 PROCEDURE PutProcedureBuiltin (Sym: CARDINAL; name: Name) ;
5755 pSym := GetPsym(Sym) ;
5759 ProcedureSym : Procedure.BuiltinName := name ;
5760 Procedure.IsBuiltin := TRUE ;
5761 (* we use the same extra pass method as hidden types for builtins *)
5762 PutHiddenTypeDeclared
5765 InternalError ('expecting procedure symbol')
5768 END PutProcedureBuiltin ;
5772 IsProcedureBuiltin - returns TRUE if this procedure has a builtin equivalent.
5775 PROCEDURE IsProcedureBuiltin (Sym: CARDINAL) : BOOLEAN ;
5779 pSym := GetPsym(Sym) ;
5783 ProcedureSym : RETURN( Procedure.IsBuiltin )
5786 InternalError ('expecting procedure symbol')
5789 END IsProcedureBuiltin ;
5793 CanUseBuiltin - returns TRUE if the procedure, Sym, can be
5794 inlined via a builtin function.
5797 PROCEDURE CanUseBuiltin (Sym: CARDINAL) : BOOLEAN ;
5799 RETURN( (NOT DebugBuiltins) AND
5800 (BuiltinExists (KeyToCharStar (GetProcedureBuiltin (Sym))) OR
5801 BuiltinExists (KeyToCharStar (GetSymName (Sym)))) )
5806 IsProcedureBuiltinAvailable - return TRUE if procedure is available as a builtin
5807 for the target architecture.
5810 PROCEDURE IsProcedureBuiltinAvailable (procedure: CARDINAL) : BOOLEAN ;
5812 RETURN IsProcedureBuiltin (procedure) AND CanUseBuiltin (procedure)
5813 END IsProcedureBuiltinAvailable ;
5817 PutProcedureInline - determines that procedure, Sym, has been requested to be inlined.
5820 PROCEDURE PutProcedureInline (Sym: CARDINAL) ;
5824 pSym := GetPsym(Sym) ;
5828 ProcedureSym : Procedure.IsInline := TRUE ;
5831 InternalError ('expecting procedure symbol')
5834 END PutProcedureInline ;
5838 IsProcedureBuiltin - returns TRUE if this procedure was declared as inlined.
5841 PROCEDURE IsProcedureInline (Sym: CARDINAL) : BOOLEAN ;
5845 pSym := GetPsym(Sym) ;
5849 ProcedureSym : RETURN( Procedure.IsInline )
5852 InternalError ('expecting procedure symbol')
5855 END IsProcedureInline ;
5859 PutConstSet - informs the const var symbol, sym, that it is or will contain
5863 PROCEDURE PutConstSet (Sym: CARDINAL) ;
5867 pSym := GetPsym(Sym) ;
5871 ConstVarSym: ConstVar.IsSet := TRUE |
5872 ConstLitSym: ConstLit.IsSet := TRUE
5875 InternalError ('expecting ConstVar symbol')
5882 IsConstSet - returns TRUE if the constant is declared as a set.
5885 PROCEDURE IsConstSet (Sym: CARDINAL) : BOOLEAN ;
5889 pSym := GetPsym(Sym) ;
5893 ConstVarSym: RETURN( ConstVar.IsSet ) |
5894 ConstLitSym: RETURN( ConstLit.IsSet )
5904 PutConstructor - informs the const var symbol, sym, that it is or
5905 will contain a constructor (record, set or array)
5909 PROCEDURE PutConstructor (Sym: CARDINAL) ;
5913 pSym := GetPsym(Sym) ;
5917 ConstVarSym: ConstVar.IsConstructor := TRUE |
5918 ConstLitSym: ConstLit.IsConstructor := TRUE
5921 InternalError ('expecting ConstVar or ConstLit symbol')
5924 END PutConstructor ;
5928 IsConstructor - returns TRUE if the constant is declared as a
5929 constant set, array or record.
5932 PROCEDURE IsConstructor (Sym: CARDINAL) : BOOLEAN ;
5936 pSym := GetPsym(Sym) ;
5940 ConstVarSym: RETURN( ConstVar.IsConstructor ) |
5941 ConstLitSym: RETURN( ConstLit.IsConstructor )
5951 PutConstructorFrom - sets the from type field in constructor,
5955 PROCEDURE PutConstructorFrom (Sym: CARDINAL; from: CARDINAL) ;
5959 pSym := GetPsym(Sym) ;
5963 ConstVarSym: ConstVar.FromType := from ;
5964 ConstVar.UnresFromType := TRUE |
5965 ConstLitSym: ConstLit.FromType := from ;
5966 ConstLit.UnresFromType := TRUE
5969 InternalError ('expecting ConstVar or ConstLit symbol')
5972 IncludeItemIntoList(UnresolvedConstructorType, Sym)
5973 END PutConstructorFrom ;
5977 InitPacked - initialise packedInfo to FALSE and NulSym.
5980 PROCEDURE InitPacked (VAR packedInfo: PackedInfo) ;
5984 PackedEquiv := NulSym
5990 doEquivalent - create a packed equivalent symbol for, sym, and return the
5991 new symbol. It sets both fields in packedInfo to FALSE
5995 PROCEDURE doEquivalent (VAR packedInfo: PackedInfo; sym: CARDINAL) : CARDINAL ;
6001 pSym := GetPsym(nSym) ;
6003 SymbolType := EquivSym ;
6006 packedInfo.IsPacked := TRUE ;
6007 packedInfo.PackedEquiv := NulSym
6010 packedInfo.IsPacked := FALSE ;
6011 packedInfo.PackedEquiv := nSym ;
6017 MakeEquivalent - return the equivalent packed symbol for, sym.
6020 PROCEDURE MakeEquivalent (sym: CARDINAL) : CARDINAL ;
6024 pSym := GetPsym(sym) ;
6028 EnumerationSym: RETURN( doEquivalent(Enumeration.packedInfo, sym) ) |
6029 SubrangeSym : RETURN( doEquivalent(Subrange.packedInfo, sym) ) |
6030 TypeSym : RETURN( doEquivalent(Type.packedInfo, sym) ) |
6031 SetSym : RETURN( doEquivalent(Set.packedInfo, sym) )
6034 InternalError ('expecting type, subrange or enumerated type symbol')
6037 END MakeEquivalent ;
6044 PROCEDURE GetEquivalent (VAR packedInfo: PackedInfo; sym: CARDINAL) : CARDINAL ;
6050 ELSIF PackedEquiv=NulSym
6052 PackedEquiv := MakeEquivalent(sym)
6054 RETURN( PackedEquiv )
6060 GetPackedEquivalent - returns the packed equivalent of type, sym.
6061 sym must be a type, subrange or enumerated type.
6064 PROCEDURE GetPackedEquivalent (sym: CARDINAL) : CARDINAL ;
6068 pSym := GetPsym(sym) ;
6072 EnumerationSym: RETURN( GetEquivalent(Enumeration.packedInfo, sym) ) |
6073 SubrangeSym : RETURN( GetEquivalent(Subrange.packedInfo, sym) ) |
6074 TypeSym : RETURN( GetEquivalent(Type.packedInfo, sym) ) |
6075 SetSym : RETURN( GetEquivalent(Set.packedInfo, sym) )
6078 InternalError ('expecting type, subrange or enumerated type symbol')
6081 END GetPackedEquivalent ;
6085 GetNonPackedEquivalent - returns the equivalent non packed symbol associated with, sym.
6088 PROCEDURE GetNonPackedEquivalent (sym: CARDINAL) : CARDINAL ;
6092 pSym := GetPsym(sym) ;
6096 EquivSym: RETURN( Equiv.nonPacked )
6099 InternalError ('expecting equivalent symbol')
6102 END GetNonPackedEquivalent ;
6106 IsEquivalent - returns TRUE if, sym, is an equivalent symbol.
6109 PROCEDURE IsEquivalent (sym: CARDINAL) : BOOLEAN ;
6113 pSym := GetPsym(sym) ;
6117 EquivSym: RETURN( TRUE )
6127 MakeSubrange - makes a new symbol into a subrange type with
6131 PROCEDURE MakeSubrange (tok: CARDINAL; SubrangeName: Name) : CARDINAL ;
6133 pSym : PtrToSymbol ;
6134 sym, oaf: CARDINAL ;
6136 sym := HandleHiddenOrDeclare (tok, SubrangeName, oaf) ;
6139 pSym := GetPsym(sym) ;
6141 SymbolType := SubrangeSym ;
6143 name := SubrangeName ;
6144 Low := NulSym ; (* Index to a symbol determining *)
6145 (* the lower bound of subrange. *)
6146 (* Points to a constant - *)
6147 (* possibly created by *)
6148 (* ConstExpression. *)
6149 High := NulSym ; (* Index to a symbol determining *)
6150 (* the lower bound of subrange. *)
6151 (* Points to a constant - *)
6152 (* possibly created by *)
6153 (* ConstExpression. *)
6154 Type := NulSym ; (* Index to a type. Determines *)
6155 (* the type of subrange. *)
6156 Align := NulSym ; (* The alignment of this type. *)
6157 InitPacked(packedInfo) ; (* not packed and no equivalent *)
6158 InitTree(ConstLitTree) ; (* constants of this type. *)
6159 Size := InitValue() ; (* Size determines the type size *)
6160 oafamily := oaf ; (* The unbounded sym for this *)
6161 Scope := GetCurrentScope() ; (* Which scope created it *)
6162 InitWhereDeclaredTok(tok, At) (* Declared here *)
6166 ForeachOAFamily(oaf, doFillInOAFamily) ;
6172 MakeArray - makes an Array symbol with name ArrayName.
6175 PROCEDURE MakeArray (tok: CARDINAL; ArrayName: Name) : CARDINAL ;
6177 pSym : PtrToSymbol ;
6178 sym, oaf: CARDINAL ;
6180 sym := HandleHiddenOrDeclare (tok, ArrayName, oaf) ;
6183 pSym := GetPsym(sym) ;
6185 SymbolType := ArraySym ;
6188 Subscript := NulSym ; (* Contains the array subscripts. *)
6189 Size := InitValue() ; (* Size of array. *)
6190 Offset := InitValue() ; (* Offset of array. *)
6191 Type := NulSym ; (* The Array Type. ARRAY OF Type. *)
6192 Large := FALSE ; (* is this array large? *)
6193 Align := NulSym ; (* The alignment of this type. *)
6194 oafamily := oaf ; (* The unbounded for this array *)
6195 Scope := GetCurrentScope() ; (* Which scope created it *)
6196 InitWhereDeclaredTok(tok, At) (* Declared here *)
6200 ForeachOAFamily(oaf, doFillInOAFamily) ;
6206 PutArrayLarge - indicates that this is a large array in which case
6207 the interface to gcc maps this array from 0..high-low,
6208 using an integer indice.
6211 PROCEDURE PutArrayLarge (array: CARDINAL) ;
6215 IF NOT IsError(array)
6217 Assert(IsArray(array)) ;
6218 pSym := GetPsym(array) ;
6227 IsArrayLarge - returns TRUE if we need to treat this as a large array.
6230 PROCEDURE IsArrayLarge (array: CARDINAL) : BOOLEAN ;
6234 Assert(IsArray(array)) ;
6235 pSym := GetPsym(array) ;
6236 RETURN( pSym^.Array.Large )
6241 GetModule - Returns the Module symbol for the module with name, name.
6244 PROCEDURE GetModule (name: Name) : CARDINAL ;
6246 RETURN( GetSymKey(ModuleTree, name) )
6251 GetLowestType - Returns the lowest type in the type chain of
6253 If NulSym is returned then we assume type unknown or
6254 you have reqested the type of a base type.
6257 PROCEDURE GetLowestType (Sym: CARDINAL) : CARDINAL ;
6262 Assert(Sym#NulSym) ;
6263 pSym := GetPsym(Sym) ;
6267 VarSym : type := Var.Type |
6268 ConstLitSym : type := ConstLit.Type |
6269 ConstVarSym : type := ConstVar.Type |
6270 ConstStringSym : type := NulSym | (* No type for a string *)
6271 TypeSym : type := Type.Type |
6272 RecordFieldSym : type := RecordField.Type |
6273 RecordSym : type := NulSym | (* No type for a record *)
6274 EnumerationFieldSym : type := EnumerationField.Type |
6275 EnumerationSym : type := NulSym | (* No type for enumeration *)
6276 PointerSym : type := Sym | (* we don't go to Pointer.Type *)
6277 ProcedureSym : type := Procedure.ReturnType |
6278 ProcTypeSym : type := ProcType.ReturnType |
6279 ParamSym : type := Param.Type |
6280 VarParamSym : type := VarParam.Type |
6281 SubrangeSym : type := Subrange.Type |
6282 ArraySym : type := Array.Type |
6283 SubscriptSym : type := Subscript.Type |
6284 SetSym : type := Set.Type |
6285 UnboundedSym : type := Unbounded.Type |
6286 UndefinedSym : type := NulSym |
6287 DummySym : type := NulSym
6290 InternalError ('not implemented yet')
6293 pSym := GetPsym(Sym) ;
6294 IF (pSym^.SymbolType=TypeSym) AND (type=NulSym)
6296 type := Sym (* Base Type *)
6297 ELSIF (type#NulSym) AND IsType(type) AND (GetAlignment(type)=NulSym)
6299 type := GetLowestType(type) (* Type def *)
6306 doGetType - subsiduary helper procedure function of GetDType, GetSType and GetLType.
6309 PROCEDURE doGetType (sym: CARDINAL; skipEquiv, skipAlign, skipHidden, skipBase: BOOLEAN) : CARDINAL ;
6315 Assert (sym # NulSym) ;
6316 pSym := GetPsym (sym) ;
6320 OAFamilySym : type := OAFamily.SimpleType |
6321 VarSym : type := GetTypeOfVar(sym) |
6322 ConstLitSym : type := ConstLit.Type |
6323 ConstVarSym : type := ConstVar.Type |
6324 ConstStringSym : IF ConstString.Length=1
6328 type := NulSym (* No type for a string *)
6330 TypeSym : type := Type.Type |
6331 RecordFieldSym : type := RecordField.Type |
6332 RecordSym : type := NulSym | (* No type for a record *)
6333 VarientSym : type := NulSym | (* No type for a record *)
6334 EnumerationFieldSym : type := EnumerationField.Type |
6335 EnumerationSym : type := NulSym | (* No type for enumeration *)
6336 PointerSym : type := Pointer.Type |
6337 ProcedureSym : type := Procedure.ReturnType |
6338 ProcTypeSym : type := ProcType.ReturnType |
6339 ParamSym : type := Param.Type |
6340 VarParamSym : type := VarParam.Type |
6341 SubrangeSym : type := Subrange.Type |
6342 ArraySym : type := Array.Type |
6343 SubscriptSym : type := Subscript.Type |
6344 SetSym : type := Set.Type |
6345 UnboundedSym : type := Unbounded.Type |
6346 UndefinedSym : type := NulSym |
6347 PartialUnboundedSym : type := PartialUnbounded.Type |
6348 ObjectSym : type := NulSym
6351 InternalError ('not implemented yet')
6354 IF (type=NulSym) AND IsType(sym) AND (NOT skipBase)
6356 RETURN sym (* sym is a base type *)
6359 IF IsType(type) AND skipEquiv
6361 IF (NOT IsHiddenType(type)) OR skipHidden
6363 IF (GetAlignment(type)=NulSym) OR skipAlign
6365 RETURN doGetType (type, skipEquiv, skipAlign, skipHidden, skipBase)
6375 GetLType - get lowest type. It returns the lowest type
6376 of symbol, sym. It skips over type equivalences.
6377 It will not skip over base types.
6380 PROCEDURE GetLType (sym: CARDINAL) : CARDINAL ;
6383 Assert (doGetType (sym, TRUE, TRUE, TRUE, FALSE) = GetLowestType (sym)) ;
6385 RETURN doGetType (sym, TRUE, TRUE, TRUE, FALSE)
6390 GetSType - get source type. It returns the type closest
6391 to the object. It does not skip over type
6392 equivalences. It will skip over base types.
6395 PROCEDURE GetSType (sym: CARDINAL) : CARDINAL ;
6397 Assert (doGetType (sym, FALSE, FALSE, FALSE, TRUE) = GetType (sym)) ;
6398 RETURN doGetType (sym, FALSE, FALSE, FALSE, TRUE)
6403 GetDType - get gcc declared type. It returns the type
6404 of the object which is declared to GCC.
6405 It does skip over type equivalences but only
6406 if they do not contain a user alignment.
6407 It does not skip over hidden types.
6408 It does not skip over base types.
6411 PROCEDURE GetDType (sym: CARDINAL) : CARDINAL ;
6414 Assert (doGetType (sym, TRUE, FALSE, FALSE, FALSE) = SkipType(GetType(sym))) ;
6416 RETURN doGetType (sym, TRUE, FALSE, FALSE, FALSE)
6421 GetTypeOfVar - returns the type of symbol, var.
6424 PROCEDURE GetTypeOfVar (var: CARDINAL) : CARDINAL ;
6429 pSym := GetPsym(var) ;
6433 VarSym: IF Var.IsTemp AND Var.IsComponentRef
6435 high := Indexing.HighIndice(Var.list) ;
6436 RETURN( GetType(GetFromIndex(Var.list, high)) )
6442 InternalError ('expecting a var symbol')
6449 GetType - Returns the symbol that is the TYPE symbol to Sym.
6450 If zero is returned then we assume type unknown.
6453 PROCEDURE GetType (Sym: CARDINAL) : CARDINAL ;
6458 Assert(Sym#NulSym) ;
6459 pSym := GetPsym(Sym) ;
6463 OAFamilySym : type := OAFamily.SimpleType |
6464 VarSym : type := GetTypeOfVar(Sym) |
6465 ConstLitSym : type := ConstLit.Type |
6466 ConstVarSym : type := ConstVar.Type |
6467 ConstStringSym : IF ConstString.Length=1
6471 type := NulSym (* No type for a string *)
6473 TypeSym : type := Type.Type |
6474 RecordFieldSym : type := RecordField.Type |
6475 RecordSym : type := NulSym | (* No type for a record *)
6476 VarientSym : type := NulSym | (* No type for a record *)
6477 EnumerationFieldSym : type := EnumerationField.Type |
6478 EnumerationSym : type := NulSym | (* No type for enumeration *)
6479 PointerSym : type := Pointer.Type |
6480 ProcedureSym : type := Procedure.ReturnType |
6481 ProcTypeSym : type := ProcType.ReturnType |
6482 ParamSym : type := Param.Type |
6483 VarParamSym : type := VarParam.Type |
6484 SubrangeSym : type := Subrange.Type |
6485 ArraySym : type := Array.Type |
6486 SubscriptSym : type := Subscript.Type |
6487 SetSym : type := Set.Type |
6488 UnboundedSym : type := Unbounded.Type |
6489 UndefinedSym : type := NulSym |
6490 PartialUnboundedSym : type := PartialUnbounded.Type |
6491 ObjectSym : type := NulSym
6494 InternalError ('not implemented yet')
6502 SkipType - if sym is a TYPE foo = bar
6503 then call SkipType(bar)
6506 it does not skip over hidden types.
6509 PROCEDURE SkipType (Sym: CARDINAL) : CARDINAL ;
6511 IF (Sym#NulSym) AND IsType(Sym) AND
6512 (NOT IsHiddenType(Sym)) AND (GetType(Sym)#NulSym)
6514 RETURN( SkipType(GetType(Sym)) )
6522 SkipTypeAndSubrange - if sym is a TYPE foo = bar OR
6523 sym is declared as a subrange of bar
6524 then call SkipTypeAndSubrange(bar)
6527 it does not skip over hidden types.
6530 PROCEDURE SkipTypeAndSubrange (Sym: CARDINAL) : CARDINAL ;
6532 IF (Sym#NulSym) AND (IsType(Sym) OR IsSubrange(Sym)) AND
6533 (NOT IsHiddenType(Sym)) AND (GetType(Sym)#NulSym)
6535 RETURN( SkipTypeAndSubrange(GetType(Sym)) )
6539 END SkipTypeAndSubrange ;
6543 IsHiddenType - returns TRUE if, Sym, is a Type and is also declared as a hidden type.
6546 PROCEDURE IsHiddenType (Sym: CARDINAL) : BOOLEAN ;
6550 pSym := GetPsym(Sym) ;
6554 TypeSym: RETURN( Type.IsHidden )
6564 GetConstLitType - returns the type of the constant of, name.
6565 All floating point constants have type LONGREAL.
6566 Character constants are type CHAR.
6567 Integer values are INTEGER, LONGINT or LONGCARD
6568 depending upon their value.
6571 PROCEDURE GetConstLitType (tok: CARDINAL; name: Name;
6572 VAR overflow: BOOLEAN; issueError: BOOLEAN) : CARDINAL ;
6577 s := InitStringCharStar (KeyToCharStar (name)) ;
6578 IF char (s, -1) = 'C'
6580 s := KillString (s) ;
6583 IF Index (s, '.', 0) # -1 (* found a '.' in our constant *)
6585 s := KillString (s) ;
6588 loc := TokenToLocation (tok) ;
6589 CASE char (s, -1) OF
6591 'H': overflow := OverflowZType (loc, string (s), 16, issueError) |
6592 'B': overflow := OverflowZType (loc, string (s), 8, issueError) |
6593 'A': overflow := OverflowZType (loc, string (s), 2, issueError)
6596 overflow := OverflowZType (loc, string (s), 10, issueError)
6598 s := KillString (s) ;
6601 END GetConstLitType ;
6605 GetLocalSym - only searches the scope Sym for a symbol with name
6606 and returns the index to the symbol.
6609 PROCEDURE GetLocalSym (Sym: CARDINAL; name: Name) : CARDINAL ;
6611 pSym : PtrToSymbol ;
6612 LocalSym: CARDINAL ;
6615 WriteString('Attempting to retrieve symbol from ') ; WriteKey(GetSymName(Sym)) ;
6616 WriteString(' local symbol table') ; WriteLn ;
6618 pSym := GetPsym(Sym) ;
6622 EnumerationSym : LocalSym := GetSymKey(Enumeration.LocalSymbols, name) |
6623 RecordSym : LocalSym := GetSymKey(Record.LocalSymbols, name) |
6624 ProcedureSym : LocalSym := GetSymKey(Procedure.LocalSymbols, name) |
6625 ModuleSym : LocalSym := GetSymKey(Module.LocalSymbols, name) |
6626 DefImpSym : LocalSym := GetSymKey(DefImp.LocalSymbols, name)
6629 InternalError ('symbol does not have a LocalSymbols field')
6637 GetNthFromComponent -
6640 PROCEDURE GetNthFromComponent (Sym: CARDINAL; n: CARDINAL) : CARDINAL ;
6644 pSym := GetPsym(Sym) ;
6648 VarSym: IF IsComponent(Sym)
6650 IF InBounds(Var.list, n)
6652 RETURN( GetFromIndex(Var.list, n) )
6657 InternalError ('cannot GetNth from this symbol')
6661 InternalError ('cannot GetNth from this symbol')
6664 END GetNthFromComponent ;
6668 GetNth - returns the n th symbol in the list associated with the scope
6669 of Sym. Sym may be a Module, DefImp, Procedure, Record or
6673 PROCEDURE GetNth (Sym: CARDINAL; n: CARDINAL) : CARDINAL ;
6678 pSym := GetPsym(Sym) ;
6682 RecordSym : i := GetItemFromList (Record.ListOfSons, n) |
6683 VarientSym : i := GetItemFromList (Varient.ListOfSons, n) |
6684 VarientFieldSym : i := GetItemFromList (VarientField.ListOfSons, n) |
6685 ProcedureSym : i := GetItemFromList (Procedure.ListOfVars, n) |
6686 DefImpSym : i := GetItemFromList (DefImp.ListOfVars, n) |
6687 ModuleSym : i := GetItemFromList (Module.ListOfVars, n) |
6688 TupleSym : i := GetFromIndex (Tuple.list, n) |
6689 VarSym : i := GetNthFromComponent (Sym, n) |
6690 EnumerationSym : i := GetItemFromList (Enumeration.ListOfFields, n)
6693 InternalError ('cannot GetNth from this symbol')
6701 GetNthParam - returns the n th parameter of a procedure Sym.
6704 PROCEDURE GetNthParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
6711 (* Demands the return type of the function *)
6714 pSym := GetPsym(Sym) ;
6718 ProcedureSym: i := GetItemFromList(Procedure.ListOfParam, ParamNo) |
6719 ProcTypeSym : i := GetItemFromList(ProcType.ListOfParam, ParamNo)
6722 InternalError ('expecting ProcedureSym or ProcTypeSym')
6731 The Following procedures fill in the symbol table with the
6736 PutVar - gives the VarSym symbol Sym a type Type.
6739 PROCEDURE PutVar (Sym: CARDINAL; VarType: CARDINAL) ;
6743 pSym := GetPsym(Sym) ;
6747 VarSym : Var.Type := VarType ;
6748 ConfigSymInit (Var.InitState[LeftValue], Sym) ;
6749 ConfigSymInit (Var.InitState[RightValue], Sym) |
6750 ConstVarSym: ConstVar.Type := VarType
6753 InternalError ('expecting VarSym or ConstVarSym')
6760 PutLeftValueFrontBackType - gives the variable symbol a front and backend type.
6761 The variable must be a LeftValue.
6764 PROCEDURE PutLeftValueFrontBackType (Sym: CARDINAL; FrontType, BackType: CARDINAL) ;
6768 Assert(GetMode(Sym)=LeftValue) ;
6769 pSym := GetPsym(Sym) ;
6773 VarSym : Var.Type := FrontType ;
6774 Var.BackType := BackType ;
6779 InternalError ('expecting VarSym')
6782 END PutLeftValueFrontBackType ;
6786 GetVarBackEndType - returns the back end type if specified.
6789 PROCEDURE GetVarBackEndType (Sym: CARDINAL) : CARDINAL ;
6793 Assert(Sym#NulSym) ;
6794 pSym := GetPsym(Sym) ;
6798 VarSym: RETURN( Var.BackType )
6804 END GetVarBackEndType ;
6808 PutVarPointerCheck - marks variable, sym, as requiring (or not
6809 depending upon the, value), a NIL pointer check
6810 when this symbol is dereferenced.
6813 PROCEDURE PutVarPointerCheck (sym: CARDINAL; value: BOOLEAN) ;
6819 pSym := GetPsym(sym) ;
6821 IsPointerCheck := value
6824 END PutVarPointerCheck ;
6828 GetVarPointerCheck - returns TRUE if this symbol is a variable and
6829 has been marked as needing a pointer via NIL check.
6832 PROCEDURE GetVarPointerCheck (sym: CARDINAL) : BOOLEAN ;
6838 pSym := GetPsym(sym) ;
6840 RETURN( IsPointerCheck )
6844 END GetVarPointerCheck ;
6848 PutVarWritten - marks variable, sym, as being written to (or not
6849 depending upon the, value).
6852 PROCEDURE PutVarWritten (sym: CARDINAL; value: BOOLEAN) ;
6858 pSym := GetPsym(sym) ;
6867 GetVarWritten - returns TRUE if this symbol is a variable and
6868 has been marked as being written.
6871 PROCEDURE GetVarWritten (sym: CARDINAL) : BOOLEAN ;
6875 pSym := GetPsym(sym) ;
6879 VarSym: RETURN( Var.IsWritten )
6882 InternalError ('expecting VarSym')
6889 PutVarConst - sets the IsConst field to value indicating the variable is read only.
6892 PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ;
6898 pSym := GetPsym (sym) ;
6899 pSym^.Var.IsConst := value
6905 IsVarConst - returns the IsConst field indicating the variable is read only.
6908 PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ;
6912 pSym := GetPsym(sym) ;
6916 VarSym: RETURN( Var.IsConst )
6919 InternalError ('expecting VarSym')
6926 PutConst - gives the constant symbol Sym a type ConstType.
6929 PROCEDURE PutConst (Sym: CARDINAL; ConstType: CARDINAL) ;
6933 pSym := GetPsym(Sym) ;
6937 ConstVarSym: ConstVar.Type := ConstType
6940 InternalError ('expecting ConstVarSym')
6947 PutVarArrayRef - assigns ArrayRef field with value.
6950 PROCEDURE PutVarArrayRef (sym: CARDINAL; value: BOOLEAN) ;
6954 pSym := GetPsym(sym) ;
6958 VarSym: Var.ArrayRef := value
6961 InternalError ('expecting VarSym')
6964 END PutVarArrayRef ;
6968 IsVarArrayRef - returns ArrayRef field value.
6971 PROCEDURE IsVarArrayRef (sym: CARDINAL) : BOOLEAN ;
6975 pSym := GetPsym(sym) ;
6979 VarSym: RETURN (Var.ArrayRef)
6982 InternalError ('expecting VarSym')
6989 PutVarHeap - assigns ArrayRef field with value.
6992 PROCEDURE PutVarHeap (sym: CARDINAL; value: BOOLEAN) ;
6996 pSym := GetPsym(sym) ;
7000 VarSym: Var.Heap := value
7003 InternalError ('expecting VarSym')
7010 IsVarHeap - returns ArrayRef field value.
7013 PROCEDURE IsVarHeap (sym: CARDINAL) : BOOLEAN ;
7017 pSym := GetPsym(sym) ;
7021 VarSym: RETURN (Var.Heap)
7024 InternalError ('expecting VarSym')
7031 PutFieldRecord - places a field, FieldName and FieldType into a record, Sym.
7032 VarSym is a optional varient symbol which can be returned
7033 by a call to GetVarient(fieldsymbol). The created field
7037 PROCEDURE PutFieldRecord (Sym: CARDINAL;
7038 FieldName: Name; FieldType: CARDINAL;
7039 VarSym: CARDINAL) : CARDINAL ;
7042 pSym : PtrToSymbol ;
7047 NewSym(SonSym) ; (* Cannot be used before declared since use occurs *)
7048 (* in pass 3 and it will be declared in pass 2. *)
7049 (* Fill in the SonSym and connect it to its brothers (if any) and *)
7050 (* ensure that it is connected its parent. *)
7051 pSym := GetPsym(Sym) ;
7055 RecordSym : WITH Record DO
7056 PutItemIntoList(ListOfSons, SonSym) ;
7057 Assert(IsItemInList(Record.ListOfSons, SonSym)) ;
7059 n := NoOfItemsInList(ListOfSons) ;
7060 printf3('record %d no of fields in ListOfSons = %d, field %d\n', Sym, n, SonSym) ;
7062 (* Ensure that the Field is in the Parents Local Symbols *)
7063 IF FieldName#NulName
7065 IF GetSymKey(LocalSymbols, FieldName)=NulKey
7067 PutSymKey(LocalSymbols, FieldName, SonSym)
7069 esym := GetSymKey(LocalSymbols, FieldName) ;
7070 MetaErrors1('field record {%1Dad} has already been declared',
7071 'field record duplicate', esym)
7075 CheckRecordConsistency(Sym) |
7076 VarientFieldSym : WITH VarientField DO
7077 PutItemIntoList(ListOfSons, SonSym) ;
7078 ParSym := GetRecord(Parent)
7080 oSym := GetPsym(ParSym) ;
7081 Assert(oSym^.SymbolType=RecordSym) ;
7082 IF FieldName#NulName
7084 oSym := GetPsym(ParSym) ;
7085 PutSymKey(oSym^.Record.LocalSymbols, FieldName, SonSym)
7089 InternalError ('expecting Record symbol')
7092 (* Fill in SonSym *)
7093 oSym := GetPsym(SonSym) ;
7095 SymbolType := RecordFieldSym ;
7104 DeclPacked := FALSE ; (* not known as packed (yet). *)
7105 DeclResolved := FALSE ;
7106 Scope := GetScope(Sym) ;
7107 Size := InitValue() ;
7108 Offset := InitValue() ;
7109 InitWhereDeclared(At)
7113 END PutFieldRecord ;
7117 MakeFieldVarient - returns a FieldVarient symbol which has been
7118 assigned to the Varient symbol, Sym.
7121 PROCEDURE MakeFieldVarient (n: Name; Sym: CARDINAL) : CARDINAL ;
7123 pSym : PtrToSymbol ;
7128 IF NoOfItemsInList(FreeFVarientList)=0
7132 SonSym := GetItemFromList(FreeFVarientList, 1) ;
7133 RemoveItemFromList(FreeFVarientList, SonSym)
7137 pSym := GetPsym(SonSym) ;
7139 SymbolType := VarientFieldSym ;
7140 WITH VarientField DO
7142 InitList(ListOfSons) ;
7143 Parent := GetRecord(Sym) ;
7145 Size := InitValue() ;
7146 Offset := InitValue() ;
7147 DeclPacked := FALSE ;
7148 DeclResolved := FALSE ;
7149 Scope := GetCurrentScope() ;
7150 InitWhereDeclared(At)
7154 END MakeFieldVarient ;
7158 PutFieldVarient - places the field varient, Field, as a brother to, the
7159 varient symbol, sym, and also tells Field that its varient
7163 PROCEDURE PutFieldVarient (Field, Sym: CARDINAL) ;
7167 Assert(IsVarient(Sym)) ;
7168 Assert(IsFieldVarient(Field)) ;
7169 pSym := GetPsym(Sym) ;
7173 VarientSym : IncludeItemIntoList(Varient.ListOfSons, Field)
7176 InternalError ('expecting Varient symbol')
7179 pSym := GetPsym(Field) ;
7183 VarientFieldSym : VarientField.Varient := Sym
7186 InternalError ('expecting VarientField symbol')
7189 (* PutItemIntoList(UsedFVarientList, Field) *)
7190 END PutFieldVarient ;
7194 GetVarient - returns the varient symbol associated with the
7195 record or varient field symbol, Field.
7198 PROCEDURE GetVarient (Field: CARDINAL) : CARDINAL ;
7202 pSym := GetPsym(Field) ;
7206 VarientFieldSym : RETURN( VarientField.Varient ) |
7207 RecordFieldSym : RETURN( RecordField.Varient ) |
7208 VarientSym : RETURN( Varient.Varient )
7218 EnsureOrder - providing that both symbols, a, and, b, exist in
7219 list, l. Ensure that, b, is placed after a.
7222 PROCEDURE EnsureOrder (l: List; a, b: CARDINAL) ;
7226 n := NoOfItemsInList(l) ;
7227 IF IsItemInList(l, a) AND IsItemInList(l, b)
7229 RemoveItemFromList(l, b) ;
7230 IncludeItemIntoList(l, b)
7232 Assert(n=NoOfItemsInList(l))
7237 recordConsist: CARDINAL ; (* is used by CheckRecordConsistency and friends. *)
7244 PROCEDURE DumpSons (sym: CARDINAL) ;
7246 pSym : PtrToSymbol ;
7249 pSym := GetPsym(sym) ;
7253 RecordSym: n := NoOfItemsInList(Record.ListOfSons) ;
7256 f := GetItemFromList(Record.ListOfSons, i) ;
7257 printf3('record %d field %d is %d\n', sym, i, f) ;
7262 InternalError ('expecting record symbol')
7270 CheckListOfSons - checks to see that sym, is present in, recordConsist, ListOfSons.
7273 PROCEDURE CheckListOfSons (sym: WORD) ;
7277 pSym := GetPsym(recordConsist) ;
7281 RecordSym: IF NOT IsItemInList(Record.ListOfSons, sym)
7283 DumpSons(recordConsist) ;
7284 MetaError1('internal error: expecting {%1ad} to exist in record ListOfSons', sym)
7288 InternalError ('expecting record symbol')
7291 END CheckListOfSons ;
7295 CheckRecordConsistency -
7298 PROCEDURE CheckRecordConsistency (sym: CARDINAL) ;
7303 pSym := GetPsym(sym) ;
7307 RecordSym: recordConsist := sym ;
7309 ForeachNodeDo(LocalSymbols, CheckListOfSons)
7313 InternalError ('record symbol expected')
7316 END CheckRecordConsistency ;
7320 IsEmptyFieldVarient - returns TRUE if the field variant has
7321 no fields. This will occur then the
7322 compiler constructs 'else end' variants.
7325 PROCEDURE IsEmptyFieldVarient (sym: CARDINAL) : BOOLEAN ;
7329 pSym := GetPsym(sym) ;
7333 VarientFieldSym: RETURN( NoOfItemsInList(VarientField.ListOfSons)=0 )
7336 InternalError ('varient field symbol expected')
7339 END IsEmptyFieldVarient ;
7343 IsRecordFieldAVarientTag - returns TRUE if record field, sym, is
7347 PROCEDURE IsRecordFieldAVarientTag (sym: CARDINAL) : BOOLEAN ;
7351 IF IsRecordField(sym)
7353 pSym := GetPsym(sym) ;
7354 RETURN( pSym^.RecordField.Tag )
7356 InternalError ('record field symbol expected')
7358 END IsRecordFieldAVarientTag ;
7362 PutVarientTag - places, Tag, into varient, Sym.
7365 PROCEDURE PutVarientTag (Sym, Tag: CARDINAL) ;
7367 pSym : PtrToSymbol ;
7370 pSym := GetPsym(Sym) ;
7374 VarientSym: Varient.tag := Tag
7377 InternalError ('varient symbol expected')
7380 (* now ensure that if Tag is a RecordField then it must be
7381 placed before the varient symbol in its parent ListOfSons.
7382 This allows M2GCCDeclare to declare record fields in order
7383 and preserve the order of fields. Otherwise it will add the
7384 tag field after the C union. *)
7385 IF IsRecordField(Tag)
7387 pSym := GetPsym(Tag) ;
7388 pSym^.RecordField.Tag := TRUE ;
7389 parent := GetParent(Sym) ;
7390 pSym := GetPsym(parent) ;
7395 VarientSym : EnsureOrder(Varient.ListOfSons, Tag, Sym) |
7396 VarientFieldSym: EnsureOrder(VarientField.ListOfSons, Tag, Sym) |
7397 RecordSym : EnsureOrder(Record.ListOfSons, Tag, Sym) ;
7398 CheckRecordConsistency(parent)
7401 InternalError ('not expecting this symbol type')
7409 GetVarientTag - returns the varient tag from, Sym.
7412 PROCEDURE GetVarientTag (Sym: CARDINAL) : CARDINAL ;
7416 pSym := GetPsym(Sym) ;
7420 VarientSym: RETURN( Varient.tag )
7423 InternalError ('varient symbol expected')
7430 IsFieldVarient - returns true if the symbol, Sym, is a
7434 PROCEDURE IsFieldVarient (Sym: CARDINAL) : BOOLEAN ;
7438 pSym := GetPsym(Sym) ;
7439 RETURN( pSym^.SymbolType=VarientFieldSym )
7440 END IsFieldVarient ;
7444 IsFieldEnumeration - returns true if the symbol, Sym, is an
7448 PROCEDURE IsFieldEnumeration (Sym: CARDINAL) : BOOLEAN ;
7452 pSym := GetPsym(Sym) ;
7453 RETURN( pSym^.SymbolType=EnumerationFieldSym )
7454 END IsFieldEnumeration ;
7458 IsVarient - returns true if the symbol, Sym, is a
7462 PROCEDURE IsVarient (Sym: CARDINAL) : BOOLEAN ;
7466 pSym := GetPsym(Sym) ;
7467 RETURN( pSym^.SymbolType=VarientSym )
7472 PutUnused - sets, sym, as unused. This is a gm2 pragma.
7475 PROCEDURE PutUnused (sym: CARDINAL) ;
7479 pSym := GetPsym(sym) ;
7483 RecordFieldSym: RecordField.Used := FALSE
7486 MetaError1("cannot use pragma 'unused' on symbol {%1ad}", sym)
7493 IsUnused - returns TRUE if the symbol was declared as unused with a
7497 PROCEDURE IsUnused (sym: CARDINAL) : BOOLEAN ;
7501 pSym := GetPsym(sym) ;
7505 RecordFieldSym: RETURN( NOT RecordField.Used )
7508 InternalError ('expecting a record field symbol')
7515 PutFieldEnumeration - places a field into the enumeration type
7516 Sym. The field has a name FieldName and a
7520 PROCEDURE PutFieldEnumeration (tok: CARDINAL; Sym: CARDINAL; FieldName: Name) ;
7523 pSym : PtrToSymbol ;
7527 Field := CheckForHiddenType(FieldName) ;
7530 Field := DeclareSym (tok, FieldName)
7532 IF NOT IsError(Field)
7534 pSym := GetPsym(Field) ;
7536 SymbolType := EnumerationFieldSym ;
7537 WITH EnumerationField DO
7538 name := FieldName ; (* Index into name array, name *)
7540 oSym := GetPsym(Sym) ;
7541 PushCard(oSym^.Enumeration.NoOfElements) ;
7542 Value := InitValue() ;
7545 Scope := GetCurrentScope() ;
7546 InitWhereDeclaredTok (tok, At) (* Declared here *)
7549 pSym := GetPsym(Sym) ;
7553 EnumerationSym: WITH Enumeration DO
7555 IF GetSymKey(LocalSymbols, FieldName)#NulSym
7557 s := Mark(InitStringCharStar(KeyToCharStar(FieldName))) ;
7558 AlreadyDeclaredError(Sprintf1(Mark(InitString('enumeration field (%s) is already declared elsewhere, use a different name or remove the declaration')), s),
7560 GetDeclaredMod(GetSymKey(LocalSymbols, FieldName)))
7562 PutSymKey(LocalSymbols, FieldName, Field) ;
7563 IncludeItemIntoList (ListOfFields, Field)
7568 InternalError ('expecting Sym=Enumeration')
7572 END PutFieldEnumeration ;
7576 PutType - gives a type symbol Sym type TypeSymbol.
7579 PROCEDURE PutType (Sym: CARDINAL; TypeSymbol: CARDINAL) ;
7585 InternalError ('not expecting a type to be declared as itself')
7587 pSym := GetPsym(Sym) ;
7592 TypeSym : Type.Type := TypeSymbol
7595 InternalError ('expecting a Type symbol')
7602 IsDefImp - returns true is the Sym is a DefImp symbol.
7603 Definition/Implementation module symbol.
7606 PROCEDURE IsDefImp (Sym: CARDINAL) : BOOLEAN ;
7610 pSym := GetPsym(Sym) ;
7611 RETURN( pSym^.SymbolType=DefImpSym )
7616 IsModule - returns true is the Sym is a Module symbol.
7617 Program module symbol.
7620 PROCEDURE IsModule (Sym: CARDINAL) : BOOLEAN ;
7624 pSym := GetPsym(Sym) ;
7625 RETURN( pSym^.SymbolType=ModuleSym )
7630 IsInnerModule - returns true if the symbol, Sym, is an inner module.
7633 PROCEDURE IsInnerModule (Sym: CARDINAL) : BOOLEAN ;
7637 RETURN( GetScope(Sym)#NulSym )
7645 GetSymName - returns the symbol name.
7648 PROCEDURE GetSymName (Sym: CARDINAL) : Name ;
7657 pSym := GetPsym(Sym) ;
7661 ErrorSym : n := Error.name |
7662 ObjectSym : n := Object.name |
7663 DefImpSym : n := DefImp.name |
7664 ModuleSym : n := Module.name |
7665 TypeSym : n := Type.name |
7666 VarSym : n := Var.name |
7667 ConstLitSym : n := ConstLit.name |
7668 ConstVarSym : n := ConstVar.name |
7669 ConstStringSym : n := ConstString.name |
7670 EnumerationSym : n := Enumeration.name |
7671 EnumerationFieldSym : n := EnumerationField.name |
7672 UndefinedSym : n := Undefined.name |
7673 ProcedureSym : n := Procedure.name |
7674 ProcTypeSym : n := ProcType.name |
7675 RecordFieldSym : n := RecordField.name |
7676 RecordSym : n := Record.name |
7677 VarientSym : n := NulName |
7678 VarientFieldSym : n := VarientField.name |
7679 VarParamSym : n := VarParam.name |
7680 ParamSym : n := Param.name |
7681 PointerSym : n := Pointer.name |
7682 ArraySym : n := Array.name |
7683 UnboundedSym : n := NulName |
7684 SubrangeSym : n := Subrange.name |
7685 SetSym : n := Set.name |
7686 SubscriptSym : n := NulName |
7687 DummySym : n := NulName |
7688 PartialUnboundedSym : n := GetSymName(PartialUnbounded.Type) |
7689 TupleSym : n := NulName |
7690 GnuAsmSym : n := NulName |
7691 InterfaceSym : n := NulName |
7692 ImportSym : n := NulName |
7693 ImportStatementSym : n := NulName
7696 InternalError ('unexpected symbol type')
7705 PutConstVarTemporary - indicates that constant, sym, is a temporary.
7708 PROCEDURE PutConstVarTemporary (sym: CARDINAL) ;
7712 pSym := GetPsym(sym) ;
7716 ConstVarSym: ConstVar.IsTemp := TRUE
7719 InternalError ('expecting a Var symbol')
7722 END PutConstVarTemporary ;
7726 buildTemporary - builds the temporary filling in componentRef, record and sets mode.
7729 PROCEDURE buildTemporary (tok: CARDINAL;
7730 Mode: ModeOfAddr; componentRef: BOOLEAN; record: CARDINAL) : CARDINAL ;
7738 s := Sprintf1(Mark(InitString('_T%d')), TemporaryNo) ;
7739 IF Mode=ImmediateValue
7741 Sym := MakeConstVar(tok, makekey(string(s))) ;
7742 PutConstVarTemporary(Sym)
7744 Sym := MakeVar(tok, makekey(string(s))) ;
7745 pSym := GetPsym(Sym) ;
7749 VarSym : Var.AddrMode := Mode ;
7750 Var.IsComponentRef := componentRef ;
7751 Var.IsTemp := TRUE ; (* Variable is a temporary var *)
7754 Var.list := Indexing.InitIndex(1) ;
7755 PutIntoIndex(Var.list, 1, record)
7757 InitWhereDeclaredTok(tok, Var.At) ; (* Declared here *)
7758 InitWhereFirstUsedTok(tok, Var.At) ; (* Where symbol first used. *)
7761 InternalError ('expecting a Var symbol')
7765 s := KillString(s) ;
7767 END buildTemporary ;
7771 MakeComponentRef - use, sym, to reference, field, sym is returned.
7774 PROCEDURE MakeComponentRef (sym: CARDINAL; field: CARDINAL) : CARDINAL ;
7779 pSym := GetPsym (sym) ;
7783 VarSym: IF NOT Var.IsTemp
7785 InternalError ('variable must be a temporary')
7786 ELSIF Var.IsComponentRef
7788 high := Indexing.HighIndice (Var.list) ;
7789 PutIntoIndex (Var.list, high+1, field)
7791 InternalError ('temporary is not a component reference')
7795 InternalError ('expecting a variable symbol')
7799 END MakeComponentRef ;
7803 MakeComponentRecord - make a temporary which will be used to reference and field
7804 (or sub field) of record.
7807 PROCEDURE MakeComponentRecord (tok: CARDINAL; Mode: ModeOfAddr; record: CARDINAL) : CARDINAL ;
7809 RETURN buildTemporary (tok, Mode, TRUE, record)
7810 END MakeComponentRecord ;
7814 IsComponent - returns TRUE if symbol, sym, is a temporary and a component
7818 PROCEDURE IsComponent (sym: CARDINAL) : BOOLEAN ;
7822 pSym := GetPsym(sym) ;
7826 VarSym: RETURN( Var.IsComponentRef )
7836 MakeTemporary - Makes a new temporary variable at the highest real scope.
7837 The addressing mode of the temporary is set to NoValue.
7840 PROCEDURE MakeTemporary (tok: CARDINAL; Mode: ModeOfAddr) : CARDINAL ;
7842 RETURN buildTemporary (tok, Mode, FALSE, NulSym)
7847 MakeTemporaryFromExpressions - makes a new temporary variable at the
7848 highest real scope. The addressing
7849 mode of the temporary is set and the
7850 type is determined by expressions,
7854 PROCEDURE MakeTemporaryFromExpressions (tok: CARDINAL;
7856 mode: ModeOfAddr) : CARDINAL ;
7865 s := Sprintf1(Mark(InitString('_T%d')), TemporaryNo) ;
7866 IF mode=ImmediateValue
7868 Sym := MakeConstVar(tok, makekey(string(s))) ;
7869 IF IsConstructor(e1)
7871 PutConstructor(Sym) ;
7872 PutConstructorFrom(Sym, e1)
7873 ELSIF IsConstructor(e2)
7875 PutConstructor(Sym) ;
7876 PutConstructorFrom(Sym, e2)
7878 PutVar(Sym, MixTypes(GetType(e1), GetType(e2), tok))
7880 PutConstVarTemporary(Sym)
7882 Sym := MakeVar(tok, makekey(string(s))) ;
7883 pSym := GetPsym(Sym) ;
7887 VarSym : Var.AddrMode := mode ;
7888 Var.IsComponentRef := FALSE ;
7889 Var.IsTemp := TRUE ; (* Variable is a temporary var *)
7890 InitWhereDeclaredTok(tok, Var.At)
7894 InternalError ('expecting a Var symbol')
7897 t := MixTypes(GetType(e1), GetType(e2), tok) ;
7900 Assert(NOT IsConstructor(t)) ;
7904 s := KillString(s) ;
7906 END MakeTemporaryFromExpressions ;
7910 MakeTemporaryFromExpression - makes a new temporary variable at the
7911 highest real scope. The addressing
7912 mode of the temporary is set and the
7913 type is determined by expressions, e.
7916 PROCEDURE MakeTemporaryFromExpression (tok: CARDINAL;
7918 mode: ModeOfAddr) : CARDINAL ;
7920 RETURN MakeTemporaryFromExpressions (tok, e, e, mode)
7921 END MakeTemporaryFromExpression ;
7925 PutMode - Puts the addressing mode, SymMode, into symbol Sym.
7926 The mode may only be altered if the mode
7930 PROCEDURE PutMode (Sym: CARDINAL; SymMode: ModeOfAddr) ;
7934 pSym := GetPsym(Sym) ;
7939 VarSym : Var.AddrMode := SymMode
7942 InternalError ('Expecting VarSym')
7949 GetMode - Returns the addressing mode of a symbol.
7952 PROCEDURE GetMode (Sym: CARDINAL) : ModeOfAddr ;
7956 pSym := GetPsym(Sym) ;
7960 ErrorSym : ErrorAbort0('') |
7961 VarSym : RETURN( Var.AddrMode ) |
7962 ConstLitSym : RETURN( ImmediateValue ) |
7963 ConstVarSym : RETURN( ImmediateValue ) |
7964 ConstStringSym : RETURN( ImmediateValue ) |
7965 EnumerationFieldSym: RETURN( ImmediateValue ) |
7966 ProcedureSym : RETURN( ImmediateValue ) |
7967 RecordFieldSym : RETURN( ImmediateValue ) |
7968 VarientFieldSym : RETURN( ImmediateValue ) |
7969 TypeSym : RETURN( NoValue ) |
7970 ArraySym : RETURN( NoValue ) |
7971 SubrangeSym : RETURN( NoValue ) |
7972 EnumerationSym : RETURN( NoValue ) |
7973 RecordSym : RETURN( NoValue ) |
7974 PointerSym : RETURN( NoValue ) |
7975 SetSym : RETURN( NoValue ) |
7976 ProcTypeSym : RETURN( NoValue ) |
7977 UnboundedSym : RETURN( NoValue ) |
7978 UndefinedSym : RETURN( NoValue )
7981 InternalError ('not expecting this type')
7988 RenameSym - renames a symbol, Sym, with SymName.
7989 It also checks the unknown tree for a symbol
7990 with this new name. Must only be renamed in
7991 the same scope of being declared.
7994 PROCEDURE RenameSym (Sym: CARDINAL; SymName: Name) ;
7998 IF GetSymName(Sym)=NulName
8000 pSym := GetPsym(Sym) ;
8004 ErrorSym : ErrorAbort0('') |
8005 TypeSym : Type.name := SymName |
8006 VarSym : Var.name := SymName |
8007 ConstLitSym : ConstLit.name := SymName |
8008 ConstVarSym : ConstVar.name := SymName |
8009 UndefinedSym : Undefined.name := SymName |
8010 RecordSym : Record.name := SymName |
8011 PointerSym : Pointer.name := SymName
8014 InternalError ('not implemented yet')
8017 AddSymToScope(Sym, SymName)
8019 InternalError ('old name of symbol must be nul')
8025 IsUnknown - returns true is the symbol Sym is unknown.
8028 PROCEDURE IsUnknown (Sym: WORD) : BOOLEAN ;
8033 pSym := GetPsym(Sym) ;
8034 RETURN pSym^.SymbolType=UndefinedSym
8039 CheckLegal - determines whether the Sym is a legal symbol.
8042 PROCEDURE CheckLegal (Sym: CARDINAL) ;
8044 IF (Sym<1) OR (Sym>FinalSymbol())
8046 InternalError ('illegal symbol')
8052 CheckForHiddenType - scans the NeedToBeImplemented tree providing
8053 that we are currently compiling an implementation
8054 module. If a symbol is found with TypeName
8055 then its Sym is returned.
8056 Otherwise NulSym is returned.
8057 CheckForHiddenType is called before any type is
8058 created, therefore the compiler allows hidden
8059 types to be implemented using any type.
8062 PROCEDURE CheckForHiddenType (TypeName: Name) : CARDINAL ;
8068 IF CompilingImplementationModule() AND
8069 IsDefImp(CurrentModule) AND
8070 IsHiddenTypeDeclared(CurrentModule) AND
8073 (* Check to see whether we are declaring a HiddenType. *)
8074 pSym := GetPsym(CurrentModule) ;
8078 DefImpSym: Sym := GetSymKey(DefImp.NeedToBeImplemented, TypeName)
8081 InternalError ('expecting a DefImp symbol')
8086 END CheckForHiddenType ;
8090 IsReallyPointer - returns TRUE is sym is a pointer, address or a
8091 type declared as a pointer or address.
8094 PROCEDURE IsReallyPointer (Sym: CARDINAL) : BOOLEAN ;
8100 Sym := SkipType(Sym) ;
8101 RETURN( IsPointer(Sym) OR (Sym=Address) )
8102 END IsReallyPointer ;
8106 SkipHiddenType - if sym is a TYPE foo = bar
8107 then call SkipType(bar)
8110 it does skip over hidden type.
8114 PROCEDURE SkipHiddenType (Sym: CARDINAL) : CARDINAL ;
8116 IF (Sym#NulSym) AND IsType(Sym) AND (GetType(Sym)#NulSym)
8118 RETURN( SkipType(GetType(Sym)) )
8122 END SkipHiddenType ;
8127 IsHiddenReallyPointer - returns TRUE is sym is a pointer, address or a
8128 type declared as a pointer or address.
8131 PROCEDURE IsHiddenReallyPointer (Sym: CARDINAL) : BOOLEAN ;
8135 Sym := GetType (Sym)
8137 WHILE (Sym # NulSym) AND IsType (Sym) DO
8138 Sym := SkipType (GetType (Sym))
8140 RETURN (Sym # NulSym) AND (IsPointer (Sym) OR (Sym = Address))
8141 END IsHiddenReallyPointer ;
8145 CheckHiddenTypeAreAddress - checks to see that any hidden types
8146 which we have declared are actually
8147 of type ADDRESS or map onto a POINTER type.
8150 PROCEDURE CheckHiddenTypeAreAddress ;
8158 n := NoOfItemsInList(AddressTypes) ;
8160 sym := GetItemFromList(AddressTypes, i) ;
8161 IF NOT IsHiddenReallyPointer(sym)
8163 name := GetSymName(sym) ;
8164 e := NewError(GetDeclaredDef(sym)) ;
8165 ErrorFormat1(e, 'opaque type (%a) should be equivalent to a POINTER or an ADDRESS', name) ;
8166 e := NewError(GetDeclaredMod(sym)) ;
8167 ErrorFormat0(e, 'if you really need a non POINTER type use the -fextended-opaque switch')
8171 END CheckHiddenTypeAreAddress ;
8175 GetLastMainScopeId - returns the, id, containing the last main scope.
8179 PROCEDURE GetLastMainScopeId (id: CARDINAL) : CARDINAL ;
8181 pCall: PtrToCallFrame ;
8186 pCall := GetPcall(id) ;
8187 sym := pCall^.Main ;
8190 pCall := GetPcall(id) ;
8198 END GetLastMainScopeId ;
8203 GetDeclareSym - searches for a symbol with a name SymName in the
8204 current and previous scopes.
8205 If the symbol is found then it is returned
8206 else an unknown symbol is returned.
8207 This procedure assumes that SymName is being
8208 declared at this point and therefore it does
8209 not examine the base scope (for pervasive
8213 PROCEDURE GetDeclareSym (tok: CARDINAL; SymName: Name) : CARDINAL ;
8217 Sym := GetScopeSym (SymName, FALSE) ; (* must not be allowed to fetch a symbol through a procedure scope *)
8220 Sym := GetSymFromUnknownTree (SymName) ;
8225 FillInUnknownFields (tok, Sym, SymName) ;
8226 (* Add to unknown tree *)
8227 AddSymToUnknownTree (ScopePtr, SymName, Sym)
8229 ; WriteKey(SymName) ; WriteString(' unknown demanded') ; WriteLn
8238 RequestSym - searches for a symbol with a name SymName in the
8239 current and previous scopes.
8240 If the symbol is found then it is returned
8241 else an unknown symbol is returned create at token
8243 This procedure does search the base scope (for
8244 pervasive identifiers).
8247 PROCEDURE RequestSym (tok: CARDINAL; SymName: Name) : CARDINAL ;
8252 WriteString('RequestSym for: ') ; WriteKey(SymName) ; WriteLn ;
8254 Sym := GetSym (SymName) ;
8257 Sym := GetSymFromUnknownTree (SymName) ;
8262 FillInUnknownFields (tok, Sym, SymName) ;
8263 (* Add to unknown tree *)
8264 AddSymToUnknownTree (ScopePtr, SymName, Sym)
8266 ; WriteKey(SymName) ; WriteString(' unknown demanded') ; WriteLn
8275 PutImported - places a symbol, Sym, into the current main scope.
8278 PROCEDURE PutImported (Sym: CARDINAL) ;
8280 pSym : PtrToSymbol ;
8285 We have currently imported Sym, now place it into the current module.
8287 ModSym := GetCurrentModuleScope() ;
8288 Assert(IsDefImp(ModSym) OR IsModule(ModSym)) ;
8289 pSym := GetPsym(ModSym) ;
8293 ModuleSym: IF GetSymKey(Module.ImportTree, GetSymName(Sym))=Sym
8297 n := GetSymName(Sym) ;
8298 WriteFormat1('symbol (%a) has already been imported', n)
8300 ELSIF GetSymKey(Module.ImportTree, GetSymName(Sym))=NulKey
8302 IF GetSymKey(Module.WhereImported, Sym)=NulKey
8304 PutSymKey(Module.WhereImported, Sym, GetTokenNo())
8306 PutSymKey(Module.ImportTree, GetSymName(Sym), Sym) ;
8307 AddSymToModuleScope(ModSym, Sym)
8309 n := GetSymName(Sym) ;
8310 WriteFormat1('name clash when trying to import (%a)', n)
8312 DefImpSym: IF GetSymKey(DefImp.ImportTree, GetSymName(Sym))=Sym
8316 n := GetSymName(Sym) ;
8317 WriteFormat1('symbol (%a) has already been imported', n)
8319 ELSIF GetSymKey(DefImp.ImportTree, GetSymName(Sym))=NulKey
8321 IF GetSymKey(DefImp.WhereImported, Sym)=NulKey
8323 PutSymKey(DefImp.WhereImported, Sym, GetTokenNo())
8325 PutSymKey(DefImp.ImportTree, GetSymName(Sym), Sym) ;
8326 AddSymToModuleScope(ModSym, Sym)
8328 n := GetSymName(Sym) ;
8329 WriteFormat1('name clash when trying to import (%a)', n)
8333 InternalError ('expecting a Module or DefImp symbol')
8340 PutIncluded - places a symbol, Sym, into the included list of the
8342 Symbols that are placed in this list are indirectly declared
8347 modulename.identifier
8350 PROCEDURE PutIncluded (Sym: CARDINAL) ;
8352 pSym : PtrToSymbol ;
8357 We have referenced Sym, via modulename.Sym
8358 now place it into the current module include list.
8360 ModSym := GetCurrentModuleScope() ;
8361 Assert(IsDefImp(ModSym) OR IsModule(ModSym)) ;
8364 n1 := GetSymName(Sym) ;
8365 n2 := GetSymName(ModSym) ;
8366 printf2('including %a into scope %a\n', n1, n2)
8368 pSym := GetPsym(ModSym) ;
8372 ModuleSym: IncludeItemIntoList(Module.IncludeList, Sym) |
8373 DefImpSym: IncludeItemIntoList(DefImp.IncludeList, Sym)
8376 InternalError ('expecting a Module or DefImp symbol')
8383 PutExported - places a symbol, Sym into the next level out module.
8384 Sym is also placed in the ExportTree of the current inner
8388 PROCEDURE PutExported (Sym: CARDINAL) ;
8393 WriteString('PutExported') ; WriteLn ;
8395 AddSymToModuleScope(GetLastModuleOrProcedureScope(), Sym) ;
8396 pSym := GetPsym(GetCurrentModuleScope()) ;
8400 ModuleSym: PutSymKey(Module.ExportTree, GetSymName(Sym), Sym) ;
8403 PutExportUndeclared(GetCurrentModuleScope(), Sym)
8406 ; WriteKey(Module.name) ; WriteString(' exports ') ;
8407 ; WriteKey(GetSymName(Sym)) ; WriteLn ;
8411 InternalError ('expecting a Module symbol')
8418 PutExportQualified - places a symbol with the name, SymName,
8419 into the export tree of the
8420 Definition module being compiled.
8421 The symbol with name has been EXPORT QUALIFIED
8422 by the definition module and therefore any reference
8423 to this symbol in the code generation phase
8424 will be in the form _Module_Name.
8427 PROCEDURE PutExportQualified (tokenno: CARDINAL; SymName: Name) ;
8429 pSym : PtrToSymbol ;
8434 ModSym := GetCurrentModule () ;
8435 Assert (IsDefImp (ModSym)) ;
8436 Assert (CompilingDefinitionModule () OR
8437 (GetSymName(ModSym) = MakeKey ('SYSTEM'))) ;
8438 (* printf2('module %a exporting %a\n', GetSymName(ModSym), SymName) ; *)
8440 WriteString('1st MODULE ') ; WriteKey(GetSymName(ModSym)) ;
8441 WriteString(' identifier ') ; WriteKey(SymName) ; WriteLn ;
8443 pSym := GetPsym (ModSym) ;
8447 DefImpSym: WITH DefImp DO
8448 IF (GetSymKey (ExportQualifiedTree, SymName) # NulKey) AND
8449 (GetSymKey (ExportRequest, SymName) = NulKey)
8451 n := GetSymName(ModSym) ;
8452 WriteFormat2('identifier (%a) has already been exported from MODULE %a',
8454 ELSIF GetSymKey(ExportRequest, SymName)#NulKey
8456 Sym := GetSymKey(ExportRequest, SymName) ;
8457 DelSymKey(ExportRequest, SymName) ;
8458 PutSymKey(ExportQualifiedTree, SymName, Sym) ;
8459 PutExportUndeclared (ModSym, Sym)
8461 Sym := GetDeclareSym(tokenno, SymName) ;
8462 PutSymKey(ExportQualifiedTree, SymName, Sym) ;
8463 PutExportUndeclared (ModSym, Sym)
8468 InternalError ('expecting a DefImp symbol')
8471 END PutExportQualified ;
8475 PutExportUnQualified - places a symbol with the name, SymName,
8476 into the export tree of the
8477 Definition module being compiled.
8478 The symbol with Name has been EXPORT UNQUALIFIED
8479 by the definition module and therefore any reference
8480 to this symbol in the code generation phase
8481 will be in the form _Name.
8484 PROCEDURE PutExportUnQualified (tokenno: CARDINAL; SymName: Name) ;
8486 pSym : PtrToSymbol ;
8491 ModSym := GetCurrentModule() ;
8492 Assert(IsDefImp(ModSym)) ;
8493 Assert(CompilingDefinitionModule() OR (GetSymName(ModSym)=MakeKey('SYSTEM'))) ;
8494 pSym := GetPsym(ModSym) ;
8498 DefImpSym: WITH DefImp DO
8499 IF (GetSymKey(ExportUnQualifiedTree, SymName)#NulKey) AND
8500 (GetSymKey(ExportRequest, SymName)=NulKey)
8502 n := GetSymName(ModSym) ;
8503 WriteFormat2('identifier (%a) has already been exported from MODULE %a',
8505 ELSIF GetSymKey(ExportRequest, SymName)#NulKey
8507 Sym := GetSymKey(ExportRequest, SymName) ;
8508 DelSymKey(ExportRequest, SymName) ;
8509 PutSymKey(ExportUnQualifiedTree, SymName, Sym) ;
8510 PutExportUndeclared(ModSym, Sym)
8512 Sym := GetDeclareSym(tokenno, SymName) ;
8513 PutSymKey(ExportUnQualifiedTree, SymName, Sym) ;
8514 PutExportUndeclared(ModSym, Sym)
8519 InternalError ('expecting a DefImp symbol')
8522 END PutExportUnQualified ;
8526 GetExported - returns the symbol which has a name SymName,
8527 and is exported from the definition module ModSym.
8531 PROCEDURE GetExported (tokenno: CARDINAL;
8533 SymName: Name) : CARDINAL ;
8538 pSym := GetPsym(ModSym) ;
8542 DefImpSym: Sym := RequestFromDefinition (tokenno, ModSym, SymName) |
8543 ModuleSym: Sym := RequestFromModule (tokenno, ModSym, SymName)
8546 InternalError ('expecting a DefImp symbol')
8554 RequestFromModule - returns a symbol from module ModSym with name, SymName.
8557 PROCEDURE RequestFromModule (tok: CARDINAL; ModSym: CARDINAL; SymName: Name) : CARDINAL ;
8562 pSym := GetPsym(ModSym) ;
8566 DefImpSym: WITH DefImp DO
8567 Sym := GetSymKey (LocalSymbols, SymName) ;
8570 Sym := FetchUnknownFromDefImp (tok, ModSym, SymName)
8574 ModuleSym: WITH Module DO
8575 Sym := GetSymKey (LocalSymbols, SymName) ;
8578 Sym := FetchUnknownFromModule (tok, ModSym, SymName)
8583 InternalError ('expecting a DefImp or Module symbol')
8587 END RequestFromModule ;
8591 RequestFromDefinition - returns a symbol from module ModSym with name,
8595 PROCEDURE RequestFromDefinition (tok: CARDINAL;
8596 ModSym: CARDINAL; SymName: Name) : CARDINAL ;
8598 pSym : PtrToSymbol ;
8600 OldScopePtr: CARDINAL ;
8602 pSym := GetPsym(ModSym) ;
8606 DefImpSym: WITH DefImp DO
8607 Sym := GetSymKey (ExportQualifiedTree, SymName) ;
8610 Sym := GetSymKey (ExportUnQualifiedTree, SymName) ;
8613 Sym := GetSymKey (ExportRequest, SymName) ;
8616 OldScopePtr := ScopePtr ;
8617 StartScope (ModSym) ;
8618 Sym := GetScopeSym (SymName, TRUE) ;
8620 Assert (OldScopePtr=ScopePtr) ;
8623 Sym := FetchUnknownFromDefImp (tok, ModSym, SymName)
8625 IF IsFieldEnumeration (Sym)
8627 IF IsExported (ModSym, GetType (Sym))
8633 PutSymKey (ExportRequest, SymName, Sym)
8640 InternalError ('expecting a DefImp symbol')
8644 END RequestFromDefinition ;
8648 PutIncludedByDefinition - places a module symbol, Sym, into the
8649 included list of the current definition module.
8652 PROCEDURE PutIncludedByDefinition (Sym: CARDINAL) ;
8654 pSym : PtrToSymbol ;
8657 ModSym := GetCurrentModuleScope() ;
8658 Assert(IsDefImp(ModSym)) ;
8659 Assert(IsDefImp(Sym)) ;
8660 pSym := GetPsym(ModSym) ;
8664 DefImpSym: IncludeItemIntoList(DefImp.DefIncludeList, Sym)
8667 InternalError ('expecting a DefImp symbol')
8670 END PutIncludedByDefinition ;
8674 IsIncludedByDefinition - returns TRUE if definition module symbol, Sym, was included
8675 by ModSym's definition module.
8678 PROCEDURE IsIncludedByDefinition (ModSym, Sym: CARDINAL) : BOOLEAN ;
8682 Assert(IsDefImp(ModSym)) ;
8683 Assert(IsDefImp(Sym)) ;
8684 pSym := GetPsym(ModSym) ;
8688 DefImpSym: RETURN( IsItemInList(DefImp.DefIncludeList, Sym) )
8691 InternalError ('expecting a DefImp symbol')
8694 END IsIncludedByDefinition ;
8698 GetWhereImported - returns the token number where this symbol
8699 was imported into the current module.
8702 PROCEDURE GetWhereImported (Sym: CARDINAL) : CARDINAL ;
8706 pSym := GetPsym(GetCurrentModuleScope()) ;
8710 DefImpSym: RETURN( GetSymKey(DefImp.WhereImported, Sym) ) |
8711 ModuleSym: RETURN( GetSymKey(Module.WhereImported, Sym) )
8714 InternalError ('expecting DefImp or Module symbol')
8717 END GetWhereImported ;
8721 DisplayName - displays the name.
8724 PROCEDURE DisplayName (sym: WORD) ;
8731 DisplaySymbol - displays the name of a symbol
8734 PROCEDURE DisplaySymbol (sym: WORD) ;
8738 s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(sym)))) ;
8739 printf2(' %s (%d)', s, sym)
8744 DisplayTrees - displays the SymbolTrees for Module symbol, ModSym.
8747 PROCEDURE DisplayTrees (ModSym: CARDINAL) ;
8752 n := GetSymName(ModSym) ;
8753 printf1('Symbol trees for module/procedure: %a\n', n) ;
8754 pSym := GetPsym(ModSym) ;
8758 DefImpSym: WITH DefImp DO
8759 n := GetSymName(ModSym) ;
8760 printf1('%a UndefinedTree', n) ;
8761 ForeachNodeDo(Unresolved, DisplaySymbol) ; printf0('\n') ;
8762 printf1('%a Local symbols', n) ;
8763 ForeachNodeDo(LocalSymbols, DisplaySymbol) ; printf0('\n') ;
8764 printf1('%a ExportRequest', n) ;
8765 ForeachNodeDo(ExportRequest, DisplaySymbol) ; printf0('\n') ;
8766 printf1('%a ExportQualified', n) ;
8767 ForeachNodeDo(ExportQualifiedTree, DisplaySymbol) ; printf0('\n') ;
8768 printf1('%a ExportUnQualified', n) ;
8769 ForeachNodeDo(ExportUnQualifiedTree, DisplaySymbol) ; printf0('\n') ;
8770 printf1('%a ExportUndeclared', n) ;
8771 ForeachNodeDo(ExportUndeclared, DisplaySymbol) ; printf0('\n') ;
8772 printf1('%a DeclaredObjects', n) ;
8773 ForeachNodeDo(NamedObjects, DisplaySymbol) ; printf0('\n') ;
8774 printf1('%a ImportedObjects', n) ;
8775 ForeachNodeDo(NamedImports, DisplayName) ; printf0('\n')
8777 ModuleSym: WITH Module DO
8778 n := GetSymName(ModSym) ;
8779 printf1('%a UndefinedTree', n) ;
8780 ForeachNodeDo(Unresolved, DisplaySymbol) ; printf0('\n') ;
8781 printf1('%a Local symbols', n) ;
8782 ForeachNodeDo(LocalSymbols, DisplaySymbol) ; printf0('\n') ;
8783 printf1('%a ImportTree', n) ;
8784 ForeachNodeDo(ImportTree, DisplaySymbol) ; printf0('\n') ;
8785 printf1('%a ExportTree', n) ;
8786 ForeachNodeDo(ExportTree, DisplaySymbol) ; printf0('\n') ;
8787 printf1('%a ExportUndeclared', n) ;
8788 ForeachNodeDo(ExportUndeclared, DisplaySymbol) ; printf0('\n') ;
8789 printf1('%a DeclaredObjects', n) ;
8790 ForeachNodeDo(NamedObjects, DisplaySymbol) ; printf0('\n') ;
8791 printf1('%a ImportedObjects', n) ;
8792 ForeachNodeDo(NamedImports, DisplayName) ; printf0('\n')
8794 ProcedureSym: WITH Procedure DO
8795 n := GetSymName(ModSym) ;
8796 printf1('%a UndefinedTree', n) ;
8797 ForeachNodeDo(Unresolved, DisplaySymbol) ; printf0('\n') ;
8798 printf1('%a Local symbols', n) ;
8799 ForeachNodeDo(LocalSymbols, DisplaySymbol) ; printf0('\n') ;
8800 printf1('%a DeclaredObjects', n) ;
8801 ForeachNodeDo(NamedObjects, DisplayName) ; printf0('\n')
8805 InternalError ('expecting DefImp symbol')
8812 FetchUnknownFromModule - returns an Unknown symbol from module, ModSym.
8815 PROCEDURE FetchUnknownFromModule (tok: CARDINAL;
8817 SymName: Name) : CARDINAL ;
8822 pSym := GetPsym (ModSym) ;
8825 ModuleSym: WITH Module DO
8826 Sym := GetSymKey (Unresolved, SymName) ;
8830 FillInUnknownFields (tok, Sym, SymName) ;
8831 PutSymKey (Unresolved, SymName, Sym)
8835 InternalError ('expecting a Module symbol')
8839 END FetchUnknownFromModule ;
8843 FetchUnknownFromDefImp - returns an Unknown symbol from module, ModSym.
8846 PROCEDURE FetchUnknownFromDefImp (tok: CARDINAL;
8848 SymName: Name) : CARDINAL ;
8853 pSym := GetPsym (ModSym) ;
8856 DefImpSym: WITH DefImp DO
8857 Sym := GetSymKey (Unresolved , SymName) ;
8861 FillInUnknownFields (tok, Sym, SymName) ;
8862 PutSymKey (Unresolved, SymName, Sym)
8866 InternalError ('expecting a DefImp symbol')
8870 END FetchUnknownFromDefImp ;
8873 PROCEDURE FetchUnknownFrom (tok: CARDINAL;
8875 SymName: Name) : CARDINAL ;
8880 pSym := GetPsym(scope) ;
8883 DefImpSym: WITH DefImp DO
8884 Sym := GetSymKey(Unresolved, SymName) ;
8888 FillInUnknownFields (tok, Sym, SymName) ;
8889 PutSymKey(Unresolved, SymName, Sym)
8892 ModuleSym: WITH Module DO
8893 Sym := GetSymKey(Unresolved, SymName) ;
8897 FillInUnknownFields (tok, Sym, SymName) ;
8898 PutSymKey(Unresolved, SymName, Sym)
8901 ProcedureSym: WITH Procedure DO
8902 Sym := GetSymKey(Unresolved, SymName) ;
8906 FillInUnknownFields (tok, Sym, SymName) ;
8907 PutSymKey(Unresolved, SymName, Sym)
8912 InternalError ('expecting a DefImp or Module or Procedure symbol')
8916 END FetchUnknownFrom ;
8920 GetFromOuterModule - returns a symbol with name, SymName, which comes
8921 from outside the current module.
8924 PROCEDURE GetFromOuterModule (tokenno: CARDINAL; SymName: Name) : CARDINAL ;
8926 pCall : PtrToCallFrame ;
8927 ScopeId : CARDINAL ;
8929 ScopeSym: CARDINAL ;
8931 ScopeId := ScopePtr ;
8932 pCall := GetPcall(ScopeId) ;
8933 WHILE (NOT IsModule(pCall^.Search)) AND
8934 (NOT IsDefImp(pCall^.Search)) DO
8935 Assert (ScopeId>0) ;
8937 pCall := GetPcall (ScopeId)
8940 (* we are now below the current module *)
8942 pCall := GetPcall(ScopeId) ;
8943 ScopeSym := pCall^.Search ;
8946 Sym := GetLocalSym(ScopeSym, SymName) ;
8949 IF IsModule(ScopeSym) OR IsProcedure(ScopeSym) OR IsDefImp(ScopeSym)
8953 Sym := ExamineUnresolvedTree(ScopeSym, SymName) ;
8965 pCall := GetPcall(ScopeId)
8967 (* at this point we force an unknown from the last module scope *)
8968 RETURN( RequestFromModule (tokenno, GetLastModuleScope(), SymName) )
8969 END GetFromOuterModule ;
8973 IsExportUnQualified - returns true if a symbol, Sym, was defined as
8974 being EXPORT UNQUALIFIED.
8977 PROCEDURE IsExportUnQualified (Sym: CARDINAL) : BOOLEAN ;
8979 pSym : PtrToSymbol ;
8980 OuterModule: CARDINAL ;
8982 OuterModule := Sym ;
8984 OuterModule := GetScope(OuterModule)
8985 UNTIL GetScope(OuterModule)=NulSym ;
8986 pSym := GetPsym(OuterModule) ;
8990 ModuleSym: RETURN( FALSE ) |
8991 DefImpSym: RETURN( GetSymKey(
8992 DefImp.ExportUnQualifiedTree,
8998 InternalError ('expecting a DefImp or Module symbol')
9001 END IsExportUnQualified ;
9005 IsExportQualified - returns true if a symbol, Sym, was defined as
9006 being EXPORT QUALIFIED.
9007 Sym is expected to be either a procedure or a
9011 PROCEDURE IsExportQualified (Sym: CARDINAL) : BOOLEAN ;
9013 pSym : PtrToSymbol ;
9014 OuterModule: CARDINAL ;
9016 OuterModule := Sym ;
9018 OuterModule := GetScope(OuterModule)
9019 UNTIL GetScope(OuterModule)=NulSym ;
9020 pSym := GetPsym(OuterModule) ;
9024 ModuleSym: RETURN( FALSE ) |
9025 DefImpSym: RETURN( GetSymKey(DefImp.ExportQualifiedTree, GetSymName(Sym))=Sym )
9028 InternalError ('expecting a DefImp or Module symbol')
9031 END IsExportQualified ;
9035 ForeachImportedDo - calls a procedure, P, foreach imported symbol
9039 PROCEDURE ForeachImportedDo (ModSym: CARDINAL; P: PerformOperation) ;
9043 pSym := GetPsym(ModSym) ;
9047 DefImpSym: WITH DefImp DO
9048 ForeachNodeDo( ImportTree, P ) ;
9049 ForeachItemInListDo( IncludeList, P )
9051 ModuleSym: WITH Module DO
9052 ForeachNodeDo( ImportTree, P ) ;
9053 ForeachItemInListDo( IncludeList, P )
9057 InternalError ('expecting a DefImp or Module symbol')
9060 END ForeachImportedDo ;
9064 ForeachExportedDo - calls a procedure, P, foreach imported symbol
9068 PROCEDURE ForeachExportedDo (ModSym: CARDINAL; P: PerformOperation) ;
9072 pSym := GetPsym(ModSym) ;
9076 DefImpSym: WITH DefImp DO
9077 ForeachNodeDo( ExportQualifiedTree, P ) ;
9078 ForeachNodeDo( ExportUnQualifiedTree, P )
9080 ModuleSym: WITH Module DO
9081 ForeachNodeDo( ExportTree, P )
9085 InternalError ('expecting a DefImp or Module symbol')
9088 END ForeachExportedDo ;
9092 ForeachLocalSymDo - foreach local symbol in module, Sym, or procedure, Sym,
9093 perform the procedure, P.
9096 PROCEDURE ForeachLocalSymDo (Sym: CARDINAL; P: PerformOperation) ;
9100 pSym := GetPsym(Sym) ;
9104 DefImpSym: WITH DefImp DO
9105 ForeachNodeDo( LocalSymbols, P )
9107 ModuleSym: WITH Module DO
9108 ForeachNodeDo( LocalSymbols, P )
9110 ProcedureSym: WITH Procedure DO
9111 ForeachNodeDo( LocalSymbols, P )
9113 RecordSym: WITH Record DO
9114 ForeachNodeDo( LocalSymbols, P )
9116 EnumerationSym: WITH Enumeration DO
9117 ForeachNodeDo( LocalSymbols, P )
9121 InternalError ('expecting a DefImp, Module or Procedure symbol')
9124 END ForeachLocalSymDo ;
9128 ForeachParamSymDo - foreach parameter symbol in procedure, Sym,
9129 perform the procedure, P. Each symbol
9130 looked up will be VarParam or Param
9131 (not the shadow variable).
9134 PROCEDURE ForeachParamSymDo (Sym: CARDINAL; P: PerformOperation) ;
9139 IF IsProcedure (Sym)
9141 p := NoOfParam (Sym) ;
9144 param := GetNthParam (Sym, i) ;
9149 END ForeachParamSymDo ;
9153 CheckForUnknownInModule - checks for any unknown symbols in the
9155 If any unknown symbols are found then
9156 an error message is displayed.
9159 PROCEDURE CheckForUnknownInModule ;
9163 pSym := GetPsym(GetCurrentModuleScope()) ;
9167 DefImpSym: WITH DefImp DO
9168 CheckForUnknowns (name, ExportQualifiedTree,
9169 'EXPORT QUALIFIED') ;
9170 CheckForUnknowns (name, ExportUnQualifiedTree,
9171 'EXPORT UNQUALIFIED') ;
9172 CheckForSymbols (ExportRequest,
9173 'requested by another modules import (symbols have not been exported by the appropriate definition module)') ;
9174 CheckForUnknowns (name, Unresolved, 'unresolved') ;
9175 CheckForUnknowns (name, LocalSymbols, 'locally used')
9177 ModuleSym: WITH Module DO
9178 CheckForUnknowns (name, Unresolved, 'unresolved') ;
9179 CheckForUnknowns (name, ExportUndeclared, 'exported but undeclared') ;
9180 CheckForUnknowns (name, ExportTree, 'exported but undeclared') ;
9181 CheckForUnknowns (name, LocalSymbols, 'locally used')
9185 InternalError ('expecting a DefImp or Module symbol')
9188 END CheckForUnknownInModule ;
9192 UnknownSymbolError - displays symbol name for symbol, sym.
9195 PROCEDURE UnknownSymbolError (sym: WORD) ;
9197 IF IsUnreportedUnknown (sym)
9199 IncludeElementIntoSet (ReportedUnknowns, sym) ;
9200 MetaErrorStringT1 (GetFirstUsed (sym), InitString ("unknown symbol {%1EUad}"), sym)
9202 END UnknownSymbolError ;
9206 UnknownReported - if sym is an unknown symbol and has not been reported
9207 then include it into the set of reported unknowns.
9210 PROCEDURE UnknownReported (sym: CARDINAL) ;
9212 IF IsUnreportedUnknown (sym)
9214 IncludeElementIntoSet (ReportedUnknowns, sym)
9216 END UnknownReported ;
9220 IsUnreportedUnknown - returns TRUE if symbol, sym, has not been
9221 reported and is an unknown symbol.
9224 PROCEDURE IsUnreportedUnknown (sym: CARDINAL) : BOOLEAN ;
9226 RETURN IsUnknown (sym) AND (NOT IsElementInSet (ReportedUnknowns, sym))
9227 END IsUnreportedUnknown ;
9231 ListifySentance : String ;
9233 ListifyWordCount: CARDINAL ;
9240 PROCEDURE AddListify (sym: CARDINAL) ;
9242 INC (ListifyWordCount) ;
9243 (* printf ("AddListify: ListifyWordCount = %d, ListifyTotal = %d\n",
9244 ListifyWordCount, ListifyTotal) ; *)
9245 IF ListifyWordCount > 1
9247 IF ListifyWordCount = ListifyTotal
9249 ListifySentance := ConCat (ListifySentance, Mark (InitString (" and ")))
9251 ListifySentance := ConCat (ListifySentance, Mark (InitString (", ")))
9254 ListifySentance := ConCat (ListifySentance,
9255 Mark (InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
9260 Listify - convert tree into a string list and return the result.
9263 PROCEDURE Listify (tree: SymbolTree; isCondition: IsSymbol) : String ;
9265 ListifyTotal := NoOfNodes (tree, isCondition) ;
9266 ListifyWordCount := 0 ;
9267 ListifySentance := InitString ('') ;
9268 ForeachNodeConditionDo (tree, isCondition, AddListify) ;
9269 RETURN ListifySentance
9274 CheckForUnknowns - checks a binary tree, Tree, to see whether it contains
9275 an unknown symbol. All unknown symbols are displayed
9276 together with an error message.
9279 PROCEDURE CheckForUnknowns (name: Name; Tree: SymbolTree;
9284 IF DoesTreeContainAny(Tree, IsUnreportedUnknown)
9286 CurrentError := NewError(GetTokenNo()) ;
9287 s := InitString("{%E} the following unknown symbols in module %<") ;
9288 s := ConCat(s, Mark(InitStringCharStar(KeyToCharStar(name)))) ;
9289 s := ConCat(s, Mark(InitString('%> were '))) ;
9290 s := ConCat(s, Mark(InitString(a))) ;
9291 s := ConCat (s, Mark (InitString (': '))) ;
9292 s := ConCat (s, Mark (Listify (Tree, IsUnreportedUnknown))) ;
9293 MetaErrorStringT0(GetTokenNo(), s) ;
9294 ForeachNodeDo(Tree, UnknownSymbolError)
9296 END CheckForUnknowns ;
9300 SymbolError - displays symbol name for symbol, Sym.
9303 PROCEDURE SymbolError (Sym: WORD) ;
9308 n := GetSymName(Sym) ;
9309 e := ChainError(GetFirstUsed(Sym), CurrentError) ;
9310 ErrorFormat1(e, "unknown symbol '%a' found", n)
9315 CheckForSymbols - checks a binary tree, Tree, to see whether it contains
9316 any symbol. The tree is expected to be empty, if not
9317 then an error has occurred.
9320 PROCEDURE CheckForSymbols (Tree: SymbolTree; a: ARRAY OF CHAR) ;
9324 IF NOT IsEmptyTree(Tree)
9326 s := InitString ("the symbols are unknown at the end of module {%1Ea} when ") ;
9327 s := ConCat (s, Mark(InitString(a))) ;
9328 MetaErrorString1 (s, MainModule) ;
9329 ForeachNodeDo(Tree, SymbolError)
9331 END CheckForSymbols ;
9335 PutExportUndeclared - places a symbol, Sym, into module, ModSym,
9336 ExportUndeclared list provided that Sym
9340 PROCEDURE PutExportUndeclared (ModSym: CARDINAL; Sym: CARDINAL) ;
9346 pSym := GetPsym (ModSym) ;
9350 ModuleSym: PutSymKey (Module.ExportUndeclared, GetSymName (Sym), Sym) |
9351 DefImpSym: PutSymKey (DefImp.ExportUndeclared, GetSymName (Sym), Sym)
9354 InternalError ('expecting a DefImp or Module symbol')
9358 END PutExportUndeclared ;
9362 GetExportUndeclared - returns a symbol which has, name, from module, ModSym,
9363 which is in the ExportUndeclared list.
9366 PROCEDURE GetExportUndeclared (ModSym: CARDINAL; name: Name) : CARDINAL ;
9370 pSym := GetPsym(ModSym) ;
9374 ModuleSym: RETURN( GetSymKey(Module.ExportUndeclared, name) ) |
9375 DefImpSym: RETURN( GetSymKey(DefImp.ExportUndeclared, name) )
9378 InternalError ('expecting a DefImp or Module symbol')
9381 END GetExportUndeclared ;
9385 RemoveExportUndeclared - removes a symbol, Sym, from the module, ModSym,
9386 ExportUndeclaredTree.
9389 PROCEDURE RemoveExportUndeclared (ModSym: CARDINAL; Sym: CARDINAL) ;
9393 pSym := GetPsym(ModSym) ;
9397 ModuleSym: IF GetSymKey(Module.ExportUndeclared, GetSymName(Sym))=Sym
9399 DelSymKey(Module.ExportUndeclared, GetSymName(Sym))
9401 DefImpSym: IF GetSymKey(DefImp.ExportUndeclared, GetSymName(Sym))=Sym
9403 DelSymKey(DefImp.ExportUndeclared, GetSymName(Sym))
9407 InternalError ('expecting a DefImp or Module symbol')
9410 END RemoveExportUndeclared ;
9414 CheckForExportedDeclaration - checks to see whether a definition module
9415 is currently being compiled, if so,
9416 symbol, Sym, is removed from the
9417 ExportUndeclared list.
9418 This procedure is called whenever a symbol
9419 is declared, thus attempting to reduce
9420 the ExportUndeclared list.
9423 PROCEDURE CheckForExportedDeclaration (Sym: CARDINAL) ;
9425 IF CompilingDefinitionModule ()
9427 RemoveExportUndeclared(GetCurrentModule(), Sym)
9429 END CheckForExportedDeclaration ;
9433 CheckForUndeclaredExports - displays an error and the offending symbols
9434 which have been exported but not declared
9435 from module, ModSym.
9438 PROCEDURE CheckForUndeclaredExports (ModSym: CARDINAL) ;
9442 (* WriteString('Inside CheckForUndeclaredExports') ; WriteLn ; *)
9443 pSym := GetPsym(ModSym) ;
9447 ModuleSym: IF NOT IsEmptyTree(Module.ExportUndeclared)
9449 MetaError1('undeclared identifier(s) in EXPORT list of {%1ERd} {%1a}', ModSym) ;
9450 ForeachNodeDo(Module.ExportUndeclared, UndeclaredSymbolError)
9452 DefImpSym: IF NOT IsEmptyTree(DefImp.ExportUndeclared)
9454 IF DoesNotNeedExportList(ModSym)
9456 MetaError1('undeclared identifier(s) in {%1ERd} {%1a}', ModSym) ;
9458 MetaError1('undeclared identifier(s) in export list of {%1ERd} {%1a}', ModSym) ;
9460 ForeachNodeDo(DefImp.ExportUndeclared, UndeclaredSymbolError)
9464 InternalError ('expecting a DefImp or Module symbol')
9467 END CheckForUndeclaredExports ;
9471 UndeclaredSymbolError - displays symbol name for symbol, Sym.
9474 PROCEDURE UndeclaredSymbolError (Sym: WORD) ;
9478 printf1('undeclared symbol (%d)\n', Sym)
9480 MetaError1('{%1UC} undeclared symbol {%1a}', Sym)
9481 END UndeclaredSymbolError ;
9485 PutExportUnImplemented - places a symbol, Sym, into the currently compiled
9486 DefImp module NeedToBeImplemented list.
9489 PROCEDURE PutExportUnImplemented (tokenno: CARDINAL; Sym: CARDINAL) ;
9493 pSym := GetPsym (CurrentModule) ;
9497 DefImpSym: IF GetSymKey (DefImp.NeedToBeImplemented, GetSymName (Sym)) = Sym
9499 MetaErrorT2 (tokenno, 'symbol {%1a} is already exported from module {%2a}',
9502 n1 := GetSymName (Sym) ;
9503 n2 := GetSymName (CurrentModule) ;
9504 WriteFormat2 ('symbol (%a) already exported from module (%a)', n1, n2)
9507 PutSymKey (DefImp.NeedToBeImplemented, GetSymName(Sym), Sym)
9511 InternalError ('expecting a DefImp symbol')
9514 END PutExportUnImplemented ;
9518 RemoveExportUnImplemented - removes a symbol, Sym, from the module, ModSym,
9519 NeedToBeImplemented list.
9522 PROCEDURE RemoveExportUnImplemented (ModSym: CARDINAL; Sym: CARDINAL) ;
9526 pSym := GetPsym(ModSym) ;
9530 DefImpSym: IF GetSymKey(DefImp.NeedToBeImplemented, GetSymName(Sym))=Sym
9532 DelSymKey(DefImp.NeedToBeImplemented, GetSymName(Sym))
9536 InternalError ('expecting a DefImp symbol')
9539 END RemoveExportUnImplemented ;
9543 ExportRequestModule: CARDINAL ;
9547 RemoveFromExportRequest -
9550 PROCEDURE RemoveFromExportRequest (Sym: CARDINAL) ;
9554 pSym := GetPsym(ExportRequestModule) ;
9558 DefImpSym: IF GetSymKey(DefImp.ExportRequest, GetSymName(Sym))=Sym
9560 DelSymKey(DefImp.ExportRequest, GetSymName(Sym))
9564 InternalError ('expecting a DefImp symbol')
9567 END RemoveFromExportRequest ;
9571 RemoveEnumerationFromExportRequest - removes enumeration symbol, sym,
9572 (and its fields) from the ExportRequest tree.
9575 PROCEDURE RemoveEnumerationFromExportRequest (ModSym: CARDINAL; Sym: CARDINAL) ;
9577 IF IsEnumeration(Sym)
9579 ExportRequestModule := ModSym ;
9580 RemoveFromExportRequest(Sym) ;
9581 ForeachLocalSymDo(Sym, RemoveFromExportRequest)
9583 END RemoveEnumerationFromExportRequest ;
9587 CheckForExportedImplementation - checks to see whether an implementation
9588 module is currently being compiled, if so,
9589 symbol, Sym, is removed from the
9590 NeedToBeImplemented list.
9591 This procedure is called whenever a symbol
9592 is declared, thus attempting to reduce
9593 the NeedToBeImplemented list.
9594 Only needs to be called when a TYPE or
9595 PROCEDURE is built since the implementation
9596 module can only implement these objects
9597 declared in the definition module.
9599 It also checks whether a definition module
9600 is currently being compiled and, if so,
9601 it will ensure that symbol, Sym, is removed
9602 from the ExportRequest list. If Sym is an
9603 enumerated type it ensures that its fields
9607 PROCEDURE CheckForExportedImplementation (Sym: CARDINAL) ;
9609 IF CompilingImplementationModule()
9611 RemoveExportUnImplemented(GetCurrentModule(), Sym)
9613 IF CompilingDefinitionModule() AND IsEnumeration(Sym)
9615 RemoveEnumerationFromExportRequest(GetCurrentModule(), Sym)
9617 END CheckForExportedImplementation ;
9621 CheckForUnImplementedExports - displays an error and the offending symbols
9622 which have been exported but not implemented
9623 from the current compiled module.
9626 PROCEDURE CheckForUnImplementedExports ;
9630 (* WriteString('Inside CheckForImplementedExports') ; WriteLn ; *)
9631 pSym := GetPsym (CurrentModule) ;
9635 DefImpSym: IF NOT IsEmptyTree (DefImp.NeedToBeImplemented)
9637 CurrentError := NewError (GetTokenNo ()) ;
9638 ErrorFormat1 (CurrentError, 'unimplemented identifier(s) in EXPORT list of DEFINITION MODULE %a\nthe implementation module fails to implement the following exported identifier(s)', DefImp.name) ;
9639 ForeachNodeDo (DefImp.NeedToBeImplemented, UnImplementedSymbolError)
9643 InternalError ('expecting a DefImp symbol')
9646 END CheckForUnImplementedExports ;
9650 UnImplementedSymbolError - displays symbol name for symbol, Sym.
9653 PROCEDURE UnImplementedSymbolError (Sym: WORD) ;
9657 CurrentError := ChainError (GetFirstUsed (Sym), CurrentError) ;
9660 n := GetSymName(Sym) ;
9661 ErrorFormat1 (CurrentError, 'hidden type is undeclared (%a)', n)
9662 ELSIF IsProcedure (Sym)
9664 n := GetSymName(Sym) ;
9665 ErrorFormat1 (CurrentError, 'procedure is undeclared (%a)', n)
9666 ELSIF IsProcType (Sym)
9668 n := GetSymName(Sym) ;
9669 ErrorFormat1 (CurrentError, 'procedure type is undeclared (%a)', n)
9671 ErrorFormat0 (CurrentError, 'undeclared symbol')
9673 END UnImplementedSymbolError ;
9677 PutHiddenTypeDeclared - sets a flag in the current compiled module which
9678 indicates that a Hidden Type is declared within
9679 the implementation part of the module.
9680 This procedure is expected to be called while
9681 compiling the associated definition module.
9684 PROCEDURE PutHiddenTypeDeclared ;
9688 pSym := GetPsym(CurrentModule) ;
9692 DefImpSym: DefImp.ContainsHiddenType := TRUE
9695 InternalError ('expecting a DefImp symbol')
9698 END PutHiddenTypeDeclared ;
9702 IsHiddenTypeDeclared - returns true if a Hidden Type was declared in
9706 PROCEDURE IsHiddenTypeDeclared (Sym: CARDINAL) : BOOLEAN ;
9710 pSym := GetPsym(Sym) ;
9714 DefImpSym: RETURN( DefImp.ContainsHiddenType )
9717 InternalError ('expecting a DefImp symbol')
9720 END IsHiddenTypeDeclared ;
9724 PutModuleContainsBuiltin - sets a flag in the current compiled module which
9725 indicates that a builtin procedure is being declared.
9726 This is only expected to be called when we are
9727 parsing the definition module.
9730 PROCEDURE PutModuleContainsBuiltin ;
9734 PutHiddenTypeDeclared ;
9735 pSym := GetPsym(CurrentModule) ;
9739 DefImpSym: DefImp.ContainsBuiltin := TRUE
9742 InternalError ('expecting a DefImp symbol')
9745 END PutModuleContainsBuiltin ;
9749 IsBuiltinInModule - returns true if a module, Sym, has declared a builtin procedure.
9752 PROCEDURE IsBuiltinInModule (Sym: CARDINAL) : BOOLEAN ;
9756 pSym := GetPsym(Sym) ;
9760 DefImpSym: RETURN( DefImp.ContainsBuiltin )
9763 InternalError ('expecting a DefImp symbol')
9766 END IsBuiltinInModule ;
9770 PutDefinitionForC - sets a flag in the current compiled module which
9771 indicates that this module is a wrapper for a C
9772 file. Parameters passes to procedures in this module
9773 will adopt the C calling convention.
9776 PROCEDURE PutDefinitionForC (Sym: CARDINAL) ;
9780 pSym := GetPsym(Sym) ;
9784 DefImpSym: DefImp.ForC := TRUE
9787 InternalError ('expecting a DefImp symbol')
9790 END PutDefinitionForC ;
9794 IsDefinitionForC - returns true if this definition module was declared
9795 as a DEFINITION MODULE FOR "C".
9798 PROCEDURE IsDefinitionForC (Sym: CARDINAL) : BOOLEAN ;
9802 pSym := GetPsym(Sym) ;
9806 DefImpSym: RETURN( DefImp.ForC )
9809 InternalError ('expecting a DefImp symbol')
9812 END IsDefinitionForC ;
9816 PutDoesNeedExportList - sets a flag in module, Sym, which
9817 indicates that this module requires an explicit
9818 EXPORT QUALIFIED or UNQUALIFIED list. PIM-2
9821 PROCEDURE PutDoesNeedExportList (Sym: CARDINAL) ;
9825 pSym := GetPsym(Sym) ;
9829 DefImpSym: DefImp.NeedExportList := TRUE
9832 InternalError ('expecting a DefImp symbol')
9835 END PutDoesNeedExportList ;
9839 PutDoesNotNeedExportList - sets a flag in module, Sym, which
9840 indicates that this module does not require an explicit
9841 EXPORT QUALIFIED or UNQUALIFIED list. PIM-3|4
9844 PROCEDURE PutDoesNotNeedExportList (Sym: CARDINAL) ;
9848 pSym := GetPsym(Sym) ;
9852 DefImpSym: DefImp.NeedExportList := FALSE
9855 InternalError ('expecting a DefImp symbol')
9858 END PutDoesNotNeedExportList ;
9862 DoesNotNeedExportList - returns TRUE if module, Sym, does not require an explicit
9863 EXPORT QUALIFIED list.
9866 PROCEDURE DoesNotNeedExportList (Sym: CARDINAL) : BOOLEAN ;
9870 pSym := GetPsym(Sym) ;
9874 DefImpSym: RETURN( NOT DefImp.NeedExportList )
9877 InternalError ('expecting a DefImp symbol')
9880 END DoesNotNeedExportList ;
9884 CheckForEnumerationInCurrentModule - checks to see whether the enumeration
9885 type symbol, Sym, has been entered into
9886 the current modules scope list.
9889 PROCEDURE CheckForEnumerationInCurrentModule (Sym: CARDINAL) ;
9891 pSym : PtrToSymbol ;
9894 IF (SkipType(Sym)#NulSym) AND IsEnumeration(SkipType(Sym))
9896 Sym := SkipType(Sym)
9899 IF IsEnumeration(Sym)
9901 ModSym := GetCurrentModuleScope() ;
9902 pSym := GetPsym(ModSym) ;
9906 DefImpSym: CheckEnumerationInList(DefImp.EnumerationScopeList, Sym) |
9907 ModuleSym: CheckEnumerationInList(Module.EnumerationScopeList, Sym)
9910 InternalError ('expecting a DefImp or Module symbol')
9914 END CheckForEnumerationInCurrentModule ;
9918 CheckEnumerationInList - places symbol, Sym, in the list, l,
9919 providing it does not already exist.
9920 PseudoScope(Sym) is called if Sym needs to
9921 be added to the enumeration list, l.
9924 PROCEDURE CheckEnumerationInList (l: List; Sym: CARDINAL) ;
9926 IF NOT IsItemInList(l, Sym)
9928 PutItemIntoList(l, Sym) ;
9931 END CheckEnumerationInList ;
9935 CheckIfEnumerationExported - An outer module may use an enumeration that
9936 is declared inside an inner module. The usage
9937 may occur before definition. The first pass
9938 exports a symbol, later the symbol is declared
9939 as an emumeration type. At this stage the
9940 CheckIfEnumerationExported procedure should be
9941 called. This procedure ripples from the current
9942 (inner) module to outer module and every time
9943 it is exported it must be added to the outer
9944 module EnumerationScopeList.
9947 PROCEDURE CheckIfEnumerationExported (Sym: CARDINAL; ScopeId: CARDINAL) ;
9949 pCall : PtrToCallFrame ;
9951 OuterModId : CARDINAL ;
9953 OuterModSym: CARDINAL ;
9955 InnerModId := GetModuleScopeId(ScopeId) ;
9958 OuterModId := GetModuleScopeId(InnerModId-1) ;
9961 pCall := GetPcall(InnerModId) ;
9962 InnerModSym := pCall^.Search ;
9963 pCall := GetPcall(OuterModId) ;
9964 OuterModSym := pCall^.Search ;
9965 IF (InnerModSym#NulSym) AND (OuterModSym#NulSym)
9967 IF IsExported(InnerModSym, Sym)
9969 CheckForEnumerationInOuterModule(Sym, OuterModSym) ;
9970 CheckIfEnumerationExported(Sym, OuterModId)
9975 END CheckIfEnumerationExported ;
9979 CheckForEnumerationInOuterModule - checks to see whether the enumeration
9980 type symbol, Sym, has been entered into
9981 the outer module, OuterModule, scope list.
9982 OuterModule may be internal to the
9986 PROCEDURE CheckForEnumerationInOuterModule (Sym: CARDINAL;
9987 OuterModule: CARDINAL) ;
9991 pSym := GetPsym(OuterModule) ;
9995 DefImpSym: IncludeItemIntoList(DefImp.EnumerationScopeList, Sym) |
9996 ModuleSym: IncludeItemIntoList(Module.EnumerationScopeList, Sym)
9999 InternalError ('expecting a DefImp or Module symbol')
10002 END CheckForEnumerationInOuterModule ;
10006 IsExported - returns true if a symbol, Sym, is exported
10007 from module, ModSym.
10008 If ModSym is a DefImp symbol then its
10009 ExportQualified and ExportUnQualified lists are examined.
10012 PROCEDURE IsExported (ModSym: CARDINAL; Sym: CARDINAL) : BOOLEAN ;
10014 pSym : PtrToSymbol ;
10017 SymName := GetSymName(Sym) ;
10018 pSym := GetPsym(ModSym) ;
10022 DefImpSym: WITH DefImp DO
10024 (GetSymKey(ExportQualifiedTree, SymName)=Sym) OR
10025 (GetSymKey(ExportUnQualifiedTree, SymName)=Sym)
10028 ModuleSym: WITH Module DO
10029 RETURN( GetSymKey(ExportTree, SymName)=Sym )
10033 InternalError ('expecting a DefImp or Module symbol')
10040 IsImported - returns true if a symbol, Sym, in module, ModSym,
10044 PROCEDURE IsImported (ModSym: CARDINAL; Sym: CARDINAL) : BOOLEAN ;
10046 pSym : PtrToSymbol ;
10049 SymName := GetSymName(Sym) ;
10050 pSym := GetPsym(ModSym) ;
10054 DefImpSym: WITH DefImp DO
10056 (GetSymKey(ImportTree, SymName)=Sym) OR
10057 IsItemInList(IncludeList, Sym)
10060 ModuleSym: WITH Module DO
10062 (GetSymKey(ImportTree, SymName)=Sym) OR
10063 IsItemInList(IncludeList, Sym)
10068 InternalError ('expecting a DefImp or Module symbol')
10075 IsType - returns true if the Sym is a type symbol.
10078 PROCEDURE IsType (Sym: CARDINAL) : BOOLEAN ;
10080 pSym: PtrToSymbol ;
10082 pSym := GetPsym(Sym) ;
10083 RETURN( pSym^.SymbolType=TypeSym )
10088 IsReturnOptional - returns TRUE if the return value for, sym, is
10092 PROCEDURE IsReturnOptional (sym: CARDINAL) : BOOLEAN ;
10094 pSym: PtrToSymbol ;
10096 pSym := GetPsym(sym) ;
10100 ProcedureSym: RETURN( Procedure.ReturnOptional ) |
10101 ProcTypeSym : RETURN( ProcType.ReturnOptional )
10104 InternalError ('expecting a Procedure or ProcType symbol')
10107 END IsReturnOptional ;
10111 SetReturnOptional - sets the ReturnOptional field in the Procedure or
10112 ProcType symboltable entry.
10115 PROCEDURE SetReturnOptional (sym: CARDINAL; isopt: BOOLEAN) ;
10117 pSym: PtrToSymbol ;
10119 pSym := GetPsym(sym) ;
10123 ProcedureSym: Procedure.ReturnOptional := isopt |
10124 ProcTypeSym : ProcType.ReturnOptional := isopt
10127 InternalError ('expecting a Procedure or ProcType symbol')
10130 END SetReturnOptional ;
10134 CheckOptFunction - checks to see whether the optional return value
10135 has been set before and if it differs it will
10136 generate an error message. It will set the
10137 new value to, isopt.
10140 PROCEDURE CheckOptFunction (sym: CARDINAL; isopt: BOOLEAN) ;
10145 IF GetType(sym)#NulSym
10147 IF IsReturnOptional(sym) AND (NOT isopt)
10149 n := GetSymName(sym) ;
10150 e := NewError(GetTokenNo()) ;
10151 ErrorFormat1(e, 'function (%a) has no optional return value here', n) ;
10152 e := ChainError(GetDeclaredMod(sym), e) ;
10153 ErrorFormat1(e, 'whereas the same function (%a) was declared to have an optional return value at this point', n)
10154 ELSIF (NOT IsReturnOptional(sym)) AND isopt
10156 n := GetSymName(sym) ;
10157 e := NewError(GetTokenNo()) ;
10158 ErrorFormat1(e, 'function (%a) has an optional return value', n) ;
10159 e := ChainError(GetDeclaredMod(sym), e) ;
10160 ErrorFormat1(e, 'whereas the same function (%a) was declared to have no optional return value at this point', n)
10163 SetReturnOptional(sym, isopt)
10164 END CheckOptFunction ;
10168 PutFunction - Places a TypeSym as the return type to a procedure Sym.
10171 PROCEDURE PutFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
10173 pSym: PtrToSymbol ;
10175 pSym := GetPsym(Sym) ;
10180 ProcedureSym: CheckOptFunction(Sym, FALSE) ; Procedure.ReturnType := TypeSym |
10181 ProcTypeSym : CheckOptFunction(Sym, FALSE) ; ProcType.ReturnType := TypeSym
10184 InternalError ('expecting a Procedure or ProcType symbol')
10191 PutOptFunction - places a TypeSym as the optional return type to a procedure Sym.
10194 PROCEDURE PutOptFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
10196 pSym: PtrToSymbol ;
10198 pSym := GetPsym(Sym) ;
10203 ProcedureSym: CheckOptFunction(Sym, TRUE) ; Procedure.ReturnType := TypeSym |
10204 ProcTypeSym : CheckOptFunction(Sym, TRUE) ; ProcType.ReturnType := TypeSym
10207 InternalError ('expecting a Procedure or ProcType symbol')
10210 END PutOptFunction ;
10214 MakeVariableForParam -
10217 PROCEDURE MakeVariableForParam (tok : CARDINAL;
10219 ProcSym : CARDINAL ;
10220 no : CARDINAL) : CARDINAL ;
10222 pSym : PtrToSymbol ;
10223 VariableSym: CARDINAL ;
10225 VariableSym := MakeVar (tok, ParamName) ;
10226 pSym := GetPsym (VariableSym) ;
10230 ErrorSym: RETURN( NulSym ) |
10231 VarSym : Var.IsParam := TRUE (* Variable is really a parameter. *)
10234 InternalError ('expecting a Var symbol')
10237 (* Note that the parameter is now treated as a local variable. *)
10238 PutVar (VariableSym, GetType(GetNthParam(ProcSym, no))) ;
10239 PutDeclared (tok, VariableSym) ;
10241 Normal VAR parameters have LeftValue,
10242 however Unbounded VAR parameters have RightValue.
10243 Non VAR parameters always have RightValue.
10245 IF IsVarParam (ProcSym, no) AND (NOT IsUnboundedParam (ProcSym, no))
10247 PutMode (VariableSym, LeftValue)
10249 PutMode (VariableSym, RightValue)
10251 RETURN( VariableSym )
10252 END MakeVariableForParam ;
10256 PutParam - Places a Non VAR parameter ParamName with type ParamType into
10257 procedure Sym. The parameter number is ParamNo.
10258 If the procedure Sym already has this parameter then
10259 the parameter is checked for consistancy and the
10260 consistancy test is returned.
10263 PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
10264 ParamName: Name; ParamType: CARDINAL;
10265 isUnbounded: BOOLEAN) : BOOLEAN ;
10267 pSym : PtrToSymbol ;
10268 ParSym : CARDINAL ;
10269 VariableSym: CARDINAL ;
10271 IF ParamNo<=NoOfParam(Sym)
10273 InternalError ('why are we trying to put parameters again')
10275 (* Add a new parameter *)
10277 pSym := GetPsym(ParSym) ;
10279 SymbolType := ParamSym ;
10281 name := ParamName ;
10282 Type := ParamType ;
10283 IsUnbounded := isUnbounded ;
10284 ShadowVar := NulSym ;
10285 InitWhereDeclaredTok(tok, At)
10288 AddParameter(Sym, ParSym) ;
10289 IF ParamName#NulName
10291 VariableSym := MakeVariableForParam(tok, ParamName, Sym, ParamNo) ;
10292 IF VariableSym=NulSym
10296 pSym := GetPsym(ParSym) ;
10297 pSym^.Param.ShadowVar := VariableSym
10306 PutVarParam - Places a Non VAR parameter ParamName with type
10307 ParamType into procedure Sym.
10308 The parameter number is ParamNo.
10309 If the procedure Sym already has this parameter then
10310 the parameter is checked for consistancy and the
10311 consistancy test is returned.
10314 PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
10315 ParamName: Name; ParamType: CARDINAL;
10316 isUnbounded: BOOLEAN) : BOOLEAN ;
10318 pSym : PtrToSymbol ;
10319 ParSym : CARDINAL ;
10320 VariableSym: CARDINAL ;
10322 IF ParamNo<=NoOfParam(Sym)
10324 InternalError ('why are we trying to put parameters again')
10326 (* Add a new parameter *)
10328 pSym := GetPsym(ParSym) ;
10330 SymbolType := VarParamSym ;
10332 name := ParamName ;
10333 Type := ParamType ;
10334 IsUnbounded := isUnbounded ;
10335 ShadowVar := NulSym ;
10336 HeapVar := NulSym ; (* Will contain a pointer value. *)
10337 InitWhereDeclaredTok(tok, At)
10340 AddParameter(Sym, ParSym) ;
10341 IF ParamName#NulName
10343 VariableSym := MakeVariableForParam(tok, ParamName, Sym, ParamNo) ;
10344 IF VariableSym=NulSym
10348 pSym := GetPsym(ParSym) ;
10349 pSym^.VarParam.ShadowVar := VariableSym
10358 PutParamName - assigns a name, name, to paramater, no, of procedure,
10362 PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL; name: Name) ;
10364 pSym : PtrToSymbol ;
10367 pSym := GetPsym(ProcSym) ;
10372 ErrorSym : RETURN |
10373 ProcedureSym: ParSym := GetItemFromList(Procedure.ListOfParam, no) |
10374 ProcTypeSym : ParSym := GetItemFromList(ProcType.ListOfParam, no)
10377 InternalError ('expecting a Procedure symbol')
10380 pSym := GetPsym(ParSym) ;
10384 ParamSym: IF Param.name=NulName
10386 Param.name := name ;
10387 Param.ShadowVar := MakeVariableForParam(tok, name, ProcSym, no)
10389 InternalError ('name of parameter has already been assigned')
10391 VarParamSym: IF VarParam.name=NulName
10393 VarParam.name := name ;
10394 VarParam.ShadowVar := MakeVariableForParam(tok, name, ProcSym, no)
10396 InternalError ('name of parameter has already been assigned')
10400 InternalError ('expecting a VarParam or Param symbol')
10407 AddParameter - adds a parameter ParSym to a procedure Sym.
10410 PROCEDURE AddParameter (Sym: CARDINAL; ParSym: CARDINAL) ;
10412 pSym: PtrToSymbol ;
10414 pSym := GetPsym(Sym) ;
10419 ProcedureSym: PutItemIntoList(Procedure.ListOfParam, ParSym) |
10420 ProcTypeSym : PutItemIntoList(ProcType.ListOfParam, ParSym)
10423 InternalError ('expecting a Procedure symbol')
10430 IsVarParam - Returns a conditional depending whether parameter ParamNo
10431 is a VAR parameter.
10434 PROCEDURE IsVarParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
10436 pSym : PtrToSymbol ;
10440 pSym := GetPsym(Sym) ;
10445 ProcedureSym: IsVar := IsNthParamVar(Procedure.ListOfParam, ParamNo) |
10446 ProcTypeSym : IsVar := IsNthParamVar(ProcType.ListOfParam, ParamNo)
10449 InternalError ('expecting a Procedure or ProcType symbol')
10457 IsNthParamVar - returns true if the n th parameter of the parameter list,
10458 List, is a VAR parameter.
10461 PROCEDURE IsNthParamVar (Head: List; n: CARDINAL) : BOOLEAN ;
10463 pSym: PtrToSymbol ;
10466 p := GetItemFromList(Head, n) ;
10469 InternalError ('parameter does not exist')
10471 pSym := GetPsym(p) ;
10475 ErrorSym : RETURN( FALSE ) |
10476 VarParamSym: RETURN( TRUE ) |
10477 ParamSym : RETURN( FALSE )
10480 InternalError ('expecting Param or VarParam symbol')
10484 END IsNthParamVar ;
10488 NoOfParam - Returns the number of parameters that procedure Sym contains.
10491 PROCEDURE NoOfParam (Sym: CARDINAL) : CARDINAL ;
10493 pSym: PtrToSymbol ;
10497 pSym := GetPsym(Sym) ;
10501 ErrorSym : n := 0 |
10502 ProcedureSym: n := NoOfItemsInList(Procedure.ListOfParam) |
10503 ProcTypeSym : n := NoOfItemsInList(ProcType.ListOfParam)
10506 InternalError ('expecting a Procedure or ProcType symbol')
10514 HasVarParameters - returns TRUE if procedure, p, has any VAR parameters.
10517 PROCEDURE HasVarParameters (p: CARDINAL) : BOOLEAN ;
10521 n := NoOfParam(p) ;
10524 IF IsVarParam(p, i)
10531 END HasVarParameters ;
10535 PutUseVarArgs - tell the symbol table that this procedure, Sym,
10537 The procedure _must_ be declared inside a
10542 PROCEDURE PutUseVarArgs (Sym: CARDINAL) ;
10544 pSym: PtrToSymbol ;
10547 pSym := GetPsym(Sym) ;
10552 ProcedureSym: Procedure.HasVarArgs := TRUE |
10553 ProcTypeSym : ProcType.HasVarArgs := TRUE
10556 InternalError ('expecting a Procedure or ProcType symbol')
10559 END PutUseVarArgs ;
10563 UsesVarArgs - returns TRUE if procedure, Sym, uses varargs.
10564 The procedure _must_ be declared inside a
10568 PROCEDURE UsesVarArgs (Sym: CARDINAL) : BOOLEAN ;
10570 pSym: PtrToSymbol ;
10573 pSym := GetPsym(Sym) ;
10577 ErrorSym : RETURN( FALSE ) |
10578 ProcedureSym: RETURN( Procedure.HasVarArgs ) |
10579 ProcTypeSym : RETURN( ProcType.HasVarArgs )
10582 InternalError ('expecting a Procedure or ProcType symbol')
10589 PutUseOptArg - tell the symbol table that this procedure, Sym,
10593 PROCEDURE PutUseOptArg (Sym: CARDINAL) ;
10595 pSym: PtrToSymbol ;
10598 pSym := GetPsym(Sym) ;
10603 ProcedureSym: Procedure.HasOptArg := TRUE |
10604 ProcTypeSym : ProcType.HasOptArg := TRUE
10607 InternalError ('expecting a Procedure or ProcType symbol')
10614 UsesOptArg - returns TRUE if procedure, Sym, uses varargs.
10617 PROCEDURE UsesOptArg (Sym: CARDINAL) : BOOLEAN ;
10619 pSym: PtrToSymbol ;
10622 pSym := GetPsym(Sym) ;
10626 ErrorSym : RETURN( FALSE ) |
10627 ProcedureSym: RETURN( Procedure.HasOptArg ) |
10628 ProcTypeSym : RETURN( ProcType.HasOptArg )
10631 InternalError ('expecting a Procedure or ProcType symbol')
10638 PutOptArgInit - makes symbol, Sym, the initializer value to
10639 procedure, ProcSym.
10642 PROCEDURE PutOptArgInit (ProcSym, Sym: CARDINAL) ;
10644 pSym: PtrToSymbol ;
10647 IF NOT IsError(ProcSym)
10649 IF UsesOptArg(ProcSym)
10651 pSym := GetPsym(ProcSym) ;
10656 ProcedureSym: Procedure.OptArgInit := Sym |
10657 ProcTypeSym : ProcType.OptArgInit := Sym
10660 InternalError ('expecting a Procedure or ProcType symbol')
10665 END PutOptArgInit ;
10669 GetOptArgInit - returns the initializer value to the optional parameter in
10670 procedure, ProcSym.
10673 PROCEDURE GetOptArgInit (ProcSym: CARDINAL) : CARDINAL ;
10675 pSym: PtrToSymbol ;
10677 IF NOT IsError(ProcSym)
10679 IF UsesOptArg(ProcSym)
10681 pSym := GetPsym(ProcSym) ;
10686 ProcedureSym: RETURN( Procedure.OptArgInit ) |
10687 ProcTypeSym : RETURN( ProcType.OptArgInit )
10690 InternalError ('expecting a Procedure or ProcType symbol')
10696 END GetOptArgInit ;
10700 MakeParameterHeapVar - create a heap variable if sym is a pointer.
10703 PROCEDURE MakeParameterHeapVar (tok: CARDINAL; type: CARDINAL; mode: ModeOfAddr) : CARDINAL ;
10705 heapvar: CARDINAL ;
10707 heapvar := NulSym ;
10708 type := SkipType (type) ;
10709 IF IsPointer (type)
10711 heapvar := MakeTemporary (tok, mode) ;
10712 PutVar (heapvar, type) ;
10713 PutVarHeap (heapvar, TRUE)
10716 END MakeParameterHeapVar ;
10720 GetParameterHeapVar - return the heap variable associated with the
10721 parameter or NulSym.
10724 PROCEDURE GetParameterHeapVar (ParSym: CARDINAL) : CARDINAL ;
10726 pSym: PtrToSymbol ;
10728 pSym := GetPsym (ParSym) ;
10732 ParamSym : RETURN NulSym | (* Only VarParam has the pointer. *)
10733 VarParamSym: RETURN VarParam.HeapVar
10736 InternalError ('expecting Param or VarParam symbol')
10739 END GetParameterHeapVar ;
10743 PutParameterHeapVar - creates a heap variable associated with parameter sym.
10746 PROCEDURE PutParameterHeapVar (sym: CARDINAL) ;
10748 pSym : PtrToSymbol ;
10750 pSym := GetPsym (sym) ;
10754 ParamSym : | (* Nothing to do for the non var parameter. *)
10755 VarParamSym: VarParam.HeapVar := MakeParameterHeapVar (GetDeclaredMod (sym),
10756 VarParam.Type, LeftValue)
10759 InternalError ('Param or VarParam symbol expected')
10762 END PutParameterHeapVar ;
10766 PutProcedureParameterHeapVars - creates heap variables for parameter sym.
10769 PROCEDURE PutProcedureParameterHeapVars (sym: CARDINAL) ;
10771 Assert (IsProcedure (sym)) ;
10772 ForeachParamSymDo (sym, PutParameterHeapVar)
10773 END PutProcedureParameterHeapVars ;
10777 NoOfVariables - returns the number of variables in scope. The scope maybe
10778 a procedure, module or defimp scope.
10781 PROCEDURE NoOfVariables (scope: CARDINAL) : CARDINAL ;
10783 pSym: PtrToSymbol ;
10785 IF IsProcedure (scope)
10787 RETURN NoOfLocalVar (scope)
10788 ELSIF IsModule (scope)
10790 pSym := GetPsym (scope) ;
10794 ModuleSym: RETURN NoOfItemsInList (Module.ListOfVars)
10797 InternalError ('expecting module symbol')
10800 ELSIF IsDefImp (scope)
10802 pSym := GetPsym (scope) ;
10806 DefImpSym: RETURN NoOfItemsInList (DefImp.ListOfVars)
10809 InternalError ('expecting defimp symbol')
10813 InternalError ('expecting procedure, module or defimp symbol')
10815 END NoOfVariables ;
10819 NoOfLocalVar - returns the number of local variables that exist in
10820 procedure Sym. Parameters are NOT included in the
10824 PROCEDURE NoOfLocalVar (Sym: CARDINAL) : CARDINAL ;
10826 pSym: PtrToSymbol ;
10829 pSym := GetPsym(Sym) ;
10833 ErrorSym : n := 0 |
10834 ProcedureSym: n := NoOfItemsInList(Procedure.ListOfVars)
10837 InternalError ('expecting a Procedure symbol')
10841 Parameters are actually included in the list of local varaibles,
10842 therefore we must subtract the Parameter Number from local variable
10845 RETURN( n-NoOfParam(Sym) )
10850 IsParameterVar - returns true if parameter symbol Sym
10851 was declared as a VAR.
10854 PROCEDURE IsParameterVar (Sym: CARDINAL) : BOOLEAN ;
10856 pSym: PtrToSymbol ;
10858 pSym := GetPsym(Sym) ;
10862 ParamSym : RETURN( FALSE ) |
10863 VarParamSym: RETURN( TRUE )
10866 InternalError ('expecting Param or VarParam symbol')
10869 END IsParameterVar ;
10873 IsParameterUnbounded - returns TRUE if parameter, Sym, is
10877 PROCEDURE IsParameterUnbounded (Sym: CARDINAL) : BOOLEAN ;
10879 pSym: PtrToSymbol ;
10881 pSym := GetPsym(Sym) ;
10885 ParamSym : RETURN( Param.IsUnbounded ) |
10886 VarParamSym: RETURN( VarParam.IsUnbounded )
10889 InternalError ('expecting Param or VarParam symbol')
10892 END IsParameterUnbounded ;
10896 IsUnboundedParam - Returns a conditional depending whether parameter
10897 ParamNo is an unbounded array procedure parameter.
10900 PROCEDURE IsUnboundedParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
10904 Assert(IsProcedure(Sym) OR IsProcType(Sym)) ;
10905 param := GetNthParam(Sym, ParamNo) ;
10906 RETURN( IsParameterUnbounded(param) )
10907 END IsUnboundedParam ;
10911 IsParameter - returns true if Sym is a parameter symbol.
10914 PROCEDURE IsParameter (Sym: CARDINAL) : BOOLEAN ;
10916 pSym: PtrToSymbol ;
10918 pSym := GetPsym(Sym) ;
10923 VarParamSym: RETURN( TRUE )
10933 GetParameterShadowVar - returns the local variable associated with the
10934 parameter symbol, sym.
10937 PROCEDURE GetParameterShadowVar (sym: CARDINAL) : CARDINAL ;
10939 pSym: PtrToSymbol ;
10941 pSym := GetPsym(sym) ;
10945 ParamSym : RETURN( Param.ShadowVar ) |
10946 VarParamSym: RETURN( VarParam.ShadowVar )
10949 InternalError ('expecting a ParamSym or VarParamSym')
10952 END GetParameterShadowVar ;
10956 IsProcedure - returns true if Sym is a procedure symbol.
10959 PROCEDURE IsProcedure (Sym: CARDINAL) : BOOLEAN ;
10961 pSym: PtrToSymbol ;
10964 pSym := GetPsym(Sym) ;
10965 RETURN( pSym^.SymbolType=ProcedureSym )
10970 ProcedureParametersDefined - dictates to procedure symbol, Sym,
10971 that its parameters have been defined.
10974 PROCEDURE ProcedureParametersDefined (Sym: CARDINAL) ;
10976 pSym: PtrToSymbol ;
10979 pSym := GetPsym(Sym) ;
10984 ProcedureSym: Assert(NOT Procedure.ParamDefined) ;
10985 Procedure.ParamDefined := TRUE
10988 InternalError ('expecting a Procedure symbol')
10991 END ProcedureParametersDefined ;
10995 AreProcedureParametersDefined - returns true if the parameters to procedure
10996 symbol, Sym, have been defined.
10999 PROCEDURE AreProcedureParametersDefined (Sym: CARDINAL) : BOOLEAN ;
11001 pSym: PtrToSymbol ;
11004 pSym := GetPsym(Sym) ;
11008 ErrorSym : RETURN( FALSE ) |
11009 ProcedureSym: RETURN( Procedure.ParamDefined )
11012 InternalError ('expecting a Procedure symbol')
11015 END AreProcedureParametersDefined ;
11019 ParametersDefinedInDefinition - dictates to procedure symbol, Sym,
11020 that its parameters have been defined in
11021 a definition module.
11024 PROCEDURE ParametersDefinedInDefinition (Sym: CARDINAL) ;
11026 pSym: PtrToSymbol ;
11029 pSym := GetPsym(Sym) ;
11034 ProcedureSym: Assert(NOT Procedure.DefinedInDef) ;
11035 Procedure.DefinedInDef := TRUE
11038 InternalError ('expecting a Procedure symbol')
11041 END ParametersDefinedInDefinition ;
11045 AreParametersDefinedInDefinition - returns true if procedure symbol, Sym,
11046 has had its parameters been defined in
11047 a definition module.
11050 PROCEDURE AreParametersDefinedInDefinition (Sym: CARDINAL) : BOOLEAN ;
11052 pSym: PtrToSymbol ;
11055 pSym := GetPsym(Sym) ;
11059 ErrorSym : RETURN( FALSE ) |
11060 ProcedureSym: RETURN( Procedure.DefinedInDef )
11063 InternalError ('expecting a Procedure symbol')
11066 END AreParametersDefinedInDefinition ;
11070 ParametersDefinedInImplementation - dictates to procedure symbol, Sym,
11071 that its parameters have been defined in
11072 a implemtation module.
11075 PROCEDURE ParametersDefinedInImplementation (Sym: CARDINAL) ;
11077 pSym: PtrToSymbol ;
11080 pSym := GetPsym(Sym) ;
11085 ProcedureSym: Assert(NOT Procedure.DefinedInImp) ;
11086 Procedure.DefinedInImp := TRUE
11089 InternalError ('expecting a Procedure symbol')
11092 END ParametersDefinedInImplementation ;
11096 AreParametersDefinedInImplementation - returns true if procedure symbol, Sym,
11097 has had its parameters been defined in
11098 an implementation module.
11101 PROCEDURE AreParametersDefinedInImplementation (Sym: CARDINAL) : BOOLEAN ;
11103 pSym: PtrToSymbol ;
11106 pSym := GetPsym(Sym) ;
11110 ErrorSym : RETURN( FALSE ) |
11111 ProcedureSym: RETURN( Procedure.DefinedInImp )
11114 InternalError ('expecting a Procedure symbol')
11117 END AreParametersDefinedInImplementation ;
11121 FillInUnknownFields -
11124 PROCEDURE FillInUnknownFields (tok: CARDINAL; sym: CARDINAL; SymName: Name) ;
11126 pSym: PtrToSymbol ;
11128 pSym := GetPsym(sym) ;
11130 SymbolType := UndefinedSym ;
11133 oafamily := NulSym ;
11134 errorScope := GetCurrentErrorScope () ;
11135 InitWhereFirstUsedTok (tok, At)
11138 END FillInUnknownFields ;
11142 FillInPointerFields - given a new symbol, sym, make it a pointer symbol
11143 and initialize its fields.
11146 PROCEDURE FillInPointerFields (Sym: CARDINAL; PointerName: Name;
11147 scope: CARDINAL; oaf: CARDINAL) ;
11149 pSym: PtrToSymbol ;
11151 IF NOT IsError(Sym)
11153 pSym := GetPsym(Sym) ;
11155 SymbolType := PointerSym ;
11158 PointerSym: Pointer.Type := NulSym ;
11159 Pointer.name := PointerName ;
11160 Pointer.oafamily := oaf ; (* The unbounded for this *)
11161 InitTree(Pointer.ConstLitTree) ; (* constants of this type *)
11162 Pointer.Scope := scope ; (* Which scope created it *)
11163 Pointer.Size := InitValue() ;
11164 Pointer.Align := NulSym ; (* Alignment of this type *)
11167 InternalError ('expecting a Pointer symbol')
11171 END FillInPointerFields ;
11175 MakePointer - returns a pointer symbol with PointerName.
11178 PROCEDURE MakePointer (tok: CARDINAL; PointerName: Name) : CARDINAL ;
11180 oaf, sym: CARDINAL ;
11182 sym := HandleHiddenOrDeclare(tok, PointerName, oaf) ;
11183 FillInPointerFields(sym, PointerName, GetCurrentScope(), oaf) ;
11184 ForeachOAFamily(oaf, doFillInOAFamily) ;
11190 PutPointer - gives a pointer symbol a type, PointerType.
11193 PROCEDURE PutPointer (Sym: CARDINAL; PointerType: CARDINAL) ;
11195 pSym: PtrToSymbol ;
11197 pSym := GetPsym(Sym) ;
11202 PointerSym: Pointer.Type := PointerType
11205 InternalError ('expecting a Pointer symbol')
11212 IsPointer - returns true is Sym is a pointer type symbol.
11215 PROCEDURE IsPointer (Sym: CARDINAL) : BOOLEAN ;
11217 pSym: PtrToSymbol ;
11220 pSym := GetPsym(Sym) ;
11221 RETURN( pSym^.SymbolType=PointerSym )
11226 IsRecord - returns true is Sym is a record type symbol.
11229 PROCEDURE IsRecord (Sym: CARDINAL) : BOOLEAN ;
11231 pSym: PtrToSymbol ;
11234 pSym := GetPsym(Sym) ;
11235 RETURN( pSym^.SymbolType=RecordSym )
11240 IsArray - returns true is Sym is an array type symbol.
11243 PROCEDURE IsArray (Sym: CARDINAL) : BOOLEAN ;
11245 pSym: PtrToSymbol ;
11248 pSym := GetPsym(Sym) ;
11249 RETURN( pSym^.SymbolType=ArraySym )
11254 IsEnumeration - returns true if Sym is an enumeration symbol.
11257 PROCEDURE IsEnumeration (Sym: CARDINAL) : BOOLEAN ;
11259 pSym: PtrToSymbol ;
11262 pSym := GetPsym(Sym) ;
11263 RETURN( pSym^.SymbolType=EnumerationSym )
11264 END IsEnumeration ;
11268 IsUnbounded - returns true if Sym is an unbounded symbol.
11271 PROCEDURE IsUnbounded (Sym: CARDINAL) : BOOLEAN ;
11273 pSym: PtrToSymbol ;
11276 pSym := GetPsym(Sym) ;
11277 RETURN( pSym^.SymbolType=UnboundedSym )
11282 GetVarScope - returns the symbol which is the scope of variable Sym.
11283 ie a Module, DefImp or Procedure Symbol.
11286 PROCEDURE GetVarScope (Sym: CARDINAL) : CARDINAL ;
11288 pSym: PtrToSymbol ;
11290 pSym := GetPsym(Sym) ;
11294 ErrorSym: RETURN( NulSym ) |
11295 VarSym : RETURN( Var.Scope )
11298 InternalError ('expecting a Var symbol')
11305 NoOfElements - Returns the number of elements in array Sym,
11306 or the number of elements in an enumeration Sym or
11307 the number of interface symbols in an Interface list.
11310 PROCEDURE NoOfElements (Sym: CARDINAL) : CARDINAL ;
11312 pSym: PtrToSymbol ;
11315 pSym := GetPsym(Sym) ;
11319 ErrorSym : n := 0 |
11322 UnboundedSym : n := 1 | (* Standard language limitation *)
11324 EnumerationSym: n := pSym^.Enumeration.NoOfElements |
11325 InterfaceSym : n := HighIndice(Interface.Parameters)
11328 InternalError ('expecting an Array or UnBounded symbol')
11336 PutArraySubscript - places an index field into the array Sym. The
11337 index field is a subscript sym.
11340 PROCEDURE PutArraySubscript (Sym: CARDINAL; SubscriptSymbol: CARDINAL) ;
11342 pSym: PtrToSymbol ;
11344 pSym := GetPsym(Sym) ;
11349 ArraySym: Array.Subscript := SubscriptSymbol
11352 InternalError ('expecting an Array symbol')
11355 END PutArraySubscript ;
11359 GetArraySubscript - returns the subscript symbol for array, Sym.
11362 PROCEDURE GetArraySubscript (Sym: CARDINAL) : CARDINAL ;
11364 pSym: PtrToSymbol ;
11366 pSym := GetPsym(Sym) ;
11370 ErrorSym: RETURN( NulSym ) |
11371 ArraySym: RETURN( Array.Subscript )
11374 InternalError ('expecting an Array symbol')
11377 END GetArraySubscript ;
11381 MakeSubscript - makes a subscript Symbol.
11382 No name is required.
11385 PROCEDURE MakeSubscript () : CARDINAL ;
11387 pSym: PtrToSymbol ;
11391 pSym := GetPsym(Sym) ;
11393 SymbolType := SubscriptSym ;
11395 Type := NulSym ; (* Index to a subrange symbol. *)
11396 Size := InitValue() ; (* Size of this indice in*Size *)
11397 Offset := InitValue() ; (* Offset at runtime of symbol *)
11398 (* Pseudo ie: Offset+Size*i *)
11399 (* 1..n. The array offset is *)
11400 (* the real memory offset. *)
11401 (* This offset allows the a[i] *)
11402 (* to be calculated without *)
11403 (* the need to perform *)
11404 (* subtractions when a[4..10] *)
11405 (* needs to be indexed. *)
11406 InitWhereDeclared(At) (* Declared here *)
11410 END MakeSubscript ;
11414 PutSubscript - gives a subscript symbol a type, SimpleType.
11417 PROCEDURE PutSubscript (Sym: CARDINAL; SimpleType: CARDINAL) ;
11419 pSym: PtrToSymbol ;
11421 pSym := GetPsym(Sym) ;
11426 SubscriptSym: Subscript.Type := SimpleType ;
11429 InternalError ('expecting a SubScript symbol')
11436 MakeSet - makes a set Symbol with name, SetName.
11439 PROCEDURE MakeSet (tok: CARDINAL; SetName: Name) : CARDINAL ;
11441 pSym : PtrToSymbol ;
11442 oaf, sym: CARDINAL ;
11444 sym := HandleHiddenOrDeclare(tok, SetName, oaf) ;
11445 IF NOT IsError(sym)
11447 pSym := GetPsym(sym) ;
11449 SymbolType := SetSym ;
11451 name := SetName ; (* The name of the set. *)
11452 Type := NulSym ; (* Index to a subrange symbol. *)
11453 Size := InitValue() ; (* Size of this set *)
11454 InitPacked(packedInfo) ; (* not packed and no *)
11455 (* equivalent (yet). *)
11456 ispacked := FALSE ; (* Not yet known to be packed. *)
11457 oafamily := oaf ; (* The unbounded sym for this *)
11458 Scope := GetCurrentScope() ; (* Which scope created it *)
11459 InitWhereDeclaredTok(tok, At) (* Declared here *)
11463 ForeachOAFamily(oaf, doFillInOAFamily) ;
11469 PutSet - places SimpleType as the type for set, Sym.
11472 PROCEDURE PutSet (Sym: CARDINAL; SimpleType: CARDINAL; packed: BOOLEAN) ;
11474 pSym: PtrToSymbol ;
11476 pSym := GetPsym(Sym) ;
11481 SetSym: WITH Set DO
11482 Type := SimpleType ; (* Index to a subrange symbol *)
11483 (* or an enumeration type. *)
11487 InternalError ('expecting a Set symbol')
11494 IsSet - returns TRUE if Sym is a set symbol.
11497 PROCEDURE IsSet (Sym: CARDINAL) : BOOLEAN ;
11499 pSym: PtrToSymbol ;
11502 pSym := GetPsym(Sym) ;
11503 RETURN( pSym^.SymbolType=SetSym )
11508 IsSetPacked - returns TRUE if Sym is packed.
11511 PROCEDURE IsSetPacked (Sym: CARDINAL) : BOOLEAN ;
11513 pSym: PtrToSymbol ;
11516 pSym := GetPsym (Sym) ;
11517 RETURN (pSym^.SymbolType=SetSym) AND pSym^.Set.ispacked
11522 ForeachParameterDo -
11525 PROCEDURE ForeachParameterDo (p: CheckProcedure) ;
11529 l := LowIndice(Symbols) ;
11530 h := HighIndice(Symbols) ;
11538 END ForeachParameterDo ;
11542 CheckUnbounded - checks to see if parameter, Sym, is now an unbounded parameter.
11545 PROCEDURE CheckUnbounded (Sym: CARDINAL) ;
11547 pSym: PtrToSymbol ;
11550 pSym := GetPsym(Sym) ;
11554 ParamSym : IF IsUnbounded(Param.Type)
11556 Param.IsUnbounded := TRUE
11558 VarParamSym: IF IsUnbounded(VarParam.Type)
11560 VarParam.IsUnbounded := TRUE
11567 END CheckUnbounded ;
11571 IsOAFamily - returns TRUE if, Sym, is an OAFamily symbol.
11574 PROCEDURE IsOAFamily (Sym: CARDINAL) : BOOLEAN ;
11576 pSym: PtrToSymbol ;
11579 pSym := GetPsym(Sym) ;
11580 RETURN( pSym^.SymbolType=OAFamilySym )
11585 MakeOAFamily - makes an OAFamily symbol based on SimpleType.
11586 It returns the OAFamily symbol. A new symbol
11587 is created if one does not already exist for
11591 PROCEDURE MakeOAFamily (SimpleType: CARDINAL) : CARDINAL ;
11593 pSym: PtrToSymbol ;
11596 sym := GetOAFamily(SimpleType) ;
11600 pSym := GetPsym(sym) ;
11602 SymbolType := OAFamilySym ;
11603 OAFamily.MaxDimensions := 0 ;
11604 OAFamily.SimpleType := SimpleType ;
11605 OAFamily.Dimensions := Indexing.InitIndex(1)
11607 PutOAFamily(SimpleType, sym)
11614 GetOAFamily - returns the oafamily symbol associated with
11618 PROCEDURE GetOAFamily (SimpleType: CARDINAL) : CARDINAL ;
11620 pSym: PtrToSymbol ;
11622 pSym := GetPsym(SimpleType) ;
11626 ErrorSym : RETURN( NulSym ) |
11627 RecordSym : RETURN( Record.oafamily ) |
11628 SubrangeSym : RETURN( Subrange.oafamily ) |
11629 EnumerationSym: RETURN( Enumeration.oafamily ) |
11630 ArraySym : RETURN( Array.oafamily ) |
11631 ProcTypeSym : RETURN( ProcType.oafamily ) |
11632 TypeSym : RETURN( Type.oafamily ) |
11633 PointerSym : RETURN( Pointer.oafamily ) |
11634 SetSym : RETURN( Set.oafamily ) |
11635 UndefinedSym : RETURN( Undefined.oafamily )
11645 PutOAFamily - places the, oaf, into, SimpleType, oafamily field.
11648 PROCEDURE PutOAFamily (SimpleType: CARDINAL; oaf: CARDINAL) ;
11650 pSym: PtrToSymbol ;
11652 pSym := GetPsym(SimpleType) ;
11657 RecordSym : Record.oafamily := oaf |
11658 SubrangeSym : Subrange.oafamily := oaf |
11659 EnumerationSym: Enumeration.oafamily := oaf |
11660 ArraySym : Array.oafamily := oaf |
11661 ProcTypeSym : ProcType.oafamily := oaf |
11662 TypeSym : Type.oafamily := oaf |
11663 PointerSym : Pointer.oafamily := oaf |
11664 SetSym : Set.oafamily := oaf |
11665 UndefinedSym : Undefined.oafamily := oaf
11668 InternalError ('not expecting this SimpleType')
11675 ForeachOAFamily - call, p[oaf, ndim, symbol] for every unbounded symbol,
11679 PROCEDURE ForeachOAFamily (sym: CARDINAL; p: FamilyOperation) ;
11681 pSym: PtrToSymbol ;
11683 pc : POINTER TO CARDINAL ;
11687 pSym := GetPsym(sym) ;
11691 OAFamilySym: h := Indexing.HighIndice(OAFamily.Dimensions) ;
11694 pc := Indexing.GetIndice(OAFamily.Dimensions, i) ;
11703 InternalError ('expecting OAFamily symbol')
11707 END ForeachOAFamily ;
11714 PROCEDURE doFillInOAFamily (oaf: CARDINAL; i: CARDINAL; unbounded: CARDINAL) ;
11716 SimpleType: CARDINAL ;
11718 SimpleType := GetType(oaf) ;
11719 IF unbounded#NulSym
11721 FillInUnboundedFields(GetTokenNo(), unbounded, SimpleType, i)
11723 END doFillInOAFamily ;
11727 FillInUnboundedFields -
11730 PROCEDURE FillInUnboundedFields (tok: CARDINAL;
11731 sym: CARDINAL; SimpleType: CARDINAL; ndim: CARDINAL) ;
11733 pSym : PtrToSymbol ;
11734 Contents: CARDINAL ;
11739 pSym := GetPsym(sym) ;
11741 SymbolType := UnboundedSym ;
11743 Type := SimpleType ; (* Index to a simple type. *)
11744 Size := InitValue() ; (* Size in bytes for this sym *)
11745 Scope := GetScope(SimpleType) ; (* Which scope will create it *)
11746 InitWhereDeclaredTok(tok, At) ; (* Declared here *)
11747 NewSym(RecordType) ;
11748 FillInRecordFields(tok, RecordType, NulName, GetScope(SimpleType), NulSym) ;
11750 FillInPointerFields(Contents, NulName, GetScope(SimpleType), NulSym) ;
11751 PutPointer(Contents, SimpleType) ;
11752 (* create the contents field for the unbounded array. *)
11753 Assert (PutFieldRecord(RecordType,
11754 MakeKey(UnboundedAddressName),
11755 Contents, NulSym) # NulSym) ;
11756 (* create all the high fields for the unbounded array. *)
11759 Assert (PutFieldRecord(RecordType,
11760 makekey(string(Mark(Sprintf1(Mark(InitString(UnboundedHighName)), i)))),
11761 Cardinal, NulSym) # NulSym) ;
11767 ForeachParameterDo(CheckUnbounded)
11769 END FillInUnboundedFields ;
11773 MakeUnbounded - makes an unbounded array Symbol.
11774 ndim is the number of dimensions required.
11775 No name is required.
11778 PROCEDURE MakeUnbounded (tok: CARDINAL;
11779 SimpleType: CARDINAL; ndim: CARDINAL) : CARDINAL ;
11781 sym, oaf: CARDINAL ;
11783 oaf := MakeOAFamily(SimpleType) ;
11784 sym := GetUnbounded(oaf, ndim) ;
11788 IF IsUnknown (SimpleType)
11790 PutPartialUnbounded(sym, SimpleType, ndim)
11792 FillInUnboundedFields(tok, sym, SimpleType, ndim)
11794 PutUnbounded(oaf, sym, ndim)
11797 END MakeUnbounded ;
11801 GetUnbounded - returns the unbounded symbol associated with
11802 the OAFamily symbol, oaf, and the number of
11803 dimensions, ndim, of the open array.
11806 PROCEDURE GetUnbounded (oaf: CARDINAL; ndim: CARDINAL) : CARDINAL ;
11808 pSym: PtrToSymbol ;
11810 pSym := GetPsym(oaf) ;
11814 OAFamilySym: WITH OAFamily DO
11815 IF ndim>MaxDimensions
11819 RETURN( GetFromIndex(Dimensions, ndim) )
11824 InternalError ('expecting OAFamily symbol')
11831 PutUnbounded - associates the unbounded symbol, open, with
11835 PROCEDURE PutUnbounded (oaf: CARDINAL; sym: CARDINAL; ndim: CARDINAL) ;
11837 pSym: PtrToSymbol ;
11839 pSym := GetPsym(oaf) ;
11843 OAFamilySym: WITH OAFamily DO
11844 (* need to check to see if we need to add NulSym for all dimensions < ndim
11845 which have not been used. *)
11846 WHILE MaxDimensions<ndim DO
11847 INC(MaxDimensions) ;
11848 IF MaxDimensions<ndim
11850 (* add NulSym to an unused dimension. *)
11851 PutIntoIndex(Dimensions, MaxDimensions, NulSym)
11854 (* and finally add the known sym. *)
11855 PutIntoIndex(Dimensions, ndim, sym)
11859 InternalError ('expecting OAFamily symbol')
11866 GetUnboundedRecordType - returns the record type used to
11867 implement the unbounded array.
11870 PROCEDURE GetUnboundedRecordType (Sym: CARDINAL) : CARDINAL ;
11872 pSym: PtrToSymbol ;
11874 pSym := GetPsym(Sym) ;
11878 UnboundedSym: RETURN( Unbounded.RecordType )
11881 InternalError ('expecting an UnBounded symbol')
11884 END GetUnboundedRecordType ;
11888 GetUnboundedAddressOffset - returns the offset of the address field
11889 inside the record used to implement the
11893 PROCEDURE GetUnboundedAddressOffset (sym: CARDINAL) : CARDINAL ;
11898 rec := GetUnboundedRecordType(sym) ;
11901 InternalError ('expecting record type to be declared')
11903 field := GetLocalSym(rec, MakeKey(UnboundedAddressName)) ;
11906 InternalError ('expecting address field to be present inside unbounded record')
11911 END GetUnboundedAddressOffset ;
11915 GetUnboundedHighOffset - returns the offset of the high field
11916 inside the record used to implement the
11920 PROCEDURE GetUnboundedHighOffset (sym: CARDINAL; ndim: CARDINAL) : CARDINAL ;
11924 rec := GetUnboundedRecordType(sym) ;
11927 InternalError ('expecting record type to be declared')
11929 RETURN GetLocalSym(rec,
11930 makekey(string(Mark(Sprintf1(Mark(InitString(UnboundedHighName)),
11933 END GetUnboundedHighOffset ;
11937 GetArrayDimension - returns the number of dimensions defined.
11940 PROCEDURE GetArrayDimension (sym: CARDINAL) : CARDINAL ;
11945 WHILE IsArray(sym) DO
11946 sym := SkipType(GetType(sym)) ;
11950 END GetArrayDimension ;
11954 GetDimension - return the number of dimensions associated with
11955 this unbounded ARRAY parameter.
11958 PROCEDURE GetDimension (sym: CARDINAL) : CARDINAL ;
11960 pSym: PtrToSymbol ;
11962 pSym := GetPsym(sym) ;
11966 PartialUnboundedSym: RETURN( PartialUnbounded.NDim ) |
11967 UnboundedSym : RETURN( Unbounded.Dimensions ) |
11968 OAFamilySym : RETURN( OAFamily.MaxDimensions ) |
11969 ParamSym : IF Param.IsUnbounded
11971 RETURN( GetDimension(GetType(sym)) )
11973 InternalError ('expecting unbounded paramater')
11975 VarParamSym : IF VarParam.IsUnbounded
11977 RETURN( GetDimension(GetType(sym)) )
11979 InternalError ('expecting unbounded paramater')
11981 ArraySym : RETURN( GetArrayDimension(sym) ) |
11982 TypeSym : RETURN( GetDimension(GetType(sym)) ) |
11983 VarSym : RETURN( GetDimension(GetType(sym)) )
11986 InternalError ('expecting PartialUnbounded')
11993 PutArray - places a type symbol into an Array.
11996 PROCEDURE PutArray (Sym, TypeSymbol: CARDINAL) ;
11998 pSym: PtrToSymbol ;
12000 pSym := GetPsym(Sym) ;
12005 ArraySym: WITH Array DO
12006 Type := TypeSymbol (* The Array Type. ARRAY OF Type. *)
12009 InternalError ('expecting an Array symbol')
12016 ResolveConstructorType - if, sym, has an unresolved constructor type
12017 then attempt to resolve it by examining the
12021 PROCEDURE ResolveConstructorType (sym: CARDINAL;
12022 VAR type: CARDINAL;
12023 VAR from: CARDINAL;
12024 VAR unres: BOOLEAN) ;
12028 IF IsConstructor(from)
12030 IF IsConstructorResolved(from)
12033 type := GetType(from) ;
12034 IF (type#NulSym) AND IsSet(SkipType(type))
12039 ELSIF (from#NulSym) AND IsSet(SkipType(from))
12044 ELSIF (from#NulSym) AND (IsRecord(SkipType(from)) OR IsArray(SkipType(from)))
12050 END ResolveConstructorType ;
12054 IsConstructorResolved - returns TRUE if the constructor does not
12055 have an unresolved type.
12058 PROCEDURE IsConstructorResolved (sym: CARDINAL) : BOOLEAN ;
12060 pSym: PtrToSymbol ;
12062 pSym := GetPsym(sym) ;
12066 ConstVarSym: RETURN( NOT ConstVar.UnresFromType ) |
12067 ConstLitSym: RETURN( NOT ConstLit.UnresFromType )
12070 InternalError ('expecting ConstVar or ConstLit symbol')
12073 END IsConstructorResolved ;
12077 CanResolveConstructor - returns TRUE if the type of the constructor,
12081 PROCEDURE CanResolveConstructor (sym: CARDINAL) : BOOLEAN ;
12083 pSym: PtrToSymbol ;
12085 IF NOT IsConstructorResolved(sym)
12087 pSym := GetPsym(sym) ;
12091 ConstVarSym: WITH ConstVar DO
12092 ResolveConstructorType(sym, Type, FromType, UnresFromType)
12094 ConstLitSym: WITH ConstLit DO
12095 ResolveConstructorType(sym, Type, FromType, UnresFromType)
12099 InternalError ('expecting ConstVar or ConstLit symbol')
12103 RETURN( IsConstructorResolved(sym) )
12104 END CanResolveConstructor ;
12108 CheckAllConstructorsResolved - checks to see that the
12109 UnresolvedConstructorType list is
12110 empty and if it is not then it
12111 generates error messages.
12114 PROCEDURE CheckAllConstructorsResolved ;
12116 i, n, s: CARDINAL ;
12119 n := NoOfItemsInList(UnresolvedConstructorType) ;
12123 s := GetItemFromList(UnresolvedConstructorType, i) ;
12124 e := NewError(GetDeclaredMod(s)) ;
12125 ErrorFormat0(e, 'constructor has an unknown type')
12129 END CheckAllConstructorsResolved ;
12133 ResolveConstructorTypes - to be called at the end of pass three. Its
12134 purpose is to fix up all constructors whose
12138 PROCEDURE ResolveConstructorTypes ;
12140 finished: BOOLEAN ;
12141 i, n, s : CARDINAL ;
12144 n := NoOfItemsInList(UnresolvedConstructorType) ;
12148 s := GetItemFromList(UnresolvedConstructorType, i) ;
12149 Assert(IsConstructor(s)) ;
12150 IF CanResolveConstructor(s)
12152 finished := FALSE ;
12153 RemoveItemFromList(UnresolvedConstructorType, s) ;
12159 CheckAllConstructorsResolved
12160 END ResolveConstructorTypes ;
12164 SanityCheckParameters -
12167 PROCEDURE SanityCheckParameters (sym: CARDINAL) ;
12173 n := NoOfParam(sym) ;
12175 p := GetType(GetParam(sym, i)) ;
12178 MetaError3('the {%1N} formal parameter in procedure {%2Dad} should have a type rather than a constant {%3Dad}',
12183 END SanityCheckParameters ;
12187 SanityCheckArray - checks to see that an array has a correct subrange type.
12190 PROCEDURE SanityCheckArray (sym: CARDINAL) ;
12193 subscript: CARDINAL ;
12197 subscript := GetArraySubscript(sym) ;
12198 IF subscript#NulSym
12200 type := SkipType(GetType(subscript)) ;
12201 IF IsAModula2Type(type)
12203 (* ok all is good *)
12205 MetaError2('the array {%1Dad} must be declared with a simpletype in the [..] component rather than a {%2d}',
12210 END SanityCheckArray ;
12214 ForeachSymbolDo - foreach symbol, call, P(sym).
12217 PROCEDURE ForeachSymbolDo (P: PerformOperation) ;
12221 i := Indexing.LowIndice(Symbols) ;
12222 n := Indexing.HighIndice(Symbols) ;
12227 END ForeachSymbolDo ;
12231 SanityCheckProcedure - check to see that procedure parameters do not use constants
12232 instead of types in their formal parameter section.
12235 PROCEDURE SanityCheckProcedure (sym: CARDINAL) ;
12237 SanityCheckParameters(sym)
12238 END SanityCheckProcedure ;
12242 SanityCheckModule -
12245 PROCEDURE SanityCheckModule (sym: CARDINAL) ;
12247 ForeachInnerModuleDo(sym, SanityCheckModule) ;
12248 ForeachProcedureDo(sym, SanityCheckProcedure) ;
12249 ForeachLocalSymDo(sym, SanityCheckArray)
12250 END SanityCheckModule ;
12254 SanityCheckConstants - must only be called once all constants, types, procedures
12255 have been declared. It checks to see that constants are
12256 not used as procedure parameter types.
12259 PROCEDURE SanityCheckConstants ;
12261 ForeachModuleDo(SanityCheckModule) ;
12262 ForeachSymbolDo(SanityCheckArray)
12263 END SanityCheckConstants ;
12267 AddNameTo - adds Name, n, to tree, s.
12270 PROCEDURE AddNameTo (s: SymbolTree; o: CARDINAL) ;
12272 IF GetSymKey(s, GetSymName(o))=NulKey
12274 PutSymKey(s, GetSymName(o), o)
12280 AddNameToScope - adds a Name, n, to the list of objects declared at the
12284 PROCEDURE AddNameToScope (n: Name) ;
12286 pSym : PtrToSymbol ;
12289 scope := GetCurrentScope() ;
12290 pSym := GetPsym(scope) ;
12294 ProcedureSym: AddNameTo(Procedure.NamedObjects, MakeObject(n)) |
12295 ModuleSym : AddNameTo(Module.NamedObjects, MakeObject(n)) |
12296 DefImpSym : AddNameTo(DefImp.NamedObjects, MakeObject(n))
12299 InternalError ('expecting - DefImp')
12302 END AddNameToScope ;
12306 AddNameToImportList - adds a Name, n, to the import list of the current
12310 PROCEDURE AddNameToImportList (n: Name) ;
12312 pSym : PtrToSymbol ;
12315 scope := GetCurrentScope() ;
12316 pSym := GetPsym(scope) ;
12320 ModuleSym: AddNameTo(Module.NamedImports, MakeObject(n)) |
12321 DefImpSym: AddNameTo(DefImp.NamedImports, MakeObject(n))
12324 InternalError ('expecting - DefImp or Module symbol')
12327 END AddNameToImportList ;
12331 ResolveModule: CARDINAL ;
12335 CollectSymbolFrom -
12338 PROCEDURE CollectSymbolFrom (tok: CARDINAL; scope: CARDINAL; n: Name) : CARDINAL ;
12343 n1 := GetSymName (scope) ;
12346 printf2('declaring %a in %a', n, n1)
12348 sym := CheckScopeForSym (scope, n) ;
12351 sym := FetchUnknownFrom (tok, scope, n)
12355 printf1(' symbol created (%d)\n', sym)
12358 END CollectSymbolFrom ;
12365 PROCEDURE CollectUnknown (tok: CARDINAL; sym: CARDINAL; n: Name) : CARDINAL ;
12367 pSym: PtrToSymbol ;
12371 IF IsModule (sym) OR IsDefImp (sym)
12373 RETURN( CollectSymbolFrom (tok, sym, n) )
12374 ELSIF IsProcedure(sym)
12376 s := CheckScopeForSym (sym, n) ;
12379 pSym := GetPsym (sym) ;
12383 ProcedureSym: IF GetSymKey (Procedure.NamedObjects, n) # NulKey
12385 RETURN( CollectSymbolFrom (tok, sym, n) )
12389 InternalError ('expecting - Procedure symbol')
12392 s := CollectUnknown (tok, GetScope (sym), n)
12396 END CollectUnknown ;
12403 PROCEDURE ResolveImport (o: WORD) ;
12411 n1 := GetSymName(o) ;
12412 printf1('attempting to find out where %a was declared\n', n1) ;
12413 n1 := GetSymName(ResolveModule) ;
12414 n2 := GetSymName(GetScope(ResolveModule)) ;
12415 printf2('scope of module %a is %a\n', n1, n2)
12417 tok := GetFirstUsed (o) ;
12418 sym := CollectUnknown (tok, GetScope(ResolveModule), GetSymName(o)) ;
12421 MetaError2('unknown symbol {%1Uad} found in import list of module {%2a}',
12424 AddSymToModuleScope(ResolveModule, sym)
12426 END ResolveImport ;
12430 ResolveRelativeImport -
12433 PROCEDURE ResolveRelativeImport (sym: CARDINAL) ;
12435 pSym: PtrToSymbol ;
12439 ResolveModule := sym ;
12440 pSym := GetPsym(sym) ;
12444 ModuleSym: ForeachNodeDo(Module.NamedImports,
12448 InternalError ('expecting - Module symbol')
12452 ForeachProcedureDo(sym, ResolveRelativeImport) ;
12453 ForeachInnerModuleDo(sym, ResolveRelativeImport)
12454 END ResolveRelativeImport ;
12458 ResolveImports - it examines the import list of all inner modules
12459 and resolves all relative imports.
12462 PROCEDURE ResolveImports ;
12466 scope := GetCurrentScope() ;
12469 DisplayTrees(scope)
12471 ForeachProcedureDo(scope, ResolveRelativeImport) ;
12472 ForeachInnerModuleDo(scope, ResolveRelativeImport)
12473 END ResolveImports ;
12477 GetScope - returns the declaration scope of the symbol.
12480 PROCEDURE GetScope (Sym: CARDINAL) : CARDINAL ;
12482 pSym: PtrToSymbol ;
12484 pSym := GetPsym(Sym) ;
12488 ErrorSym : ErrorAbort0('') |
12489 DefImpSym : RETURN( NulSym ) |
12490 ModuleSym : RETURN( Module.Scope ) |
12491 VarSym : RETURN( Var.Scope ) |
12492 ProcedureSym : RETURN( Procedure.Scope ) |
12493 ProcTypeSym : RETURN( ProcType.Scope ) |
12494 RecordFieldSym : RETURN( RecordField.Scope ) |
12495 VarientSym : RETURN( Varient.Scope ) |
12496 VarientFieldSym : RETURN( VarientField.Scope ) |
12497 EnumerationSym : RETURN( Enumeration.Scope ) |
12498 EnumerationFieldSym: RETURN( EnumerationField.Scope ) |
12499 SubrangeSym : RETURN( Subrange.Scope ) |
12500 ArraySym : RETURN( Array.Scope ) |
12501 TypeSym : RETURN( Type.Scope ) |
12502 PointerSym : RETURN( Pointer.Scope ) |
12503 RecordSym : RETURN( Record.Scope ) |
12504 SetSym : RETURN( Set.Scope ) |
12505 UnboundedSym : RETURN( Unbounded.Scope ) |
12506 ConstLitSym : RETURN( ConstLit.Scope ) |
12507 ConstStringSym : RETURN( ConstString.Scope ) |
12508 ConstVarSym : RETURN( ConstVar.Scope ) |
12509 PartialUnboundedSym: InternalError ('should not be requesting the scope of a PartialUnbounded symbol')
12512 InternalError ('not implemented yet')
12519 GetModuleScope - returns the module scope of symbol, sym.
12520 If sym was declared within a nested procedure
12521 then return the module which defines the
12525 PROCEDURE GetModuleScope (sym: CARDINAL) : CARDINAL ;
12529 mod := GetScope(sym) ;
12530 WHILE (mod#NulSym) AND (NOT IsDefImp(mod)) AND (NOT IsModule(mod)) DO
12531 mod := GetScope(mod)
12534 END GetModuleScope ;
12538 GetProcedureScope - returns the innermost procedure (if any)
12539 in which the symbol, sym, resides.
12540 A module inside the procedure is skipped
12544 PROCEDURE GetProcedureScope (sym: CARDINAL) : CARDINAL ;
12546 WHILE (sym#NulSym) AND (NOT IsProcedure(sym)) DO
12547 sym := GetScope(sym)
12549 IF (sym#NulSym) AND IsProcedure(sym)
12555 END GetProcedureScope ;
12559 IsModuleWithinProcedure - returns TRUE if module, sym, is
12560 inside a procedure.
12563 PROCEDURE IsModuleWithinProcedure (sym: CARDINAL) : BOOLEAN ;
12565 RETURN( GetProcedureScope(sym)#NulSym )
12566 END IsModuleWithinProcedure ;
12570 GetParent - returns the parent of symbol, Sym.
12573 PROCEDURE GetParent (Sym: CARDINAL) : CARDINAL ;
12575 pSym: PtrToSymbol ;
12577 pSym := GetPsym(Sym) ;
12581 ErrorSym : ErrorAbort0('') |
12582 VarientSym : RETURN( Varient.Parent ) |
12583 VarientFieldSym : RETURN( VarientField.Parent ) |
12584 RecordFieldSym : RETURN( RecordField.Parent ) |
12585 EnumerationFieldSym: RETURN( EnumerationField.Type )
12588 InternalError ('not implemented yet')
12595 IsRecordField - returns true if Sym is a record field.
12598 PROCEDURE IsRecordField (Sym: CARDINAL) : BOOLEAN ;
12600 pSym: PtrToSymbol ;
12602 pSym := GetPsym(Sym) ;
12603 RETURN( pSym^.SymbolType=RecordFieldSym )
12604 END IsRecordField ;
12608 MakeProcType - returns a procedure type symbol with ProcTypeName.
12611 PROCEDURE MakeProcType (tok: CARDINAL; ProcTypeName: Name) : CARDINAL ;
12613 pSym : PtrToSymbol ;
12614 oaf, sym: CARDINAL ;
12616 sym := HandleHiddenOrDeclare (tok, ProcTypeName, oaf) ;
12617 IF NOT IsError(sym)
12619 pSym := GetPsym(sym) ;
12621 SymbolType := ProcTypeSym ;
12624 ProcTypeSym: ProcType.ReturnType := NulSym ;
12625 ProcType.name := ProcTypeName ;
12626 InitList(ProcType.ListOfParam) ;
12627 ProcType.HasVarArgs := FALSE ; (* Does this proc type use ... ? *)
12628 ProcType.HasOptArg := FALSE ; (* Does this proc type use [ ] ? *)
12629 ProcType.OptArgInit := NulSym ; (* The optarg initial value. *)
12630 ProcType.ReturnOptional := FALSE ; (* Is the return value optional? *)
12631 ProcType.Scope := GetCurrentScope() ;
12632 (* scope of procedure. *)
12633 ProcType.Size := InitValue() ;
12634 ProcType.TotalParamSize := InitValue() ; (* size of all parameters *)
12635 ProcType.oafamily := oaf ; (* The oa family for this symbol *)
12636 InitWhereDeclaredTok(tok, ProcType.At) (* Declared here *)
12639 InternalError ('expecting ProcType symbol')
12643 ForeachOAFamily(oaf, doFillInOAFamily) ;
12649 PutProcTypeParam - Places a Non VAR parameter ParamName with type
12650 ParamType into ProcType Sym.
12653 PROCEDURE PutProcTypeParam (Sym: CARDINAL;
12654 ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
12656 pSym : PtrToSymbol ;
12660 pSym := GetPsym(ParSym) ;
12662 SymbolType := ParamSym ;
12665 Type := ParamType ;
12666 IsUnbounded := isUnbounded ;
12667 ShadowVar := NulSym ;
12668 InitWhereDeclared(At)
12671 AddParameter(Sym, ParSym)
12672 END PutProcTypeParam ;
12676 PutProcTypeVarParam - Places a Non VAR parameter ParamName with type
12677 ParamType into ProcType Sym.
12680 PROCEDURE PutProcTypeVarParam (Sym: CARDINAL;
12681 ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
12683 pSym : PtrToSymbol ;
12687 pSym := GetPsym(ParSym) ;
12689 SymbolType := VarParamSym ;
12692 Type := ParamType ;
12693 IsUnbounded := isUnbounded ;
12694 ShadowVar := NulSym ;
12695 InitWhereDeclared(At)
12698 AddParameter(Sym, ParSym)
12699 END PutProcTypeVarParam ;
12703 PutProcedureReachable - Sets the procedure, Sym, to be reachable by the
12707 PROCEDURE PutProcedureReachable (Sym: CARDINAL) ;
12709 pSym: PtrToSymbol ;
12711 pSym := GetPsym(Sym) ;
12716 ProcedureSym: Procedure.Reachable := TRUE
12719 InternalError ('expecting Procedure symbol')
12722 END PutProcedureReachable ;
12726 PutModuleStartQuad - Places QuadNumber into the Module symbol, Sym.
12727 QuadNumber is the start quad of Module,
12731 PROCEDURE PutModuleStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
12733 pSym: PtrToSymbol ;
12735 pSym := GetPsym(Sym) ;
12739 ModuleSym: Module.StartQuad := QuadNumber |
12740 DefImpSym: DefImp.StartQuad := QuadNumber
12743 InternalError ('expecting a Module or DefImp symbol')
12746 END PutModuleStartQuad ;
12750 PutModuleEndQuad - Places QuadNumber into the Module symbol, Sym.
12751 QuadNumber is the end quad of Module,
12755 PROCEDURE PutModuleEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
12757 pSym: PtrToSymbol ;
12759 pSym := GetPsym(Sym) ;
12763 ModuleSym: Module.EndQuad := QuadNumber |
12764 DefImpSym: DefImp.EndQuad := QuadNumber
12767 InternalError ('expecting a Module or DefImp symbol')
12770 END PutModuleEndQuad ;
12774 PutModuleFinallyStartQuad - Places QuadNumber into the Module symbol, Sym.
12775 QuadNumber is the finally start quad of
12779 PROCEDURE PutModuleFinallyStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
12781 pSym: PtrToSymbol ;
12783 pSym := GetPsym(Sym) ;
12787 ModuleSym: Module.StartFinishQuad := QuadNumber |
12788 DefImpSym: DefImp.StartFinishQuad := QuadNumber
12791 InternalError ('expecting a Module or DefImp symbol')
12794 END PutModuleFinallyStartQuad ;
12798 PutModuleFinallyEndQuad - Places QuadNumber into the Module symbol, Sym.
12799 QuadNumber is the end quad of the finally block
12803 PROCEDURE PutModuleFinallyEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
12805 pSym: PtrToSymbol ;
12807 pSym := GetPsym(Sym) ;
12811 ModuleSym: Module.EndFinishQuad := QuadNumber |
12812 DefImpSym: DefImp.EndFinishQuad := QuadNumber
12815 InternalError ('expecting a Module or DefImp symbol')
12818 END PutModuleFinallyEndQuad ;
12822 GetModuleQuads - Returns, StartInit EndInit StartFinish EndFinish,
12823 Quads of a Module, Sym.
12824 Start and End represent the initialization code
12825 of the Module, Sym.
12828 PROCEDURE GetModuleQuads (Sym: CARDINAL;
12829 VAR StartInit, EndInit,
12830 StartFinish, EndFinish: CARDINAL) ;
12832 pSym: PtrToSymbol ;
12834 pSym := GetPsym(Sym) ;
12838 ModuleSym: WITH Module DO
12839 StartInit := StartQuad ;
12840 EndInit := EndQuad ;
12841 StartFinish := StartFinishQuad ;
12842 EndFinish := EndFinishQuad
12844 DefImpSym: WITH DefImp DO
12845 StartInit := StartQuad ;
12846 EndInit := EndQuad ;
12847 StartFinish := StartFinishQuad ;
12848 EndFinish := EndFinishQuad
12852 InternalError ('expecting a Module or DefImp symbol')
12855 END GetModuleQuads ;
12859 PutModuleFinallyFunction - Places Tree, finally, into the Module symbol, Sym.
12862 PROCEDURE PutModuleFinallyFunction (Sym: CARDINAL; finally: Tree) ;
12864 pSym: PtrToSymbol ;
12866 pSym := GetPsym(Sym) ;
12870 ModuleSym: Module.FinallyFunction := finally |
12871 DefImpSym: DefImp.FinallyFunction := finally
12874 InternalError ('expecting a Module or DefImp symbol')
12877 END PutModuleFinallyFunction ;
12881 GetModuleFinallyFunction - returns the finally tree from the Module symbol, Sym.
12884 PROCEDURE GetModuleFinallyFunction (Sym: CARDINAL) : Tree ;
12886 pSym: PtrToSymbol ;
12888 pSym := GetPsym(Sym) ;
12892 ModuleSym: RETURN( Module.FinallyFunction) |
12893 DefImpSym: RETURN( DefImp.FinallyFunction)
12896 InternalError ('expecting a Module or DefImp symbol')
12899 END GetModuleFinallyFunction ;
12903 PutProcedureScopeQuad - Places QuadNumber into the Procedure symbol, Sym.
12904 QuadNumber is the start quad of scope for procedure,
12908 PROCEDURE PutProcedureScopeQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
12910 pSym: PtrToSymbol ;
12912 pSym := GetPsym(Sym) ;
12916 ProcedureSym: Procedure.ScopeQuad := QuadNumber
12919 InternalError ('expecting a Procedure symbol')
12922 END PutProcedureScopeQuad ;
12926 PutProcedureStartQuad - Places QuadNumber into the Procedure symbol, Sym.
12927 QuadNumber is the start quad of procedure,
12931 PROCEDURE PutProcedureStartQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
12933 pSym: PtrToSymbol ;
12935 pSym := GetPsym(Sym) ;
12939 ProcedureSym: Procedure.StartQuad := QuadNumber
12942 InternalError ('expecting a Procedure symbol')
12945 END PutProcedureStartQuad ;
12949 PutProcedureEndQuad - Places QuadNumber into the Procedure symbol, Sym.
12950 QuadNumber is the end quad of procedure,
12954 PROCEDURE PutProcedureEndQuad (Sym: CARDINAL; QuadNumber: CARDINAL) ;
12956 pSym: PtrToSymbol ;
12958 pSym := GetPsym(Sym) ;
12962 ProcedureSym: Procedure.EndQuad := QuadNumber
12965 InternalError ('expecting a Procedure symbol')
12968 END PutProcedureEndQuad ;
12972 GetProcedureQuads - Returns, Start and End, Quads of a procedure, Sym.
12975 PROCEDURE GetProcedureQuads (Sym: CARDINAL; VAR scope, start, end: CARDINAL) ;
12977 pSym: PtrToSymbol ;
12979 pSym := GetPsym(Sym) ;
12983 ProcedureSym: WITH Procedure DO
12984 scope := ScopeQuad ;
12985 start := StartQuad ;
12990 InternalError ('expecting a Procedure symbol')
12993 END GetProcedureQuads ;
12997 GetReadQuads - assigns Start and End to the beginning and end of
12998 symbol, Sym, read history usage.
13001 PROCEDURE GetReadQuads (Sym: CARDINAL; m: ModeOfAddr;
13002 VAR Start, End: CARDINAL) ;
13004 GetReadLimitQuads(Sym, m, 0, 0, Start, End)
13009 GetWriteQuads - assigns Start and End to the beginning and end of
13010 symbol, Sym, usage.
13013 PROCEDURE GetWriteQuads (Sym: CARDINAL; m: ModeOfAddr;
13014 VAR Start, End: CARDINAL) ;
13016 GetWriteLimitQuads(Sym, m, 0, 0, Start, End)
13017 END GetWriteQuads ;
13021 PutProcedureBegin - assigns begin as the token number matching the
13025 PROCEDURE PutProcedureBegin (Sym: CARDINAL; begin: CARDINAL) ;
13027 pSym: PtrToSymbol ;
13029 pSym := GetPsym(Sym) ;
13033 ProcedureSym: Procedure.Begin := begin
13036 InternalError ('expecting a Procedure symbol')
13039 END PutProcedureBegin ;
13043 PutProcedureEnd - assigns end as the token number matching the
13047 PROCEDURE PutProcedureEnd (Sym: CARDINAL; end: CARDINAL) ;
13049 pSym: PtrToSymbol ;
13051 pSym := GetPsym(Sym) ;
13055 ProcedureSym: Procedure.End := end
13058 InternalError ('expecting a Procedure symbol')
13061 END PutProcedureEnd ;
13065 GetProcedureBeginEnd - assigns, begin, end, to the stored token values.
13068 PROCEDURE GetProcedureBeginEnd (Sym: CARDINAL; VAR begin, end: CARDINAL) ;
13070 pSym: PtrToSymbol ;
13072 pSym := GetPsym(Sym) ;
13076 ProcedureSym: begin := Procedure.Begin ;
13077 end := Procedure.End
13080 InternalError ('expecting a Procedure symbol')
13083 END GetProcedureBeginEnd ;
13090 PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
13105 PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
13117 GetQuads - assigns Start and End to the beginning and end of
13118 symbol, Sym, usage.
13121 PROCEDURE GetQuads (Sym: CARDINAL; m: ModeOfAddr; VAR Start, End: CARDINAL) ;
13123 StartRead, EndRead,
13124 StartWrite, EndWrite: CARDINAL ;
13126 GetReadQuads(Sym, m, StartRead, EndRead) ;
13127 GetWriteQuads(Sym, m, StartWrite, EndWrite) ;
13130 Start := StartWrite
13135 Start := Min(StartRead, StartWrite)
13144 End := Max(EndRead, EndWrite)
13150 PutReadQuad - places Quad into the list of symbol usage.
13153 PROCEDURE PutReadQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
13155 pSym: PtrToSymbol ;
13157 pSym := GetPsym(Sym) ;
13161 VarSym: IncludeItemIntoList(Var.ReadUsageList[m], Quad)
13164 InternalError ('expecting a Var symbol')
13171 RemoveReadQuad - places Quad into the list of symbol usage.
13174 PROCEDURE RemoveReadQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
13176 pSym: PtrToSymbol ;
13178 pSym := GetPsym(Sym) ;
13182 VarSym: RemoveItemFromList(Var.ReadUsageList[m], Quad)
13185 InternalError ('expecting a Var symbol')
13188 END RemoveReadQuad ;
13192 PutWriteQuad - places Quad into the list of symbol usage.
13195 PROCEDURE PutWriteQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
13197 pSym: PtrToSymbol ;
13199 pSym := GetPsym(Sym) ;
13203 VarSym: IncludeItemIntoList(Var.WriteUsageList[m], Quad)
13206 InternalError ('expecting a Var symbol')
13213 RemoveWriteQuad - places Quad into the list of symbol usage.
13216 PROCEDURE RemoveWriteQuad (Sym: CARDINAL; m: ModeOfAddr; Quad: CARDINAL) ;
13218 pSym: PtrToSymbol ;
13220 pSym := GetPsym(Sym) ;
13224 VarSym: RemoveItemFromList(Var.WriteUsageList[m], Quad)
13227 InternalError ('expecting a Var symbol')
13230 END RemoveWriteQuad ;
13234 DoFindLimits - assigns, Start, and, End, to the start and end
13235 limits contained in the list, l. It ensures that
13236 Start and End are within StartLimit..EndLimit.
13237 If StartLimit or EndLimit are 0 then Start is
13238 is set to the first value and End to the last.
13241 PROCEDURE DoFindLimits (StartLimit, EndLimit: CARDINAL;
13242 VAR Start, End: CARDINAL; l: List) ;
13244 i, j, n: CARDINAL ;
13249 n := NoOfItemsInList(l) ;
13251 j := GetItemFromList(l, i) ;
13252 IF (j>End) AND (j>=StartLimit) AND ((j<=EndLimit) OR (EndLimit=0))
13256 IF ((Start=0) OR (j<Start)) AND (j#0) AND (j>=StartLimit) AND
13257 ((j<=EndLimit) OR (EndLimit=0))
13267 GetReadLimitQuads - returns Start and End which have been assigned
13268 the start and end of when the symbol was read
13269 to within: StartLimit..EndLimit.
13272 PROCEDURE GetReadLimitQuads (Sym: CARDINAL; m: ModeOfAddr;
13273 StartLimit, EndLimit: CARDINAL;
13274 VAR Start, End: CARDINAL) ;
13276 pSym: PtrToSymbol ;
13278 pSym := GetPsym(Sym) ;
13282 VarSym: DoFindLimits(StartLimit, EndLimit, Start, End,
13283 Var.ReadUsageList[m])
13286 InternalError ('expecting a Var symbol')
13289 END GetReadLimitQuads ;
13293 GetWriteLimitQuads - returns Start and End which have been assigned
13294 the start and end of when the symbol was written
13295 to within: StartLimit..EndLimit.
13298 PROCEDURE GetWriteLimitQuads (Sym: CARDINAL; m: ModeOfAddr;
13299 StartLimit, EndLimit: CARDINAL;
13300 VAR Start, End: CARDINAL) ;
13302 pSym: PtrToSymbol ;
13304 pSym := GetPsym(Sym) ;
13308 VarSym : DoFindLimits(StartLimit, EndLimit, Start, End,
13309 Var.WriteUsageList[m])
13312 InternalError ('expecting a Var symbol')
13315 END GetWriteLimitQuads ;
13319 GetNthProcedure - Returns the Nth procedure in Module, Sym.
13322 PROCEDURE GetNthProcedure (Sym: CARDINAL; n: CARDINAL) : CARDINAL ;
13324 pSym: PtrToSymbol ;
13326 pSym := GetPsym(Sym) ;
13330 DefImpSym: RETURN( GetItemFromList(DefImp.ListOfProcs, n) ) |
13331 ModuleSym: RETURN( GetItemFromList(Module.ListOfProcs, n) )
13334 InternalError ('expecting a DefImp or Module symbol')
13337 END GetNthProcedure ;
13341 GetDeclaredDefinition - returns the token where this symbol
13342 was declared in the definition module.
13345 PROCEDURE GetDeclaredDefinition (Sym: CARDINAL) : CARDINAL ;
13347 pSym: PtrToSymbol ;
13349 pSym := GetPsym(Sym) ;
13353 ErrorSym : RETURN( Error.At.DefDeclared ) |
13354 ObjectSym : RETURN( Object.At.DefDeclared ) |
13355 VarientSym : RETURN( Varient.At.DefDeclared ) |
13356 RecordSym : RETURN( Record.At.DefDeclared ) |
13357 SubrangeSym : RETURN( Subrange.At.DefDeclared ) |
13358 EnumerationSym : RETURN( Enumeration.At.DefDeclared ) |
13359 ArraySym : RETURN( Array.At.DefDeclared ) |
13360 SubscriptSym : RETURN( Subscript.At.DefDeclared ) |
13361 UnboundedSym : RETURN( Unbounded.At.DefDeclared ) |
13362 ProcedureSym : RETURN( Procedure.At.DefDeclared ) |
13363 ProcTypeSym : RETURN( ProcType.At.DefDeclared ) |
13364 ParamSym : RETURN( Param.At.DefDeclared ) |
13365 VarParamSym : RETURN( VarParam.At.DefDeclared ) |
13366 ConstStringSym : RETURN( ConstString.At.DefDeclared ) |
13367 ConstLitSym : RETURN( ConstLit.At.DefDeclared ) |
13368 ConstVarSym : RETURN( ConstVar.At.DefDeclared ) |
13369 VarSym : RETURN( Var.At.DefDeclared ) |
13370 TypeSym : RETURN( Type.At.DefDeclared ) |
13371 PointerSym : RETURN( Pointer.At.DefDeclared ) |
13372 RecordFieldSym : RETURN( RecordField.At.DefDeclared ) |
13373 VarientFieldSym : RETURN( VarientField.At.DefDeclared ) |
13374 EnumerationFieldSym: RETURN( EnumerationField.At.DefDeclared ) |
13375 SetSym : RETURN( Set.At.DefDeclared ) |
13376 DefImpSym : RETURN( DefImp.At.DefDeclared ) |
13377 ModuleSym : RETURN( Module.At.DefDeclared ) |
13378 UndefinedSym : RETURN( GetFirstUsed(Sym) ) |
13379 ImportSym : RETURN( Import.at.DefDeclared ) |
13380 ImportStatementSym : RETURN( ImportStatement.at.DefDeclared ) |
13381 PartialUnboundedSym: RETURN( GetDeclaredDefinition(PartialUnbounded.Type) )
13384 InternalError ('not expecting this type of symbol')
13387 END GetDeclaredDefinition ;
13391 GetDeclaredModule - returns the token where this symbol was declared
13392 in an implementation or program module.
13395 PROCEDURE GetDeclaredModule (Sym: CARDINAL) : CARDINAL ;
13397 pSym: PtrToSymbol ;
13399 pSym := GetPsym(Sym) ;
13403 ErrorSym : RETURN( Error.At.ModDeclared ) |
13404 ObjectSym : RETURN( Object.At.ModDeclared ) |
13405 VarientSym : RETURN( Varient.At.ModDeclared ) |
13406 RecordSym : RETURN( Record.At.ModDeclared ) |
13407 SubrangeSym : RETURN( Subrange.At.ModDeclared ) |
13408 EnumerationSym : RETURN( Enumeration.At.ModDeclared ) |
13409 ArraySym : RETURN( Array.At.ModDeclared ) |
13410 SubscriptSym : RETURN( Subscript.At.ModDeclared ) |
13411 UnboundedSym : RETURN( Unbounded.At.ModDeclared ) |
13412 ProcedureSym : RETURN( Procedure.At.ModDeclared ) |
13413 ProcTypeSym : RETURN( ProcType.At.ModDeclared ) |
13414 ParamSym : RETURN( Param.At.ModDeclared ) |
13415 VarParamSym : RETURN( VarParam.At.ModDeclared ) |
13416 ConstStringSym : RETURN( ConstString.At.ModDeclared ) |
13417 ConstLitSym : RETURN( ConstLit.At.ModDeclared ) |
13418 ConstVarSym : RETURN( ConstVar.At.ModDeclared ) |
13419 VarSym : RETURN( Var.At.ModDeclared ) |
13420 TypeSym : RETURN( Type.At.ModDeclared ) |
13421 PointerSym : RETURN( Pointer.At.ModDeclared ) |
13422 RecordFieldSym : RETURN( RecordField.At.ModDeclared ) |
13423 VarientFieldSym : RETURN( VarientField.At.ModDeclared ) |
13424 EnumerationFieldSym: RETURN( EnumerationField.At.ModDeclared ) |
13425 SetSym : RETURN( Set.At.ModDeclared ) |
13426 DefImpSym : RETURN( DefImp.At.ModDeclared ) |
13427 ModuleSym : RETURN( Module.At.ModDeclared ) |
13428 UndefinedSym : RETURN( GetFirstUsed(Sym) ) |
13429 ImportSym : RETURN( Import.at.ModDeclared ) |
13430 ImportStatementSym : RETURN( ImportStatement.at.ModDeclared ) |
13431 PartialUnboundedSym: RETURN( GetDeclaredModule(PartialUnbounded.Type) )
13434 InternalError ('not expecting this type of symbol')
13437 END GetDeclaredModule ;
13441 PutDeclaredDefinition - associates the current tokenno with
13442 the symbols declaration in the definition
13446 PROCEDURE PutDeclaredDefinition (tok: CARDINAL; Sym: CARDINAL) ;
13448 pSym: PtrToSymbol ;
13450 pSym := GetPsym(Sym) ;
13454 ErrorSym : Error.At.DefDeclared := tok |
13455 ObjectSym : Object.At.DefDeclared := tok |
13456 VarientSym : Varient.At.DefDeclared := tok |
13457 RecordSym : Record.At.DefDeclared := tok |
13458 SubrangeSym : Subrange.At.DefDeclared := tok |
13459 EnumerationSym : Enumeration.At.DefDeclared := tok |
13460 ArraySym : Array.At.DefDeclared := tok |
13461 SubscriptSym : Subscript.At.DefDeclared := tok |
13462 UnboundedSym : Unbounded.At.DefDeclared := tok |
13463 ProcedureSym : Procedure.At.DefDeclared := tok |
13464 ProcTypeSym : ProcType.At.DefDeclared := tok |
13465 ParamSym : Param.At.DefDeclared := tok |
13466 VarParamSym : VarParam.At.DefDeclared := tok |
13467 ConstStringSym : ConstString.At.DefDeclared := tok |
13468 ConstLitSym : ConstLit.At.DefDeclared := tok |
13469 ConstVarSym : ConstVar.At.DefDeclared := tok |
13470 VarSym : Var.At.DefDeclared := tok |
13471 TypeSym : Type.At.DefDeclared := tok |
13472 PointerSym : Pointer.At.DefDeclared := tok |
13473 RecordFieldSym : RecordField.At.DefDeclared := tok |
13474 VarientFieldSym : VarientField.At.DefDeclared := tok |
13475 EnumerationFieldSym: EnumerationField.At.DefDeclared := tok |
13476 SetSym : Set.At.DefDeclared := tok |
13477 DefImpSym : DefImp.At.DefDeclared := tok |
13478 ModuleSym : Module.At.DefDeclared := tok |
13480 PartialUnboundedSym: PutDeclaredDefinition(tok, PartialUnbounded.Type)
13483 InternalError ('not expecting this type of symbol')
13486 END PutDeclaredDefinition ;
13490 PutDeclaredModule - returns the token where this symbol was declared
13491 in an implementation or program module.
13494 PROCEDURE PutDeclaredModule (tok: CARDINAL; Sym: CARDINAL) ;
13496 pSym: PtrToSymbol ;
13498 pSym := GetPsym(Sym) ;
13502 ErrorSym : Error.At.ModDeclared := tok |
13503 ObjectSym : Object.At.ModDeclared := tok |
13504 VarientSym : Varient.At.ModDeclared := tok |
13505 RecordSym : Record.At.ModDeclared := tok |
13506 SubrangeSym : Subrange.At.ModDeclared := tok |
13507 EnumerationSym : Enumeration.At.ModDeclared := tok |
13508 ArraySym : Array.At.ModDeclared := tok |
13509 SubscriptSym : Subscript.At.ModDeclared := tok |
13510 UnboundedSym : Unbounded.At.ModDeclared := tok |
13511 ProcedureSym : Procedure.At.ModDeclared := tok |
13512 ProcTypeSym : ProcType.At.ModDeclared := tok |
13513 ParamSym : Param.At.ModDeclared := tok |
13514 VarParamSym : VarParam.At.ModDeclared := tok |
13515 ConstStringSym : ConstString.At.ModDeclared := tok |
13516 ConstLitSym : ConstLit.At.ModDeclared := tok |
13517 ConstVarSym : ConstVar.At.ModDeclared := tok |
13518 VarSym : Var.At.ModDeclared := tok |
13519 TypeSym : Type.At.ModDeclared := tok |
13520 PointerSym : Pointer.At.ModDeclared := tok |
13521 RecordFieldSym : RecordField.At.ModDeclared := tok |
13522 VarientFieldSym : VarientField.At.ModDeclared := tok |
13523 EnumerationFieldSym: EnumerationField.At.ModDeclared := tok |
13524 SetSym : Set.At.ModDeclared := tok |
13525 DefImpSym : DefImp.At.ModDeclared := tok |
13526 ModuleSym : Module.At.ModDeclared := tok |
13528 PartialUnboundedSym: PutDeclaredModule(tok, PartialUnbounded.Type)
13531 InternalError ('not expecting this type of symbol')
13534 END PutDeclaredModule ;
13538 PutDeclared - adds an entry to symbol, Sym, indicating that it
13539 was declared at, tok. This routine
13540 may be called twice, once for definition module
13541 partial declaration and once when parsing the
13542 implementation module.
13545 PROCEDURE PutDeclared (tok: CARDINAL; Sym: CARDINAL) ;
13547 IF CompilingDefinitionModule ()
13549 PutDeclaredDefinition (tok, Sym)
13551 PutDeclaredModule (tok, Sym)
13557 GetDeclaredDef - returns the tokenno where the symbol was declared.
13558 The priority of declaration is definition, implementation
13559 and program module.
13562 PROCEDURE GetDeclaredDef (Sym: CARDINAL) : CARDINAL ;
13564 declared: CARDINAL ;
13566 declared := GetDeclaredDefinition (Sym) ;
13567 IF declared = UnknownTokenNo
13569 RETURN GetDeclaredModule (Sym)
13572 END GetDeclaredDef ;
13576 GetDeclaredMod - returns the tokenno where the symbol was declared.
13577 The priority of declaration is program,
13578 implementation and definition module.
13581 PROCEDURE GetDeclaredMod (Sym: CARDINAL) : CARDINAL ;
13583 declared: CARDINAL ;
13585 declared := GetDeclaredModule (Sym) ;
13586 IF declared = UnknownTokenNo
13588 RETURN GetDeclaredDefinition (Sym)
13591 END GetDeclaredMod ;
13595 GetFirstUsed - returns the token where this symbol was first used.
13598 PROCEDURE GetFirstUsed (Sym: CARDINAL) : CARDINAL ;
13600 pSym: PtrToSymbol ;
13602 pSym := GetPsym (Sym) ;
13606 ErrorSym : RETURN( Error.At.FirstUsed ) |
13607 ObjectSym : RETURN( Object.At.FirstUsed ) |
13608 UndefinedSym : RETURN( Undefined.At.FirstUsed ) |
13609 VarientSym : RETURN( Varient.At.FirstUsed ) |
13610 RecordSym : RETURN( Record.At.FirstUsed ) |
13611 SubrangeSym : RETURN( Subrange.At.FirstUsed ) |
13612 EnumerationSym : RETURN( Enumeration.At.FirstUsed ) |
13613 ArraySym : RETURN( Array.At.FirstUsed ) |
13614 SubscriptSym : RETURN( Subscript.At.FirstUsed ) |
13615 UnboundedSym : RETURN( Unbounded.At.FirstUsed ) |
13616 ProcedureSym : RETURN( Procedure.At.FirstUsed ) |
13617 ProcTypeSym : RETURN( ProcType.At.FirstUsed ) |
13618 ParamSym : RETURN( Param.At.FirstUsed ) |
13619 VarParamSym : RETURN( VarParam.At.FirstUsed ) |
13620 ConstStringSym : RETURN( ConstString.At.FirstUsed ) |
13621 ConstLitSym : RETURN( ConstLit.At.FirstUsed ) |
13622 ConstVarSym : RETURN( ConstVar.At.FirstUsed ) |
13623 VarSym : RETURN( Var.At.FirstUsed ) |
13624 TypeSym : RETURN( Type.At.FirstUsed ) |
13625 PointerSym : RETURN( Pointer.At.FirstUsed ) |
13626 RecordFieldSym : RETURN( RecordField.At.FirstUsed ) |
13627 VarientFieldSym : RETURN( VarientField.At.FirstUsed ) |
13628 EnumerationFieldSym: RETURN( EnumerationField.At.FirstUsed ) |
13629 SetSym : RETURN( Set.At.FirstUsed ) |
13630 DefImpSym : RETURN( DefImp.At.FirstUsed ) |
13631 ModuleSym : RETURN( Module.At.FirstUsed )
13634 InternalError ('not expecting this type of symbol')
13641 ForeachProcedureDo - for each procedure in module, Sym, do procedure, P.
13644 PROCEDURE ForeachProcedureDo (Sym: CARDINAL; P: PerformOperation) ;
13646 pSym: PtrToSymbol ;
13648 pSym := GetPsym(Sym) ;
13652 DefImpSym : ForeachItemInListDo( DefImp.ListOfProcs, P) |
13653 ModuleSym : ForeachItemInListDo( Module.ListOfProcs, P) |
13654 ProcedureSym: ForeachItemInListDo( Procedure.ListOfProcs, P)
13657 InternalError ('expecting DefImp or Module symbol')
13660 END ForeachProcedureDo ;
13664 ForeachInnerModuleDo - for each inner module in module, Sym,
13668 PROCEDURE ForeachInnerModuleDo (Sym: CARDINAL; P: PerformOperation) ;
13670 pSym: PtrToSymbol ;
13672 pSym := GetPsym(Sym) ;
13676 DefImpSym : ForeachItemInListDo( DefImp.ListOfModules, P) |
13677 ModuleSym : ForeachItemInListDo( Module.ListOfModules, P) |
13678 ProcedureSym: ForeachItemInListDo( Procedure.ListOfModules, P)
13681 InternalError ('expecting DefImp or Module symbol')
13684 END ForeachInnerModuleDo ;
13688 ForeachModuleDo - for each module do procedure, P.
13691 PROCEDURE ForeachModuleDo (P: PerformOperation) ;
13693 ForeachNodeDo (ModuleTree, P)
13694 END ForeachModuleDo ;
13698 ForeachFieldEnumerationDo - for each field in enumeration, Sym,
13699 do procedure, P. Each call to P contains
13700 an enumeration field, the order is alphabetical.
13701 Use ForeachLocalSymDo for declaration order.
13704 PROCEDURE ForeachFieldEnumerationDo (Sym: CARDINAL; P: PerformOperation) ;
13706 pSym: PtrToSymbol ;
13708 pSym := GetPsym(Sym) ;
13712 EnumerationSym: ForeachNodeDo (Enumeration.LocalSymbols, P)
13715 InternalError ('expecting Enumeration symbol')
13718 END ForeachFieldEnumerationDo ;
13722 IsProcedureReachable - Returns true if the procedure, Sym, is
13723 reachable from the main Module.
13726 PROCEDURE IsProcedureReachable (Sym: CARDINAL) : BOOLEAN ;
13728 pSym: PtrToSymbol ;
13730 pSym := GetPsym(Sym) ;
13734 ProcedureSym: RETURN( Procedure.Reachable )
13737 InternalError ('expecting Procedure symbol')
13740 END IsProcedureReachable ;
13744 IsProcType - returns true if Sym is a ProcType Symbol.
13747 PROCEDURE IsProcType (Sym: CARDINAL) : BOOLEAN ;
13749 pSym: PtrToSymbol ;
13751 pSym := GetPsym(Sym) ;
13752 RETURN( pSym^.SymbolType=ProcTypeSym )
13757 IsVar - returns true if Sym is a Var Symbol.
13760 PROCEDURE IsVar (Sym: CARDINAL) : BOOLEAN ;
13762 pSym: PtrToSymbol ;
13764 pSym := GetPsym(Sym) ;
13765 RETURN( pSym^.SymbolType=VarSym )
13770 DoIsConst - returns TRUE if Sym is defined as a constant
13771 or is an enumeration field or string.
13774 PROCEDURE DoIsConst (Sym: CARDINAL) : BOOLEAN ;
13776 pSym: PtrToSymbol ;
13778 pSym := GetPsym(Sym) ;
13780 RETURN( (SymbolType=ConstVarSym) OR
13781 (SymbolType=ConstLitSym) OR
13782 (SymbolType=ConstStringSym) OR
13783 ((SymbolType=VarSym) AND (Var.AddrMode=ImmediateValue)) OR
13784 (SymbolType=EnumerationFieldSym)
13791 IsConst - returns true if Sym contains a constant value.
13794 PROCEDURE IsConst (Sym: CARDINAL) : BOOLEAN ;
13796 IF IsConstructor(Sym)
13798 RETURN( IsConstructorConstant(Sym) )
13800 RETURN( DoIsConst(Sym) )
13806 IsConstString - returns whether sym is a conststring of any variant.
13809 PROCEDURE IsConstString (sym: CARDINAL) : BOOLEAN ;
13811 pSym: PtrToSymbol ;
13813 pSym := GetPsym (sym) ;
13815 RETURN SymbolType = ConstStringSym
13817 END IsConstString ;
13821 IsConstLit - returns true if Sym is a literal constant.
13824 PROCEDURE IsConstLit (Sym: CARDINAL) : BOOLEAN ;
13826 pSym: PtrToSymbol ;
13828 pSym := GetPsym(Sym) ;
13830 RETURN( SymbolType=ConstLitSym )
13836 IsDummy - returns true if Sym is a Dummy symbol.
13839 PROCEDURE IsDummy (Sym: CARDINAL) : BOOLEAN ;
13841 pSym: PtrToSymbol ;
13843 pSym := GetPsym(Sym) ;
13844 RETURN( pSym^.SymbolType=DummySym )
13849 IsTemporary - returns true if Sym is a Temporary symbol.
13852 PROCEDURE IsTemporary (Sym: CARDINAL) : BOOLEAN ;
13854 pSym: PtrToSymbol ;
13856 pSym := GetPsym(Sym) ;
13860 VarSym : RETURN( Var.IsTemp ) |
13861 ConstVarSym: RETURN( ConstVar.IsTemp )
13871 IsVarAParam - returns true if Sym is a variable declared as a parameter.
13874 PROCEDURE IsVarAParam (Sym: CARDINAL) : BOOLEAN ;
13876 pSym: PtrToSymbol ;
13878 pSym := GetPsym(Sym) ;
13882 VarSym: RETURN( Var.IsParam )
13892 IsSubscript - returns true if Sym is a subscript symbol.
13895 PROCEDURE IsSubscript (Sym: CARDINAL) : BOOLEAN ;
13897 pSym: PtrToSymbol ;
13899 pSym := GetPsym(Sym) ;
13900 RETURN( pSym^.SymbolType=SubscriptSym )
13905 IsSubrange - returns true if Sym is a subrange symbol.
13908 PROCEDURE IsSubrange (Sym: CARDINAL) : BOOLEAN ;
13910 pSym: PtrToSymbol ;
13912 pSym := GetPsym(Sym) ;
13913 RETURN( pSym^.SymbolType=SubrangeSym )
13918 IsProcedureVariable - returns true if a Sym is a variable and
13919 it was declared within a procedure.
13922 PROCEDURE IsProcedureVariable (Sym: CARDINAL) : BOOLEAN ;
13925 RETURN( IsVar(Sym) AND IsProcedure(GetVarScope(Sym)) )
13926 END IsProcedureVariable ;
13930 IsProcedureNested - returns TRUE if procedure, Sym, was
13931 declared as a nested procedure.
13934 PROCEDURE IsProcedureNested (Sym: CARDINAL) : BOOLEAN ;
13936 RETURN( IsProcedure(Sym) AND (IsProcedure(GetScope(Sym))) )
13937 END IsProcedureNested ;
13941 IsAModula2Type - returns true if Sym, is a:
13942 IsType, IsPointer, IsRecord, IsEnumeration,
13943 IsSubrange, IsArray, IsUnbounded, IsProcType.
13944 NOTE that it different from IsType.
13947 PROCEDURE IsAModula2Type (Sym: CARDINAL) : BOOLEAN ;
13951 IsType(Sym) OR IsRecord(Sym) OR IsPointer(Sym) OR
13952 IsEnumeration(Sym) OR IsSubrange(Sym) OR IsArray(Sym) OR
13953 IsUnbounded(Sym) OR IsProcType(Sym) OR IsSet(Sym)
13955 END IsAModula2Type ;
13959 IsGnuAsmVolatile - returns TRUE if a GnuAsm symbol was defined as VOLATILE.
13962 PROCEDURE IsGnuAsmVolatile (Sym: CARDINAL) : BOOLEAN ;
13964 pSym: PtrToSymbol ;
13966 pSym := GetPsym(Sym) ;
13970 GnuAsmSym: RETURN( GnuAsm.Volatile )
13973 InternalError ('expecting GnuAsm symbol')
13976 END IsGnuAsmVolatile ;
13980 IsGnuAsmSimple - returns TRUE if a GnuAsm symbol is a simple kind.
13983 PROCEDURE IsGnuAsmSimple (Sym: CARDINAL) : BOOLEAN ;
13985 pSym: PtrToSymbol ;
13987 pSym := GetPsym(Sym) ;
13991 GnuAsmSym: RETURN( GnuAsm.Simple )
13994 InternalError ('expecting GnuAsm symbol')
13997 END IsGnuAsmSimple ;
14001 IsGnuAsm - returns TRUE if Sym is a GnuAsm symbol.
14004 PROCEDURE IsGnuAsm (Sym: CARDINAL) : BOOLEAN ;
14006 pSym: PtrToSymbol ;
14008 pSym := GetPsym(Sym) ;
14010 RETURN( SymbolType=GnuAsmSym )
14016 IsRegInterface - returns TRUE if Sym is a RegInterface symbol.
14019 PROCEDURE IsRegInterface (Sym: CARDINAL) : BOOLEAN ;
14021 pSym: PtrToSymbol ;
14023 pSym := GetPsym(Sym) ;
14025 RETURN( SymbolType=InterfaceSym )
14027 END IsRegInterface ;
14031 GetParam - returns the ParamNo parameter from procedure ProcSym
14034 PROCEDURE GetParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
14039 (* Parameter Zero is the return argument for the Function *)
14040 RETURN(GetType(Sym))
14042 RETURN(GetNthParam(Sym, ParamNo))
14048 GetFromIndex - return a value from list, i, at position, n.
14051 PROCEDURE GetFromIndex (i: Indexing.Index; n: CARDINAL) : CARDINAL ;
14053 p: POINTER TO CARDINAL ;
14055 p := Indexing.GetIndice(i, n) ;
14061 PutIntoIndex - places value, v, into list, i, at position, n.
14064 PROCEDURE PutIntoIndex (VAR i: Indexing.Index; n: CARDINAL; v: CARDINAL) ;
14066 p: POINTER TO CARDINAL ;
14070 Indexing.PutIndice(i, n, p)
14075 Make2Tuple - creates and returns a 2 tuple from, a, and, b.
14078 PROCEDURE Make2Tuple (a, b: CARDINAL) : CARDINAL ;
14080 pSym: PtrToSymbol ;
14084 pSym := GetPsym(Sym) ;
14086 SymbolType := TupleSym ;
14089 list := Indexing.InitIndex(1) ;
14090 PutIntoIndex(list, 1, a) ;
14091 PutIntoIndex(list, 2, b) ;
14092 InitWhereDeclared(At) ;
14093 InitWhereFirstUsed(At)
14101 IsSizeSolved - returns true if the size of Sym is solved.
14104 PROCEDURE IsSizeSolved (Sym: CARDINAL) : BOOLEAN ;
14106 pSym: PtrToSymbol ;
14109 pSym := GetPsym(Sym) ;
14113 ProcedureSym : RETURN( IsSolved(Procedure.Size) ) |
14114 VarSym : RETURN( IsSolved(Var.Size) ) |
14115 TypeSym : RETURN( IsSolved(Type.Size) ) |
14116 SetSym : RETURN( IsSolved(Set.Size) ) |
14117 RecordSym : RETURN( IsSolved(Record.Size) ) |
14118 VarientSym : RETURN( IsSolved(Varient.Size) ) |
14119 EnumerationSym : RETURN( IsSolved(Enumeration.Size) ) |
14120 PointerSym : RETURN( IsSolved(Pointer.Size) ) |
14121 ArraySym : RETURN( IsSolved(Array.Size) ) |
14122 RecordFieldSym : RETURN( IsSolved(RecordField.Size) ) |
14123 VarientFieldSym : RETURN( IsSolved(VarientField.Size) ) |
14124 SubrangeSym : RETURN( IsSolved(Subrange.Size) ) |
14125 SubscriptSym : RETURN( IsSolved(Subscript.Size) ) |
14126 ProcTypeSym : RETURN( IsSolved(ProcType.Size) ) |
14127 UnboundedSym : RETURN( IsSolved(Unbounded.Size) )
14130 InternalError ('not expecting this kind of symbol')
14137 IsOffsetSolved - returns true if the Offset of Sym is solved.
14140 PROCEDURE IsOffsetSolved (Sym: CARDINAL) : BOOLEAN ;
14142 pSym: PtrToSymbol ;
14145 pSym := GetPsym(Sym) ;
14149 VarSym : RETURN( IsSolved(Var.Offset) ) |
14150 RecordFieldSym : RETURN( IsSolved(RecordField.Offset) ) |
14151 VarientFieldSym : RETURN( IsSolved(VarientField.Offset) )
14154 InternalError ('not expecting this kind of symbol')
14157 END IsOffsetSolved ;
14161 IsValueSolved - returns true if the value of Sym is solved.
14164 PROCEDURE IsValueSolved (Sym: CARDINAL) : BOOLEAN ;
14166 pSym: PtrToSymbol ;
14169 pSym := GetPsym(Sym) ;
14173 ConstLitSym : RETURN( IsSolved(ConstLit.Value) ) |
14174 ConstVarSym : RETURN( IsSolved(ConstVar.Value) ) |
14175 EnumerationFieldSym : RETURN( IsSolved(EnumerationField.Value) ) |
14176 ConstStringSym : RETURN( TRUE )
14179 InternalError ('not expecting this kind of symbol')
14182 END IsValueSolved ;
14186 IsConstructorConstant - returns TRUE if constructor, Sym, is
14187 defined by only constants.
14190 PROCEDURE IsConstructorConstant (Sym: CARDINAL) : BOOLEAN ;
14192 pSym: PtrToSymbol ;
14194 IF IsConstructor(Sym) OR IsConstSet(Sym)
14196 pSym := GetPsym(Sym) ;
14200 ConstVarSym: RETURN( IsValueConst(ConstVar.Value) ) |
14201 ConstLitSym: RETURN( IsValueConst(ConstLit.Value) )
14204 InternalError ('expecting Constructor')
14208 InternalError ('expecting Constructor')
14210 END IsConstructorConstant ;
14214 IsComposite - returns TRUE if symbol, sym, is a composite
14215 type: ie an ARRAY or RECORD.
14218 PROCEDURE IsComposite (sym: CARDINAL) : BOOLEAN ;
14224 sym := SkipType(sym) ;
14225 RETURN( IsArray(sym) OR IsRecord(sym) )
14231 IsSumOfParamSizeSolved - has the sum of parameters been solved yet?
14234 PROCEDURE IsSumOfParamSizeSolved (Sym: CARDINAL) : BOOLEAN ;
14236 pSym: PtrToSymbol ;
14239 pSym := GetPsym(Sym) ;
14243 ProcedureSym: RETURN( IsSolved(Procedure.TotalParamSize) ) |
14244 ProcTypeSym : RETURN( IsSolved(ProcType.TotalParamSize) )
14247 InternalError ('expecting Procedure or ProcType symbol')
14250 END IsSumOfParamSizeSolved ;
14254 PushSize - pushes the size of Sym.
14257 PROCEDURE PushSize (Sym: CARDINAL) ;
14259 pSym: PtrToSymbol ;
14262 pSym := GetPsym(Sym) ;
14266 ProcedureSym : PushFrom(Procedure.Size) |
14267 VarSym : PushFrom(Var.Size) |
14268 TypeSym : PushFrom(Type.Size) |
14269 SetSym : PushFrom(Set.Size) |
14270 VarientSym : PushFrom(Varient.Size) |
14271 RecordSym : PushFrom(Record.Size) |
14272 EnumerationSym : PushFrom(Enumeration.Size) |
14273 PointerSym : PushFrom(Pointer.Size) |
14274 ArraySym : PushFrom(Array.Size) |
14275 RecordFieldSym : PushFrom(RecordField.Size) |
14276 VarientFieldSym : PushFrom(VarientField.Size) |
14277 SubrangeSym : PushFrom(Subrange.Size) |
14278 SubscriptSym : PushFrom(Subscript.Size) |
14279 ProcTypeSym : PushFrom(ProcType.Size) |
14280 UnboundedSym : PushFrom(Unbounded.Size)
14283 InternalError ('not expecting this kind of symbol')
14290 PushOffset - pushes the Offset of Sym.
14293 PROCEDURE PushOffset (Sym: CARDINAL) ;
14295 pSym: PtrToSymbol ;
14298 pSym := GetPsym(Sym) ;
14302 VarSym : PushFrom(Var.Offset) |
14303 RecordFieldSym : PushFrom(RecordField.Offset) |
14304 VarientFieldSym : PushFrom(VarientField.Offset)
14307 InternalError ('not expecting this kind of symbol')
14314 PushValue - pushes the Value of Sym onto the ALU stack.
14317 PROCEDURE PushValue (Sym: CARDINAL) ;
14319 pSym: PtrToSymbol ;
14322 pSym := GetPsym(Sym) ;
14326 ConstLitSym : PushFrom(ConstLit.Value) |
14327 ConstVarSym : PushFrom(ConstVar.Value) |
14328 EnumerationFieldSym : PushFrom(EnumerationField.Value) |
14329 ConstStringSym : PushConstString(Sym)
14332 InternalError ('not expecting this kind of symbol')
14339 PushConstString - pushes the character string onto the ALU stack.
14340 It assumes that the character string is only
14341 one character long.
14344 PROCEDURE PushConstString (Sym: CARDINAL) ;
14346 pSym: PtrToSymbol ;
14347 a : ARRAY [0..10] OF CHAR ;
14350 pSym := GetPsym (Sym) ;
14354 ConstStringSym: WITH ConstString DO
14357 GetKey (Contents, a) ;
14360 WriteFormat0 ('ConstString must be length 1')
14365 InternalError ('expecting ConstString symbol')
14368 END PushConstString ;
14372 PushParamSize - push the size of parameter, ParamNo,
14373 of procedure Sym onto the ALU stack.
14376 PROCEDURE PushParamSize (Sym: CARDINAL; ParamNo: CARDINAL) ;
14378 p, Type: CARDINAL ;
14381 Assert(IsProcedure(Sym) OR IsProcType(Sym)) ;
14384 PushSize(GetType(Sym))
14387 can use GetNthParam but 1..n returns parameter.
14388 But 0 yields the function return type.
14390 Note that VAR Unbounded parameters and non VAR Unbounded parameters
14391 contain the unbounded descriptor. VAR unbounded parameters
14392 do NOT JUST contain an address re: other VAR parameters.
14394 IF IsVarParam(Sym, ParamNo) AND (NOT IsUnboundedParam(Sym, ParamNo))
14396 PushSize(Address) (* VAR parameters point to the variable *)
14398 p := GetNthParam(Sym, ParamNo) ; (* nth Parameter *)
14400 N.B. chose to get the Type of the parameter rather than the Var
14401 because ProcType's have Type but no Var associated with them.
14403 Type := GetType(p) ; (* ie Variable from Procedure Sym *)
14404 Assert(p#NulSym) ; (* If this fails then ParamNo is out of range *)
14408 END PushParamSize ;
14412 PushSumOfLocalVarSize - push the total size of all local variables
14413 onto the ALU stack.
14416 PROCEDURE PushSumOfLocalVarSize (Sym: CARDINAL) ;
14418 pSym: PtrToSymbol ;
14421 pSym := GetPsym(Sym) ;
14427 ModuleSym : PushSize(Sym)
14430 InternalError ('expecting Procedure, DefImp or Module symbol')
14433 END PushSumOfLocalVarSize ;
14437 PushSumOfParamSize - push the total size of all parameters onto
14441 PROCEDURE PushSumOfParamSize (Sym: CARDINAL) ;
14443 pSym: PtrToSymbol ;
14446 pSym := GetPsym(Sym) ;
14450 ProcedureSym: PushFrom(Procedure.TotalParamSize) |
14451 ProcTypeSym : PushFrom(ProcType.TotalParamSize)
14454 InternalError ('expecting Procedure or ProcType symbol')
14457 END PushSumOfParamSize ;
14461 PushVarSize - pushes the size of a variable, Sym.
14462 The runtime size of Sym will depend upon its addressing mode,
14463 RightValue has size PushSize(GetType(Sym)) and
14464 LeftValue has size PushSize(Address) since it points to a
14468 PROCEDURE PushVarSize (Sym: CARDINAL) ;
14471 Assert(IsVar(Sym)) ;
14472 IF GetMode(Sym)=LeftValue
14476 Assert(GetMode(Sym)=RightValue) ;
14477 PushSize(GetType(Sym))
14483 PopValue - pops the ALU stack into Value of Sym.
14486 PROCEDURE PopValue (Sym: CARDINAL) ;
14488 pSym: PtrToSymbol ;
14491 pSym := GetPsym(Sym) ;
14495 ConstLitSym : PopInto(ConstLit.Value) |
14496 ConstVarSym : PopInto(ConstVar.Value) |
14497 EnumerationFieldSym : InternalError ('cannot pop into an enumeration field')
14500 InternalError ('symbol type not expected')
14507 PopSize - pops the ALU stack into Size of Sym.
14510 PROCEDURE PopSize (Sym: CARDINAL) ;
14512 pSym: PtrToSymbol ;
14515 pSym := GetPsym(Sym) ;
14519 ProcedureSym : PopInto(Procedure.Size) |
14520 VarSym : PopInto(Var.Size) |
14521 TypeSym : PopInto(Type.Size) |
14522 RecordSym : PopInto(Record.Size) |
14523 VarientSym : PopInto(Varient.Size) |
14524 EnumerationSym : PopInto(Enumeration.Size) |
14525 PointerSym : PopInto(Pointer.Size) |
14526 ArraySym : PopInto(Array.Size) |
14527 RecordFieldSym : PopInto(RecordField.Size) |
14528 VarientFieldSym : PopInto(VarientField.Size) |
14529 SubrangeSym : PopInto(Subrange.Size) |
14530 SubscriptSym : PopInto(Subscript.Size) |
14531 ProcTypeSym : PopInto(ProcType.Size) |
14532 UnboundedSym : PopInto(Unbounded.Size) |
14533 SetSym : PopInto(Set.Size)
14536 InternalError ('not expecting this kind of symbol')
14543 PopOffset - pops the ALU stack into Offset of Sym.
14546 PROCEDURE PopOffset (Sym: CARDINAL) ;
14548 pSym: PtrToSymbol ;
14551 pSym := GetPsym(Sym) ;
14555 VarSym : PopInto(Var.Offset) |
14556 RecordFieldSym : PopInto(RecordField.Offset) |
14557 VarientFieldSym : PopInto(VarientField.Offset)
14560 InternalError ('not expecting this kind of symbol')
14567 PopSumOfParamSize - pop the total value on the ALU stack as the
14568 sum of all parameters.
14571 PROCEDURE PopSumOfParamSize (Sym: CARDINAL) ;
14573 pSym: PtrToSymbol ;
14576 pSym := GetPsym(Sym) ;
14580 ProcedureSym: PopInto(Procedure.TotalParamSize) |
14581 ProcTypeSym : PopInto(ProcType.TotalParamSize)
14584 InternalError ('expecting Procedure or ProcType symbol')
14587 END PopSumOfParamSize ;
14591 PutAlignment - assigns the alignment constant associated with,
14595 PROCEDURE PutAlignment (type: CARDINAL; align: CARDINAL) ;
14597 pSym: PtrToSymbol ;
14599 pSym := GetPsym(type) ;
14603 RecordSym : Record.Align := align |
14604 RecordFieldSym: RecordField.Align := align |
14605 TypeSym : Type.Align := align |
14606 ArraySym : Array.Align := align |
14607 PointerSym : Pointer.Align := align |
14608 SubrangeSym : Subrange.Align := align
14611 InternalError ('expecting record, field, pointer, type, subrange or an array symbol')
14618 GetAlignment - returns the alignment constant associated with,
14622 PROCEDURE GetAlignment (type: CARDINAL) : CARDINAL ;
14624 pSym: PtrToSymbol ;
14626 pSym := GetPsym(type) ;
14630 RecordSym : RETURN( Record.Align ) |
14631 RecordFieldSym : RETURN( RecordField.Align ) |
14632 TypeSym : RETURN( Type.Align ) |
14633 ArraySym : RETURN( Array.Align ) |
14634 PointerSym : RETURN( Pointer.Align ) |
14635 VarientFieldSym: RETURN( GetAlignment(VarientField.Parent) ) |
14636 VarientSym : RETURN( GetAlignment(Varient.Parent) ) |
14637 SubrangeSym : RETURN( Subrange.Align )
14640 InternalError ('expecting record, field, pointer, type, subrange or an array symbol')
14647 PutDefaultRecordFieldAlignment - assigns, align, as the default alignment
14651 PROCEDURE PutDefaultRecordFieldAlignment (sym: CARDINAL; align: CARDINAL) ;
14653 pSym: PtrToSymbol ;
14655 pSym := GetPsym(sym) ;
14659 RecordSym: Record.DefaultAlign := align
14662 InternalError ('expecting record symbol')
14665 END PutDefaultRecordFieldAlignment ;
14669 GetDefaultRecordFieldAlignment - assigns, align, as the default alignment
14673 PROCEDURE GetDefaultRecordFieldAlignment (sym: CARDINAL) : CARDINAL ;
14675 pSym: PtrToSymbol ;
14677 pSym := GetPsym(sym) ;
14681 RecordSym : RETURN( Record.DefaultAlign ) |
14682 VarientFieldSym: RETURN( GetDefaultRecordFieldAlignment(GetParent(sym)) ) |
14683 VarientSym : RETURN( GetDefaultRecordFieldAlignment(GetParent(sym)) )
14686 InternalError ('expecting record symbol')
14689 END GetDefaultRecordFieldAlignment ;
14693 VarCheckReadInit - returns TRUE if sym has been initialized.
14696 PROCEDURE VarCheckReadInit (sym: CARDINAL; mode: ModeOfAddr) : BOOLEAN ;
14698 pSym: PtrToSymbol ;
14702 pSym := GetPsym (sym) ;
14706 VarSym: RETURN GetInitialized (Var.InitState[mode])
14713 END VarCheckReadInit ;
14717 VarInitState - initializes the init state for variable sym.
14720 PROCEDURE VarInitState (sym: CARDINAL) ;
14722 pSym: PtrToSymbol ;
14726 pSym := GetPsym (sym) ;
14730 VarSym: ConfigSymInit (Var.InitState[LeftValue], sym) ;
14731 ConfigSymInit (Var.InitState[RightValue], sym)
14741 PutVarInitialized - set sym as initialized.
14744 PROCEDURE PutVarInitialized (sym: CARDINAL; mode: ModeOfAddr) ;
14746 pSym: PtrToSymbol ;
14750 pSym := GetPsym (sym) ;
14754 VarSym: WITH Var DO
14755 SetInitialized (InitState[mode])
14762 END PutVarInitialized ;
14766 PutVarFieldInitialized - records that field has been initialized with
14767 variable sym. TRUE is returned if the field
14768 is detected and changed to initialized.
14771 PROCEDURE PutVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr;
14772 fieldlist: List) : BOOLEAN ;
14774 pSym: PtrToSymbol ;
14778 pSym := GetPsym (sym) ;
14782 VarSym: WITH Var DO
14783 RETURN SetFieldInitialized (InitState[mode], fieldlist)
14791 END PutVarFieldInitialized ;
14795 GetVarFieldInitialized - return TRUE if fieldlist has been initialized
14796 within variable sym.
14799 PROCEDURE GetVarFieldInitialized (sym: CARDINAL; mode: ModeOfAddr;
14800 fieldlist: List) : BOOLEAN ;
14802 pSym: PtrToSymbol ;
14806 pSym := GetPsym (sym) ;
14810 VarSym: WITH Var DO
14811 RETURN GetFieldInitialized (InitState[mode], fieldlist)
14819 END GetVarFieldInitialized ;
14823 PrintInitialized - display variable sym initialization state.
14826 PROCEDURE PrintInitialized (sym: CARDINAL) ;
14828 pSym: PtrToSymbol ;
14832 pSym := GetPsym (sym) ;
14836 VarSym: printf0 ("LeftMode init: ") ;
14837 PrintSymInit (Var.InitState[LeftValue]) ;
14838 printf0 ("RightMode init: ") ;
14839 PrintSymInit (Var.InitState[RightValue])
14845 END PrintInitialized ;
14849 DumpSymbols - display all symbol numbers and their type.
14853 PROCEDURE DumpSymbols ;
14855 pSym: PtrToSymbol ;
14859 WHILE sym <= FinalSymbol () DO
14860 pSym := GetPsym(sym) ;
14861 printf ("%d ", sym) ;
14865 RecordSym: printf ("RecordSym") |
14866 VarientSym: printf ("VarientSym") |
14867 DummySym: printf ("DummySym") |
14868 VarSym: printf ("VarSym") |
14869 EnumerationSym: printf ("EnumerationSym") |
14870 SubrangeSym: printf ("SubrangeSym") |
14871 ArraySym: printf ("ArraySym") |
14872 ConstStringSym: printf ("ConstStringSym") |
14873 ConstVarSym: printf ("ConstVarSym") |
14874 ConstLitSym: printf ("ConstLitSym") |
14875 VarParamSym: printf ("VarParamSym") |
14876 ParamSym: printf ("ParamSym") |
14877 PointerSym: printf ("PointerSym") |
14878 UndefinedSym: printf ("UndefinedSym") |
14879 TypeSym: printf ("TypeSym") |
14880 RecordFieldSym: printf ("RecordFieldSym") |
14881 VarientFieldSym: printf ("VarientFieldSym") |
14882 EnumerationFieldSym: printf ("EnumerationFieldSym") |
14883 DefImpSym: printf ("DefImpSym") |
14884 ModuleSym: printf ("ModuleSym") |
14885 SetSym: printf ("SetSym") |
14886 ProcedureSym: printf ("ProcedureSym") |
14887 ProcTypeSym: printf ("ProcTypeSym") |
14888 SubscriptSym: printf ("SubscriptSym") |
14889 UnboundedSym: printf ("UnboundedSym") |
14890 GnuAsmSym: printf ("GnuAsmSym") |
14891 InterfaceSym: printf ("InterfaceSym") |
14892 ObjectSym: printf ("ObjectSym") |
14893 PartialUnboundedSym: printf ("PartialUnboundedSym") |
14894 TupleSym: printf ("TupleSym") |
14895 OAFamilySym: printf ("OAFamilySym") |
14896 EquivSym: printf ("EquivSym") |
14897 ErrorSym: printf ("ErrorSym")
14909 GetErrorScope - returns the error scope for a symbol.
14910 The error scope is the title scope which is used to
14911 announce the symbol in the GCC error message.
14914 PROCEDURE GetErrorScope (sym: CARDINAL) : ErrorScope ;
14916 pSym: PtrToSymbol ;
14918 pSym := GetPsym (sym) ;
14922 ProcedureSym: RETURN Procedure.errorScope |
14923 ModuleSym : RETURN Module.errorScope |
14924 DefImpSym : RETURN DefImp.errorScope |
14925 UndefinedSym: RETURN Undefined.errorScope
14928 InternalError ('expecting procedure, module or defimp symbol')
14931 END GetErrorScope ;
14935 PutErrorScope - sets the error scope for a symbol.
14936 The error scope is the title scope which is used to
14937 announce the symbol in the GCC error message.
14941 PROCEDURE PutErrorScope (sym: CARDINAL; errorScope: ErrorScope) ;
14943 pSym: PtrToSymbol ;
14945 pSym := GetPsym (type) ;
14949 ProcedureSym: Procedure.errorScope := errorScope |
14950 ModuleSym : Module.errorScope := errorScope |
14951 DefImpSym : DefImp.errorScope := errorScope
14954 InternalError ('expecting procedure, module or defimp symbol')
14957 END PutErrorScope ;
14962 IsLegal - returns TRUE if, sym, is a legal symbol.
14965 PROCEDURE IsLegal (sym: CARDINAL) : BOOLEAN ;
14967 RETURN sym < FreeSymbol
projects / thirdparty / gcc.git / blob