Bugfix detect assigning constant constructors within a code block.

gcc/m2/ChangeLog:

	* gm2-compiler/M2Quads.def (BuildAssignConstant):
	Exported.
	* gm2-compiler/M2Quads.mod (BuildAssignConstant): New
	procedure.  (BuildAssignment) check whether designator
	is a constant and generate an error.
	* gm2-compiler/P3Build.bnf: Call BuildAssignConstant
	during ConstStatement.  Pass tokenno down to constant
	constructor parameters.
	* gm2-compiler/PHBuild.bnf: Call BuildAssignConstant
	during ConstStatement.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

4 files changed, 149 insertions, 37 deletions

diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index bd36812..113ce09 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -40,7 +40,8 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
                  BuildRetry,
                  BuildReThrow,
                  BuildBuiltinConst, BuildBuiltinTypeInfo,
-                 BuildAssignment, BuildAlignment,
+                 BuildAssignment, BuildAssignConstant,
+                 BuildAlignment,
                  BuildDefaultFieldAlignment, BuildPragmaField,
                  BuildRepeat, BuildUntil,
                  BuildWhile, BuildDoWhile, BuildEndWhile,
@@ -735,7 +736,8 @@ PROCEDURE BuildBuiltinTypeInfo ;
    BuildAssignment - Builds an assignment from the values given on the
                      quad stack. Either an assignment to an
                      arithmetic expression or an assignment to a
-                     boolean expression.
+                     boolean expression.  This procedure should not
+                     be called in CONST declarations.
                      The Stack is expected to contain:
 
 
@@ -785,6 +787,54 @@ PROCEDURE BuildAssignment (becomesTokNo: CARDINAL) ;
 
 
 (*
+   BuildAssignConstant - used to create constant in the CONST declaration.
+                         The stack is expected to contain:
+
+       Either
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | Expression |
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  Expression
+
+       OR
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | True |False|
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  TRUE
+                     q+1   GotoOp                    q+3
+                     q+2   BecomesOp  Designator  _  FALSE
+*)
+
+PROCEDURE BuildAssignConstant (equalsTokNo: CARDINAL) ;
+
+
+(*
    BuildAlignment - builds an assignment to an alignment constant.
 
                     The Stack is expected to contain:
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 8b09b00..5be8e77 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -3304,7 +3304,8 @@ END CheckBecomesMeta ;
    BuildAssignment - Builds an assignment from the values given on the
                      quad stack. Either an assignment to an
                      arithmetic expression or an assignment to a
-                     boolean expression.
+                     boolean expression.  This procedure should not
+                     be called in CONST declarations.
                      The Stack is expected to contain:
 
 
@@ -3323,22 +3324,89 @@ END CheckBecomesMeta ;
                      |------------|          |------------|
 
 
-                     Quadruples Produced depend of GetMode of Designator and Expression
-
+                     Quadruples Produced
 
-                     Designator = RightValue         Expression = RightValue
                      q     BecomesOp  Designator  _  Expression
 
-                     Designator = RightValue         Expression = LeftValue
-                     q     IndrX      Designator     Expression
+       OR
 
-                     Designator = LeftValue          Expression = RightValue
-                     q     XIndr      Designator     Expression
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | True |False|
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
 
-                     Designator = LeftValue          Expression = LeftValue
-                     q     IndrX      t              Expression
-                     q+1   XIndr      Designator     t
+                     q     BecomesOp  Designator  _  TRUE
+                     q+1   GotoOp                    q+3
+                     q+2   BecomesOp  Designator  _  FALSE
 
+*)
+
+PROCEDURE BuildAssignment (becomesTokNo: CARDINAL) ;
+VAR
+   des, exp   : CARDINAL ;
+   destok,
+   exptok,
+   combinedtok: CARDINAL ;
+BEGIN
+   des := OperandT (2) ;
+   IF IsConst (des)
+   THEN
+      destok := OperandTok (2) ;
+      exptok := OperandTok (1) ;
+      IF DebugTokPos
+      THEN
+         MetaErrorT1 (destok, 'destok {%1Ead}', des) ;
+         MetaErrorT1 (exptok, 'exptok {%1Ead}', exp)
+      END ;
+      combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ;
+      IF IsBoolean (1)
+      THEN
+         MetaErrorT1 (combinedtok,
+                      'cannot assign expression to a constant designator {%1Ead}', des)
+      ELSE
+         exp := OperandT (1) ;
+         MetaErrorT2 (combinedtok,
+                      'cannot assign a constant designator {%1Ead} with an expression {%2Ead}',
+                      des, exp)
+      END
+   ELSE
+      doBuildAssignment (becomesTokNo, TRUE, TRUE)
+   END
+END BuildAssignment ;
+
+
+(*
+   BuildAssignConstant - used to create constant in the CONST declaration.
+                         The stack is expected to contain:
+
+       Either
+
+                     Entry                   Exit
+                     =====                   ====
+
+              Ptr ->
+                     +------------+
+                     | Expression |
+                     |------------|
+                     | Designator |
+                     |------------|          +------------+
+                     |            |          |            |  <- Ptr
+                     |------------|          |------------|
+
+
+                     Quadruples Produced
+
+                     q     BecomesOp  Designator  _  Expression
 
        OR
 
@@ -3355,24 +3423,17 @@ END CheckBecomesMeta ;
                      |------------|          |------------|
 
 
-                     Quadruples Produced depend of GetMode of Designator
+                     Quadruples Produced
 
-                     Designator = RightValue
                      q     BecomesOp  Designator  _  TRUE
                      q+1   GotoOp                    q+3
                      q+2   BecomesOp  Designator  _  FALSE
-
-
-                     Designator = LeftValue
-                     q     XIndr      Designator  _  TRUE
-                     q+1   GotoOp                    q+3
-                     q+2   XIndr      Designator  _  FALSE
 *)
 
-PROCEDURE BuildAssignment (becomesTokNo: CARDINAL) ;
+PROCEDURE BuildAssignConstant (equalsTokNo: CARDINAL) ;
 BEGIN
-   doBuildAssignment (becomesTokNo, TRUE, TRUE)
-END BuildAssignment ;
+   doBuildAssignment (equalsTokNo, TRUE, TRUE)
+END BuildAssignConstant ;
 
 
 (*
@@ -3476,7 +3537,7 @@ BEGIN
       ((DesL#NulSym) AND (NOT IsProcType(DesL)))
    THEN
       MetaError1 ('incorrectly assigning a procedure to a designator {%1Ead} (designator is not a procedure type, {%1ast})', Des)
-   ELSIF IsProcedure(Exp) AND IsProcedureNested(Exp)
+   ELSIF IsProcedure (Exp) AND IsProcedureNested (Exp)
    THEN
       MetaError1 ('cannot call nested procedure {%1Ead} indirectly as the outer scope will not be known', Exp)
    ELSIF IsConstString(Exp)
@@ -3597,7 +3658,7 @@ BEGIN
    GetConstFromFifoQueue (align) ;
    PushT (align) ;
    PushT (expr) ;
-   BuildAssignment (tokno)
+   BuildAssignConstant (tokno)
 END BuildAlignment ;
 
 
@@ -3625,7 +3686,7 @@ BEGIN
    GetConstFromFifoQueue (length) ;
    PushT (length) ;
    PushT (expr) ;
-   BuildAssignment (tokno)
+   BuildAssignConstant (tokno)
 END BuildBitLength ;
 
 
@@ -3659,7 +3720,7 @@ BEGIN
    GetConstFromFifoQueue (align) ;
    PushT (align) ;
    PushT (expr) ;
-   BuildAssignment (GetTokenNo ())
+   BuildAssignConstant (GetTokenNo ())
 END BuildDefaultFieldAlignment ;
 
 
@@ -3695,7 +3756,7 @@ BEGIN
       GetConstFromFifoQueue (const) ;
       PushT (const) ;
       PushT (expr) ;
-      BuildAssignment (GetTokenNo ())
+      BuildAssignConstant (GetTokenNo ())
    END
 END BuildPragmaField ;
 
@@ -10958,7 +11019,7 @@ BEGIN
          PushTFtok (t, GetSType(t), exprTok) ;
          PushTtok (Sym, arrayTok) ;
          combinedTok := MakeVirtualTok (arrayTok, arrayTok, exprTok) ;
-         BuildAssignment (combinedTok) ;
+         BuildAssignConstant (combinedTok) ;
          PushTFDtok (t, GetDType(t), d, arrayTok) ;
          PushTtok (e, exprTok)
       END
@@ -11981,7 +12042,7 @@ BEGIN
          PopT(e2) ;
          PopT(e1) ;
          PopT(const) ;
-         WriteFormat0('either the constant must be an array constructor or a set constructor but not both') ;
+         WriteFormat0('the constant must be an array constructor or a set constructor but not both') ;
          PushT(const)
       END
    END
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index ec98b49..9f5dbb3 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -87,7 +87,8 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
                     BuildSetStart, BuildSetEnd,
                     PushLineNo, BuildSizeCheckStart,
                     BuildBuiltinConst, BuildBuiltinTypeInfo,
-                    BuildAssignment, BuildAlignment,
+                    BuildAssignment, BuildAssignConstant,
+                    BuildAlignment,
                     BuildRepeat, BuildUntil,
                     BuildWhile, BuildDoWhile, BuildEndWhile,
                     BuildLoop, BuildExit, BuildEndLoop,
@@ -662,7 +663,7 @@ ConstantDeclaration :=                                                     % VAR
                                                                            % PushAutoOn %
                        ( Ident "="                                         % tokno := GetTokenNo () -1 %
                                                                            % BuildConst %
-                         ConstExpression )                                 % BuildAssignment (tokno) %
+                         ConstExpression )                                 % BuildAssignConstant (tokno) %
                                                                            % PopAuto %
                      =:
 
@@ -729,12 +730,12 @@ ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
 
 ConstString := string =:
 
-ComponentElement := ConstExpression ( ".." ConstExpression                 % PushT(PeriodPeriodTok) %
+ComponentElement := ConstExpression ( ".." ConstExpression                 % PushTtok(PeriodPeriodTok, GetTokenNo() -1) %
                                       |                                    % PushT(NulTok) %
                                     )
                   =:
 
-ComponentValue := ComponentElement ( 'BY' ConstExpression                  % PushT(ByTok) %
+ComponentValue := ComponentElement ( 'BY' ConstExpression                  % PushTtok(ByTok, GetTokenNo() -1) %
 
                                      |                                     % PushT(NulTok) %
                                    )
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index 472fd0b..9efc005 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -61,7 +61,7 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, PushTFtok, PopTFtok,
                     EndBuildInit,
                     BuildProcedureStart,
                     BuildProcedureEnd,
-                    BuildAssignment,
+                    BuildAssignment, BuildAssignConstant,
                     BuildFunctionCall, BuildConstFunctionCall,
                     BuildBinaryOp, BuildUnaryOp, BuildRelOp, BuildNot,
       	       	    BuildEmptySet, BuildInclRange, BuildInclBit,
@@ -612,7 +612,7 @@ ConstantDeclaration :=                                                     % Pus
                                                                            % VAR tokno: CARDINAL ; %
                        ( Ident "="                                         % tokno := GetTokenNo () %
                                                                            % BuildConst %
-                         ConstExpression )                                 % BuildAssignment (tokno) %
+                         ConstExpression )                                 % BuildAssignConstant (tokno) %
                                                                            % PopAuto %
                      =: