This commit adds the language hooks and the target hooks for the Algol 68 front-end, which implement the a681 compiler proper.
Signed-off-by: Jose E. Marchesi <[email protected]> gcc/ChangeLog * algol68/a68-lang.cc: New file. * algol68/algol68-target.def: Likewise. * genhooks.cc (hook_array): Include algol68/algol68-target.def. --- gcc/algol68/a68-lang.cc | 751 +++++++++++++++++++++++++++++++++ gcc/algol68/algol68-target.def | 52 +++ gcc/genhooks.cc | 1 + 3 files changed, 804 insertions(+) create mode 100644 gcc/algol68/a68-lang.cc create mode 100644 gcc/algol68/algol68-target.def diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc new file mode 100644 index 00000000000..ac2ba7c0b67 --- /dev/null +++ b/gcc/algol68/a68-lang.cc @@ -0,0 +1,751 @@ +/* Language-dependent hooks for Algol 68. + 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/>. */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tree.h" +#include "toplev.h" +#include "langhooks.h" +#include "langhooks-def.h" +#include "target.h" +#include "stringpool.h" +#include "debug.h" +#include "diagnostic.h" +#include "opts.h" +#include "machmode.h" +#include "stor-layout.h" /* For layout_type */ +#include "vec.h" + +#include "a68.h" + +/* Global state for the Algol 68 front end. */ + +A68_T a68_common; + +/* The context to be used for global declarations. */ +static GTY(()) tree global_context; + +/* Array of all global declarations to pass back to the middle-end. */ +static GTY(()) vec <tree, va_gc> *global_declarations; + +/* Array of global type/decl nodes used by this front-end. */ + +tree a68_global_trees[ATI_MAX]; + +/* Types expected by gcc's garbage collector. + These types exist to allow language front-ends to + add extra information in gcc's parse tree data structure. */ + +struct GTY(()) lang_type +{ + MOID_T * GTY((skip)) moid; +}; + +struct GTY(()) lang_decl +{ + NODE_T * GTY((skip)) node; +}; + +/* Language-specific identifier information. This must include a + tree_identifier. */ +struct GTY(()) lang_identifier +{ + struct tree_identifier common; +}; + + +struct GTY(()) language_function +{ + int dummy; +}; + +/* The Algol68 frontend Type AST for GCC type NODE. */ +#define TYPE_LANG_FRONTEND(NODE) \ + (TYPE_LANG_SPECIFIC (NODE) \ + ? TYPE_LANG_SPECIFIC (NODE)->type : NULL) + +/* The resulting tree type. */ + +union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), + chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), " + "TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN " + "(&%h.generic)) : NULL"))) lang_tree_node +{ + union tree_node GTY((tag ("0"), + desc ("tree_node_structure (&%h)"))) generic; + struct lang_identifier GTY ((tag ("1"))) identifier; +}; + +/* Allocate and return a lang specific structure for type tree nodes. */ + +struct lang_type * +a68_build_lang_type (MOID_T *moid) +{ + tree ctype = CTYPE (moid); + struct lang_type *lt = ctype ? TYPE_LANG_SPECIFIC (ctype) : NULL; + + if (lt == NULL) + lt = (struct lang_type *) ggc_cleared_alloc <struct lang_type> (); + if (lt->moid == NULL) + lt->moid = moid; + return lt; +} + +/* Allocate and return a lang specific structure for decl tree nodes. */ + +struct lang_decl * +a68_build_lang_decl (NODE_T *node) +{ + tree cdecl = CDECL (node); + struct lang_decl *ld = cdecl ? DECL_LANG_SPECIFIC (cdecl) : NULL; + + if (ld == NULL) + ld = (struct lang_decl *) ggc_cleared_alloc <struct lang_decl> (); + if (ld->node == NULL) + ld->node = node; + return ld; +} + +/* Get the front-end mode associated with the given TYPE. If no mode is + associated then this function returns NO_MODE. */ + +MOID_T * +a68_type_moid (tree type) +{ + gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL + && TYPE_LANG_SPECIFIC (type)->moid != NO_MOID); + return TYPE_LANG_SPECIFIC (type)->moid; +} + +/* Build the type trees in a68_global_trees. */ + +static void +a68_build_a68_type_nodes (void) +{ + /* VOID */ + a68_void_type = make_node (RECORD_TYPE); + TYPE_NAME (a68_void_type) = get_identifier ("void%"); + TYPE_FIELDS (a68_void_type) = NULL_TREE; + TYPE_READONLY (a68_void_type) = 1; + TYPE_CXX_ODR_P (a68_void_type) = 1; + layout_type (a68_void_type); + + /* BOOL */ + a68_bool_type = boolean_type_node; + + /* CHAR */ + a68_char_type = uint32_type_node; + + /* SHORT SHORT INT + SHORT INT + INT */ + a68_short_short_int_type = signed_char_type_node; + a68_short_int_type = short_integer_type_node; + a68_int_type = integer_type_node; + + /* LONG INT */ + if (int_size_in_bytes (long_integer_type_node) + > int_size_in_bytes (a68_int_type)) + a68_long_int_type = long_integer_type_node; + else if (int_size_in_bytes (long_long_integer_type_node) + > int_size_in_bytes (a68_int_type)) + a68_long_int_type = long_long_integer_type_node; + else + a68_long_int_type = a68_int_type; + + /* LONG LONG INT */ + if (int_size_in_bytes (long_integer_type_node) + > int_size_in_bytes (a68_long_int_type)) + a68_long_long_int_type = long_integer_type_node; + else if (int_size_in_bytes (long_long_integer_type_node) + > int_size_in_bytes (a68_long_int_type)) + a68_long_long_int_type = long_long_integer_type_node; + else + a68_long_long_int_type = a68_long_int_type; + + /* SHORT SHORT BITS + SHORT BITS + BITS */ + a68_short_short_bits_type = unsigned_char_type_node; + a68_short_bits_type = short_unsigned_type_node; + a68_bits_type = unsigned_type_node; + + /* LONG BITS */ + if (int_size_in_bytes (long_unsigned_type_node) + > int_size_in_bytes (a68_bits_type)) + a68_long_bits_type = long_unsigned_type_node; + else if (int_size_in_bytes (long_long_unsigned_type_node) + > int_size_in_bytes (a68_bits_type)) + a68_long_bits_type = long_long_unsigned_type_node; + else + a68_long_bits_type = a68_bits_type; + + /* LONG LONG BITS */ + if (int_size_in_bytes (long_unsigned_type_node) + > int_size_in_bytes (a68_long_bits_type)) + a68_long_long_bits_type = long_unsigned_type_node; + else if (int_size_in_bytes (long_long_unsigned_type_node) + > int_size_in_bytes (a68_long_bits_type)) + a68_long_long_bits_type = long_long_unsigned_type_node; + else + a68_long_long_bits_type = a68_long_bits_type; + + /* BYTES + LONG BYTES */ + a68_bytes_type = unsigned_type_node; + a68_long_bytes_type = long_unsigned_type_node; + + /* REAL + LONG REAL + LONG LONG REAL */ + a68_real_type = float_type_node; + a68_long_real_type = double_type_node; + a68_long_long_real_type = long_double_type_node; +} + +/* Language hooks data structures. This is the main interface between + the GCC front-end and the GCC middle-end/back-end. A list of + language hooks can be found in langhooks.h. */ + +#undef LANG_HOOKS_NAME +#define LANG_HOOKS_NAME "GNU Algol 68" + +/* LANG_HOOKS_INIT gets called to initialize the front-end. + Invoked after option handling. */ + +static bool +a68_init (void) +{ + build_common_tree_nodes (false); + targetm.init_builtins (); + a68_build_a68_type_nodes (); + build_common_builtin_nodes (); + a68_install_builtins (); + + /* Initialize binding contexts. */ + a68_init_ranges (); + + /* Set the type of size_t. */ + if (TYPE_MODE (long_unsigned_type_node) == ptr_mode) + size_type_node = long_unsigned_type_node; + else if (TYPE_MODE (long_long_unsigned_type_node) == ptr_mode) + size_type_node = long_long_unsigned_type_node; + else + size_type_node = long_unsigned_type_node; + + return true; +} + +#undef LANG_HOOKS_INIT +#define LANG_HOOKS_INIT a68_init + +/* LANG_HOOKS_OPTION_LANG_MASK */ + +static unsigned int +a68_option_lang_mask (void) +{ + return CL_Algol68; +} + +#undef LANG_HOOKS_OPTION_LANG_MASK +#define LANG_HOOKS_OPTION_LANG_MASK a68_option_lang_mask + + +/* Return a data type that has machine mode MODE. If the mode is an + integer, then UNSIGNEDP selects between signed and unsigned types. */ + +static tree +a68_type_for_mode (enum machine_mode mode, int unsignedp) +{ + if (mode == QImode) + return unsignedp ? a68_short_short_bits_type :a68_short_short_int_type; + + if (mode == HImode) + return unsignedp ? a68_short_bits_type : a68_short_int_type; + + if (mode == SImode) + return unsignedp ? a68_bits_type : a68_int_type; + + if (mode == DImode) + return unsignedp ? a68_long_bits_type : a68_long_int_type; + + if (mode == TYPE_MODE (a68_long_long_bits_type)) + return unsignedp ? a68_long_long_bits_type : a68_long_long_int_type; + + if (mode == TYPE_MODE (a68_real_type)) + return a68_real_type; + + if (mode == TYPE_MODE (a68_long_real_type)) + return a68_long_real_type; + + if (mode == TYPE_MODE (a68_long_long_real_type)) + return a68_long_long_real_type; + + if (mode == TYPE_MODE (build_pointer_type (char_type_node))) + return build_pointer_type (char_type_node); + + if (mode == TYPE_MODE (build_pointer_type (integer_type_node))) + return build_pointer_type (integer_type_node); + + for (int i = 0; i < NUM_INT_N_ENTS; i ++) + { + if (int_n_enabled_p[i] && mode == int_n_data[i].m) + { + if (unsignedp) + return int_n_trees[i].unsigned_type; + else + return int_n_trees[i].signed_type; + } + } + + return 0; +} + +#undef LANG_HOOKS_TYPE_FOR_MODE +#define LANG_HOOKS_TYPE_FOR_MODE a68_type_for_mode + + +/* Return an integer type with BITS bits of precision, + that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */ + +static tree +a68_type_for_size (unsigned int bits, int unsignedp) +{ + if (unsignedp) + { + if (bits <= TYPE_PRECISION (a68_short_short_bits_type)) + return a68_short_short_bits_type; + if (bits <= TYPE_PRECISION (a68_short_bits_type)) + return a68_short_bits_type; + if (bits <= TYPE_PRECISION (a68_bits_type)) + return a68_bits_type; + if (bits <= TYPE_PRECISION (a68_long_bits_type)) + return a68_long_bits_type; + if (bits <= TYPE_PRECISION (a68_long_long_bits_type)) + return a68_long_long_bits_type; + } + else + { + if (bits <= TYPE_PRECISION (a68_short_short_int_type)) + return a68_short_short_int_type; + if (bits <= TYPE_PRECISION (a68_short_int_type)) + return a68_short_int_type; + if (bits <= TYPE_PRECISION (a68_int_type)) + return a68_int_type; + if (bits <= TYPE_PRECISION (a68_long_int_type)) + return a68_long_int_type; + if (bits <= TYPE_PRECISION (a68_long_long_int_type)) + return a68_long_long_int_type; + } + + for (int i = 0; i < NUM_INT_N_ENTS; ++i) + { + if (int_n_enabled_p[i] && bits == int_n_data[i].bitsize) + { + if (unsignedp) + return int_n_trees[i].unsigned_type; + else + return int_n_trees[i].signed_type; + } + } + + return 0; +} + +#undef LANG_HOOKS_TYPE_FOR_SIZE +#define LANG_HOOKS_TYPE_FOR_SIZE a68_type_for_size + + +/* Implements the lang_hooks.decls.global_bindings_p routine for Algol 68. + Return true if we are in the global binding level. */ + +static bool +a68_global_bindings_p (void) +{ + return (current_function_decl == NULL_TREE); +} + +#undef LANG_HOOKS_GLOBAL_BINDINGS_P +#define LANG_HOOKS_GLOBAL_BINDINGS_P a68_global_bindings_p + +/* Implements the lang_hooks.decls.getdecls routine. + Return the list of declarations of the current level. */ + +static tree +a68_getdecls (void) +{ + return a68_range_names (); +} + +#undef LANG_HOOKS_GETDECLS +#define LANG_HOOKS_GETDECLS a68_getdecls + +/* Return global_context, but create it first if need be. */ + +static tree +get_global_context (void) +{ + if (!global_context) + { + global_context = build_translation_unit_decl (NULL_TREE); + debug_hooks->register_main_translation_unit (global_context); + } + + return global_context; +} + +/* Implements the lang_hooks.decls.pushdecl routine. + Record DECL as belonging to the current lexical scope. */ + +static tree +pushdecl (tree decl) +{ + /* Set the context of the decl. If current_function_decl did not help in + determining the context, use global scope. */ + if (!DECL_CONTEXT (decl)) + { + if (current_function_decl) + DECL_CONTEXT (decl) = current_function_decl; + else + DECL_CONTEXT (decl) = get_global_context (); + } + + /* Put decls on list in reverse order. */ + if (TREE_STATIC (decl) || a68_global_bindings_p ()) + vec_safe_push (global_declarations, decl); + else + a68_add_decl (decl); + + return decl; +} + +#undef LANG_HOOKS_PUSHDECL +#define LANG_HOOKS_PUSHDECL pushdecl + +/* Implements the lang_hooks.init_options routine for language Algol 68. This + initializes the global state for the frontend before calling the option + handlers. */ + +static void +a68_init_options (unsigned int argc ATTRIBUTE_UNUSED, + cl_decoded_option *decoded_options ATTRIBUTE_UNUSED) +{ + /* Nothing to do here for now. */ +} + +#undef LANG_HOOKS_INIT_OPTIONS +#define LANG_HOOKS_INIT_OPTIONS a68_init_options + + +/* Handle -fcheck= option. */ + +static void +a68_handle_runtime_check_option (const char *arg) +{ + int pos = 0; + + while (*arg) + { + /* We accept entries like -fcheck=nil,,bounds and -fcheck=,all. */ + while (*arg == ',') + arg++; + + while (arg[pos] && arg[pos] != ',') + pos++; + + /* Process an option flag in the -fcheck= specification. + + "all" means enable all run-time checks. + "none" means disable all run-time checks. + + Options are processed from left to right, with increase + precedende. */ + + if (strncmp (arg, "all", pos) == 0) + { + OPTION_NIL_CHECKING (&A68_JOB) = true; + OPTION_BOUNDS_CHECKING (&A68_JOB) = true; + } + else if (strncmp (arg, "none", pos) == 0) + { + OPTION_NIL_CHECKING (&A68_JOB) = false; + OPTION_BOUNDS_CHECKING (&A68_JOB) = false; + } + else if (strncmp (arg, "nil", pos) == 0) + OPTION_NIL_CHECKING (&A68_JOB) = true; + else if (strncmp (arg, "no-nil", pos) == 0) + OPTION_NIL_CHECKING (&A68_JOB) = false; + else if (strncmp (arg, "bounds", pos) == 0) + OPTION_BOUNDS_CHECKING (&A68_JOB) = true; + else if (strncmp (arg, "no-bounds", pos) == 0) + OPTION_BOUNDS_CHECKING (&A68_JOB) = false; + else + fatal_error (UNKNOWN_LOCATION, + "Argument to %<-fcheck%> is not valid: %s", arg); + + /* Process next flag. */ + arg += pos; + pos = 0; + } +} + +/* Handle Algol 68 specific options. Return false if we didn't do + anything. */ + +static bool +a68_handle_option (size_t scode, + const char *arg, + HOST_WIDE_INT value ATTRIBUTE_UNUSED, + int kind ATTRIBUTE_UNUSED, + location_t loc ATTRIBUTE_UNUSED, + const cl_option_handlers *handlers ATTRIBUTE_UNUSED) +{ + opt_code code = (opt_code) scode; + + switch (code) + { + case OPT_std_algol68: + OPTION_STRICT (&A68_JOB) = 1; + break; + case OPT_fbrackets: + OPTION_BRACKETS (&A68_JOB) = flag_brackets; + break; + case OPT_fassert: + OPTION_ASSERT (&A68_JOB) = flag_assert; + break; + case OPT_fcheck_: + a68_handle_runtime_check_option (arg); + break; + case OPT_fstropping_: + if (value == 0) + OPTION_STROPPING (&A68_JOB) = UPPER_STROPPING; + else + OPTION_STROPPING (&A68_JOB) = SUPPER_STROPPING; + break; + case OPT_I: + vec_safe_push (A68_INCLUDE_PATHS, arg); + break; + default: + break; + } + + return true; +} + +#undef LANG_HOOKS_HANDLE_OPTION +#define LANG_HOOKS_HANDLE_OPTION a68_handle_option + +/* LANG_HOOKS_INIT_OPTIONS_STRUCT is called so the front-end can + change some default values in the compiler's option structure. */ + +static void +a68_init_options_struct (struct gcc_options *opts) +{ + /* Operations are always wrapping in algol68, even on signed + integer. */ + opts->x_flag_wrapv = 1; + /* Do not warn for voiding by default. */ + opts->x_warn_algol68_voiding = 0; + /* Do not warn for usage of Algol 68 extensions by default. */ + opts->x_warn_algol68_extensions = 0; + /* Do not warn for potential scope violations by default. */ + opts->x_warn_algol68_scope = 0; + /* Do not warn for hidden declarations by default. */ + opts->x_warn_algol68_hidden_declarations = 0; + /* Enable assertions by default. */ + OPTION_ASSERT (&A68_JOB) = 1; + /* Disable run-time nil checking by default. */ + OPTION_NIL_CHECKING (&A68_JOB) = 0; + /* Enable run-time bounds checking by default. */ + OPTION_BOUNDS_CHECKING (&A68_JOB) = 1; + opts->x_flag_assert = 1; + /* Allow GNU extensions by default. */ + OPTION_STRICT (&A68_JOB) = 0; + /* The default stropping regime is SUPPER. */ + OPTION_STROPPING (&A68_JOB) = SUPPER_STROPPING; +} + +#undef LANG_HOOKS_INIT_OPTIONS_STRUCT +#define LANG_HOOKS_INIT_OPTIONS_STRUCT a68_init_options_struct + +/* Deal with any options that imply the turning on/off of features. FILENAME + is the main input file passed on the command line. */ + +static bool +a68_post_options (const char **filename ATTRIBUTE_UNUSED) +{ + /* -fbounds-check is equivalent to -fcheck=bounds */ + if (flag_bounds_check) + OPTION_BOUNDS_CHECKING (&A68_JOB) = true; + + return false; +} + +#undef LANG_HOOKS_POST_OPTIONS +#define LANG_HOOKS_POST_OPTIONS a68_post_options + +/* LANG_HOOKS_PARSE_FILE is called to parse the input files. + + The input file names are available in the global variables + in_fnames and num_in_fnames, and this function is required to + create a complete parse tree from them in a global var, then + return. */ + +static void +a68_parse_file (void) +{ + if (num_in_fnames != 1) + fatal_error (UNKNOWN_LOCATION, + "exactly one source file must be specified on the command line"); + + /* Run the Mailloux parser. */ + a68_parser (in_fnames[0]); + + if (ERROR_COUNT (&A68_JOB) > 0) + goto had_errors; + + /* Generate dumps if so requested. */ + if (flag_a68_dump_modes) + a68_dump_modes (TOP_MOID (&A68_JOB)); + if (flag_a68_dump_ast) + a68_dump_parse_tree (TOP_NODE (&A68_JOB)); + + /* Lower modes to GENERIC. */ + a68_lower_moids (TOP_MOID (&A68_JOB)); + /* Lower the particular program. */ + a68_lower_top_tree (TOP_NODE (&A68_JOB)); + + if (ERROR_COUNT (&A68_JOB) > 0) + goto had_errors; + + /* Process all file scopes in this compilation, and the external_scope, + through wrapup_global_declarations. */ + for (unsigned int i = 0; i < vec_safe_length (global_declarations); i++) + { + tree decl = vec_safe_address (global_declarations)[i]; + wrapup_global_declarations (&decl, 1); + } + + had_errors: + errorcount += ERROR_COUNT (&A68_JOB); +} + +#undef LANG_HOOKS_PARSE_FILE +#define LANG_HOOKS_PARSE_FILE a68_parse_file + +/* This hook is called for every GENERIC tree that gets gimplified. + Its purpose is to gimplify language specific trees. + + At the moment we are not supporting any Algol 68 specific tree, so + we just return FALSE. */ + +static int +a68_gimplify_expr (tree *expr_p ATTRIBUTE_UNUSED, + gimple_seq *pre_p ATTRIBUTE_UNUSED, + gimple_seq *post_p ATTRIBUTE_UNUSED) +{ + return false; +} + +#undef LANG_HOOKS_GIMPLIFY_EXPR +#define LANG_HOOKS_GIMPLIFY_EXPR a68_gimplify_expr + +/* This function shall return the printable name of the language. */ + +static const char * +a68_printable_name (tree decl, int kind ATTRIBUTE_UNUSED) +{ + tree decl_name = DECL_NAME (decl); + + if (decl_name == NULL_TREE) + return "<unnamed>"; + else + return IDENTIFIER_POINTER (decl_name); +} + +#undef LANG_HOOKS_DECL_PRINTABLE_NAME +#define LANG_HOOKS_DECL_PRINTABLE_NAME a68_printable_name + + +/* Return true if a warning should be given about option OPTION, which is for + the wrong language, false if it should be quietly ignored. */ + +static bool +a68_complain_wrong_lang_p (const struct cl_option *option ATTRIBUTE_UNUSED) +{ + return false; +} + +#undef LANG_HOOKS_COMPLAIN_WRONG_LANG_P +#define LANG_HOOKS_COMPLAIN_WRONG_LANG_P a68_complain_wrong_lang_p + +/* Create an expression whose value is that of EXPR, + converted to type TYPE. The TREE_TYPE of the value + is always TYPE. This function implements all reasonable + conversions; callers should filter out those that are + not permitted by the language being compiled. + + Note that this function is not used outside the front-end. This front-end + doesn't currently use it at all. */ + +tree convert (tree type ATTRIBUTE_UNUSED, + tree expr ATTRIBUTE_UNUSED) +{ + gcc_unreachable (); +} + +/* Implements the lang_hooks.types_compatible_p routine for Algol 68. + Compares two types for equivalence in Algol 68. + This routine should only return 1 if it is sure, even though the frontend + should have already ensured that all types are compatible before handing + over the parsed ASTs to the code generator. */ + +static int +a68_types_compatible_p (tree x, tree y) +{ + MOID_T *mode_x = a68_type_moid (x); + MOID_T *mode_y = a68_type_moid (y); + + if (mode_x != NO_MOID && mode_y != NO_MOID) + return a68_is_equal_modes (mode_x, mode_y, SAFE_DEFLEXING); + + return false; +} + +#undef LANG_HOOKS_TYPES_COMPATIBLE_P +#define LANG_HOOKS_TYPES_COMPATIBLE_P a68_types_compatible_p + +/* Get a value for the SARIF v2.1.0 "artifact.sourceLanguage" property. Algol + 68 is not yet listed in SARIF v2.1.0 Appendix J, but if/when it does, it + will likely use this string. */ + +const char * +a68_get_sarif_source_language (const char *) +{ + return "algol68"; +} + +#undef LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE +#define LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE a68_get_sarif_source_language + +/* Expands all LANG_HOOKS_x o GCC. */ +struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; + +#include "gt-algol68-a68-lang.h" +#include "gtype-algol68.h" diff --git a/gcc/algol68/algol68-target.def b/gcc/algol68/algol68-target.def new file mode 100644 index 00000000000..3e865176084 --- /dev/null +++ b/gcc/algol68/algol68-target.def @@ -0,0 +1,52 @@ +/* Target hook definitions for the Algol68 front end. + Copyright (C) 2025 Jose E. Marchesi. + + 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, 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 this program; see the file COPYING3. If not see + <http://www.gnu.org/licenses/>. */ + +/* See target-hooks-macros.h for details of macros that should be + provided by the including file, and how to use them here. */ + +#include "target-hooks-macros.h" + +#undef HOOK_TYPE +#define HOOK_TYPE "Algol68 Target Hook" + +HOOK_VECTOR (TARGETALGOL68M_INITIALIZER, gcc_targetalgol68m) + +#undef HOOK_PREFIX +#define HOOK_PREFIX "TARGET_" + +/* Environmental CPU info and features (e.g. endianness, pointer size) relating + to the target CPU. */ +DEFHOOK +(algol68_cpu_info, + "Declare all environmental CPU info and features relating to the target CPU\n\ +using the function @code{algol68_add_target_info}, which takes a string\n\ +representing the feature key and a string representing the feature value.\n\ +Configuration pairs predefined by this hook apply to all files that are being\n\ +compiled.", + void, (void), + hook_void_void) + +/* Environmental OS info relating to the target OS. */ +DEFHOOK +(algol68_os_info, + "Similar to @code{TARGET_ALGOL68_CPU_INFO}, but is used for configuration info\n\ +relating to the target operating system.", + void, (void), + hook_void_void) + +/* Close the 'struct gcc_targetalgol68m' definition. */ +HOOK_VECTOR_END (C90_EMPTY_HACK) diff --git a/gcc/genhooks.cc b/gcc/genhooks.cc index 529417b50f2..56a150e78d4 100644 --- a/gcc/genhooks.cc +++ b/gcc/genhooks.cc @@ -37,6 +37,7 @@ static struct hook_desc hook_array[] = { #include "d/d-target.def" #include "rust/rust-target.def" #include "jit/jit-target.def" +#include "algol68/algol68-target.def" #undef DEFHOOK }; -- 2.30.2
