https://gcc.gnu.org/g:28b80fb7626b6977e837f32aa707bfa9b5d1649d
commit r16-5757-g28b80fb7626b6977e837f32aa707bfa9b5d1649d Author: Jose E. Marchesi <[email protected]> Date: Sat Oct 11 19:53:12 2025 +0200 a68: low: runtime 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. Diff: --- gcc/algol68/a68-low-runtime.cc | 225 ++++++++++++++++++++++++++++++++++++++++ gcc/algol68/a68-low-runtime.def | 92 ++++++++++++++++ 2 files changed, 317 insertions(+) diff --git a/gcc/algol68/a68-low-runtime.cc b/gcc/algol68/a68-low-runtime.cc new file mode 100644 index 000000000000..4ea93e991e10 --- /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 000000000000..04cca03ca51b --- /dev/null +++ b/gcc/algol68/a68-low-runtime.def @@ -0,0 +1,92 @@ +/* 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 (POSIX_LSEEK, "_libga68_posixlseek", RT(LONGLONGINT), P3(INT,LONGLONGINT,INT), 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
