public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/modula-2] Bugfix to detect re-assigning a constant array in a code block.
@ 2022-11-29 15:10 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-11-29 15:10 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:5d09bba11a76e7488d29955eb823bad5a7a6f251
commit 5d09bba11a76e7488d29955eb823bad5a7a6f251
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Tue Nov 29 14:49:41 2022 +0000
Bugfix to detect re-assigning a constant array in a code block.
These patches detect re-assigning a constant array. The patches
also correct the token position for aggregate constants.
gcc/m2/ChangeLog:
* gm2-compiler/M2AsmUtil.mod
* gm2-compiler/M2Quads.def (PushTFntok): Exported.
(PopConstructor) Exported.
(BuildConstructor): Add parameter.
(BuildConstructorStart): Add parameter.
(BuildConstructorEnd): Add parameter.
(BuildComponentValue): Improved comment.
* gm2-compiler/M2Quads.mod (SymbolTable): Import list inserted
identifiers IsVarConst, PutVarConst and PutDeclared.
(BuildConstructorStart): Add parameter.
(BuildConstructorEnd): Add parameter.
(BuildAssignment): Detect assignment to a constant.
(BuildDesignatorArray): Detect assignment to a constant.
(BuildStaticArray): Detect assignment to a constant.
(BuildDynamicArray): Improve comments.
(PushConstructor): Improve comments.
(NextConstructorField): Improve comments.
(BuildConstructor): Add parameter and use token position
of type and parameter.
* gm2-compiler/PCBuild.bnf (M2Quads): Import PopConstructor
and PushTFntok.
(ErrorStringAt): New procedure.
* gm2-compiler/PCSymBuild.mod (PushConstructorCastType):
Propagate token position.
* gm2-compiler/PHBuild.bnf (Constructor): BuildConstructorStart
pass token position of {. BuildConstructorEnd
pass token position of }.
* gm2-compiler/SymbolTable.def (PutVarConst): Exported.
(IsVarConst) Exported.
* gm2-compiler/SymbolTable.mod (PutVarConst): New procedure.
(IsVarConst) New procedure function.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2AsmUtil.mod | 3 +-
gcc/m2/gm2-compiler/M2Quads.def | 24 ++++++--
gcc/m2/gm2-compiler/M2Quads.mod | 114 +++++++++++++++++++++++++-----------
gcc/m2/gm2-compiler/P3Build.bnf | 5 +-
gcc/m2/gm2-compiler/PCBuild.bnf | 77 +++++++++++++++---------
gcc/m2/gm2-compiler/PCSymBuild.mod | 6 +-
gcc/m2/gm2-compiler/PHBuild.bnf | 4 +-
gcc/m2/gm2-compiler/SymbolTable.def | 16 +++++
gcc/m2/gm2-compiler/SymbolTable.mod | 48 +++++++++++++++
9 files changed, 219 insertions(+), 78 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2AsmUtil.mod b/gcc/m2/gm2-compiler/M2AsmUtil.mod
index 7fc54cd22ed..3440b1d5dbf 100644
--- a/gcc/m2/gm2-compiler/M2AsmUtil.mod
+++ b/gcc/m2/gm2-compiler/M2AsmUtil.mod
@@ -69,8 +69,7 @@ END StringToKey ;
PROCEDURE GetFullScopeAsmName (sym: CARDINAL) : Name ;
VAR
- leader,
- module: String ;
+ leader: String ;
scope : CARDINAL ;
BEGIN
scope := GetScope (sym) ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index 113ce09cb98..148c6b8f918 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -81,7 +81,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
Top,
PopTF, PushTF, PopT, PushT, PopNothing, PopN, PushTFA,
PushTtok, PushTFtok, PopTFtok, PopTtok, PushTFAtok,
- PushTFn, PopTFn,
+ PushTFn, PushTFntok, PopTFn,
OperandT, OperandF, OperandA, OperandAnno, OperandTok,
DisplayStack, WriteOperand, Annotate,
@@ -93,6 +93,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile,
BuildConstructorStart,
BuildConstructorEnd,
NextConstructorField, BuildTypeForConstructor,
+ PopConstructor,
BuildComponentValue,
SilentBuildConstructor, SilentBuildConstructorStart,
@@ -1971,7 +1972,7 @@ PROCEDURE SilentBuildConstructorStart ;
|------------+
*)
-PROCEDURE BuildConstructor ;
+PROCEDURE BuildConstructor (tokcbrpos: CARDINAL) ;
(*
@@ -1986,7 +1987,7 @@ PROCEDURE BuildConstructor ;
|------------+ |------------|
*)
-PROCEDURE BuildConstructorStart ;
+PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
(*
@@ -2004,7 +2005,7 @@ PROCEDURE BuildConstructorStart ;
|------------+ |------------|
*)
-PROCEDURE BuildConstructorEnd ;
+PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
(*
@@ -2042,6 +2043,13 @@ PROCEDURE BuildTypeForConstructor ;
PROCEDURE BuildComponentValue ;
+(*
+ PopConstructor - removes the top constructor from the top of stack.
+*)
+
+PROCEDURE PopConstructor ;
+
+
(*
BuildNot - Builds a NOT operation from the quad stack.
The Stack is expected to contain:
@@ -2258,6 +2266,14 @@ PROCEDURE PopTtok (VAR True: WORD; VAR tok: CARDINAL) ;
PROCEDURE PushTFn (True, False, n: WORD) ;
+(*
+ PushTFntok - Push a True and False numbers onto the True/False stack.
+ True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFntok (True, False, n: WORD; tokno: CARDINAL) ;
+
+
(*
PopTFn - Pop a True and False number from the True/False stack.
True and False are assumed to contain Symbols or Ident etc.
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 5be8e770ec2..a7c3acac166 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -84,6 +84,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
PutWriteQuad, RemoveWriteQuad,
PutPriority, GetPriority,
PutProcedureBegin, PutProcedureEnd,
+ PutVarConst, IsVarConst,
IsVarParam, IsProcedure, IsPointer, IsParameter,
IsUnboundedParam, IsEnumeration, IsDefinitionForC,
IsVarAParam, IsVarient, IsLegal,
@@ -104,6 +105,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
IsPartialUnbounded, IsProcedureBuiltin,
IsSet, IsConstSet, IsConstructor, PutConst,
PutConstructor, PutConstructorFrom,
+ PutDeclared,
MakeComponentRecord, MakeComponentRef,
IsSubscript,
IsTemporary,
@@ -3359,16 +3361,21 @@ VAR
combinedtok: CARDINAL ;
BEGIN
des := OperandT (2) ;
- IF IsConst (des)
+ IF IsConst (des) OR IsVarConst (des)
THEN
destok := OperandTok (2) ;
exptok := OperandTok (1) ;
+ exp := OperandT (1) ;
IF DebugTokPos
THEN
MetaErrorT1 (destok, 'destok {%1Ead}', des) ;
MetaErrorT1 (exptok, 'exptok {%1Ead}', exp)
END ;
combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ;
+ IF DebugTokPos
+ THEN
+ MetaErrorT1 (combinedtok, 'combined {%1Ead}', des)
+ END ;
IF IsBoolean (1)
THEN
MetaErrorT1 (combinedtok,
@@ -3489,24 +3496,24 @@ BEGIN
combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ;
IF (GetSType (Des) # NulSym) AND (NOT IsSet (GetDType (Des)))
THEN
- (* tell code generator to test runtime values of assignment so ensure we
- catch overflow and underflow *)
+ (* Tell code generator to test runtime values of assignment so ensure we
+ catch overflow and underflow. *)
BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp))
END ;
IF checkTypes
THEN
CheckBecomesMeta (Des, Exp)
END ;
- (* Traditional Assignment *)
+ (* Traditional Assignment. *)
MoveWithMode (becomesTokNo, Des, Exp, Array, destok, exptok, checkOverflow) ;
IF checkTypes
THEN
(*
IF (CannotCheckTypeInPass3 (Des) OR CannotCheckTypeInPass3 (Exp))
THEN
- (* we must do this after the assignment to allow the Designator to be
- resolved (if it is a constant) before the type checking is done *)
- (* prompt post pass 3 to check the assignment once all types are resolved *)
+ (* We must do this after the assignment to allow the Designator to be
+ resolved (if it is a constant) before the type checking is done. *)
+ (* Prompt post pass 3 to check the assignment once all types are resolved. *)
BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp))
END ;
*)
@@ -11019,6 +11026,7 @@ BEGIN
PushTFtok (t, GetSType(t), exprTok) ;
PushTtok (Sym, arrayTok) ;
combinedTok := MakeVirtualTok (arrayTok, arrayTok, exprTok) ;
+ PutVarConst (t, TRUE) ;
BuildAssignConstant (combinedTok) ;
PushTFDtok (t, GetDType(t), d, arrayTok) ;
PushTtok (e, exprTok)
@@ -11100,6 +11108,11 @@ BEGIN
(* now make Adr point to the address of the indexed element *)
combinedTok := MakeVirtualTok (arrayTok, arrayTok, indexTok) ;
Adr := MakeTemporary (combinedTok, LeftValue) ;
+ IF IsVar (Array)
+ THEN
+ (* BuildDesignatorArray may have detected des is a constant. *)
+ PutVarConst (Adr, IsVarConst (Array))
+ END ;
(*
From now on it must reference the array element by its lvalue
- so we create the type of the referenced entity
@@ -11201,16 +11214,13 @@ BEGIN
IF Dim = 1
THEN
(*
- Base has type address because
+ Base has type address since
BuildDesignatorRecord references by address.
Build a record for retrieving the address of dynamic array.
BuildDesignatorRecord will generate the required quadruples,
therefore build sets up the stack for BuildDesignatorRecord
which will generate the quads to access the record.
-
- Build above current current info needed for array.
- Note that, n, has gone by now.
*)
ArraySym := Sym ;
UnboundedType := GetUnboundedRecordType(GetSType(Sym)) ;
@@ -11846,7 +11856,7 @@ PROCEDURE PopConstructor ;
VAR
c: ConstructorFrame ;
BEGIN
- c := PopAddress(ConstructorStack) ;
+ c := PopAddress (ConstructorStack) ;
DISPOSE(c)
END PopConstructor ;
@@ -11870,7 +11880,7 @@ END NextConstructorField ;
PROCEDURE SilentBuildConstructor ;
BEGIN
- PutConstructorIntoFifoQueue(NulSym)
+ PutConstructorIntoFifoQueue (NulSym)
END SilentBuildConstructor ;
@@ -11886,28 +11896,28 @@ END SilentBuildConstructor ;
|------------+
*)
-PROCEDURE BuildConstructor ;
+PROCEDURE BuildConstructor (tokcbrpos: CARDINAL) ;
VAR
tok : CARDINAL ;
constValue,
type : CARDINAL ;
BEGIN
- PopT(type) ;
- tok := GetTokenNo () ;
- constValue := MakeTemporary(tok, ImmediateValue) ;
- PutVar(constValue, type) ;
- PutConstructor(constValue) ;
- PushValue(constValue) ;
- IF type=NulSym
+ PopTtok (type, tok) ;
+ constValue := MakeTemporary (tok, ImmediateValue) ;
+ PutVar (constValue, type) ;
+ PutConstructor (constValue) ;
+ PushValue (constValue) ;
+ IF type = NulSym
THEN
- WriteFormat0('constructor requires a type before the opening {')
+ MetaErrorT0 (tokcbrpos,
+ '{%E}constructor requires a type before the opening {')
ELSE
- ChangeToConstructor(GetTokenNo(), type) ;
- PutConstructorFrom(constValue, type) ;
- PopValue(constValue) ;
- PutConstructorIntoFifoQueue(constValue)
+ ChangeToConstructor (tok, type) ;
+ PutConstructorFrom (constValue, type) ;
+ PopValue (constValue) ;
+ PutConstructorIntoFifoQueue (constValue)
END ;
- PushConstructor(type)
+ PushConstructor (type)
END BuildConstructor ;
@@ -11919,7 +11929,7 @@ PROCEDURE SilentBuildConstructorStart ;
VAR
constValue: CARDINAL ;
BEGIN
- GetConstructorFromFifoQueue(constValue)
+ GetConstructorFromFifoQueue (constValue)
END SilentBuildConstructorStart ;
@@ -11935,16 +11945,16 @@ END SilentBuildConstructorStart ;
|------------+ |----------------|
*)
-PROCEDURE BuildConstructorStart ;
+PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
VAR
constValue,
type : CARDINAL ;
BEGIN
- PopT(type) ; (* we ignore the type as we already have the constructor symbol from pass C *)
- GetConstructorFromFifoQueue(constValue) ;
- Assert(type=GetSType(constValue)) ;
- PushT(constValue) ;
- PushConstructor(type)
+ PopT (type) ; (* we ignore the type as we already have the constructor symbol from pass C *)
+ GetConstructorFromFifoQueue (constValue) ;
+ Assert (type = GetSType (constValue)) ;
+ PushTtok (constValue, cbratokpos) ;
+ PushConstructor (type)
END BuildConstructorStart ;
@@ -11961,9 +11971,23 @@ END BuildConstructorStart ;
|------------| |------------|
*)
-PROCEDURE BuildConstructorEnd ;
+PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
+VAR
+ type, typetok,
+ value, valtok: CARDINAL ;
BEGIN
+ PopTtok (value, valtok) ;
+ IF IsBoolean (1)
+ THEN
+ typetok := valtok
+ ELSE
+ typetok := OperandTtok (1)
+ END ;
+ valtok := MakeVirtualTok (typetok, typetok, cbratokpos) ;
+ PutDeclared (valtok, value) ;
+ PushTtok (value, valtok) ; (* Use valtok as we now know it was a constructor. *)
PopConstructor
+ (* ; ErrorStringAt (Mark (InitString ('aggregate constant')), valtok) *)
END BuildConstructorEnd ;
@@ -14685,6 +14709,26 @@ BEGIN
END PushTFn ;
+(*
+ PushTFntok - Push a True and False numbers onto the True/False stack.
+ True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFntok (True, False, n: WORD; tokno: CARDINAL) ;
+VAR
+ f: BoolFrame ;
+BEGIN
+ f := newBoolFrame () ;
+ WITH f^ DO
+ TrueExit := True ;
+ FalseExit := False ;
+ name := n ;
+ tokenno := tokno
+ END ;
+ PushAddress (BoolStack, f)
+END PushTFntok ;
+
+
(*
PopTFn - Pop a True and False number from the True/False stack.
True and False are assumed to contain Symbols or Ident etc.
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 9f5dbb3536d..79ebab5eb94 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -747,8 +747,9 @@ ArraySetRecordValue := ComponentValue % Bui
}
=:
-Constructor := '{' % BuildConstructorStart %
- [ ArraySetRecordValue ] % BuildConstructorEnd %
+Constructor := % DisplayStack %
+ '{' % BuildConstructorStart (GetTokenNo() -1) %
+ [ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
'}' =:
ConstSetOrQualidentOrFunction := Qualident
diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf
index 7db36e8dfd6..40fc1e63923 100644
--- a/gcc/m2/gm2-compiler/PCBuild.bnf
+++ b/gcc/m2/gm2-compiler/PCBuild.bnf
@@ -62,9 +62,10 @@ FROM M2Reserved IMPORT tokToTok, toktype,
AndTok, AmbersandTok, PeriodPeriodTok, ByTok ;
FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF, PopNothing, OperandT, PushTFA,
- PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok,
+ PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok, PushTFntok,
PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto,
BuildTypeForConstructor, BuildConstructor, BuildConstructorEnd,
+ PopConstructor,
NextConstructorField, SilentBuildConstructor ;
FROM P3SymBuild IMPORT CheckCanBeImported ;
@@ -130,17 +131,23 @@ VAR
PROCEDURE ErrorString (s: String) ;
BEGIN
- ErrorStringAt(s, GetTokenNo()) ;
+ ErrorStringAt (s, GetTokenNo ()) ;
WasNoError := FALSE
END ErrorString ;
PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
BEGIN
- ErrorString(InitString(a))
+ ErrorString (InitString (a))
END ErrorArray ;
+PROCEDURE ErrorArrayAt (a: ARRAY OF CHAR; tok: CARDINAL) ;
+BEGIN
+ ErrorStringAt (InitString(a), tok)
+END ErrorArrayAt ;
+
+
% declaration PCBuild begin
@@ -344,7 +351,7 @@ PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop
BEGIN
IF IsAutoPushOn()
THEN
- PushTF(makekey(currentstring), identtok)
+ PushTFtok (makekey (currentstring), identtok, GetTokenNo ())
END ;
Expect(identtok, stopset0, stopset1, stopset2)
END Ident ;
@@ -681,8 +688,8 @@ ArraySetRecordValue := ComponentValue { ',' % Nex
Constructor := '{' % PushConstructorCastType %
% PushInConstructor %
- % BuildConstructor %
- [ ArraySetRecordValue ] % BuildConstructorEnd %
+ % BuildConstructor (GetTokenNo ()-1) %
+ [ ArraySetRecordValue ] % PopConstructor %
'}' % PopInConstructor %
=:
@@ -926,50 +933,64 @@ Term := Factor { MulOperator Factor } =:
Factor := Number | string | SetOrDesignatorOrFunction |
"(" Expression ")" | "NOT" ( Factor | ConstAttribute ) =:
-PushQualident := % VAR name : Name ;
- init, ip1: CARDINAL ; %
+PushQualident := % VAR name : Name ;
+ init, ip1 : CARDINAL ;
+ tok, tokstart: CARDINAL ; %
% PushAutoOn %
Ident % IF IsAutoPushOn()
THEN
- PopT(name) ;
- init := GetSym(name) ;
+ PopTtok (name, tokstart) ;
+ tok := tokstart ;
+ init := GetSym (name) ;
IF init=NulSym
THEN
- PushTFn(NulSym, NulSym, name)
+ PushTFntok (NulSym, NulSym, name, tok)
ELSE
- WHILE IsDefImp(init) OR IsModule(init) DO
- IF currenttoken#periodtok
+ WHILE IsDefImp (init) OR IsModule (init) DO
+ IF currenttoken # periodtok
THEN
- ErrorArray("expecting '.' after module in the construction of a qualident") ;
- PushT(init) ;
+ ErrorArrayAt ("expecting '.' after module in the construction of a qualident", tok) ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ PushTtok (init, tok) ;
PopAuto ;
RETURN
ELSE
- Expect(periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
- StartScope(init) ;
- Ident(stopset0, stopset1, stopset2) ;
- PopT(name) ;
- ip1 := GetSym(name) ;
- IF ip1=NulSym
+ Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+ StartScope (init) ;
+ Ident (stopset0, stopset1, stopset2) ;
+ PopTtok (name, tok) ;
+ ip1 := GetSym (name) ;
+ IF ip1 = NulSym
THEN
- ErrorArray("unknown ident in the construction of a qualident") ;
+ ErrorArrayAt ("unknown ident in the construction of a qualident", tok) ;
EndScope ;
- PushTFn(NulSym, NulSym, name) ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ PushTFntok (NulSym, NulSym, name, tok) ;
PopAuto ;
RETURN
ELSE
- PutIncluded(ip1)
+ PutIncluded (ip1)
END ;
EndScope ;
- CheckCanBeImported(init, ip1) ;
+ CheckCanBeImported (init, ip1) ;
init := ip1
END
END ;
- IF IsProcedure(init) OR IsProcType(init)
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ IF IsProcedure (init) OR IsProcType (init)
THEN
- PushT(init)
+ PushTtok (init, tok)
ELSE
- PushTF(init, GetType(init))
+ PushTFtok (init, GetType(init), tok)
END
END
ELSE %
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod
index 7e11b0ea014..f3d3afce8f0 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.mod
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -1326,14 +1326,10 @@ END PushConstType ;
*)
PROCEDURE PushConstructorCastType ;
-VAR
- c: CARDINAL ;
BEGIN
- PopT(c) ;
- PushT(c) ;
IF inDesignator
THEN
- InitConvert(cast, c, NIL, NIL)
+ InitConvert (cast, OperandT (1), NIL, NIL)
END
END PushConstructorCastType ;
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index 9efc005327b..16c8f0e1b1c 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -695,8 +695,8 @@ ArraySetRecordValue := ComponentValue % Bui
}
=:
-Constructor := '{' % BuildConstructorStart %
- [ ArraySetRecordValue ] % BuildConstructorEnd %
+Constructor := '{' % BuildConstructorStart (GetTokenNo() -1) %
+ [ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
'}' =:
ConstSetOrQualidentOrFunction := Qualident
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index 2983ec46fde..c2f25f4e319 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -146,6 +146,7 @@ EXPORT QUALIFIED NulSym,
GetImportStatementList, GetModuleDefImportStatementList, GetModuleModImportStatementList,
PutVar,
+ PutVarConst,
PutLeftValueFrontBackType,
GetVarBackEndType,
PutVarPointerCheck,
@@ -227,6 +228,7 @@ EXPORT QUALIFIED NulSym,
IsImport,
IsImportStatement,
IsVar,
+ IsVarConst,
IsConst,
IsConstString,
IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul,
@@ -883,6 +885,13 @@ PROCEDURE PutVariableSSA (sym: CARDINAL; value: BOOLEAN) ;
PROCEDURE IsVariableSSA (sym: CARDINAL) : BOOLEAN ;
+(*
+ PutVarConst - sets the IsConst field to value indicating the variable is read only.
+*)
+
+PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ;
+
+
(*
MakeGnuAsm - create a GnuAsm symbol.
*)
@@ -2802,6 +2811,13 @@ PROCEDURE IsProcType (Sym: CARDINAL) : BOOLEAN ;
PROCEDURE IsVar (Sym: CARDINAL) : BOOLEAN ;
+(*
+ IsVarConst - returns the IsConst field indicating the variable is read only.
+*)
+
+PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ;
+
+
(*
IsConst - returns true is Sym is a Const Symbol.
*)
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 41e9c8a2d99..a2fd8691940 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -456,6 +456,7 @@ TYPE
CVariant,
NulCVariant : CARDINAL ; (* variants of the same string *)
StringVariant : ConstStringVariant ;
+ Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
@@ -468,6 +469,7 @@ TYPE
IsConstructor: BOOLEAN ; (* is the constant a set? *)
FromType : CARDINAL ; (* type is determined FromType *)
UnresFromType: BOOLEAN ; (* is Type unresolved? *)
+ Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
@@ -481,6 +483,7 @@ TYPE
FromType : CARDINAL ; (* type is determined FromType *)
UnresFromType: BOOLEAN ; (* is Type resolved? *)
IsTemp : BOOLEAN ; (* is it a temporary? *)
+ Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
@@ -504,6 +507,7 @@ TYPE
(* dereference a pointer? *)
IsWritten : BOOLEAN ; (* Is variable written to? *)
IsSSA : BOOLEAN ; (* Is variable a SSA? *)
+ IsConst : BOOLEAN ; (* Is variable read/only? *)
At : Where ; (* Where was sym declared/used *)
ReadUsageList, (* list of var read quads *)
WriteUsageList: LRLists ; (* list of var write quads *)
@@ -4081,6 +4085,7 @@ BEGIN
IsPointerCheck := FALSE ;
IsWritten := FALSE ;
IsSSA := FALSE ;
+ IsConst := FALSE ;
InitWhereDeclaredTok(tok, At) ;
InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
InitList(ReadUsageList[RightValue]) ;
@@ -4667,6 +4672,7 @@ BEGIN
ConstLit.IsConstructor := FALSE ;
ConstLit.FromType := NulSym ; (* type is determined FromType *)
ConstLit.UnresFromType := FALSE ; (* is Type resolved? *)
+ ConstLit.Scope := GetCurrentScope() ;
InitWhereDeclaredTok (tok, ConstLit.At) ;
InitWhereFirstUsedTok (tok, ConstLit.At)
@@ -4703,6 +4709,7 @@ BEGIN
FromType := NulSym ; (* type is determined FromType *)
UnresFromType := FALSE ; (* is Type resolved? *)
IsTemp := FALSE ;
+ Scope := GetCurrentScope() ;
InitWhereDeclaredTok (tok, At)
END
END ;
@@ -4811,6 +4818,7 @@ BEGIN
m2sym, m2nulsym, csym, cnulsym) ;
BackFillString (cnulsym,
m2sym, m2nulsym, csym, cnulsym) ;
+ ConstString.Scope := GetCurrentScope() ;
InitWhereDeclaredTok (tok, ConstString.At)
ELSE
@@ -6578,6 +6586,43 @@ BEGIN
END GetVarWritten ;
+(*
+ PutVarConst - sets the IsConst field to value indicating the variable is read only.
+*)
+
+PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ pSym^.Var.IsConst := value
+ END
+END PutVarConst ;
+
+
+(*
+ IsVarConst - returns the IsConst field indicating the variable is read only.
+*)
+
+PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: RETURN( Var.IsConst )
+
+ ELSE
+ InternalError ('expecting VarSym')
+ END
+ END
+END IsVarConst ;
+
+
(*
PutConst - gives the constant symbol Sym a type ConstType.
*)
@@ -11964,6 +12009,9 @@ BEGIN
RecordSym : RETURN( Record.Scope ) |
SetSym : RETURN( Set.Scope ) |
UnboundedSym : RETURN( Unbounded.Scope ) |
+ ConstLitSym : RETURN( ConstLit.Scope ) |
+ ConstStringSym : RETURN( ConstString.Scope ) |
+ ConstVarSym : RETURN( ConstVar.Scope ) |
PartialUnboundedSym: InternalError ('should not be requesting the scope of a PartialUnbounded symbol')
ELSE
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-11-29 15:10 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-11-29 15:10 [gcc/devel/modula-2] Bugfix to detect re-assigning a constant array 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).