https://gcc.gnu.org/g:b1af867d22e3108402c62f97d8fcd1df303c9dab
commit r14-9675-gb1af867d22e3108402c62f97d8fcd1df303c9dab
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Tue Mar 26 15:33:52 2024 +0000
PR modula2/114478 isnormal builtin unavailable from m2
This patch adds isnormal (and isgreater, isless, isgreaterequal,
islessequal, islessgreater, isunordered) c99 macro similar prototyped
builtins to m2.
gcc/m2/ChangeLog:
PR modula2/114478
* gm2-gcc/m2builtins.cc (struct builtin_macro_definition): New
struct.
(lookup_builtin_macro): New function.
(m2builtins_BuildBuiltinTree): Rewrite to lookup builtin function
and builtin macro.
(lookup_builtin_function): New function.
(define_builtin): Rename parameter type to prototype push macro
definition to builtin_macros vector.
(define_builtin_ext): New function.
(define_builtin_math): New function.
(m2builtins_init): Add isgreater, isless, isgreaterequal,
islessequal, islessgreater, isunordered, isnormal to macro
definitions.
* gm2-libs/Builtins.def (isgreater): New procedure function.
(isgreaterf): Ditto.
(isgreaterl): Ditto.
(isgreaterequal): Ditto.
(isgreaterequalf): Ditto.
(isgreaterequall): Ditto.
(isless): Ditto.
(islessf): Ditto.
(islessl): Ditto.
(islessequal): Ditto.
(islessequalf): Ditto.
(islessequall): Ditto.
(islessgreater): Ditto.
(islessgreaterf): Ditto.
(islessgreaterl): Ditto.
(isunordered): Ditto.
(isunorderedf): Ditto.
(isunorderedl): Ditto.
(iseqsig): Ditto.
(iseqsigf): Ditto.
(iseqsigl): Ditto.
(isnormal): Ditto.
(isnormalf): Ditto.
(isnormall): Ditto.
(isinf_sign): Ditto.
(isinf_signf): Ditto.
(isinf_signl): Ditto.
* gm2-libs/Builtins.mod (isgreater): New procedure function.
(isgreaterf): Ditto.
(isgreaterl): Ditto.
(isgreaterequal): Ditto.
(isgreaterequalf): Ditto.
(isgreaterequall): Ditto.
(isless): Ditto.
(islessf): Ditto.
(islessl): Ditto.
(islessequal): Ditto.
(islessequalf): Ditto.
(islessequall): Ditto.
(islessgreater): Ditto.
(islessgreaterf): Ditto.
(islessgreaterl): Ditto.
(isunordered): Ditto.
(isunorderedf): Ditto.
(isunorderedl): Ditto.
(iseqsig): Ditto.
(iseqsigf): Ditto.
(iseqsigl): Ditto.
(isnormal): Ditto.
(isnormalf): Ditto.
(isnormall): Ditto.
(isinf_sign): Ditto.
(isinf_signf): Ditto.
(isinf_signl): Ditto.
gcc/testsuite/ChangeLog:
PR modula2/114478
* gm2/builtins/run/pass/builtins-run-pass.exp: New test.
* gm2/builtins/run/pass/testcomparisons.mod: New test.
* gm2/builtins/run/pass/testisnormal.mod: New test.
* gm2/pimlib/run/pass/testchar.mod: New test.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-gcc/m2builtins.cc | 147 +++++++++++++++----
gcc/m2/gm2-libs/Builtins.def | 40 ++++-
gcc/m2/gm2-libs/Builtins.mod | 161 +++++++++++++++++++--
.../gm2/builtins/run/pass/builtins-run-pass.exp | 36 +++++
.../gm2/builtins/run/pass/testcomparisons.mod | 77 ++++++++++
.../gm2/builtins/run/pass/testisnormal.mod | 49 +++++++
gcc/testsuite/gm2/pimlib/run/pass/testchar.mod | 71 +++++++++
7 files changed, 539 insertions(+), 42 deletions(-)
diff --git a/gcc/m2/gm2-gcc/m2builtins.cc b/gcc/m2/gm2-gcc/m2builtins.cc
index e4fc6a50c1c..cfb4751e15a 100644
--- a/gcc/m2/gm2-gcc/m2builtins.cc
+++ b/gcc/m2/gm2-gcc/m2builtins.cc
@@ -393,6 +393,13 @@ struct builtin_type_info
tree (*functionHandler) (location_t, tree);
};
+struct GTY(()) builtin_macro_definition
+{
+ const char *name;
+ tree function_node;
+ tree return_node;
+};
+
static GTY (()) tree sizetype_endlink;
static GTY (()) tree unsigned_endlink;
static GTY (()) tree endlink;
@@ -418,6 +425,7 @@ static GTY (()) tree long_doubleptr_type_node;
static GTY (()) tree doubleptr_type_node;
static GTY (()) tree floatptr_type_node;
static GTY (()) tree builtin_ftype_int_var;
+static GTY (()) vec<builtin_macro_definition, va_gc> *builtin_macros;
/* Prototypes for locally defined functions. */
static tree DoBuiltinAlloca (location_t location, tree n);
@@ -916,21 +924,45 @@ m2builtins_BuiltinExists (char *name)
if (strcmp (name, fe->name) == 0)
return true;
// return target_support_exists (fe);
-
+ int length = vec_safe_length (builtin_macros);
+ for (int idx = 0; idx < length; idx++)
+ if (strcmp ((*builtin_macros)[idx].name, name) == 0)
+ return true;
return false;
}
+/* lookup_builtin_function returns a builtin macro. */
-/* BuildBuiltinTree - returns a Tree containing the builtin function,
- name. */
+static
+tree
+lookup_builtin_macro (location_t location, char *name)
+{
+ int length = vec_safe_length (builtin_macros);
+ for (int idx = 0; idx < length; idx++)
+ if (strcmp ((*builtin_macros)[idx].name, name) == 0)
+ {
+ tree functype = TREE_TYPE ((*builtin_macros)[idx].function_node);
+ tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype),
+ (*builtin_macros)[idx].function_node);
+ tree call = m2treelib_DoCall (
+ location, (*builtin_macros)[idx].return_node,
+ funcptr, m2statement_GetParamList ());
+ m2statement_SetLastFunction (call);
+ m2statement_SetParamList (NULL_TREE);
+ if ((*builtin_macros)[idx].return_node == void_type_node)
+ m2statement_SetLastFunction (NULL_TREE);
+ return call;
+ }
+ return NULL_TREE;
+}
+
+/* lookup_builtin_function returns a builtin function. */
+static
tree
-m2builtins_BuildBuiltinTree (location_t location, char *name)
+lookup_builtin_function (location_t location, char *name)
{
struct builtin_function_entry *fe;
- tree call;
-
- m2statement_SetLastFunction (NULL_TREE);
for (fe = &list_of_builtins[0]; fe->name != NULL; fe++)
if ((strcmp (name, fe->name) == 0) && target_support_exists (fe))
@@ -938,7 +970,7 @@ m2builtins_BuildBuiltinTree (location_t location, char
*name)
tree functype = TREE_TYPE (fe->function_node);
tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype),
fe->function_node);
- call = m2treelib_DoCall (
+ tree call = m2treelib_DoCall (
location, fe->return_node, funcptr, m2statement_GetParamList ());
m2statement_SetLastFunction (call);
m2statement_SetParamList (NULL_TREE);
@@ -946,9 +978,29 @@ m2builtins_BuildBuiltinTree (location_t location, char
*name)
m2statement_SetLastFunction (NULL_TREE);
return call;
}
+ return NULL_TREE;
+}
+
+/* BuildBuiltinTree - returns a Tree containing the builtin function,
+ name. */
+
+tree
+m2builtins_BuildBuiltinTree (location_t location, char *name)
+{
+ tree call;
+ m2statement_SetLastFunction (NULL_TREE);
- m2statement_SetParamList (NULL_TREE);
- return m2statement_GetLastFunction ();
+ call = lookup_builtin_function (location, name);
+ if (call == NULL_TREE)
+ {
+ call = lookup_builtin_macro (location, name);
+ if (call == NULL_TREE)
+ {
+ m2statement_SetParamList (NULL_TREE);
+ return m2statement_GetLastFunction ();
+ }
+ }
+ return call;
}
static tree
@@ -1347,14 +1399,16 @@ set_decl_function_code (tree decl, built_in_function f)
}
/* Define a single builtin. */
+
static void
-define_builtin (enum built_in_function val, const char *name, tree type,
+define_builtin (enum built_in_function val, const char *name, tree prototype,
const char *libname, int flags)
{
tree decl;
+ builtin_macro_definition bmd;
decl = build_decl (BUILTINS_LOCATION, FUNCTION_DECL, get_identifier (name),
- type);
+ prototype);
DECL_EXTERNAL (decl) = 1;
TREE_PUBLIC (decl) = 1;
SET_DECL_ASSEMBLER_NAME (decl, get_identifier (libname));
@@ -1362,8 +1416,43 @@ define_builtin (enum built_in_function val, const char
*name, tree type,
set_decl_built_in_class (decl, BUILT_IN_NORMAL);
set_decl_function_code (decl, val);
set_call_expr_flags (decl, flags);
-
set_builtin_decl (val, decl, true);
+ bmd.name = name;
+ bmd.function_node = decl;
+ bmd.return_node = TREE_TYPE (prototype);
+ vec_safe_push (builtin_macros, bmd);
+}
+
+/* Define a math type variant of the builtin function. */
+
+static
+void
+define_builtin_ext (enum built_in_function val, const char *name, tree type,
+ const char *libname, int flags, const char *ext)
+{
+ char *newname = (char *) xmalloc (strlen (name) + strlen (ext) + 1);
+ char *newlibname = (char *) xmalloc (strlen (libname) + strlen (ext) + 1);
+ strcpy (newname, name);
+ strcat (newname, ext);
+ strcpy (newlibname, libname);
+ strcat (newlibname, ext);
+ define_builtin (val, newname, type, newlibname, flags);
+}
+
+/* Define all support math type versions of this builtin. */
+
+static void
+define_builtin_math (enum built_in_function val, const char *name, tree type,
+ const char *libname, int flags)
+{
+ /* SHORTREAL version. */
+ define_builtin_ext (val, name, type, libname, flags, "f");
+ /* LONGREAL version. */
+ define_builtin_ext (val, name, type, libname, flags, "l");
+ /* REAL version. */
+ define_builtin (val, name, type, libname, flags);
+ /* Perhaps it should declare SYSTEM.def types size floating point
+ versions as well? */
}
void
@@ -1408,20 +1497,24 @@ m2builtins_init (location_t location)
define_builtin (BUILT_IN_TRAP, "__builtin_trap",
build_function_type_list (void_type_node, NULL_TREE),
"__builtin_trap", ECF_NOTHROW | ECF_LEAF | ECF_NORETURN);
- define_builtin (BUILT_IN_ISGREATER, "isgreater", builtin_ftype_int_var,
- "__builtin_isgreater", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISGREATEREQUAL, "isgreaterequal",
- builtin_ftype_int_var, "__builtin_isgreaterequal",
- ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISLESS, "isless", builtin_ftype_int_var,
- "__builtin_isless", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISLESSEQUAL, "islessequal", builtin_ftype_int_var,
- "__builtin_islessequal", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISLESSGREATER, "islessgreater",
- builtin_ftype_int_var, "__builtin_islessgreater",
- ECF_CONST | ECF_NOTHROW | ECF_LEAF);
- define_builtin (BUILT_IN_ISUNORDERED, "isunordered", builtin_ftype_int_var,
- "__builtin_isunordered", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISGREATER, "isgreater", builtin_ftype_int_var,
+ "__builtin_isgreater", ECF_CONST | ECF_NOTHROW |
ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISGREATEREQUAL, "isgreaterequal",
+ builtin_ftype_int_var, "__builtin_isgreaterequal",
+ ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISLESS, "isless", builtin_ftype_int_var,
+ "__builtin_isless", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISLESSEQUAL, "islessequal",
builtin_ftype_int_var,
+ "__builtin_islessequal", ECF_CONST | ECF_NOTHROW |
ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISLESSGREATER, "islessgreater",
+ builtin_ftype_int_var, "__builtin_islessgreater",
+ ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISUNORDERED, "isunordered",
builtin_ftype_int_var,
+ "__builtin_isunordered", ECF_CONST | ECF_NOTHROW |
ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISNORMAL, "isnormal", builtin_ftype_int_var,
+ "__builtin_isnormal", ECF_CONST | ECF_NOTHROW |
ECF_LEAF);
+ define_builtin_math (BUILT_IN_ISINF_SIGN, "isinf_sign",
builtin_ftype_int_var,
+ "__builtin_isinf_sign", ECF_CONST | ECF_NOTHROW |
ECF_LEAF);
gm2_alloca_node = find_builtin_tree ("__builtin_alloca");
gm2_memcpy_node = find_builtin_tree ("__builtin_memcpy");
diff --git a/gcc/m2/gm2-libs/Builtins.def b/gcc/m2/gm2-libs/Builtins.def
index 3e1cb29d157..2ad66030e39 100644
--- a/gcc/m2/gm2-libs/Builtins.def
+++ b/gcc/m2/gm2-libs/Builtins.def
@@ -28,7 +28,7 @@ DEFINITION MODULE Builtins ;
FROM SYSTEM IMPORT ADDRESS ;
-(* floating point intrinsic procedure functions *)
+(* Floating point intrinsic procedure functions. *)
PROCEDURE __BUILTIN__ isnanf (x: SHORTREAL) : INTEGER ;
PROCEDURE __BUILTIN__ isnan (x: REAL) : INTEGER ;
@@ -107,7 +107,43 @@ PROCEDURE __BUILTIN__ scalbn (x: REAL; n: INTEGER) : REAL ;
PROCEDURE __BUILTIN__ scalbnf (x: SHORTREAL; n: INTEGER) : SHORTREAL ;
PROCEDURE __BUILTIN__ scalbnl (x: LONGREAL; n: INTEGER) : LONGREAL ;
-(* complex arithmetic intrincic procedure functions *)
+PROCEDURE __BUILTIN__ isgreater (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isgreaterf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isgreaterl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isgreaterequal (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isgreaterequalf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isgreaterequall (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isless (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ islessequal (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessequalf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessequall (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ islessgreater (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessgreaterf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ islessgreaterl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isunordered (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isunorderedf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isunorderedl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ iseqsig (x, y: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ iseqsigf (x, y: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ iseqsigl (x, y: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isnormal (r: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isnormalf (s: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isnormall (l: LONGREAL) : INTEGER ;
+
+PROCEDURE __BUILTIN__ isinf_sign (r: REAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isinf_signf (s: SHORTREAL) : INTEGER ;
+PROCEDURE __BUILTIN__ isinf_signl (l: LONGREAL) : INTEGER ;
+
+(* Complex arithmetic intrincic procedure functions. *)
PROCEDURE __BUILTIN__ cabsf (z: SHORTCOMPLEX) : SHORTREAL ;
PROCEDURE __BUILTIN__ cabs (z: COMPLEX) : REAL ;
diff --git a/gcc/m2/gm2-libs/Builtins.mod b/gcc/m2/gm2-libs/Builtins.mod
index 457ee92c282..8079dc13565 100644
--- a/gcc/m2/gm2-libs/Builtins.mod
+++ b/gcc/m2/gm2-libs/Builtins.mod
@@ -33,7 +33,7 @@ PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_alloca))
alloca (i: CARDINAL) :
BEGIN
(* This routine will never be called as it allocates memory on
top of the current stack frame, which is automatically
- deallocated upon its return. *)
+ deallocated upon its return. *)
HALT ;
RETURN NIL
END alloca ;
@@ -43,18 +43,17 @@ BEGIN
(* this routine is only called if -fdebug-builtins is supplied
on the command line. The purpose of this routine is to allow
a developer to single step into this routine and inspect the
- value of, nBytes, and, returned.
- *)
+ value of nBytes and returned. *)
RETURN returned
END alloca_trace ;
-PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_memcpy)) memcpy (dest, src:
ADDRESS; nbytes: CARDINAL) : ADDRESS ;
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_memcpy))
+ memcpy (dest, src: ADDRESS; nbytes: CARDINAL) : ADDRESS ;
BEGIN
- (* hopefully the compiler will choose to use the __builtin_memcpy function
within GCC.
- This call is here just in case it cannot. Ie if the user sets a
procedure variable to
- memcpy, then clearly the compiler cannot inline such a call and thus it
will
- be forced into calling this function.
- *)
+ (* Hopefully the compiler will choose to use the __builtin_memcpy
+ function within GCC. This call is here just in case it cannot.
+ If the user sets a procedure variable to memcpy then the
+ code below could be run instead. *)
RETURN cbuiltin.memcpy (dest, src, nbytes)
END memcpy ;
@@ -629,18 +628,154 @@ BEGIN
RETURN -1.0
END huge_valf ;
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreater)) isgreater (x, y:
REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreater ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterf)) isgreaterf (x, y:
SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterl)) isgreaterl (x, y:
LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterequal))
isgreaterequal (x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterequal ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterequalf))
isgreaterequalf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterequalf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isgreaterequall))
isgreaterequall (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isgreaterequall ;
+
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isless)) isless (x, y: REAL) :
INTEGER ;
+BEGIN
+ RETURN 1
+END isless ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessf)) islessf (x, y:
SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessl)) islessl (x, y:
LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessequal)) islessequal (x,
y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessequal ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessequalf)) islessequalf
(x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessequalf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessequall)) islessequall
(x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessequall ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessgreater)) islessgreater
(x, y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessgreater ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessgreaterf))
islessgreaterf (x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessgreaterf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_islessgreaterl))
islessgreaterl (x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END islessgreaterl ;
+
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isunordered)) isunordered (x,
y: REAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isunordered ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isunorderedf)) isunorderedf
(x, y: SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isunorderedf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isunorderedl)) isunorderedl
(x, y: LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isunorderedl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_iseqsig)) iseqsig (x, y: REAL)
: INTEGER ;
+BEGIN
+ RETURN 1
+END iseqsig ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_iseqsigf)) iseqsigf (x, y:
SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END iseqsigf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_iseqsigl)) iseqsigl (x, y:
LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END iseqsigl ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnormal)) isnormal (r: REAL)
: INTEGER ;
+BEGIN
+ RETURN 1
+END isnormal ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnormalf)) isnormalf (s:
SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isnormalf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isnormall)) isnormall (l:
LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isnormall ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isinf)) isinf_sign (r: REAL) :
INTEGER ;
+BEGIN
+ RETURN 1
+END isinf_sign ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isinf_signf)) isinf_signf (s:
SHORTREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isinf_signf ;
+
+PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_isinf)) isinf_signl (l:
LONGREAL) : INTEGER ;
+BEGIN
+ RETURN 1
+END isinf_signl ;
+
PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_longjmp)) longjmp (env:
ADDRESS; val: INTEGER) ;
BEGIN
- (* empty, replaced internally by gcc *)
+ (* Empty, replaced internally by gcc. *)
END longjmp ;
PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_setjmp)) setjmp (env: ADDRESS)
: INTEGER ;
BEGIN
- (* empty, replaced internally by gcc *)
- RETURN 0 (* keeps gm2 happy *)
+ (* Empty, replaced internally by gcc. *)
+ RETURN 0 (* Keep -Wreturn-type happy. *)
END setjmp ;
-
(*
frame_address - returns the address of the frame.
The current frame is obtained if level is 0,
diff --git a/gcc/testsuite/gm2/builtins/run/pass/builtins-run-pass.exp
b/gcc/testsuite/gm2/builtins/run/pass/builtins-run-pass.exp
new file mode 100644
index 00000000000..7efea06e30e
--- /dev/null
+++ b/gcc/testsuite/gm2/builtins/run/pass/builtins-run-pass.exp
@@ -0,0 +1,36 @@
+# Copyright (C) 2024 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaiusm...@gmail.com)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+load_lib gm2-torture.exp
+
+gm2_init_pim "${srcdir}/gm2/builtins/run/pass"
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+
+ gm2-torture-execute $testcase "" "pass"
+}
diff --git a/gcc/testsuite/gm2/builtins/run/pass/testcomparisons.mod
b/gcc/testsuite/gm2/builtins/run/pass/testcomparisons.mod
new file mode 100644
index 00000000000..85f81fc7b82
--- /dev/null
+++ b/gcc/testsuite/gm2/builtins/run/pass/testcomparisons.mod
@@ -0,0 +1,77 @@
+MODULE testcomparisons ;
+
+
+FROM libc IMPORT printf, exit ;
+FROM Builtins IMPORT isgreater, isless, islessequal, isgreaterequal ;
+FROM SYSTEM IMPORT ADR ;
+
+
+(*
+ assert -
+*)
+
+PROCEDURE assert (value: BOOLEAN; message: ARRAY OF CHAR) ;
+BEGIN
+ IF NOT value
+ THEN
+ printf ("test failed: %s\n", ADR (message)) ;
+ code := 1
+ END
+END assert ;
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ result: INTEGER ;
+BEGIN
+ result := isgreater (2.0, 1.0) ;
+ printf ("isgreater (2.0, 1.0) = %d\n", result) ;
+ assert (result = 1, "isgreater (2.0, 1.0) # 1") ;
+
+ result := isless (1.0, 2.0) ;
+ printf ("isless (1.0, 2.0) = %d\n", result) ;
+ assert (result = 1, "isless (1.0, 2.0) # 1") ;
+
+ result := islessequal (1.0, 2.0) ;
+ printf ("islessequal (1.0, 2.0) = %d\n", result) ;
+ assert (result = 1, "islessequal (1.0, 2.0) # 1") ;
+
+ result := isgreaterequal (2.0, 1.0) ;
+ printf ("isgreaterequal (2.0, 1.0) = %d\n", result) ;
+ assert (result = 1, "isgreatereequal (2.0, 1.0) # 1") ;
+
+ result := isgreater (1.0, 2.0) ;
+ printf ("isgreater (1.0, 2.0) = %d\n", result) ;
+ assert (result = 0, "isgreater (1.0, 2.0) # 0") ;
+
+ result := isless (2.0, 1.0) ;
+ printf ("isless (2.0, 1.0) = %d\n", result) ;
+ assert (result = 0, "isless (2.0, 1.0) # 0") ;
+
+ result := islessequal (2.0, 1.0) ;
+ printf ("islessequal (2.0, 1.0) = %d\n", result) ;
+ assert (result = 0, "islessequal (2.0, 1.0) # 0") ;
+
+ result := isgreaterequal (1.0, 2.0) ;
+ printf ("isgreaterequal (1.0, 2.0) = %d\n", result) ;
+ assert (result = 0, "isgreatereequal (1.0, 2.0) # 1")
+END test ;
+
+
+VAR
+ code: INTEGER ;
+BEGIN
+ code := 0 ;
+ test ;
+ IF code = 0
+ THEN
+ printf ("all tests pass\n")
+ ELSE
+ printf ("some tests failed\n")
+ END ;
+ exit (code)
+END testcomparisons.
diff --git a/gcc/testsuite/gm2/builtins/run/pass/testisnormal.mod
b/gcc/testsuite/gm2/builtins/run/pass/testisnormal.mod
new file mode 100644
index 00000000000..6b65a7b9b12
--- /dev/null
+++ b/gcc/testsuite/gm2/builtins/run/pass/testisnormal.mod
@@ -0,0 +1,49 @@
+MODULE testisnormal ;
+
+FROM libc IMPORT printf, exit ;
+FROM Builtins IMPORT isnormal ;
+FROM SYSTEM IMPORT ADR ;
+
+
+(*
+ assert -
+*)
+
+PROCEDURE assert (value: BOOLEAN; message: ARRAY OF CHAR) ;
+BEGIN
+ IF NOT value
+ THEN
+ printf ("test failed: %s\n", ADR (message)) ;
+ code := 1
+ END
+END assert ;
+
+
+
+(*
+ test -
+*)
+
+PROCEDURE test ;
+VAR
+ result: INTEGER ;
+BEGIN
+ result := isnormal (1.0) ;
+ printf ("isnormal (1.0) = %d\n", result) ;
+ assert (result = 1, "isnormal (1.0) # 1")
+END test ;
+
+
+VAR
+ code: INTEGER ;
+BEGIN
+ code := 0 ;
+ test ;
+ IF code = 0
+ THEN
+ printf ("all tests pass\n")
+ ELSE
+ printf ("some tests failed\n")
+ END ;
+ exit (code)
+END testisnormal.
diff --git a/gcc/testsuite/gm2/pimlib/run/pass/testchar.mod
b/gcc/testsuite/gm2/pimlib/run/pass/testchar.mod
new file mode 100644
index 00000000000..31dfd5f661f
--- /dev/null
+++ b/gcc/testsuite/gm2/pimlib/run/pass/testchar.mod
@@ -0,0 +1,71 @@
+MODULE testchar ;
+
+FROM FIO IMPORT File, OpenToWrite, OpenToRead,
+ Close, WriteChar, ReadChar, IsNoError ;
+
+FROM libc IMPORT printf, exit ;
+
+
+(*
+ createFile -
+*)
+
+PROCEDURE createFile ;
+VAR
+ fo: File ;
+ ch: CHAR ;
+BEGIN
+ fo := OpenToWrite ("test.txt") ;
+ FOR ch := MIN (CHAR) TO MAX (CHAR) DO
+ WriteChar (fo, ch) ;
+ IF NOT IsNoError (fo)
+ THEN
+ printf ("failure to write: %c\n", ch);
+ exit (1)
+ END
+ END ;
+ Close (fo)
+END createFile ;
+
+
+(*
+ readFile -
+*)
+
+PROCEDURE readFile ;
+VAR
+ fi : File ;
+ ch, in: CHAR ;
+BEGIN
+ fi := OpenToRead ("test.txt") ;
+ FOR ch := MIN (CHAR) TO MAX (CHAR) DO
+ in := ReadChar (fi) ;
+ IF NOT IsNoError (fi)
+ THEN
+ printf ("failure to read: %c\n", ch);
+ exit (1)
+ END ;
+ IF ch # in
+ THEN
+ printf ("failure to verify: %c\n", ch);
+ exit (1)
+ END
+ END ;
+ Close (fi)
+END readFile ;
+
+
+(*
+ init -
+*)
+
+PROCEDURE init ;
+BEGIN
+ createFile ;
+ readFile
+END init ;
+
+
+BEGIN
+ init
+END testchar.
