From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1499) id BCE113858D1E; Tue, 29 Nov 2022 20:25:25 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BCE113858D1E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1669753525; bh=Be/UMS1DxZF7xZnaYin8WPbxHIrTudEVG+7RqKrse7A=; h=From:To:Subject:Date:From; b=nfyhEsUpFEY+goKH9JoA/IS8SKI034dlC7u7Qhv/rFZ7ZFhjarZWXuuURHjccFqQj gLLjv7QG46Hrsw4MvOZLuMkmN5P/z1h5Gu3fXvHJIu2m4yigodLrFQ89dx73FoUWHa tk2W3u7fMTGsUG/PH+bqULlv8MdupYX/1GsdT3z8= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Gaius Mulley To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/modula-2] Bugfix to detect re-assigning a constant record in a code block. X-Act-Checkin: gcc X-Git-Author: Gaius Mulley X-Git-Refname: refs/heads/devel/modula-2 X-Git-Oldrev: 918e3a0d1fb7dce3088cb291605e56eb7624c9cd X-Git-Newrev: cad9dac28278b23829f5ffceaefc20dc3d594ac5 Message-Id: <20221129202525.BCE113858D1E@sourceware.org> Date: Tue, 29 Nov 2022 20:25:25 +0000 (GMT) List-Id: https://gcc.gnu.org/g:cad9dac28278b23829f5ffceaefc20dc3d594ac5 commit cad9dac28278b23829f5ffceaefc20dc3d594ac5 Author: Gaius Mulley 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 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) %