aboutsummaryrefslogtreecommitdiff
path: root/gcc/m2
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/m2')
-rw-r--r--gcc/m2/ChangeLog28
-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
-rw-r--r--gcc/m2/gm2-libs-log/Strings.def4
-rw-r--r--gcc/m2/gm2-libs-log/Strings.mod77
6 files changed, 185 insertions, 102 deletions
diff --git a/gcc/m2/ChangeLog b/gcc/m2/ChangeLog
index 1037f5c..bf50c77 100644
--- a/gcc/m2/ChangeLog
+++ b/gcc/m2/ChangeLog
@@ -1,3 +1,31 @@
+2025-06-21 Gaius Mulley <gaiusmod2@gmail.com>
+
+ * gm2-compiler/M2GCCDeclare.mod (StartDeclareModuleScopeSeparate):
+ Reformat statement comments.
+ (StartDeclareModuleScopeWholeProgram): Ditto.
+
+2025-06-17 Gaius Mulley <gaiusmod2@gmail.com>
+
+ PR modula2/120673
+ * gm2-compiler/M2GCCDeclare.mod (ErrorDepList): New
+ global variable set containing every errant dependency symbol.
+ (mystop): Remove.
+ (EmitCircularDependancyError): Replace with ...
+ (EmitCircularDependencyError): ... this.
+ (AssertAllTypesDeclared): Rewrite.
+ (DoVariableDeclaration): Ditto.
+ (TypeDependentsDeclared): New procedure function.
+ (PrepareGCCVarDeclaration): Ditto.
+ (DeclareVariable): Remove assert.
+ (DeclareLocalVariable): Ditto.
+ (Constructor): Initialize ErrorDepList.
+ * gm2-compiler/M2MetaError.mod (doErrorScopeProc): Rewrite
+ and ensure that a symbol with a module scope does not lookup
+ from a definition module.
+ * gm2-compiler/P2SymBuild.mod (BuildType): Rewrite so that
+ a synonym type is created using the token refering to the name
+ on the lhs.
+
2025-06-12 Gaius Mulley <gaiusmod2@gmail.com>
PR modula2/119650
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 ;
diff --git a/gcc/m2/gm2-libs-log/Strings.def b/gcc/m2/gm2-libs-log/Strings.def
index aea35f8..2be4e42 100644
--- a/gcc/m2/gm2-libs-log/Strings.def
+++ b/gcc/m2/gm2-libs-log/Strings.def
@@ -53,7 +53,9 @@ PROCEDURE Delete (VAR str: ARRAY OF CHAR; index: CARDINAL; length: CARDINAL) ;
(*
- Pos - return the first position of, substr, in, str.
+ Pos - return the first position of substr in str.
+ If substr is not found in str then it returns
+ HIGH (str) + 1.
*)
PROCEDURE Pos (substr, str: ARRAY OF CHAR) : CARDINAL ;
diff --git a/gcc/m2/gm2-libs-log/Strings.mod b/gcc/m2/gm2-libs-log/Strings.mod
index 6046a10..44f47b3 100644
--- a/gcc/m2/gm2-libs-log/Strings.mod
+++ b/gcc/m2/gm2-libs-log/Strings.mod
@@ -83,39 +83,62 @@ END Delete ;
(*
- Pos - return the first position of, substr, in, str.
+ PosLower - return the first position of substr in str.
*)
-PROCEDURE Pos (substr, str: ARRAY OF CHAR) : CARDINAL ;
+PROCEDURE PosLower (substr, str: ARRAY OF CHAR) : CARDINAL ;
VAR
- i, k, l : INTEGER ;
- s1, s2, s3: DynamicStrings.String ;
+ i, strLen, substrLen : INTEGER ;
+ strS, substrS, scratchS: DynamicStrings.String ;
BEGIN
- s1 := DynamicStrings.InitString(str) ;
- s2 := DynamicStrings.InitString(substr) ;
- k := DynamicStrings.Length(s1) ;
- l := DynamicStrings.Length(s2) ;
+ strS := DynamicStrings.InitString (str) ;
+ substrS := DynamicStrings.InitString (substr) ;
+ strLen := DynamicStrings.Length (strS) ;
+ substrLen := DynamicStrings.Length (substrS) ;
i := 0 ;
REPEAT
- i := DynamicStrings.Index(s1, DynamicStrings.char(s2, 0), i) ;
- IF i>=0
+ i := DynamicStrings.Index (strS, DynamicStrings.char (substrS, 0), i) ;
+ IF i < 0
+ THEN
+ (* No match on first character therefore return now. *)
+ strS := DynamicStrings.KillString (strS) ;
+ substrS := DynamicStrings.KillString (substrS) ;
+ scratchS := DynamicStrings.KillString (scratchS) ;
+ RETURN( HIGH (str) + 1 )
+ ELSIF i + substrLen <= strLen
THEN
- s3 := DynamicStrings.Slice(s1, i, l) ;
- IF DynamicStrings.Equal(s3, s2)
+ scratchS := DynamicStrings.Slice (strS, i, i + substrLen) ;
+ IF DynamicStrings.Equal (scratchS, substrS)
THEN
- s1 := DynamicStrings.KillString(s1) ;
- s2 := DynamicStrings.KillString(s2) ;
- s3 := DynamicStrings.KillString(s3) ;
+ strS := DynamicStrings.KillString (strS) ;
+ substrS := DynamicStrings.KillString (substrS) ;
+ scratchS := DynamicStrings.KillString (scratchS) ;
RETURN( i )
END ;
- s3 := DynamicStrings.KillString(s3)
+ scratchS := DynamicStrings.KillString (scratchS)
END ;
- INC(i)
- UNTIL i>=k ;
- s1 := DynamicStrings.KillString(s1) ;
- s2 := DynamicStrings.KillString(s2) ;
- s3 := DynamicStrings.KillString(s3) ;
- RETURN( HIGH(str)+1 )
+ INC (i)
+ UNTIL i >= strLen ;
+ strS := DynamicStrings.KillString (strS) ;
+ substrS := DynamicStrings.KillString (substrS) ;
+ scratchS := DynamicStrings.KillString (scratchS) ;
+ RETURN( HIGH (str) + 1 )
+END PosLower ;
+
+
+(*
+ Pos - return the first position of substr in str.
+ If substr is not found in str then it returns
+ HIGH (str) + 1.
+*)
+
+PROCEDURE Pos (substr, str: ARRAY OF CHAR) : CARDINAL ;
+BEGIN
+ IF Length (substr) <= Length (str)
+ THEN
+ RETURN PosLower (substr, str)
+ END ;
+ RETURN( HIGH (str) + 1 )
END Pos ;
@@ -129,11 +152,11 @@ PROCEDURE Copy (str: ARRAY OF CHAR;
VAR
s1, s2: DynamicStrings.String ;
BEGIN
- s1 := DynamicStrings.InitString(str) ;
- s2 := DynamicStrings.Slice(s1, index, index+length) ;
- DynamicStrings.CopyOut(result, s2) ;
- s1 := DynamicStrings.KillString(s1) ;
- s2 := DynamicStrings.KillString(s2)
+ s1 := DynamicStrings.InitString (str) ;
+ s2 := DynamicStrings.Slice (s1, index, index+length) ;
+ DynamicStrings.CopyOut (result, s2) ;
+ s1 := DynamicStrings.KillString (s1) ;
+ s2 := DynamicStrings.KillString (s2)
END Copy ;
generated by cgit v1.1 at 2025-06-23 05:57:35 +0000