Bugfix to detect re-assigning a constant record in a code block.

Detect re-assigning a value into an aggregate constant formed
from a record type.

gcc/m2/ChangeLog:

	* gm2-compiler/M2Quads.def (StartBuildWith): Add token
	parameter.
	* gm2-compiler/M2Quads.mod (StartBuildWith): Add token
	parameter.
	(BuildAssignment): Use IsReadOnly.
	(IsReadOnly): New procedure function.
	(BuildDesignatorRecord): Rewritten to propagate constant
	and correct token location.
	(BuildDynamicArray): Reformatted.
        (StartBuildWith): Rewritten to propagate constant
	and correct token location.
	(PushWith): New parameter token location.
	(CheckWithReference): Rewritten to use the token showing
	the with expression.
	* gm2-compiler/P3Build.bnf: Pass the token for the with
	keyword to BuildStartWith.

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

diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index 148c6b8f9189f933ec29bd3de647eea188ad1603..829cee5b21dcf471a92ca01127f6e4b94d16c7e2 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -1735,7 +1735,7 @@ PROCEDURE BuildModulePriority ;
                     |------------|
 *)
 
-PROCEDURE StartBuildWith ;
+PROCEDURE StartBuildWith (withTok: CARDINAL) ;
 
 
 (*

diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index a7c3acac1662136e5a171162d838b5f9f477c693..12e9be55d7e6609bf8eae70c630638a863d457c1 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -298,10 +298,11 @@ TYPE
                           END ;
 
    WithFrame = POINTER TO RECORD
-                             RecordSym : CARDINAL ;
-                             RecordType: CARDINAL ;
-                             RecordRef : CARDINAL ;
-                             rw        : CARDINAL ;  (* the record variable *)
+                             RecordSym   : CARDINAL ;
+                             RecordType  : CARDINAL ;
+                             RecordRef   : CARDINAL ;
+                             rw          : CARDINAL ;  (* The record variable.  *)
+                             RecordTokPos: CARDINAL ;  (* Token of the record.  *)
                           END ;
 
    ForLoopInfo = RECORD
@@ -3361,7 +3362,7 @@ VAR
    combinedtok: CARDINAL ;
 BEGIN
    des := OperandT (2) ;
-   IF IsConst (des) OR IsVarConst (des)
+   IF IsReadOnly (des)
    THEN
       destok := OperandTok (2) ;
       exptok := OperandTok (1) ;
@@ -10918,6 +10919,16 @@ BEGIN
 END BuildReturn ;
 
 
+(*
+   IsReadOnly - a helper procedure function to detect constants.
+*)
+
+PROCEDURE IsReadOnly (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+   RETURN IsConst (sym) OR (IsVar (sym) AND IsVarConst (sym))
+END IsReadOnly ;
+
+
 (*
    BuildDesignatorRecord - Builds the record referencing.
                            The Stack is expected to contain:
@@ -10974,6 +10985,7 @@ BEGIN
    END ;
    Res := MakeComponentRef (MakeComponentRecord (combinedtok,
                                                  RightValue, RecordSym), Field) ;
+   PutVarConst (Res, IsReadOnly (RecordSym)) ;
    GenQuadO (combinedtok, RecordFieldOp, Res, RecordSym, Field, FALSE) ;
    PopN (n+1) ;
    PushTFrwtok (Res, FieldType, rw, combinedtok)
@@ -11207,8 +11219,8 @@ BEGIN
    arrayTok := OperandTok (2) ;
    indexTok := OperandTok (1) ;
    combinedTok := MakeVirtualTok (arrayTok, arrayTok, indexTok) ;
-   Dim := OperandD(2) ;
-   rw := OperandMergeRW(2) ;
+   Dim := OperandD (2) ;
+   rw := OperandMergeRW (2) ;
    Assert (IsLegal (rw)) ;
    INC (Dim) ;
    IF Dim = 1
@@ -11223,10 +11235,10 @@ BEGIN
          which will generate the quads to access the record.
       *)
       ArraySym := Sym ;
-      UnboundedType := GetUnboundedRecordType(GetSType(Sym)) ;
-      PushTFrwtok(Sym, UnboundedType, rw, arrayTok) ;
-      PushTF (GetUnboundedAddressOffset(GetSType(Sym)),
-              GetSType(GetUnboundedAddressOffset(GetSType(Sym)))) ;
+      UnboundedType := GetUnboundedRecordType (GetSType (Sym)) ;
+      PushTFrwtok (Sym, UnboundedType, rw, arrayTok) ;
+      PushTF (GetUnboundedAddressOffset (GetSType (Sym)),
+              GetSType (GetUnboundedAddressOffset (GetSType (Sym)))) ;
       PushT (1) ;  (* One record field to dereference *)
       BuildDesignatorRecord (combinedTok) ;
       PopT (PtrToBase) ;
@@ -11375,37 +11387,38 @@ END BuildDesignatorPointer ;
                     |------------|
 *)
 
-PROCEDURE StartBuildWith ;
+PROCEDURE StartBuildWith (withTok: CARDINAL) ;
 VAR
    tok      : CARDINAL ;
    Sym, Type,
    Ref      : CARDINAL ;
 BEGIN
    DisplayStack ;
-   PopTF(Sym, Type) ;
-   Type := SkipType(Type) ;
-   tok := GetTokenNo () ;
+   PopTFtok (Sym, Type, tok) ;
+   Type := SkipType (Type) ;
 
-   Ref := MakeTemporary(tok, LeftValue) ;
-   PutVar(Ref, Type) ;
-   IF GetMode(Sym)=LeftValue
+   Ref := MakeTemporary (tok, LeftValue) ;
+   PutVar (Ref, Type) ;
+   IF GetMode (Sym) = LeftValue
    THEN
       (* copy LeftValue *)
-      GenQuad(BecomesOp, Ref, NulSym, Sym)
+      GenQuadO (tok, BecomesOp, Ref, NulSym, Sym, TRUE)
    ELSE
       (* calculate the address of Sym *)
-      GenQuad(AddrOp, Ref, NulSym, Sym)
+      GenQuadO (tok, AddrOp, Ref, NulSym, Sym, TRUE)
    END ;
 
-   PushWith(Sym, Type, Ref) ;
-   IF Type=NulSym
+   PushWith (Sym, Type, Ref, tok) ;
+   IF Type = NulSym
    THEN
-      MetaError1 ('{%1Ea} {%1d} has a no type, the {%kWITH} statement requires a variable or parameter of a {%kRECORD} type', Sym)
+      MetaError1 ('{%1Ea} {%1d} has a no type, the {%kWITH} statement requires a variable or parameter of a {%kRECORD} type',
+                  Sym)
    ELSIF NOT IsRecord(Type)
    THEN
-      MetaError1 ('the {%kWITH} statement requires that {%1Ea} {%1d} be of a {%kRECORD} {%1tsa:type rather than {%1tsa}}', Sym)
+      MetaError1 ('the {%kWITH} statement requires that {%1Ea} {%1d} be of a {%kRECORD} {%1tsa:type rather than {%1tsa}}',
+                  Sym)
    END ;
-   StartScope(Type)
+   StartScope (Type)
  ; DisplayStack ;
 END StartBuildWith ;
 
@@ -11428,7 +11441,7 @@ END EndBuildWith ;
               previous declaration of this record type.
 *)
 
-PROCEDURE PushWith (Sym, Type, Ref: CARDINAL) ;
+PROCEDURE PushWith (Sym, Type, Ref, Tok: CARDINAL) ;
 VAR
    i, n: CARDINAL ;
    f   : WithFrame ;
@@ -11449,12 +11462,13 @@ BEGIN
    END ;
    NEW(f) ;
    WITH f^ DO
-      RecordSym  := Sym ;
-      RecordType := Type ;
-      RecordRef  := Ref ;
-      rw         := Sym
+      RecordSym    := Sym ;
+      RecordType   := Type ;
+      RecordRef    := Ref ;
+      rw           := Sym ;
+      RecordTokPos := Tok
    END ;
-   PushAddress(WithStack, f)
+   PushAddress (WithStack, f)
 END PushWith ;
 
 
@@ -11488,32 +11502,32 @@ BEGIN
    n := NoOfItemsInStackAddress(WithStack) ;
    IF (n>0) AND (NOT SuppressWith)
    THEN
-      PopTFrwtok(Sym, Type, rw, tokpos) ;
+      PopTFrwtok (Sym, Type, rw, tokpos) ;
       Assert (tokpos # UnknownTokenNo) ;
       (* inner WITH always has precidence *)
       i := 1 ;  (* top of stack *)
       WHILE i<=n DO
          (* WriteString('Checking for a with') ; *)
-         f := PeepAddress(WithStack, i) ;
+         f := PeepAddress (WithStack, i) ;
          WITH f^ DO
-            IF IsRecordField(Sym) AND (GetRecord(GetParent(Sym))=RecordType)
+            IF IsRecordField (Sym) AND (GetRecord (GetParent (Sym)) = RecordType)
             THEN
-               IF IsUnused(Sym)
+               IF IsUnused (Sym)
                THEN
                   MetaError1('record field {%1Dad} was declared as unused by a pragma', Sym)
                END ;
                (* Fake a RecordSym.op *)
-               PushTFrw(RecordRef, RecordType, rw) ;
-               PushTF(Sym, Type) ;
+               PushTFrwtok (RecordRef, RecordType, rw, RecordTokPos) ;
+               PushTFtok (Sym, Type, tokpos) ;
                BuildAccessWithField ;
-               PopTFrw(Sym, Type, rw) ;
-               i := n+1
+               PopTFrw (Sym, Type, rw) ;
+               i := n+1  (* Finish loop.  *)
             ELSE
-               INC(i)
+               INC (i)
             END
          END
       END ;
-      PushTFrwtok(Sym, Type, rw, tokpos)
+      PushTFrwtok (Sym, Type, rw, tokpos)
    END
 END CheckWithReference ;
 
@@ -11540,7 +11554,7 @@ END CheckWithReference ;
 
 PROCEDURE BuildAccessWithField ;
 VAR
-   tok               : CARDINAL ;
+   rectok, fieldtok  : CARDINAL ;
    OldSuppressWith   : BOOLEAN ;
    rw,
    Field, FieldType,
@@ -11548,19 +11562,20 @@ VAR
    Ref               : CARDINAL ;
 BEGIN
    OldSuppressWith := SuppressWith ;
-   tok := GetTokenNo () ;
    SuppressWith := TRUE ;
    (*
       now the WITH cannot look at the stack of outstanding WITH records.
    *)
-   PopTF(Field, FieldType) ;
-   PopTFrw(Record, RecordType, rw) ;
+   PopTFtok (Field, FieldType, fieldtok) ;
+   PopTFrwtok (Record, RecordType, rw, rectok) ;
 
-   Ref := MakeComponentRef (MakeComponentRecord (tok,
+   Ref := MakeComponentRef (MakeComponentRecord (fieldtok,
                                                  RightValue, Record), Field) ;
-   GenQuad(RecordFieldOp, Ref, Record, Field) ;
+   PutVarConst (Ref, IsReadOnly (Record)) ;
+   GenQuadO (fieldtok,
+             RecordFieldOp, Ref, Record, Field, TRUE) ;
 
-   PushTFrw(Ref, FieldType, rw) ;
+   PushTFrwtok (Ref, FieldType, rw, fieldtok) ;
    SuppressWith := OldSuppressWith
 END BuildAccessWithField ;
 

diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 79ebab5eb941c560e8d9aaa4400f41db0183cca4..16e4590a257ba5a8189efbcbb9c536fd4cd760cf 100644 (file)
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -1258,8 +1258,10 @@ LoopStatement := "LOOP"
                                           "END"                            % BuildEndLoop %
                =:
 
-WithStatement := "WITH"
-                        Designator                                         % StartBuildWith %
+WithStatement :=                                                           % VAR
+                                                                                tok: CARDINAL ; %
+                 "WITH"                                                    % tok := GetTokenNo () -1 %
+                        Designator                                         % StartBuildWith (tok) %
                                    "DO"
                         StatementSequence
                                                                            % BuildStmtNote (0) %