Libcalls for operations implemented in the run-time environment.
Signed-off-by: Jose E. Marchesi <[email protected]>
gcc/ChangeLog
* algol68/a68-low-runtime.cc: New file.
* algol68/a68-low-runtime.def: Likewise.
---
gcc/algol68/a68-low-runtime.cc | 225 ++++++++++++++++++++++++++++++++
gcc/algol68/a68-low-runtime.def | 91 +++++++++++++
2 files changed, 316 insertions(+)
create mode 100644 gcc/algol68/a68-low-runtime.cc
create mode 100644 gcc/algol68/a68-low-runtime.def
diff --git a/gcc/algol68/a68-low-runtime.cc b/gcc/algol68/a68-low-runtime.cc
new file mode 100644
index 00000000000..4ea93e991e1
--- /dev/null
+++ b/gcc/algol68/a68-low-runtime.cc
@@ -0,0 +1,225 @@
+/* Libcalls to Algol 68 run-time functions.
+ Copyright (C) 2006-2025 Free Software Foundation, Inc.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+ Written by Jose E. Marchesi.
+ Adapted from gcc/d/runtime.cc.
+
+ GCC 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, or (at your option)
+ any later version.
+
+ GCC 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/>. */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+
+#include "tree.h"
+#include "fold-const.h"
+#include "langhooks.h"
+#include "tm.h"
+#include "function.h"
+#include "cgraph.h"
+#include "toplev.h"
+#include "varasm.h"
+#include "predict.h"
+#include "stor-layout.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "print-tree.h"
+#include "gimplify.h"
+#include "dumpfile.h"
+#include "convert.h"
+
+#include "a68.h"
+
+/* The lowering pass may generate expressions to call various runtime library
+ functions. Most of these functions are implemented in libga68. This file
+ provides facilities to compile libcalls to runtime functions. The file
+ a68-low-runtime.def contains a database of available runtime library
+ functions. */
+
+enum a68_libcall_type
+{
+ LCT_VOID,
+ LCT_CHAR,
+ LCT_CONSTCHARPTR,
+ LCT_VOIDPTR,
+ LCT_UNISTR,
+ LCT_UNISTRPTR,
+ LCT_SIZE,
+ LCT_SSIZE,
+ LCT_SIZEPTR,
+ LCT_UINT,
+ LCT_INT,
+ LCT_LONGLONGINT,
+ LCT_FLOAT,
+ LCT_DOUBLE,
+ LCT_LONGDOUBLE,
+ LCT_END
+};
+
+/* An array of all types that are used by the runtime functions we need. */
+
+static tree libcall_types[LCT_END];
+
+/* Internal list of library functions. */
+
+static tree libcall_decls[A68_LIBCALL_LAST];
+
+/* Return the TREE type that is described by TYPE. */
+
+static tree
+get_libcall_type (a68_libcall_type type)
+{
+ if (libcall_types[type])
+ return libcall_types[type];
+
+ if (type == LCT_VOID)
+ libcall_types[type] = void_type_node;
+ else if (type == LCT_CHAR)
+ libcall_types[type] = uint32_type_node;
+ else if (type == LCT_CONSTCHARPTR)
+ libcall_types[type] = build_pointer_type (build_qualified_type
(char_type_node,
+
TYPE_QUAL_CONST));
+ else if (type == LCT_VOIDPTR)
+ libcall_types[type] = ptr_type_node;
+ else if (type == LCT_UNISTR)
+ libcall_types[type] = build_pointer_type (a68_char_type);
+ else if (type == LCT_UNISTRPTR)
+ libcall_types[type] = build_pointer_type (build_pointer_type
(a68_char_type));
+ else if (type == LCT_SIZE)
+ libcall_types[type] = sizetype;
+ else if (type == LCT_SSIZE)
+ libcall_types[type] = ssizetype;
+ else if (type == LCT_SIZEPTR)
+ libcall_types[type] = build_pointer_type (sizetype);
+ else if (type == LCT_UINT)
+ libcall_types[type] = unsigned_type_node;
+ else if (type == LCT_INT)
+ libcall_types[type] = integer_type_node;
+ else if (type == LCT_LONGLONGINT)
+ libcall_types[type] = long_long_integer_type_node;
+ else if (type == LCT_FLOAT)
+ libcall_types[type] = float_type_node;
+ else if (type == LCT_DOUBLE)
+ libcall_types[type] = double_type_node;
+ else if (type == LCT_LONGDOUBLE)
+ libcall_types[type] = long_double_type_node;
+ else
+ gcc_unreachable ();
+
+ return libcall_types[type];
+}
+
+/* Build and return a function declaration named NAME. The RETURN_TYPE is the
+ type returned, FLAGS are the expression call flags, and NPARAMS is the
+ number of arguments, the types of which are provided in `...'. */
+
+static tree
+build_libcall_decl (const char *name, a68_libcall_type return_type,
+ int flags, int nparams, ...)
+{
+ tree *args = XALLOCAVEC (tree, nparams);
+ bool varargs = false;
+ tree fntype;
+
+ /* Add parameter types, using `void' as the last parameter type
+ to mean this function accepts a variable list of arguments. */
+ va_list ap;
+ va_start (ap, nparams);
+
+ for (int i = 0; i < nparams; i++)
+ {
+ a68_libcall_type ptype = (a68_libcall_type) va_arg (ap, int);
+ tree type = get_libcall_type (ptype);
+
+ if (type == void_type_node)
+ {
+ varargs = true;
+ nparams = i;
+ }
+ else
+ args[i] = type;
+ }
+
+ va_end (ap);
+
+ /* Build the function. */
+ tree tret = get_libcall_type (return_type);
+ if (varargs)
+ fntype = build_varargs_function_type_array (tret, nparams, args);
+ else
+ fntype = build_function_type_array (tret, nparams, args);
+
+ tree decl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL,
+ get_identifier (name), fntype);
+ DECL_EXTERNAL (decl) = 1;
+ TREE_PUBLIC (decl) = 1;
+ DECL_ARTIFICIAL (decl) = 1;
+ DECL_VISIBILITY (decl) = VISIBILITY_DEFAULT;
+ DECL_VISIBILITY_SPECIFIED (decl) = 1;
+
+ /* Set any attributes on the function, such as malloc or noreturn. */
+ set_call_expr_flags (decl, flags);
+ return decl;
+}
+
+/* Return or create the runtime library function declaration for LIBCALL.
+ Library functions are generated as needed. This could probably be changed
+ in the future to be done in the compiler init stage, like GCC builtin trees
+ are. */
+
+tree
+a68_get_libcall (a68_libcall_fn libcall)
+{
+ if (libcall_decls[libcall])
+ return libcall_decls[libcall];
+
+ switch (libcall)
+ {
+#define DEF_A68_RUNTIME(CODE, NAME, TYPE, PARAMS, FLAGS) \
+ case A68_LIBCALL_ ## CODE: \
+ libcall_decls[libcall] = build_libcall_decl (NAME, TYPE, FLAGS, PARAMS);
\
+ break;
+#include "a68-low-runtime.def"
+#undef DEF_A68_RUNTIME
+ default:
+ gcc_unreachable ();
+ }
+
+ return libcall_decls[libcall];
+}
+
+/* Generate a call to LIBCALL, returning the result as TYPE. NARGS is the
+ number of call arguments, the expressions of which are provided in `...'.
+ This does not perform conversions or promotions on the arguments. */
+
+tree
+a68_build_libcall (a68_libcall_fn libcall, tree type ATTRIBUTE_UNUSED,
+ int nargs, ...)
+{
+ /* Build the call expression to the runtime function. */
+ tree decl = a68_get_libcall (libcall);
+ tree *args = XALLOCAVEC (tree, nargs);
+ va_list ap;
+
+ va_start (ap, nargs);
+ for (int i = 0; i < nargs; i++)
+ args[i] = va_arg (ap, tree);
+ va_end (ap);
+
+ tree result = build_call_expr_loc_array (input_location, decl, nargs, args);
+
+ /* Assumes caller knows what it is doing. */
+ return result;
+}
diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def
new file mode 100644
index 00000000000..21ec855947d
--- /dev/null
+++ b/gcc/algol68/a68-low-runtime.def
@@ -0,0 +1,91 @@
+/* a68-low-runtime.def -- Definitions for Algol 68 runtime functions.
+ Copyright (C) 2025 Jose E. Marchesi.
+
+GCC 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, or (at your option)
+any later version.
+
+GCC 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/>. */
+
+/* Helper macros for parameter building. */
+#define P0() 0
+#define P1(T1) 1, LCT_ ## T1
+#define P2(T1, T2) \
+ 2, LCT_ ## T1, LCT_ ## T2
+#define P3(T1, T2, T3) \
+ 3, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3
+#define P4(T1, T2, T3, T4) \
+ 4, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4
+#define P5(T1, T2, T3, T4, T5) \
+ 5, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5
+#define P6(T1, T2, T3, T4, T5, T6) \
+ 6, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5,
LCT_ ## T6
+#define P7(T1, T2, T3, T4, T5, T6, T7) \
+ 7, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5,
LCT_ ## T6, LCT_ ## T7
+#define RT(T1) LCT_ ## T1
+
+/* Algol 68 runtime library functions. */
+
+/* DEF_A68_RUNTIME (CODE, NAME, TYPE, PARAMS, FLAGS)
+ CODE The enum code used to refer to this function.
+ NAME The name of this function as a string.
+ FLAGS ECF flags to describe attributes of the function.
+
+ Used for declaring functions that are called by generated code. */
+
+DEF_A68_RUNTIME (ASSERT, "_libga68_assert", RT(VOID), P2(CONSTCHARPTR, UINT),
ECF_NORETURN)
+DEF_A68_RUNTIME (SET_EXIT_STATUS, "_libga68_set_exit_status", RT(VOID),
P1(INT), 0)
+DEF_A68_RUNTIME (MALLOC, "_libga68_malloc", RT(VOIDPTR), P1(SIZE), ECF_NOTHROW
| ECF_LEAF | ECF_MALLOC)
+DEF_A68_RUNTIME (DEREFNIL, "_libga68_derefnil", RT(VOID), P2(CONSTCHARPTR,
UINT), ECF_NORETURN)
+DEF_A68_RUNTIME (UNREACHABLE, "_libga68_unreachable", RT(VOID),
P2(CONSTCHARPTR, UINT), ECF_NORETURN)
+DEF_A68_RUNTIME (INVALIDCHARERROR, "_libga68_invalidcharerror", RT(VOID),
P3(CONSTCHARPTR,UINT,INT), ECF_NORETURN)
+DEF_A68_RUNTIME (BITSBOUNDSERROR, "_libga68_bitsboundserror", RT(VOID),
P3(CONSTCHARPTR,UINT,SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYLOWERBOUND, "_libga68_lower_bound", RT(VOID),
+ P4(CONSTCHARPTR, UINT, SSIZE, SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYUPPERBOUND, "_libga68_upper_bound", RT(VOID),
+ P4(CONSTCHARPTR, UINT, SSIZE, SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYBOUNDS, "_libga68_bounds", RT(VOID),
+ P5(CONSTCHARPTR, UINT, SSIZE, SSIZE, SSIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYBOUNDSMISMATCH, "_libga68_bounds_mismatch", RT(VOID),
+ P7(CONSTCHARPTR, UINT, SIZE, SSIZE, SSIZE, SSIZE, SSIZE),
ECF_NORETURN)
+DEF_A68_RUNTIME (ARRAYDIM, "_libga68_dim", RT(VOID),
+ P4(CONSTCHARPTR, UINT, SIZE, SIZE), ECF_NORETURN)
+DEF_A68_RUNTIME (RANDOM, "_libga68_random", RT(FLOAT), P0(), 0)
+DEF_A68_RUNTIME (LONGRANDOM, "_libga68_longrandom", RT(DOUBLE), P0(), 0)
+DEF_A68_RUNTIME (LONGLONGRANDOM, "_libga68_longlongrandom", RT(LONGDOUBLE),
P0(), 0)
+DEF_A68_RUNTIME (POSIX_FCONNECT, "_libga68_posixfconnect", RT(INT),
P4(UNISTRPTR,SIZE,SIZE,INT), 0)
+DEF_A68_RUNTIME (POSIX_FOPEN, "_libga68_posixfopen", RT(INT),
P4(UNISTRPTR,SIZE,SIZE,UINT), 0)
+DEF_A68_RUNTIME (POSIX_FCREATE, "_libga68_posixcreat", RT(INT),
P4(UNISTRPTR,SIZE,SIZE,UINT), 0)
+DEF_A68_RUNTIME (POSIX_FCLOSE, "_libga68_posixclose", RT(INT), P0(), 0)
+DEF_A68_RUNTIME (POSIX_FSIZE, "_libga68_posixfsize", RT(LONGLONGINT), P1(INT),
0)
+DEF_A68_RUNTIME (POSIX_ARGC, "_libga68_posixargc", RT(INT), P0(), 0)
+DEF_A68_RUNTIME (POSIX_ARGV, "_libga68_posixargv", RT(UNISTRPTR), P2(INT,
SIZEPTR), 0)
+DEF_A68_RUNTIME (POSIX_PUTCHAR, "_libga68_posixputchar", RT(CHAR), P1(CHAR), 0)
+DEF_A68_RUNTIME (POSIX_FPUTC, "_libga68_posixfputc", RT(CHAR), P2(INT,CHAR), 0)
+DEF_A68_RUNTIME (POSIX_PUTS, "_libga68_posixputs", RT(VOID),
P3(UNISTR,SIZE,SIZE), 0)
+DEF_A68_RUNTIME (POSIX_FPUTS, "_libga68_posixfputs", RT(INT),
P4(INT,UNISTRPTR,SIZE,SIZE), 0)
+DEF_A68_RUNTIME (POSIX_GETCHAR, "_libga68_posixgetchar", RT(CHAR), P0(), 0)
+DEF_A68_RUNTIME (POSIX_FGETC, "_libga68_posixfgetc", RT(CHAR), P1(INT), 0)
+DEF_A68_RUNTIME (POSIX_GETS, "_libga68_posixgets", RT(UNISTRPTR),
P2(INT,SIZEPTR), 0)
+DEF_A68_RUNTIME (POSIX_FGETS, "_libga68_posixfgets", RT(UNISTRPTR),
P3(INT,INT,SIZEPTR), 0)
+DEF_A68_RUNTIME (POSIX_GETENV, "_libga68_posixgetenv", RT(VOID),
P5(UNISTR,SIZE,SIZE,UNISTRPTR,SIZEPTR), 0)
+DEF_A68_RUNTIME (POSIX_ERRNO, "_libga68_posixerrno", RT(INT), P0(), 0)
+DEF_A68_RUNTIME (POSIX_PERROR, "_libga68_posixperror", RT(VOID),
P3(UNISTR,SIZE,SIZE), 0)
+DEF_A68_RUNTIME (POSIX_STRERROR, "_libga68_posixstrerror", RT(UNISTRPTR),
P2(INT, SIZEPTR), 0)
+DEF_A68_RUNTIME (U32_CMP2, "_libga68_u32_cmp2", RT(INT), P6(UNISTR, SIZE,
SIZE, UNISTR, SIZE, SIZE), 0)
+
+#undef P0
+#undef P1
+#undef P2
+#undef P3
+#undef P4
+#undef P5
+#undef RT
--
2.30.2
