https://gcc.gnu.org/g:d286ece094ca52f41bf71096aa1de0a0cd954dfb
commit r15-8475-gd286ece094ca52f41bf71096aa1de0a0cd954dfb
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Thu Mar 20 20:10:31 2025 +0000
PR modula2/118600 Assigning to a record causes alignment exception
This patch recursively tests every assignment (of a constructor
to a designator) to ensure the types are GCC equivalent. If they
are equivalent then it uses gimple assignment and if not then it
copies a structure by field and uses __builtin_strncpy to copy a
string cst into an array. Unions are copied by __builtin_memcpy.
gcc/m2/ChangeLog:
PR modula2/118600
* gm2-compiler/M2GenGCC.mod (PerformCodeBecomes): New procedure.
(CodeBecomes): Refactor and call PerformCodeBecomes.
* gm2-gcc/m2builtins.cc (gm2_strncpy_node): New global variable.
(DoBuiltinStrNCopy): New function.
(m2builtins_BuiltinStrNCopy): New function.
(m2builtins_init): Initialize gm2_strncpy_node.
* gm2-gcc/m2builtins.def (BuiltinStrNCopy): New procedure
function.
* gm2-gcc/m2builtins.h (m2builtins_BuiltinStrNCopy): New
function.
* gm2-gcc/m2statement.cc (copy_record_fields): New function.
(copy_array): Ditto.
(copy_strncpy): Ditto.
(copy_memcpy): Ditto.
(CopyByField_Lower): Ditto.
(m2statement_CopyByField): Ditto.
* gm2-gcc/m2statement.def (CopyByField): New procedure function.
* gm2-gcc/m2statement.h (m2statement_CopyByField): New function.
* gm2-gcc/m2type.cc (check_record_fields): Ditto.
(check_array_types): Ditto.
(m2type_IsGccStrictTypeEquivalent): Ditto.
* gm2-gcc/m2type.def (IsGccStrictTypeEquivalent): New procedure
function.
* gm2-gcc/m2type.h (m2type_IsAddress): Replace return type int
with bool.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2GenGCC.mod | 38 +++++++++----
gcc/m2/gm2-gcc/m2builtins.cc | 22 ++++++++
gcc/m2/gm2-gcc/m2builtins.def | 13 +++--
gcc/m2/gm2-gcc/m2builtins.h | 2 +
gcc/m2/gm2-gcc/m2statement.cc | 115 +++++++++++++++++++++++++++++++++++++++
gcc/m2/gm2-gcc/m2statement.def | 12 ++++
gcc/m2/gm2-gcc/m2statement.h | 1 +
gcc/m2/gm2-gcc/m2type.cc | 60 +++++++++++++++++++-
gcc/m2/gm2-gcc/m2type.def | 8 +++
gcc/m2/gm2-gcc/m2type.h | 4 +-
10 files changed, 255 insertions(+), 20 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index ec38dc2e7cb4..3665751f4f97 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/gcc/m2/gm2-compiler/M2GenGCC.mod
@@ -43,7 +43,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue,
PopValue,
IsConst, IsConstSet, IsProcedure, IsProcType,
IsVar, IsVarParamAny, IsTemporary, IsTuple,
IsEnumeration,
- IsUnbounded, IsArray, IsSet, IsConstructor,
+ IsUnbounded, IsArray, IsSet, IsConstructor,
IsConstructorConstant,
IsProcedureVariable,
IsUnboundedParamAny,
IsRecordField, IsFieldVarient, IsVarient, IsRecord,
@@ -232,7 +232,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree,
BuildParam, BuildFunct
BuildReturnValueCode, SetLastFunction,
BuildIncludeVarConst, BuildIncludeVarVar,
BuildExcludeVarConst, BuildExcludeVarVar,
- BuildBuiltinCallTree,
+ BuildBuiltinCallTree, CopyByField,
GetParamTree, BuildCleanUp,
BuildTryFinally,
GetLastFunction, SetLastFunction,
@@ -241,7 +241,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree,
BuildParam, BuildFunct
FROM m2type IMPORT ChainOnParamValue, GetPointerType, GetIntegerType,
AddStatement,
GetCardinalType, GetWordType, GetM2ZType, GetM2RType,
GetM2CType,
BuildCharConstant, AddStringToTreeList,
BuildArrayStringConstructor,
- GetArrayNoOfElements, GetTreeType ;
+ GetArrayNoOfElements, GetTreeType,
IsGccStrictTypeEquivalent ;
FROM m2block IMPORT RememberConstant, pushGlobalScope, popGlobalScope,
finishFunctionDecl,
pushFunctionScope, popFunctionScope,
@@ -3497,6 +3497,29 @@ BEGIN
END checkDeclare ;
+(*
+ PerformCodeBecomes -
+*)
+
+PROCEDURE PerformCodeBecomes (location: location_t;
+ virtpos: CARDINAL; des, expr: CARDINAL) ;
+VAR
+ destree, exprtree: tree ;
+BEGIN
+ destree := Mod2Gcc (des) ;
+ exprtree := FoldConstBecomes (virtpos, des, expr) ;
+ IF IsVar (des) AND IsVariableSSA (des)
+ THEN
+ Replace (des, exprtree)
+ ELSIF IsGccStrictTypeEquivalent (destree, exprtree)
+ THEN
+ BuildAssignmentStatement (location, destree, exprtree)
+ ELSE
+ CopyByField (location, destree, exprtree)
+ END
+END PerformCodeBecomes ;
+
+
(*
------------------------------------------------------------------------------
:= Operator
@@ -3576,14 +3599,7 @@ BEGIN
ELSE
IF checkBecomes (des, expr, virtpos, despos, exprpos)
THEN
- IF IsVar (des) AND IsVariableSSA (des)
- THEN
- Replace (des, FoldConstBecomes (virtpos, des, expr))
- ELSE
- BuildAssignmentStatement (location,
- Mod2Gcc (des),
- FoldConstBecomes (virtpos, des, expr))
- END
+ PerformCodeBecomes (location, virtpos, des, expr)
ELSE
SubQuad (quad) (* We don't want multiple errors for the quad. *)
END
diff --git a/gcc/m2/gm2-gcc/m2builtins.cc b/gcc/m2/gm2-gcc/m2builtins.cc
index 175c62a102a5..cb9ef65351d2 100644
--- a/gcc/m2/gm2-gcc/m2builtins.cc
+++ b/gcc/m2/gm2-gcc/m2builtins.cc
@@ -418,6 +418,7 @@ static GTY (()) tree ldouble_ftype_ldouble;
static GTY (()) tree gm2_alloca_node;
static GTY (()) tree gm2_memcpy_node;
static GTY (()) tree gm2_memset_node;
+static GTY (()) tree gm2_strncpy_node;
static GTY (()) tree gm2_isfinite_node;
static GTY (()) tree gm2_isnan_node;
static GTY (()) tree gm2_huge_valf_node;
@@ -1039,6 +1040,18 @@ DoBuiltinMemCopy (location_t location, tree dest, tree
src, tree bytes)
return call;
}
+static tree
+DoBuiltinStrNCopy (location_t location, tree dest, tree src, tree bytes)
+{
+ tree functype = TREE_TYPE (gm2_strncpy_node);
+ tree rettype = TREE_TYPE (functype);
+ tree funcptr
+ = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_strncpy_node);
+ tree call
+ = m2treelib_DoCall3 (location, rettype, funcptr, dest, src, bytes);
+ return call;
+}
+
static tree
DoBuiltinAlloca (location_t location, tree bytes)
{
@@ -1105,6 +1118,14 @@ m2builtins_BuiltInHugeValLong (location_t location)
return call;
}
+/* BuiltinStrNCopy copy at most n chars from address src to dest. */
+
+tree
+m2builtins_BuiltinStrNCopy (location_t location, tree dest, tree src, tree n)
+{
+ return DoBuiltinStrNCopy (location, dest, src, n);
+}
+
static void
create_function_prototype (location_t location,
struct builtin_function_entry *fe)
@@ -1580,6 +1601,7 @@ m2builtins_init (location_t location)
gm2_alloca_node = find_builtin_tree ("__builtin_alloca");
gm2_memcpy_node = find_builtin_tree ("__builtin_memcpy");
gm2_memset_node = find_builtin_tree ("__builtin_memset");
+ gm2_strncpy_node = find_builtin_tree ("__builtin_strncpy");
gm2_huge_valf_node = find_builtin_tree ("__builtin_huge_valf");
gm2_huge_val_node = find_builtin_tree ("__builtin_huge_val");
gm2_huge_vall_node = find_builtin_tree ("__builtin_huge_vall");
diff --git a/gcc/m2/gm2-gcc/m2builtins.def b/gcc/m2/gm2-gcc/m2builtins.def
index 61f769d91b68..5ab5a6d816f7 100644
--- a/gcc/m2/gm2-gcc/m2builtins.def
+++ b/gcc/m2/gm2-gcc/m2builtins.def
@@ -24,12 +24,6 @@ DEFINITION MODULE FOR "C" m2builtins ;
FROM CDataTypes IMPORT CharStar, ConstCharStar ;
FROM gcctypes IMPORT location_t, tree ;
-EXPORT QUALIFIED GetBuiltinConst, GetBuiltinConstType,
- GetBuiltinTypeInfoType, GetBuiltinTypeInfo,
- BuiltinExists, BuildBuiltinTree,
- BuiltinMemCopy, BuiltinMemSet, BuiltInAlloca,
- BuiltInIsfinite ;
-
(*
GetBuiltinConst - returns the gcc tree of a built in constant, name.
@@ -124,4 +118,11 @@ PROCEDURE BuiltInAlloca (location: location_t; n: tree) :
tree ;
PROCEDURE BuiltInIsfinite (location: location_t; e: tree) : tree ;
+(*
+ BuiltinStrNCopy - copy at most n characters from src to dest.
+*)
+
+PROCEDURE BuiltinStrNCopy (location: location_t; dest, src, n: tree) : tree ;
+
+
END m2builtins.
diff --git a/gcc/m2/gm2-gcc/m2builtins.h b/gcc/m2/gm2-gcc/m2builtins.h
index 37bdbfa06953..017d2df38f61 100644
--- a/gcc/m2/gm2-gcc/m2builtins.h
+++ b/gcc/m2/gm2-gcc/m2builtins.h
@@ -54,6 +54,8 @@ EXTERN tree m2builtins_BuildBuiltinTree (location_t location,
char *name);
EXTERN tree m2builtins_BuiltInHugeVal (location_t location);
EXTERN tree m2builtins_BuiltInHugeValShort (location_t location);
EXTERN tree m2builtins_BuiltInHugeValLong (location_t location);
+EXTERN tree m2builtins_BuiltinStrNCopy (location_t location, tree dest, tree
src, tree n);
+
EXTERN void m2builtins_init (location_t location);
#undef EXTERN
diff --git a/gcc/m2/gm2-gcc/m2statement.cc b/gcc/m2/gm2-gcc/m2statement.cc
index d42183f349ce..795298435e72 100644
--- a/gcc/m2/gm2-gcc/m2statement.cc
+++ b/gcc/m2/gm2-gcc/m2statement.cc
@@ -36,6 +36,7 @@ along with GNU Modula-2; see the file COPYING3. If not see
#include "m2treelib.h"
#include "m2type.h"
#include "m2convert.h"
+#include "m2builtins.h"
#include "m2pp.h"
static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
@@ -154,6 +155,120 @@ m2statement_SetEndLocation (location_t location)
cfun->function_end_locus = location;
}
+/* copy_record_fields copy each record field from right to left. */
+
+static
+void
+copy_record_fields (location_t location, tree left, tree right)
+{
+ unsigned int i;
+ tree right_value;
+ tree left_type = TREE_TYPE (left);
+ vec<constructor_elt, va_gc> *values = CONSTRUCTOR_ELTS (right);
+ FOR_EACH_CONSTRUCTOR_VALUE (values, i, right_value)
+ {
+ tree left_field = m2treelib_get_field_no (left_type, NULL_TREE, false,
i);
+ tree left_ref = m2expr_BuildComponentRef (location, left, left_field);
+ m2statement_CopyByField (location, left_ref, right_value);
+ }
+}
+
+/* copy_array copy each element of an array from array right to array left. */
+
+static
+void
+copy_array (location_t location, tree left, tree right)
+{
+ unsigned int i;
+ tree value;
+ vec<constructor_elt, va_gc> *values = CONSTRUCTOR_ELTS (right);
+ tree array_type = TREE_TYPE (left);
+ tree index_type = TYPE_DOMAIN (array_type);
+ tree elt_type = TREE_TYPE (array_type);
+ tree low_indice = TYPE_MIN_VALUE (index_type);
+ low_indice
+ = m2convert_BuildConvert (location, index_type, low_indice, false);
+ FOR_EACH_CONSTRUCTOR_VALUE (values, i, value)
+ {
+ tree idx = m2decl_BuildIntegerConstant (i);
+ idx = m2convert_BuildConvert (location, index_type, idx, false);
+ tree array_ref = build4_loc (location, ARRAY_REF, elt_type, left,
+ idx, low_indice, NULL_TREE);
+ m2statement_CopyByField (location, array_ref, value);
+ }
+}
+
+/* copy_array cst into left using strncpy. */
+
+static
+void
+copy_strncpy (location_t location, tree left, tree cst)
+{
+ tree result = m2builtins_BuiltinStrNCopy (location,
+ m2expr_BuildAddr (location, left,
false),
+ m2expr_BuildAddr (location, cst,
false),
+ m2decl_BuildIntegerConstant
(m2expr_StringLength (cst)));
+ TREE_SIDE_EFFECTS (result) = true;
+ TREE_USED (left) = true;
+ TREE_USED (cst) = true;
+ add_stmt (location, result);
+}
+
+/* copy_memcpy copy right into left using builtin_memcpy. */
+
+static
+void
+copy_memcpy (location_t location, tree left, tree right)
+{
+ tree result = m2builtins_BuiltinMemCopy (location,
+ m2expr_BuildAddr (location, left,
false),
+ m2expr_BuildAddr (location, right,
false),
+ m2expr_GetSizeOf (location, left));
+ TREE_SIDE_EFFECTS (result) = true;
+ TREE_USED (left) = true;
+ TREE_USED (right) = true;
+ add_stmt (location, result);
+}
+
+/* CopyByField_Lower copy right to left using memcpy for unions,
+ strncpy for string cst, field assignment for records,
+ array element assignment for array constructors. For all
+ other types it uses BuildAssignmentStatement. */
+
+static
+void
+CopyByField_Lower (location_t location,
+ tree left, tree right)
+{
+ tree left_type = TREE_TYPE (left);
+ enum tree_code right_code = TREE_CODE (right);
+ enum tree_code left_code = TREE_CODE (left_type);
+
+ if (left_code == RECORD_TYPE && right_code == CONSTRUCTOR)
+ copy_record_fields (location, left, right);
+ else if (left_code == ARRAY_TYPE && right_code == CONSTRUCTOR)
+ copy_array (location, left, right);
+ else if (left_code == UNION_TYPE && right_code == CONSTRUCTOR)
+ copy_memcpy (location, left, right);
+ else if (right_code == STRING_CST)
+ copy_strncpy (location, left, right);
+ else
+ m2statement_BuildAssignmentStatement (location, left, right);
+}
+
+/* CopyByField recursively checks each field to ensure GCC
+ type equivalence and if so it uses assignment.
+ Otherwise use strncpy or memcpy depending upon type. */
+
+void
+m2statement_CopyByField (location_t location, tree des, tree expr)
+{
+ if (m2type_IsGccStrictTypeEquivalent (des, expr))
+ m2statement_BuildAssignmentStatement (location, des, expr);
+ else
+ CopyByField_Lower (location, des, expr);
+}
+
/* BuildAssignmentTree builds the assignment of, des, and, expr.
It returns, des. */
diff --git a/gcc/m2/gm2-gcc/m2statement.def b/gcc/m2/gm2-gcc/m2statement.def
index 074b76860ba2..ffaf69784eee 100644
--- a/gcc/m2/gm2-gcc/m2statement.def
+++ b/gcc/m2/gm2-gcc/m2statement.def
@@ -314,4 +314,16 @@ PROCEDURE SetEndLocation (location: location_t) ;
PROCEDURE BuildBuiltinCallTree (func: tree) : tree ;
+(*
+ CopyByField - copy expr to des, if des is a record, union or an array
+ then check fields for GCC type equivalence and if necessary
+ call __builtin_strncpy and __builtin_memcpy.
+ This can occur if an expr contains a constant string
+ which is to be assigned into a field declared as
+ an ARRAY [0..n] OF CHAR.
+*)
+
+PROCEDURE CopyByField (location: location_t; des, expr: tree) ;
+
+
END m2statement.
diff --git a/gcc/m2/gm2-gcc/m2statement.h b/gcc/m2/gm2-gcc/m2statement.h
index db2daf37b6f6..0076b32dc8ee 100644
--- a/gcc/m2/gm2-gcc/m2statement.h
+++ b/gcc/m2/gm2-gcc/m2statement.h
@@ -108,6 +108,7 @@ EXTERN tree m2statement_BuildBuiltinCallTree (tree func);
EXTERN tree m2statement_BuildTryFinally (location_t location, tree call,
tree cleanups);
EXTERN tree m2statement_BuildCleanUp (tree param);
+EXTERN void m2statement_CopyByField (location_t location, tree des, tree expr);
#undef EXTERN
#endif /* m2statement_h. */
diff --git a/gcc/m2/gm2-gcc/m2type.cc b/gcc/m2/gm2-gcc/m2type.cc
index a946509d1c25..e82857d252df 100644
--- a/gcc/m2/gm2-gcc/m2type.cc
+++ b/gcc/m2/gm2-gcc/m2type.cc
@@ -3105,10 +3105,68 @@ m2type_gm2_signed_or_unsigned_type (int unsignedp, tree
type)
/* IsAddress returns true if the type is an ADDRESS. */
-int
+bool
m2type_IsAddress (tree type)
{
return type == ptr_type_node;
}
+/* check_record_fields return true if all the fields in left and right
+ are GCC equivalent. */
+
+static
+bool
+check_record_fields (tree left, tree right)
+{
+ unsigned int i;
+ tree right_value;
+ vec<constructor_elt, va_gc> *values = CONSTRUCTOR_ELTS (right);
+ FOR_EACH_CONSTRUCTOR_VALUE (values, i, right_value)
+ {
+ tree left_field = TREE_TYPE (m2treelib_get_field_no (left, NULL_TREE,
false, i));
+ if (! m2type_IsGccStrictTypeEquivalent (left_field, right_value))
+ return false;
+ }
+ return true;
+}
+
+/* check_array_types return true if left and right have the same type and right
+ is not a CST_STRING. */
+
+static
+bool
+check_array_types (tree right)
+{
+ unsigned int i;
+ tree value;
+ vec<constructor_elt, va_gc> *values = CONSTRUCTOR_ELTS (right);
+ FOR_EACH_CONSTRUCTOR_VALUE (values, i, value)
+ {
+ enum tree_code right_code = TREE_CODE (value);
+ if (right_code == STRING_CST)
+ return false;
+ }
+ return true;
+}
+
+bool
+m2type_IsGccStrictTypeEquivalent (tree left, tree right)
+{
+ enum tree_code right_code = TREE_CODE (right);
+ enum tree_code left_code = TREE_CODE (left);
+ if (left_code == VAR_DECL)
+ return m2type_IsGccStrictTypeEquivalent (TREE_TYPE (left), right);
+ if (right_code == VAR_DECL)
+ return m2type_IsGccStrictTypeEquivalent (left, TREE_TYPE (right));
+ if (left_code == RECORD_TYPE && right_code == CONSTRUCTOR)
+ return check_record_fields (left, right);
+ if (left_code == UNION_TYPE && right_code == CONSTRUCTOR)
+ return false;
+ if (left_code == ARRAY_TYPE && right_code == CONSTRUCTOR)
+ return check_array_types (right);
+ if (right_code == STRING_CST)
+ return false;
+ return true;
+}
+
#include "gt-m2-m2type.h"
diff --git a/gcc/m2/gm2-gcc/m2type.def b/gcc/m2/gm2-gcc/m2type.def
index 797335e00704..f74888e315ef 100644
--- a/gcc/m2/gm2-gcc/m2type.def
+++ b/gcc/m2/gm2-gcc/m2type.def
@@ -996,4 +996,12 @@ PROCEDURE IsAddress (type: tree) : BOOLEAN ;
PROCEDURE SameRealType (a, b: tree) : BOOLEAN ;
+(*
+ IsGccStrictTypeEquivalent - return true if left and right and
+ all their contents have the same type.
+*)
+
+PROCEDURE IsGccStrictTypeEquivalent (left, right: tree) : BOOLEAN ;
+
+
END m2type.
diff --git a/gcc/m2/gm2-gcc/m2type.h b/gcc/m2/gm2-gcc/m2type.h
index 04370d63e2bd..663af3ce7eb8 100644
--- a/gcc/m2/gm2-gcc/m2type.h
+++ b/gcc/m2/gm2-gcc/m2type.h
@@ -210,10 +210,10 @@ EXTERN tree m2type_gm2_type_for_size (unsigned int bits,
int unsignedp);
EXTERN tree m2type_BuildProcTypeParameterDeclaration (location_t location,
tree type,
bool isreference);
-EXTERN int m2type_IsAddress (tree type);
+EXTERN bool m2type_IsAddress (tree type);
EXTERN tree m2type_GetCardinalAddressType (void);
EXTERN bool m2type_SameRealType (tree a, tree b);
-
+EXTERN bool m2type_IsGccStrictTypeEquivalent (tree left, tree right);
#undef EXTERN
#endif /* m2type_h */
