public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] PR-107959 bugfix ICE detect attempt to create aggregate constant using bad type
@ 2022-12-03 17:33 Gaius Mulley
  0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-12-03 17:33 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:e171e6b291b5852e5802eefeb5f955419413b94e

commit e171e6b291b5852e5802eefeb5f955419413b94e
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date:   Sat Dec 3 16:59:52 2022 +0000

    PR-107959 bugfix ICE detect attempt to create aggregate constant using bad type
    
    The module below causes an ICE.
    
    MODULE badipv4 ;
    TYPE
      IPV4 = ARRAY [1..4] OF CHAR ;
    CONST
      Loopback = IPV4 {127, 0, 0, 1} ;
    END badipv4.
    
    The fix was to replace the internal error with a failure boolean and
    issue error messages based on the constructor.  It also required changes
    propagating tokenno into the range checking code which is then passed
    to M2ALU which generates the aggregate constant.
    
    gcc/m2/ChangeLog:
    
            * gm2-compiler/M2ALU.mod (CheckGetCharFromString): Return TRUE if
            successful otherwise return FALSE and issue an error message.
            Add extra parameter baseType.
            (InitialiseArrayOfCharWith) Use CheckGetCharFromString and pass
            baseType.
            * gm2-compiler/M2Quads.def (StartBuildDefFile):
            Add parameter tok.  (StartBuildModFile) Add parameter tok.
            (EndBuildFile) Add parameter tok.
            (StartBuildInit) Add parameter tok.
            (EndBuildInit) Add parameter tok.
            (StartBuildFinally) Add parameter tok.
            (EndBuildFinally) Add parameter tok.
            (BuildExceptInitial) Add parameter tok.
            (BuildExceptInitial) Add parameter tok.
            (BuildExceptFinally) Add parameter tok.
            (BuildExceptProcedure) Add parameter tok.
            (BuildReThrow) Add parameter tok.
            (StartBuildInnerInit) Add parameter tok.
            (EndBuildInnerInit) Add parameter tok.
            (BuildModuleStart) Add parameter tok.
            (BuildModuleStart) Add parameter tok.
            * gm2-compiler/M2Quads.mod (ForLoopInfo): Redefined as a pointer
            to record.  (ForInfo) Redefined as an Index.
            (EndBuildFile) Add parameter tok.
            (StartBuildInit) Add parameter tok.
            (EndBuildInit) Add parameter tok.
            (StartBuildFinally) Add parameter tok.
            (EndBuildFinally) Add parameter tok.
            (BuildExceptInitial) Add parameter tok.
            (BuildExceptInitial) Add parameter tok.
            (BuildExceptFinally) Add parameter tok.
            (BuildExceptProcedure) Add parameter tok.
            (BuildReThrow) Add parameter tok.
            (StartBuildInnerInit) Add parameter tok.
            (EndBuildInnerInit) Add parameter tok.
            (BuildModuleStart) Add parameter tok.
            (BuildModuleStart) Add parameter tok.
            (ForLoopAnalysis): Use ForInfo Indexing
            procedures and ForLoopInfo to check for loops.
            (AddForInfo): Reimplemented using ForInfo and
            Indexing procedures.
            (CheckForIndex): Pass ForLoopInfo parameter.
            Reimplemented.
            (BuildEndFor): Add parameter to AddForInfo.
            * gm2-compiler/M2Range.mod (FoldAssignment):
            Use tokenNo in the Range when declaring constant.
            (FoldParameterAssign) Use tokenNo in the Range
            when declaring constant.  (FoldReturn) Use tokenNo
            in the Range when declaring constant.
            (FoldReturn) Use tokenNo
            in the Range when declaring constant.
            * gm2-compiler/P3Build.bnf (ProgramModule) pass module
            token and end token to respective build procedures.
            (ImplementationModule) pass module
            token and end token to respective build procedures.
            (Block) Pass token to build routines.
            (InitialBlockBody) Pass token to build routines.
            (FinalBlockBody) Pass token to build routines.
            (ProcedureBlockBody) Pass token to build routines.
            (ModuleDeclaration) Pass token to build routines.
            (DefinitionModule) Pass token to build routines.
            * gm2-compiler/PHBuild.bnf (ProgramModule) pass module
            token and end token to respective build procedures.
            (ImplementationModule) pass module
            token and end token to respective build procedures.
            (Block) Pass token to build routines.
            (InitialBlockBody) Pass token to build routines.
            (FinalBlockBody) Pass token to build routines.
            (ProcedureBlockBody) Pass token to build routines.
            (ModuleDeclaration) Pass token to build routines.
            (DefinitionModule) Pass token to build routines.
    
    Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

Diff:
---
 gcc/m2/gm2-compiler/M2ALU.mod          |  47 ++++++++---
 gcc/m2/gm2-compiler/M2Quads.def        |  26 +++---
 gcc/m2/gm2-compiler/M2Quads.mod        | 144 +++++++++++++++------------------
 gcc/m2/gm2-compiler/M2Range.mod        |   6 +-
 gcc/m2/gm2-compiler/P3Build.bnf        |  61 +++++++-------
 gcc/m2/gm2-compiler/PHBuild.bnf        |  48 ++++++-----
 gcc/testsuite/gm2/iso/fail/badipv4.mod |   9 +++
 7 files changed, 189 insertions(+), 152 deletions(-)

diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod
index 47943754f79..8d33b347760 100644
--- a/gcc/m2/gm2-compiler/M2ALU.mod
+++ b/gcc/m2/gm2-compiler/M2ALU.mod
@@ -48,7 +48,7 @@ FROM M2Base IMPORT MixTypes, GetBaseTypeMinMax, Char, IsRealType, IsComplexType,
 FROM DynamicStrings IMPORT String, InitString, Mark, ConCat, Slice, InitStringCharStar, KillString, InitStringChar, string ;
 FROM M2LexBuf IMPORT TokenToLineNo, FindFileNameFromToken, TokenToLocation ;
 FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaErrorStringT0,
-                        MetaErrorT0, MetaErrorT2 ;
+                        MetaErrorT0, MetaErrorT1, MetaErrorT2,  MetaErrorT3 ;
 
 FROM SymbolTable IMPORT NulSym, IsEnumeration, IsSubrange, IsValueSolved, PushValue,
                         ForeachFieldEnumerationDo, MakeTemporary, PutVar, PopValue, GetType,
@@ -4849,14 +4849,17 @@ END InitialiseArrayWith ;
 
 
 (*
-   CheckGetCharFromString - return char from the position, arrayIndex, in the list of
-                            constDecl elements.
+   CheckGetCharFromString - return TRUE if a char from the position arrayIndex in the list of
+                            constDecl elements can be extracted.  The character is returned
+                            in value.
 *)
 
 PROCEDURE CheckGetCharFromString (location: location_t;
                                   tokenno: CARDINAL ;
                                   constDecl: PtrToValue;
-                                  arrayIndex: CARDINAL) : Tree ;
+                                  consType: CARDINAL ;
+                                  arrayIndex: CARDINAL;
+                                  VAR value: Tree) : BOOLEAN ;
 VAR
    elementIndex: CARDINAL ;
    element     : CARDINAL ;
@@ -4876,7 +4879,8 @@ BEGIN
          THEN
             key := GetString (element) ;
             DEC (arrayIndex, offset) ;
-            RETURN BuildCharConstantChar (location, CharKey (key, arrayIndex))
+            value := BuildCharConstantChar (location, CharKey (key, arrayIndex)) ;
+            RETURN TRUE
          END
       ELSIF IsConst (element) AND (SkipType (GetType (element)) = Char) AND IsValueSolved (element)
       THEN
@@ -4884,14 +4888,27 @@ BEGIN
          IF totalLength > arrayIndex
          THEN
             PushValue (element) ;
-            RETURN ConvertConstantAndCheck (location, GetM2CharType (), PopIntegerTree ())
+            value := ConvertConstantAndCheck (location, GetM2CharType (), PopIntegerTree ()) ;
+            RETURN TRUE
          END
       ELSE
-         InternalError ('const char should be resolved')
+         INC (totalLength) ;
+         IF totalLength > arrayIndex
+         THEN
+            MetaErrorT3 (tokenno,
+                         'expecting {%kCHAR} datatype and not {%1Ea} a {%1tad} in the {%2N} component of the {%3a} {%3d}',
+                         element, arrayIndex, consType) ;
+            value := GetCardinalZero (location) ;
+            RETURN FALSE
+         END
       END ;
       INC (elementIndex)
    UNTIL element = NulSym ;
-   RETURN GetCardinalZero (location)
+   value := GetCardinalZero (location) ;
+   MetaErrorT2 (tokenno,
+                'unable to obtain a {%kCHAR} at the {%1EN} position in {%2ad}',
+                arrayIndex, consType) ;
+   RETURN FALSE
 END CheckGetCharFromString ;
 
 
@@ -4900,7 +4917,8 @@ END CheckGetCharFromString ;
 *)
 
 PROCEDURE InitialiseArrayOfCharWith (tokenno: CARDINAL; cons: Tree;
-                                     constDecl: PtrToValue; el, high, low, arrayType: CARDINAL) : Tree ;
+                                     constDecl: PtrToValue;
+                                     el, high, low, consType, arrayType: CARDINAL) : Tree ;
 VAR
    location  : location_t ;
    arrayIndex: CARDINAL ;      (* arrayIndex is the char position index of the final string.  *)
@@ -4915,7 +4933,14 @@ BEGIN
       PushInt (arrayIndex) ;
       Addn ;
       indice := PopIntegerTree () ;
-      value := CheckGetCharFromString (location, tokenno, constDecl, arrayIndex) ;
+      IF NOT CheckGetCharFromString (location, tokenno, constDecl, consType, arrayIndex, value)
+      THEN
+         (*
+         MetaErrorT2 (tokenno,
+                      'unable to obtain a {%kCHAR} at the {%1EN} position in {%2ad}',
+                      arrayIndex, consType) ;
+         *)
+      END ;
       value := ConvertConstantAndCheck (location, Mod2Gcc (arrayType), value) ;
       BuildArrayConstructorElement (cons, value, indice) ;
       PushValue (low) ;
@@ -4972,7 +4997,7 @@ BEGIN
             RETURN InitialiseArrayOfCharWithString (tokenno, cons, el1, baseType, arrayType)
          ELSIF SkipType(arrayType)=Char
          THEN
-            RETURN InitialiseArrayOfCharWith (tokenno, cons, v, el1, high, low, arrayType)
+            RETURN InitialiseArrayOfCharWith (tokenno, cons, v, el1, high, low, baseType, arrayType)
          ELSE
             RETURN InitialiseArrayWith (tokenno, cons, v, el1, high, low, arrayType)
          END
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index f1438c36bd8..bc84c24e758 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -561,7 +561,7 @@ PROCEDURE BuildScaffold (tok: CARDINAL; moduleSym: CARDINAL) ;
                        q     StartDefFileOp  _  _  ModuleSym
 *)
 
-PROCEDURE StartBuildDefFile ;
+PROCEDURE StartBuildDefFile (tok: CARDINAL) ;
 
 
 (*
@@ -586,7 +586,7 @@ PROCEDURE StartBuildDefFile ;
                        q     StartModFileOp  _  _  ModuleSym
 *)
 
-PROCEDURE StartBuildModFile ;
+PROCEDURE StartBuildModFile (tok: CARDINAL) ;
 
 
 (*
@@ -608,35 +608,35 @@ PROCEDURE StartBuildModFile ;
                   q     EndFileOp  _  _  ModuleSym
 *)
 
-PROCEDURE EndBuildFile ;
+PROCEDURE EndBuildFile (tok: CARDINAL) ;
 
 
 (*
    StartBuildInit - Builds the start initialisation code of a module.
 *)
 
-PROCEDURE StartBuildInit ;
+PROCEDURE StartBuildInit (tok: CARDINAL) ;
 
 
 (*
    EndBuildInit - Builds the end initialisation code of a module.
 *)
 
-PROCEDURE EndBuildInit ;
+PROCEDURE EndBuildInit (tok: CARDINAL) ;
 
 
 (*
    StartBuildFinally - Builds the start finalisation code of a module.
 *)
 
-PROCEDURE StartBuildFinally ;
+PROCEDURE StartBuildFinally (tok: CARDINAL) ;
 
 
 (*
    EndBuildFinally - Builds the end finalisation code of a module.
 *)
 
-PROCEDURE EndBuildFinally ;
+PROCEDURE EndBuildFinally (tok: CARDINAL) ;
 
 
 (*
@@ -644,7 +644,7 @@ PROCEDURE EndBuildFinally ;
                         initial block.
 *)
 
-PROCEDURE BuildExceptInitial ;
+PROCEDURE BuildExceptInitial (tok: CARDINAL) ;
 
 
 (*
@@ -652,7 +652,7 @@ PROCEDURE BuildExceptInitial ;
                         finally block.
 *)
 
-PROCEDURE BuildExceptFinally ;
+PROCEDURE BuildExceptFinally (tok: CARDINAL) ;
 
 
 (*
@@ -660,7 +660,7 @@ PROCEDURE BuildExceptFinally ;
                           block.
 *)
 
-PROCEDURE BuildExceptProcedure ;
+PROCEDURE BuildExceptProcedure (tok: CARDINAL) ;
 
 
 (*
@@ -684,14 +684,14 @@ PROCEDURE BuildReThrow (tokenno: CARDINAL) ;
                          inner module to the next quadruple.
 *)
 
-PROCEDURE StartBuildInnerInit ;
+PROCEDURE StartBuildInnerInit (tok: CARDINAL) ;
 
 
 (*
    EndBuildInnerInit - Sets the end initialization code of a module.
 *)
 
-PROCEDURE EndBuildInnerInit ;
+PROCEDURE EndBuildInnerInit (tok: CARDINAL) ;
 
 
 (*
@@ -1612,7 +1612,7 @@ PROCEDURE BuildBooleanVariable ;
    BuildModuleStart - starts current module scope.
 *)
 
-PROCEDURE BuildModuleStart ;
+PROCEDURE BuildModuleStart (tok: CARDINAL) ;
 
 
 (*
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 2ff4d54c950..5de7ddb5281 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -221,7 +221,7 @@ FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord,
                         PushWord, PopWord, PeepWord, RemoveTop,
                         IsEmptyWord, NoOfItemsInStackWord ;
 
-FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, InBounds ;
+FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice, InBounds, HighIndice, IncludeIndiceIntoIndex ;
 
 FROM M2Range IMPORT InitAssignmentRangeCheck,
                     InitReturnRangeCheck,
@@ -306,12 +306,13 @@ TYPE
                              RecordTokPos: CARDINAL ;  (* Token of the record.  *)
                           END ;
 
-   ForLoopInfo = RECORD
-                    IncrementQuad,
-                    StartOfForLoop,                              (* we keep a list of all for      *)
-                    EndOfForLoop,                                (* loops so we can check index    *)
-                    ForLoopIndex  : List ;                       (* variables are not abused       *)
-                 END ;
+   ForLoopInfo = POINTER TO RECORD
+                               IncrementQuad,
+                               StartOfForLoop,                 (* we keep a list of all for      *)
+                               EndOfForLoop,                   (* loops so we can check index    *)
+                               ForLoopIndex,
+                               IndexTok      : CARDINAL ;      (* variables are not abused       *)
+                            END ;
 
    LineNote  = POINTER TO RECORD
                              Line: CARDINAL ;
@@ -351,7 +352,7 @@ VAR
    InConstExpression,
    IsAutoOn,                          (* should parser automatically push idents *)
    MustNotCheckBounds   : BOOLEAN ;
-   ForInfo              : ForLoopInfo ;  (* start and end of all FOR loops       *)
+   ForInfo              : Index ;     (* start and end of all FOR loops       *)
    GrowInitialization   : CARDINAL ;  (* upper limit of where the initialized    *)
                                       (* quadruples.                             *)
    BuildingHigh,
@@ -1932,13 +1933,13 @@ END CheckNeedPriorityEnd ;
                        q     StartDefFileOp  _  _  ModuleSym
 *)
 
-PROCEDURE StartBuildDefFile ;
+PROCEDURE StartBuildDefFile (tok: CARDINAL) ;
 VAR
    ModuleName: Name ;
 BEGIN
    PopT (ModuleName) ;
    PushT (ModuleName) ;
-   GenQuad (StartDefFileOp, GetPreviousTokenLineNo (), NulSym, GetModule (ModuleName))
+   GenQuadO (tok, StartDefFileOp, tok, NulSym, GetModule (ModuleName), FALSE)
 END StartBuildDefFile ;
 
 
@@ -1964,10 +1965,11 @@ END StartBuildDefFile ;
                        q     StartModFileOp  lineno  filename  ModuleSym
 *)
 
-PROCEDURE StartBuildModFile ;
+PROCEDURE StartBuildModFile (tok: CARDINAL) ;
 BEGIN
-   GenQuad(StartModFileOp, GetPreviousTokenLineNo(),
-           WORD(makekey(string(GetFileName()))), GetFileModule())
+   GenQuadO (tok, StartModFileOp, tok,
+             WORD (makekey (string (GetFileName ()))),
+             GetFileModule (), FALSE)
 END StartBuildModFile ;
 
 
@@ -1990,13 +1992,12 @@ END StartBuildModFile ;
                   q     EndFileOp  _  _  ModuleSym
 *)
 
-PROCEDURE EndBuildFile ;
+PROCEDURE EndBuildFile (tok: CARDINAL) ;
 VAR
    ModuleName: Name ;
 BEGIN
-   PopT(ModuleName) ;
-   PushT(ModuleName) ;
-   GenQuad(EndFileOp, NulSym, NulSym, GetModule(ModuleName))
+   ModuleName := OperandT (1) ;
+   GenQuadO (tok, EndFileOp, NulSym, NulSym, GetModule (ModuleName), FALSE)
 END EndBuildFile ;
 
 
@@ -2005,9 +2006,8 @@ END EndBuildFile ;
                     current module to the next quadruple.
 *)
 
-PROCEDURE StartBuildInit ;
+PROCEDURE StartBuildInit (tok: CARDINAL) ;
 VAR
-   tok      : CARDINAL ;
    name     : Name ;
    ModuleSym: CARDINAL ;
 BEGIN
@@ -2016,7 +2016,6 @@ BEGIN
    Assert(IsModule(ModuleSym) OR IsDefImp(ModuleSym)) ;
    Assert(GetSymName(ModuleSym)=name) ;
    PutModuleStartQuad(ModuleSym, NextQuad) ;
-   tok := GetPreviousTokenLineNo () ;
    GenQuad(InitStartOp, tok, GetFileModule(), ModuleSym) ;
    PushWord(ReturnStack, 0) ;
    PushT(name) ;
@@ -2035,11 +2034,8 @@ END StartBuildInit ;
    EndBuildInit - Sets the end initialization code of a module.
 *)
 
-PROCEDURE EndBuildInit ;
-VAR
-   tok: CARDINAL ;
+PROCEDURE EndBuildInit (tok: CARDINAL) ;
 BEGIN
-   tok := GetPreviousTokenLineNo () ;
    IF HasExceptionBlock(GetCurrentModule())
    THEN
       BuildRTExceptLeave (tok, TRUE) ;
@@ -2058,9 +2054,8 @@ END EndBuildInit ;
                        current module to the next quadruple.
 *)
 
-PROCEDURE StartBuildFinally ;
+PROCEDURE StartBuildFinally (tok: CARDINAL) ;
 VAR
-   tok      : CARDINAL ;
    name     : Name ;
    ModuleSym: CARDINAL ;
 BEGIN
@@ -2069,7 +2064,6 @@ BEGIN
    Assert(IsModule(ModuleSym) OR IsDefImp(ModuleSym)) ;
    Assert(GetSymName(ModuleSym)=name) ;
    PutModuleFinallyStartQuad(ModuleSym, NextQuad) ;
-   tok := GetPreviousTokenLineNo() ;
    GenQuadO (tok, FinallyStartOp, tok, GetFileModule(), ModuleSym, FALSE) ;
    PushWord (ReturnStack, 0) ;
    PushT (name) ;
@@ -2088,11 +2082,8 @@ END StartBuildFinally ;
    EndBuildFinally - Sets the end finalization code of a module.
 *)
 
-PROCEDURE EndBuildFinally ;
-VAR
-   tok: CARDINAL ;
+PROCEDURE EndBuildFinally (tok: CARDINAL) ;
 BEGIN
-   tok := GetPreviousTokenLineNo() ;
    IF HasExceptionFinally(GetCurrentModule())
    THEN
       BuildRTExceptLeave (tok, TRUE) ;
@@ -2723,11 +2714,8 @@ END BuildScaffold ;
    BuildModuleStart - starts current module scope.
 *)
 
-PROCEDURE BuildModuleStart ;
-VAR
-   tok: CARDINAL ;
+PROCEDURE BuildModuleStart (tok: CARDINAL) ;
 BEGIN
-   tok := GetPreviousTokenLineNo () ;
    GenQuadO (tok,
              ModuleScopeOp, tok,
              WORD (makekey (string (GetFileName ()))), GetCurrentModule (), FALSE)
@@ -2739,12 +2727,9 @@ END BuildModuleStart ;
                          inner module to the next quadruple.
 *)
 
-PROCEDURE StartBuildInnerInit ;
-VAR
-   tok: CARDINAL ;
+PROCEDURE StartBuildInnerInit (tok: CARDINAL) ;
 BEGIN
-   tok := GetPreviousTokenLineNo () ;
-   PutModuleStartQuad(GetCurrentModule(), NextQuad) ;
+   PutModuleStartQuad (GetCurrentModule(), NextQuad) ;
    GenQuadO (tok, InitStartOp, tok, NulSym, GetCurrentModule(), FALSE) ;
    PushWord (ReturnStack, 0) ;
    CheckNeedPriorityBegin (tok, GetCurrentModule(), GetCurrentModule()) ;
@@ -2761,11 +2746,8 @@ END StartBuildInnerInit ;
    EndBuildInnerInit - Sets the end initialization code of a module.
 *)
 
-PROCEDURE EndBuildInnerInit ;
-VAR
-   tok: CARDINAL ;
+PROCEDURE EndBuildInnerInit (tok: CARDINAL) ;
 BEGIN
-   tok := GetPreviousTokenLineNo () ;
    IF HasExceptionBlock (GetCurrentModule())
    THEN
       BuildRTExceptLeave (tok, TRUE) ;
@@ -2809,20 +2791,17 @@ END BuildModulePriority ;
 
 PROCEDURE ForLoopAnalysis ;
 VAR
-   i, n: CARDINAL ;
+   i, n   : CARDINAL ;
+   forDesc: ForLoopInfo ;
 BEGIN
    IF Pedantic
    THEN
-      WITH ForInfo DO
-         n := NoOfItemsInList(IncrementQuad) ;
-         i := 1 ;
-         WHILE i<=n DO
-            CheckForIndex(GetItemFromList(StartOfForLoop, i),
-                          GetItemFromList(EndOfForLoop, i),
-                          GetItemFromList(IncrementQuad, i),
-                          GetItemFromList(ForLoopIndex, i)) ;
-            INC(i)
-         END
+      n := HighIndice (ForInfo) ;
+      i := 1 ;
+      WHILE i <= n DO
+         forDesc := GetIndice (ForInfo, i) ;
+         CheckForIndex (forDesc) ;
+         INC (i)
       END
    END
 END ForLoopAnalysis ;
@@ -2834,16 +2813,21 @@ END ForLoopAnalysis ;
                 usage.
 *)
 
-PROCEDURE AddForInfo (Start, End, IncQuad: CARDINAL; Sym: CARDINAL) ;
+PROCEDURE AddForInfo (Start, End, IncQuad: CARDINAL; Sym: CARDINAL; idtok: CARDINAL) ;
+VAR
+   forDesc: ForLoopInfo ;
 BEGIN
    IF Pedantic
    THEN
-      WITH ForInfo DO
-         PutItemIntoList (IncrementQuad, IncQuad) ;
-         PutItemIntoList (StartOfForLoop, Start) ;
-         PutItemIntoList (EndOfForLoop, End) ;
-         PutItemIntoList (ForLoopIndex, Sym)
-      END
+      NEW (forDesc) ;
+      WITH forDesc^ DO
+         IncrementQuad := IncQuad ;
+         StartOfForLoop := Start ;
+         EndOfForLoop := End ;
+         ForLoopIndex := Sym ;
+         IndexTok := idtok
+      END ;
+      IncludeIndiceIntoIndex (ForInfo, forDesc)
    END
 END AddForInfo ;
 
@@ -2857,24 +2841,31 @@ END AddForInfo ;
                    is issued.
 *)
 
-PROCEDURE CheckForIndex (Start, End, Omit: CARDINAL; IndexSym: CARDINAL) ;
+PROCEDURE CheckForIndex (forDesc: ForLoopInfo) ;
 VAR
    ReadStart, ReadEnd,
    WriteStart, WriteEnd: CARDINAL ;
 BEGIN
-   GetWriteLimitQuads(IndexSym, RightValue, Start, End, WriteStart, WriteEnd) ;
-   IF (WriteStart < Omit) AND (WriteStart > Start)
+   GetWriteLimitQuads (forDesc^.ForLoopIndex, RightValue, forDesc^.StartOfForLoop, forDesc^.EndOfForLoop, WriteStart, WriteEnd) ;
+   IF (WriteStart < forDesc^.IncrementQuad) AND (WriteStart > forDesc^.StartOfForLoop)
    THEN
+      MetaErrorT1 (forDesc^.IndexTok,
+                   '{%kFOR} loop index variable {%1Wad} is being manipulated inside the loop',
+                   forDesc^.ForLoopIndex) ;
       MetaErrorT1 (QuadToTokenNo (WriteStart),
-                   '{%kFOR} loop index variable {%1Wad} is being manipulated inside the loop, this is considered bad practice and may cause unknown program behaviour', IndexSym)
+                   '{%kFOR} loop index variable {%1Wad} is being manipulated, this is considered bad practice and may cause unknown program behaviour',
+                   forDesc^.ForLoopIndex)
    END ;
-   GetWriteLimitQuads (IndexSym, RightValue, End, 0, WriteStart, WriteEnd) ;
-   GetReadLimitQuads (IndexSym, RightValue, End, 0, ReadStart, ReadEnd) ;
+   GetWriteLimitQuads (forDesc^.ForLoopIndex, RightValue, forDesc^.EndOfForLoop, 0, WriteStart, WriteEnd) ;
+   GetReadLimitQuads (forDesc^.ForLoopIndex, RightValue, forDesc^.EndOfForLoop, 0, ReadStart, ReadEnd) ;
    IF (ReadStart#0) AND ((ReadStart < WriteStart) OR (WriteStart = 0))
    THEN
+      MetaErrorT1 (forDesc^.IndexTok,
+                   '{%kFOR} loop index variable {%1Wad} is being read outside the FOR loop (without being reset)',
+                   forDesc^.ForLoopIndex) ;
       MetaErrorT1 (QuadToTokenNo (ReadStart),
-                   '{%kFOR} loop index variable {%1Wad} is being read outside the FOR loop (without being reset first), this is considered extremely bad practice and may cause unknown program behaviour',
-                   IndexSym)
+                   '{%kFOR} loop index variable {%1Wad} is being read outside the FOR loop (without being reset), this is considered extremely bad practice and may cause unknown program behaviour',
+                   forDesc^.ForLoopIndex)
    END
 END CheckForIndex ;
 
@@ -4538,7 +4529,7 @@ BEGIN
    END ;
    GenQuadO (endpostok, GotoOp, NulSym, NulSym, ForQuad, FALSE) ;
    BackPatch (PopFor (), NextQuad) ;
-   AddForInfo (ForQuad, NextQuad-1, IncQuad, IdSym)
+   AddForInfo (ForQuad, NextQuad-1, IncQuad, IdSym, idtok)
 END BuildEndFor ;
 
 
@@ -14139,7 +14130,7 @@ BEGIN
       a varient field anyway as the next pass would not know whether to
       ignore a varient field.
    *)
-   PutItemIntoList(VarientFields, r) ;
+   PutItemIntoList (VarientFields, r) ;
    IF DebugVarients
    THEN
       n := NoOfItemsInList(VarientFields) ;
@@ -15058,7 +15049,7 @@ BEGIN
    LogicalAndTok := MakeKey('_LAND') ;
    LogicalXorTok := MakeKey('_LXOR') ;
    LogicalDifferenceTok := MakeKey('_LDIFF') ;
-   QuadArray := InitIndex(1) ;
+   QuadArray := InitIndex (1) ;
    FreeList := 1 ;
    NewQuad(NextQuad) ;
    Assert(NextQuad=1) ;
@@ -15083,12 +15074,7 @@ BEGIN
    MustNotCheckBounds := FALSE ;
    InitQuad := 0 ;
    GrowInitialization := 0 ;
-   WITH ForInfo DO
-      InitList(IncrementQuad) ;
-      InitList(StartOfForLoop) ;
-      InitList(EndOfForLoop) ;
-      InitList(ForLoopIndex)
-   END ;
+   ForInfo := InitIndex (1) ;
    QuadrupleGeneration := TRUE ;
    BuildingHigh := FALSE ;
    BuildingSize := FALSE ;
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index 241c40057cc..255250c3128 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -1137,7 +1137,7 @@ VAR
 BEGIN
    p := GetIndice (RangeIndex, r) ;
    WITH p^ DO
-      TryDeclareConstant (tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant (tokenNo, expr) ;
       IF desLowestType # NulSym
       THEN
          IF GccKnowsAbout (expr) AND IsConst (expr) AND
@@ -1169,7 +1169,7 @@ VAR
 BEGIN
    p := GetIndice(RangeIndex, r) ;
    WITH p^ DO
-      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant (tokenNo, expr) ;
       IF desLowestType#NulSym
       THEN
          IF GccKnowsAbout(expr) AND IsConst(expr) AND
@@ -1204,7 +1204,7 @@ VAR
 BEGIN
    p := GetIndice(RangeIndex, r) ;
    WITH p^ DO
-      TryDeclareConstant(tokenno, expr) ;  (* use quad tokenno, rather than the range tokenNo *)
+      TryDeclareConstant (tokenNo, expr) ;
       IF desLowestType#NulSym
       THEN
          IF GccKnowsAbout(expr) AND IsConst(expr) AND
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 8a8861e11d4..42d369449e7 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -574,40 +574,41 @@ FileUnit :=                                                                % Pus
               ImplementationOrProgramModule )                              % PopAuto %
          =:
 
-ProgramModule := "MODULE"                                                  % M2Error.DefaultProgramModule %
+ProgramModule :=                                                           % VAR modulet, endt: CARDINAL ; %
+                                                                           % modulet := GetTokenNo () %
+                 "MODULE"                                                  % M2Error.DefaultProgramModule %
                                                                            % PushAutoOn %
-                                                                           % VAR tokno: CARDINAL ; %
-                                                                           % tokno := GetTokenNo () %
                   Ident                                                    % P3StartBuildProgModule %
-                                                                           % StartBuildModFile %
-                                                                           % BuildModuleStart %
+                                                                           % StartBuildModFile (modulet) %
+                                                                           % BuildModuleStart (modulet) %
                                                                            % PushAutoOff %
                   [ Priority
                   ]
-                  ";"                                                      % BuildScaffold (tokno,
+                  ";"                                                      % BuildScaffold (modulet,
                                                                                             GetCurrentModule ()) %
                   { Import }
                   Block                                                    % PushAutoOn %
-                  Ident                                                    % EndBuildFile %
+                                                                           % endt := GetTokenNo () -1 %
+                  Ident                                                    % EndBuildFile (endt) %
                                                                            % P3EndBuildProgModule %
                   "."                                                      % PopAuto ; PopAuto %
                   =:
 
-ImplementationModule := "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
+ImplementationModule :=                                                    % VAR modulet, endt: CARDINAL ; %
+                                                                           % modulet := GetTokenNo () %
+                        "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
                                          "MODULE"                          % PushAutoOn %
-                                                                           % VAR tokno: CARDINAL ; %
-                                                                           % tokno := GetTokenNo () %
-                         Ident                                             % StartBuildModFile %
+                         Ident                                             % StartBuildModFile (modulet) %
                                                                            % P3StartBuildImpModule %
-                                                                           % BuildModuleStart %
+                                                                           % BuildModuleStart (modulet) %
                                                                            % PushAutoOff %
                          [ Priority
-                         ] ";"                                             % BuildScaffold (tokno,
+                         ] ";"                                             % BuildScaffold (modulet,
                                                                                             GetCurrentModule ()) %
                          { Import }
                          Block                                             % PushAutoOn %
-
-                         Ident                                             % EndBuildFile %
+                                                                           % endt := GetTokenNo () -1 %
+                         Ident                                             % EndBuildFile (endt) %
                                                                            % P3EndBuildImpModule %
                          "."                                               % PopAuto ; PopAuto ; PopAuto %
                       =:
@@ -1323,10 +1324,10 @@ ProcedureBlock :=                                                          % Bui
                                                                  "END"
                 =:
 
-Block := { Declaration }                                                   % StartBuildInit %
-                         InitialBlock                                      % EndBuildInit ;
-                                                                             StartBuildFinally %
-                                      FinalBlock                           % EndBuildFinally %
+Block := { Declaration }                                                   % StartBuildInit (GetTokenNo ()) %
+                         InitialBlock                                      % EndBuildInit (GetTokenNo ()) ;
+                                                                             StartBuildFinally (GetTokenNo ()) %
+                                      FinalBlock                           % EndBuildFinally (GetTokenNo ()) %
                                                  "END"
        =:
 
@@ -1338,17 +1339,17 @@ FinalBlock := [ "FINALLY"                                                  % Bui
 
 InitialBlockBody := NormalPart [
                                  "EXCEPT"                                  % BuildStmtNote (-1) %
-                                                                           % BuildExceptInitial %
+                                                                           % BuildExceptInitial (GetTokenNo() -1) %
                                           ExceptionalPart ] =:
 
 FinalBlockBody := NormalPart [
                                "EXCEPT"                                    % BuildStmtNote (-1) %
-			                                                   % BuildExceptFinally %
+			                                                   % BuildExceptFinally (GetTokenNo() -1) %
                                         ExceptionalPart ] =:
 
 ProcedureBlockBody := NormalPart [
                                    "EXCEPT"                                % BuildStmtNote (-1) %
-				                                           % BuildExceptProcedure %
+				                                           % BuildExceptProcedure (GetTokenNo() -1) %
                                             ExceptionalPart ] =:
 
 NormalPart := StatementSequence =:
@@ -1390,10 +1391,12 @@ DefOptArg := "[" Ident ":" FormalType "=" ConstExpression                  % Bui
 
 FormalType := { "ARRAY" "OF" } Qualident =:
 
-ModuleDeclaration := "MODULE"                                              % M2Error.DefaultInnerModule %
+ModuleDeclaration :=                                                       % VAR modulet: CARDINAL ; %
+                                                                           % modulet := GetTokenNo () %
+                     "MODULE"                                              % M2Error.DefaultInnerModule %
                                                                            % PushAutoOn %
                      Ident                                                 % StartBuildInnerModule %
-                                                                           % BuildModuleStart ;
+                                                                           % BuildModuleStart (modulet) ;
                                                                              PushAutoOff %
                      [ Priority ] ";"
                      { Import } [ Export ]
@@ -1425,18 +1428,20 @@ WithoutFromImport :=                                                       % Pus
 
 Import :=  FromImport | WithoutFromImport =:
 
-DefinitionModule := "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
+DefinitionModule :=                                                        % VAR deft, endt: CARDINAL ; %
+                                                                           % deft := GetTokenNo () %
+                    "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
                                  "MODULE"                                  % PushAutoOn %
                     [ "FOR" string ]
-                    Ident                                                  % StartBuildDefFile ;
+                    Ident                                                  % StartBuildDefFile (deft) ;
                                                                              P3StartBuildDefModule ;
                                                                              PushAutoOff %
                     ";"
                     { Import } [ Export
                                         ]
-                    { Definition }
+                    { Definition }                                         % endt := GetTokenNo () %
                                    "END"                                   % PushAutoOn %
-                                         Ident                             % EndBuildFile ;
+                                         Ident                             % EndBuildFile (endt) ;
                                                                              P3EndBuildDefModule %
                                                "."                         % PopAuto ; PopAuto ; PopAuto %
                   =:
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index 16c8f0e1b1c..ad4777ced58 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -540,40 +540,47 @@ FileUnit :=                                                                % Pus
               ImplementationOrProgramModule )                              % PopAuto %
          =:
 
-ProgramModule := "MODULE"                                                  % M2Error.DefaultProgramModule %
+ProgramModule :=                                                           % VAR begint, endt: CARDINAL ; %
+                                                                           % begint := GetTokenNo () %
+                 "MODULE"                                                  % M2Error.DefaultProgramModule %
                                                                            % PushAutoOn %
                   Ident                                                    % P3StartBuildProgModule %
-                                                                           % BuildModuleStart %
+                                                                           % BuildModuleStart (begint) %
                                                                            % PushAutoOff %
                   [ Priority
                   ]
                   ";"
                   { Import
-                  }                                                        % StartBuildInit %
+                  }                                                        % begint := GetTokenNo () %
+                                                                           % StartBuildInit (begint) %
                   Block                                                    % PushAutoOn %
-                  Ident                                                    % EndBuildFile %
+                                                                           % endt := GetTokenNo () -1 %
+                  Ident                                                    % EndBuildFile (endt) %
                                                                            % P3EndBuildProgModule %
                   "."                                                      % PopAuto ;
-                                                                             EndBuildInit ;
+                                                                             EndBuildInit (endt) ;
                                                                              PopAuto %
                   =:
 
-ImplementationModule := "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
+ImplementationModule :=                                                    % VAR begint, endt: CARDINAL ; %
+                                                                           % begint := GetTokenNo () %
+                        "IMPLEMENTATION"                                   % M2Error.DefaultImplementationModule %
                                          "MODULE"                          % PushAutoOn %
-                         Ident                                             % StartBuildModFile %
+                         Ident                                             % StartBuildModFile (begint) %
                                                                            % P3StartBuildImpModule %
-                                                                           % BuildModuleStart %
+                                                                           % BuildModuleStart (begint) %
                                                                            % PushAutoOff %
                          [ Priority
                          ] ";"
                          { Import
-                           }                                               % StartBuildInit %
+                           }                                               % begint := GetTokenNo () %
+                                                                           % StartBuildInit (begint) %
                          Block                                             % PushAutoOn %
-
-                         Ident                                             % EndBuildFile %
+                                                                           % endt := GetTokenNo () -1 %
+                         Ident                                             % EndBuildFile (endt) %
                                                                            % P3EndBuildImpModule %
                          "."                                               % PopAuto ;
-                                                                             EndBuildInit ;
+                                                                             EndBuildInit (endt) ;
                                                                              PopAuto ;
                                                                              PopAuto %
                       =:
@@ -1181,10 +1188,12 @@ DefOptArg := "[" Ident ":" FormalType "=" SilentConstExpression "]" =:
 
 FormalType := { "ARRAY" "OF" } Qualident =:
 
-ModuleDeclaration := "MODULE"                                              % M2Error.DefaultInnerModule %
+ModuleDeclaration :=                                                       % VAR begint, endt: CARDINAL ; %
+                                                                           % begint := GetTokenNo () %
+                     "MODULE"                                              % M2Error.DefaultInnerModule %
                                                                            % PushAutoOn %
                      Ident                                                 % StartBuildInnerModule ;
-                                                                             BuildModuleStart ;
+                                                                             BuildModuleStart (begint) ;
 
                                                                              PushAutoOff %
                      [ Priority ] ";"
@@ -1192,6 +1201,7 @@ ModuleDeclaration := "MODULE"                                              % M2E
                         } [ Export
                             ]
                        Block                                               % PushAutoOn %
+                                                                           % endt := GetTokenNo () -1 %
                        Ident                                               % EndBuildInnerModule %
                                                                            % PopAuto ; PopAuto ; PopAuto %
                      =:
@@ -1208,19 +1218,21 @@ Import :=  "FROM" Ident "IMPORT" IdentList ";" |
            "IMPORT"
             IdentList ";" =:
 
-DefinitionModule := "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
+DefinitionModule :=                                                        % VAR begint, endt: CARDINAL ; %
+                                                                           % begint := GetTokenNo () %
+                    "DEFINITION"                                           % M2Error.DefaultDefinitionModule %
                                  "MODULE"                                  % PushAutoOn %
                     [ "FOR" string ]
-                    Ident                                                  % StartBuildDefFile ;
+                    Ident                                                  % StartBuildDefFile (begint) ;
                                                                              P3StartBuildDefModule ;
                                                                              PushAutoOff %
                     ";"
                     { Import
                              } [ Export
                                         ]
-                    { Definition }
+                    { Definition }                                         % endt := GetTokenNo () %
                                    "END"                                   % PushAutoOn %
-                                         Ident                             % EndBuildFile ;
+                                         Ident                             % EndBuildFile (endt) ;
                                                                              P3EndBuildDefModule %
                                                "."                         % PopAuto ; PopAuto ; PopAuto %
                   =:
diff --git a/gcc/testsuite/gm2/iso/fail/badipv4.mod b/gcc/testsuite/gm2/iso/fail/badipv4.mod
new file mode 100644
index 00000000000..6b0896a29d3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badipv4.mod
@@ -0,0 +1,9 @@
+MODULE badipv4 ;
+
+TYPE
+  IPV4 = ARRAY [1..4] OF CHAR ;
+
+CONST
+  Loopback = IPV4 {127, 0, 0, 1} ;
+
+END badipv4.
\ No newline at end of file

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-12-03 17:33 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-12-03 17:33 [gcc/devel/modula-2] PR-107959 bugfix ICE detect attempt to create aggregate constant using bad type Gaius Mulley

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).