10 files changed, 247 insertions, 20 deletions
diff --git a/gcc/m2/gm2-gcc/m2builtins.cc b/gcc/m2/gm2-gcc/m2builtins.cc
index 175c62a..cb9ef65 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;
@@ -1040,6 +1041,18 @@ DoBuiltinMemCopy (location_t location, tree dest, tree src, tree bytes)
 }
 
 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)
 {
   tree functype = TREE_TYPE (gm2_alloca_node);
@@ -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 61f769d..5ab5a6d 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 37bdbfa..017d2df 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/m2pp.cc b/gcc/m2/gm2-gcc/m2pp.cc
index 6ec8aaa..7d4adb8 100644
--- a/gcc/m2/gm2-gcc/m2pp.cc
+++ b/gcc/m2/gm2-gcc/m2pp.cc
@@ -2367,7 +2367,6 @@ m2pp_asm_expr (pretty *state, tree node)
 static void
 m2pp_nop_expr (pretty *state, tree t)
 {
-  enum tree_code code = TREE_CODE (t);
   m2pp_begin (state);
   m2pp_print (state, "(* NOP for debug location *)");
   m2pp_needspace (state);
diff --git a/gcc/m2/gm2-gcc/m2statement.cc b/gcc/m2/gm2-gcc/m2statement.cc
index d42183f..7952984 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 074b768..ffaf697 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 db2daf3..0076b32 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 a946509..e486f12 100644
--- a/gcc/m2/gm2-gcc/m2type.cc
+++ b/gcc/m2/gm2-gcc/m2type.cc
@@ -1891,6 +1891,22 @@ m2type_GetDefaultType (location_t location, char *name, tree type)
     return id;
 }
 
+/* IsGccRealType return true if type is a GCC realtype.  */
+  
+static
+bool
+IsGccRealType (tree type)
+{
+  return (type == m2_real_type_node || type == m2type_GetRealType () ||
+	  type == m2_long_real_type_node || type == m2type_GetLongRealType () ||
+	  type == m2_short_real_type_node || type == m2type_GetShortRealType () ||
+	  type == m2type_GetM2Real32 () ||
+	  type == m2type_GetM2Real64 () ||
+	  type == m2type_GetM2Real96 () ||
+	  type == m2type_GetM2Real128 ());
+}
+
+static
 tree
 do_min_real (tree type)
 {
@@ -1911,11 +1927,7 @@ m2type_GetMinFrom (location_t location, tree type)
 {
   m2assert_AssertLocation (location);
 
-  if (type == m2_real_type_node || type == m2type_GetRealType ())
-    return do_min_real (type);
-  if (type == m2_long_real_type_node || type == m2type_GetLongRealType ())
-    return do_min_real (type);
-  if (type == m2_short_real_type_node || type == m2type_GetShortRealType ())
+  if (IsGccRealType (type))
     return do_min_real (type);
   if (type == ptr_type_node)
     return m2expr_GetPointerZero (location);
@@ -1923,6 +1935,7 @@ m2type_GetMinFrom (location_t location, tree type)
   return TYPE_MIN_VALUE (m2tree_skip_type_decl (type));
 }
 
+static      
 tree
 do_max_real (tree type)
 {
@@ -1943,11 +1956,7 @@ m2type_GetMaxFrom (location_t location, tree type)
 {
   m2assert_AssertLocation (location);
 
-  if (type == m2_real_type_node || type == m2type_GetRealType ())
-    return do_max_real (type);
-  if (type == m2_long_real_type_node || type == m2type_GetLongRealType ())
-    return do_max_real (type);
-  if (type == m2_short_real_type_node || type == m2type_GetShortRealType ())
+  if (IsGccRealType (type))
     return do_max_real (type);
   if (type == ptr_type_node)
     return fold (m2expr_BuildSub (location, m2expr_GetPointerZero (location),
@@ -3105,10 +3114,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 797335e..f74888e 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 04370d6..663af3c 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  */