aboutsummaryrefslogtreecommitdiff
path: root/gcc/m2/gm2-compiler
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/m2/gm2-compiler')
-rw-r--r--gcc/m2/gm2-compiler/M2GCCDeclare.mod110
-rw-r--r--gcc/m2/gm2-compiler/M2MetaError.mod37
-rw-r--r--gcc/m2/gm2-compiler/P2SymBuild.mod31
3 files changed, 104 insertions, 74 deletions
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index b12add6..860a89a 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -251,6 +251,7 @@ TYPE
VAR
FreeGroup,
GlobalGroup : Group ; (* The global group of all sets. *)
+ ErrorDepList, (* The set of symbols with dependency errors. *)
VisitedList,
ChainedList : Set ;
HaveInitDefaultTypes: BOOLEAN ; (* Have we initialized them yet? *)
@@ -261,9 +262,6 @@ VAR
enumDeps : BOOLEAN ;
-PROCEDURE mystop ; BEGIN END mystop ;
-
-
(* *************************************************** *)
(*
PrintNum -
@@ -1315,14 +1313,26 @@ END CanBeDeclaredPartiallyViaPartialDependants ;
(*
- EmitCircularDependancyError - issue a dependancy error.
+ EmitCircularDependencyError - issue a dependency error.
*)
-PROCEDURE EmitCircularDependancyError (sym: CARDINAL) ;
+PROCEDURE EmitCircularDependencyError (sym: CARDINAL) ;
BEGIN
- MetaError1('circular dependancy error found when trying to resolve {%1Uad}',
- sym)
-END EmitCircularDependancyError ;
+ (* Ensure we only issue one dependency message per symbol for this
+ error classification. *)
+ IF NOT IsElementInSet (ErrorDepList, sym)
+ THEN
+ IncludeElementIntoSet (ErrorDepList, sym) ;
+ IF IsVar (sym) OR IsParameter (sym)
+ THEN
+ MetaError1 ('circular dependency error found when trying to resolve {%1Had}',
+ sym)
+ ELSE
+ MetaError1 ('circular dependency error found when trying to resolve {%1Dad}',
+ sym)
+ END
+ END
+END EmitCircularDependencyError ;
TYPE
@@ -1529,17 +1539,17 @@ BEGIN
IF ForeachTryDeclare (todolist,
circulartodo,
NotAllDependantsFullyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
ELSIF ForeachTryDeclare (partiallydeclared,
circularpartial,
NotAllDependantsPartiallyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
ELSIF ForeachTryDeclare (niltypedarrays,
circularniltyped,
NotAllDependantsPartiallyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
END
END ;
@@ -2855,13 +2865,8 @@ BEGIN
n := 1 ;
Var := GetNth(scope, n) ;
WHILE Var#NulSym DO
- IF NOT AllDependantsFullyDeclared(GetSType(Var))
- THEN
- mystop
- END ;
- IF NOT AllDependantsFullyDeclared(GetSType(Var))
+ IF NOT TypeDependentsDeclared (Var, TRUE)
THEN
- EmitCircularDependancyError(GetSType(Var)) ;
failed := TRUE
END ;
INC(n) ;
@@ -2922,14 +2927,12 @@ BEGIN
DeclareTypesConstantsProcedures(scope) ; (* will resolved TYPEs and CONSTs on the ToDo *)
(* lists. *)
ForeachModuleDo(DeclareProcedure) ;
- (*
- now that all types have been resolved it is safe to declare
- variables
- *)
+ (* Now that all types have been resolved it is safe to declare
+ variables. *)
AssertAllTypesDeclared(scope) ;
DeclareGlobalVariables(scope) ;
ForeachImportedDo(scope, DeclareImportedVariables) ;
- (* now it is safe to declare all procedures *)
+ (* Now it is safe to declare all procedures. *)
ForeachProcedureDo(scope, DeclareProcedure) ;
ForeachInnerModuleDo(scope, WalkTypesInModule) ;
ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
@@ -2958,14 +2961,12 @@ BEGIN
(* lists. *)
ForeachModuleDo(DeclareProcedure) ;
ForeachModuleDo(DeclareModuleInit) ;
- (*
- now that all types have been resolved it is safe to declare
- variables
- *)
+ (* Now that all types have been resolved it is safe to declare
+ variables. *)
AssertAllTypesDeclared(scope) ;
DeclareGlobalVariablesWholeProgram(scope) ;
ForeachImportedDo(scope, DeclareImportedVariablesWholeProgram) ;
- (* now it is safe to declare all procedures *)
+ (* Now it is safe to declare all procedures. *)
ForeachProcedureDo(scope, DeclareProcedure) ;
ForeachInnerModuleDo(scope, WalkTypesInModule) ;
ForeachInnerModuleDo(scope, DeclareTypesConstantsProcedures) ;
@@ -3411,15 +3412,55 @@ PROCEDURE DoVariableDeclaration (var: CARDINAL; name: ADDRESS;
isImported, isExported,
isTemporary, isGlobal: BOOLEAN;
scope: tree) ;
+BEGIN
+ IF NOT (IsComponent (var) OR IsVarHeap (var))
+ THEN
+ IF TypeDependentsDeclared (var, TRUE)
+ THEN
+ PrepareGCCVarDeclaration (var, name, isImported, isExported,
+ isTemporary, isGlobal, scope)
+ END
+ END
+END DoVariableDeclaration ;
+
+
+(*
+ TypeDependentsDeclared - return TRUE if all type dependents of variable
+ have been declared.
+*)
+
+PROCEDURE TypeDependentsDeclared (variable: CARDINAL; errorMessage: BOOLEAN) : BOOLEAN ;
+VAR
+ type: CARDINAL ;
+BEGIN
+ type := GetSType (variable) ;
+ IF AllDependantsFullyDeclared (type)
+ THEN
+ RETURN TRUE
+ ELSE
+ IF errorMessage
+ THEN
+ EmitCircularDependencyError (variable) ;
+ ForeachElementInSetDo (GlobalGroup^.ToDoList, EmitCircularDependencyError)
+ END
+ END ;
+ RETURN FALSE
+END TypeDependentsDeclared ;
+
+
+(*
+ PrepareGCCVarDeclaration -
+*)
+
+PROCEDURE PrepareGCCVarDeclaration (var: CARDINAL; name: ADDRESS;
+ isImported, isExported,
+ isTemporary, isGlobal: BOOLEAN;
+ scope: tree) ;
VAR
type : tree ;
varType : CARDINAL ;
location: location_t ;
BEGIN
- IF IsComponent (var) OR IsVarHeap (var)
- THEN
- RETURN
- END ;
IF GetMode (var) = LeftValue
THEN
(*
@@ -3457,7 +3498,7 @@ BEGIN
isGlobal, scope, NIL)) ;
WatchRemoveList (var, todolist) ;
WatchIncludeList (var, fullydeclared)
-END DoVariableDeclaration ;
+END PrepareGCCVarDeclaration ;
(*
@@ -3493,7 +3534,6 @@ BEGIN
THEN
scope := FindContext (ModSym) ;
decl := FindOuterModule (variable) ;
- Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
PushBinding (ModSym) ;
DoVariableDeclaration (variable,
KeyToCharStar (GetFullSymName (variable)),
@@ -3521,7 +3561,6 @@ BEGIN
THEN
scope := FindContext (mainModule) ;
decl := FindOuterModule (variable) ;
- Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
PushBinding (mainModule) ;
DoVariableDeclaration (variable,
KeyToCharStar (GetFullSymName (variable)),
@@ -3618,7 +3657,6 @@ END DeclareImportedVariablesWholeProgram ;
PROCEDURE DeclareLocalVariable (var: CARDINAL) ;
BEGIN
- Assert (AllDependantsFullyDeclared (var)) ;
DoVariableDeclaration (var,
KeyToCharStar (GetFullSymName (var)),
FALSE, (* local variables cannot be imported *)
@@ -3662,7 +3700,6 @@ BEGIN
scope := Mod2Gcc (GetProcedureScope (sym)) ;
Var := GetNth (sym, i) ;
WHILE Var # NulSym DO
- Assert (AllDependantsFullyDeclared (GetSType (Var))) ;
DoVariableDeclaration (Var,
KeyToCharStar (GetFullSymName (Var)),
FALSE, (* inner module variables cannot be imported *)
@@ -6658,6 +6695,7 @@ END InitDeclarations ;
BEGIN
FreeGroup := NIL ;
GlobalGroup := InitGroup () ;
+ ErrorDepList := InitSet (1) ;
ChainedList := InitSet(1) ;
WatchList := InitSet(1) ;
VisitedList := NIL ;
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod b/gcc/m2/gm2-compiler/M2MetaError.mod
index 22bc77f..3aa7543 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -1437,35 +1437,22 @@ BEGIN
doError (eb, GetDeclaredDef (sym))
ELSE
M2Error.EnterErrorScope (GetErrorScope (scope)) ;
- IF IsProcedure (scope)
+ IF IsVar (sym) OR IsParameter (sym)
THEN
- IF IsVar (sym) OR IsParameter (sym)
- THEN
- doError (eb, GetVarParamTok (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetVarParamTok (sym))
+ ELSIF IsProcedure (scope)
+ THEN
+ doError (eb, GetDeclaredDef (sym))
+ ELSIF IsModule (scope)
+ THEN
+ doError (eb, GetDeclaredMod (sym))
ELSE
- IF IsModule (scope)
+ Assert (IsDefImp (scope)) ;
+ IF GetDeclaredDefinition (sym) = UnknownTokenNo
THEN
- IF IsInnerModule (scope)
- THEN
- doError (eb, GetDeclaredDef (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetDeclaredMod (sym))
ELSE
- Assert (IsDefImp (scope)) ;
- (* if this fails then we need to skip to the outer scope.
- REPEAT
- OuterModule := GetScope(OuterModule)
- UNTIL GetScope(OuterModule)=NulSym ; *)
- IF GetDeclaredDefinition (sym) = UnknownTokenNo
- THEN
- doError (eb, GetDeclaredMod (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetDeclaredDef (sym))
END
END
END ;
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 8f3b499..5c82ec8 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -1225,7 +1225,8 @@ VAR
Sym,
Type : CARDINAL ;
name : Name ;
- tokno : CARDINAL ;
+ nametokno,
+ typetokno: CARDINAL ;
BEGIN
(*
Two cases
@@ -1234,8 +1235,8 @@ BEGIN
- when type with a name that is different to Name. In which case
we create a new type.
*)
- PopTtok(Type, tokno) ;
- PopT(name) ;
+ PopTtok (Type, typetokno) ;
+ PopTtok (name, nametokno) ;
IF Debugging
THEN
n1 := GetSymName(GetCurrentModule()) ;
@@ -1264,11 +1265,11 @@ BEGIN
*)
(* WriteString('Blank name type') ; WriteLn ; *)
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
ELSIF IsError(Type)
THEN
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||error type|error type name|token no")
ELSIF GetSymName(Type)=name
THEN
@@ -1276,7 +1277,7 @@ BEGIN
IF isunknown OR
(NOT IsDeclaredIn(GetCurrentScope(), Type))
THEN
- Sym := MakeType(tokno, name) ;
+ Sym := MakeType (typetokno, name) ;
IF NOT IsError(Sym)
THEN
IF Sym=Type
@@ -1295,19 +1296,23 @@ BEGIN
CheckForEnumerationInCurrentModule(Type)
END
END ;
- PushTFtok(Sym, name, tokno) ;
+ PushTFtok(Sym, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
ELSE
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
END
ELSE
(* example TYPE a = CARDINAL *)
- Sym := MakeType(tokno, name) ;
- PutType(Sym, Type) ;
- CheckForExportedImplementation(Sym) ; (* May be an exported hidden type *)
- PushTFtok(Sym, name, tokno) ;
- Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
+ Sym := MakeType (nametokno, name) ;
+ PutType (Sym, Type) ;
+ CheckForExportedImplementation (Sym) ; (* May be an exported hidden type *)
+ PushTFtok (Sym, name, nametokno) ;
+ Annotate ("%1s(%1d)|%2n|%3d||type|type name|token no") ;
+ IF Debugging
+ THEN
+ MetaErrorT1 (nametokno, 'type pos {%1Wa}', Sym)
+ END
END
END BuildType ;
generated by cgit v1.1 at 2025-06-23 10:17:28 +0000