procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

PR modula2/114296 ICE when attempting to create a constant set with a variable element

Browse source 
This patch corrects the virtual token creation for the aggregate constant
and also corrects tokens for constructor components.

gcc/m2/ChangeLog:

	PR modula2/114296
	* gm2-compiler/M2ALU.mod (ElementsSolved): Add tokenno parameter.
	Add constant checks and generate error messages.
	(EvalSetValues): Pass tokenno parameter to ElementsSolved.
	* gm2-compiler/M2LexBuf.mod (stop): New procedure.
	(MakeVirtualTok): Call stop if caret = BadTokenNo.
	* gm2-compiler/M2Quads.def (BuildNulExpression): Add tokpos
	parameter.
	(BuildSetStart): Ditto.
	(BuildEmptySet): Ditto.
	(BuildConstructorEnd): Add startpos parameter.
	(BuildTypeForConstructor): Add tokpos parameter.
	* gm2-compiler/M2Quads.mod (BuildNulExpression): Add tokpos
	parameter and push tokpos to the quad stack.
	(BuildSetStart): Add tokpos parameter and push tokpos.
	(BuildSetEnd): Rewrite.
	(BuildEmptySet): Add tokpos parameter and push tokpos with
	the set	type.
	(BuildConstructorStart): Pop typepos.
	(BuildConstructorEnd): Add startpos parameter.
	Create valtok from startpos and cbratokpos.
	(BuildTypeForConstructor): Add tokpos parameter.
	* gm2-compiler/M2Range.def (InitAssignmentRangeCheck): Rename
	d to des and e to expr.
	Add destok and exprtok parameters.
	* gm2-compiler/M2Range.mod (InitAssignmentRangeCheck): Rename
	d to des and e to expr.
	Add destok and exprtok parameters.
	Save destok and exprtok into range record.
	(FoldAssignment): Pass exprtok to TryDeclareConstant.
	* gm2-compiler/P3Build.bnf (ComponentValue): Rewrite.
	(Constructor): Rewrite.
	(ConstSetOrQualidentOrFunction): Rewrite.
	(SetOrQualidentOrFunction): Rewrite.
	* gm2-compiler/PCBuild.bnf (ConstSetOrQualidentOrFunction): Rewrite.
	(SetOrQualidentOrFunction): Rewrite.
	* gm2-compiler/PHBuild.bnf (Constructor): Rewrite.
	(ConstSetOrQualidentOrFunction): Rewrite.

gcc/testsuite/ChangeLog:

	PR modula2/114296
	* gm2/pim/fail/badtype2.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
This commit is contained in:
Gaius Mulley 2024-03-17 14:49:23 +00:00
parent 2d454f9829
commit f065c582d9
10 changed files with 174 additions and 96 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
gcc/m2/gm2-compiler/M2ALU.mod
View file

@ -2922,10 +2922,20 @@ END AddField ;
ElementsSolved - returns TRUE if all ranges in the set have been solved.
*)
PROCEDURE ElementsSolved (r: listOfRange) : BOOLEAN ;
PROCEDURE ElementsSolved (tokenno: CARDINAL; r: listOfRange) : BOOLEAN ;
BEGIN
WHILE r#NIL DO
WITH r^ DO
IF NOT IsConst (low)
THEN
MetaErrorT1 (tokenno, 'a constant set can only contain constant set elements, {%1Ead} is not a constant',
low)
END ;
IF (high # low) AND (NOT IsConst (high))
THEN
MetaErrorT1 (tokenno, 'a constant set can only contain constant set elements, {%1Ead} is not a constant',
high)
END ;
IF NOT (IsSolvedGCC(low) AND IsSolvedGCC(high))
THEN
RETURN( FALSE )
@ -3088,7 +3098,7 @@ END CombineElements ;
PROCEDURE EvalSetValues (tokenno: CARDINAL; r: listOfRange) : BOOLEAN ;
BEGIN
IF ElementsSolved(r)
IF ElementsSolved (tokenno, r)
THEN
SortElements(tokenno, r) ;
CombineElements(tokenno, r) ;

13
gcc/m2/gm2-compiler/M2LexBuf.mod
View file

@ -48,6 +48,7 @@ CONST
Tracing = FALSE ;
Debugging = FALSE ;
DebugRecover = FALSE ;
BadTokenNo = 32579 ;
InitialSourceToken = 2 ; (* 0 is unknown, 1 is builtin. *)
TYPE
@ -81,6 +82,10 @@ VAR
to OpenSource. *)
PROCEDURE stop ;
END stop ;
(*
InitTokenDesc - returns a TokenDesc filled in with the parameters and
the insert field set to NIL.
@ -1060,10 +1065,14 @@ BEGIN
AddTokToList (virtualrangetok, NulName, 0,
descLeft^.line, descLeft^.col, descLeft^.file,
GetLocationBinary (lc, ll, lr)) ;
RETURN HighIndice (ListOfTokens)
caret := HighIndice (ListOfTokens)
END
END
END ;
IF caret = BadTokenNo
THEN
stop
END ;
RETURN caret
END MakeVirtualTok ;
@ -1075,7 +1084,7 @@ END MakeVirtualTok ;
PROCEDURE MakeVirtual2Tok (left, right: CARDINAL) : CARDINAL ;
BEGIN
RETURN MakeVirtualTok (left, left, right)
RETURN MakeVirtualTok (left, left, right) ;
END MakeVirtual2Tok ;

15
gcc/m2/gm2-compiler/M2Quads.def
View file

@ -1934,9 +1934,10 @@ PROCEDURE BuildDesignatorPointer (ptrtok: CARDINAL) ;
Empty +------------+
| NulSym |
|------------|
tokpos is the position of the RETURN token.
*)
PROCEDURE BuildNulExpression ;
PROCEDURE BuildNulExpression (tokpos: CARDINAL) ;
(*
@ -1953,7 +1954,7 @@ PROCEDURE BuildNulExpression ;
|--------------|
*)
PROCEDURE BuildSetStart ;
PROCEDURE BuildSetStart (tokpos: CARDINAL) ;
(*
@ -1986,9 +1987,10 @@ PROCEDURE BuildSetEnd ;
| SetType | | SetType |
|-----------| |-------------|
tokpos points to the opening '{'.
*)
PROCEDURE BuildEmptySet ;
PROCEDURE BuildEmptySet (tokpos: CARDINAL) ;
(*
@ -2097,9 +2099,12 @@ PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
+------------+ +------------+
| const | | const |
|------------+ |------------|
startpos is the start of the constructor, either the typename or '{'
cbratokpos is the '}'.
*)
PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
PROCEDURE BuildConstructorEnd (startpos, cbratokpos: CARDINAL) ;
(*
@ -2116,7 +2121,7 @@ PROCEDURE NextConstructorField ;
it Pushes a Bitset type.
*)
PROCEDURE BuildTypeForConstructor ;
PROCEDURE BuildTypeForConstructor (tokpos: CARDINAL) ;
(*

126
gcc/m2/gm2-compiler/M2Quads.mod
View file

@ -147,7 +147,7 @@ FROM M2Comp IMPORT CompilingImplementationModule,
CompilingProgramModule ;
FROM M2LexBuf IMPORT currenttoken, UnknownTokenNo, BuiltinTokenNo,
GetToken, MakeVirtualTok,
GetToken, MakeVirtualTok, MakeVirtual2Tok,
GetFileName, TokenToLineNo, GetTokenName,
GetTokenNo, GetLineNo, GetPreviousTokenLineNo, PrintTokenNo ;
@ -3702,7 +3702,7 @@ BEGIN
THEN
(* Tell code generator to test runtime values of assignment so ensure we
catch overflow and underflow. *)
BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp))
BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp, destok, exptok))
END ;
IF checkTypes
THEN
@ -11825,11 +11825,12 @@ END BuildAccessWithField ;
Empty +------------+
| NulSym |
|------------|
tokpos is the position of the RETURN token.
*)
PROCEDURE BuildNulExpression ;
PROCEDURE BuildNulExpression (tokpos: CARDINAL) ;
BEGIN
PushT(NulSym)
PushTtok (NulSym, tokpos)
END BuildNulExpression ;
@ -11839,25 +11840,25 @@ END BuildNulExpression ;
it Pushes a Bitset type.
*)
PROCEDURE BuildTypeForConstructor ;
PROCEDURE BuildTypeForConstructor (tokpos: CARDINAL) ;
VAR
c: ConstructorFrame ;
BEGIN
IF NoOfItemsInStackAddress(ConstructorStack)=0
THEN
PushT(Bitset)
PushTtok (Bitset, tokpos)
ELSE
c := PeepAddress(ConstructorStack, 1) ;
WITH c^ DO
IF IsArray(type) OR IsSet(type)
IF IsArray (type) OR IsSet (type)
THEN
PushT(GetSType(type))
ELSIF IsRecord(type)
PushTtok (GetSType (type), tokpos)
ELSIF IsRecord (type)
THEN
PushT(GetSType(GetNth(type, index)))
PushTtok (GetSType (GetNth (type, index)), tokpos)
ELSE
MetaError1('{%1ad} is not a set, record or array type which is expected when constructing an aggregate entity',
type)
MetaError1 ('{%1ad} is not a set, record or array type which is expected when constructing an aggregate entity',
type)
END
END
END
@ -11878,9 +11879,9 @@ END BuildTypeForConstructor ;
|--------------|
*)
PROCEDURE BuildSetStart ;
PROCEDURE BuildSetStart (tokpos: CARDINAL) ;
BEGIN
PushT(Bitset)
PushTtok (Bitset, tokpos)
END BuildSetStart ;
@ -11900,12 +11901,15 @@ END BuildSetStart ;
PROCEDURE BuildSetEnd ;
VAR
v, t: CARDINAL ;
valuepos, typepos,
combined,
value, type : CARDINAL ;
BEGIN
PopT(v) ;
PopT(t) ;
PushTF(v, t) ;
Assert(IsSet(t))
PopTtok (value, valuepos) ;
PopTtok (type, typepos) ;
combined := MakeVirtual2Tok (typepos, valuepos) ;
PushTFtok (value, type, combined) ;
Assert (IsSet (type))
END BuildSetEnd ;
@ -11922,52 +11926,54 @@ END BuildSetEnd ;
| SetType | | SetType |
|-----------| |-------------|
tokpos points to the opening '{'.
*)
PROCEDURE BuildEmptySet ;
PROCEDURE BuildEmptySet (tokpos: CARDINAL) ;
VAR
n : Name ;
Type : CARDINAL ;
NulSet: CARDINAL ;
tok : CARDINAL ;
n : Name ;
typepos,
Type : CARDINAL ;
NulSet : CARDINAL ;
tok : CARDINAL ;
BEGIN
PopT(Type) ; (* type of set we are building *)
tok := GetTokenNo () ;
IF (Type=NulSym) AND Pim
PopTtok (Type, typepos) ; (* type of set we are building *)
IF (Type = NulSym) AND Pim
THEN
(* allowed generic {} in PIM Modula-2 *)
ELSIF IsUnknown(Type)
typepos := tokpos
ELSIF IsUnknown (Type)
THEN
n := GetSymName(Type) ;
WriteFormat1('set type %a is undefined', n) ;
n := GetSymName (Type) ;
WriteFormat1 ('set type %a is undefined', n) ;
Type := Bitset
ELSIF NOT IsSet(SkipType(Type))
ELSIF NOT IsSet (SkipType (Type))
THEN
n := GetSymName(Type) ;
n := GetSymName (Type) ;
WriteFormat1('expecting a set type %a', n) ;
Type := Bitset
ELSE
Type := SkipType(Type) ;
Assert((Type#NulSym))
Type := SkipType (Type) ;
Assert (Type # NulSym)
END ;
NulSet := MakeTemporary(tok, ImmediateValue) ;
PutVar(NulSet, Type) ;
PutConstSet(NulSet) ;
NulSet := MakeTemporary (typepos, ImmediateValue) ;
PutVar (NulSet, Type) ;
PutConstSet (NulSet) ;
IF CompilerDebugging
THEN
n := GetSymName(Type) ;
printf1('set type = %a\n', n)
n := GetSymName (Type) ;
printf1 ('set type = %a\n', n)
END ;
PushNulSet(Type) ; (* onto the ALU stack *)
PopValue(NulSet) ; (* ALU -> symbol table *)
PushNulSet (Type) ; (* onto the ALU stack *)
PopValue (NulSet) ; (* ALU -> symbol table *)
(* and now construct the M2Quads stack as defined by the comments above *)
PushT(Type) ;
PushT(NulSet) ;
PushTtok (Type, typepos) ;
PushTtok (NulSet, typepos) ;
IF CompilerDebugging
THEN
n := GetSymName(Type) ;
printf2('Type = %a (%d) built empty set\n', n, Type) ;
n := GetSymName (Type) ;
printf2 ('Type = %a (%d) built empty set\n', n, Type) ;
DisplayStack (* Debugging info *)
END
END BuildEmptySet ;
@ -12197,10 +12203,11 @@ END SilentBuildConstructorStart ;
PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
VAR
typepos,
constValue,
type : CARDINAL ;
BEGIN
PopT (type) ; (* we ignore the type as we already have the constructor symbol from pass C *)
PopTtok (type, typepos) ; (* we ignore the type as we already have the constructor symbol from pass C *)
GetConstructorFromFifoQueue (constValue) ;
IF type # GetSType (constValue)
THEN
@ -12224,25 +12231,34 @@ END BuildConstructorStart ;
+------------+ +------------+
| const | | const |
|------------| |------------|
startpos is the start of the constructor, either the typename or '{'
cbratokpos is the '}'.
*)
PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
PROCEDURE BuildConstructorEnd (startpos, cbratokpos: CARDINAL) ;
VAR
typetok,
value, valtok: CARDINAL ;
BEGIN
PopTtok (value, valtok) ;
IF IsBoolean (1)
IF DebugTokPos
THEN
typetok := valtok
ELSE
typetok := OperandTtok (1)
WarnStringAt (InitString ('startpos'), startpos) ;
WarnStringAt (InitString ('cbratokpos'), cbratokpos)
END ;
valtok := MakeVirtualTok (typetok, typetok, cbratokpos) ;
PopTtok (value, valtok) ;
IF DebugTokPos
THEN
WarnStringAt (InitString ('value valtok'), valtok)
END ;
valtok := MakeVirtual2Tok (startpos, cbratokpos) ;
PutDeclared (valtok, value) ;
PushTtok (value, valtok) ; (* Use valtok as we now know it was a constructor. *)
PopConstructor
(* ; ErrorStringAt (Mark (InitString ('aggregate constant')), valtok) *)
PopConstructor ;
IF DebugTokPos
THEN
WarnStringAt (InitString ('aggregate constant'), valtok)
END
END BuildConstructorEnd ;

4
gcc/m2/gm2-compiler/M2Range.def
View file

@ -51,7 +51,9 @@ FROM DynamicStrings IMPORT String ;
can be generated later on.
*)
PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL;
des, expr: CARDINAL;
destok, exprtok: CARDINAL) : CARDINAL ;
(*

14
gcc/m2/gm2-compiler/M2Range.mod
View file

@ -601,16 +601,22 @@ END PutRangeArraySubscript ;
(*
InitAssignmentRangeCheck - returns a range check node which
remembers the information necessary
so that a range check for d := e
so that a range check for des := expr
can be generated later on.
*)
PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL; d, e: CARDINAL) : CARDINAL ;
PROCEDURE InitAssignmentRangeCheck (tokno: CARDINAL;
des, expr: CARDINAL;
destok, exprtok: CARDINAL) : CARDINAL ;
VAR
r: CARDINAL ;
p: Range ;
BEGIN
r := InitRange () ;
Assert (PutRange (tokno, GetIndice (RangeIndex, r), assignment, d, e) # NIL) ;
p := GetIndice (RangeIndex, r) ;
Assert (PutRange (tokno, p, assignment, des, expr) # NIL) ;
p^.destok := destok ;
p^.exprtok := exprtok ;
RETURN r
END InitAssignmentRangeCheck ;
@ -1207,7 +1213,7 @@ VAR
BEGIN
p := GetIndice (RangeIndex, r) ;
WITH p^ DO
TryDeclareConstant (tokenNo, expr) ;
TryDeclareConstant (exprtok, expr) ;
IF desLowestType # NulSym
THEN
IF AssignmentTypeCompatible (tokenno, "", des, expr)

48
gcc/m2/gm2-compiler/P3Build.bnf
View file

@ -739,10 +739,15 @@ ComponentElement := ConstExpression ( ".." ConstExpression % Pus
)
=:
ComponentValue := ComponentElement ( 'BY' ConstExpression % PushTtok(ByTok, GetTokenNo() -1) %
ComponentValue := % VAR tokpos: CARDINAL ; %
(
% tokpos := GetTokenNo () %
ComponentElement ( % tokpos := GetTokenNo () %
'BY' ConstExpression % PushTtok (ByTok, tokpos) %
| % PushT(NulTok) %
)
| % PushTtok (NulTok, tokpos) %
)
)
=:
ArraySetRecordValue := ComponentValue % BuildComponentValue %
@ -751,16 +756,22 @@ ArraySetRecordValue := ComponentValue % Bui
}
=:
Constructor := % DisplayStack %
'{' % BuildConstructorStart (GetTokenNo() -1) %
[ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
Constructor := % VAR tokpos: CARDINAL ; %
% DisplayStack %
'{' % tokpos := GetTokenNo () -1 %
% BuildConstructorStart (tokpos) %
[ ArraySetRecordValue ] % BuildConstructorEnd (tokpos, GetTokenNo()) %
'}' =:
ConstSetOrQualidentOrFunction := Qualident
[ Constructor | ConstActualParameters % BuildConstFunctionCall %
]
| % BuildTypeForConstructor %
Constructor =:
ConstSetOrQualidentOrFunction := % VAR tokpos: CARDINAL ; %
% tokpos := GetTokenNo () %
(
Qualident
[ Constructor | ConstActualParameters % BuildConstFunctionCall %
]
| % BuildTypeForConstructor (tokpos) %
Constructor
) =:
ConstActualParameters := % PushInConstExpression %
ActualParameters % PopInConstExpression %
@ -1101,10 +1112,13 @@ Factor := % VAR
| ConstAttribute
) =:
SetOrDesignatorOrFunction := Qualident
% Assert (OperandTok(1) # UnknownTokenNo) %
SetOrDesignatorOrFunction := % VAR tokpos: CARDINAL ; %
% tokpos := GetTokenNo () %
(
Qualident
% Assert (OperandTok (1) # UnknownTokenNo) %
% CheckWithReference %
% Assert (OperandTok(1) # UnknownTokenNo) %
% Assert (OperandTok (1) # UnknownTokenNo) %
[ Constructor |
SimpleDes % (* Assert (OperandTok(1) # UnknownTokenNo) *) %
[ ActualParameters % IF IsInConstExpression()
@ -1115,8 +1129,8 @@ SetOrDesignatorOrFunction := Qualident
END %
]
] |
% BuildTypeForConstructor %
Constructor =:
% BuildTypeForConstructor (tokpos) %
Constructor ) =:
-- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
SimpleDes := { SubDesignator } =:
@ -1130,7 +1144,7 @@ ExitStatement := "EXIT" % Bui
ReturnStatement := "RETURN" % VAR tokno: CARDINAL ; %
% tokno := GetTokenNo () -1 %
( Expression | % BuildNulExpression (* in epsilon *) %
( Expression | % BuildNulExpression (tokno) %
) % BuildReturn (tokno) %
=:

11
gcc/m2/gm2-compiler/PCBuild.bnf
View file

@ -700,12 +700,13 @@ ConstructorOrConstActualParameters := Constructor | ConstActualParameters % Pus
-- the entry to Constructor
ConstSetOrQualidentOrFunction := % PushAutoOff %
(
% VAR tokpos: CARDINAL ; %
( % tokpos := GetTokenNo () %
PushQualident
( ConstructorOrConstActualParameters | % PushConstType %
% PopNothing %
)
| % BuildTypeForConstructor %
| % BuildTypeForConstructor (tokpos) %
Constructor ) % PopAuto %
=:
@ -1003,12 +1004,14 @@ ConstructorOrSimpleDes := Constructor | % Pop
=:
SetOrDesignatorOrFunction := % PushAutoOff %
(
% VAR tokpos: CARDINAL ; %
( % tokpos := GetTokenNo () %
PushQualident
( ConstructorOrSimpleDes | % PopNothing %
)
|
% BuildTypeForConstructor %
% BuildTypeForConstructor (tokpos) %
Constructor
) % PopAuto %
=:

16
gcc/m2/gm2-compiler/PHBuild.bnf
View file

@ -652,19 +652,23 @@ ArraySetRecordValue := ComponentValue % Bui
}
=:
Constructor := '{' % BuildConstructorStart (GetTokenNo() -1) %
[ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
Constructor := % VAR tokpos: CARDINAL ; %
% DisplayStack %
'{' % tokpos := GetTokenNo () -1 %
% BuildConstructorStart (tokpos) %
[ ArraySetRecordValue ] % BuildConstructorEnd (tokpos, GetTokenNo()) %
'}' =:
ConstSetOrQualidentOrFunction := % PushAutoOn %
(
ConstSetOrQualidentOrFunction := % PushAutoOn %
% VAR tokpos: CARDINAL ; %
( % tokpos := GetTokenNo () %
Qualident
[ Constructor |
ConstActualParameters % BuildConstFunctionCall %
]
| % BuildTypeForConstructor %
| % BuildTypeForConstructor (tokpos) %
Constructor
) % PopAuto %
) % PopAuto %
=:
ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" ConstAttributeExpression ")" ")" =:

9
gcc/testsuite/gm2/pim/fail/badtype2.mod Normal file
View file

@ -0,0 +1,9 @@
MODULE badtype2 ;
VAR
x: CARDINAL ;
ch: CHAR ;
BEGIN
x := 6 ;
ch := {7 .. x};
END badtype2.