public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Bugfix to detect re-assigning a constant record in a code block.
@ 2022-11-29 20:25 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-11-29 20:25 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:cad9dac28278b23829f5ffceaefc20dc3d594ac5
commit cad9dac28278b23829f5ffceaefc20dc3d594ac5
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Tue Nov 29 20:25:06 2022 +0000
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:
---
gcc/m2/gm2-compiler/M2Quads.def | 2 +-
gcc/m2/gm2-compiler/M2Quads.mod | 111 +++++++++++++++++++++++-----------------
gcc/m2/gm2-compiler/P3Build.bnf | 6 ++-
3 files changed, 68 insertions(+), 51 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index 148c6b8f918..829cee5b21d 100644
--- 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 a7c3acac166..12e9be55d7e 100644
--- 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 79ebab5eb94..16e4590a257 100644
--- 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) %
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-11-29 20:25 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-11-29 20:25 [gcc/devel/modula-2] Bugfix to detect re-assigning a constant record in a code block 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).