PR modula2/111955 introduce isnan support to Builtins.def

This patch introduces isnan, isnanf and isnanl to Builtins.def.
It requires fallback functions isnan, isnanf, isnanl to be implemented in
libgm2/libm2pim/wrapc.cc and gm2-libs-ch/wrapc.c.
Access to the GCC builtin isnan tree is provided by adding
an isnan definition and support functions to gm2-gcc/m2builtins.cc.

gcc/m2/ChangeLog:

	PR modula2/111955
	* gm2-gcc/m2builtins.cc (gm2_isnan_node): New tree.
	(DoBuiltinIsnan): New function.
	(m2builtins_BuiltInIsnan): New function.
	(m2builtins_init): Initialize gm2_isnan_node.
	(list_of_builtins): Add define for __builtin_isnan.
	* gm2-libs-ch/wrapc.c (wrapc_isnan): New function.
	(wrapc_isnanf): New function.
	(wrapc_isnanl): New function.
	* gm2-libs/Builtins.def (isnanf): New procedure function.
	(isnan): New procedure function.
	(isnanl): New procedure function.
	* gm2-libs/Builtins.mod:
	* gm2-libs/wrapc.def (isnan): New function.
	(isnanf): New function.
	(isnanl): New function.

libgm2/ChangeLog:

	PR modula2/111955
	* libm2pim/wrapc.cc (isnan): Export new function.
	(isnanf): Export new function.
	(isnanl): Export new function.

gcc/testsuite/ChangeLog:

	PR modula2/111955
	* gm2/pimlib/run/pass/testnan.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

7 files changed, 152 insertions, 5 deletions

diff --git a/gcc/m2/gm2-gcc/m2builtins.cc b/gcc/m2/gm2-gcc/m2builtins.cc
index 8774ee7f32c..bcf9a0273d4 100644
--- a/gcc/m2/gm2-gcc/m2builtins.cc
+++ b/gcc/m2/gm2-gcc/m2builtins.cc
@@ -145,6 +145,8 @@ static struct builtin_function_entry list_of_builtins[] = {
     BUILT_IN_NORMAL, "memcpy", NULL, NULL, bf_default_lib },
   { "__builtin_isfinite", BT_FN_INT_DOUBLE, BUILT_IN_ISFINITE, BUILT_IN_NORMAL,
     "isfinite", NULL, NULL, bf_gcc },
+  { "__builtin_isnan", BT_FN_INT_DOUBLE, BUILT_IN_ISNAN, BUILT_IN_NORMAL,
+    "isnan", NULL, NULL, bf_gcc },
   { "__builtin_sinf", BT_FN_FLOAT_FLOAT, BUILT_IN_SINF, BUILT_IN_NORMAL,
     "sinf", NULL, NULL, bf_c99_c90res },
   { "__builtin_sin", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SIN, BUILT_IN_NORMAL, "sin",
@@ -408,6 +410,7 @@ static GTY (()) tree gm2_alloca_node;
 static GTY (()) tree gm2_memcpy_node;
 static GTY (()) tree gm2_memset_node;
 static GTY (()) tree gm2_isfinite_node;
+static GTY (()) tree gm2_isnan_node;
 static GTY (()) tree gm2_huge_valf_node;
 static GTY (()) tree gm2_huge_val_node;
 static GTY (()) tree gm2_huge_vall_node;
@@ -421,6 +424,7 @@ static tree DoBuiltinAlloca (location_t location, tree n);
 static tree DoBuiltinMemCopy (location_t location, tree dest, tree src,
                               tree n);
 static tree DoBuiltinIsfinite (location_t location, tree value);
+static tree DoBuiltinIsnan (location_t location, tree value);
 static void create_function_prototype (location_t location,
                                        struct builtin_function_entry *fe);
 static tree doradix (location_t location, tree type);
@@ -830,6 +834,15 @@ m2builtins_BuiltInIsfinite (location_t location, tree expression)
   return DoBuiltinIsfinite (location, expression);
 }
 
+/* BuiltInIsnan - return integer 1 if the real expression is
+   nan otherwise return integer 0.  */
+
+tree
+m2builtins_BuiltInIsnan (location_t location, tree expression)
+{
+  return DoBuiltinIsnan (location, expression);
+}
+
 
 /* do_target_support_exists returns true if the builting function
    is supported by the target.  */
@@ -969,6 +982,17 @@ DoBuiltinIsfinite (location_t location, tree value)
   return call;
 }
 
+static tree
+DoBuiltinIsnan (location_t location, tree value)
+{
+  tree functype = TREE_TYPE (gm2_isnan_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_isnan_node);
+  tree call = m2treelib_DoCall1 (location, ptr_type_node, funcptr, value);
+
+  return call;
+}
+
 tree
 m2builtins_BuiltInHugeVal (location_t location)
 {
@@ -1404,6 +1428,7 @@ m2builtins_init (location_t location)
   gm2_huge_val_node = find_builtin_tree ("__builtin_huge_val");
   gm2_huge_vall_node = find_builtin_tree ("__builtin_huge_vall");
   gm2_isfinite_node = find_builtin_tree ("__builtin_isfinite");
+  gm2_isnan_node = find_builtin_tree ("__builtin_isnan");
   m2block_popGlobalScope ();
 }
 
diff --git a/gcc/m2/gm2-libs-ch/wrapc.c b/gcc/m2/gm2-libs-ch/wrapc.c
index 51cbbf79e0b..fdb51cd64e1 100644
--- a/gcc/m2/gm2-libs-ch/wrapc.c
+++ b/gcc/m2/gm2-libs-ch/wrapc.c
@@ -225,6 +225,33 @@ wrapc_isfinitef (float x)
   return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
 }
 
+/* isnan - provide non builtin alternative to the gcc builtin isnan.
+   Returns 1 if x is a NaN otherwise return 0.  */
+
+int
+wrapc_isnan (double x)
+{
+  return isnan (x);
+}
+
+/* isnanf - provide non builtin alternative to the gcc builtin isnanf.
+   Returns 1 if x is a NaN otherwise return 0.  */
+
+int
+wrapc_isnanf (float x)
+{
+  return isnan (x);
+}
+
+/* isnanl - provide non builtin alternative to the gcc builtin isnanl.
+   Returns 1 if x is a NaN otherwise return 0.  */
+
+int
+wrapc_isnanl (long double x)
+{
+  return isnan (x);
+}
+
 /* init - init/finish functions for the module */
 
 void
diff --git a/gcc/m2/gm2-libs/Builtins.def b/gcc/m2/gm2-libs/Builtins.def
index 651ade580cb..8660976037e 100644
--- a/gcc/m2/gm2-libs/Builtins.def
+++ b/gcc/m2/gm2-libs/Builtins.def
@@ -30,6 +30,10 @@ FROM SYSTEM IMPORT ADDRESS ;
 
 (* floating point intrinsic procedure functions *)
 
+PROCEDURE __BUILTIN__ isnanf (x: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isnan (x: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isnanl (x: LONGREAL) : INTEGER ;
+
 PROCEDURE __BUILTIN__ isfinitef (x: SHORTREAL) : INTEGER ;
 PROCEDURE __BUILTIN__ isfinite (x: REAL) : INTEGER ;
 PROCEDURE __BUILTIN__ isfinitel (x: LONGREAL) : INTEGER ;
diff --git a/gcc/m2/gm2-libs/Builtins.mod b/gcc/m2/gm2-libs/Builtins.mod
index 707f0e366ac..4efe47f9bfe 100644
--- a/gcc/m2/gm2-libs/Builtins.mod
+++ b/gcc/m2/gm2-libs/Builtins.mod
@@ -58,6 +58,22 @@ BEGIN
    RETURN cbuiltin.memcpy (dest, src, nbytes)
 END memcpy ;
 
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnan)) isnanf (x: SHORTREAL) : INTEGER ;
+BEGIN
+   RETURN wrapc.isnanf (x)
+END isnanf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnan)) isnan (x: REAL) : INTEGER ;
+BEGIN
+   RETURN wrapc.isnan (x)
+END isnan ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnan)) isnanl (x: LONGREAL) : INTEGER ;
+BEGIN
+   RETURN wrapc.isnanl (x)
+END isnanl ;
+
 PROCEDURE __ATTRIBUTE__  __BUILTIN__ ((__builtin_isfinite)) isfinitef (x: SHORTREAL) : INTEGER ;
 BEGIN
    RETURN wrapc.isfinitef (x)
diff --git a/gcc/m2/gm2-libs/wrapc.def b/gcc/m2/gm2-libs/wrapc.def
index 90c14d128fb..238d52dc5b4 100644
--- a/gcc/m2/gm2-libs/wrapc.def
+++ b/gcc/m2/gm2-libs/wrapc.def
@@ -28,11 +28,6 @@ DEFINITION MODULE wrapc ;
 
 FROM SYSTEM IMPORT ADDRESS ;
 
-EXPORT QUALIFIED strtime, filesize, fileinode,
-                 getrand, getusername, filemtime,
-                 getnameuidgid, signbit, signbitf, signbitl,
-		 isfinite, isfinitel, isfinitef ;
-
 
 (*
    strtime - returns the C string for the equivalent C asctime
@@ -121,4 +116,28 @@ PROCEDURE isfinitef (x: SHORTREAL) : INTEGER ;
 PROCEDURE isfinitel (x: LONGREAL) : INTEGER ;
 
 
+(*
+   isnan - provide non builtin alternative to the gcc builtin isnan.
+           Returns 1 if x is a NaN otherwise return 0.
+*)
+
+PROCEDURE isnan (x: REAL) : INTEGER ;
+
+
+(*
+   isnanf - provide non builtin alternative to the gcc builtin isnanf.
+            Returns 1 if x is a NaN otherwise return 0.
+*)
+
+PROCEDURE isnanf (x: SHORTREAL) : INTEGER ;
+
+
+(*
+   isnanl - provide non builtin alternative to the gcc builtin isnanl.
+            Returns 1 if x is a NaN otherwise return 0.
+*)
+
+PROCEDURE isnanl (x: LONGREAL) : INTEGER ;
+
+
 END wrapc.
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/testnan.mod b/gcc/testsuite/gm2/pimlib/run/pass/testnan.mod
new file mode 100644
index 00000000000..d3c061f5681
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/testnan.mod
@@ -0,0 +1,17 @@
+MODULE testnan ;
+
+FROM Builtins IMPORT isnan ;
+FROM libc IMPORT printf, exit ;
+
+VAR
+   x: REAL ;
+BEGIN
+   x := 0.0 / 0.0 ;
+   IF isnan (x) = 1
+   THEN
+      printf ("success isnan working from module Builtins\n")
+   ELSE
+      printf ("failure isnan is not working from module Builtins\n") ;
+      exit (1)
+   END
+END testnan.
diff --git a/libgm2/libm2pim/wrapc.cc b/libgm2/libm2pim/wrapc.cc
index c24d214649e..4d930509037 100644
--- a/libgm2/libm2pim/wrapc.cc
+++ b/libgm2/libm2pim/wrapc.cc
@@ -277,6 +277,45 @@ EXPORT(isfinitef) (float x)
 #endif
 }
 
+/* isnan - provide non builtin alternative to the gcc builtin isnan.
+   Returns 1 if x is a NaN otherwise return 0.  */
+
+extern "C" int
+EXPORT(isnan) (double x)
+{
+#if defined(FP_NAN)
+  return fpclassify (x) == FP_NAN;
+#else
+  return x != x;
+#endif
+}
+
+/* isnanf - provide non builtin alternative to the gcc builtin isnanf.
+   Returns 1 if x is a NaN otherwise return 0.  */
+
+extern "C" int
+EXPORT(isnanf) (float x)
+{
+#if defined(FP_NAN)
+  return fpclassify (x) == FP_NAN;
+#else
+  return x != x;
+#endif
+}
+
+/* isnanl - provide non builtin alternative to the gcc builtin isnanl.
+   Returns 1 if x is a NaN otherwise return 0.  */
+
+extern "C" int
+EXPORT(isnanl) (long double x)
+{
+#if defined(FP_NAN)
+  return fpclassify (x) == FP_NAN;
+#else
+  return x != x;
+#endif
+}
+
 /* GNU Modula-2 linking hooks.  */
 
 extern "C" void