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

PR modula2/119192 ICE if TBITSIZE is used in an expression

Browse source 
This patch fixes an ICE which will occur is TBITSIZE is used
within an expression.

gcc/m2/ChangeLog:

	PR modula2/119192
	* gm2-compiler/M2GCCDeclare.def (TryDeclareType): New procedure.
	* gm2-compiler/M2GCCDeclare.mod (IsAnyType): New procedure.
	(TryDeclareType): Ditto.
	* gm2-compiler/M2GenGCC.mod (FoldTBitsize): New procedure.
	(FoldStandardFunction): Call FoldTBitsize.
	* gm2-gcc/m2expr.cc (BuildTBitSize): Improve comment.
	(m2expr_BuildSystemTBitSize): New function.
	* gm2-gcc/m2expr.def (BuildSystemTBitSize): New procedure
	function.
	* gm2-gcc/m2expr.h (m2expr_BuildSystemTBitSize): New function
	prototype.

gcc/testsuite/ChangeLog:

	PR modula2/119192
	* gm2/sets/run/pass/simplepacked.mod: Uncomment asserts.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
This commit is contained in:
Gaius Mulley 2025-03-10 17:37:41 +00:00
parent 85b46d0795
commit 40a4f3dead
7 changed files with 101 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/m2/gm2-compiler/M2GCCDeclare.def
View file

@ -92,6 +92,15 @@ PROCEDURE DeclareConstructor (tokenno: CARDINAL; quad: CARDINAL; sym: CARDINAL)
PROCEDURE TryDeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ;
(*
TryDeclareType - try and declare a type. If sym is a
type try and declare it, if we cannot
then enter it into the to do list.
*)
PROCEDURE TryDeclareType (tokenno: CARDINAL; type: CARDINAL) ;
(*
TryDeclareConstructor - try and declare a constructor. If, sym, is a
constructor try and declare it, if we cannot

27
gcc/m2/gm2-compiler/M2GCCDeclare.mod
View file

@ -1900,6 +1900,33 @@ BEGIN
END TryDeclareConstant ;
(*
IsAnyType - return TRUE if sym is any Modula-2 type.
*)
PROCEDURE IsAnyType (sym: CARDINAL) : BOOLEAN ;
BEGIN
RETURN (IsRecord(sym) OR IsType(sym) OR IsRecordField(sym) OR
IsPointer(sym) OR IsArray(sym) OR IsSet (sym) OR IsEnumeration (sym) OR
IsPointer (sym))
END IsAnyType ;
(*
TryDeclareType - try and declare a type. If sym is a
type try and declare it, if we cannot
then enter it into the to do list.
*)
PROCEDURE TryDeclareType (tokenno: CARDINAL; type: CARDINAL) ;
BEGIN
IF (type#NulSym) AND IsAnyType (type)
THEN
TraverseDependants (type)
END
END TryDeclareType ;
(*
DeclareConstant - checks to see whether, sym, is a constant and
declares the constant to gcc.

43
gcc/m2/gm2-compiler/M2GenGCC.mod
View file

@ -61,7 +61,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
ForeachProcedureDo,
ForeachInnerModuleDo,
ForeachLocalSymDo,
GetLType,
GetLType, GetDType,
GetType, GetNth, GetNthParamAny,
SkipType, SkipTypeAndSubrange,
GetUnboundedHighOffset,
@ -148,7 +148,7 @@ FROM M2ALU IMPORT PtrToValue,
ConvertToType ;
FROM M2GCCDeclare IMPORT WalkAction,
DeclareConstant, TryDeclareConstant,
DeclareConstant, TryDeclareConstant, TryDeclareType,
DeclareConstructor, TryDeclareConstructor,
StartDeclareScope, EndDeclareScope,
PromoteToString, PromoteToCString, DeclareLocalVariable,
@ -194,7 +194,8 @@ FROM m2expr IMPORT GetIntegerZero, GetIntegerOne,
BuildLogicalOr, BuildLogicalAnd, BuildSymmetricDifference,
BuildLogicalDifference,
BuildLogicalShift, BuildLogicalRotate,
BuildNegate, BuildNegateCheck, BuildAddr, BuildSize, BuildTBitSize,
BuildNegate, BuildNegateCheck, BuildAddr, BuildSize,
BuildTBitSize, BuildSystemTBitSize,
BuildOffset, BuildOffset1,
BuildLessThan, BuildGreaterThan,
BuildLessThanOrEqual, BuildGreaterThanOrEqual,
@ -4809,12 +4810,38 @@ BEGIN
END FoldBuiltinTypeInfo ;
(*
FoldTBitsize - attempt to fold the standard function SYSTEM.TBITSIZE
quadruple. If the quadruple is folded it is removed.
*)
PROCEDURE FoldTBitsize (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL;
op1, op2, op3: CARDINAL) ;
VAR
type : CARDINAL ;
location: location_t ;
BEGIN
location := TokenToLocation(tokenno) ;
TryDeclareType (tokenno, op3) ;
type := GetDType (op3) ;
IF CompletelyResolved (type)
THEN
AddModGcc (op1, BuildSystemTBitSize (location, Mod2Gcc (type))) ;
p (op1) ;
NoChange := FALSE ;
SubQuad (quad)
END
END FoldTBitsize ;
(*
FoldStandardFunction - attempts to fold a standard function.
*)
PROCEDURE FoldStandardFunction (tokenno: CARDINAL; p: WalkAction;
quad: CARDINAL; op1, op2, op3: CARDINAL) ;
quad: CARDINAL;
op1, op2, op3: CARDINAL) ;
VAR
s : String ;
type,
@ -4940,13 +4967,7 @@ BEGIN
END
ELSIF op2=TBitSize
THEN
IF GccKnowsAbout(op3)
THEN
AddModGcc(op1, BuildTBitSize(location, Mod2Gcc(op3))) ;
p(op1) ;
NoChange := FALSE ;
SubQuad(quad)
END
FoldTBitsize (tokenno, p, quad, op1, op2, op3)
ELSE
InternalError ('only expecting LENGTH, CAP, ABS, IM, RE')
END

17
gcc/m2/gm2-gcc/m2expr.cc
View file

@ -2818,7 +2818,9 @@ m2expr_calcNbits (location_t location, tree min, tree max)
return t;
}
/* BuildTBitSize return the minimum number of bits to represent, type. */
/* BuildTBitSize return the minimum number of bits to represent type.
This function is called internally by cc1gm2 to calculate the bits
size of a type and is used to position record fields. */
tree
m2expr_BuildTBitSize (location_t location, tree type)
@ -2849,6 +2851,19 @@ m2expr_BuildTBitSize (location_t location, tree type)
}
}
/* BuildSystemTBitSize return the minimum number of bits to represent type.
This function is called when evaluating SYSTEM.TBITSIZE. */
tree
m2expr_BuildSystemTBitSize (location_t location, tree type)
{
enum tree_code code = TREE_CODE (type);
m2assert_AssertLocation (location);
if (code == TYPE_DECL)
return m2expr_BuildTBitSize (location, TREE_TYPE (type));
return TYPE_SIZE (type);
}
/* BuildSize build a SIZE function expression and returns the tree. */
tree

9
gcc/m2/gm2-gcc/m2expr.def
View file

@ -745,4 +745,13 @@ PROCEDURE OverflowZType (location: location_t;
PROCEDURE BuildCondIfExpression (condition, type, left, right: tree) : tree ;
(*
BuildSystemTBitSize - return the minimum number of bits to represent type.
This function is called when evaluating
SYSTEM.TBITSIZE.
*)
PROCEDURE BuildSystemTBitSize (location: location_t; type: tree) : tree ;
END m2expr.

1
gcc/m2/gm2-gcc/m2expr.h
View file

@ -245,6 +245,7 @@ EXTERN int m2expr_GetCstInteger (tree cst);
EXTERN tree m2expr_calcNbits (location_t location, tree min, tree max);
EXTERN bool m2expr_OverflowZType (location_t location, const char *str,
unsigned int base, bool issueError);
EXTERN tree m2expr_BuildSystemTBitSize (location_t location, tree type);
EXTERN void m2expr_init (location_t location);
#undef EXTERN

9
gcc/testsuite/gm2/sets/run/pass/simplepacked.mod
View file

@ -24,7 +24,10 @@ VAR
BEGIN
a := settype {1} ;
b := a ;
(* assert (TBITSIZE (a) = 4, __LINE__, "TBITSIZE = 4") ; *)
(* Assumes that the bitset will be contained in <= 64 bits, most likely
32. But probably safe to assume <= 64 bits for some time. *)
printf ("TBITSIZE (a) = %d\n", TBITSIZE (a));
assert (TBITSIZE (a) <= 64, __LINE__, "TBITSIZE <= 64") ;
assert (a = b, __LINE__, "comparision between variable sets") ;
assert (a = settype {1}, __LINE__, "comparision between variable and constant sets") ;
assert (b = settype {1}, __LINE__, "comparision between variable and constant sets") ;
@ -43,7 +46,9 @@ VAR
BEGIN
a := psettype {1} ;
b := a ;
(* assert (TBITSIZE (a) = 4, __LINE__, "TBITSIZE = 4 packed set") ; *)
(* Packed set should be stored in a BYTE. *)
printf ("TBITSIZE (a) = %d\n", TBITSIZE (a));
assert (TBITSIZE (a) <= 32, __LINE__, "TBITSIZE <= 32 ( packed set )") ;
assert (a = b, __LINE__, "comparision between variable packed sets") ;
assert (a = psettype {1}, __LINE__, "comparision between variable and constant packed sets") ;
assert (b = psettype {1}, __LINE__, "comparision between variable and constant packed sets") ;