UnboundedHighName = "_m2_high_%d" ;
TYPE
+ ConstLitPoolEntry = POINTER TO RECORD
+ sym : CARDINAL ;
+ tok : CARDINAL ;
+ constName: Name ;
+ constType: CARDINAL ;
+ next : ConstLitPoolEntry ;
+ END ;
+
LRLists = ARRAY [RightValue..LeftValue] OF List ;
TypeOfSymbol = (RecordSym, VarientSym, DummySym,
IsSet : BOOLEAN ; (* is the constant a set? *)
IsConstructor: BOOLEAN ; (* is the constant a set? *)
FromType : CARDINAL ; (* type is determined FromType *)
+ RangeError : BOOLEAN ; (* Have we reported an error? *)
UnresFromType: BOOLEAN ; (* is Type unresolved? *)
Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
CallFrame = RECORD
- Main : CARDINAL ; (* Main scope for insertions *)
- Search: CARDINAL ; (* Search scope for symbol searches *)
- Start : CARDINAL ; (* ScopePtr value before StartScope *)
- (* was called. *)
+ Main : CARDINAL ; (* Main scope for insertions *)
+ Search: CARDINAL ; (* Search scope for symbol searches *)
+ Start : CARDINAL ; (* ScopePtr value before StartScope *)
+ (* was called. *)
END ;
PtrToSymbol = POINTER TO Symbol ;
CheckProcedure = PROCEDURE (CARDINAL) ;
VAR
- Symbols : Indexing.Index ; (* ARRAY [1..MaxSymbols] OF Symbol. *)
- ScopeCallFrame: Indexing.Index ; (* ARRAY [1..MaxScopes] OF CallFrame. *)
- FreeSymbol : CARDINAL ; (* The next free symbol indice. *)
+ Symbols : Indexing.Index ; (* ARRAY [1..MaxSymbols] OF Symbol. *)
+ ScopeCallFrame: Indexing.Index ; (* ARRAY [1..MaxScopes] OF CallFrame. *)
+ FreeSymbol : CARDINAL ; (* The next free symbol indice. *)
DefModuleTree : SymbolTree ;
- ModuleTree : SymbolTree ; (* Tree of all modules ever used. *)
+ ModuleTree : SymbolTree ; (* Tree of all modules ever used. *)
ConstLitStringTree
- : SymbolTree ; (* String Literal Constants only need *)
- (* to be declared once. *)
- ConstLitTree : SymbolTree ; (* Numerical Literal Constants only *)
- (* need to be declared once. *)
- CurrentModule : CARDINAL ; (* Index into symbols determining the *)
- (* current module being compiled. *)
- (* This maybe an inner module. *)
- MainModule : CARDINAL ; (* Index into symbols determining the *)
- (* module the user requested to *)
- (* compile. *)
- FileModule : CARDINAL ; (* Index into symbols determining *)
- (* which module (file) is being *)
- (* compiled. (Maybe an import def) *)
- ScopePtr : CARDINAL ; (* An index to the ScopeCallFrame. *)
- (* ScopePtr determines the top of the *)
- (* ScopeCallFrame. *)
- BaseScopePtr : CARDINAL ; (* An index to the ScopeCallFrame of *)
- (* the top of BaseModule. BaseModule *)
- (* is always left at the bottom of *)
- (* stack since it is used so *)
- (* frequently. When the BaseModule *)
- (* needs to be searched the ScopePtr *)
- (* is temporarily altered to *)
- (* BaseScopePtr and GetScopeSym is *)
- (* called. *)
- BaseModule : CARDINAL ; (* Index to the symbol table of the *)
- (* Base pseudo modeule declaration. *)
- TemporaryNo : CARDINAL ; (* The next temporary number. *)
- CurrentError : Error ; (* Current error chain. *)
- AddressTypes : List ; (* A list of type symbols which must *)
- (* be declared as ADDRESS or pointer *)
-(*
- FreeFVarientList, (* Lists used to maintain GC of field *)
- UsedFVarientList: List ; (* varients. *)
-*)
- UnresolvedConstructorType: List ; (* all constructors whose type *)
- (* is not yet known. *)
- AnonymousName : CARDINAL ;(* anonymous type name unique id *)
- ReportedUnknowns : Set ; (* set of symbols already reported as *)
- (* unknowns to the user. *)
+ : SymbolTree ; (* String Literal Constants only need *)
+ (* to be declared once. *)
+ CurrentModule : CARDINAL ; (* Index into symbols determining the *)
+ (* current module being compiled. *)
+ (* This maybe an inner module. *)
+ MainModule : CARDINAL ; (* Index into symbols determining the *)
+ (* module the user requested to *)
+ (* compile. *)
+ FileModule : CARDINAL ; (* Index into symbols determining *)
+ (* which module (file) is being *)
+ (* compiled. (Maybe an import def) *)
+ ScopePtr : CARDINAL ; (* An index to the ScopeCallFrame. *)
+ (* ScopePtr determines the top of the *)
+ (* ScopeCallFrame. *)
+ BaseScopePtr : CARDINAL ; (* An index to the ScopeCallFrame of *)
+ (* the top of BaseModule. BaseModule *)
+ (* is always left at the bottom of *)
+ (* stack since it is used so *)
+ (* frequently. When the BaseModule *)
+ (* needs to be searched the ScopePtr *)
+ (* is temporarily altered to *)
+ (* BaseScopePtr and GetScopeSym is *)
+ (* called. *)
+ BaseModule : CARDINAL ; (* Index to the symbol table of the *)
+ (* Base pseudo modeule declaration. *)
+ TemporaryNo : CARDINAL ; (* The next temporary number. *)
+ CurrentError : Error ; (* Current error chain. *)
+ AddressTypes : List ; (* A list of type symbols which must *)
+ (* be declared as ADDRESS or pointer *)
+ UnresolvedConstructorType: List ; (* all constructors whose type *)
+ (* is not yet known. *)
+ AnonymousName : CARDINAL ; (* anonymous type name unique id *)
+ ReportedUnknowns : Set ; (* set of symbols already reported as *)
+ (* unknowns to the user. *)
+ ConstLitPoolTree : SymbolTree ; (* Pool of constants to ensure *)
+ (* constants are reused between *)
+ (* passes and reduce duplicate *)
+ (* errors. *)
+ ConstLitArray : Indexing.Index ;
(*
BEGIN
AnonymousName := 0 ;
CurrentError := NIL ;
- InitTree(ConstLitTree) ;
- InitTree(ConstLitStringTree) ;
- InitTree(DefModuleTree) ;
- InitTree(ModuleTree) ;
- Symbols := InitIndex(1) ;
+ InitTree (ConstLitPoolTree) ;
+ InitTree (ConstLitStringTree) ;
+ InitTree (DefModuleTree) ;
+ InitTree (ModuleTree) ;
+ Symbols := InitIndex (1) ;
+ ConstLitArray := InitIndex (1) ;
FreeSymbol := 1 ;
ScopePtr := 1 ;
ScopeCallFrame := InitIndex(1) ;
(*
- MakeConstLit - returns a constant literal of type, constType, with a constName,
- at location, tok.
+ CreateConstLit -
*)
-PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
+PROCEDURE CreateConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
VAR
pSym : PtrToSymbol ;
Sym : CARDINAL ;
- issueError,
overflow : BOOLEAN ;
BEGIN
- issueError := TRUE ;
overflow := FALSE ;
IF constType=NulSym
THEN
- constType := GetConstLitType (tok, constName, overflow, issueError) ;
- issueError := NOT overflow
+ constType := GetConstLitType (tok, constName, overflow, TRUE)
END ;
NewSym (Sym) ;
pSym := GetPsym (Sym) ;
ConstLitSym : ConstLit.name := constName ;
ConstLit.Value := InitValue () ;
- PushString (tok, constName, issueError) ;
+ PushString (tok, constName, NOT overflow) ;
PopInto (ConstLit.Value) ;
ConstLit.Type := constType ;
ConstLit.IsSet := FALSE ;
ConstLit.IsConstructor := FALSE ;
ConstLit.FromType := NulSym ; (* type is determined FromType *)
+ ConstLit.RangeError := overflow ;
ConstLit.UnresFromType := FALSE ; (* is Type resolved? *)
- ConstLit.Scope := GetCurrentScope() ;
+ ConstLit.Scope := GetCurrentScope () ;
InitWhereDeclaredTok (tok, ConstLit.At) ;
InitWhereFirstUsedTok (tok, ConstLit.At)
END
END ;
RETURN Sym
+END CreateConstLit ;
+
+
+(*
+ LookupConstLitPoolEntry - return a ConstLit symbol from the constant pool which
+ matches tok, constName and constType.
+*)
+
+PROCEDURE LookupConstLitPoolEntry (tok: CARDINAL;
+ constName: Name; constType: CARDINAL) : CARDINAL ;
+VAR
+ pe : ConstLitPoolEntry ;
+ rootIndex: CARDINAL ;
+BEGIN
+ rootIndex := GetSymKey (ConstLitPoolTree, constName) ;
+ IF rootIndex # 0
+ THEN
+ pe := Indexing.GetIndice (ConstLitArray, rootIndex) ;
+ WHILE pe # NIL DO
+ IF (pe^.tok = tok) AND
+ (pe^.constName = constName) AND
+ (pe^.constType = constType)
+ THEN
+ RETURN pe^.sym
+ END ;
+ pe := pe^.next
+ END
+ END ;
+ RETURN NulSym
+END LookupConstLitPoolEntry ;
+
+
+(*
+ AddConstLitPoolEntry - adds sym to the constlit pool.
+*)
+
+PROCEDURE AddConstLitPoolEntry (sym: CARDINAL; tok: CARDINAL;
+ constName: Name; constType: CARDINAL) ;
+VAR
+ pe, old : ConstLitPoolEntry ;
+ rootIndex, high: CARDINAL ;
+BEGIN
+ rootIndex := GetSymKey (ConstLitPoolTree, constName) ;
+ IF rootIndex = NulKey
+ THEN
+ high := Indexing.HighIndice (ConstLitArray) ;
+ NEW (pe) ;
+ IF pe = NIL
+ THEN
+ InternalError ('out of memory')
+ ELSE
+ pe^.sym := sym ;
+ pe^.tok := tok ;
+ pe^.constName := constName ;
+ pe^.constType := constType ;
+ pe^.next := NIL ;
+ PutSymKey (ConstLitPoolTree, constName, high+1) ;
+ Indexing.PutIndice (ConstLitArray, high+1, pe)
+ END
+ ELSE
+ NEW (pe) ;
+ IF pe = NIL
+ THEN
+ InternalError ('out of memory')
+ ELSE
+ old := Indexing.GetIndice (ConstLitArray, rootIndex) ;
+ pe^.sym := sym ;
+ pe^.tok := tok ;
+ pe^.constName := constName ;
+ pe^.constType := constType ;
+ pe^.next := old ;
+ Indexing.PutIndice (ConstLitArray, rootIndex, pe)
+ END
+ END
+END AddConstLitPoolEntry ;
+
+
+(*
+ MakeConstLit - returns a constant literal of type, constType, with a constName,
+ at location, tok.
+*)
+
+PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : CARDINAL ;
+VAR
+ sym: CARDINAL ;
+BEGIN
+ sym := LookupConstLitPoolEntry (tok, constName, constType) ;
+ IF sym = NulSym
+ THEN
+ sym := CreateConstLit (tok, constName, constType) ;
+ AddConstLitPoolEntry (sym, tok, constName, constType)
+ END ;
+ RETURN sym
END MakeConstLit ;
FromType := NulSym ; (* type is determined FromType *)
UnresFromType := FALSE ; (* is Type resolved? *)
IsTemp := FALSE ;
- Scope := GetCurrentScope() ;
+ Scope := GetCurrentScope () ;
InitWhereDeclaredTok (tok, At)
END
END ;
WITH pSym^.Var DO
RETURN( IsPointerCheck )
END
- END
+ END ;
+ RETURN FALSE
END GetVarPointerCheck ;
s := CollectUnknown (tok, GetScope (sym), n)
END ;
RETURN( s )
- END
+ END ;
+ InternalError ('expecting sym should be a module, defimp or procedure symbol')
END CollectUnknown ;
projects / thirdparty / gcc.git / commitdiff
