15/19 modula2 front end: cc1gm2 additional non modula2 source files
Commit Message
This patch set contains the .h, .cc and .flex files found in
gcc/m2. The files are tightly coupled with the gimple interface
(see 04-gimple-interface) and built using the rules found in
(01-03-make).
------8<----------8<----------8<----------8<----------8<----------8<----
Comments
On Mon, Oct 10, 2022 at 5:44 PM Gaius Mulley via Gcc-patches
<gcc-patches@gcc.gnu.org> wrote:
>
>
>
> This patch set contains the .h, .cc and .flex files found in
> gcc/m2. The files are tightly coupled with the gimple interface
> (see 04-gimple-interface) and built using the rules found in
> (01-03-make).
>
>
> ------8<----------8<----------8<----------8<----------8<----------8<----
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-lang.cc
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/gm2-lang.cc 2022-10-07 20:21:18.650096940 +0100
> @@ -0,0 +1,938 @@
> +/* gm2-lang.cc language-dependent hooks for GNU Modula-2.
> +
> +Copyright (C) 2002-2022 Free Software Foundation, Inc.
> +Contributed by Gaius Mulley <gaius@glam.ac.uk>.
> +
> +This file is part of GNU Modula-2.
> +
> +GNU Modula-2 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.
> +
> +GNU Modula-2 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 GNU Modula-2; see the file COPYING. If not, write to the
> +Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
> +02110-1301, USA. */
> +
> +#include "gm2-gcc/gcc-consolidation.h"
> +
> +#include "langhooks-def.h" /* FIXME: for lhd_set_decl_assembler_name. */
> +#include "tree-pass.h" /* FIXME: only for PROP_gimple_any. */
> +#include "toplev.h"
> +#include "debug.h"
> +
> +#include "opts.h"
> +
> +#define GM2_LANG_C
> +#include "gm2-lang.h"
> +#include "m2block.h"
> +#include "dynamicstrings.h"
> +#include "m2options.h"
> +#include "m2convert.h"
> +#include "m2linemap.h"
> +#include "init.h"
> +#include "m2-tree.h"
> +#include "convert.h"
> +#include "rtegraph.h"
> +
> +static void write_globals (void);
> +
> +static int insideCppArgs = FALSE;
> +
> +#define EXPR_STMT_EXPR(NODE) TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0)
This seems to be in m2-tree.h already.
> +/* start of new stuff. */
> +
> +/* Language-dependent contents of a type. */
> +
> +struct GTY (()) lang_type
> +{
> + char dummy;
> +};
> +
> +/* Language-dependent contents of a decl. */
> +
> +struct GTY (()) lang_decl
> +{
> + char dummy;
> +};
> +
> +/* Language-dependent contents of an identifier. This must include a
> + tree_identifier. */
> +
> +struct GTY (()) lang_identifier
> +{
> + struct tree_identifier common;
> +};
> +
> +/* 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;
> +};
> +
> +/* We don't use language_function. */
well ...
> +struct GTY (()) language_function
> +{
> +
> + /* While we are parsing the function, this contains information about
> + the statement-tree that we are building. */
> + /* struct stmt_tree_s stmt_tree; */
> + tree stmt_tree;
... but this?
> +};
> +
> +/* end of new stuff. */
> +
> +/* Language hooks. */
> +
> +bool
> +gm2_langhook_init (void)
> +{
> + build_common_tree_nodes (false);
> +
> + /* I don't know why this has to be done explicitly. */
> + void_list_node = build_tree_list (NULL_TREE, void_type_node);
it's now done in build_common_tree_nodes
> + build_common_builtin_nodes ();
> +
> + /* The default precision for floating point numbers. This is used
> + for floating point constants with abstract type. This may eventually
> + be controllable by a command line option. */
> + mpfr_set_default_prec (256);
> +
> + /* GNU Modula-2 uses exceptions. */
> + using_eh_for_cleanups ();
> +
> + return true;
> +}
> +
> +/* The option mask. */
> +
> +static unsigned int
> +gm2_langhook_option_lang_mask (void)
> +{
> + return CL_ModulaX2;
> +}
> +
> +/* Initialize the options structure. */
> +
> +static void
> +gm2_langhook_init_options_struct (struct gcc_options *opts)
> +{
> + /* Default to avoiding range issues for complex multiply and divide. */
> + opts->x_flag_complex_method = 2;
> +
> + /* The builtin math functions should not set errno. */
> + opts->x_flag_errno_math = 0;
> + opts->frontend_set_flag_errno_math = true;
> +
> + /* Exceptions are used to handle recovering from panics. */
> + opts->x_flag_exceptions = 1;
> + opts->x_flag_non_call_exceptions = 1;
whohoo - really non-call-exceptions?
> +
> + init_FrontEndInit ();
> +}
> +
> +/* Infrastructure for a VEC of bool values. */
> +
> +/* This array determines whether the filename is associated with the
> + C preprocessor. */
> +
> +static vec<bool> filename_cpp;
> +
> +void
> +gm2_langhook_init_options (unsigned int decoded_options_count,
> + struct cl_decoded_option *decoded_options)
> +{
> + unsigned int i;
> + bool in_cpp_args = false;
> +
> + // filename_cpp = ggc_vec_alloc<bool> (decoded_options_count);
> +
> + for (i = 1; i < decoded_options_count; i++)
> + {
> + switch (decoded_options[i].opt_index)
> + {
> + case OPT_fcpp_begin:
> + in_cpp_args = true;
> + break;
> + case OPT_fcpp_end:
> + in_cpp_args = false;
> + break;
> + case OPT_SPECIAL_input_file:
> + case OPT_SPECIAL_program_name:
> + filename_cpp.safe_push (in_cpp_args);
> + }
> + }
> + filename_cpp.safe_push (false);
> +}
> +
> +static bool
> +is_cpp_filename (unsigned int i)
> +{
> + gcc_assert (i < filename_cpp.length ());
> + return filename_cpp[i];
> +}
> +
> +/* Handle gm2 specific options. Return 0 if we didn't do anything. */
> +
> +bool
> +gm2_langhook_handle_option (
> + size_t scode, const char *arg, HOST_WIDE_INT value, int kind ATTRIBUTE_UNUSED,
> + location_t loc ATTRIBUTE_UNUSED,
> + const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
> +{
> + enum opt_code code = (enum opt_code)scode;
> +
> + /* ignore file names. */
> + if (code == N_OPTS)
> + return 1;
> +
> + switch (code)
> + {
> + case OPT_B:
> + M2Options_SetB (arg);
> + return 1;
> + case OPT_c:
> + M2Options_Setc (value);
> + return 1;
> + case OPT_I:
> + if (insideCppArgs)
> + {
> + const struct cl_option *option = &cl_options[scode];
> + const char *opt = (const char *)option->opt_text;
> + M2Options_CppArg (opt, arg, TRUE);
> + }
> + else
> + M2Options_SetSearchPath (arg);
> + return 1;
> + case OPT_fiso:
> + M2Options_SetISO (value);
> + return 1;
> + case OPT_fpim:
> + M2Options_SetPIM (value);
> + return 1;
> + case OPT_fpim2:
> + M2Options_SetPIM2 (value);
> + return 1;
> + case OPT_fpim3:
> + M2Options_SetPIM3 (value);
> + return 1;
> + case OPT_fpim4:
> + M2Options_SetPIM4 (value);
> + return 1;
> + case OPT_fpositive_mod_floor_div:
> + M2Options_SetPositiveModFloor (value);
> + return 1;
> + case OPT_flibs_:
> + /* handled in the gm2 driver. */
> + return 1;
> + case OPT_fgen_module_list_:
> + M2Options_SetGenModuleList (value, arg);
> + return 1;
> + case OPT_fnil:
> + M2Options_SetNilCheck (value);
> + return 1;
> + case OPT_fwholediv:
> + M2Options_SetWholeDiv (value);
> + return 1;
> + case OPT_findex:
> + M2Options_SetIndex (value);
> + return 1;
> + case OPT_frange:
> + M2Options_SetRange (value);
> + return 1;
> + case OPT_ffloatvalue:
> + M2Options_SetFloatValueCheck (value);
> + return 1;
> + case OPT_fwholevalue:
> + M2Options_SetWholeValueCheck (value);
> + return 1;
> + case OPT_freturn:
> + M2Options_SetReturnCheck (value);
> + return 1;
> + case OPT_fcase:
> + M2Options_SetCaseCheck (value);
> + return 1;
> + case OPT_fd:
> + M2Options_SetCompilerDebugging (value);
> + return 1;
> + case OPT_fdebug_trace_quad:
> + M2Options_SetDebugTraceQuad (value);
> + return 1;
> + case OPT_fdebug_trace_api:
> + M2Options_SetDebugTraceAPI (value);
> + return 1;
> + case OPT_fdebug_function_line_numbers:
> + M2Options_SetDebugFunctionLineNumbers (value);
> + return 1;
> + case OPT_fauto_init:
> + M2Options_SetAutoInit (value);
> + return 1;
> + case OPT_fsoft_check_all:
> + M2Options_SetCheckAll (value);
> + return 1;
> + case OPT_fexceptions:
> + M2Options_SetExceptions (value);
> + return 1;
> + case OPT_Wstyle:
> + M2Options_SetStyle (value);
> + return 1;
> + case OPT_Wpedantic:
> + M2Options_SetPedantic (value);
> + return 1;
> + case OPT_Wpedantic_param_names:
> + M2Options_SetPedanticParamNames (value);
> + return 1;
> + case OPT_Wpedantic_cast:
> + M2Options_SetPedanticCast (value);
> + return 1;
> + case OPT_fextended_opaque:
> + M2Options_SetExtendedOpaque (value);
> + return 1;
> + case OPT_Wverbose_unbounded:
> + M2Options_SetVerboseUnbounded (value);
> + return 1;
> + case OPT_Wunused_variable:
> + M2Options_SetUnusedVariableChecking (value);
> + return 1;
> + case OPT_Wunused_parameter:
> + M2Options_SetUnusedParameterChecking (value);
> + return 1;
> + case OPT_fm2_strict_type:
> + M2Options_SetStrictTypeChecking (value);
> + return 1;
> + case OPT_Wall:
> + M2Options_SetWall (value);
> + return 1;
> + case OPT_fxcode:
> + M2Options_SetXCode (value);
> + return 1;
> + case OPT_fm2_lower_case:
> + M2Options_SetLowerCaseKeywords (value);
> + return 1;
> + case OPT_fuse_list_:
> + M2Options_SetUselist (value, arg);
> + return 1;
> + case OPT_fruntime_modules_:
> + M2Options_SetRuntimeModuleOverride (arg);
> + return 1;
> + case OPT_fpthread:
> + /* handled in the driver. */
> + return 1;
> + case OPT_fm2_plugin:
> + /* handled in the driver. */
> + return 1;
> + case OPT_fscaffold_dynamic:
> + M2Options_SetScaffoldDynamic (value);
> + return 1;
> + case OPT_fscaffold_static:
> + M2Options_SetScaffoldStatic (value);
> + return 1;
> + case OPT_fscaffold_main:
> + M2Options_SetScaffoldMain (value);
> + return 1;
> + case OPT_fcpp:
> + M2Options_SetCpp (value);
> + return 1;
> + case OPT_fcpp_begin:
> + insideCppArgs = TRUE;
> + return 1;
> + case OPT_fcpp_end:
> + insideCppArgs = FALSE;
> + return 1;
> + case OPT_fq:
> + M2Options_SetQuadDebugging (value);
> + return 1;
> + case OPT_fsources:
> + M2Options_SetSources (value);
> + return 1;
> + case OPT_funbounded_by_reference:
> + M2Options_SetUnboundedByReference (value);
> + return 1;
> + case OPT_fdef_:
> + M2Options_setdefextension (arg);
> + return 1;
> + case OPT_fmod_:
> + M2Options_setmodextension (arg);
> + return 1;
> + case OPT_fdump_system_exports:
> + M2Options_SetDumpSystemExports (value);
> + return 1;
> + case OPT_fswig:
> + M2Options_SetSwig (value);
> + return 1;
> + case OPT_fshared:
> + M2Options_SetShared (value);
> + return 1;
> + case OPT_fm2_statistics:
> + M2Options_SetStatistics (value);
> + return 1;
> + case OPT_fm2_g:
> + M2Options_SetM2g (value);
> + return 1;
> + case OPT_O:
> + M2Options_SetOptimizing (value);
> + return 1;
> + case OPT_quiet:
> + M2Options_SetQuiet (value);
> + return 1;
> + case OPT_fm2_whole_program:
> + M2Options_SetWholeProgram (value);
> + return 1;
> + case OPT_flocation_:
> + if (strcmp (arg, "builtins") == 0)
> + {
> + M2Options_SetForcedLocation (BUILTINS_LOCATION);
> + return 1;
> + }
> + else if (strcmp (arg, "unknown") == 0)
> + {
> + M2Options_SetForcedLocation (UNKNOWN_LOCATION);
> + return 1;
> + }
> + else if ((arg != NULL) && (ISDIGIT (arg[0])))
> + {
> + M2Options_SetForcedLocation (atoi (arg));
> + return 1;
> + }
> + else
> + return 0;
> + case OPT_save_temps:
> + M2Options_SetSaveTemps (value);
> + return 1;
> + case OPT_save_temps_:
> + M2Options_SetSaveTempsDir (arg);
> + return 1;
> + default:
> + if (insideCppArgs)
> + {
> + const struct cl_option *option = &cl_options[scode];
> + const char *opt = (const char *)option->opt_text;
> +
> + M2Options_CppArg (opt, arg, TRUE);
> + return 1;
> + }
> + return 0;
> + }
> + return 0;
> +}
> +
> +/* Run after parsing options. */
> +
> +static bool
> +gm2_langhook_post_options (const char **pfilename)
> +{
> + const char *filename = *pfilename;
> + flag_excess_precision = EXCESS_PRECISION_FAST;
> + M2Options_SetCC1Quiet (quiet_flag);
> + M2Options_FinaliseOptions ();
> + main_input_filename = filename;
> +
> + /* Returning false means that the backend should be used. */
> + return false;
> +}
> +
> +/* Call the compiler for every source filename on the command line. */
> +
> +static void
> +gm2_parse_input_files (const char **filenames, unsigned int filename_count)
> +{
> + unsigned int i;
> + gcc_assert (filename_count > 0);
> +
> + for (i = 0; i < filename_count; i++)
> + if (!is_cpp_filename (i))
> + {
> + main_input_filename = filenames[i];
> + init_PerCompilationInit (filenames[i]);
> + }
> +}
> +
> +static void
> +gm2_langhook_parse_file (void)
> +{
> + gm2_parse_input_files (in_fnames, num_in_fnames);
> + write_globals ();
> +}
> +
> +static tree
> +gm2_langhook_type_for_size (unsigned int bits, int unsignedp)
> +{
> + return gm2_type_for_size (bits, unsignedp);
> +}
> +
> +static tree
> +gm2_langhook_type_for_mode (machine_mode mode, int unsignedp)
> +{
> + tree type;
> +
> + if (VECTOR_MODE_P (mode))
> + {
> + tree inner;
> +
> + inner = gm2_langhook_type_for_mode (GET_MODE_INNER (mode), unsignedp);
> + if (inner != NULL_TREE)
> + return build_vector_type_for_mode (inner, mode);
> + return NULL_TREE;
> + }
> +
> + scalar_int_mode imode;
> + scalar_float_mode fmode;
> + complex_mode cmode;
> + if (is_int_mode (mode, &imode))
> + return gm2_langhook_type_for_size (GET_MODE_BITSIZE (imode), unsignedp);
> + else if (is_float_mode (mode, &fmode))
> + {
> + switch (GET_MODE_BITSIZE (fmode))
> + {
> + case 32:
> + return float_type_node;
> + case 64:
> + return double_type_node;
Have a look at lto/lto-lang.cc where we match the global types with
if (mode == TYPE_MODE (float_type_node))
return float_type_node;
I think that's better than relying on the size statically as you do above.
> + default:
> + // We have to check for long double in order to support
> + // i386 excess precision.
> + if (fmode == TYPE_MODE (long_double_type_node))
> + return long_double_type_node;
> + }
> + }
> + else if (is_complex_float_mode (mode, &cmode))
> + {
> + switch (GET_MODE_BITSIZE (cmode))
> + {
> + case 64:
> + return complex_float_type_node;
> + case 128:
> + return complex_double_type_node;
> + default:
> + // We have to check for long double in order to support
> + // i386 excess precision.
> + if (cmode == TYPE_MODE (complex_long_double_type_node))
> + return complex_long_double_type_node;
> + }
> + }
> +
> +#if HOST_BITS_PER_WIDE_INT >= 64
> +
> + /* The middle-end and some backends rely on TImode being supported
> + for 64-bit HWI. */
> + if (mode == TImode)
> + {
> + type = build_nonstandard_integer_type (GET_MODE_BITSIZE (TImode),
> + unsignedp);
> + if (type && TYPE_MODE (type) == TImode)
> + return type;
> + }
> +#endif
Instead of this block look at c-family/c-common.cc which does
for (i = 0; i < NUM_INT_N_ENTS; i ++)
if (int_n_enabled_p[i]
&& mode == int_n_data[i].m)
return (unsignedp ? int_n_trees[i].unsigned_type
: int_n_trees[i].signed_type);
it might be practical to factor out handling of the global tree nodes into
a function in the middle-end that frontends can call after processing modes
it has special types for.
> + return NULL_TREE;
> +}
> +
> +/* Record a builtin function. We just ignore builtin functions. */
> +
> +static tree
> +gm2_langhook_builtin_function (tree decl)
> +{
> + return decl;
> +}
> +
> +/* Return true if we are in the global binding level. */
> +
> +static bool
> +gm2_langhook_global_bindings_p (void)
> +{
> + return current_function_decl == NULL_TREE;
> +}
> +
> +/* Push a declaration into the current binding level. We can't
> + usefully implement this since we don't want to convert from tree back
> + to one of our internal data structures. I think the only way this is
> + used is to record a decl which is to be returned by getdecls, and we
> + could implement it for that purpose if necessary. */
> +
> +static tree
> +gm2_langhook_pushdecl (tree decl ATTRIBUTE_UNUSED)
> +{
> + gcc_unreachable ();
> +}
> +
> +/* This hook is used to get the current list of declarations as trees.
> + We don't support that; instead we use write_globals. This can't
> + simply crash because it is called by -gstabs. */
> +
> +static tree
> +gm2_langhook_getdecls (void)
> +{
> + return NULL;
> +}
> +
> +/* m2_write_global_declarations writes out globals by coping into a vec
> + and calling wrapup_global_declarations. */
> +
> +static void
> +m2_write_global_declarations (tree globals)
> +{
> + tree decl = globals;
> + int n = 0;
> +
> + while (decl != NULL)
> + {
> + n++;
> + decl = TREE_CHAIN (decl);
> + }
> +
> + if (n > 0)
> + {
> + int i = 0;
> + tree vec[n];
to simplify this and to avoid huge stack usage it might
be easier to use an auto_vec<tree> here and simply
pushing the chain onto that, passing .address () to
wrapup_global_declarations.
> + decl = globals;
> + while (decl != NULL)
> + {
> + vec[i] = decl;
> + decl = TREE_CHAIN (decl);
> + i++;
> + }
> + wrapup_global_declarations (vec, n);
> + }
> +}
> +
> +/* Write out globals. */
> +
> +static void
> +write_globals (void)
> +{
> + tree t;
> + unsigned i;
> +
> + m2block_finishGlobals ();
> +
> + /* Process all file scopes in this compilation, and the
> + external_scope, through wrapup_global_declarations and
> + check_global_declarations. */
> + FOR_EACH_VEC_ELT (*all_translation_units, i, t)
> + m2_write_global_declarations (BLOCK_VARS (DECL_INITIAL (t)));
> +}
> +
> +
> +/* Gimplify an EXPR_STMT node. */
> +
> +static void
> +gimplify_expr_stmt (tree *stmt_p)
> +{
> + gcc_assert (EXPR_STMT_EXPR (*stmt_p) != NULL_TREE);
> +
> + *stmt_p = EXPR_STMT_EXPR (*stmt_p);
> +}
> +
> +/* Genericize a TRY_BLOCK. */
> +
> +static void
> +genericize_try_block (tree *stmt_p)
> +{
> + tree body = TRY_STMTS (*stmt_p);
> + tree cleanup = TRY_HANDLERS (*stmt_p);
> +
> + *stmt_p = build2 (TRY_CATCH_EXPR, void_type_node, body, cleanup);
> +}
> +
> +/* Genericize a HANDLER by converting to a CATCH_EXPR. */
> +
> +static void
> +genericize_catch_block (tree *stmt_p)
> +{
> + tree type = HANDLER_TYPE (*stmt_p);
> + tree body = HANDLER_BODY (*stmt_p);
> +
> + /* FIXME should the caught type go in TREE_TYPE? */
> + *stmt_p = build2 (CATCH_EXPR, void_type_node, type, body);
> +}
> +
> +/* Convert the tree representation of FNDECL from m2 frontend trees
> + to GENERIC. */
> +
> +extern void pf (tree);
> +
> +void
> +gm2_genericize (tree fndecl)
> +{
> + tree t;
> + struct cgraph_node *cgn;
> +
> +#if 0
> + pf (fndecl);
> +#endif
> + /* Fix up the types of parms passed by invisible reference. */
> + for (t = DECL_ARGUMENTS (fndecl); t; t = DECL_CHAIN (t))
> + if (TREE_ADDRESSABLE (TREE_TYPE (t)))
> + {
> +
> + /* If a function's arguments are copied to create a thunk, then
> + DECL_BY_REFERENCE will be set -- but the type of the argument will be
> + a pointer type, so we will never get here. */
> + gcc_assert (!DECL_BY_REFERENCE (t));
> + gcc_assert (DECL_ARG_TYPE (t) != TREE_TYPE (t));
> + TREE_TYPE (t) = DECL_ARG_TYPE (t);
> + DECL_BY_REFERENCE (t) = 1;
> + TREE_ADDRESSABLE (t) = 0;
> + relayout_decl (t);
> + }
> +
> + /* Dump all nested functions now. */
> + cgn = cgraph_node::get_create (fndecl);
> + for (cgn = first_nested_function (cgn);
> + cgn != NULL; cgn = next_nested_function (cgn))
> + gm2_genericize (cgn->decl);
> +}
> +
> +/* gm2 gimplify expression, currently just change THROW in the same
> + way as C++ */
> +
> +static int
> +gm2_langhook_gimplify_expr (tree *expr_p, gimple_seq *pre_p ATTRIBUTE_UNUSED,
> + gimple_seq *post_p ATTRIBUTE_UNUSED)
> +{
> + enum tree_code code = TREE_CODE (*expr_p);
> +
> + switch (code)
> + {
> + case THROW_EXPR:
> +
> + /* FIXME communicate throw type to back end, probably by moving
> + THROW_EXPR into ../tree.def. */
> + *expr_p = TREE_OPERAND (*expr_p, 0);
> + return GS_OK;
> +
> + case EXPR_STMT:
> + gimplify_expr_stmt (expr_p);
> + return GS_OK;
> +
> + case TRY_BLOCK:
> + genericize_try_block (expr_p);
> + return GS_OK;
> +
> + case HANDLER:
> + genericize_catch_block (expr_p);
> + return GS_OK;
> +
> + default:
> + return GS_UNHANDLED;
> + }
> +}
> +
> +/* FIXME: This is a hack to preserve trees that we create from the
> + garbage collector. */
> +
> +static GTY (()) tree gm2_gc_root;
> +static tree personality_decl = NULL_TREE;
> +
> +static void
> +gm2_preserve_from_gc (tree t)
> +{
> + gm2_gc_root = tree_cons (NULL_TREE, t, gm2_gc_root);
I suppose it's difficult to properly mark roots in the m2 sources?
I'll note that using a tree_list is prone to deep GC mark stacks,
eventually a vec<tree, va_gc> might be more efficient here.
Since more frontends seem to use hacks like this "support"
for this from the GC itself might be nice (even if just having
this "hackish" GC root globally). Just an idea for the future.
> +}
> +
> +/* Return a decl for the exception personality function. */
> +
> +static tree
> +gm2_langhook_eh_personality (void)
> +{
> + if (personality_decl == NULL_TREE)
> + {
> + personality_decl = build_personality_function ("gxx");
> + gm2_preserve_from_gc (personality_decl);
For example the C++ frontend just has a global
static GTY(()) tree cp_eh_personality_decl;
> + }
> + return personality_decl;
> +}
> +
> +/* Functions called directly by the generic backend. */
> +tree
> +convert_loc (location_t location, tree type, tree expr)
> +{
> + if (type == error_mark_node || expr == error_mark_node
> + || TREE_TYPE (expr) == error_mark_node)
> + return error_mark_node;
> +
> + if (type == TREE_TYPE (expr))
> + return expr;
> +
> + gcc_assert (TYPE_MAIN_VARIANT (type) != NULL);
> + if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
> + return fold_convert (type, expr);
> +
> + expr = m2convert_GenericToType (location, type, expr);
> + switch (TREE_CODE (type))
> + {
> + case VOID_TYPE:
> + case BOOLEAN_TYPE:
> + return fold_convert (type, expr);
> + case INTEGER_TYPE:
> + return fold (convert_to_integer (type, expr));
> + case POINTER_TYPE:
> + return fold (convert_to_pointer (type, expr));
> + case REAL_TYPE:
> + return fold (convert_to_real (type, expr));
> + case COMPLEX_TYPE:
> + return fold (convert_to_complex (type, expr));
> + case ENUMERAL_TYPE:
> + return fold (convert_to_integer (type, expr));
> + default:
> + error_at (location, "cannot convert expression, only base types can be converted");
> + break;
> + }
> + return error_mark_node;
> +}
> +
> +/* Functions called directly by the generic backend. */
In theory, if the frontend doesn't call convert_* from gcc/convert.{h,cc} then
these shouldn't be necessary and are never called (but we build and link
convert.cc so they have to be present) - does the m2 frontend use those?
If not it _shoult_ work to simply have a gcc_unreachable () in them ..
(and we should have a LANG_USES_CONVERT language macro to gate
compiling of convert.cc or simply adjust all the lang/Make-lang.in to include
it when necessary, moving convert.{cc,h} to a new gcc/lang-common/
directory).
> +tree
> +convert (tree type, tree expr)
> +{
> + return convert_loc (m2linemap_UnknownLocation (), type, expr);
> +}
> +
> +/* Mark EXP saying that we need to be able to take the address of it;
> + it should not be allocated in a register. Returns true if
> + successful. */
> +
> +bool
> +gm2_mark_addressable (tree exp)
> +{
> + tree x = exp;
> +
> + while (TRUE)
> + switch (TREE_CODE (x))
> + {
> + case COMPONENT_REF:
> + if (DECL_PACKED (TREE_OPERAND (x, 1)))
> + return false;
> + x = TREE_OPERAND (x, 0);
> + break;
> +
> + case ADDR_EXPR:
> + case ARRAY_REF:
> + case REALPART_EXPR:
> + case IMAGPART_EXPR:
> + x = TREE_OPERAND (x, 0);
> + break;
> +
> + case COMPOUND_LITERAL_EXPR:
> + case CONSTRUCTOR:
> + case STRING_CST:
> + case VAR_DECL:
> + case CONST_DECL:
> + case PARM_DECL:
> + case RESULT_DECL:
> + case FUNCTION_DECL:
> + TREE_ADDRESSABLE (x) = 1;
> + return true;
> + default:
> + return true;
> + }
> + /* Never reach here. */
> + gcc_unreachable ();
> +}
> +
> +/* Return an integer type with BITS bits of precision, that is
> + unsigned if UNSIGNEDP is nonzero, otherwise signed. */
> +
> +tree
> +gm2_type_for_size (unsigned int bits, int unsignedp)
> +{
> + tree type;
> +
> + if (unsignedp)
> + {
> + if (bits == INT_TYPE_SIZE)
> + type = unsigned_type_node;
> + else if (bits == CHAR_TYPE_SIZE)
> + type = unsigned_char_type_node;
> + else if (bits == SHORT_TYPE_SIZE)
> + type = short_unsigned_type_node;
> + else if (bits == LONG_TYPE_SIZE)
> + type = long_unsigned_type_node;
> + else if (bits == LONG_LONG_TYPE_SIZE)
> + type = long_long_unsigned_type_node;
> + else
> + type = make_unsigned_type (bits);
You want to use build_nonstandard_integer_type instead
here, otherwise each call gets a distinct type which is probably
not intended. Frontends are fine to return NULL_TREE for
unhandled cases though.
Again the c-family/c-common.cc or the lto-lang.cc implementations
might be worth looking at.
> + }
> + else
> + {
> + if (bits == INT_TYPE_SIZE)
> + type = integer_type_node;
> + else if (bits == CHAR_TYPE_SIZE)
> + type = signed_char_type_node;
> + else if (bits == SHORT_TYPE_SIZE)
> + type = short_integer_type_node;
> + else if (bits == LONG_TYPE_SIZE)
> + type = long_integer_type_node;
> + else if (bits == LONG_LONG_TYPE_SIZE)
> + type = long_long_integer_type_node;
> + else
> + type = make_signed_type (bits);
> + }
> + return type;
> +}
> +
> +/* Allow the analyzer to understand Storage ALLOCATE/DEALLOCATE. */
> +
> +bool
> +gm2_langhook_new_dispose_storage_substitution (void)
> +{
> + return true;
> +}
> +
> +#undef LANG_HOOKS_NAME
> +#undef LANG_HOOKS_INIT
> +#undef LANG_HOOKS_INIT_OPTIONS
> +#undef LANG_HOOKS_OPTION_LANG_MASK
> +#undef LANG_HOOKS_INIT_OPTIONS_STRUCT
> +#undef LANG_HOOKS_HANDLE_OPTION
> +#undef LANG_HOOKS_POST_OPTIONS
> +#undef LANG_HOOKS_PARSE_FILE
> +#undef LANG_HOOKS_TYPE_FOR_MODE
> +#undef LANG_HOOKS_TYPE_FOR_SIZE
> +#undef LANG_HOOKS_BUILTIN_FUNCTION
> +#undef LANG_HOOKS_GLOBAL_BINDINGS_P
> +#undef LANG_HOOKS_PUSHDECL
> +#undef LANG_HOOKS_GETDECLS
> +#undef LANG_HOOKS_GIMPLIFY_EXPR
> +#undef LANG_HOOKS_EH_PERSONALITY
> +#undef LANG_HOOKS_NEW_DISPOSE_STORAGE_SUBSTITUTION
> +
> +#define LANG_HOOKS_NAME "GNU Modula-2"
> +#define LANG_HOOKS_INIT gm2_langhook_init
> +#define LANG_HOOKS_INIT_OPTIONS gm2_langhook_init_options
> +#define LANG_HOOKS_OPTION_LANG_MASK gm2_langhook_option_lang_mask
> +#define LANG_HOOKS_INIT_OPTIONS_STRUCT gm2_langhook_init_options_struct
> +#define LANG_HOOKS_HANDLE_OPTION gm2_langhook_handle_option
> +#define LANG_HOOKS_POST_OPTIONS gm2_langhook_post_options
> +#define LANG_HOOKS_PARSE_FILE gm2_langhook_parse_file
> +#define LANG_HOOKS_TYPE_FOR_MODE gm2_langhook_type_for_mode
> +#define LANG_HOOKS_TYPE_FOR_SIZE gm2_langhook_type_for_size
> +#define LANG_HOOKS_BUILTIN_FUNCTION gm2_langhook_builtin_function
> +#define LANG_HOOKS_GLOBAL_BINDINGS_P gm2_langhook_global_bindings_p
> +#define LANG_HOOKS_PUSHDECL gm2_langhook_pushdecl
> +#define LANG_HOOKS_GETDECLS gm2_langhook_getdecls
> +#define LANG_HOOKS_GIMPLIFY_EXPR gm2_langhook_gimplify_expr
> +#define LANG_HOOKS_EH_PERSONALITY gm2_langhook_eh_personality
> +#define LANG_HOOKS_NEW_DISPOSE_STORAGE_SUBSTITUTION \
> + gm2_langhook_new_dispose_storage_substitution
> +
> +struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
> +
> +#include "gt-m2-gm2-lang.h"
> +#include "gtype-m2.h"
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-lang.h
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/gm2-lang.h 2022-10-07 20:21:18.650096940 +0100
> @@ -0,0 +1,56 @@
> +/* Language-dependent hooks for GNU Modula-2.
> + Copyright (C) 2003-2022 Free Software Foundation, Inc.
> + Contributed by Gaius Mulley <gaius@glam.ac.uk>
> +
> +This file is part of GNU CC.
> +
> +GNU CC 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.
> +
> +GNU CC 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 GNU CC; see the file COPYING. If not, write to
> +the Free Software Foundation, 51 Franklin Street, Fifth Floor,
> +Boston, MA 02110-1301, USA. */
> +
> +#if !defined(GM2_LANG_H)
> +# define GM2_LANG_H
> +
> +#if defined(GM2_LANG_C)
> +# define EXTERN
> +#else
> +# define EXTERN extern
> +#endif
> +#include "config.h"
> +#include "system.h"
> +#include "ansidecl.h"
> +#include "coretypes.h"
> +#include "opts.h"
> +#include "tree.h"
> +#include "gimple.h"
> +
> +
> +EXTERN enum gimplify_status gm2_gimplify_expr (tree *, tree *, tree *);
> +EXTERN bool gm2_mark_addressable (tree);
> +EXTERN tree gm2_type_for_size (unsigned int bits, int unsignedp);
> +EXTERN tree gm2_type_for_mode (enum machine_mode mode, int unsignedp);
> +EXTERN bool gm2_langhook_init (void);
> +EXTERN bool gm2_langhook_handle_option (size_t scode, const char *arg,
> + int value,
> + int kind ATTRIBUTE_UNUSED,
> + location_t loc ATTRIBUTE_UNUSED,
> + const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED);
> +EXTERN void gm2_langhook_init_options (unsigned int decoded_options_count,
> + struct cl_decoded_option *decoded_options);
> +EXTERN void gm2_genericize (tree fndecl);
> +EXTERN tree convert_loc (location_t location, tree type, tree expr);
> +
> +
> +#undef EXTERN
> +#endif
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2version.h
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/gm2version.h 2022-10-07 20:21:18.662097087 +0100
> @@ -0,0 +1,22 @@
> +/* gm2version provides access to the gm2 front end version number.
> +
> +Copyright (C) 2008-2022 Free Software Foundation, Inc.
> +Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
> +
> +This file is part of GNU Modula-2.
> +
> +GNU Modula-2 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.
> +
> +GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
> +<http://www.gnu.org/licenses/>. */
> +
> +extern void gm2_version (int need_to_exit);
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2.flex
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/m2.flex 2022-10-07 20:21:18.662097087 +0100
> @@ -0,0 +1,760 @@
> +%{
> +/* m2.flex implements lexical analysis for Modula-2.
> +
> +Copyright (C) 2004-2022 Free Software Foundation, Inc.
> +Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
> +
> +This file is part of GNU Modula-2.
> +
> +GNU Modula-2 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.
> +
> +GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
> +<http://www.gnu.org/licenses/>. */
> +
> +#include "gm2-gcc/gcc-consolidation.h"
> +
> +#include "GM2Reserved.h"
> +#include "GM2LexBuf.h"
> +#include "input.h"
> +#include "m2options.h"
> +
> +
> +#if defined(GM2USEGGC)
> +# include "ggc.h"
> +#endif
> +
> +#include "timevar.h"
> +
> +#define START_FILE(F,L) m2linemap_StartFile(F,L)
> +#define END_FILE() m2linemap_EndFile()
> +#define START_LINE(N,S) m2linemap_StartLine(N,S)
> +#define GET_LOCATION(COLUMN_START,COLUMN_END) \
> + m2linemap_GetLocationRange(COLUMN_START,COLUMN_END)
> +#define TIMEVAR_PUSH_LEX timevar_push (TV_LEX)
> +#define TIMEVAR_POP_LEX timevar_pop (TV_LEX)
> +
> +#ifdef __cplusplus
> +#define EXTERN extern "C"
> +#endif
> +
> + /* m2.flex provides a lexical analyser for GNU Modula-2. */
> +
> + struct lineInfo {
> + char *linebuf; /* line contents */
> + int linelen; /* length */
> + int tokenpos; /* start position of token within line */
> + int toklen; /* a copy of yylen (length of token) */
> + int nextpos; /* position after token */
> + int lineno; /* line number of this line */
> + int column; /* first column number of token on this line */
> + int inuse; /* do we need to keep this line info? */
> + location_t location; /* the corresponding gcc location_t */
> + struct lineInfo *next;
> + };
> +
> + struct functionInfo {
> + char *name; /* function name */
> + int module; /* is it really a module? */
> + struct functionInfo *next; /* list of nested functions */
> + };
> +
> + static int lineno =1; /* a running count of the file line number */
> + static char *filename =NULL;
> + static int commentLevel=0;
> + static struct lineInfo *currentLine=NULL;
> + static struct functionInfo *currentFunction=NULL;
> + static int seenFunctionStart=FALSE;
> + static int seenEnd=FALSE;
> + static int seenModuleStart=FALSE;
> + static int isDefinitionModule=FALSE;
> + static int totalLines=0;
> +
> +static void pushLine (void);
> +static void popLine (void);
> +static void finishedLine (void);
> +static void resetpos (void);
> +static void consumeLine (void);
> +static void updatepos (void);
> +static void skippos (void);
> +static void poperrorskip (const char *);
> +static void endOfComment (void);
> +static void handleDate (void);
> +static void handleLine (void);
> +static void handleFile (void);
> +static void handleFunction (void);
> +static void handleColumn (void);
> +static void pushFunction (char *function, int module);
> +static void popFunction (void);
> +static void checkFunction (void);
> +EXTERN void m2flex_M2Error (const char *);
> +EXTERN location_t m2flex_GetLocation (void);
> +EXTERN int m2flex_GetColumnNo (void);
> +EXTERN int m2flex_OpenSource (char *s);
> +EXTERN int m2flex_GetLineNo (void);
> +EXTERN void m2flex_CloseSource (void);
> +EXTERN char *m2flex_GetToken (void);
> +EXTERN void _M2_m2flex_init (void);
> +EXTERN int m2flex_GetTotalLines (void);
> +extern void yylex (void);
> +
> +#if !defined(TRUE)
> +# define TRUE (1==1)
> +#endif
> +#if !defined(FALSE)
> +# define FALSE (1==0)
> +#endif
> +
> +#define YY_DECL void yylex (void)
> +%}
> +
> +%option nounput
> +%x COMMENT COMMENT1 LINE0 LINE1 LINE2
> +
> +%%
> +
> +"(*" { updatepos();
> + commentLevel=1; pushLine(); skippos();
> + BEGIN COMMENT; }
> +<COMMENT>"*)" { endOfComment(); }
> +<COMMENT>"(*" { commentLevel++; pushLine(); updatepos(); skippos(); }
> +<COMMENT>"<*" { if (commentLevel == 1) {
> + updatepos();
> + pushLine();
> + skippos();
> + BEGIN COMMENT1;
> + } else
> + updatepos(); skippos();
> + }
> +<COMMENT>\n.* { consumeLine(); }
> +<COMMENT>. { updatepos(); skippos(); }
> +<COMMENT1>. { updatepos(); skippos(); }
> +<COMMENT1>"*>" { updatepos(); skippos(); finishedLine(); BEGIN COMMENT; }
> +<COMMENT1>\n.* { consumeLine(); }
> +<COMMENT1>"*)" { poperrorskip("unterminated source code directive, missing *>");
> + endOfComment(); }
> +<COMMENT1><<EOF>> { poperrorskip("unterminated source code directive, missing *>"); BEGIN COMMENT; }
> +<COMMENT><<EOF>> { poperrorskip("unterminated comment found at the end of the file, missing *)"); BEGIN INITIAL; }
> +
> +^\#.* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
> +\n\#.* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
> +<LINE0>\#[ \t]* { updatepos(); }
> +<LINE0>[0-9]+[ \t]*\" { updatepos(); lineno=atoi(yytext)-1; BEGIN LINE1; }
> +<LINE0>\n { m2flex_M2Error("missing initial quote after #line directive"); resetpos(); BEGIN INITIAL; }
> +<LINE0>[^\n]
> +<LINE1>[^\"\n]+ { m2flex_M2Error("missing final quote after #line directive"); resetpos(); BEGIN INITIAL; }
> +<LINE1>.*\" { updatepos();
> + filename = (char *)xrealloc(filename, yyleng+1);
> + strcpy(filename, yytext);
> + filename[yyleng-1] = (char)0; /* remove trailing quote */
> + START_FILE (filename, lineno);
> + BEGIN LINE2;
> + }
> +<LINE2>[ \t]* { updatepos(); }
> +<LINE2>\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
> +<LINE2>2[ \t]*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
> +<LINE2>1[ \t]*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
> +<LINE2>1[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
> +<LINE2>2[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
> +<LINE2>3[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
> +
> +\n[^\#].* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
> +\n { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
> +
> +\"[^\"\n]*\" { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; }
> +\"[^\"\n]*$ { updatepos();
> + m2flex_M2Error("missing terminating quote, \"");
> + resetpos(); return;
> + }
> +
> +'[^'\n]*' { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; }
> +'[^'\n]*$ { updatepos();
> + m2flex_M2Error("missing terminating quote, '");
> + resetpos(); return;
> + }
> +
> +<<EOF>> { updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return; }
> +\+ { updatepos(); M2LexBuf_AddTok(M2Reserved_plustok); return; }
> +- { updatepos(); M2LexBuf_AddTok(M2Reserved_minustok); return; }
> +"*" { updatepos(); M2LexBuf_AddTok(M2Reserved_timestok); return; }
> +\/ { updatepos(); M2LexBuf_AddTok(M2Reserved_dividetok); return; }
> +:= { updatepos(); M2LexBuf_AddTok(M2Reserved_becomestok); return; }
> +\& { updatepos(); M2LexBuf_AddTok(M2Reserved_ambersandtok); return; }
> +\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodtok); return; }
> +\, { updatepos(); M2LexBuf_AddTok(M2Reserved_commatok); return; }
> +\; { updatepos(); M2LexBuf_AddTok(M2Reserved_semicolontok); return; }
> +\( { updatepos(); M2LexBuf_AddTok(M2Reserved_lparatok); return; }
> +\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rparatok); return; }
> +\[ { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; }
> +\] { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; }
> +\(\! { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; }
> +\!\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; }
> +\^ { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; }
> +\@ { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; }
> +\{ { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; }
> +\} { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; }
> +\(\: { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; }
> +\:\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; }
> +\' { updatepos(); M2LexBuf_AddTok(M2Reserved_singlequotetok); return; }
> +\= { updatepos(); M2LexBuf_AddTok(M2Reserved_equaltok); return; }
> +\# { updatepos(); M2LexBuf_AddTok(M2Reserved_hashtok); return; }
> +\< { updatepos(); M2LexBuf_AddTok(M2Reserved_lesstok); return; }
> +\> { updatepos(); M2LexBuf_AddTok(M2Reserved_greatertok); return; }
> +\<\> { updatepos(); M2LexBuf_AddTok(M2Reserved_lessgreatertok); return; }
> +\<\= { updatepos(); M2LexBuf_AddTok(M2Reserved_lessequaltok); return; }
> +\>\= { updatepos(); M2LexBuf_AddTok(M2Reserved_greaterequaltok); return; }
> +"<*" { updatepos(); M2LexBuf_AddTok(M2Reserved_ldirectivetok); return; }
> +"*>" { updatepos(); M2LexBuf_AddTok(M2Reserved_rdirectivetok); return; }
> +\.\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodtok); return; }
> +\.\.\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodperiodtok); return; }
> +\: { updatepos(); M2LexBuf_AddTok(M2Reserved_colontok); return; }
> +\" { updatepos(); M2LexBuf_AddTok(M2Reserved_doublequotestok); return; }
> +\| { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; }
> +\! { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; }
> +\~ { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; }
> +AND { updatepos(); M2LexBuf_AddTok(M2Reserved_andtok); return; }
> +ARRAY { updatepos(); M2LexBuf_AddTok(M2Reserved_arraytok); return; }
> +BEGIN { updatepos(); M2LexBuf_AddTok(M2Reserved_begintok); return; }
> +BY { updatepos(); M2LexBuf_AddTok(M2Reserved_bytok); return; }
> +CASE { updatepos(); M2LexBuf_AddTok(M2Reserved_casetok); return; }
> +CONST { updatepos(); M2LexBuf_AddTok(M2Reserved_consttok); return; }
> +DEFINITION { updatepos(); isDefinitionModule = TRUE;
> + M2LexBuf_AddTok(M2Reserved_definitiontok); return; }
> +DIV { updatepos(); M2LexBuf_AddTok(M2Reserved_divtok); return; }
> +DO { updatepos(); M2LexBuf_AddTok(M2Reserved_dotok); return; }
> +ELSE { updatepos(); M2LexBuf_AddTok(M2Reserved_elsetok); return; }
> +ELSIF { updatepos(); M2LexBuf_AddTok(M2Reserved_elsiftok); return; }
> +END { updatepos(); seenEnd=TRUE;
> + M2LexBuf_AddTok(M2Reserved_endtok); return; }
> +EXCEPT { updatepos(); M2LexBuf_AddTok(M2Reserved_excepttok); return; }
> +EXIT { updatepos(); M2LexBuf_AddTok(M2Reserved_exittok); return; }
> +EXPORT { updatepos(); M2LexBuf_AddTok(M2Reserved_exporttok); return; }
> +FINALLY { updatepos(); M2LexBuf_AddTok(M2Reserved_finallytok); return; }
> +FOR { updatepos(); M2LexBuf_AddTok(M2Reserved_fortok); return; }
> +FROM { updatepos(); M2LexBuf_AddTok(M2Reserved_fromtok); return; }
> +IF { updatepos(); M2LexBuf_AddTok(M2Reserved_iftok); return; }
> +IMPLEMENTATION { updatepos(); M2LexBuf_AddTok(M2Reserved_implementationtok); return; }
> +IMPORT { updatepos(); M2LexBuf_AddTok(M2Reserved_importtok); return; }
> +IN { updatepos(); M2LexBuf_AddTok(M2Reserved_intok); return; }
> +LOOP { updatepos(); M2LexBuf_AddTok(M2Reserved_looptok); return; }
> +MOD { updatepos(); M2LexBuf_AddTok(M2Reserved_modtok); return; }
> +MODULE { updatepos(); seenModuleStart=TRUE;
> + M2LexBuf_AddTok(M2Reserved_moduletok); return; }
> +NOT { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; }
> +OF { updatepos(); M2LexBuf_AddTok(M2Reserved_oftok); return; }
> +OR { updatepos(); M2LexBuf_AddTok(M2Reserved_ortok); return; }
> +PACKEDSET { updatepos(); M2LexBuf_AddTok(M2Reserved_packedsettok); return; }
> +POINTER { updatepos(); M2LexBuf_AddTok(M2Reserved_pointertok); return; }
> +PROCEDURE { updatepos(); seenFunctionStart=TRUE;
> + M2LexBuf_AddTok(M2Reserved_proceduretok); return; }
> +QUALIFIED { updatepos(); M2LexBuf_AddTok(M2Reserved_qualifiedtok); return; }
> +UNQUALIFIED { updatepos(); M2LexBuf_AddTok(M2Reserved_unqualifiedtok); return; }
> +RECORD { updatepos(); M2LexBuf_AddTok(M2Reserved_recordtok); return; }
> +REM { updatepos(); M2LexBuf_AddTok(M2Reserved_remtok); return; }
> +REPEAT { updatepos(); M2LexBuf_AddTok(M2Reserved_repeattok); return; }
> +RETRY { updatepos(); M2LexBuf_AddTok(M2Reserved_retrytok); return; }
> +RETURN { updatepos(); M2LexBuf_AddTok(M2Reserved_returntok); return; }
> +SET { updatepos(); M2LexBuf_AddTok(M2Reserved_settok); return; }
> +THEN { updatepos(); M2LexBuf_AddTok(M2Reserved_thentok); return; }
> +TO { updatepos(); M2LexBuf_AddTok(M2Reserved_totok); return; }
> +TYPE { updatepos(); M2LexBuf_AddTok(M2Reserved_typetok); return; }
> +UNTIL { updatepos(); M2LexBuf_AddTok(M2Reserved_untiltok); return; }
> +VAR { updatepos(); M2LexBuf_AddTok(M2Reserved_vartok); return; }
> +WHILE { updatepos(); M2LexBuf_AddTok(M2Reserved_whiletok); return; }
> +WITH { updatepos(); M2LexBuf_AddTok(M2Reserved_withtok); return; }
> +ASM { updatepos(); M2LexBuf_AddTok(M2Reserved_asmtok); return; }
> +VOLATILE { updatepos(); M2LexBuf_AddTok(M2Reserved_volatiletok); return; }
> +\_\_DATE\_\_ { updatepos(); handleDate(); return; }
> +\_\_LINE\_\_ { updatepos(); handleLine(); return; }
> +\_\_FILE\_\_ { updatepos(); handleFile(); return; }
> +\_\_FUNCTION\_\_ { updatepos(); handleFunction(); return; }
> +\_\_COLUMN\_\_ { updatepos(); handleColumn(); return; }
> +\_\_ATTRIBUTE\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_attributetok); return; }
> +\_\_BUILTIN\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_builtintok); return; }
> +\_\_INLINE\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_inlinetok); return; }
> +
> +
> +(([0-9]*\.[0-9]+)(E[+-]?[0-9]+)?) { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
> +[0-9]*\.E[+-]?[0-9]+ { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
> +[a-zA-Z_][a-zA-Z0-9_]* { checkFunction(); updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_identtok, yytext); return; }
> +[0-9]+ { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
> +[0-9]+B { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
> +[0-9]+C { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
> +[0-9A-F]+H { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
> +[\t\r ]+ { currentLine->tokenpos += yyleng; /* Ignore space. */; }
> +. { updatepos(); m2flex_M2Error("unrecognised symbol"); skippos(); }
> +
> +%%
> +
> +/* have removed the -? from the beginning of the real/integer constant literal rules */
> +
> +/*
> + * hand built routines
> + */
> +
> +/*
> + * handleFile - handles the __FILE__ construct by wraping it in double quotes and putting
> + * it into the token buffer as a string.
> + */
> +
> +static void handleFile (void)
> +{
> + char *s = (char *)alloca(strlen(filename)+2+1);
> +
> + strcpy(s, "\"");
> + strcat(s, filename);
> + strcat(s, "\"");
> + M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
> +}
> +
> +/*
> + * handleLine - handles the __LINE__ construct by passing an integer to
> + * the token buffer.
> + */
> +
> +static void handleLine (void)
> +{
> + M2LexBuf_AddTokInteger(M2Reserved_integertok, lineno);
> +}
> +
> +/*
> + * handleColumn - handles the __COLUMN__ construct by passing an integer to
> + * the token buffer.
> + */
> +
> +static void handleColumn (void)
> +{
> + M2LexBuf_AddTokInteger(M2Reserved_integertok, m2flex_GetColumnNo());
> +}
> +
> +/*
> + * handleDate - handles the __DATE__ construct by passing the date
> + * as a string to the token buffer.
> + */
> +
> +static void handleDate (void)
> +{
> + time_t clock = time ((time_t *)0);
> + char *sdate = ctime (&clock);
> + char *s = (char *) alloca (strlen (sdate) + 2 + 1);
> + char *p = index (sdate, '\n');
> +
> + if (p != NULL) {
> + *p = (char) 0;
> + }
> + strcpy(s, "\"");
> + strcat(s, sdate);
> + strcat(s, "\"");
> + M2LexBuf_AddTokCharStar (M2Reserved_stringtok, s);
> +}
> +
> +/*
> + * handleFunction - handles the __FUNCTION__ construct by wrapping
> + * it in double quotes and putting it into the token
> + * buffer as a string.
> + */
> +
> +static void handleFunction (void)
> +{
> + if (currentFunction == NULL)
> + M2LexBuf_AddTokCharStar(M2Reserved_stringtok, const_cast<char *>("\"\""));
> + else if (currentFunction->module) {
> + char *s = (char *) alloca(strlen(yytext) +
> + strlen("\"module initialization\"") + 1);
> + strcpy(s, "\"module ");
> + strcat(s, currentFunction->name);
> + strcat(s, " initialization\"");
> + M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
> + } else {
> + char *function = currentFunction->name;
> + char *s = (char *)alloca(strlen(function)+2+1);
> + strcpy(s, "\"");
> + strcat(s, function);
> + strcat(s, "\"");
> + M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
> + }
> +}
> +
> +/*
> + * pushFunction - pushes the function name onto the stack.
> + */
> +
> +static void pushFunction (char *function, int module)
> +{
> + if (currentFunction == NULL) {
> + currentFunction = (struct functionInfo *)xmalloc (sizeof (struct functionInfo));
> + currentFunction->name = xstrdup(function);
> + currentFunction->next = NULL;
> + currentFunction->module = module;
> + } else {
> + struct functionInfo *f = (struct functionInfo *)xmalloc (sizeof (struct functionInfo));
> + f->name = xstrdup(function);
> + f->next = currentFunction;
> + f->module = module;
> + currentFunction = f;
> + }
> +}
> +
> +/*
> + * popFunction - pops the current function.
> + */
> +
> +static void popFunction (void)
> +{
> + if (currentFunction != NULL && currentFunction->next != NULL) {
> + struct functionInfo *f = currentFunction;
> +
> + currentFunction = currentFunction->next;
> + if (f->name != NULL)
> + free(f->name);
> + free(f);
> + }
> +}
> +
> +/*
> + * endOfComment - handles the end of comment
> + */
> +
> +static void endOfComment (void)
> +{
> + commentLevel--;
> + updatepos();
> + skippos();
> + if (commentLevel==0) {
> + BEGIN INITIAL;
> + finishedLine();
> + } else
> + popLine();
> +}
> +
> +/*
> + * m2flex_M2Error - displays the error message, s, after the code line and pointer
> + * to the erroneous token.
> + */
> +
> +EXTERN void m2flex_M2Error (const char *s)
> +{
> + if (currentLine->linebuf != NULL) {
> + int i=1;
> +
> + printf("%s:%d:%s\n", filename, currentLine->lineno, currentLine->linebuf);
> + printf("%s:%d:%*s", filename, currentLine->lineno, 1+currentLine->tokenpos, "^");
> + while (i<currentLine->toklen) {
> + putchar('^');
> + i++;
> + }
> + putchar('\n');
> + }
> + printf("%s:%d:%s\n", filename, currentLine->lineno, s);
> +}
> +
> +static void poperrorskip (const char *s)
> +{
> + int nextpos =currentLine->nextpos;
> + int tokenpos=currentLine->tokenpos;
> +
> + popLine();
> + m2flex_M2Error(s);
> + if (currentLine != NULL) {
> + currentLine->nextpos = nextpos;
> + currentLine->tokenpos = tokenpos;
> + }
> +}
> +
> +/*
> + * consumeLine - reads a line into a buffer, it then pushes back the whole
> + * line except the initial \n.
> + */
> +
> +static void consumeLine (void)
> +{
> + if (currentLine->linelen<yyleng) {
> + currentLine->linebuf = (char *)xrealloc (currentLine->linebuf, yyleng);
> + currentLine->linelen = yyleng;
> + }
> + strcpy(currentLine->linebuf, yytext+1); /* copy all except the initial \n */
> + lineno++;
> + totalLines++;
> + currentLine->lineno = lineno;
> + currentLine->tokenpos=0;
> + currentLine->nextpos=0;
> + currentLine->column=0;
> + START_LINE (lineno, yyleng);
> + yyless(1); /* push back all but the \n */
> +}
> +
> +static void assert_location (location_t location ATTRIBUTE_UNUSED)
> +{
> +#if 0
> + if ((location != BUILTINS_LOCATION) && (location != UNKNOWN_LOCATION) && (! M2Options_GetCpp ())) {
> + expanded_location xl = expand_location (location);
> + if (xl.line != currentLine->lineno) {
> + m2flex_M2Error ("mismatched gcc location and front end token number");
> + }
> + }
> +#endif
> +}
> +
> +/*
> + * updatepos - updates the current token position.
> + * Should be used when a rule matches a token.
> + */
> +
> +static void updatepos (void)
> +{
> + seenFunctionStart = FALSE;
> + seenEnd = FALSE;
> + seenModuleStart = FALSE;
> + currentLine->nextpos = currentLine->tokenpos+yyleng;
> + currentLine->toklen = yyleng;
> + /* if (currentLine->column == 0) */
> + currentLine->column = currentLine->tokenpos+1;
> + currentLine->location =
> + M2Options_OverrideLocation (GET_LOCATION (currentLine->column,
> + currentLine->column+currentLine->toklen-1));
> + assert_location (GET_LOCATION (currentLine->column,
> + currentLine->column+currentLine->toklen-1));
> +}
> +
> +/*
> + * checkFunction - checks to see whether we have seen the start
> + * or end of a function.
> + */
> +
> +static void checkFunction (void)
> +{
> + if (! isDefinitionModule) {
> + if (seenModuleStart)
> + pushFunction(yytext, 1);
> + if (seenFunctionStart)
> + pushFunction(yytext, 0);
> + if (seenEnd && currentFunction != NULL &&
> + (strcmp(currentFunction->name, yytext) == 0))
> + popFunction();
> + }
> + seenFunctionStart = FALSE;
> + seenEnd = FALSE;
> + seenModuleStart = FALSE;
> +}
> +
> +/*
> + * skippos - skips over this token. This function should be called
> + * if we are not returning and thus not calling getToken.
> + */
> +
> +static void skippos (void)
> +{
> + currentLine->tokenpos = currentLine->nextpos;
> +}
> +
> +/*
> + * initLine - initializes a currentLine
> + */
> +
> +static void initLine (void)
> +{
> + currentLine = (struct lineInfo *)xmalloc (sizeof(struct lineInfo));
> +
> + if (currentLine == NULL)
> + perror("xmalloc");
> + currentLine->linebuf = NULL;
> + currentLine->linelen = 0;
> + currentLine->tokenpos = 0;
> + currentLine->toklen = 0;
> + currentLine->nextpos = 0;
> + currentLine->lineno = lineno;
> + currentLine->column = 0;
> + currentLine->inuse = TRUE;
> + currentLine->next = NULL;
> +}
> +
> +/*
> + * pushLine - pushes a new line structure.
> + */
> +
> +static void pushLine (void)
> +{
> + if (currentLine == NULL)
> + initLine();
> + else if (currentLine->inuse) {
> + struct lineInfo *l = (struct lineInfo *)xmalloc (sizeof(struct lineInfo));
> +
> + if (currentLine->linebuf == NULL) {
> + l->linebuf = NULL;
> + l->linelen = 0;
> + } else {
> + l->linebuf = (char *)xstrdup (currentLine->linebuf);
> + l->linelen = strlen (l->linebuf)+1;
> + }
> + l->tokenpos = currentLine->tokenpos;
> + l->toklen = currentLine->toklen;
> + l->nextpos = currentLine->nextpos;
> + l->lineno = currentLine->lineno;
> + l->column = currentLine->column;
> + l->next = currentLine;
> + currentLine = l;
> + }
> + currentLine->inuse = TRUE;
> +}
> +
> +/*
> + * popLine - pops a line structure.
> + */
> +
> +static void popLine (void)
> +{
> + if (currentLine != NULL) {
> + struct lineInfo *l = currentLine;
> +
> + if (currentLine->linebuf != NULL)
> + free(currentLine->linebuf);
> + currentLine = l->next;
> + free(l);
> + }
> +}
> +
> +/*
> + * resetpos - resets the position of the next token to the start of the line.
> + */
> +
> +static void resetpos (void)
> +{
> + if (currentLine != NULL)
> + currentLine->nextpos = 0;
> +}
> +
> +/*
> + * finishedLine - indicates that the current line does not need to be preserved when a pushLine
> + * occurs.
> + */
> +
> +static void finishedLine (void)
> +{
> + currentLine->inuse = FALSE;
> +}
> +
> +/*
> + * m2flex_GetToken - returns a new token.
> + */
> +
> +EXTERN char *m2flex_GetToken (void)
> +{
> + TIMEVAR_PUSH_LEX;
> + if (currentLine == NULL)
> + initLine();
> + currentLine->tokenpos = currentLine->nextpos;
> + yylex();
> + TIMEVAR_POP_LEX;
> + return yytext;
> +}
> +
> +/*
> + * CloseSource - provided for semantic sugar
> + */
> +
> +EXTERN void m2flex_CloseSource (void)
> +{
> + END_FILE ();
> +}
> +
> +/*
> + * OpenSource - returns TRUE if file s can be opened and
> + * all tokens are taken from this file.
> + */
> +
> +EXTERN int m2flex_OpenSource (char *s)
> +{
> + FILE *f = fopen(s, "r");
> +
> + if (f == NULL)
> + return( FALSE );
> + else {
> + isDefinitionModule = FALSE;
> + while (currentFunction != NULL)
> + {
> + struct functionInfo *f = currentFunction;
> + currentFunction = f->next;
> + if (f->name != NULL)
> + free(f->name);
> + free(f);
> + }
> + yy_delete_buffer (YY_CURRENT_BUFFER);
> + yy_switch_to_buffer (yy_create_buffer(f, YY_BUF_SIZE));
> + filename = xstrdup (s);
> + lineno = 1;
> + if (currentLine == NULL)
> + pushLine ();
> + else
> + currentLine->lineno = lineno;
> + START_FILE (filename, lineno);
> + BEGIN INITIAL; resetpos ();
> + return TRUE;
> + }
> +}
> +
> +/*
> + * m2flex_GetLineNo - returns the current line number.
> + */
> +
> +EXTERN int m2flex_GetLineNo (void)
> +{
> + if (currentLine != NULL)
> + return currentLine->lineno;
> + else
> + return 0;
> +}
> +
> +/*
> + * m2flex_GetColumnNo - returns the column where the current
> + * token starts.
> + */
> +
> +EXTERN int m2flex_GetColumnNo (void)
> +{
> + if (currentLine != NULL)
> + return currentLine->column;
> + else
> + return 0;
> +}
> +
> +/*
> + * m2flex_GetLocation - returns the gcc location_t of the current token.
> + */
> +
> +EXTERN location_t m2flex_GetLocation (void)
> +{
> + if (currentLine != NULL)
> + return currentLine->location;
> + else
> + return 0;
> +}
> +
> +/*
> + * GetTotalLines - returns the total number of lines parsed.
> + */
> +
> +EXTERN int m2flex_GetTotalLines (void)
> +{
> + return totalLines;
> +}
> +
> +/*
> + * yywrap is called when end of file is seen. We push an eof token
> + * and tell the lexical analysis to stop.
> + */
> +
> +int yywrap (void)
> +{
> + updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return 1;
> +}
> +
> +EXTERN void _M2_m2flex_init (void) {}
> +EXTERN void _M2_m2flex_finish (void) {}
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2pp.cc
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/m2pp.cc 2022-10-07 20:21:18.662097087 +0100
> @@ -0,0 +1,2643 @@
> +/* m2pp.c pretty print trees, output in Modula-2 where possible.
> +
> +Copyright (C) 2007-2022 Free Software Foundation, Inc.
> +Contributed by Gaius Mulley <gaius@glam.ac.uk>.
> +
> +This file is part of GNU Modula-2.
> +
> +GNU Modula-2 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.
> +
> +GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
> +<http://www.gnu.org/licenses/>. */
> +
> +#if defined(GM2)
> +#include "gm2-gcc/gcc-consolidation.h"
> +
> +#include "m2-tree.h"
> +#include "gm2-lang.h"
> +
> +#include "gm2-gcc/m2tree.h"
> +#include "gm2-gcc/m2expr.h"
> +#include "gm2-gcc/m2type.h"
> +#include "gm2-gcc/m2decl.h"
> +#else
> +#include "config.h"
> +#include "system.h"
> +#include "coretypes.h"
> +#include "cp/cp-tree.h"
> +#include "stringpool.h"
> +#include "gm2-gcc/gcc-consolidation.h"
> +#include "../cp/cp-tree.h"
> +#endif
> +
> +#define M2PP_C
> +#include "m2/m2pp.h"
> +
> +#undef DEBUGGING
> +
> +typedef struct pretty_t
> +{
> + int needs_space;
> + int needs_indent;
> + int curpos;
> + int indent;
> + int issued_begin;
> + int in_vars;
> + int in_types;
> + tree block;
> + int bits;
> +} pretty;
> +
> +typedef struct m2stack_t
> +{
> + tree value;
> + struct m2stack_t *next;
> +} stack;
> +
> +/* Prototypes. */
> +
> +static pretty *initPretty (int bits);
> +static pretty *dupPretty (pretty *s);
> +static int getindent (pretty *s);
> +static void setindent (pretty *s, int n);
> +static int getcurpos (pretty *s);
> +static void m2pp_identifier (pretty *s, tree t);
> +static void m2pp_needspace (pretty *s);
> +static void m2pp_function (pretty *s, tree t);
> +static void m2pp_function_header (pretty *s, tree t);
> +static void m2pp_function_vars (pretty *s, tree t);
> +static void m2pp_statement_sequence (pretty *s, tree t);
> +static void m2pp_print (pretty *s, const char *p);
> +static void m2pp_print_char (pretty *s, char ch);
> +static void m2pp_parameter (pretty *s, tree t);
> +static void m2pp_type (pretty *s, tree t);
> +static void m2pp_ident_pointer (pretty *s, tree t);
> +static void m2pp_set_type (pretty *s, tree t);
> +static void m2pp_enum (pretty *s, tree t);
> +static void m2pp_array (pretty *s, tree t);
> +static void m2pp_subrange (pretty *s, tree t);
> +static void m2pp_gimpified (pretty *s, tree t);
> +static void m2pp_pointer_type (pretty *s, tree t);
> +static void m2pp_record_type (pretty *s, tree t);
> +static void m2pp_union_type (pretty *s, tree t);
> +static void m2pp_simple_type (pretty *s, tree t);
> +static void m2pp_expression (pretty *s, tree t);
> +static void m2pp_relop (pretty *s, tree t, const char *p);
> +static void m2pp_simple_expression (pretty *s, tree t);
> +static void m2pp_statement_sequence (pretty *s, tree t);
> +static void m2pp_unknown (pretty *s, const char *s1, const char *s2);
> +static void m2pp_statement (pretty *s, tree t);
> +static void m2pp_assignment (pretty *s, tree t);
> +static void m2pp_designator (pretty *s, tree t);
> +static void m2pp_conditional (pretty *s, tree t);
> +static void m2pp_label_expr (pretty *s, tree t);
> +static void m2pp_label_decl (pretty *s, tree t);
> +static void m2pp_goto (pretty *s, tree t);
> +static void m2pp_list (pretty *s, tree t);
> +static void m2pp_offset (pretty *s, tree t);
> +static void m2pp_indirect_ref (pretty *s, tree t);
> +static void m2pp_integer_cst (pretty *s, tree t);
> +static void m2pp_real_cst (pretty *s, tree t);
> +static void m2pp_string_cst (pretty *s, tree t);
> +static void m2pp_integer (pretty *s, tree t);
> +static void m2pp_addr_expr (pretty *s, tree t);
> +static void m2pp_nop (pretty *s, tree t);
> +static void m2pp_convert (pretty *s, tree t);
> +static void m2pp_var_decl (pretty *s, tree t);
> +static void m2pp_binary (pretty *s, tree t, const char *p);
> +static void m2pp_unary (pretty *s, tree t, const char *p);
> +static void m2pp_call_expr (pretty *s, tree t);
> +static void m2pp_procedure_call (pretty *s, tree t);
> +static void m2pp_ssa (pretty *s, tree t);
> +static void m2pp_block (pretty *s, tree t);
> +static void m2pp_block_list (pretty *s, tree t);
> +static void m2pp_var_list (pretty *s, tree t);
> +static void m2pp_bind_expr (pretty *s, tree t);
> +static void m2pp_return_expr (pretty *s, tree t);
> +static void m2pp_result_decl (pretty *s, tree t);
> +static void m2pp_try_block (pretty *s, tree t);
> +static void m2pp_cleanup_point_expr (pretty *s, tree t);
> +static void m2pp_handler (pretty *s, tree t);
> +static void m2pp_component_ref (pretty *s, tree t);
> +static void m2pp_array_ref (pretty *s, tree t);
> +static void m2pp_begin (pretty *s);
> +static void m2pp_var (pretty *s);
> +static void m2pp_types (pretty *s);
> +static void m2pp_decl_expr (pretty *s, tree t);
> +static void m2pp_var_type_decl (pretty *s, tree t);
> +static void m2pp_non_lvalue_expr (pretty *s, tree t);
> +static void m2pp_procedure_type (pretty *s, tree t);
> +static void m2pp_param_type (pretty *s, tree t);
> +static void m2pp_type_lowlevel (pretty *s, tree t);
> +static void m2pp_try_catch_expr (pretty *s, tree t);
> +static void m2pp_throw (pretty *s, tree t);
> +static void m2pp_catch_expr (pretty *s, tree t);
> +static void m2pp_try_finally_expr (pretty *s, tree t);
> +static void m2pp_complex (pretty *s, tree t);
> +static void killPretty (pretty *s);
> +static void m2pp_compound_expression (pretty *s, tree t);
> +static void m2pp_target_expression (pretty *s, tree t);
> +static void m2pp_constructor (pretty *s, tree t);
> +static void m2pp_translation (pretty *s, tree t);
> +static void m2pp_module_block (pretty *s, tree t);
> +static void push (tree t);
> +static void pop (void);
> +static int begin_printed (tree t);
> +static void m2pp_decl_list (pretty *s, tree t);
> +static void m2pp_loc (pretty *s, tree t);
> +
> +void pet (tree t);
> +void m2pp_integer (pretty *s, tree t);
> +
> +extern void stop (void);
> +
> +static stack *stackPtr = NULL;
> +
> +/* do_pf helper function for pf. */
> +
> +void
> +do_pf (tree t, int bits)
Can you put these inside a namespace? Short identifiers tend to
cause "issues", esp. the two letter ones below. If they are merely
for convenience in gdb sessions amending the gdbinit.in or
gdbhooks.py might be more appropriate (not sure if we can have
language specific snippets in there)
> +{
> + pretty *state = initPretty (bits);
> +
> + if (TREE_CODE (t) == TRANSLATION_UNIT_DECL)
> + m2pp_translation (state, t);
> + else if (TREE_CODE (t) == BLOCK)
> + m2pp_module_block (state, t);
> + else if (TREE_CODE (t) == FUNCTION_DECL)
> + m2pp_function (state, t);
> + else
> + m2pp_statement_sequence (state, t);
> + killPretty (state);
> +}
> +
> +/* pf print function. Expected to be printed interactively from
> + the debugger: print pf(func), or to be called from code. */
> +
> +void
> +pf (tree t)
> +{
> + do_pf (t, FALSE);
> +}
> +
> +/* pe print expression. Expected to be printed interactively from
> + the debugger: print pe(expr), or to be called from code. */
> +
> +void
> +pe (tree t)
> +{
> + pretty *state = initPretty (FALSE);
> +
> + m2pp_expression (state, t);
> + m2pp_needspace (state);
> + m2pp_print (state, ";\n");
> + killPretty (state);
> +}
> +
> +/* pet print expression and its type. Expected to be printed
> + interactively from the debugger: print pet(expr), or to be called
> + from code. */
> +
> +void
> +pet (tree t)
> +{
> + pretty *state = initPretty (FALSE);
> +
> + m2pp_expression (state, t);
> + m2pp_needspace (state);
> + m2pp_print (state, ":");
> + m2pp_type (state, TREE_TYPE (t));
> + m2pp_print (state, ";\n");
> + killPretty (state);
> +}
> +
> +/* pt print type. Expected to be printed interactively from the
> + debugger: print pt(expr), or to be called from code. */
> +
> +void
> +pt (tree t)
> +{
> + pretty *state = initPretty (FALSE);
> + m2pp_type (state, t);
> + m2pp_needspace (state);
> + m2pp_print (state, ";\n");
> + killPretty (state);
> +}
> +
> +/* ptl print type low level. Expected to be printed interactively
> + from the debugger: print ptl(type), or to be called from code. */
> +
> +void
> +ptl (tree t)
> +{
> + pretty *state = initPretty (FALSE);
> + m2pp_type_lowlevel (state, t);
> + m2pp_needspace (state);
> + m2pp_print (state, ";\n");
> + killPretty (state);
> +}
> +
> +/* ptcl print TREE_CHAINed list. */
> +
> +void
> +ptcl (tree t)
> +{
> + pretty *state = initPretty (FALSE);
> +
> + m2pp_decl_list (state, t);
> + m2pp_print (state, "\n");
> + killPretty (state);
> +}
> +
> +/* loc if tree has a location then display it within a comment. */
> +
> +static void
> +m2pp_loc (pretty *s, tree t)
> +{
> + if (CAN_HAVE_LOCATION_P (t))
> + {
> + if (EXPR_HAS_LOCATION (t))
> + {
> + if (EXPR_LOCATION (t) == UNKNOWN_LOCATION)
> + m2pp_print (s, "(* missing location1 *)\n");
> + else
> + {
> + expanded_location l = expand_location (EXPR_LOCATION (t));
> +
> + m2pp_print (s, "(* ");
> + m2pp_print (s, l.file);
> + m2pp_print (s, ":");
> + printf ("%d", l.line);
> + m2pp_print (s, " *)");
> + m2pp_print (s, "\n");
> + }
> + }
> + else
> + {
> + m2pp_print (s, "(* missing location2 *)\n");
> + }
> + }
> +}
> +
> +/* m2pp_decl_list prints a TREE_CHAINed list for a decl node. */
> +
> +static void
> +m2pp_decl_list (pretty *s, tree t)
> +{
> + tree u = t;
> +
> + m2pp_print (s, "(");
> + m2pp_needspace (s);
> + while (t != NULL_TREE)
> + {
> + m2pp_identifier (s, t);
> + t = TREE_CHAIN (t);
> + if (t == u || t == NULL_TREE)
> + break;
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + }
> + m2pp_needspace (s);
> + m2pp_print (s, ")");
> +}
> +
> +static void
> +m2pp_decl_bool (pretty *s, tree t)
> +{
> + if (TREE_STATIC (t))
> + m2pp_print (s, "static, ");
> + if (DECL_EXTERNAL (t))
> + m2pp_print (s, "external, ");
> + if (DECL_SEEN_IN_BIND_EXPR_P (t))
> + m2pp_print (s, "in bind expr, ");
> +}
> +
> +void
> +pv (tree t)
> +{
> + if (t)
> + {
> + enum tree_code code = TREE_CODE (t);
> +
> + if (code == PARM_DECL)
> + {
> + pretty *state = initPretty (FALSE);
> + m2pp_identifier (state, t);
> + m2pp_needspace (state);
> + m2pp_print (state, "<parm_decl context = ");
> + m2pp_identifier (state, DECL_CONTEXT (t));
> + if (DECL_ABSTRACT_ORIGIN (t) == t)
> + m2pp_print (state, ">\n");
> + else
> + {
> + m2pp_print (state, ", abstract origin = ");
> + m2pp_identifier (state, DECL_ABSTRACT_ORIGIN (t));
> + m2pp_print (state, ">\n");
> + pv (DECL_ABSTRACT_ORIGIN (t));
> + }
> + killPretty (state);
> + }
> + if (code == VAR_DECL)
> + {
> + pretty *state = initPretty (FALSE);
> + m2pp_identifier (state, t);
> + m2pp_needspace (state);
> + m2pp_print (state, "(* <var_decl context = ");
> + m2pp_identifier (state, DECL_CONTEXT (t));
> + m2pp_decl_bool (state, t);
> + if (DECL_ABSTRACT_ORIGIN (t) == t)
> + m2pp_print (state, "> *)\n");
> + else
> + {
> + m2pp_print (state, ", abstract origin = ");
> + m2pp_identifier (state, DECL_ABSTRACT_ORIGIN (t));
> + m2pp_print (state, "> *)\n");
> + pv (DECL_ABSTRACT_ORIGIN (t));
> + }
> + killPretty (state);
> + }
> + }
> +}
> +
> +#if defined(GM2_MAINTAINER)
> +
> +/* remember an internal debugging hook. */
> +static tree rememberF = NULL;
> +
> +static void
> +remember (tree t)
> +{
> + rememberF = t;
> + printf ("type: watch *((tree *) %p) != %p\n", (void *)&DECL_SAVED_TREE (t),
> + (void *)DECL_SAVED_TREE (t));
> +}
> +#endif
> +
> +/* push pushes tree t onto stack. */
> +
> +static void
> +push (tree t)
> +{
> + stack *s = (stack *)xmalloc (sizeof (stack));
> +
> + s->value = t;
> + s->next = stackPtr;
> + stackPtr = s;
> +}
> +
> +/* pop pops a tree, from the stack. */
> +
> +static void
> +pop (void)
> +{
> + stack *s = stackPtr;
> +
> + stackPtr = stackPtr->next;
> + free (s);
> +}
> +
> +/* being_printed returns TRUE if t is held on the stack. */
> +
> +static int
> +begin_printed (tree t)
> +{
> + stack *s = stackPtr;
> +
> + while (s != NULL)
> + {
> + if (s->value == t)
> + return TRUE;
> + else
> + s = s->next;
> + }
> + return FALSE;
> +}
> +
> +/* dupPretty duplicate and return a copy of state s. */
> +
> +static pretty *
> +dupPretty (pretty *s)
> +{
> + pretty *p = initPretty (s->bits);
> + *p = *s;
> + return p;
> +}
> +
> +/* initPretty initialise the state of the pretty printer. */
> +
> +static pretty *
> +initPretty (int bits)
> +{
> + pretty *state = (pretty *)xmalloc (sizeof (pretty));
> + state->needs_space = FALSE;
> + state->needs_indent = FALSE;
> + state->curpos = 0;
> + state->indent = 0;
> + state->issued_begin = FALSE;
> + state->in_vars = FALSE;
> + state->in_types = FALSE;
> + state->block = NULL_TREE;
> + state->bits = bits;
> + return state;
> +}
> +
> +/* killPretty cleans up the state. */
> +
> +static void
> +killPretty (pretty *s)
> +{
> + free (s);
> + fflush (stdout);
> +}
> +
> +/* getindent returns the current indent value. */
> +
> +static int
> +getindent (pretty *s)
> +{
> + return s->indent;
> +}
> +
> +/* setindent sets the current indent to, n. */
> +
> +static void
> +setindent (pretty *s, int n)
> +{
> + s->indent = n;
> +}
> +
> +/* getcurpos returns the current cursor position. */
> +
> +static int
> +getcurpos (pretty *s)
> +{
> + if (s->needs_space)
> + return s->curpos + 1;
> + else
> + return s->curpos;
> +}
> +
> +/* m2pp_type_lowlevel prints out the low level details of a
> + fundamental type. */
> +
> +static void
> +m2pp_type_lowlevel (pretty *s, tree t)
> +{
> + if (TREE_CODE (t) == INTEGER_TYPE)
> + {
> + m2pp_print (s, "min");
> + m2pp_needspace (s);
> + m2pp_integer_cst (s, TYPE_MIN_VALUE (t));
> + m2pp_print (s, ", max");
> + m2pp_needspace (s);
> + m2pp_integer_cst (s, TYPE_MAX_VALUE (t));
> + m2pp_print (s, ", type size unit");
> + m2pp_needspace (s);
> + m2pp_integer_cst (s, TYPE_SIZE_UNIT (t));
> + m2pp_print (s, ", type size");
> + m2pp_needspace (s);
> + m2pp_integer_cst (s, TYPE_SIZE (t));
> +
> + printf (", precision %d, mode %d, align %d, user align %d",
> + TYPE_PRECISION (t), TYPE_MODE (t), TYPE_ALIGN (t),
> + TYPE_USER_ALIGN (t));
> +
> + m2pp_needspace (s);
> + if (TYPE_UNSIGNED (t))
> + m2pp_print (s, "unsigned\n");
> + else
> + m2pp_print (s, "signed\n");
> + }
> +}
> +
> +/* m2pp_var emit a VAR if necessary. */
> +
> +static void
> +m2pp_var (pretty *s)
> +{
> + if (!s->in_vars)
> + {
> + s->in_vars = TRUE;
> + m2pp_print (s, "VAR\n");
> + setindent (s, getindent (s) + 3);
> + }
> +}
> +
> +/* m2pp_types emit a TYPE if necessary. */
> +
> +static void
> +m2pp_types (pretty *s)
> +{
> + if (!s->in_types)
> + {
> + s->in_types = TRUE;
> + m2pp_print (s, "TYPE\n");
> + setindent (s, getindent (s) + 3);
> + }
> +}
> +
> +/* hextree displays the critical fields for function, block and
> + bind_expr trees in raw hex. */
> +
> +static void
> +hextree (tree t)
> +{
> + if (t == NULL_TREE)
> + return;
> +
> + if (TREE_CODE (t) == BLOCK)
> + {
> + printf ("(* BLOCK %p *)\n", (void *)t);
> + printf ("BLOCK_VARS (t) = %p\n", (void *)BLOCK_VARS (t));
> + printf ("BLOCK_SUPERCONTEXT (t) = %p\n",
> + (void *)BLOCK_SUPERCONTEXT (t));
> + }
> + if (TREE_CODE (t) == BIND_EXPR)
> + {
> + printf ("(* BIND_EXPR %p *)\n", (void *)t);
> + printf ("BIND_EXPR_VARS (t) = %p\n", (void *)BIND_EXPR_VARS (t));
> + printf ("BIND_EXPR_BLOCK (t) = %p\n", (void *)BIND_EXPR_BLOCK (t));
> + printf ("BIND_EXPR_BODY (t) = %p\n", (void *)BIND_EXPR_BODY (t));
> + }
> + if (TREE_CODE (t) == FUNCTION_DECL)
> + {
> + printf ("(* FUNCTION_DECL %p *)\n", (void *)t);
> + printf ("DECL_INITIAL (t) = %p\n", (void *)DECL_INITIAL (t));
> + printf ("DECL_SAVED_TREE (t) = %p\n", (void *)DECL_SAVED_TREE (t));
> + hextree (DECL_INITIAL (t));
> + hextree (DECL_SAVED_TREE (t));
> + }
> + if (TREE_CODE (t) == VAR_DECL)
> + {
> + pretty *state = initPretty (FALSE);
> +
> + printf ("(* VAR_DECL %p <", (void *)t);
> + if (DECL_SEEN_IN_BIND_EXPR_P (t))
> + printf ("b");
> + if (DECL_EXTERNAL (t))
> + printf ("e");
> + if (TREE_STATIC (t))
> + printf ("s");
> + printf ("> context = %p*)\n", (void *)decl_function_context (t));
> + m2pp_type (state, TREE_TYPE (t));
> + m2pp_needspace (state);
> + m2pp_print (state, ";\n");
> + killPretty (state);
> + }
> + if (TREE_CODE (t) == PARM_DECL)
> + {
> + pretty *state = initPretty (FALSE);
> +
> + printf ("(* PARM_DECL %p <", (void *)t);
> + printf ("> context = %p*)\n", (void *)decl_function_context (t));
> + m2pp_type (state, TREE_TYPE (t));
> + m2pp_needspace (state);
> + m2pp_print (state, ";\n");
> + killPretty (state);
> + }
> +}
> +
> +/* translation produce a pseudo implementation module from the tree t. */
> +
> +static void
> +m2pp_translation (pretty *s, tree t)
> +{
> + tree block = DECL_INITIAL (t);
> +
> + m2pp_print (s, "IMPLEMENTATION MODULE ");
> + m2pp_identifier (s, t);
> + m2pp_print (s, "\n\n");
> +
> + if (block != NULL)
> + {
> + m2pp_module_block (s, block);
> + m2pp_print (s, "\n");
> + }
> +
> + m2pp_print (s, "\n");
> + m2pp_print (s, "END ");
> + m2pp_identifier (s, t);
> + m2pp_print (s, ".\n");
> +}
> +
> +static void
> +m2pp_module_block (pretty *s, tree t)
> +{
> + t = BLOCK_VARS (t);
> +
> + if (t != NULL_TREE)
> + for (; t != NULL_TREE; t = TREE_CHAIN (t))
> + {
> + switch (TREE_CODE (t))
> + {
> + case FUNCTION_DECL:
> + if (!DECL_EXTERNAL (t))
> + {
> + pretty *p = dupPretty (s);
> + printf ("\n");
> + p->in_vars = FALSE;
> + p->in_types = FALSE;
> + m2pp_function (p, t);
> + killPretty (p);
> + printf ("\n");
> + s->in_vars = FALSE;
> + s->in_types = FALSE;
> + }
> + break;
> +
> + case TYPE_DECL:
> + {
> + int o = getindent (s);
> + int p;
> +
> + m2pp_print (s, "\n");
> + m2pp_types (s);
> + setindent (s, o + 3);
> + m2pp_identifier (s, t);
> + m2pp_print (s, " = ");
> + p = getcurpos (s);
> + setindent (s, p);
> + m2pp_type (s, TREE_TYPE (t));
> + setindent (s, o);
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> + s->in_vars = FALSE;
> + }
> + break;
> +
> + case VAR_DECL:
> + m2pp_var (s);
> + m2pp_identifier (s, t);
> + m2pp_needspace (s);
> + m2pp_print (s, ":");
> + m2pp_needspace (s);
> + m2pp_type (s, TREE_TYPE (t));
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> + s->in_types = FALSE;
> + break;
> +
> + case DECL_EXPR:
> + printf ("is this node legal here? \n");
> + m2pp_decl_expr (s, t);
> + break;
> +
> + default:
> + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
> + }
> + }
> +}
> +
> +/* m2pp_begin emit a BEGIN if necessary. */
> +
> +static void
> +m2pp_begin (pretty *s)
> +{
> + if (!s->issued_begin)
> + {
> + if (s->in_vars || s->in_types)
> + {
> + setindent (s, getindent (s) - 3);
> + m2pp_print (s, "BEGIN\n");
> + setindent (s, getindent (s) + 3);
> + }
> + else
> + {
> + m2pp_print (s, "BEGIN\n");
> + setindent (s, getindent (s) + 3);
> + }
> + s->issued_begin = TRUE;
> + s->in_vars = FALSE;
> + s->in_types = FALSE;
> + }
> +}
> +
> +/* m2pp_function walk over the function. */
> +
> +static void
> +m2pp_function (pretty *s, tree t)
> +{
> + m2pp_function_header (s, t);
> + m2pp_function_vars (s, t);
> + m2pp_statement_sequence (s, DECL_SAVED_TREE (t));
> + if (TREE_CODE (t) == FUNCTION_DECL)
> + {
> + m2pp_begin (s);
> + setindent (s, getindent (s) - 3);
> + m2pp_print (s, "END");
> + m2pp_needspace (s);
> + m2pp_identifier (s, t);
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> + }
> +}
> +
> +/* m2pp_bind_expr displays the bind expr tree node. */
> +
> +static void
> +m2pp_bind_expr (pretty *s, tree t)
> +{
> + if (TREE_CODE (t) == BIND_EXPR)
> + {
> + if (BIND_EXPR_VARS (t))
> + {
> + m2pp_print (s, "(* variables in bind_expr *)\n");
> + m2pp_var (s);
> + m2pp_var_list (s, BIND_EXPR_VARS (t));
> + }
> + if (BIND_EXPR_BLOCK (t))
> + {
> + m2pp_print (s, "(* bind_expr_block *)\n");
> + m2pp_statement_sequence (s, BIND_EXPR_BLOCK (t));
> + m2pp_needspace (s);
> + m2pp_print (s, "; \n");
> + }
> + m2pp_statement_sequence (s, BIND_EXPR_BODY (t));
> + }
> +}
> +
> +/* m2pp_block_list iterates over the list of blocks. */
> +
> +static void
> +m2pp_block_list (pretty *s, tree t)
> +{
> + for (; t; t = BLOCK_CHAIN (t))
> + m2pp_block (s, t);
> +}
> +
> +/* m2pp_block prints the VARiables and the TYPEs inside a block. */
> +
> +static void
> +m2pp_block (pretty *s, tree t)
> +{
> + if ((BLOCK_VARS (t) != NULL_TREE) && (s->block != BLOCK_VARS (t)))
> + {
> + s->block = BLOCK_VARS (t);
> + m2pp_print (s, "(* block variables *)\n");
> + m2pp_var (s);
> + m2pp_var_list (s, BLOCK_VARS (t));
> + }
> +}
> +
> +/* m2pp_var_type_decl displays the variable and type declaration. */
> +
> +static void
> +m2pp_var_type_decl (pretty *s, tree t)
> +{
> + m2pp_identifier (s, t);
> + m2pp_needspace (s);
> + m2pp_print (s, ":");
> + m2pp_needspace (s);
> + m2pp_type (s, TREE_TYPE (t));
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> +}
> +
> +/* m2pp_var_list print a variable list. */
> +
> +static void
> +m2pp_var_list (pretty *s, tree t)
> +{
> + if (t != NULL_TREE)
> + for (; t; t = TREE_CHAIN (t))
> + {
> + if (TREE_CODE (t) == FUNCTION_DECL)
> + {
> + pretty *p = dupPretty (s);
> + printf ("\n");
> + p->in_vars = FALSE;
> + p->in_types = FALSE;
> + m2pp_function (p, t);
> + killPretty (p);
> + printf ("\n");
> + }
> + else if (TREE_CODE (t) == TYPE_DECL)
> + m2pp_identifier (s, t);
> + else if (TREE_CODE (t) == DECL_EXPR)
> + {
> + printf ("is this node legal here? \n");
> + // is it legal to have a DECL_EXPR here ?
> + m2pp_var_type_decl (s, DECL_EXPR_DECL (t));
> + }
> + else
> + m2pp_var_type_decl (s, t);
> + }
> +}
> +
> +#if 0
> +/* m2pp_type_list print a variable list. */
> +
> +static void
> +m2pp_type_list (pretty *s, tree t)
> +{
> + if (t != NULL_TREE)
> + for (; t; t = TREE_CHAIN (t))
> + {
> + m2pp_identifier (s, t);
> + m2pp_needspace (s);
> + m2pp_print (s, "=");
> + m2pp_needspace (s);
> + m2pp_type (s, TREE_TYPE (t));
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> + }
> +}
> +#endif
> +
> +/* m2pp_needspace sets appropriate flag to TRUE. */
> +
> +static void
> +m2pp_needspace (pretty *s)
> +{
> + s->needs_space = TRUE;
> +}
> +
> +/* m2pp_identifer prints an identifier. */
> +
> +static void
> +m2pp_identifier (pretty *s, tree t)
> +{
> + if (t)
> + {
> + if (TREE_CODE (t) == COMPONENT_REF)
> + m2pp_component_ref (s, t);
> + else if (DECL_NAME (t) && IDENTIFIER_POINTER (DECL_NAME (t)))
> + m2pp_ident_pointer (s, DECL_NAME (t));
> + else
> + {
> + char name[100];
> +
> + if (TREE_CODE (t) == CONST_DECL)
> + snprintf (name, 100, "C_%u", DECL_UID (t));
> + else
> + snprintf (name, 100, "D_%u", DECL_UID (t));
> + m2pp_print (s, name);
> + }
> + }
> +}
> +
> +/* m2pp_ident_pointer displays an ident pointer. */
> +
> +static void
> +m2pp_ident_pointer (pretty *s, tree t)
> +{
> + if (t)
> + m2pp_print (s, IDENTIFIER_POINTER (t));
> +}
> +
> +/* m2pp_parameter prints out a param decl tree. */
> +
> +static void
> +m2pp_parameter (pretty *s, tree t)
> +{
> + if (TREE_CODE (t) == PARM_DECL)
> + {
> + if (TREE_TYPE (t) && (TREE_CODE (TREE_TYPE (t)) == REFERENCE_TYPE))
> + {
> + m2pp_print (s, "VAR");
> + m2pp_needspace (s);
> + m2pp_identifier (s, t);
> + m2pp_print (s, ":");
> + m2pp_needspace (s);
> + m2pp_simple_type (s, TREE_TYPE (TREE_TYPE (t)));
> + }
> + else
> + {
> + m2pp_identifier (s, t);
> + m2pp_print (s, ":");
> + m2pp_needspace (s);
> + m2pp_simple_type (s, TREE_TYPE (t));
> + }
> + }
> +}
> +
> +/* m2pp_param_type prints out the type of parameter. */
> +
> +static void
> +m2pp_param_type (pretty *s, tree t)
> +{
> + if (t && (TREE_CODE (t) == REFERENCE_TYPE))
> + {
> + m2pp_print (s, "VAR");
> + m2pp_needspace (s);
> + m2pp_simple_type (s, TREE_TYPE (t));
> + }
> + else
> + m2pp_simple_type (s, t);
> +}
> +
> +/* m2pp_procedure_type displays a procedure type. */
> +
> +static void
> +m2pp_procedure_type (pretty *s, tree t)
> +{
> + push (t);
> + if (TREE_CODE (t) == FUNCTION_TYPE)
> + {
> + tree i = TYPE_ARG_TYPES (t);
> + tree returnType = TREE_TYPE (TREE_TYPE (t));
> +
> + m2pp_needspace (s);
> + m2pp_print (s, "PROCEDURE");
> + m2pp_needspace (s);
> + if (i != NULL_TREE)
> + {
> + int o = getindent (s);
> + int p;
> + int first = TRUE;
> +
> + m2pp_print (s, "(");
> + p = getcurpos (s);
> + setindent (s, p);
> + while (i != NULL_TREE)
> + {
> + if (TREE_CHAIN (i) == NULL_TREE)
> + {
> + if (TREE_VALUE (i) == void_type_node)
> + /* Ignore void_type_node at the end. */
> + ;
> + else
> + {
> + m2pp_param_type (s, TREE_VALUE (i));
> + m2pp_print (s, ", ...");
> + }
> + break;
> + }
> + else
> + {
> + if (!first)
> + {
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + }
> + m2pp_param_type (s, TREE_VALUE (i));
> + }
> + i = TREE_CHAIN (i);
> + first = FALSE;
> + }
> + m2pp_print (s, ")");
> + setindent (s, o);
> + }
> + else if (returnType != NULL_TREE)
> + {
> + m2pp_needspace (s);
> + m2pp_print (s, "()");
> + }
> + if (returnType != NULL_TREE)
> + {
> + m2pp_needspace (s);
> + m2pp_print (s, ": ");
> + m2pp_simple_type (s, returnType);
> + }
> + }
> + pop ();
> +}
> +
> +/* m2pp_comment_header displays a simple header with some critical
> + tree info. */
> +
> +static void
> +m2pp_comment_header (pretty *s, tree t)
> +{
> + int o = getindent (s);
> +
> + m2pp_print (s, "(*\n");
> + setindent (s, o + 3);
> + m2pp_identifier (s, t);
> + m2pp_needspace (s);
> + m2pp_print (s, "-");
> + m2pp_needspace (s);
> + if (TREE_PUBLIC (t))
> + {
> + m2pp_needspace (s);
> + m2pp_print (s, "public,");
> + }
> + if (TREE_STATIC (t))
> + {
> + m2pp_needspace (s);
> + m2pp_print (s, "static,");
> + }
> + if (DECL_EXTERNAL (t))
> + {
> + m2pp_needspace (s);
> + m2pp_print (s, "extern");
> + }
> + m2pp_print (s, "\n");
> + setindent (s, o);
> + m2pp_print (s, "*)\n\n");
> +}
> +
> +/* m2pp_function_header displays the function header. */
> +
> +static void
> +m2pp_function_header (pretty *s, tree t)
> +{
> + push (t);
> + if (TREE_CODE (t) == FUNCTION_DECL)
> + {
> + tree i = DECL_ARGUMENTS (t);
> + tree returnType = TREE_TYPE (TREE_TYPE (t));
> +
> + m2pp_comment_header (s, t);
> + m2pp_print (s, "PROCEDURE ");
> + m2pp_identifier (s, t);
> + m2pp_needspace (s);
> + if (i != NULL_TREE)
> + {
> + int o = getindent (s);
> + int p;
> +
> + m2pp_print (s, "(");
> + p = getcurpos (s);
> + setindent (s, p);
> + while (i != NULL_TREE)
> + {
> + m2pp_parameter (s, i);
> + i = TREE_CHAIN (i);
> + if (i != NULL_TREE)
> + m2pp_print (s, ";\n");
> + }
> + m2pp_print (s, ")");
> + m2pp_needspace (s);
> + setindent (s, o);
> + }
> + else if (returnType != void_type_node)
> + {
> + m2pp_print (s, "()");
> + m2pp_needspace (s);
> + }
> + if (returnType != void_type_node)
> + {
> + m2pp_print (s, ": ");
> + m2pp_simple_type (s, returnType);
> + m2pp_needspace (s);
> + }
> + m2pp_print (s, "; ");
> + m2pp_loc (s, t);
> + m2pp_print (s, "\n");
> + }
> + pop ();
> +}
> +
> +/* m2pp_add_var adds a variable into a list as defined by, data. */
> +
> +static tree
> +m2pp_add_var (tree *tp, int *walk_subtrees, void *data)
> +{
> + tree t = *tp;
> + pretty *s = (pretty *)data;
> + enum tree_code code = TREE_CODE (t);
> +
> + if (code == VAR_DECL)
> + {
> + m2pp_var (s);
> + m2pp_identifier (s, t);
> + m2pp_needspace (s);
> + m2pp_print (s, ":");
> + m2pp_needspace (s);
> + m2pp_type (s, TREE_TYPE (t));
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> + }
> + if (code == SSA_NAME)
> + {
> + m2pp_var (s);
> + m2pp_ssa (s, t);
> + m2pp_identifier (s, SSA_NAME_VAR (t));
> + m2pp_needspace (s);
> + m2pp_print (s, ":");
> + m2pp_needspace (s);
> + m2pp_type (s, TREE_TYPE (t));
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> + }
> +
> + *walk_subtrees = 1;
> + return NULL_TREE;
> +}
> +
> +/* m2pp_function_vars displays variables as defined by the function
> + tree. */
> +
> +static void
> +m2pp_function_vars (pretty *s, tree t)
> +{
> + walk_tree_without_duplicates (&t, m2pp_add_var, s);
> +
> + if (TREE_CODE (t) == FUNCTION_DECL && DECL_INITIAL (t))
> + {
> + m2pp_print (s, "(* variables in function_decl (decl_initial) *)\n");
> + m2pp_var (s);
> + m2pp_statement_sequence (s, DECL_INITIAL (t));
> + }
> +}
> +
> +/* m2pp_print print out a string p interpreting '\n' and
> + adjusting the fields within state s. */
> +
> +static void
> +m2pp_print (pretty *s, const char *p)
> +{
> + if (p)
> + {
> + int l = strlen (p);
> + int i = 0;
> +
> + if (s->needs_space)
> + {
> + printf (" ");
> + s->needs_space = FALSE;
> + s->curpos++;
> + }
> +
> + while (i < l)
> + {
> + if (p[i] == '\n')
> + {
> + s->needs_indent = TRUE;
> + s->curpos = 0;
> + printf ("\n");
> + }
> + else
> + {
> + if (s->needs_indent)
> + {
> + if (s->indent > 0)
> + printf ("%*c", s->indent, ' ');
> + s->needs_indent = FALSE;
> + s->curpos += s->indent;
> + }
> + s->curpos++;
> + putchar (p[i]);
> + }
> + i++;
> + }
> + }
> +}
> +
> +/* m2pp_print_char prints out a character ch obeying needs_space
> + and needs_indent. */
> +
> +static void
> +m2pp_print_char (pretty *s, char ch)
> +{
> + if (s->needs_space)
> + {
> + printf (" ");
> + s->needs_space = FALSE;
> + s->curpos++;
> + }
> + if (s->needs_indent)
> + {
> + if (s->indent > 0)
> + printf ("%*c", s->indent, ' ');
> + s->needs_indent = FALSE;
> + s->curpos += s->indent;
> + }
> + if (ch == '\n')
> + {
> + s->curpos++;
> + putchar ('\\');
> + putchar ('n');
> + }
> + else
> + putchar (ch);
> + s->curpos++;
> +}
> +
> +/* m2pp_integer display the appropriate integer type. */
> +
> +#if defined(GM2)
> +void
> +m2pp_integer (pretty *s, tree t)
> +{
> + if (t == m2type_GetM2ZType ())
> + m2pp_print (s, "M2ZTYPE");
> + else if (t == m2type_GetM2LongIntType ())
> + m2pp_print (s, "LONGINT");
> + else if (t == m2type_GetM2IntegerType ())
> + m2pp_print (s, "INTEGER");
> + else if (t == m2type_GetM2ShortIntType ())
> + m2pp_print (s, "SHORTINT");
> + else if (t == m2type_GetLongIntType ())
> + m2pp_print (s, "long int");
> + else if (t == m2type_GetIntegerType ())
> + m2pp_print (s, "int");
> + else if (t == m2type_GetShortIntType ())
> + m2pp_print (s, "short");
> + else if (t == m2type_GetM2LongCardType ())
> + m2pp_print (s, "LONGCARD");
> + else if (t == m2type_GetM2CardinalType ())
> + m2pp_print (s, "CARDINAL");
> + else if (t == m2type_GetM2ShortCardType ())
> + m2pp_print (s, "SHORTCARD");
> + else if (t == m2type_GetCardinalType ())
> + m2pp_print (s, "CARDINAL");
> + else if (t == m2type_GetPointerType ())
> + m2pp_print (s, "ADDRESS");
> + else if (t == m2type_GetByteType ())
> + m2pp_print (s, "BYTE");
> + else if (t == m2type_GetCharType ())
> + m2pp_print (s, "CHAR");
> + else if (t == m2type_GetBitsetType ())
> + m2pp_print (s, "BITSET");
> + else if (t == m2type_GetBitnumType ())
> + m2pp_print (s, "BITNUM");
> + else
> + {
> + if (TYPE_UNSIGNED (t))
> + m2pp_print (s, "CARDINAL");
> + else
> + m2pp_print (s, "INTEGER");
> + m2pp_integer_cst (s, TYPE_SIZE (t));
> + }
> +}
> +#else
> +void
> +m2pp_integer (pretty *s, tree t ATTRIBUTE_UNUSED)
> +{
> + m2pp_print (s, "INTEGER");
> +}
> +#endif
> +
> +/* m2pp_complex display the actual complex type. */
> +
> +#if defined(GM2)
> +static void
> +m2pp_complex (pretty *s, tree t)
> +{
> + if (t == m2type_GetM2ComplexType ())
> + m2pp_print (s, "COMPLEX");
> + else if (t == m2type_GetM2LongComplexType ())
> + m2pp_print (s, "LONGCOMPLEX");
> + else if (t == m2type_GetM2ShortComplexType ())
> + m2pp_print (s, "SHORTCOMPLEX");
> + else if (t == m2type_GetM2CType ())
> + m2pp_print (s, "C'omplex' type");
> + else if (t == m2type_GetM2Complex32 ())
> + m2pp_print (s, "COMPLEX32");
> + else if (t == m2type_GetM2Complex64 ())
> + m2pp_print (s, "COMPLEX64");
> + else if (t == m2type_GetM2Complex96 ())
> + m2pp_print (s, "COMPLEX96");
> + else if (t == m2type_GetM2Complex128 ())
> + m2pp_print (s, "COMPLEX128");
> + else
> + m2pp_print (s, "unknown COMPLEX type");
> +}
> +
> +#else
> +
> +static void
> +m2pp_complex (pretty *s, tree t ATTRIBUTE_UNUSED)
> +{
> + m2pp_print (s, "a COMPLEX type");
> +}
> +#endif
> +
> +/* m2pp_type prints a full type. */
> +
> +void
> +m2pp_type (pretty *s, tree t)
> +{
> + if (begin_printed (t))
> + {
> + m2pp_print (s, "<...>");
> + return;
> + }
> + if ((TREE_CODE (t) != FIELD_DECL) && (TREE_CODE (t) != TYPE_DECL))
> + m2pp_gimpified (s, t);
> + switch (TREE_CODE (t))
> + {
> + case INTEGER_TYPE:
> + m2pp_integer (s, t);
> + break;
> + case REAL_TYPE:
> + m2pp_print (s, "REAL");
> + break;
> + case ENUMERAL_TYPE:
> + m2pp_enum (s, t);
> + break;
> + case UNION_TYPE:
> + m2pp_union_type (s, t);
> + break;
> + case RECORD_TYPE:
> + m2pp_record_type (s, t);
> + break;
> + case ARRAY_TYPE:
> + m2pp_array (s, t);
> + break;
> +#if 0
> + case FUNCTION_TYPE:
> + m2pp_function_type (s, t);
> + break;
> +#endif
> + case TYPE_DECL:
> + m2pp_identifier (s, t);
> + break;
> + case POINTER_TYPE:
> + m2pp_pointer_type (s, t);
> + break;
> +#if defined(GM2)
> + case SET_TYPE:
> + m2pp_set_type (s, t);
> + break;
> +#endif
> + case VOID_TYPE:
> + m2pp_print (s, "ADDRESS");
> + break;
> + case COMPLEX_TYPE:
> + m2pp_complex (s, t);
> + break;
> + default:
> + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
> + }
> +}
> +
> +/* m2pp_set_type prints out the set type. */
> +
> +static void
> +m2pp_set_type (pretty *s, tree t)
> +{
> + push (t);
> + m2pp_print (s, "SET OF");
> + m2pp_needspace (s);
> + m2pp_type (s, TREE_TYPE (t));
> + pop ();
> +}
> +
> +/* m2pp_enum print out the enumeration type. */
> +
> +static void
> +m2pp_enum (pretty *s, tree t)
> +{
> + tree chain_p = TYPE_VALUES (t);
> +
> + push (t);
> + m2pp_print (s, "(");
> + while (chain_p)
> + {
> + m2pp_ident_pointer (s, TREE_PURPOSE (chain_p));
> + chain_p = TREE_CHAIN (chain_p);
> + if (chain_p)
> + m2pp_print (s, ", ");
> + }
> + m2pp_print (s, ")");
> + pop ();
> +}
> +
> +/* m2pp_array prints out the array type. */
> +
> +static void
> +m2pp_array (pretty *s, tree t)
> +{
> + push (t);
> + m2pp_print (s, "ARRAY");
> + m2pp_needspace (s);
> + m2pp_subrange (s, TYPE_DOMAIN (t));
> + m2pp_needspace (s);
> + m2pp_print (s, "OF");
> + m2pp_needspace (s);
> + m2pp_type (s, TREE_TYPE (t));
> + pop ();
> +}
> +
> +/* m2pp_subrange prints out the subrange, but probably the lower
> + bound will always be zero. */
> +
> +static void
> +m2pp_subrange (pretty *s, tree t)
> +{
> + tree min = TYPE_MIN_VALUE (t);
> + tree max = TYPE_MAX_VALUE (t);
> +
> + m2pp_print (s, "[");
> + m2pp_expression (s, min);
> + m2pp_print (s, "..");
> + m2pp_expression (s, max);
> + m2pp_print (s, "]");
> +}
> +
> +/* m2pp_gimplified print out a gimplified comment. */
> +
> +static void
> +m2pp_gimpified (pretty *s, tree t)
> +{
> + if (!TYPE_SIZES_GIMPLIFIED (t))
> + {
> + m2pp_print (s, "(* <!g> *)");
> + m2pp_needspace (s);
> + }
> +}
> +
> +/* m2pp_printer_type display the pointer type. */
> +
> +static void
> +m2pp_pointer_type (pretty *s, tree t)
> +{
> + push (t);
> + if (TREE_CODE (t) == POINTER_TYPE)
> + {
> + if (TREE_CODE (TREE_TYPE (t)) == FUNCTION_TYPE)
> + m2pp_procedure_type (s, TREE_TYPE (t));
> + else if (t == ptr_type_node)
> + m2pp_print (s, "ADDRESS");
> + else
> + {
> + m2pp_print (s, "POINTER TO");
> + m2pp_needspace (s);
> + m2pp_type (s, TREE_TYPE (t));
> + }
> + }
> + pop ();
> +}
> +
> +/* m2pp_record_alignment prints out whether this record is aligned
> + (packed). */
> +
> +static void
> +m2pp_record_alignment (pretty *s, tree t)
> +{
> + if (TYPE_PACKED (t))
> + m2pp_print (s, "<* bytealignment (0) *>\n");
> +}
> +
> +static unsigned int
> +m2pp_getaligned (tree t)
> +{
> + if (DECL_P (t))
> + {
> + if (DECL_USER_ALIGN (t))
> + return DECL_ALIGN (t);
> + }
> + else if (TYPE_P (t))
> + {
> + if (TYPE_USER_ALIGN (t))
> + return TYPE_ALIGN (t);
> + }
> + return 0;
> +}
> +
> +static void
> +m2pp_recordfield_alignment (pretty *s, tree t)
> +{
> + unsigned int aligned = m2pp_getaligned (t);
> +
> + if (aligned != 0)
> + {
> + int o = getindent (s);
> + int p = getcurpos (s);
> + m2pp_needspace (s);
> + m2pp_print (s, "<* bytealignment (");
> + setindent (s, p + 18);
> +
> + printf ("%d", aligned / BITS_PER_UNIT);
> +
> + m2pp_print (s, ")");
> + m2pp_needspace (s);
> + setindent (s, p);
> + m2pp_print (s, "*>");
> + setindent (s, o);
> + }
> +}
> +
> +static void
> +m2pp_recordfield_bitfield (pretty *s, tree t)
> +{
> + if ((TREE_CODE (t) == FIELD_DECL) && DECL_PACKED (t))
> + {
> + m2pp_print (s, " (* packed");
> + if (DECL_NONADDRESSABLE_P (t))
> + m2pp_print (s, ", non-addressible");
> + if (DECL_BIT_FIELD (t))
> + m2pp_print (s, ", bit-field");
> + m2pp_print (s, ", offset: ");
> + m2pp_expression (s, DECL_FIELD_OFFSET (t));
> + m2pp_print (s, ", bit offset:");
> + m2pp_expression (s, DECL_FIELD_BIT_OFFSET (t));
> + m2pp_print (s, " *) ");
> + }
> +}
> +
> +/* m2pp_record_type displays the record type. */
> +
> +static void
> +m2pp_record_type (pretty *s, tree t)
> +{
> + push (t);
> + if (TREE_CODE (t) == RECORD_TYPE)
> + {
> + tree i;
> + int o = getindent (s);
> + int p = getcurpos (s);
> +
> + m2pp_print (s, "RECORD\n");
> + setindent (s, p + 3);
> + m2pp_record_alignment (s, t);
> + for (i = TYPE_FIELDS (t); i != NULL_TREE; i = TREE_CHAIN (i))
> + {
> + m2pp_identifier (s, i);
> + m2pp_print (s, " : ");
> + m2pp_type (s, TREE_TYPE (i));
> + m2pp_recordfield_bitfield (s, i);
> + m2pp_recordfield_alignment (s, i);
> + m2pp_print (s, ";\n");
> + }
> + setindent (s, p);
> + m2pp_print (s, "END");
> + setindent (s, o);
> + }
> + pop ();
> +}
> +
> +/* m2pp_record_type displays the record type. */
> +
> +static void
> +m2pp_union_type (pretty *s, tree t)
> +{
> + push (t);
> + if (TREE_CODE (t) == UNION_TYPE)
> + {
> + tree i;
> + int o = getindent (s);
> + int p = getcurpos (s);
> +
> + m2pp_print (s, "CASE .. OF\n");
> + setindent (s, p + 3);
> + m2pp_record_alignment (s, t);
> + for (i = TYPE_FIELDS (t); i != NULL_TREE; i = TREE_CHAIN (i))
> + {
> + m2pp_identifier (s, i);
> + m2pp_print (s, " : ");
> + m2pp_type (s, TREE_TYPE (i));
> + m2pp_recordfield_bitfield (s, i);
> + m2pp_print (s, ";\n");
> + }
> + setindent (s, p);
> + m2pp_print (s, "END");
> + setindent (s, o);
> + }
> + pop ();
> +}
> +
> +/* m2pp_simple_type. */
> +
> +static void
> +m2pp_simple_type (pretty *s, tree t)
> +{
> + if (begin_printed (t))
> + {
> + m2pp_print (s, "<...>");
> + return;
> + }
> +
> + m2pp_gimpified (s, t);
> + switch (TREE_CODE (t))
> + {
> + case INTEGER_TYPE:
> + m2pp_integer (s, t);
> + break;
> + case REAL_TYPE:
> + m2pp_print (s, "REAL");
> + break;
> + case BOOLEAN_TYPE:
> + m2pp_print (s, "BOOLEAN");
> + break;
> + case VOID_TYPE:
> + m2pp_print (s, "ADDRESS");
> + break;
> + case TYPE_DECL:
> + m2pp_identifier (s, t);
> + break;
> + case POINTER_TYPE:
> + m2pp_pointer_type (s, t);
> + break;
> + case RECORD_TYPE:
> + m2pp_record_type (s, t);
> + break;
> + case UNION_TYPE:
> + m2pp_union_type (s, t);
> + break;
> + case ENUMERAL_TYPE:
> + m2pp_enum (s, t);
> + break;
> + case COMPLEX_TYPE:
> + m2pp_complex (s, t);
> + break;
> + default:
> + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
> + }
> +}
> +
> +/* m2pp_expression display an expression. */
> +
> +static void
> +m2pp_expression (pretty *s, tree t)
> +{
> + enum tree_code code = TREE_CODE (t);
> +
> + switch (code)
> + {
> + case EQ_EXPR:
> + m2pp_relop (s, t, "=");
> + break;
> + case NE_EXPR:
> + m2pp_relop (s, t, "#");
> + break;
> + case LE_EXPR:
> + m2pp_relop (s, t, "<=");
> + break;
> + case GE_EXPR:
> + m2pp_relop (s, t, ">=");
> + break;
> + case LT_EXPR:
> + m2pp_relop (s, t, "<");
> + break;
> + case GT_EXPR:
> + m2pp_relop (s, t, ">");
> + break;
> + default:
> + m2pp_simple_expression (s, t);
> + }
> +}
> +
> +/* m2pp_relop displays the lhs relop rhs. */
> +
> +static void
> +m2pp_relop (pretty *s, tree t, const char *p)
> +{
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_needspace (s);
> + m2pp_print (s, p);
> + m2pp_needspace (s);
> + m2pp_expression (s, TREE_OPERAND (t, 1));
> +}
> +
> +/* m2pp_compound_expression handle compound expression tree. */
> +
> +static void
> +m2pp_compound_expression (pretty *s, tree t)
> +{
> + m2pp_print (s, "compound expression {");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, " (* result ignored *), ");
> + m2pp_expression (s, TREE_OPERAND (t, 1));
> + m2pp_print (s, "}");
> + m2pp_needspace (s);
> +}
> +
> +/* m2pp_target_expression handle target expression tree. */
> +
> +static void
> +m2pp_target_expression (pretty *s, tree t)
> +{
> + m2pp_print (s, "{");
> + m2pp_needspace (s);
> + if (TREE_OPERAND (t, 0) != NULL_TREE)
> + {
> + m2pp_print (s, "(* target *) ");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + }
> + if (TREE_OPERAND (t, 1) != NULL_TREE)
> + {
> + m2pp_print (s, "(* initializer *) ");
> + m2pp_expression (s, TREE_OPERAND (t, 1));
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + }
> + if (TREE_OPERAND (t, 2) != NULL_TREE)
> + {
> + m2pp_print (s, "(* cleanup *) ");
> + m2pp_expression (s, TREE_OPERAND (t, 2));
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + }
> + if (TREE_OPERAND (t, 3) != NULL_TREE)
> + {
> + m2pp_print (s, "(* saved initializer *) ");
> + m2pp_expression (s, TREE_OPERAND (t, 3));
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + }
> + m2pp_print (s, "}");
> + m2pp_needspace (s);
> +}
> +
> +/* m2pp_constructor print out a constructor. */
> +
> +static void
> +m2pp_constructor (pretty *s, tree t)
> +{
> + tree purpose, value;
> + unsigned HOST_WIDE_INT ix;
> +
> + m2pp_print (s, "{ ");
> + FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (t), ix, purpose, value)
> + {
> + m2pp_print (s, "(index: ");
> + m2pp_simple_expression (s, purpose);
> + m2pp_print (s, ") ");
> + m2pp_simple_expression (s, value);
> + m2pp_print (s, ", ");
> + }
> + m2pp_print (s, "}");
> + m2pp_print (s, "(* type: ");
> + setindent (s, getindent (s) + 8);
> + m2pp_type (s, TREE_TYPE (t));
> + setindent (s, getindent (s) - 8);
> + m2pp_print (s, " *)\n");
> +}
> +
> +/* m2pp_complex_expr handle GCC complex_expr tree. */
> +
> +static void
> +m2pp_complex_expr (pretty *s, tree t)
> +{
> + if (TREE_CODE (t) == COMPLEX_CST)
> + {
> + m2pp_print (s, "CMPLX(");
> + m2pp_needspace (s);
> + m2pp_expression (s, TREE_REALPART (t));
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + m2pp_expression (s, TREE_IMAGPART (t));
> + m2pp_print (s, ")");
> + }
> + else
> + {
> + m2pp_print (s, "CMPLX(");
> + m2pp_needspace (s);
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + m2pp_expression (s, TREE_OPERAND (t, 1));
> + m2pp_print (s, ")");
> + }
> +}
> +
> +/* m2pp_imagpart_expr handle imagpart_expr tree. */
> +
> +static void
> +m2pp_imagpart_expr (pretty *s, tree t)
> +{
> + m2pp_print (s, "IM(");
> + m2pp_needspace (s);
> + if (TREE_CODE (t) == IMAGPART_EXPR)
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + else if (TREE_CODE (t) == COMPLEX_CST)
> + m2pp_expression (s, TREE_IMAGPART (t));
> + m2pp_needspace (s);
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_realpart_expr handle imagpart_expr tree. */
> +
> +static void
> +m2pp_realpart_expr (pretty *s, tree t)
> +{
> + m2pp_print (s, "RE(");
> + m2pp_needspace (s);
> + if (TREE_CODE (t) == REALPART_EXPR)
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + else if (TREE_CODE (t) == COMPLEX_CST)
> + m2pp_expression (s, TREE_REALPART (t));
> + m2pp_needspace (s);
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_bit_ior_expr generate a C style bit or. */
> +
> +static void
> +m2pp_bit_ior_expr (pretty *s, tree t)
> +{
> + m2pp_binary (s, t, "|");
> +}
> +
> +/* m2pp_truth_expr. */
> +
> +static void
> +m2pp_truth_expr (pretty *s, tree t, const char *op)
> +{
> + m2pp_print (s, "(");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ")");
> + m2pp_needspace (s);
> + m2pp_print (s, op);
> + m2pp_needspace (s);
> + m2pp_print (s, "(");
> + m2pp_expression (s, TREE_OPERAND (t, 1));
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_simple_expression handle GCC expression tree. */
> +
> +static void
> +m2pp_simple_expression (pretty *s, tree t)
> +{
> + enum tree_code code = TREE_CODE (t);
> +
> + switch (code)
> + {
> + case ERROR_MARK:
> + m2pp_print (s, "(* !!! ERROR NODE !!! *)");
> + break;
> + case CONSTRUCTOR:
> + m2pp_constructor (s, t);
> + break;
> + case IDENTIFIER_NODE:
> + m2pp_ident_pointer (s, t);
> + break;
> + case PARM_DECL:
> + m2pp_identifier (s, t);
> + break;
> + case FIELD_DECL:
> + m2pp_identifier (s, t);
> + break;
> + case TREE_LIST:
> + m2pp_list (s, t);
> + break;
> + case BLOCK:
> + m2pp_print (s, "(* BLOCK NODE *)");
> + break;
> + case OFFSET_TYPE:
> + m2pp_offset (s, t);
> + break;
> + case INTEGER_CST:
> + m2pp_integer_cst (s, t);
> + break;
> + case REAL_CST:
> + m2pp_real_cst (s, t);
> + break;
> + case STRING_CST:
> + m2pp_string_cst (s, t);
> + break;
> + case INDIRECT_REF:
> + m2pp_indirect_ref (s, t);
> + break;
> + case ADDR_EXPR:
> + m2pp_addr_expr (s, t);
> + break;
> + case NOP_EXPR:
> + m2pp_nop (s, t);
> + break;
> + case CONVERT_EXPR:
> + m2pp_convert (s, t);
> + break;
> + case VAR_DECL:
> + m2pp_var_decl (s, t);
> + break;
> + case RESULT_DECL:
> + m2pp_result_decl (s, t);
> + break;
> + case PLUS_EXPR:
> + m2pp_binary (s, t, "+");
> + break;
> + case MINUS_EXPR:
> + m2pp_binary (s, t, "-");
> + break;
> + case MULT_EXPR:
> + m2pp_binary (s, t, "*");
> + break;
> + case FLOOR_DIV_EXPR:
> + case CEIL_DIV_EXPR:
> + case TRUNC_DIV_EXPR:
> + case ROUND_DIV_EXPR:
> + m2pp_binary (s, t, "DIV");
> + break;
> + case FLOOR_MOD_EXPR:
> + case CEIL_MOD_EXPR:
> + case TRUNC_MOD_EXPR:
> + case ROUND_MOD_EXPR:
> + m2pp_binary (s, t, "MOD");
> + break;
> + case NEGATE_EXPR:
> + m2pp_unary (s, t, "-");
> + break;
> + case CALL_EXPR:
> + m2pp_call_expr (s, t);
> + break;
> + case SSA_NAME:
> + m2pp_ssa (s, t);
> + break;
> + case COMPONENT_REF:
> + m2pp_component_ref (s, t);
> + break;
> + case RETURN_EXPR:
> + m2pp_return_expr (s, t);
> + break;
> + case ARRAY_REF:
> + m2pp_array_ref (s, t);
> + break;
> + case NON_LVALUE_EXPR:
> + m2pp_non_lvalue_expr (s, t);
> + break;
> + case EXPR_STMT:
> + m2pp_expression (s, EXPR_STMT_EXPR (t));
> + break;
> +#if 0
> + case EXC_PTR_EXPR:
> + m2pp_print (s, "GCC_EXCEPTION_OBJECT");
> + break;
> +#endif
> + case INIT_EXPR:
> + case MODIFY_EXPR:
> + m2pp_assignment (s, t);
> + break;
> + case COMPOUND_EXPR:
> + m2pp_compound_expression (s, t);
> + break;
> + case TARGET_EXPR:
> + m2pp_target_expression (s, t);
> + break;
> + case THROW_EXPR:
> + m2pp_throw (s, t);
> + break;
> + case FUNCTION_DECL:
> + m2pp_identifier (s, t);
> + break;
> + case COMPLEX_EXPR:
> + m2pp_complex_expr (s, t);
> + break;
> + case REALPART_EXPR:
> + m2pp_realpart_expr (s, t);
> + break;
> + case IMAGPART_EXPR:
> + m2pp_imagpart_expr (s, t);
> + break;
> + case CONST_DECL:
> + m2pp_identifier (s, t);
> + break;
> + case POINTER_PLUS_EXPR:
> + m2pp_binary (s, t, "+");
> + break;
> + case CLEANUP_POINT_EXPR:
> + m2pp_cleanup_point_expr (s, t);
> + break;
> + case BIT_IOR_EXPR:
> + m2pp_bit_ior_expr (s, t);
> + break;
> + case TRUTH_ANDIF_EXPR:
> + m2pp_truth_expr (s, t, "AND");
> + break;
> + case TRUTH_ORIF_EXPR:
> + m2pp_truth_expr (s, t, "OR");
> + break;
> + default:
> + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (code));
> + }
> +}
> +
> +/* non_lvalue_expr indicates that operand 0 is not an lvalue. */
> +
> +static void
> +m2pp_non_lvalue_expr (pretty *s, tree t)
> +{
> + m2pp_needspace (s);
> + m2pp_print (s, "assert_non_lvalue(");
> + m2pp_needspace (s);
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_needspace (s);
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_array_ref prints out the array reference. */
> +
> +static void
> +m2pp_array_ref (pretty *s, tree t)
> +{
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, "[");
> + m2pp_expression (s, TREE_OPERAND (t, 1));
> + m2pp_print (s, "]");
> +}
> +
> +/* m2pp_ssa prints out the ssa variable name. */
> +
> +static void
> +m2pp_ssa (pretty *s, tree t)
> +{
> + m2pp_identifier (s, SSA_NAME_VAR (t));
> +}
> +
> +/* m2pp_binary print the binary operator, p, and lhs, rhs. */
> +
> +static void
> +m2pp_binary (pretty *s, tree t, const char *p)
> +{
> + tree left = TREE_OPERAND (t, 0);
> + tree right = TREE_OPERAND (t, 1);
> +
> + m2pp_expression (s, left);
> + m2pp_needspace (s);
> + m2pp_print (s, p);
> + m2pp_needspace (s);
> + m2pp_expression (s, right);
> +}
> +
> +/* m2pp_unary print the unary operator, p, and expression. */
> +
> +static void
> +m2pp_unary (pretty *s, tree t, const char *p)
> +{
> + tree expr = TREE_OPERAND (t, 0);
> +
> + m2pp_needspace (s);
> + m2pp_print (s, p);
> + m2pp_expression (s, expr);
> +}
> +
> +/* m2pp_integer_cst displays the integer constant. */
> +
> +static void
> +m2pp_integer_cst (pretty *s, tree t)
> +{
> + char val[100];
> +
> + snprintf (val, 100, "%lud", TREE_INT_CST_LOW (t));
> + m2pp_print (s, val);
> +}
> +
> +/* m2pp_real_cst displays the real constant. */
> +
> +static void
> +m2pp_real_cst (pretty *s, tree t ATTRIBUTE_UNUSED)
> +{
> + m2pp_print (s, "<unknown real>");
> +}
> +
> +/* m2pp_string_cst displays the real constant. */
> +
> +static void
> +m2pp_string_cst (pretty *s, tree t)
> +{
> + const char *p = TREE_STRING_POINTER (t);
> + int i = 0;
> +
> + m2pp_print (s, "\"");
> + while (p[i] != '\0')
> + {
> + m2pp_print_char (s, p[i]);
> + i++;
> + }
> + m2pp_print (s, "\"");
> +}
> +
> +/* m2pp_statement_sequence iterates over a statement list
> + displaying each statement in turn. */
> +
> +static void
> +m2pp_statement_sequence (pretty *s, tree t)
> +{
> + if (t != NULL_TREE)
> + {
> + if (TREE_CODE (t) == STATEMENT_LIST)
> + {
> + tree_stmt_iterator i;
> + m2pp_print (s, "(* statement list *)\n");
> +
> + for (i = tsi_start (t); !tsi_end_p (i); tsi_next (&i))
> + m2pp_statement (s, *tsi_stmt_ptr (i));
> + }
> + else
> + m2pp_statement (s, t);
> + }
> +}
> +
> +/* m2pp_unknown displays an error message. */
> +
> +static void
> +m2pp_unknown (pretty *s, const char *s1, const char *s2)
> +{
> + m2pp_begin (s);
> + m2pp_print (s, s1);
> + m2pp_needspace (s);
> + m2pp_print (s, s2);
> + m2pp_needspace (s);
> +}
> +
> +/* m2pp_throw displays a throw statement. */
> +
> +static void
> +m2pp_throw (pretty *s, tree t)
> +{
> + tree expr = TREE_OPERAND (t, 0);
> +
> + m2pp_begin (s);
> + if (expr == NULL_TREE)
> + m2pp_print (s, "THROW ;\n");
> + else
> + {
> + m2pp_print (s, "THROW (");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ")\n");
> + }
> +}
> +
> +/* m2pp_catch_expr attempts to reconstruct a catch expr. */
> +
> +static void
> +m2pp_catch_expr (pretty *s, tree t)
> +{
> + tree types = CATCH_TYPES (t);
> + tree body = CATCH_BODY (t);
> +
> + m2pp_print (s, "(* CATCH expression ");
> + if (types != NULL_TREE)
> + {
> + m2pp_print (s, "(");
> + m2pp_expression (s, types);
> + m2pp_print (s, ")");
> + }
> + m2pp_print (s, "*)\n");
> + m2pp_print (s, "(* catch body *)\n");
> + m2pp_statement_sequence (s, body);
> + m2pp_print (s, "(* end catch body *)\n");
> +}
> +
> +/* m2pp_try_finally_expr attemts to reconstruct a try finally expr. */
> +
> +static void
> +m2pp_try_finally_expr (pretty *s, tree t)
> +{
> + m2pp_begin (s);
> + m2pp_print (s, "(* try_finally_expr *)\n");
> + setindent (s, getindent (s) + 3);
> + m2pp_statement_sequence (s, TREE_OPERAND (t, 0));
> + setindent (s, getindent (s) - 3);
> + m2pp_print (s,
> + "(* finally (cleanup which is executed after the above) *)\n");
> + setindent (s, getindent (s) + 3);
> + m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
> + setindent (s, getindent (s) - 3);
> + m2pp_print (s, "(* end try_finally_expr *)\n");
> +}
> +
> +#if !defined(GM2)
> +/* m2pp_if_stmt pretty print a C++ if_stmt. */
> +
> +static void
> +m2pp_if_stmt (pretty *s, tree t)
> +{
> + m2pp_print (s, "(* only C++ uses if_stmt nodes *)\n");
> + m2pp_print (s, "IF ");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, "\n");
> + m2pp_print (s, "THEN\n");
> + setindent (s, getindent (s) + 3);
> + m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
> + setindent (s, getindent (s) - 3);
> + m2pp_print (s, "ELSE\n");
> + setindent (s, getindent (s) + 3);
> + m2pp_statement_sequence (s, TREE_OPERAND (t, 2));
> + setindent (s, getindent (s) - 3);
> + m2pp_print (s, "END\n");
> +}
> +#endif
> +
> +/* m2pp_statement attempts to reconstruct a statement. */
> +
> +static void
> +m2pp_statement (pretty *s, tree t)
> +{
> + enum tree_code code = TREE_CODE (t);
> +
> + m2pp_loc (s, t);
> + switch (code)
> + {
> + case COND_EXPR:
> + m2pp_conditional (s, t);
> + break;
> + case LABEL_EXPR:
> + m2pp_label_expr (s, t);
> + break;
> + case LABEL_DECL:
> + m2pp_label_decl (s, t);
> + break;
> + case GOTO_EXPR:
> + m2pp_goto (s, t);
> + break;
> + case INIT_EXPR:
> + case MODIFY_EXPR:
> + m2pp_assignment (s, t);
> + break;
> + case CALL_EXPR:
> + m2pp_procedure_call (s, t);
> + break;
> + case BLOCK:
> + m2pp_block_list (s, t);
> + break;
> + case BIND_EXPR:
> + m2pp_bind_expr (s, t);
> + break;
> + case RETURN_EXPR:
> + m2pp_return_expr (s, t);
> + break;
> + case DECL_EXPR:
> + m2pp_decl_expr (s, t);
> + break;
> + case TRY_BLOCK:
> + m2pp_try_block (s, t);
> + break;
> + case HANDLER:
> + m2pp_handler (s, t);
> + break;
> + case CLEANUP_POINT_EXPR:
> + m2pp_cleanup_point_expr (s, t);
> + break;
> + case THROW_EXPR:
> + m2pp_throw (s, t);
> + break;
> + case TRY_CATCH_EXPR:
> + m2pp_try_catch_expr (s, t);
> + break;
> + case TRY_FINALLY_EXPR:
> + m2pp_try_finally_expr (s, t);
> + break;
> + case CATCH_EXPR:
> + m2pp_catch_expr (s, t);
> + break;
> +#if defined(CPP)
> + case IF_STMT:
> + m2pp_if_stmt (s, t);
> + break;
> +#endif
> + case ERROR_MARK:
> + m2pp_print (s, "<ERROR CODE>\n");
> + break;
> + default:
> + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
> + }
> +}
> +
> +/* m2pp_try_catch_expr is used after gimplification. */
> +
> +static void
> +m2pp_try_catch_expr (pretty *s, tree t)
> +{
> + m2pp_print (s, "(* try_catch_expr begins *)\n");
> + m2pp_statement_sequence (s, TREE_OPERAND (t, 0));
> + setindent (s, 0);
> + m2pp_print (s, "EXCEPT\n");
> + setindent (s, 3);
> + m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
> + m2pp_print (s, "(* try_catch_expr ends *)\n");
> +}
> +
> +/* m2pp_cleanup_point_expr emits a comment indicating a GCC
> + cleanup_point_expr is present. */
> +
> +static void
> +m2pp_cleanup_point_expr (pretty *s, tree t)
> +{
> + m2pp_begin (s);
> + m2pp_print (s, "(* cleanup point begins *)\n");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, "(* cleanup point ends *)\n");
> +}
> +
> +/* m2pp_decl_expr displays a local declaration. */
> +
> +static void
> +m2pp_decl_expr (pretty *s, tree t)
> +{
> + m2pp_var (s);
> + m2pp_print (s, "(* variable in decl_expr *)\n");
> + m2pp_var_type_decl (s, DECL_EXPR_DECL (t));
> +}
> +
> +/* m2pp_procedure_call print a call to a procedure. */
> +
> +static void
> +m2pp_procedure_call (pretty *s, tree t)
> +{
> + m2pp_begin (s);
> + m2pp_call_expr (s, t);
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> +}
> +
> +/* args displays each argument in an iter list by calling expression. */
> +
> +static void
> +m2pp_args (pretty *s, tree e)
> +{
> + call_expr_arg_iterator iter;
> + tree arg;
> +
> + m2pp_print (s, "(");
> + m2pp_needspace (s);
> + FOR_EACH_CALL_EXPR_ARG (arg, iter, e)
> + {
> + m2pp_expression (s, arg);
> + if (more_call_expr_args_p (&iter))
> + {
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + }
> + }
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_call_expr print a call to a procedure or function. */
> +
> +static void
> +m2pp_call_expr (pretty *s, tree t)
> +{
> + tree call = CALL_EXPR_FN (t);
> + tree args = TREE_OPERAND (t, 1);
> + tree type = TREE_TYPE (t);
> + int has_return_type = TRUE;
> + tree proc;
> +
> + if (type && (TREE_CODE (type) == VOID_TYPE))
> + has_return_type = FALSE;
> +
> + if (TREE_CODE (call) == ADDR_EXPR || TREE_CODE (call) == NON_LVALUE_EXPR)
> + proc = TREE_OPERAND (call, 0);
> + else
> + proc = call;
> +
> + m2pp_expression (s, proc);
> + if (args || has_return_type)
> + m2pp_args (s, t);
> +}
> +
> +/* m2pp_return_expr displays the return statement. */
> +
> +static void
> +m2pp_return_expr (pretty *s, tree t)
> +{
> + tree e = TREE_OPERAND (t, 0);
> +
> + m2pp_begin (s);
> + if (e == NULL_TREE)
> + {
> + m2pp_print (s, "RETURN");
> + }
> + else if (TREE_CODE (e) == MODIFY_EXPR || (TREE_CODE (e) == INIT_EXPR))
> + {
> + m2pp_assignment (s, e);
> + m2pp_print (s, "RETURN");
> + m2pp_needspace (s);
> + m2pp_expression (s, TREE_OPERAND (e, 0));
> + }
> + else
> + {
> + m2pp_print (s, "RETURN");
> + m2pp_needspace (s);
> + m2pp_expression (s, e);
> + }
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> +}
> +
> +/* m2pp_try_block displays the try block. */
> +
> +static void
> +m2pp_try_block (pretty *s, tree t)
> +{
> + tree stmts = TRY_STMTS (t);
> + tree handlers = TRY_HANDLERS (t);
> +
> + m2pp_begin (s);
> + m2pp_print (s, "(* TRY *)\n");
> + m2pp_statement_sequence (s, stmts);
> + setindent (s, 0);
> + m2pp_print (s, "EXCEPT\n");
> + setindent (s, 3);
> + m2pp_statement_sequence (s, handlers);
> + m2pp_print (s, "(* END TRY *)\n");
> +}
> +
> +/* m2pp_try_block displays the handler block. */
> +
> +static void
> +m2pp_handler (pretty *s, tree t)
> +{
> + tree parms = HANDLER_PARMS (t);
> + tree body = HANDLER_BODY (t);
> + tree type = HANDLER_TYPE (t);
> +
> + m2pp_print (s, "(* handler *)\n");
> + if (parms != NULL_TREE)
> + {
> + m2pp_print (s, "(* handler parameter has a type (should be NULL_TREE) "
> + "in Modula-2 *)\n");
> + m2pp_print (s, "CATCH (");
> + m2pp_expression (s, parms);
> + m2pp_print (s, ")\n");
> + }
> + if (type != NULL_TREE)
> + m2pp_print (s, "(* handler type (should be NULL_TREE) in Modula-2 *)\n");
> + m2pp_statement_sequence (s, body);
> +}
> +
> +/* m2pp_assignment prints out the assignment statement. */
> +
> +static void
> +m2pp_assignment (pretty *s, tree t)
> +{
> + int o;
> +
> + m2pp_begin (s);
> + m2pp_designator (s, TREE_OPERAND (t, 0));
> + m2pp_needspace (s);
> + m2pp_print (s, ":=");
> + m2pp_needspace (s);
> + o = getindent (s);
> + setindent (s, getcurpos (s) + 1);
> + m2pp_expression (s, TREE_OPERAND (t, 1));
> + m2pp_needspace (s);
> + m2pp_print (s, ";\n");
> + setindent (s, o);
> +}
> +
> +/* m2pp_designator displays the lhs of an assignment. */
> +
> +static void
> +m2pp_designator (pretty *s, tree t)
> +{
> + m2pp_expression (s, t);
> +}
> +
> +/* m2pp_indirect_ref displays the indirect operator. */
> +
> +static void
> +m2pp_indirect_ref (pretty *s, tree t)
> +{
> + m2pp_print (s, "(");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ")^");
> +}
> +
> +/* m2pp_conditional builds an IF THEN ELSE END. With more work
> + this should be moved into statement sequence which could look for
> + repeat and while loops. */
> +
> +static void
> +m2pp_conditional (pretty *s, tree t)
> +{
> + int o;
> +
> + m2pp_begin (s);
> + m2pp_print (s, "IF");
> + m2pp_needspace (s);
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, "\nTHEN\n");
> + o = getindent (s);
> + setindent (s, o + 3);
> + m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
> + setindent (s, o);
> + if (TREE_OPERAND (t, 2) != NULL_TREE)
> + {
> + m2pp_print (s, "ELSE\n");
> + setindent (s, o + 3);
> + m2pp_statement_sequence (s, TREE_OPERAND (t, 2));
> + setindent (s, o);
> + }
> + m2pp_print (s, "END ;\n");
> +}
> +
> +/* m2pp_label_decl displays a label. Again should be moved into
> + statement sequence to determine proper loop constructs. */
> +
> +static void
> +m2pp_label_decl (pretty *s, tree t)
> +{
> + m2pp_begin (s);
> + m2pp_print (s, "(* label ");
> + m2pp_identifier (s, t);
> + m2pp_print (s, ": *)\n");
> +}
> +
> +/* m2pp_label_expr skips the LABEL_EXPR to find the LABEL_DECL. */
> +
> +static void
> +m2pp_label_expr (pretty *s, tree t)
> +{
> + m2pp_begin (s);
> + m2pp_statement (s, TREE_OPERAND (t, 0));
> +}
> +
> +/* m2pp_goto displays a goto statement. Again should be moved into
> + statement sequence to determine proper loop constructs. */
> +
> +static void
> +m2pp_goto (pretty *s, tree t)
> +{
> + m2pp_begin (s);
> + m2pp_print (s, "(* goto ");
> + m2pp_identifier (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, " *)\n");
> +}
> +
> +/* m2pp_list prints a TREE_CHAINed list. */
> +
> +static void
> +m2pp_list (pretty *s, tree t)
> +{
> + tree u = t;
> +
> + m2pp_print (s, "(");
> + m2pp_needspace (s);
> + while (t != NULL_TREE)
> + {
> + m2pp_expression (s, TREE_VALUE (t));
> + t = TREE_CHAIN (t);
> + if (t == u || t == NULL_TREE)
> + break;
> + m2pp_print (s, ",");
> + m2pp_needspace (s);
> + }
> + m2pp_needspace (s);
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_offset displays the offset operator. */
> +
> +static void
> +m2pp_offset (pretty *s, tree t)
> +{
> + tree type = TREE_TYPE (t);
> + tree base = TYPE_OFFSET_BASETYPE (t);
> +
> + m2pp_print (s, "OFFSET (");
> + m2pp_type (s, base);
> + m2pp_print (s, ".");
> + m2pp_type (s, type);
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_addr_expr create an ADR expression. */
> +
> +static void
> +m2pp_addr_expr (pretty *s, tree t)
> +{
> + m2pp_needspace (s);
> + m2pp_print (s, "ADR (");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_nop generate a CAST expression. */
> +
> +static void
> +m2pp_nop (pretty *s, tree t)
> +{
> + m2pp_needspace (s);
> + m2pp_print (s, "CAST (");
> + m2pp_simple_type (s, TREE_TYPE (t));
> + m2pp_print (s, ", ");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_convert generate a CONVERT expression. */
> +
> +static void
> +m2pp_convert (pretty *s, tree t)
> +{
> + m2pp_needspace (s);
> + m2pp_print (s, "CONVERT (");
> + m2pp_simple_type (s, TREE_TYPE (t));
> + m2pp_print (s, ", ");
> + m2pp_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ")");
> +}
> +
> +/* m2pp_var_decl generate a variable. */
> +
> +static void
> +m2pp_var_decl (pretty *s, tree t)
> +{
> + m2pp_identifier (s, t);
> +}
> +
> +/* m2pp_result_decl generate a result declaration (variable). */
> +
> +static void
> +m2pp_result_decl (pretty *s, tree t)
> +{
> + m2pp_identifier (s, t);
> +}
> +
> +/* m2pp_component_ref generate a record field access. */
> +
> +static void
> +m2pp_component_ref (pretty *s, tree t)
> +{
> + m2pp_simple_expression (s, TREE_OPERAND (t, 0));
> + m2pp_print (s, ".");
> + m2pp_simple_expression (s, TREE_OPERAND (t, 1));
> +}
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2pp.h
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/m2pp.h 2022-10-07 20:21:18.662097087 +0100
> @@ -0,0 +1,42 @@
> +/* m2pp.h pretty print trees, output in Modula-2 where possible.
> +
> +Copyright (C) 2007-2022 Free Software Foundation, Inc.
> +Contributed by Gaius Mulley <gaius@glam.ac.uk>.
> +
> +This file is part of GNU Modula-2.
> +
> +GNU Modula-2 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.
> +
> +GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
> +<http://www.gnu.org/licenses/>. */
> +
> +#if !defined(M2PP_H)
> +# define M2PP_H
> +
> +# if defined(M2PP_C)
> +# define EXTERN
> +# else
> +# define EXTERN extern
> +# endif
> +
> +/* These functions allow a maintainer to dump the trees in Modula-2. */
> +
> +EXTERN void pf (tree t);
> +EXTERN void pe (tree t);
> +EXTERN void pt (tree t);
> +EXTERN void ptl (tree t);
> +EXTERN void pv (tree t);
> +EXTERN void ptcl (tree t);
> +
> +
> +# undef EXTERN
> +#endif
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2-tree.def
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/m2-tree.def 2022-10-07 20:21:18.662097087 +0100
> @@ -0,0 +1,24 @@
> +/* gm2-tree.def a component of a C header file used to define a SET type.
> +
> +Copyright (C) 2006-2022 Free Software Foundation, Inc.
> +Contributed by Gaius Mulley <gaius@glam.ac.uk>.
> +
> +This file is part of GNU Modula-2.
> +
> +GNU Modula-2 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.
> +
> +GNU Modula-2 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 GNU Modula-2; see the file COPYING. If not, write to the
> +Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
> +02110-1301, USA. */
> +
> +/* A SET_TYPE type. */
> +DEFTREECODE (SET_TYPE, "set_type", tcc_type, 0)
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2-tree.h
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/m2-tree.h 2022-10-07 20:21:18.662097087 +0100
> @@ -0,0 +1,48 @@
> +/* m2-tree.h create language specific tree nodes for Modula-2.
> +
> +Copyright (C) 2001-2022 Free Software Foundation, Inc.
> +Contributed by Gaius Mulley <gaius@glam.ac.uk>.
> +
> +This file is part of GNU Modula-2.
> +
> +GNU Modula-2 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.
> +
> +GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
> +<http://www.gnu.org/licenses/>. */
> +
> +#ifndef GCC_GM2_TREE_H
> +#define GCC_GM2_TREE_H
> +
> +#include "ggc.h"
> +#include "function.h"
> +#include "hashtab.h"
> +#include "vec.h"
> +
> +/* These macros provide convenient access to the various statement nodes. */
> +
> +#define TRY_STMTS(NODE) TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 0)
> +#define TRY_HANDLERS(NODE) TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 1)
> +
> +/* Nonzero if this try block is a function try block. */
> +#define FN_TRY_BLOCK_P(NODE) TREE_LANG_FLAG_3 (TRY_BLOCK_CHECK (NODE))
> +#define HANDLER_PARMS(NODE) TREE_OPERAND (HANDLER_CHECK (NODE), 0)
> +#define HANDLER_BODY(NODE) TREE_OPERAND (HANDLER_CHECK (NODE), 1)
> +#define HANDLER_TYPE(NODE) TREE_TYPE (HANDLER_CHECK (NODE))
> +
> +/* STMT_EXPR accessor. */
> +#define STMT_EXPR_STMT(NODE) TREE_OPERAND (STMT_EXPR_CHECK (NODE), 0)
> +
> +/* EXPR_STMT accessor. This gives the expression associated with an
> + expression statement. */
> +#define EXPR_STMT_EXPR(NODE) TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0)
> +
> +#endif
> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/version.c
> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
> +++ gcc-git-devel-modula2/gcc/m2/version.c 2022-10-07 20:21:18.682097332 +0100
> @@ -0,0 +1 @@
> +#define version_string "1.9.5"
The rest looks OK. I wonder if caret diagnostics work for modula2
(for middle-end emitted
diagnostics, not sure if the frontend uses GCCs diagnostic machinery)
Thanks,
Richard.
Richard Biener <richard.guenther@gmail.com> writes:
>> +/* We don't use language_function. */
>
> well ...
oops, yes - I'll remove the comment!
>> +struct GTY (()) language_function
>> +{
>> +
>> + /* While we are parsing the function, this contains information about
>> + the statement-tree that we are building. */
>> + /* struct stmt_tree_s stmt_tree; */
>> + tree stmt_tree;
>
> ... but this?
>
>> +};
>> +
>> +/* end of new stuff. */
>> +
>> +/* Language hooks. */
>> +
>> +bool
>> +gm2_langhook_init (void)
>> +{
>> + build_common_tree_nodes (false);
>> +
>> + /* I don't know why this has to be done explicitly. */
>> + void_list_node = build_tree_list (NULL_TREE, void_type_node);
>
> it's now done in build_common_tree_nodes
thanks
>> + build_common_builtin_nodes ();
>> +
>> + /* The default precision for floating point numbers. This is used
>> + for floating point constants with abstract type. This may eventually
>> + be controllable by a command line option. */
>> + mpfr_set_default_prec (256);
>> +
>> + /* GNU Modula-2 uses exceptions. */
>> + using_eh_for_cleanups ();
>> +
>> + return true;
>> +}
>> +
>> +/* The option mask. */
>> +
>> +static unsigned int
>> +gm2_langhook_option_lang_mask (void)
>> +{
>> + return CL_ModulaX2;
>> +}
>> +
>> +/* Initialize the options structure. */
>> +
>> +static void
>> +gm2_langhook_init_options_struct (struct gcc_options *opts)
>> +{
>> + /* Default to avoiding range issues for complex multiply and divide. */
>> + opts->x_flag_complex_method = 2;
>> +
>> + /* The builtin math functions should not set errno. */
>> + opts->x_flag_errno_math = 0;
>> + opts->frontend_set_flag_errno_math = true;
>> +
>> + /* Exceptions are used to handle recovering from panics. */
>> + opts->x_flag_exceptions = 1;
>> + opts->x_flag_non_call_exceptions = 1;
>
> whohoo - really non-call-exceptions?
ah thankyou. Now removed, bootstrapped and regression tests pass.
>> + init_FrontEndInit ();
>> +}
>> +
[snip]
>> +static tree
>> +gm2_langhook_type_for_mode (machine_mode mode, int unsignedp)
>> +{
>> + tree type;
>> +
>> + if (VECTOR_MODE_P (mode))
>> + {
>> + tree inner;
>> +
>> + inner = gm2_langhook_type_for_mode (GET_MODE_INNER (mode), unsignedp);
>> + if (inner != NULL_TREE)
>> + return build_vector_type_for_mode (inner, mode);
>> + return NULL_TREE;
>> + }
>> +
>> + scalar_int_mode imode;
>> + scalar_float_mode fmode;
>> + complex_mode cmode;
>> + if (is_int_mode (mode, &imode))
>> + return gm2_langhook_type_for_size (GET_MODE_BITSIZE (imode), unsignedp);
>> + else if (is_float_mode (mode, &fmode))
>> + {
>> + switch (GET_MODE_BITSIZE (fmode))
>> + {
>> + case 32:
>> + return float_type_node;
>> + case 64:
>> + return double_type_node;
>
> Have a look at lto/lto-lang.cc where we match the global types with
thanks will do!
> if (mode == TYPE_MODE (float_type_node))
> return float_type_node;
>
> I think that's better than relying on the size statically as you do
> above.
yes indeed
>> + default:
>> + // We have to check for long double in order to support
>> + // i386 excess precision.
>> + if (fmode == TYPE_MODE (long_double_type_node))
>> + return long_double_type_node;
>> + }
>> + }
>> + else if (is_complex_float_mode (mode, &cmode))
>> + {
>> + switch (GET_MODE_BITSIZE (cmode))
>> + {
>> + case 64:
>> + return complex_float_type_node;
>> + case 128:
>> + return complex_double_type_node;
>> + default:
>> + // We have to check for long double in order to support
>> + // i386 excess precision.
>> + if (cmode == TYPE_MODE (complex_long_double_type_node))
>> + return complex_long_double_type_node;
>> + }
>> + }
>> +
>> +#if HOST_BITS_PER_WIDE_INT >= 64
>> +
>> + /* The middle-end and some backends rely on TImode being supported
>> + for 64-bit HWI. */
>> + if (mode == TImode)
>> + {
>> + type = build_nonstandard_integer_type (GET_MODE_BITSIZE (TImode),
>> + unsignedp);
>> + if (type && TYPE_MODE (type) == TImode)
>> + return type;
>> + }
>> +#endif
>
> Instead of this block look at c-family/c-common.cc which does
>
> for (i = 0; i < NUM_INT_N_ENTS; i ++)
> if (int_n_enabled_p[i]
> && mode == int_n_data[i].m)
> return (unsignedp ? int_n_trees[i].unsigned_type
> : int_n_trees[i].signed_type);
ok will do - thanks for the direction.
> it might be practical to factor out handling of the global tree nodes into
> a function in the middle-end that frontends can call after processing modes
> it has special types for.
yes it sounds like a common front end use.
>> + return NULL_TREE;
>> +}
>> +
[snip]
>> +/* m2_write_global_declarations writes out globals by coping into a vec
>> + and calling wrapup_global_declarations. */
>> +
>> +static void
>> +m2_write_global_declarations (tree globals)
>> +{
>> + tree decl = globals;
>> + int n = 0;
>> +
>> + while (decl != NULL)
>> + {
>> + n++;
>> + decl = TREE_CHAIN (decl);
>> + }
>> +
>> + if (n > 0)
>> + {
>> + int i = 0;
>> + tree vec[n];
>
> to simplify this and to avoid huge stack usage it might
> be easier to use an auto_vec<tree> here and simply
> pushing the chain onto that, passing .address () to
> wrapup_global_declarations.
will do.
>> + decl = globals;
>> + while (decl != NULL)
>> + {
>> + vec[i] = decl;
>> + decl = TREE_CHAIN (decl);
>> + i++;
>> + }
>> + wrapup_global_declarations (vec, n);
>> + }
>> +}
[snip]
>> +/* FIXME: This is a hack to preserve trees that we create from the
>> + garbage collector. */
>> +
>> +static GTY (()) tree gm2_gc_root;
>> +static tree personality_decl = NULL_TREE;
>> +
>> +static void
>> +gm2_preserve_from_gc (tree t)
>> +{
>> + gm2_gc_root = tree_cons (NULL_TREE, t, gm2_gc_root);
>
> I suppose it's difficult to properly mark roots in the m2 sources?
yes - especially if they are translated into C++ (not impossible - but
easier do it in a C++ module and then make m2 call the C++ function).
> I'll note that using a tree_list is prone to deep GC mark stacks,
> eventually a vec<tree, va_gc> might be more efficient here.
thanks I'll change this and avoid tree_list in favour of vec in the future.
> Since more frontends seem to use hacks like this "support"
> for this from the GC itself might be nice (even if just having
> this "hackish" GC root globally). Just an idea for the future.
yes this sounds cleaner.
>> +}
>> +
>> +/* Return a decl for the exception personality function. */
>> +
>> +static tree
>> +gm2_langhook_eh_personality (void)
>> +{
>> + if (personality_decl == NULL_TREE)
>> + {
>> + personality_decl = build_personality_function ("gxx");
>> + gm2_preserve_from_gc (personality_decl);
>
> For example the C++ frontend just has a global
>
> static GTY(()) tree cp_eh_personality_decl;
thanks - I'll re-examine/borrow the C++ code.
>> + }
>> + return personality_decl;
>> +}
>> +
>> +/* Functions called directly by the generic backend. */
>
>> +tree
>> +convert_loc (location_t location, tree type, tree expr)
>> +{
>> + if (type == error_mark_node || expr == error_mark_node
>> + || TREE_TYPE (expr) == error_mark_node)
>> + return error_mark_node;
>> +
>> + if (type == TREE_TYPE (expr))
>> + return expr;
>> +
>> + gcc_assert (TYPE_MAIN_VARIANT (type) != NULL);
>> + if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
>> + return fold_convert (type, expr);
>> +
>> + expr = m2convert_GenericToType (location, type, expr);
>> + switch (TREE_CODE (type))
>> + {
>> + case VOID_TYPE:
>> + case BOOLEAN_TYPE:
>> + return fold_convert (type, expr);
>> + case INTEGER_TYPE:
>> + return fold (convert_to_integer (type, expr));
>> + case POINTER_TYPE:
>> + return fold (convert_to_pointer (type, expr));
>> + case REAL_TYPE:
>> + return fold (convert_to_real (type, expr));
>> + case COMPLEX_TYPE:
>> + return fold (convert_to_complex (type, expr));
>> + case ENUMERAL_TYPE:
>> + return fold (convert_to_integer (type, expr));
>> + default:
>> + error_at (location, "cannot convert expression, only base types can be converted");
>> + break;
>> + }
>> + return error_mark_node;
>> +}
>> +
>> +/* Functions called directly by the generic backend. */
>
> In theory, if the frontend doesn't call convert_* from gcc/convert.{h,cc} then
> these shouldn't be necessary and are never called (but we build and link
> convert.cc so they have to be present) - does the m2 frontend use
> those?
yes. It might be possible to reduce the uses of convert_* in the front
end though.
> If not it _shoult_ work to simply have a gcc_unreachable () in them ..
> (and we should have a LANG_USES_CONVERT language macro to gate
> compiling of convert.cc or simply adjust all the lang/Make-lang.in to include
> it when necessary, moving convert.{cc,h} to a new gcc/lang-common/
> directory).
ok.
>> +tree
>> +convert (tree type, tree expr)
>> +{
>> + return convert_loc (m2linemap_UnknownLocation (), type, expr);
>> +}
>> +
[snip]
>> +tree
>> +gm2_type_for_size (unsigned int bits, int unsignedp)
>> +{
>> + tree type;
>> +
>> + if (unsignedp)
>> + {
>> + if (bits == INT_TYPE_SIZE)
>> + type = unsigned_type_node;
>> + else if (bits == CHAR_TYPE_SIZE)
>> + type = unsigned_char_type_node;
>> + else if (bits == SHORT_TYPE_SIZE)
>> + type = short_unsigned_type_node;
>> + else if (bits == LONG_TYPE_SIZE)
>> + type = long_unsigned_type_node;
>> + else if (bits == LONG_LONG_TYPE_SIZE)
>> + type = long_long_unsigned_type_node;
>> + else
>> + type = make_unsigned_type (bits);
>
> You want to use build_nonstandard_integer_type instead
> here, otherwise each call gets a distinct type which is probably
> not intended. Frontends are fine to return NULL_TREE for
> unhandled cases though.
ah thanks - will change this.
> Again the c-family/c-common.cc or the lto-lang.cc implementations
> might be worth looking at.
>
>> + }
>> + else
>> + {
>> + if (bits == INT_TYPE_SIZE)
>> + type = integer_type_node;
>> + else if (bits == CHAR_TYPE_SIZE)
>> + type = signed_char_type_node;
>> + else if (bits == SHORT_TYPE_SIZE)
>> + type = short_integer_type_node;
>> + else if (bits == LONG_TYPE_SIZE)
>> + type = long_integer_type_node;
>> + else if (bits == LONG_LONG_TYPE_SIZE)
>> + type = long_long_integer_type_node;
>> + else
>> + type = make_signed_type (bits);
>> + }
>> + return type;
>> +}
>> +
[snip]
gcc/m2/m2pp.cc
>> +static void m2pp_decl_list (pretty *s, tree t);
>> +static void m2pp_loc (pretty *s, tree t);
>> +
>> +void pet (tree t);
>> +void m2pp_integer (pretty *s, tree t);
>> +
>> +extern void stop (void);
>> +
>> +static stack *stackPtr = NULL;
>> +
>> +/* do_pf helper function for pf. */
>> +
>> +void
>> +do_pf (tree t, int bits)
>
> Can you put these inside a namespace? Short identifiers tend to
sure yes will do
> cause "issues", esp. the two letter ones below. If they are merely
> for convenience in gdb sessions amending the gdbinit.in or
> gdbhooks.py might be more appropriate (not sure if we can have
> language specific snippets in there)
yes they were for gdb convenience - I'll look into gdbhooks.py.
[snip]
>> diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/version.c
>> --- /dev/null 2022-08-24 16:22:16.888000070 +0100
>> +++ gcc-git-devel-modula2/gcc/m2/version.c 2022-10-07 20:21:18.682097332 +0100
>> @@ -0,0 +1 @@
>> +#define version_string "1.9.5"
>
> The rest looks OK. I wonder if caret diagnostics work for modula2
> (for middle-end emitted
> diagnostics, not sure if the frontend uses GCCs diagnostic machinery)
yes, the front end (after lexical analysis) uses GCCs location_t and
emits: notes, warnings, errors and generates virtual locations for
operator sub expressions etc (using GCCs diagnostic machinery). I hope
to submit an analyzer patch for m2 during the next stage1.
The front end attempts to pass well formed non error trees down to
gimple (effort has been taken to cast and convert trees to avoid
middle/back end warnings). But it might be cleaner to have a
middle/back end call back so that front end knowledge can be relayed in
error messages.
Thank you for reviewing the patch!
regards,
Gaius
@@ -0,0 +1,938 @@
+/* gm2-lang.cc language-dependent hooks for GNU Modula-2.
+
+Copyright (C) 2002-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING. If not, write to the
+Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA. */
+
+#include "gm2-gcc/gcc-consolidation.h"
+
+#include "langhooks-def.h" /* FIXME: for lhd_set_decl_assembler_name. */
+#include "tree-pass.h" /* FIXME: only for PROP_gimple_any. */
+#include "toplev.h"
+#include "debug.h"
+
+#include "opts.h"
+
+#define GM2_LANG_C
+#include "gm2-lang.h"
+#include "m2block.h"
+#include "dynamicstrings.h"
+#include "m2options.h"
+#include "m2convert.h"
+#include "m2linemap.h"
+#include "init.h"
+#include "m2-tree.h"
+#include "convert.h"
+#include "rtegraph.h"
+
+static void write_globals (void);
+
+static int insideCppArgs = FALSE;
+
+#define EXPR_STMT_EXPR(NODE) TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0)
+
+/* start of new stuff. */
+
+/* Language-dependent contents of a type. */
+
+struct GTY (()) lang_type
+{
+ char dummy;
+};
+
+/* Language-dependent contents of a decl. */
+
+struct GTY (()) lang_decl
+{
+ char dummy;
+};
+
+/* Language-dependent contents of an identifier. This must include a
+ tree_identifier. */
+
+struct GTY (()) lang_identifier
+{
+ struct tree_identifier common;
+};
+
+/* 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;
+};
+
+/* We don't use language_function. */
+
+struct GTY (()) language_function
+{
+
+ /* While we are parsing the function, this contains information about
+ the statement-tree that we are building. */
+ /* struct stmt_tree_s stmt_tree; */
+ tree stmt_tree;
+};
+
+/* end of new stuff. */
+
+/* Language hooks. */
+
+bool
+gm2_langhook_init (void)
+{
+ build_common_tree_nodes (false);
+
+ /* I don't know why this has to be done explicitly. */
+ void_list_node = build_tree_list (NULL_TREE, void_type_node);
+
+ build_common_builtin_nodes ();
+
+ /* The default precision for floating point numbers. This is used
+ for floating point constants with abstract type. This may eventually
+ be controllable by a command line option. */
+ mpfr_set_default_prec (256);
+
+ /* GNU Modula-2 uses exceptions. */
+ using_eh_for_cleanups ();
+
+ return true;
+}
+
+/* The option mask. */
+
+static unsigned int
+gm2_langhook_option_lang_mask (void)
+{
+ return CL_ModulaX2;
+}
+
+/* Initialize the options structure. */
+
+static void
+gm2_langhook_init_options_struct (struct gcc_options *opts)
+{
+ /* Default to avoiding range issues for complex multiply and divide. */
+ opts->x_flag_complex_method = 2;
+
+ /* The builtin math functions should not set errno. */
+ opts->x_flag_errno_math = 0;
+ opts->frontend_set_flag_errno_math = true;
+
+ /* Exceptions are used to handle recovering from panics. */
+ opts->x_flag_exceptions = 1;
+ opts->x_flag_non_call_exceptions = 1;
+
+ init_FrontEndInit ();
+}
+
+/* Infrastructure for a VEC of bool values. */
+
+/* This array determines whether the filename is associated with the
+ C preprocessor. */
+
+static vec<bool> filename_cpp;
+
+void
+gm2_langhook_init_options (unsigned int decoded_options_count,
+ struct cl_decoded_option *decoded_options)
+{
+ unsigned int i;
+ bool in_cpp_args = false;
+
+ // filename_cpp = ggc_vec_alloc<bool> (decoded_options_count);
+
+ for (i = 1; i < decoded_options_count; i++)
+ {
+ switch (decoded_options[i].opt_index)
+ {
+ case OPT_fcpp_begin:
+ in_cpp_args = true;
+ break;
+ case OPT_fcpp_end:
+ in_cpp_args = false;
+ break;
+ case OPT_SPECIAL_input_file:
+ case OPT_SPECIAL_program_name:
+ filename_cpp.safe_push (in_cpp_args);
+ }
+ }
+ filename_cpp.safe_push (false);
+}
+
+static bool
+is_cpp_filename (unsigned int i)
+{
+ gcc_assert (i < filename_cpp.length ());
+ return filename_cpp[i];
+}
+
+/* Handle gm2 specific options. Return 0 if we didn't do anything. */
+
+bool
+gm2_langhook_handle_option (
+ size_t scode, const char *arg, HOST_WIDE_INT value, int kind ATTRIBUTE_UNUSED,
+ location_t loc ATTRIBUTE_UNUSED,
+ const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
+{
+ enum opt_code code = (enum opt_code)scode;
+
+ /* ignore file names. */
+ if (code == N_OPTS)
+ return 1;
+
+ switch (code)
+ {
+ case OPT_B:
+ M2Options_SetB (arg);
+ return 1;
+ case OPT_c:
+ M2Options_Setc (value);
+ return 1;
+ case OPT_I:
+ if (insideCppArgs)
+ {
+ const struct cl_option *option = &cl_options[scode];
+ const char *opt = (const char *)option->opt_text;
+ M2Options_CppArg (opt, arg, TRUE);
+ }
+ else
+ M2Options_SetSearchPath (arg);
+ return 1;
+ case OPT_fiso:
+ M2Options_SetISO (value);
+ return 1;
+ case OPT_fpim:
+ M2Options_SetPIM (value);
+ return 1;
+ case OPT_fpim2:
+ M2Options_SetPIM2 (value);
+ return 1;
+ case OPT_fpim3:
+ M2Options_SetPIM3 (value);
+ return 1;
+ case OPT_fpim4:
+ M2Options_SetPIM4 (value);
+ return 1;
+ case OPT_fpositive_mod_floor_div:
+ M2Options_SetPositiveModFloor (value);
+ return 1;
+ case OPT_flibs_:
+ /* handled in the gm2 driver. */
+ return 1;
+ case OPT_fgen_module_list_:
+ M2Options_SetGenModuleList (value, arg);
+ return 1;
+ case OPT_fnil:
+ M2Options_SetNilCheck (value);
+ return 1;
+ case OPT_fwholediv:
+ M2Options_SetWholeDiv (value);
+ return 1;
+ case OPT_findex:
+ M2Options_SetIndex (value);
+ return 1;
+ case OPT_frange:
+ M2Options_SetRange (value);
+ return 1;
+ case OPT_ffloatvalue:
+ M2Options_SetFloatValueCheck (value);
+ return 1;
+ case OPT_fwholevalue:
+ M2Options_SetWholeValueCheck (value);
+ return 1;
+ case OPT_freturn:
+ M2Options_SetReturnCheck (value);
+ return 1;
+ case OPT_fcase:
+ M2Options_SetCaseCheck (value);
+ return 1;
+ case OPT_fd:
+ M2Options_SetCompilerDebugging (value);
+ return 1;
+ case OPT_fdebug_trace_quad:
+ M2Options_SetDebugTraceQuad (value);
+ return 1;
+ case OPT_fdebug_trace_api:
+ M2Options_SetDebugTraceAPI (value);
+ return 1;
+ case OPT_fdebug_function_line_numbers:
+ M2Options_SetDebugFunctionLineNumbers (value);
+ return 1;
+ case OPT_fauto_init:
+ M2Options_SetAutoInit (value);
+ return 1;
+ case OPT_fsoft_check_all:
+ M2Options_SetCheckAll (value);
+ return 1;
+ case OPT_fexceptions:
+ M2Options_SetExceptions (value);
+ return 1;
+ case OPT_Wstyle:
+ M2Options_SetStyle (value);
+ return 1;
+ case OPT_Wpedantic:
+ M2Options_SetPedantic (value);
+ return 1;
+ case OPT_Wpedantic_param_names:
+ M2Options_SetPedanticParamNames (value);
+ return 1;
+ case OPT_Wpedantic_cast:
+ M2Options_SetPedanticCast (value);
+ return 1;
+ case OPT_fextended_opaque:
+ M2Options_SetExtendedOpaque (value);
+ return 1;
+ case OPT_Wverbose_unbounded:
+ M2Options_SetVerboseUnbounded (value);
+ return 1;
+ case OPT_Wunused_variable:
+ M2Options_SetUnusedVariableChecking (value);
+ return 1;
+ case OPT_Wunused_parameter:
+ M2Options_SetUnusedParameterChecking (value);
+ return 1;
+ case OPT_fm2_strict_type:
+ M2Options_SetStrictTypeChecking (value);
+ return 1;
+ case OPT_Wall:
+ M2Options_SetWall (value);
+ return 1;
+ case OPT_fxcode:
+ M2Options_SetXCode (value);
+ return 1;
+ case OPT_fm2_lower_case:
+ M2Options_SetLowerCaseKeywords (value);
+ return 1;
+ case OPT_fuse_list_:
+ M2Options_SetUselist (value, arg);
+ return 1;
+ case OPT_fruntime_modules_:
+ M2Options_SetRuntimeModuleOverride (arg);
+ return 1;
+ case OPT_fpthread:
+ /* handled in the driver. */
+ return 1;
+ case OPT_fm2_plugin:
+ /* handled in the driver. */
+ return 1;
+ case OPT_fscaffold_dynamic:
+ M2Options_SetScaffoldDynamic (value);
+ return 1;
+ case OPT_fscaffold_static:
+ M2Options_SetScaffoldStatic (value);
+ return 1;
+ case OPT_fscaffold_main:
+ M2Options_SetScaffoldMain (value);
+ return 1;
+ case OPT_fcpp:
+ M2Options_SetCpp (value);
+ return 1;
+ case OPT_fcpp_begin:
+ insideCppArgs = TRUE;
+ return 1;
+ case OPT_fcpp_end:
+ insideCppArgs = FALSE;
+ return 1;
+ case OPT_fq:
+ M2Options_SetQuadDebugging (value);
+ return 1;
+ case OPT_fsources:
+ M2Options_SetSources (value);
+ return 1;
+ case OPT_funbounded_by_reference:
+ M2Options_SetUnboundedByReference (value);
+ return 1;
+ case OPT_fdef_:
+ M2Options_setdefextension (arg);
+ return 1;
+ case OPT_fmod_:
+ M2Options_setmodextension (arg);
+ return 1;
+ case OPT_fdump_system_exports:
+ M2Options_SetDumpSystemExports (value);
+ return 1;
+ case OPT_fswig:
+ M2Options_SetSwig (value);
+ return 1;
+ case OPT_fshared:
+ M2Options_SetShared (value);
+ return 1;
+ case OPT_fm2_statistics:
+ M2Options_SetStatistics (value);
+ return 1;
+ case OPT_fm2_g:
+ M2Options_SetM2g (value);
+ return 1;
+ case OPT_O:
+ M2Options_SetOptimizing (value);
+ return 1;
+ case OPT_quiet:
+ M2Options_SetQuiet (value);
+ return 1;
+ case OPT_fm2_whole_program:
+ M2Options_SetWholeProgram (value);
+ return 1;
+ case OPT_flocation_:
+ if (strcmp (arg, "builtins") == 0)
+ {
+ M2Options_SetForcedLocation (BUILTINS_LOCATION);
+ return 1;
+ }
+ else if (strcmp (arg, "unknown") == 0)
+ {
+ M2Options_SetForcedLocation (UNKNOWN_LOCATION);
+ return 1;
+ }
+ else if ((arg != NULL) && (ISDIGIT (arg[0])))
+ {
+ M2Options_SetForcedLocation (atoi (arg));
+ return 1;
+ }
+ else
+ return 0;
+ case OPT_save_temps:
+ M2Options_SetSaveTemps (value);
+ return 1;
+ case OPT_save_temps_:
+ M2Options_SetSaveTempsDir (arg);
+ return 1;
+ default:
+ if (insideCppArgs)
+ {
+ const struct cl_option *option = &cl_options[scode];
+ const char *opt = (const char *)option->opt_text;
+
+ M2Options_CppArg (opt, arg, TRUE);
+ return 1;
+ }
+ return 0;
+ }
+ return 0;
+}
+
+/* Run after parsing options. */
+
+static bool
+gm2_langhook_post_options (const char **pfilename)
+{
+ const char *filename = *pfilename;
+ flag_excess_precision = EXCESS_PRECISION_FAST;
+ M2Options_SetCC1Quiet (quiet_flag);
+ M2Options_FinaliseOptions ();
+ main_input_filename = filename;
+
+ /* Returning false means that the backend should be used. */
+ return false;
+}
+
+/* Call the compiler for every source filename on the command line. */
+
+static void
+gm2_parse_input_files (const char **filenames, unsigned int filename_count)
+{
+ unsigned int i;
+ gcc_assert (filename_count > 0);
+
+ for (i = 0; i < filename_count; i++)
+ if (!is_cpp_filename (i))
+ {
+ main_input_filename = filenames[i];
+ init_PerCompilationInit (filenames[i]);
+ }
+}
+
+static void
+gm2_langhook_parse_file (void)
+{
+ gm2_parse_input_files (in_fnames, num_in_fnames);
+ write_globals ();
+}
+
+static tree
+gm2_langhook_type_for_size (unsigned int bits, int unsignedp)
+{
+ return gm2_type_for_size (bits, unsignedp);
+}
+
+static tree
+gm2_langhook_type_for_mode (machine_mode mode, int unsignedp)
+{
+ tree type;
+
+ if (VECTOR_MODE_P (mode))
+ {
+ tree inner;
+
+ inner = gm2_langhook_type_for_mode (GET_MODE_INNER (mode), unsignedp);
+ if (inner != NULL_TREE)
+ return build_vector_type_for_mode (inner, mode);
+ return NULL_TREE;
+ }
+
+ scalar_int_mode imode;
+ scalar_float_mode fmode;
+ complex_mode cmode;
+ if (is_int_mode (mode, &imode))
+ return gm2_langhook_type_for_size (GET_MODE_BITSIZE (imode), unsignedp);
+ else if (is_float_mode (mode, &fmode))
+ {
+ switch (GET_MODE_BITSIZE (fmode))
+ {
+ case 32:
+ return float_type_node;
+ case 64:
+ return double_type_node;
+ default:
+ // We have to check for long double in order to support
+ // i386 excess precision.
+ if (fmode == TYPE_MODE (long_double_type_node))
+ return long_double_type_node;
+ }
+ }
+ else if (is_complex_float_mode (mode, &cmode))
+ {
+ switch (GET_MODE_BITSIZE (cmode))
+ {
+ case 64:
+ return complex_float_type_node;
+ case 128:
+ return complex_double_type_node;
+ default:
+ // We have to check for long double in order to support
+ // i386 excess precision.
+ if (cmode == TYPE_MODE (complex_long_double_type_node))
+ return complex_long_double_type_node;
+ }
+ }
+
+#if HOST_BITS_PER_WIDE_INT >= 64
+
+ /* The middle-end and some backends rely on TImode being supported
+ for 64-bit HWI. */
+ if (mode == TImode)
+ {
+ type = build_nonstandard_integer_type (GET_MODE_BITSIZE (TImode),
+ unsignedp);
+ if (type && TYPE_MODE (type) == TImode)
+ return type;
+ }
+#endif
+ return NULL_TREE;
+}
+
+/* Record a builtin function. We just ignore builtin functions. */
+
+static tree
+gm2_langhook_builtin_function (tree decl)
+{
+ return decl;
+}
+
+/* Return true if we are in the global binding level. */
+
+static bool
+gm2_langhook_global_bindings_p (void)
+{
+ return current_function_decl == NULL_TREE;
+}
+
+/* Push a declaration into the current binding level. We can't
+ usefully implement this since we don't want to convert from tree back
+ to one of our internal data structures. I think the only way this is
+ used is to record a decl which is to be returned by getdecls, and we
+ could implement it for that purpose if necessary. */
+
+static tree
+gm2_langhook_pushdecl (tree decl ATTRIBUTE_UNUSED)
+{
+ gcc_unreachable ();
+}
+
+/* This hook is used to get the current list of declarations as trees.
+ We don't support that; instead we use write_globals. This can't
+ simply crash because it is called by -gstabs. */
+
+static tree
+gm2_langhook_getdecls (void)
+{
+ return NULL;
+}
+
+/* m2_write_global_declarations writes out globals by coping into a vec
+ and calling wrapup_global_declarations. */
+
+static void
+m2_write_global_declarations (tree globals)
+{
+ tree decl = globals;
+ int n = 0;
+
+ while (decl != NULL)
+ {
+ n++;
+ decl = TREE_CHAIN (decl);
+ }
+
+ if (n > 0)
+ {
+ int i = 0;
+ tree vec[n];
+ decl = globals;
+ while (decl != NULL)
+ {
+ vec[i] = decl;
+ decl = TREE_CHAIN (decl);
+ i++;
+ }
+ wrapup_global_declarations (vec, n);
+ }
+}
+
+/* Write out globals. */
+
+static void
+write_globals (void)
+{
+ tree t;
+ unsigned i;
+
+ m2block_finishGlobals ();
+
+ /* Process all file scopes in this compilation, and the
+ external_scope, through wrapup_global_declarations and
+ check_global_declarations. */
+ FOR_EACH_VEC_ELT (*all_translation_units, i, t)
+ m2_write_global_declarations (BLOCK_VARS (DECL_INITIAL (t)));
+}
+
+
+/* Gimplify an EXPR_STMT node. */
+
+static void
+gimplify_expr_stmt (tree *stmt_p)
+{
+ gcc_assert (EXPR_STMT_EXPR (*stmt_p) != NULL_TREE);
+
+ *stmt_p = EXPR_STMT_EXPR (*stmt_p);
+}
+
+/* Genericize a TRY_BLOCK. */
+
+static void
+genericize_try_block (tree *stmt_p)
+{
+ tree body = TRY_STMTS (*stmt_p);
+ tree cleanup = TRY_HANDLERS (*stmt_p);
+
+ *stmt_p = build2 (TRY_CATCH_EXPR, void_type_node, body, cleanup);
+}
+
+/* Genericize a HANDLER by converting to a CATCH_EXPR. */
+
+static void
+genericize_catch_block (tree *stmt_p)
+{
+ tree type = HANDLER_TYPE (*stmt_p);
+ tree body = HANDLER_BODY (*stmt_p);
+
+ /* FIXME should the caught type go in TREE_TYPE? */
+ *stmt_p = build2 (CATCH_EXPR, void_type_node, type, body);
+}
+
+/* Convert the tree representation of FNDECL from m2 frontend trees
+ to GENERIC. */
+
+extern void pf (tree);
+
+void
+gm2_genericize (tree fndecl)
+{
+ tree t;
+ struct cgraph_node *cgn;
+
+#if 0
+ pf (fndecl);
+#endif
+ /* Fix up the types of parms passed by invisible reference. */
+ for (t = DECL_ARGUMENTS (fndecl); t; t = DECL_CHAIN (t))
+ if (TREE_ADDRESSABLE (TREE_TYPE (t)))
+ {
+
+ /* If a function's arguments are copied to create a thunk, then
+ DECL_BY_REFERENCE will be set -- but the type of the argument will be
+ a pointer type, so we will never get here. */
+ gcc_assert (!DECL_BY_REFERENCE (t));
+ gcc_assert (DECL_ARG_TYPE (t) != TREE_TYPE (t));
+ TREE_TYPE (t) = DECL_ARG_TYPE (t);
+ DECL_BY_REFERENCE (t) = 1;
+ TREE_ADDRESSABLE (t) = 0;
+ relayout_decl (t);
+ }
+
+ /* Dump all nested functions now. */
+ cgn = cgraph_node::get_create (fndecl);
+ for (cgn = first_nested_function (cgn);
+ cgn != NULL; cgn = next_nested_function (cgn))
+ gm2_genericize (cgn->decl);
+}
+
+/* gm2 gimplify expression, currently just change THROW in the same
+ way as C++ */
+
+static int
+gm2_langhook_gimplify_expr (tree *expr_p, gimple_seq *pre_p ATTRIBUTE_UNUSED,
+ gimple_seq *post_p ATTRIBUTE_UNUSED)
+{
+ enum tree_code code = TREE_CODE (*expr_p);
+
+ switch (code)
+ {
+ case THROW_EXPR:
+
+ /* FIXME communicate throw type to back end, probably by moving
+ THROW_EXPR into ../tree.def. */
+ *expr_p = TREE_OPERAND (*expr_p, 0);
+ return GS_OK;
+
+ case EXPR_STMT:
+ gimplify_expr_stmt (expr_p);
+ return GS_OK;
+
+ case TRY_BLOCK:
+ genericize_try_block (expr_p);
+ return GS_OK;
+
+ case HANDLER:
+ genericize_catch_block (expr_p);
+ return GS_OK;
+
+ default:
+ return GS_UNHANDLED;
+ }
+}
+
+/* FIXME: This is a hack to preserve trees that we create from the
+ garbage collector. */
+
+static GTY (()) tree gm2_gc_root;
+static tree personality_decl = NULL_TREE;
+
+static void
+gm2_preserve_from_gc (tree t)
+{
+ gm2_gc_root = tree_cons (NULL_TREE, t, gm2_gc_root);
+}
+
+/* Return a decl for the exception personality function. */
+
+static tree
+gm2_langhook_eh_personality (void)
+{
+ if (personality_decl == NULL_TREE)
+ {
+ personality_decl = build_personality_function ("gxx");
+ gm2_preserve_from_gc (personality_decl);
+ }
+ return personality_decl;
+}
+
+/* Functions called directly by the generic backend. */
+
+tree
+convert_loc (location_t location, tree type, tree expr)
+{
+ if (type == error_mark_node || expr == error_mark_node
+ || TREE_TYPE (expr) == error_mark_node)
+ return error_mark_node;
+
+ if (type == TREE_TYPE (expr))
+ return expr;
+
+ gcc_assert (TYPE_MAIN_VARIANT (type) != NULL);
+ if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
+ return fold_convert (type, expr);
+
+ expr = m2convert_GenericToType (location, type, expr);
+ switch (TREE_CODE (type))
+ {
+ case VOID_TYPE:
+ case BOOLEAN_TYPE:
+ return fold_convert (type, expr);
+ case INTEGER_TYPE:
+ return fold (convert_to_integer (type, expr));
+ case POINTER_TYPE:
+ return fold (convert_to_pointer (type, expr));
+ case REAL_TYPE:
+ return fold (convert_to_real (type, expr));
+ case COMPLEX_TYPE:
+ return fold (convert_to_complex (type, expr));
+ case ENUMERAL_TYPE:
+ return fold (convert_to_integer (type, expr));
+ default:
+ error_at (location, "cannot convert expression, only base types can be converted");
+ break;
+ }
+ return error_mark_node;
+}
+
+/* Functions called directly by the generic backend. */
+
+tree
+convert (tree type, tree expr)
+{
+ return convert_loc (m2linemap_UnknownLocation (), type, expr);
+}
+
+/* Mark EXP saying that we need to be able to take the address of it;
+ it should not be allocated in a register. Returns true if
+ successful. */
+
+bool
+gm2_mark_addressable (tree exp)
+{
+ tree x = exp;
+
+ while (TRUE)
+ switch (TREE_CODE (x))
+ {
+ case COMPONENT_REF:
+ if (DECL_PACKED (TREE_OPERAND (x, 1)))
+ return false;
+ x = TREE_OPERAND (x, 0);
+ break;
+
+ case ADDR_EXPR:
+ case ARRAY_REF:
+ case REALPART_EXPR:
+ case IMAGPART_EXPR:
+ x = TREE_OPERAND (x, 0);
+ break;
+
+ case COMPOUND_LITERAL_EXPR:
+ case CONSTRUCTOR:
+ case STRING_CST:
+ case VAR_DECL:
+ case CONST_DECL:
+ case PARM_DECL:
+ case RESULT_DECL:
+ case FUNCTION_DECL:
+ TREE_ADDRESSABLE (x) = 1;
+ return true;
+ default:
+ return true;
+ }
+ /* Never reach here. */
+ gcc_unreachable ();
+}
+
+/* Return an integer type with BITS bits of precision, that is
+ unsigned if UNSIGNEDP is nonzero, otherwise signed. */
+
+tree
+gm2_type_for_size (unsigned int bits, int unsignedp)
+{
+ tree type;
+
+ if (unsignedp)
+ {
+ if (bits == INT_TYPE_SIZE)
+ type = unsigned_type_node;
+ else if (bits == CHAR_TYPE_SIZE)
+ type = unsigned_char_type_node;
+ else if (bits == SHORT_TYPE_SIZE)
+ type = short_unsigned_type_node;
+ else if (bits == LONG_TYPE_SIZE)
+ type = long_unsigned_type_node;
+ else if (bits == LONG_LONG_TYPE_SIZE)
+ type = long_long_unsigned_type_node;
+ else
+ type = make_unsigned_type (bits);
+ }
+ else
+ {
+ if (bits == INT_TYPE_SIZE)
+ type = integer_type_node;
+ else if (bits == CHAR_TYPE_SIZE)
+ type = signed_char_type_node;
+ else if (bits == SHORT_TYPE_SIZE)
+ type = short_integer_type_node;
+ else if (bits == LONG_TYPE_SIZE)
+ type = long_integer_type_node;
+ else if (bits == LONG_LONG_TYPE_SIZE)
+ type = long_long_integer_type_node;
+ else
+ type = make_signed_type (bits);
+ }
+ return type;
+}
+
+/* Allow the analyzer to understand Storage ALLOCATE/DEALLOCATE. */
+
+bool
+gm2_langhook_new_dispose_storage_substitution (void)
+{
+ return true;
+}
+
+#undef LANG_HOOKS_NAME
+#undef LANG_HOOKS_INIT
+#undef LANG_HOOKS_INIT_OPTIONS
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#undef LANG_HOOKS_INIT_OPTIONS_STRUCT
+#undef LANG_HOOKS_HANDLE_OPTION
+#undef LANG_HOOKS_POST_OPTIONS
+#undef LANG_HOOKS_PARSE_FILE
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#undef LANG_HOOKS_BUILTIN_FUNCTION
+#undef LANG_HOOKS_GLOBAL_BINDINGS_P
+#undef LANG_HOOKS_PUSHDECL
+#undef LANG_HOOKS_GETDECLS
+#undef LANG_HOOKS_GIMPLIFY_EXPR
+#undef LANG_HOOKS_EH_PERSONALITY
+#undef LANG_HOOKS_NEW_DISPOSE_STORAGE_SUBSTITUTION
+
+#define LANG_HOOKS_NAME "GNU Modula-2"
+#define LANG_HOOKS_INIT gm2_langhook_init
+#define LANG_HOOKS_INIT_OPTIONS gm2_langhook_init_options
+#define LANG_HOOKS_OPTION_LANG_MASK gm2_langhook_option_lang_mask
+#define LANG_HOOKS_INIT_OPTIONS_STRUCT gm2_langhook_init_options_struct
+#define LANG_HOOKS_HANDLE_OPTION gm2_langhook_handle_option
+#define LANG_HOOKS_POST_OPTIONS gm2_langhook_post_options
+#define LANG_HOOKS_PARSE_FILE gm2_langhook_parse_file
+#define LANG_HOOKS_TYPE_FOR_MODE gm2_langhook_type_for_mode
+#define LANG_HOOKS_TYPE_FOR_SIZE gm2_langhook_type_for_size
+#define LANG_HOOKS_BUILTIN_FUNCTION gm2_langhook_builtin_function
+#define LANG_HOOKS_GLOBAL_BINDINGS_P gm2_langhook_global_bindings_p
+#define LANG_HOOKS_PUSHDECL gm2_langhook_pushdecl
+#define LANG_HOOKS_GETDECLS gm2_langhook_getdecls
+#define LANG_HOOKS_GIMPLIFY_EXPR gm2_langhook_gimplify_expr
+#define LANG_HOOKS_EH_PERSONALITY gm2_langhook_eh_personality
+#define LANG_HOOKS_NEW_DISPOSE_STORAGE_SUBSTITUTION \
+ gm2_langhook_new_dispose_storage_substitution
+
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+#include "gt-m2-gm2-lang.h"
+#include "gtype-m2.h"
@@ -0,0 +1,56 @@
+/* Language-dependent hooks for GNU Modula-2.
+ Copyright (C) 2003-2022 Free Software Foundation, Inc.
+ Contributed by Gaius Mulley <gaius@glam.ac.uk>
+
+This file is part of GNU CC.
+
+GNU CC 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.
+
+GNU CC 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 GNU CC; see the file COPYING. If not, write to
+the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+#if !defined(GM2_LANG_H)
+# define GM2_LANG_H
+
+#if defined(GM2_LANG_C)
+# define EXTERN
+#else
+# define EXTERN extern
+#endif
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+#include "coretypes.h"
+#include "opts.h"
+#include "tree.h"
+#include "gimple.h"
+
+
+EXTERN enum gimplify_status gm2_gimplify_expr (tree *, tree *, tree *);
+EXTERN bool gm2_mark_addressable (tree);
+EXTERN tree gm2_type_for_size (unsigned int bits, int unsignedp);
+EXTERN tree gm2_type_for_mode (enum machine_mode mode, int unsignedp);
+EXTERN bool gm2_langhook_init (void);
+EXTERN bool gm2_langhook_handle_option (size_t scode, const char *arg,
+ int value,
+ int kind ATTRIBUTE_UNUSED,
+ location_t loc ATTRIBUTE_UNUSED,
+ const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED);
+EXTERN void gm2_langhook_init_options (unsigned int decoded_options_count,
+ struct cl_decoded_option *decoded_options);
+EXTERN void gm2_genericize (tree fndecl);
+EXTERN tree convert_loc (location_t location, tree type, tree expr);
+
+
+#undef EXTERN
+#endif
@@ -0,0 +1,22 @@
+/* gm2version provides access to the gm2 front end version number.
+
+Copyright (C) 2008-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+extern void gm2_version (int need_to_exit);
@@ -0,0 +1,760 @@
+%{
+/* m2.flex implements lexical analysis for Modula-2.
+
+Copyright (C) 2004-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "gm2-gcc/gcc-consolidation.h"
+
+#include "GM2Reserved.h"
+#include "GM2LexBuf.h"
+#include "input.h"
+#include "m2options.h"
+
+
+#if defined(GM2USEGGC)
+# include "ggc.h"
+#endif
+
+#include "timevar.h"
+
+#define START_FILE(F,L) m2linemap_StartFile(F,L)
+#define END_FILE() m2linemap_EndFile()
+#define START_LINE(N,S) m2linemap_StartLine(N,S)
+#define GET_LOCATION(COLUMN_START,COLUMN_END) \
+ m2linemap_GetLocationRange(COLUMN_START,COLUMN_END)
+#define TIMEVAR_PUSH_LEX timevar_push (TV_LEX)
+#define TIMEVAR_POP_LEX timevar_pop (TV_LEX)
+
+#ifdef __cplusplus
+#define EXTERN extern "C"
+#endif
+
+ /* m2.flex provides a lexical analyser for GNU Modula-2. */
+
+ struct lineInfo {
+ char *linebuf; /* line contents */
+ int linelen; /* length */
+ int tokenpos; /* start position of token within line */
+ int toklen; /* a copy of yylen (length of token) */
+ int nextpos; /* position after token */
+ int lineno; /* line number of this line */
+ int column; /* first column number of token on this line */
+ int inuse; /* do we need to keep this line info? */
+ location_t location; /* the corresponding gcc location_t */
+ struct lineInfo *next;
+ };
+
+ struct functionInfo {
+ char *name; /* function name */
+ int module; /* is it really a module? */
+ struct functionInfo *next; /* list of nested functions */
+ };
+
+ static int lineno =1; /* a running count of the file line number */
+ static char *filename =NULL;
+ static int commentLevel=0;
+ static struct lineInfo *currentLine=NULL;
+ static struct functionInfo *currentFunction=NULL;
+ static int seenFunctionStart=FALSE;
+ static int seenEnd=FALSE;
+ static int seenModuleStart=FALSE;
+ static int isDefinitionModule=FALSE;
+ static int totalLines=0;
+
+static void pushLine (void);
+static void popLine (void);
+static void finishedLine (void);
+static void resetpos (void);
+static void consumeLine (void);
+static void updatepos (void);
+static void skippos (void);
+static void poperrorskip (const char *);
+static void endOfComment (void);
+static void handleDate (void);
+static void handleLine (void);
+static void handleFile (void);
+static void handleFunction (void);
+static void handleColumn (void);
+static void pushFunction (char *function, int module);
+static void popFunction (void);
+static void checkFunction (void);
+EXTERN void m2flex_M2Error (const char *);
+EXTERN location_t m2flex_GetLocation (void);
+EXTERN int m2flex_GetColumnNo (void);
+EXTERN int m2flex_OpenSource (char *s);
+EXTERN int m2flex_GetLineNo (void);
+EXTERN void m2flex_CloseSource (void);
+EXTERN char *m2flex_GetToken (void);
+EXTERN void _M2_m2flex_init (void);
+EXTERN int m2flex_GetTotalLines (void);
+extern void yylex (void);
+
+#if !defined(TRUE)
+# define TRUE (1==1)
+#endif
+#if !defined(FALSE)
+# define FALSE (1==0)
+#endif
+
+#define YY_DECL void yylex (void)
+%}
+
+%option nounput
+%x COMMENT COMMENT1 LINE0 LINE1 LINE2
+
+%%
+
+"(*" { updatepos();
+ commentLevel=1; pushLine(); skippos();
+ BEGIN COMMENT; }
+<COMMENT>"*)" { endOfComment(); }
+<COMMENT>"(*" { commentLevel++; pushLine(); updatepos(); skippos(); }
+<COMMENT>"<*" { if (commentLevel == 1) {
+ updatepos();
+ pushLine();
+ skippos();
+ BEGIN COMMENT1;
+ } else
+ updatepos(); skippos();
+ }
+<COMMENT>\n.* { consumeLine(); }
+<COMMENT>. { updatepos(); skippos(); }
+<COMMENT1>. { updatepos(); skippos(); }
+<COMMENT1>"*>" { updatepos(); skippos(); finishedLine(); BEGIN COMMENT; }
+<COMMENT1>\n.* { consumeLine(); }
+<COMMENT1>"*)" { poperrorskip("unterminated source code directive, missing *>");
+ endOfComment(); }
+<COMMENT1><<EOF>> { poperrorskip("unterminated source code directive, missing *>"); BEGIN COMMENT; }
+<COMMENT><<EOF>> { poperrorskip("unterminated comment found at the end of the file, missing *)"); BEGIN INITIAL; }
+
+^\#.* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
+\n\#.* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
+<LINE0>\#[ \t]* { updatepos(); }
+<LINE0>[0-9]+[ \t]*\" { updatepos(); lineno=atoi(yytext)-1; BEGIN LINE1; }
+<LINE0>\n { m2flex_M2Error("missing initial quote after #line directive"); resetpos(); BEGIN INITIAL; }
+<LINE0>[^\n]
+<LINE1>[^\"\n]+ { m2flex_M2Error("missing final quote after #line directive"); resetpos(); BEGIN INITIAL; }
+<LINE1>.*\" { updatepos();
+ filename = (char *)xrealloc(filename, yyleng+1);
+ strcpy(filename, yytext);
+ filename[yyleng-1] = (char)0; /* remove trailing quote */
+ START_FILE (filename, lineno);
+ BEGIN LINE2;
+ }
+<LINE2>[ \t]* { updatepos(); }
+<LINE2>\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>2[ \t]*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>1[ \t]*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>1[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>2[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>3[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+
+\n[^\#].* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+\n { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+
+\"[^\"\n]*\" { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; }
+\"[^\"\n]*$ { updatepos();
+ m2flex_M2Error("missing terminating quote, \"");
+ resetpos(); return;
+ }
+
+'[^'\n]*' { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; }
+'[^'\n]*$ { updatepos();
+ m2flex_M2Error("missing terminating quote, '");
+ resetpos(); return;
+ }
+
+<<EOF>> { updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return; }
+\+ { updatepos(); M2LexBuf_AddTok(M2Reserved_plustok); return; }
+- { updatepos(); M2LexBuf_AddTok(M2Reserved_minustok); return; }
+"*" { updatepos(); M2LexBuf_AddTok(M2Reserved_timestok); return; }
+\/ { updatepos(); M2LexBuf_AddTok(M2Reserved_dividetok); return; }
+:= { updatepos(); M2LexBuf_AddTok(M2Reserved_becomestok); return; }
+\& { updatepos(); M2LexBuf_AddTok(M2Reserved_ambersandtok); return; }
+\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodtok); return; }
+\, { updatepos(); M2LexBuf_AddTok(M2Reserved_commatok); return; }
+\; { updatepos(); M2LexBuf_AddTok(M2Reserved_semicolontok); return; }
+\( { updatepos(); M2LexBuf_AddTok(M2Reserved_lparatok); return; }
+\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rparatok); return; }
+\[ { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; }
+\] { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; }
+\(\! { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; }
+\!\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; }
+\^ { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; }
+\@ { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; }
+\{ { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; }
+\} { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; }
+\(\: { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; }
+\:\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; }
+\' { updatepos(); M2LexBuf_AddTok(M2Reserved_singlequotetok); return; }
+\= { updatepos(); M2LexBuf_AddTok(M2Reserved_equaltok); return; }
+\# { updatepos(); M2LexBuf_AddTok(M2Reserved_hashtok); return; }
+\< { updatepos(); M2LexBuf_AddTok(M2Reserved_lesstok); return; }
+\> { updatepos(); M2LexBuf_AddTok(M2Reserved_greatertok); return; }
+\<\> { updatepos(); M2LexBuf_AddTok(M2Reserved_lessgreatertok); return; }
+\<\= { updatepos(); M2LexBuf_AddTok(M2Reserved_lessequaltok); return; }
+\>\= { updatepos(); M2LexBuf_AddTok(M2Reserved_greaterequaltok); return; }
+"<*" { updatepos(); M2LexBuf_AddTok(M2Reserved_ldirectivetok); return; }
+"*>" { updatepos(); M2LexBuf_AddTok(M2Reserved_rdirectivetok); return; }
+\.\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodtok); return; }
+\.\.\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodperiodtok); return; }
+\: { updatepos(); M2LexBuf_AddTok(M2Reserved_colontok); return; }
+\" { updatepos(); M2LexBuf_AddTok(M2Reserved_doublequotestok); return; }
+\| { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; }
+\! { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; }
+\~ { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; }
+AND { updatepos(); M2LexBuf_AddTok(M2Reserved_andtok); return; }
+ARRAY { updatepos(); M2LexBuf_AddTok(M2Reserved_arraytok); return; }
+BEGIN { updatepos(); M2LexBuf_AddTok(M2Reserved_begintok); return; }
+BY { updatepos(); M2LexBuf_AddTok(M2Reserved_bytok); return; }
+CASE { updatepos(); M2LexBuf_AddTok(M2Reserved_casetok); return; }
+CONST { updatepos(); M2LexBuf_AddTok(M2Reserved_consttok); return; }
+DEFINITION { updatepos(); isDefinitionModule = TRUE;
+ M2LexBuf_AddTok(M2Reserved_definitiontok); return; }
+DIV { updatepos(); M2LexBuf_AddTok(M2Reserved_divtok); return; }
+DO { updatepos(); M2LexBuf_AddTok(M2Reserved_dotok); return; }
+ELSE { updatepos(); M2LexBuf_AddTok(M2Reserved_elsetok); return; }
+ELSIF { updatepos(); M2LexBuf_AddTok(M2Reserved_elsiftok); return; }
+END { updatepos(); seenEnd=TRUE;
+ M2LexBuf_AddTok(M2Reserved_endtok); return; }
+EXCEPT { updatepos(); M2LexBuf_AddTok(M2Reserved_excepttok); return; }
+EXIT { updatepos(); M2LexBuf_AddTok(M2Reserved_exittok); return; }
+EXPORT { updatepos(); M2LexBuf_AddTok(M2Reserved_exporttok); return; }
+FINALLY { updatepos(); M2LexBuf_AddTok(M2Reserved_finallytok); return; }
+FOR { updatepos(); M2LexBuf_AddTok(M2Reserved_fortok); return; }
+FROM { updatepos(); M2LexBuf_AddTok(M2Reserved_fromtok); return; }
+IF { updatepos(); M2LexBuf_AddTok(M2Reserved_iftok); return; }
+IMPLEMENTATION { updatepos(); M2LexBuf_AddTok(M2Reserved_implementationtok); return; }
+IMPORT { updatepos(); M2LexBuf_AddTok(M2Reserved_importtok); return; }
+IN { updatepos(); M2LexBuf_AddTok(M2Reserved_intok); return; }
+LOOP { updatepos(); M2LexBuf_AddTok(M2Reserved_looptok); return; }
+MOD { updatepos(); M2LexBuf_AddTok(M2Reserved_modtok); return; }
+MODULE { updatepos(); seenModuleStart=TRUE;
+ M2LexBuf_AddTok(M2Reserved_moduletok); return; }
+NOT { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; }
+OF { updatepos(); M2LexBuf_AddTok(M2Reserved_oftok); return; }
+OR { updatepos(); M2LexBuf_AddTok(M2Reserved_ortok); return; }
+PACKEDSET { updatepos(); M2LexBuf_AddTok(M2Reserved_packedsettok); return; }
+POINTER { updatepos(); M2LexBuf_AddTok(M2Reserved_pointertok); return; }
+PROCEDURE { updatepos(); seenFunctionStart=TRUE;
+ M2LexBuf_AddTok(M2Reserved_proceduretok); return; }
+QUALIFIED { updatepos(); M2LexBuf_AddTok(M2Reserved_qualifiedtok); return; }
+UNQUALIFIED { updatepos(); M2LexBuf_AddTok(M2Reserved_unqualifiedtok); return; }
+RECORD { updatepos(); M2LexBuf_AddTok(M2Reserved_recordtok); return; }
+REM { updatepos(); M2LexBuf_AddTok(M2Reserved_remtok); return; }
+REPEAT { updatepos(); M2LexBuf_AddTok(M2Reserved_repeattok); return; }
+RETRY { updatepos(); M2LexBuf_AddTok(M2Reserved_retrytok); return; }
+RETURN { updatepos(); M2LexBuf_AddTok(M2Reserved_returntok); return; }
+SET { updatepos(); M2LexBuf_AddTok(M2Reserved_settok); return; }
+THEN { updatepos(); M2LexBuf_AddTok(M2Reserved_thentok); return; }
+TO { updatepos(); M2LexBuf_AddTok(M2Reserved_totok); return; }
+TYPE { updatepos(); M2LexBuf_AddTok(M2Reserved_typetok); return; }
+UNTIL { updatepos(); M2LexBuf_AddTok(M2Reserved_untiltok); return; }
+VAR { updatepos(); M2LexBuf_AddTok(M2Reserved_vartok); return; }
+WHILE { updatepos(); M2LexBuf_AddTok(M2Reserved_whiletok); return; }
+WITH { updatepos(); M2LexBuf_AddTok(M2Reserved_withtok); return; }
+ASM { updatepos(); M2LexBuf_AddTok(M2Reserved_asmtok); return; }
+VOLATILE { updatepos(); M2LexBuf_AddTok(M2Reserved_volatiletok); return; }
+\_\_DATE\_\_ { updatepos(); handleDate(); return; }
+\_\_LINE\_\_ { updatepos(); handleLine(); return; }
+\_\_FILE\_\_ { updatepos(); handleFile(); return; }
+\_\_FUNCTION\_\_ { updatepos(); handleFunction(); return; }
+\_\_COLUMN\_\_ { updatepos(); handleColumn(); return; }
+\_\_ATTRIBUTE\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_attributetok); return; }
+\_\_BUILTIN\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_builtintok); return; }
+\_\_INLINE\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_inlinetok); return; }
+
+
+(([0-9]*\.[0-9]+)(E[+-]?[0-9]+)?) { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
+[0-9]*\.E[+-]?[0-9]+ { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
+[a-zA-Z_][a-zA-Z0-9_]* { checkFunction(); updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_identtok, yytext); return; }
+[0-9]+ { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9]+B { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9]+C { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9A-F]+H { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[\t\r ]+ { currentLine->tokenpos += yyleng; /* Ignore space. */; }
+. { updatepos(); m2flex_M2Error("unrecognised symbol"); skippos(); }
+
+%%
+
+/* have removed the -? from the beginning of the real/integer constant literal rules */
+
+/*
+ * hand built routines
+ */
+
+/*
+ * handleFile - handles the __FILE__ construct by wraping it in double quotes and putting
+ * it into the token buffer as a string.
+ */
+
+static void handleFile (void)
+{
+ char *s = (char *)alloca(strlen(filename)+2+1);
+
+ strcpy(s, "\"");
+ strcat(s, filename);
+ strcat(s, "\"");
+ M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+}
+
+/*
+ * handleLine - handles the __LINE__ construct by passing an integer to
+ * the token buffer.
+ */
+
+static void handleLine (void)
+{
+ M2LexBuf_AddTokInteger(M2Reserved_integertok, lineno);
+}
+
+/*
+ * handleColumn - handles the __COLUMN__ construct by passing an integer to
+ * the token buffer.
+ */
+
+static void handleColumn (void)
+{
+ M2LexBuf_AddTokInteger(M2Reserved_integertok, m2flex_GetColumnNo());
+}
+
+/*
+ * handleDate - handles the __DATE__ construct by passing the date
+ * as a string to the token buffer.
+ */
+
+static void handleDate (void)
+{
+ time_t clock = time ((time_t *)0);
+ char *sdate = ctime (&clock);
+ char *s = (char *) alloca (strlen (sdate) + 2 + 1);
+ char *p = index (sdate, '\n');
+
+ if (p != NULL) {
+ *p = (char) 0;
+ }
+ strcpy(s, "\"");
+ strcat(s, sdate);
+ strcat(s, "\"");
+ M2LexBuf_AddTokCharStar (M2Reserved_stringtok, s);
+}
+
+/*
+ * handleFunction - handles the __FUNCTION__ construct by wrapping
+ * it in double quotes and putting it into the token
+ * buffer as a string.
+ */
+
+static void handleFunction (void)
+{
+ if (currentFunction == NULL)
+ M2LexBuf_AddTokCharStar(M2Reserved_stringtok, const_cast<char *>("\"\""));
+ else if (currentFunction->module) {
+ char *s = (char *) alloca(strlen(yytext) +
+ strlen("\"module initialization\"") + 1);
+ strcpy(s, "\"module ");
+ strcat(s, currentFunction->name);
+ strcat(s, " initialization\"");
+ M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+ } else {
+ char *function = currentFunction->name;
+ char *s = (char *)alloca(strlen(function)+2+1);
+ strcpy(s, "\"");
+ strcat(s, function);
+ strcat(s, "\"");
+ M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+ }
+}
+
+/*
+ * pushFunction - pushes the function name onto the stack.
+ */
+
+static void pushFunction (char *function, int module)
+{
+ if (currentFunction == NULL) {
+ currentFunction = (struct functionInfo *)xmalloc (sizeof (struct functionInfo));
+ currentFunction->name = xstrdup(function);
+ currentFunction->next = NULL;
+ currentFunction->module = module;
+ } else {
+ struct functionInfo *f = (struct functionInfo *)xmalloc (sizeof (struct functionInfo));
+ f->name = xstrdup(function);
+ f->next = currentFunction;
+ f->module = module;
+ currentFunction = f;
+ }
+}
+
+/*
+ * popFunction - pops the current function.
+ */
+
+static void popFunction (void)
+{
+ if (currentFunction != NULL && currentFunction->next != NULL) {
+ struct functionInfo *f = currentFunction;
+
+ currentFunction = currentFunction->next;
+ if (f->name != NULL)
+ free(f->name);
+ free(f);
+ }
+}
+
+/*
+ * endOfComment - handles the end of comment
+ */
+
+static void endOfComment (void)
+{
+ commentLevel--;
+ updatepos();
+ skippos();
+ if (commentLevel==0) {
+ BEGIN INITIAL;
+ finishedLine();
+ } else
+ popLine();
+}
+
+/*
+ * m2flex_M2Error - displays the error message, s, after the code line and pointer
+ * to the erroneous token.
+ */
+
+EXTERN void m2flex_M2Error (const char *s)
+{
+ if (currentLine->linebuf != NULL) {
+ int i=1;
+
+ printf("%s:%d:%s\n", filename, currentLine->lineno, currentLine->linebuf);
+ printf("%s:%d:%*s", filename, currentLine->lineno, 1+currentLine->tokenpos, "^");
+ while (i<currentLine->toklen) {
+ putchar('^');
+ i++;
+ }
+ putchar('\n');
+ }
+ printf("%s:%d:%s\n", filename, currentLine->lineno, s);
+}
+
+static void poperrorskip (const char *s)
+{
+ int nextpos =currentLine->nextpos;
+ int tokenpos=currentLine->tokenpos;
+
+ popLine();
+ m2flex_M2Error(s);
+ if (currentLine != NULL) {
+ currentLine->nextpos = nextpos;
+ currentLine->tokenpos = tokenpos;
+ }
+}
+
+/*
+ * consumeLine - reads a line into a buffer, it then pushes back the whole
+ * line except the initial \n.
+ */
+
+static void consumeLine (void)
+{
+ if (currentLine->linelen<yyleng) {
+ currentLine->linebuf = (char *)xrealloc (currentLine->linebuf, yyleng);
+ currentLine->linelen = yyleng;
+ }
+ strcpy(currentLine->linebuf, yytext+1); /* copy all except the initial \n */
+ lineno++;
+ totalLines++;
+ currentLine->lineno = lineno;
+ currentLine->tokenpos=0;
+ currentLine->nextpos=0;
+ currentLine->column=0;
+ START_LINE (lineno, yyleng);
+ yyless(1); /* push back all but the \n */
+}
+
+static void assert_location (location_t location ATTRIBUTE_UNUSED)
+{
+#if 0
+ if ((location != BUILTINS_LOCATION) && (location != UNKNOWN_LOCATION) && (! M2Options_GetCpp ())) {
+ expanded_location xl = expand_location (location);
+ if (xl.line != currentLine->lineno) {
+ m2flex_M2Error ("mismatched gcc location and front end token number");
+ }
+ }
+#endif
+}
+
+/*
+ * updatepos - updates the current token position.
+ * Should be used when a rule matches a token.
+ */
+
+static void updatepos (void)
+{
+ seenFunctionStart = FALSE;
+ seenEnd = FALSE;
+ seenModuleStart = FALSE;
+ currentLine->nextpos = currentLine->tokenpos+yyleng;
+ currentLine->toklen = yyleng;
+ /* if (currentLine->column == 0) */
+ currentLine->column = currentLine->tokenpos+1;
+ currentLine->location =
+ M2Options_OverrideLocation (GET_LOCATION (currentLine->column,
+ currentLine->column+currentLine->toklen-1));
+ assert_location (GET_LOCATION (currentLine->column,
+ currentLine->column+currentLine->toklen-1));
+}
+
+/*
+ * checkFunction - checks to see whether we have seen the start
+ * or end of a function.
+ */
+
+static void checkFunction (void)
+{
+ if (! isDefinitionModule) {
+ if (seenModuleStart)
+ pushFunction(yytext, 1);
+ if (seenFunctionStart)
+ pushFunction(yytext, 0);
+ if (seenEnd && currentFunction != NULL &&
+ (strcmp(currentFunction->name, yytext) == 0))
+ popFunction();
+ }
+ seenFunctionStart = FALSE;
+ seenEnd = FALSE;
+ seenModuleStart = FALSE;
+}
+
+/*
+ * skippos - skips over this token. This function should be called
+ * if we are not returning and thus not calling getToken.
+ */
+
+static void skippos (void)
+{
+ currentLine->tokenpos = currentLine->nextpos;
+}
+
+/*
+ * initLine - initializes a currentLine
+ */
+
+static void initLine (void)
+{
+ currentLine = (struct lineInfo *)xmalloc (sizeof(struct lineInfo));
+
+ if (currentLine == NULL)
+ perror("xmalloc");
+ currentLine->linebuf = NULL;
+ currentLine->linelen = 0;
+ currentLine->tokenpos = 0;
+ currentLine->toklen = 0;
+ currentLine->nextpos = 0;
+ currentLine->lineno = lineno;
+ currentLine->column = 0;
+ currentLine->inuse = TRUE;
+ currentLine->next = NULL;
+}
+
+/*
+ * pushLine - pushes a new line structure.
+ */
+
+static void pushLine (void)
+{
+ if (currentLine == NULL)
+ initLine();
+ else if (currentLine->inuse) {
+ struct lineInfo *l = (struct lineInfo *)xmalloc (sizeof(struct lineInfo));
+
+ if (currentLine->linebuf == NULL) {
+ l->linebuf = NULL;
+ l->linelen = 0;
+ } else {
+ l->linebuf = (char *)xstrdup (currentLine->linebuf);
+ l->linelen = strlen (l->linebuf)+1;
+ }
+ l->tokenpos = currentLine->tokenpos;
+ l->toklen = currentLine->toklen;
+ l->nextpos = currentLine->nextpos;
+ l->lineno = currentLine->lineno;
+ l->column = currentLine->column;
+ l->next = currentLine;
+ currentLine = l;
+ }
+ currentLine->inuse = TRUE;
+}
+
+/*
+ * popLine - pops a line structure.
+ */
+
+static void popLine (void)
+{
+ if (currentLine != NULL) {
+ struct lineInfo *l = currentLine;
+
+ if (currentLine->linebuf != NULL)
+ free(currentLine->linebuf);
+ currentLine = l->next;
+ free(l);
+ }
+}
+
+/*
+ * resetpos - resets the position of the next token to the start of the line.
+ */
+
+static void resetpos (void)
+{
+ if (currentLine != NULL)
+ currentLine->nextpos = 0;
+}
+
+/*
+ * finishedLine - indicates that the current line does not need to be preserved when a pushLine
+ * occurs.
+ */
+
+static void finishedLine (void)
+{
+ currentLine->inuse = FALSE;
+}
+
+/*
+ * m2flex_GetToken - returns a new token.
+ */
+
+EXTERN char *m2flex_GetToken (void)
+{
+ TIMEVAR_PUSH_LEX;
+ if (currentLine == NULL)
+ initLine();
+ currentLine->tokenpos = currentLine->nextpos;
+ yylex();
+ TIMEVAR_POP_LEX;
+ return yytext;
+}
+
+/*
+ * CloseSource - provided for semantic sugar
+ */
+
+EXTERN void m2flex_CloseSource (void)
+{
+ END_FILE ();
+}
+
+/*
+ * OpenSource - returns TRUE if file s can be opened and
+ * all tokens are taken from this file.
+ */
+
+EXTERN int m2flex_OpenSource (char *s)
+{
+ FILE *f = fopen(s, "r");
+
+ if (f == NULL)
+ return( FALSE );
+ else {
+ isDefinitionModule = FALSE;
+ while (currentFunction != NULL)
+ {
+ struct functionInfo *f = currentFunction;
+ currentFunction = f->next;
+ if (f->name != NULL)
+ free(f->name);
+ free(f);
+ }
+ yy_delete_buffer (YY_CURRENT_BUFFER);
+ yy_switch_to_buffer (yy_create_buffer(f, YY_BUF_SIZE));
+ filename = xstrdup (s);
+ lineno = 1;
+ if (currentLine == NULL)
+ pushLine ();
+ else
+ currentLine->lineno = lineno;
+ START_FILE (filename, lineno);
+ BEGIN INITIAL; resetpos ();
+ return TRUE;
+ }
+}
+
+/*
+ * m2flex_GetLineNo - returns the current line number.
+ */
+
+EXTERN int m2flex_GetLineNo (void)
+{
+ if (currentLine != NULL)
+ return currentLine->lineno;
+ else
+ return 0;
+}
+
+/*
+ * m2flex_GetColumnNo - returns the column where the current
+ * token starts.
+ */
+
+EXTERN int m2flex_GetColumnNo (void)
+{
+ if (currentLine != NULL)
+ return currentLine->column;
+ else
+ return 0;
+}
+
+/*
+ * m2flex_GetLocation - returns the gcc location_t of the current token.
+ */
+
+EXTERN location_t m2flex_GetLocation (void)
+{
+ if (currentLine != NULL)
+ return currentLine->location;
+ else
+ return 0;
+}
+
+/*
+ * GetTotalLines - returns the total number of lines parsed.
+ */
+
+EXTERN int m2flex_GetTotalLines (void)
+{
+ return totalLines;
+}
+
+/*
+ * yywrap is called when end of file is seen. We push an eof token
+ * and tell the lexical analysis to stop.
+ */
+
+int yywrap (void)
+{
+ updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return 1;
+}
+
+EXTERN void _M2_m2flex_init (void) {}
+EXTERN void _M2_m2flex_finish (void) {}
@@ -0,0 +1,2643 @@
+/* m2pp.c pretty print trees, output in Modula-2 where possible.
+
+Copyright (C) 2007-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#if defined(GM2)
+#include "gm2-gcc/gcc-consolidation.h"
+
+#include "m2-tree.h"
+#include "gm2-lang.h"
+
+#include "gm2-gcc/m2tree.h"
+#include "gm2-gcc/m2expr.h"
+#include "gm2-gcc/m2type.h"
+#include "gm2-gcc/m2decl.h"
+#else
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "cp/cp-tree.h"
+#include "stringpool.h"
+#include "gm2-gcc/gcc-consolidation.h"
+#include "../cp/cp-tree.h"
+#endif
+
+#define M2PP_C
+#include "m2/m2pp.h"
+
+#undef DEBUGGING
+
+typedef struct pretty_t
+{
+ int needs_space;
+ int needs_indent;
+ int curpos;
+ int indent;
+ int issued_begin;
+ int in_vars;
+ int in_types;
+ tree block;
+ int bits;
+} pretty;
+
+typedef struct m2stack_t
+{
+ tree value;
+ struct m2stack_t *next;
+} stack;
+
+/* Prototypes. */
+
+static pretty *initPretty (int bits);
+static pretty *dupPretty (pretty *s);
+static int getindent (pretty *s);
+static void setindent (pretty *s, int n);
+static int getcurpos (pretty *s);
+static void m2pp_identifier (pretty *s, tree t);
+static void m2pp_needspace (pretty *s);
+static void m2pp_function (pretty *s, tree t);
+static void m2pp_function_header (pretty *s, tree t);
+static void m2pp_function_vars (pretty *s, tree t);
+static void m2pp_statement_sequence (pretty *s, tree t);
+static void m2pp_print (pretty *s, const char *p);
+static void m2pp_print_char (pretty *s, char ch);
+static void m2pp_parameter (pretty *s, tree t);
+static void m2pp_type (pretty *s, tree t);
+static void m2pp_ident_pointer (pretty *s, tree t);
+static void m2pp_set_type (pretty *s, tree t);
+static void m2pp_enum (pretty *s, tree t);
+static void m2pp_array (pretty *s, tree t);
+static void m2pp_subrange (pretty *s, tree t);
+static void m2pp_gimpified (pretty *s, tree t);
+static void m2pp_pointer_type (pretty *s, tree t);
+static void m2pp_record_type (pretty *s, tree t);
+static void m2pp_union_type (pretty *s, tree t);
+static void m2pp_simple_type (pretty *s, tree t);
+static void m2pp_expression (pretty *s, tree t);
+static void m2pp_relop (pretty *s, tree t, const char *p);
+static void m2pp_simple_expression (pretty *s, tree t);
+static void m2pp_statement_sequence (pretty *s, tree t);
+static void m2pp_unknown (pretty *s, const char *s1, const char *s2);
+static void m2pp_statement (pretty *s, tree t);
+static void m2pp_assignment (pretty *s, tree t);
+static void m2pp_designator (pretty *s, tree t);
+static void m2pp_conditional (pretty *s, tree t);
+static void m2pp_label_expr (pretty *s, tree t);
+static void m2pp_label_decl (pretty *s, tree t);
+static void m2pp_goto (pretty *s, tree t);
+static void m2pp_list (pretty *s, tree t);
+static void m2pp_offset (pretty *s, tree t);
+static void m2pp_indirect_ref (pretty *s, tree t);
+static void m2pp_integer_cst (pretty *s, tree t);
+static void m2pp_real_cst (pretty *s, tree t);
+static void m2pp_string_cst (pretty *s, tree t);
+static void m2pp_integer (pretty *s, tree t);
+static void m2pp_addr_expr (pretty *s, tree t);
+static void m2pp_nop (pretty *s, tree t);
+static void m2pp_convert (pretty *s, tree t);
+static void m2pp_var_decl (pretty *s, tree t);
+static void m2pp_binary (pretty *s, tree t, const char *p);
+static void m2pp_unary (pretty *s, tree t, const char *p);
+static void m2pp_call_expr (pretty *s, tree t);
+static void m2pp_procedure_call (pretty *s, tree t);
+static void m2pp_ssa (pretty *s, tree t);
+static void m2pp_block (pretty *s, tree t);
+static void m2pp_block_list (pretty *s, tree t);
+static void m2pp_var_list (pretty *s, tree t);
+static void m2pp_bind_expr (pretty *s, tree t);
+static void m2pp_return_expr (pretty *s, tree t);
+static void m2pp_result_decl (pretty *s, tree t);
+static void m2pp_try_block (pretty *s, tree t);
+static void m2pp_cleanup_point_expr (pretty *s, tree t);
+static void m2pp_handler (pretty *s, tree t);
+static void m2pp_component_ref (pretty *s, tree t);
+static void m2pp_array_ref (pretty *s, tree t);
+static void m2pp_begin (pretty *s);
+static void m2pp_var (pretty *s);
+static void m2pp_types (pretty *s);
+static void m2pp_decl_expr (pretty *s, tree t);
+static void m2pp_var_type_decl (pretty *s, tree t);
+static void m2pp_non_lvalue_expr (pretty *s, tree t);
+static void m2pp_procedure_type (pretty *s, tree t);
+static void m2pp_param_type (pretty *s, tree t);
+static void m2pp_type_lowlevel (pretty *s, tree t);
+static void m2pp_try_catch_expr (pretty *s, tree t);
+static void m2pp_throw (pretty *s, tree t);
+static void m2pp_catch_expr (pretty *s, tree t);
+static void m2pp_try_finally_expr (pretty *s, tree t);
+static void m2pp_complex (pretty *s, tree t);
+static void killPretty (pretty *s);
+static void m2pp_compound_expression (pretty *s, tree t);
+static void m2pp_target_expression (pretty *s, tree t);
+static void m2pp_constructor (pretty *s, tree t);
+static void m2pp_translation (pretty *s, tree t);
+static void m2pp_module_block (pretty *s, tree t);
+static void push (tree t);
+static void pop (void);
+static int begin_printed (tree t);
+static void m2pp_decl_list (pretty *s, tree t);
+static void m2pp_loc (pretty *s, tree t);
+
+void pet (tree t);
+void m2pp_integer (pretty *s, tree t);
+
+extern void stop (void);
+
+static stack *stackPtr = NULL;
+
+/* do_pf helper function for pf. */
+
+void
+do_pf (tree t, int bits)
+{
+ pretty *state = initPretty (bits);
+
+ if (TREE_CODE (t) == TRANSLATION_UNIT_DECL)
+ m2pp_translation (state, t);
+ else if (TREE_CODE (t) == BLOCK)
+ m2pp_module_block (state, t);
+ else if (TREE_CODE (t) == FUNCTION_DECL)
+ m2pp_function (state, t);
+ else
+ m2pp_statement_sequence (state, t);
+ killPretty (state);
+}
+
+/* pf print function. Expected to be printed interactively from
+ the debugger: print pf(func), or to be called from code. */
+
+void
+pf (tree t)
+{
+ do_pf (t, FALSE);
+}
+
+/* pe print expression. Expected to be printed interactively from
+ the debugger: print pe(expr), or to be called from code. */
+
+void
+pe (tree t)
+{
+ pretty *state = initPretty (FALSE);
+
+ m2pp_expression (state, t);
+ m2pp_needspace (state);
+ m2pp_print (state, ";\n");
+ killPretty (state);
+}
+
+/* pet print expression and its type. Expected to be printed
+ interactively from the debugger: print pet(expr), or to be called
+ from code. */
+
+void
+pet (tree t)
+{
+ pretty *state = initPretty (FALSE);
+
+ m2pp_expression (state, t);
+ m2pp_needspace (state);
+ m2pp_print (state, ":");
+ m2pp_type (state, TREE_TYPE (t));
+ m2pp_print (state, ";\n");
+ killPretty (state);
+}
+
+/* pt print type. Expected to be printed interactively from the
+ debugger: print pt(expr), or to be called from code. */
+
+void
+pt (tree t)
+{
+ pretty *state = initPretty (FALSE);
+ m2pp_type (state, t);
+ m2pp_needspace (state);
+ m2pp_print (state, ";\n");
+ killPretty (state);
+}
+
+/* ptl print type low level. Expected to be printed interactively
+ from the debugger: print ptl(type), or to be called from code. */
+
+void
+ptl (tree t)
+{
+ pretty *state = initPretty (FALSE);
+ m2pp_type_lowlevel (state, t);
+ m2pp_needspace (state);
+ m2pp_print (state, ";\n");
+ killPretty (state);
+}
+
+/* ptcl print TREE_CHAINed list. */
+
+void
+ptcl (tree t)
+{
+ pretty *state = initPretty (FALSE);
+
+ m2pp_decl_list (state, t);
+ m2pp_print (state, "\n");
+ killPretty (state);
+}
+
+/* loc if tree has a location then display it within a comment. */
+
+static void
+m2pp_loc (pretty *s, tree t)
+{
+ if (CAN_HAVE_LOCATION_P (t))
+ {
+ if (EXPR_HAS_LOCATION (t))
+ {
+ if (EXPR_LOCATION (t) == UNKNOWN_LOCATION)
+ m2pp_print (s, "(* missing location1 *)\n");
+ else
+ {
+ expanded_location l = expand_location (EXPR_LOCATION (t));
+
+ m2pp_print (s, "(* ");
+ m2pp_print (s, l.file);
+ m2pp_print (s, ":");
+ printf ("%d", l.line);
+ m2pp_print (s, " *)");
+ m2pp_print (s, "\n");
+ }
+ }
+ else
+ {
+ m2pp_print (s, "(* missing location2 *)\n");
+ }
+ }
+}
+
+/* m2pp_decl_list prints a TREE_CHAINed list for a decl node. */
+
+static void
+m2pp_decl_list (pretty *s, tree t)
+{
+ tree u = t;
+
+ m2pp_print (s, "(");
+ m2pp_needspace (s);
+ while (t != NULL_TREE)
+ {
+ m2pp_identifier (s, t);
+ t = TREE_CHAIN (t);
+ if (t == u || t == NULL_TREE)
+ break;
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ }
+ m2pp_needspace (s);
+ m2pp_print (s, ")");
+}
+
+static void
+m2pp_decl_bool (pretty *s, tree t)
+{
+ if (TREE_STATIC (t))
+ m2pp_print (s, "static, ");
+ if (DECL_EXTERNAL (t))
+ m2pp_print (s, "external, ");
+ if (DECL_SEEN_IN_BIND_EXPR_P (t))
+ m2pp_print (s, "in bind expr, ");
+}
+
+void
+pv (tree t)
+{
+ if (t)
+ {
+ enum tree_code code = TREE_CODE (t);
+
+ if (code == PARM_DECL)
+ {
+ pretty *state = initPretty (FALSE);
+ m2pp_identifier (state, t);
+ m2pp_needspace (state);
+ m2pp_print (state, "<parm_decl context = ");
+ m2pp_identifier (state, DECL_CONTEXT (t));
+ if (DECL_ABSTRACT_ORIGIN (t) == t)
+ m2pp_print (state, ">\n");
+ else
+ {
+ m2pp_print (state, ", abstract origin = ");
+ m2pp_identifier (state, DECL_ABSTRACT_ORIGIN (t));
+ m2pp_print (state, ">\n");
+ pv (DECL_ABSTRACT_ORIGIN (t));
+ }
+ killPretty (state);
+ }
+ if (code == VAR_DECL)
+ {
+ pretty *state = initPretty (FALSE);
+ m2pp_identifier (state, t);
+ m2pp_needspace (state);
+ m2pp_print (state, "(* <var_decl context = ");
+ m2pp_identifier (state, DECL_CONTEXT (t));
+ m2pp_decl_bool (state, t);
+ if (DECL_ABSTRACT_ORIGIN (t) == t)
+ m2pp_print (state, "> *)\n");
+ else
+ {
+ m2pp_print (state, ", abstract origin = ");
+ m2pp_identifier (state, DECL_ABSTRACT_ORIGIN (t));
+ m2pp_print (state, "> *)\n");
+ pv (DECL_ABSTRACT_ORIGIN (t));
+ }
+ killPretty (state);
+ }
+ }
+}
+
+#if defined(GM2_MAINTAINER)
+
+/* remember an internal debugging hook. */
+static tree rememberF = NULL;
+
+static void
+remember (tree t)
+{
+ rememberF = t;
+ printf ("type: watch *((tree *) %p) != %p\n", (void *)&DECL_SAVED_TREE (t),
+ (void *)DECL_SAVED_TREE (t));
+}
+#endif
+
+/* push pushes tree t onto stack. */
+
+static void
+push (tree t)
+{
+ stack *s = (stack *)xmalloc (sizeof (stack));
+
+ s->value = t;
+ s->next = stackPtr;
+ stackPtr = s;
+}
+
+/* pop pops a tree, from the stack. */
+
+static void
+pop (void)
+{
+ stack *s = stackPtr;
+
+ stackPtr = stackPtr->next;
+ free (s);
+}
+
+/* being_printed returns TRUE if t is held on the stack. */
+
+static int
+begin_printed (tree t)
+{
+ stack *s = stackPtr;
+
+ while (s != NULL)
+ {
+ if (s->value == t)
+ return TRUE;
+ else
+ s = s->next;
+ }
+ return FALSE;
+}
+
+/* dupPretty duplicate and return a copy of state s. */
+
+static pretty *
+dupPretty (pretty *s)
+{
+ pretty *p = initPretty (s->bits);
+ *p = *s;
+ return p;
+}
+
+/* initPretty initialise the state of the pretty printer. */
+
+static pretty *
+initPretty (int bits)
+{
+ pretty *state = (pretty *)xmalloc (sizeof (pretty));
+ state->needs_space = FALSE;
+ state->needs_indent = FALSE;
+ state->curpos = 0;
+ state->indent = 0;
+ state->issued_begin = FALSE;
+ state->in_vars = FALSE;
+ state->in_types = FALSE;
+ state->block = NULL_TREE;
+ state->bits = bits;
+ return state;
+}
+
+/* killPretty cleans up the state. */
+
+static void
+killPretty (pretty *s)
+{
+ free (s);
+ fflush (stdout);
+}
+
+/* getindent returns the current indent value. */
+
+static int
+getindent (pretty *s)
+{
+ return s->indent;
+}
+
+/* setindent sets the current indent to, n. */
+
+static void
+setindent (pretty *s, int n)
+{
+ s->indent = n;
+}
+
+/* getcurpos returns the current cursor position. */
+
+static int
+getcurpos (pretty *s)
+{
+ if (s->needs_space)
+ return s->curpos + 1;
+ else
+ return s->curpos;
+}
+
+/* m2pp_type_lowlevel prints out the low level details of a
+ fundamental type. */
+
+static void
+m2pp_type_lowlevel (pretty *s, tree t)
+{
+ if (TREE_CODE (t) == INTEGER_TYPE)
+ {
+ m2pp_print (s, "min");
+ m2pp_needspace (s);
+ m2pp_integer_cst (s, TYPE_MIN_VALUE (t));
+ m2pp_print (s, ", max");
+ m2pp_needspace (s);
+ m2pp_integer_cst (s, TYPE_MAX_VALUE (t));
+ m2pp_print (s, ", type size unit");
+ m2pp_needspace (s);
+ m2pp_integer_cst (s, TYPE_SIZE_UNIT (t));
+ m2pp_print (s, ", type size");
+ m2pp_needspace (s);
+ m2pp_integer_cst (s, TYPE_SIZE (t));
+
+ printf (", precision %d, mode %d, align %d, user align %d",
+ TYPE_PRECISION (t), TYPE_MODE (t), TYPE_ALIGN (t),
+ TYPE_USER_ALIGN (t));
+
+ m2pp_needspace (s);
+ if (TYPE_UNSIGNED (t))
+ m2pp_print (s, "unsigned\n");
+ else
+ m2pp_print (s, "signed\n");
+ }
+}
+
+/* m2pp_var emit a VAR if necessary. */
+
+static void
+m2pp_var (pretty *s)
+{
+ if (!s->in_vars)
+ {
+ s->in_vars = TRUE;
+ m2pp_print (s, "VAR\n");
+ setindent (s, getindent (s) + 3);
+ }
+}
+
+/* m2pp_types emit a TYPE if necessary. */
+
+static void
+m2pp_types (pretty *s)
+{
+ if (!s->in_types)
+ {
+ s->in_types = TRUE;
+ m2pp_print (s, "TYPE\n");
+ setindent (s, getindent (s) + 3);
+ }
+}
+
+/* hextree displays the critical fields for function, block and
+ bind_expr trees in raw hex. */
+
+static void
+hextree (tree t)
+{
+ if (t == NULL_TREE)
+ return;
+
+ if (TREE_CODE (t) == BLOCK)
+ {
+ printf ("(* BLOCK %p *)\n", (void *)t);
+ printf ("BLOCK_VARS (t) = %p\n", (void *)BLOCK_VARS (t));
+ printf ("BLOCK_SUPERCONTEXT (t) = %p\n",
+ (void *)BLOCK_SUPERCONTEXT (t));
+ }
+ if (TREE_CODE (t) == BIND_EXPR)
+ {
+ printf ("(* BIND_EXPR %p *)\n", (void *)t);
+ printf ("BIND_EXPR_VARS (t) = %p\n", (void *)BIND_EXPR_VARS (t));
+ printf ("BIND_EXPR_BLOCK (t) = %p\n", (void *)BIND_EXPR_BLOCK (t));
+ printf ("BIND_EXPR_BODY (t) = %p\n", (void *)BIND_EXPR_BODY (t));
+ }
+ if (TREE_CODE (t) == FUNCTION_DECL)
+ {
+ printf ("(* FUNCTION_DECL %p *)\n", (void *)t);
+ printf ("DECL_INITIAL (t) = %p\n", (void *)DECL_INITIAL (t));
+ printf ("DECL_SAVED_TREE (t) = %p\n", (void *)DECL_SAVED_TREE (t));
+ hextree (DECL_INITIAL (t));
+ hextree (DECL_SAVED_TREE (t));
+ }
+ if (TREE_CODE (t) == VAR_DECL)
+ {
+ pretty *state = initPretty (FALSE);
+
+ printf ("(* VAR_DECL %p <", (void *)t);
+ if (DECL_SEEN_IN_BIND_EXPR_P (t))
+ printf ("b");
+ if (DECL_EXTERNAL (t))
+ printf ("e");
+ if (TREE_STATIC (t))
+ printf ("s");
+ printf ("> context = %p*)\n", (void *)decl_function_context (t));
+ m2pp_type (state, TREE_TYPE (t));
+ m2pp_needspace (state);
+ m2pp_print (state, ";\n");
+ killPretty (state);
+ }
+ if (TREE_CODE (t) == PARM_DECL)
+ {
+ pretty *state = initPretty (FALSE);
+
+ printf ("(* PARM_DECL %p <", (void *)t);
+ printf ("> context = %p*)\n", (void *)decl_function_context (t));
+ m2pp_type (state, TREE_TYPE (t));
+ m2pp_needspace (state);
+ m2pp_print (state, ";\n");
+ killPretty (state);
+ }
+}
+
+/* translation produce a pseudo implementation module from the tree t. */
+
+static void
+m2pp_translation (pretty *s, tree t)
+{
+ tree block = DECL_INITIAL (t);
+
+ m2pp_print (s, "IMPLEMENTATION MODULE ");
+ m2pp_identifier (s, t);
+ m2pp_print (s, "\n\n");
+
+ if (block != NULL)
+ {
+ m2pp_module_block (s, block);
+ m2pp_print (s, "\n");
+ }
+
+ m2pp_print (s, "\n");
+ m2pp_print (s, "END ");
+ m2pp_identifier (s, t);
+ m2pp_print (s, ".\n");
+}
+
+static void
+m2pp_module_block (pretty *s, tree t)
+{
+ t = BLOCK_VARS (t);
+
+ if (t != NULL_TREE)
+ for (; t != NULL_TREE; t = TREE_CHAIN (t))
+ {
+ switch (TREE_CODE (t))
+ {
+ case FUNCTION_DECL:
+ if (!DECL_EXTERNAL (t))
+ {
+ pretty *p = dupPretty (s);
+ printf ("\n");
+ p->in_vars = FALSE;
+ p->in_types = FALSE;
+ m2pp_function (p, t);
+ killPretty (p);
+ printf ("\n");
+ s->in_vars = FALSE;
+ s->in_types = FALSE;
+ }
+ break;
+
+ case TYPE_DECL:
+ {
+ int o = getindent (s);
+ int p;
+
+ m2pp_print (s, "\n");
+ m2pp_types (s);
+ setindent (s, o + 3);
+ m2pp_identifier (s, t);
+ m2pp_print (s, " = ");
+ p = getcurpos (s);
+ setindent (s, p);
+ m2pp_type (s, TREE_TYPE (t));
+ setindent (s, o);
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+ s->in_vars = FALSE;
+ }
+ break;
+
+ case VAR_DECL:
+ m2pp_var (s);
+ m2pp_identifier (s, t);
+ m2pp_needspace (s);
+ m2pp_print (s, ":");
+ m2pp_needspace (s);
+ m2pp_type (s, TREE_TYPE (t));
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+ s->in_types = FALSE;
+ break;
+
+ case DECL_EXPR:
+ printf ("is this node legal here? \n");
+ m2pp_decl_expr (s, t);
+ break;
+
+ default:
+ m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
+ }
+ }
+}
+
+/* m2pp_begin emit a BEGIN if necessary. */
+
+static void
+m2pp_begin (pretty *s)
+{
+ if (!s->issued_begin)
+ {
+ if (s->in_vars || s->in_types)
+ {
+ setindent (s, getindent (s) - 3);
+ m2pp_print (s, "BEGIN\n");
+ setindent (s, getindent (s) + 3);
+ }
+ else
+ {
+ m2pp_print (s, "BEGIN\n");
+ setindent (s, getindent (s) + 3);
+ }
+ s->issued_begin = TRUE;
+ s->in_vars = FALSE;
+ s->in_types = FALSE;
+ }
+}
+
+/* m2pp_function walk over the function. */
+
+static void
+m2pp_function (pretty *s, tree t)
+{
+ m2pp_function_header (s, t);
+ m2pp_function_vars (s, t);
+ m2pp_statement_sequence (s, DECL_SAVED_TREE (t));
+ if (TREE_CODE (t) == FUNCTION_DECL)
+ {
+ m2pp_begin (s);
+ setindent (s, getindent (s) - 3);
+ m2pp_print (s, "END");
+ m2pp_needspace (s);
+ m2pp_identifier (s, t);
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+ }
+}
+
+/* m2pp_bind_expr displays the bind expr tree node. */
+
+static void
+m2pp_bind_expr (pretty *s, tree t)
+{
+ if (TREE_CODE (t) == BIND_EXPR)
+ {
+ if (BIND_EXPR_VARS (t))
+ {
+ m2pp_print (s, "(* variables in bind_expr *)\n");
+ m2pp_var (s);
+ m2pp_var_list (s, BIND_EXPR_VARS (t));
+ }
+ if (BIND_EXPR_BLOCK (t))
+ {
+ m2pp_print (s, "(* bind_expr_block *)\n");
+ m2pp_statement_sequence (s, BIND_EXPR_BLOCK (t));
+ m2pp_needspace (s);
+ m2pp_print (s, "; \n");
+ }
+ m2pp_statement_sequence (s, BIND_EXPR_BODY (t));
+ }
+}
+
+/* m2pp_block_list iterates over the list of blocks. */
+
+static void
+m2pp_block_list (pretty *s, tree t)
+{
+ for (; t; t = BLOCK_CHAIN (t))
+ m2pp_block (s, t);
+}
+
+/* m2pp_block prints the VARiables and the TYPEs inside a block. */
+
+static void
+m2pp_block (pretty *s, tree t)
+{
+ if ((BLOCK_VARS (t) != NULL_TREE) && (s->block != BLOCK_VARS (t)))
+ {
+ s->block = BLOCK_VARS (t);
+ m2pp_print (s, "(* block variables *)\n");
+ m2pp_var (s);
+ m2pp_var_list (s, BLOCK_VARS (t));
+ }
+}
+
+/* m2pp_var_type_decl displays the variable and type declaration. */
+
+static void
+m2pp_var_type_decl (pretty *s, tree t)
+{
+ m2pp_identifier (s, t);
+ m2pp_needspace (s);
+ m2pp_print (s, ":");
+ m2pp_needspace (s);
+ m2pp_type (s, TREE_TYPE (t));
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+}
+
+/* m2pp_var_list print a variable list. */
+
+static void
+m2pp_var_list (pretty *s, tree t)
+{
+ if (t != NULL_TREE)
+ for (; t; t = TREE_CHAIN (t))
+ {
+ if (TREE_CODE (t) == FUNCTION_DECL)
+ {
+ pretty *p = dupPretty (s);
+ printf ("\n");
+ p->in_vars = FALSE;
+ p->in_types = FALSE;
+ m2pp_function (p, t);
+ killPretty (p);
+ printf ("\n");
+ }
+ else if (TREE_CODE (t) == TYPE_DECL)
+ m2pp_identifier (s, t);
+ else if (TREE_CODE (t) == DECL_EXPR)
+ {
+ printf ("is this node legal here? \n");
+ // is it legal to have a DECL_EXPR here ?
+ m2pp_var_type_decl (s, DECL_EXPR_DECL (t));
+ }
+ else
+ m2pp_var_type_decl (s, t);
+ }
+}
+
+#if 0
+/* m2pp_type_list print a variable list. */
+
+static void
+m2pp_type_list (pretty *s, tree t)
+{
+ if (t != NULL_TREE)
+ for (; t; t = TREE_CHAIN (t))
+ {
+ m2pp_identifier (s, t);
+ m2pp_needspace (s);
+ m2pp_print (s, "=");
+ m2pp_needspace (s);
+ m2pp_type (s, TREE_TYPE (t));
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+ }
+}
+#endif
+
+/* m2pp_needspace sets appropriate flag to TRUE. */
+
+static void
+m2pp_needspace (pretty *s)
+{
+ s->needs_space = TRUE;
+}
+
+/* m2pp_identifer prints an identifier. */
+
+static void
+m2pp_identifier (pretty *s, tree t)
+{
+ if (t)
+ {
+ if (TREE_CODE (t) == COMPONENT_REF)
+ m2pp_component_ref (s, t);
+ else if (DECL_NAME (t) && IDENTIFIER_POINTER (DECL_NAME (t)))
+ m2pp_ident_pointer (s, DECL_NAME (t));
+ else
+ {
+ char name[100];
+
+ if (TREE_CODE (t) == CONST_DECL)
+ snprintf (name, 100, "C_%u", DECL_UID (t));
+ else
+ snprintf (name, 100, "D_%u", DECL_UID (t));
+ m2pp_print (s, name);
+ }
+ }
+}
+
+/* m2pp_ident_pointer displays an ident pointer. */
+
+static void
+m2pp_ident_pointer (pretty *s, tree t)
+{
+ if (t)
+ m2pp_print (s, IDENTIFIER_POINTER (t));
+}
+
+/* m2pp_parameter prints out a param decl tree. */
+
+static void
+m2pp_parameter (pretty *s, tree t)
+{
+ if (TREE_CODE (t) == PARM_DECL)
+ {
+ if (TREE_TYPE (t) && (TREE_CODE (TREE_TYPE (t)) == REFERENCE_TYPE))
+ {
+ m2pp_print (s, "VAR");
+ m2pp_needspace (s);
+ m2pp_identifier (s, t);
+ m2pp_print (s, ":");
+ m2pp_needspace (s);
+ m2pp_simple_type (s, TREE_TYPE (TREE_TYPE (t)));
+ }
+ else
+ {
+ m2pp_identifier (s, t);
+ m2pp_print (s, ":");
+ m2pp_needspace (s);
+ m2pp_simple_type (s, TREE_TYPE (t));
+ }
+ }
+}
+
+/* m2pp_param_type prints out the type of parameter. */
+
+static void
+m2pp_param_type (pretty *s, tree t)
+{
+ if (t && (TREE_CODE (t) == REFERENCE_TYPE))
+ {
+ m2pp_print (s, "VAR");
+ m2pp_needspace (s);
+ m2pp_simple_type (s, TREE_TYPE (t));
+ }
+ else
+ m2pp_simple_type (s, t);
+}
+
+/* m2pp_procedure_type displays a procedure type. */
+
+static void
+m2pp_procedure_type (pretty *s, tree t)
+{
+ push (t);
+ if (TREE_CODE (t) == FUNCTION_TYPE)
+ {
+ tree i = TYPE_ARG_TYPES (t);
+ tree returnType = TREE_TYPE (TREE_TYPE (t));
+
+ m2pp_needspace (s);
+ m2pp_print (s, "PROCEDURE");
+ m2pp_needspace (s);
+ if (i != NULL_TREE)
+ {
+ int o = getindent (s);
+ int p;
+ int first = TRUE;
+
+ m2pp_print (s, "(");
+ p = getcurpos (s);
+ setindent (s, p);
+ while (i != NULL_TREE)
+ {
+ if (TREE_CHAIN (i) == NULL_TREE)
+ {
+ if (TREE_VALUE (i) == void_type_node)
+ /* Ignore void_type_node at the end. */
+ ;
+ else
+ {
+ m2pp_param_type (s, TREE_VALUE (i));
+ m2pp_print (s, ", ...");
+ }
+ break;
+ }
+ else
+ {
+ if (!first)
+ {
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ }
+ m2pp_param_type (s, TREE_VALUE (i));
+ }
+ i = TREE_CHAIN (i);
+ first = FALSE;
+ }
+ m2pp_print (s, ")");
+ setindent (s, o);
+ }
+ else if (returnType != NULL_TREE)
+ {
+ m2pp_needspace (s);
+ m2pp_print (s, "()");
+ }
+ if (returnType != NULL_TREE)
+ {
+ m2pp_needspace (s);
+ m2pp_print (s, ": ");
+ m2pp_simple_type (s, returnType);
+ }
+ }
+ pop ();
+}
+
+/* m2pp_comment_header displays a simple header with some critical
+ tree info. */
+
+static void
+m2pp_comment_header (pretty *s, tree t)
+{
+ int o = getindent (s);
+
+ m2pp_print (s, "(*\n");
+ setindent (s, o + 3);
+ m2pp_identifier (s, t);
+ m2pp_needspace (s);
+ m2pp_print (s, "-");
+ m2pp_needspace (s);
+ if (TREE_PUBLIC (t))
+ {
+ m2pp_needspace (s);
+ m2pp_print (s, "public,");
+ }
+ if (TREE_STATIC (t))
+ {
+ m2pp_needspace (s);
+ m2pp_print (s, "static,");
+ }
+ if (DECL_EXTERNAL (t))
+ {
+ m2pp_needspace (s);
+ m2pp_print (s, "extern");
+ }
+ m2pp_print (s, "\n");
+ setindent (s, o);
+ m2pp_print (s, "*)\n\n");
+}
+
+/* m2pp_function_header displays the function header. */
+
+static void
+m2pp_function_header (pretty *s, tree t)
+{
+ push (t);
+ if (TREE_CODE (t) == FUNCTION_DECL)
+ {
+ tree i = DECL_ARGUMENTS (t);
+ tree returnType = TREE_TYPE (TREE_TYPE (t));
+
+ m2pp_comment_header (s, t);
+ m2pp_print (s, "PROCEDURE ");
+ m2pp_identifier (s, t);
+ m2pp_needspace (s);
+ if (i != NULL_TREE)
+ {
+ int o = getindent (s);
+ int p;
+
+ m2pp_print (s, "(");
+ p = getcurpos (s);
+ setindent (s, p);
+ while (i != NULL_TREE)
+ {
+ m2pp_parameter (s, i);
+ i = TREE_CHAIN (i);
+ if (i != NULL_TREE)
+ m2pp_print (s, ";\n");
+ }
+ m2pp_print (s, ")");
+ m2pp_needspace (s);
+ setindent (s, o);
+ }
+ else if (returnType != void_type_node)
+ {
+ m2pp_print (s, "()");
+ m2pp_needspace (s);
+ }
+ if (returnType != void_type_node)
+ {
+ m2pp_print (s, ": ");
+ m2pp_simple_type (s, returnType);
+ m2pp_needspace (s);
+ }
+ m2pp_print (s, "; ");
+ m2pp_loc (s, t);
+ m2pp_print (s, "\n");
+ }
+ pop ();
+}
+
+/* m2pp_add_var adds a variable into a list as defined by, data. */
+
+static tree
+m2pp_add_var (tree *tp, int *walk_subtrees, void *data)
+{
+ tree t = *tp;
+ pretty *s = (pretty *)data;
+ enum tree_code code = TREE_CODE (t);
+
+ if (code == VAR_DECL)
+ {
+ m2pp_var (s);
+ m2pp_identifier (s, t);
+ m2pp_needspace (s);
+ m2pp_print (s, ":");
+ m2pp_needspace (s);
+ m2pp_type (s, TREE_TYPE (t));
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+ }
+ if (code == SSA_NAME)
+ {
+ m2pp_var (s);
+ m2pp_ssa (s, t);
+ m2pp_identifier (s, SSA_NAME_VAR (t));
+ m2pp_needspace (s);
+ m2pp_print (s, ":");
+ m2pp_needspace (s);
+ m2pp_type (s, TREE_TYPE (t));
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+ }
+
+ *walk_subtrees = 1;
+ return NULL_TREE;
+}
+
+/* m2pp_function_vars displays variables as defined by the function
+ tree. */
+
+static void
+m2pp_function_vars (pretty *s, tree t)
+{
+ walk_tree_without_duplicates (&t, m2pp_add_var, s);
+
+ if (TREE_CODE (t) == FUNCTION_DECL && DECL_INITIAL (t))
+ {
+ m2pp_print (s, "(* variables in function_decl (decl_initial) *)\n");
+ m2pp_var (s);
+ m2pp_statement_sequence (s, DECL_INITIAL (t));
+ }
+}
+
+/* m2pp_print print out a string p interpreting '\n' and
+ adjusting the fields within state s. */
+
+static void
+m2pp_print (pretty *s, const char *p)
+{
+ if (p)
+ {
+ int l = strlen (p);
+ int i = 0;
+
+ if (s->needs_space)
+ {
+ printf (" ");
+ s->needs_space = FALSE;
+ s->curpos++;
+ }
+
+ while (i < l)
+ {
+ if (p[i] == '\n')
+ {
+ s->needs_indent = TRUE;
+ s->curpos = 0;
+ printf ("\n");
+ }
+ else
+ {
+ if (s->needs_indent)
+ {
+ if (s->indent > 0)
+ printf ("%*c", s->indent, ' ');
+ s->needs_indent = FALSE;
+ s->curpos += s->indent;
+ }
+ s->curpos++;
+ putchar (p[i]);
+ }
+ i++;
+ }
+ }
+}
+
+/* m2pp_print_char prints out a character ch obeying needs_space
+ and needs_indent. */
+
+static void
+m2pp_print_char (pretty *s, char ch)
+{
+ if (s->needs_space)
+ {
+ printf (" ");
+ s->needs_space = FALSE;
+ s->curpos++;
+ }
+ if (s->needs_indent)
+ {
+ if (s->indent > 0)
+ printf ("%*c", s->indent, ' ');
+ s->needs_indent = FALSE;
+ s->curpos += s->indent;
+ }
+ if (ch == '\n')
+ {
+ s->curpos++;
+ putchar ('\\');
+ putchar ('n');
+ }
+ else
+ putchar (ch);
+ s->curpos++;
+}
+
+/* m2pp_integer display the appropriate integer type. */
+
+#if defined(GM2)
+void
+m2pp_integer (pretty *s, tree t)
+{
+ if (t == m2type_GetM2ZType ())
+ m2pp_print (s, "M2ZTYPE");
+ else if (t == m2type_GetM2LongIntType ())
+ m2pp_print (s, "LONGINT");
+ else if (t == m2type_GetM2IntegerType ())
+ m2pp_print (s, "INTEGER");
+ else if (t == m2type_GetM2ShortIntType ())
+ m2pp_print (s, "SHORTINT");
+ else if (t == m2type_GetLongIntType ())
+ m2pp_print (s, "long int");
+ else if (t == m2type_GetIntegerType ())
+ m2pp_print (s, "int");
+ else if (t == m2type_GetShortIntType ())
+ m2pp_print (s, "short");
+ else if (t == m2type_GetM2LongCardType ())
+ m2pp_print (s, "LONGCARD");
+ else if (t == m2type_GetM2CardinalType ())
+ m2pp_print (s, "CARDINAL");
+ else if (t == m2type_GetM2ShortCardType ())
+ m2pp_print (s, "SHORTCARD");
+ else if (t == m2type_GetCardinalType ())
+ m2pp_print (s, "CARDINAL");
+ else if (t == m2type_GetPointerType ())
+ m2pp_print (s, "ADDRESS");
+ else if (t == m2type_GetByteType ())
+ m2pp_print (s, "BYTE");
+ else if (t == m2type_GetCharType ())
+ m2pp_print (s, "CHAR");
+ else if (t == m2type_GetBitsetType ())
+ m2pp_print (s, "BITSET");
+ else if (t == m2type_GetBitnumType ())
+ m2pp_print (s, "BITNUM");
+ else
+ {
+ if (TYPE_UNSIGNED (t))
+ m2pp_print (s, "CARDINAL");
+ else
+ m2pp_print (s, "INTEGER");
+ m2pp_integer_cst (s, TYPE_SIZE (t));
+ }
+}
+#else
+void
+m2pp_integer (pretty *s, tree t ATTRIBUTE_UNUSED)
+{
+ m2pp_print (s, "INTEGER");
+}
+#endif
+
+/* m2pp_complex display the actual complex type. */
+
+#if defined(GM2)
+static void
+m2pp_complex (pretty *s, tree t)
+{
+ if (t == m2type_GetM2ComplexType ())
+ m2pp_print (s, "COMPLEX");
+ else if (t == m2type_GetM2LongComplexType ())
+ m2pp_print (s, "LONGCOMPLEX");
+ else if (t == m2type_GetM2ShortComplexType ())
+ m2pp_print (s, "SHORTCOMPLEX");
+ else if (t == m2type_GetM2CType ())
+ m2pp_print (s, "C'omplex' type");
+ else if (t == m2type_GetM2Complex32 ())
+ m2pp_print (s, "COMPLEX32");
+ else if (t == m2type_GetM2Complex64 ())
+ m2pp_print (s, "COMPLEX64");
+ else if (t == m2type_GetM2Complex96 ())
+ m2pp_print (s, "COMPLEX96");
+ else if (t == m2type_GetM2Complex128 ())
+ m2pp_print (s, "COMPLEX128");
+ else
+ m2pp_print (s, "unknown COMPLEX type");
+}
+
+#else
+
+static void
+m2pp_complex (pretty *s, tree t ATTRIBUTE_UNUSED)
+{
+ m2pp_print (s, "a COMPLEX type");
+}
+#endif
+
+/* m2pp_type prints a full type. */
+
+void
+m2pp_type (pretty *s, tree t)
+{
+ if (begin_printed (t))
+ {
+ m2pp_print (s, "<...>");
+ return;
+ }
+ if ((TREE_CODE (t) != FIELD_DECL) && (TREE_CODE (t) != TYPE_DECL))
+ m2pp_gimpified (s, t);
+ switch (TREE_CODE (t))
+ {
+ case INTEGER_TYPE:
+ m2pp_integer (s, t);
+ break;
+ case REAL_TYPE:
+ m2pp_print (s, "REAL");
+ break;
+ case ENUMERAL_TYPE:
+ m2pp_enum (s, t);
+ break;
+ case UNION_TYPE:
+ m2pp_union_type (s, t);
+ break;
+ case RECORD_TYPE:
+ m2pp_record_type (s, t);
+ break;
+ case ARRAY_TYPE:
+ m2pp_array (s, t);
+ break;
+#if 0
+ case FUNCTION_TYPE:
+ m2pp_function_type (s, t);
+ break;
+#endif
+ case TYPE_DECL:
+ m2pp_identifier (s, t);
+ break;
+ case POINTER_TYPE:
+ m2pp_pointer_type (s, t);
+ break;
+#if defined(GM2)
+ case SET_TYPE:
+ m2pp_set_type (s, t);
+ break;
+#endif
+ case VOID_TYPE:
+ m2pp_print (s, "ADDRESS");
+ break;
+ case COMPLEX_TYPE:
+ m2pp_complex (s, t);
+ break;
+ default:
+ m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
+ }
+}
+
+/* m2pp_set_type prints out the set type. */
+
+static void
+m2pp_set_type (pretty *s, tree t)
+{
+ push (t);
+ m2pp_print (s, "SET OF");
+ m2pp_needspace (s);
+ m2pp_type (s, TREE_TYPE (t));
+ pop ();
+}
+
+/* m2pp_enum print out the enumeration type. */
+
+static void
+m2pp_enum (pretty *s, tree t)
+{
+ tree chain_p = TYPE_VALUES (t);
+
+ push (t);
+ m2pp_print (s, "(");
+ while (chain_p)
+ {
+ m2pp_ident_pointer (s, TREE_PURPOSE (chain_p));
+ chain_p = TREE_CHAIN (chain_p);
+ if (chain_p)
+ m2pp_print (s, ", ");
+ }
+ m2pp_print (s, ")");
+ pop ();
+}
+
+/* m2pp_array prints out the array type. */
+
+static void
+m2pp_array (pretty *s, tree t)
+{
+ push (t);
+ m2pp_print (s, "ARRAY");
+ m2pp_needspace (s);
+ m2pp_subrange (s, TYPE_DOMAIN (t));
+ m2pp_needspace (s);
+ m2pp_print (s, "OF");
+ m2pp_needspace (s);
+ m2pp_type (s, TREE_TYPE (t));
+ pop ();
+}
+
+/* m2pp_subrange prints out the subrange, but probably the lower
+ bound will always be zero. */
+
+static void
+m2pp_subrange (pretty *s, tree t)
+{
+ tree min = TYPE_MIN_VALUE (t);
+ tree max = TYPE_MAX_VALUE (t);
+
+ m2pp_print (s, "[");
+ m2pp_expression (s, min);
+ m2pp_print (s, "..");
+ m2pp_expression (s, max);
+ m2pp_print (s, "]");
+}
+
+/* m2pp_gimplified print out a gimplified comment. */
+
+static void
+m2pp_gimpified (pretty *s, tree t)
+{
+ if (!TYPE_SIZES_GIMPLIFIED (t))
+ {
+ m2pp_print (s, "(* <!g> *)");
+ m2pp_needspace (s);
+ }
+}
+
+/* m2pp_printer_type display the pointer type. */
+
+static void
+m2pp_pointer_type (pretty *s, tree t)
+{
+ push (t);
+ if (TREE_CODE (t) == POINTER_TYPE)
+ {
+ if (TREE_CODE (TREE_TYPE (t)) == FUNCTION_TYPE)
+ m2pp_procedure_type (s, TREE_TYPE (t));
+ else if (t == ptr_type_node)
+ m2pp_print (s, "ADDRESS");
+ else
+ {
+ m2pp_print (s, "POINTER TO");
+ m2pp_needspace (s);
+ m2pp_type (s, TREE_TYPE (t));
+ }
+ }
+ pop ();
+}
+
+/* m2pp_record_alignment prints out whether this record is aligned
+ (packed). */
+
+static void
+m2pp_record_alignment (pretty *s, tree t)
+{
+ if (TYPE_PACKED (t))
+ m2pp_print (s, "<* bytealignment (0) *>\n");
+}
+
+static unsigned int
+m2pp_getaligned (tree t)
+{
+ if (DECL_P (t))
+ {
+ if (DECL_USER_ALIGN (t))
+ return DECL_ALIGN (t);
+ }
+ else if (TYPE_P (t))
+ {
+ if (TYPE_USER_ALIGN (t))
+ return TYPE_ALIGN (t);
+ }
+ return 0;
+}
+
+static void
+m2pp_recordfield_alignment (pretty *s, tree t)
+{
+ unsigned int aligned = m2pp_getaligned (t);
+
+ if (aligned != 0)
+ {
+ int o = getindent (s);
+ int p = getcurpos (s);
+ m2pp_needspace (s);
+ m2pp_print (s, "<* bytealignment (");
+ setindent (s, p + 18);
+
+ printf ("%d", aligned / BITS_PER_UNIT);
+
+ m2pp_print (s, ")");
+ m2pp_needspace (s);
+ setindent (s, p);
+ m2pp_print (s, "*>");
+ setindent (s, o);
+ }
+}
+
+static void
+m2pp_recordfield_bitfield (pretty *s, tree t)
+{
+ if ((TREE_CODE (t) == FIELD_DECL) && DECL_PACKED (t))
+ {
+ m2pp_print (s, " (* packed");
+ if (DECL_NONADDRESSABLE_P (t))
+ m2pp_print (s, ", non-addressible");
+ if (DECL_BIT_FIELD (t))
+ m2pp_print (s, ", bit-field");
+ m2pp_print (s, ", offset: ");
+ m2pp_expression (s, DECL_FIELD_OFFSET (t));
+ m2pp_print (s, ", bit offset:");
+ m2pp_expression (s, DECL_FIELD_BIT_OFFSET (t));
+ m2pp_print (s, " *) ");
+ }
+}
+
+/* m2pp_record_type displays the record type. */
+
+static void
+m2pp_record_type (pretty *s, tree t)
+{
+ push (t);
+ if (TREE_CODE (t) == RECORD_TYPE)
+ {
+ tree i;
+ int o = getindent (s);
+ int p = getcurpos (s);
+
+ m2pp_print (s, "RECORD\n");
+ setindent (s, p + 3);
+ m2pp_record_alignment (s, t);
+ for (i = TYPE_FIELDS (t); i != NULL_TREE; i = TREE_CHAIN (i))
+ {
+ m2pp_identifier (s, i);
+ m2pp_print (s, " : ");
+ m2pp_type (s, TREE_TYPE (i));
+ m2pp_recordfield_bitfield (s, i);
+ m2pp_recordfield_alignment (s, i);
+ m2pp_print (s, ";\n");
+ }
+ setindent (s, p);
+ m2pp_print (s, "END");
+ setindent (s, o);
+ }
+ pop ();
+}
+
+/* m2pp_record_type displays the record type. */
+
+static void
+m2pp_union_type (pretty *s, tree t)
+{
+ push (t);
+ if (TREE_CODE (t) == UNION_TYPE)
+ {
+ tree i;
+ int o = getindent (s);
+ int p = getcurpos (s);
+
+ m2pp_print (s, "CASE .. OF\n");
+ setindent (s, p + 3);
+ m2pp_record_alignment (s, t);
+ for (i = TYPE_FIELDS (t); i != NULL_TREE; i = TREE_CHAIN (i))
+ {
+ m2pp_identifier (s, i);
+ m2pp_print (s, " : ");
+ m2pp_type (s, TREE_TYPE (i));
+ m2pp_recordfield_bitfield (s, i);
+ m2pp_print (s, ";\n");
+ }
+ setindent (s, p);
+ m2pp_print (s, "END");
+ setindent (s, o);
+ }
+ pop ();
+}
+
+/* m2pp_simple_type. */
+
+static void
+m2pp_simple_type (pretty *s, tree t)
+{
+ if (begin_printed (t))
+ {
+ m2pp_print (s, "<...>");
+ return;
+ }
+
+ m2pp_gimpified (s, t);
+ switch (TREE_CODE (t))
+ {
+ case INTEGER_TYPE:
+ m2pp_integer (s, t);
+ break;
+ case REAL_TYPE:
+ m2pp_print (s, "REAL");
+ break;
+ case BOOLEAN_TYPE:
+ m2pp_print (s, "BOOLEAN");
+ break;
+ case VOID_TYPE:
+ m2pp_print (s, "ADDRESS");
+ break;
+ case TYPE_DECL:
+ m2pp_identifier (s, t);
+ break;
+ case POINTER_TYPE:
+ m2pp_pointer_type (s, t);
+ break;
+ case RECORD_TYPE:
+ m2pp_record_type (s, t);
+ break;
+ case UNION_TYPE:
+ m2pp_union_type (s, t);
+ break;
+ case ENUMERAL_TYPE:
+ m2pp_enum (s, t);
+ break;
+ case COMPLEX_TYPE:
+ m2pp_complex (s, t);
+ break;
+ default:
+ m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
+ }
+}
+
+/* m2pp_expression display an expression. */
+
+static void
+m2pp_expression (pretty *s, tree t)
+{
+ enum tree_code code = TREE_CODE (t);
+
+ switch (code)
+ {
+ case EQ_EXPR:
+ m2pp_relop (s, t, "=");
+ break;
+ case NE_EXPR:
+ m2pp_relop (s, t, "#");
+ break;
+ case LE_EXPR:
+ m2pp_relop (s, t, "<=");
+ break;
+ case GE_EXPR:
+ m2pp_relop (s, t, ">=");
+ break;
+ case LT_EXPR:
+ m2pp_relop (s, t, "<");
+ break;
+ case GT_EXPR:
+ m2pp_relop (s, t, ">");
+ break;
+ default:
+ m2pp_simple_expression (s, t);
+ }
+}
+
+/* m2pp_relop displays the lhs relop rhs. */
+
+static void
+m2pp_relop (pretty *s, tree t, const char *p)
+{
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_needspace (s);
+ m2pp_print (s, p);
+ m2pp_needspace (s);
+ m2pp_expression (s, TREE_OPERAND (t, 1));
+}
+
+/* m2pp_compound_expression handle compound expression tree. */
+
+static void
+m2pp_compound_expression (pretty *s, tree t)
+{
+ m2pp_print (s, "compound expression {");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, " (* result ignored *), ");
+ m2pp_expression (s, TREE_OPERAND (t, 1));
+ m2pp_print (s, "}");
+ m2pp_needspace (s);
+}
+
+/* m2pp_target_expression handle target expression tree. */
+
+static void
+m2pp_target_expression (pretty *s, tree t)
+{
+ m2pp_print (s, "{");
+ m2pp_needspace (s);
+ if (TREE_OPERAND (t, 0) != NULL_TREE)
+ {
+ m2pp_print (s, "(* target *) ");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ }
+ if (TREE_OPERAND (t, 1) != NULL_TREE)
+ {
+ m2pp_print (s, "(* initializer *) ");
+ m2pp_expression (s, TREE_OPERAND (t, 1));
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ }
+ if (TREE_OPERAND (t, 2) != NULL_TREE)
+ {
+ m2pp_print (s, "(* cleanup *) ");
+ m2pp_expression (s, TREE_OPERAND (t, 2));
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ }
+ if (TREE_OPERAND (t, 3) != NULL_TREE)
+ {
+ m2pp_print (s, "(* saved initializer *) ");
+ m2pp_expression (s, TREE_OPERAND (t, 3));
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ }
+ m2pp_print (s, "}");
+ m2pp_needspace (s);
+}
+
+/* m2pp_constructor print out a constructor. */
+
+static void
+m2pp_constructor (pretty *s, tree t)
+{
+ tree purpose, value;
+ unsigned HOST_WIDE_INT ix;
+
+ m2pp_print (s, "{ ");
+ FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (t), ix, purpose, value)
+ {
+ m2pp_print (s, "(index: ");
+ m2pp_simple_expression (s, purpose);
+ m2pp_print (s, ") ");
+ m2pp_simple_expression (s, value);
+ m2pp_print (s, ", ");
+ }
+ m2pp_print (s, "}");
+ m2pp_print (s, "(* type: ");
+ setindent (s, getindent (s) + 8);
+ m2pp_type (s, TREE_TYPE (t));
+ setindent (s, getindent (s) - 8);
+ m2pp_print (s, " *)\n");
+}
+
+/* m2pp_complex_expr handle GCC complex_expr tree. */
+
+static void
+m2pp_complex_expr (pretty *s, tree t)
+{
+ if (TREE_CODE (t) == COMPLEX_CST)
+ {
+ m2pp_print (s, "CMPLX(");
+ m2pp_needspace (s);
+ m2pp_expression (s, TREE_REALPART (t));
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ m2pp_expression (s, TREE_IMAGPART (t));
+ m2pp_print (s, ")");
+ }
+ else
+ {
+ m2pp_print (s, "CMPLX(");
+ m2pp_needspace (s);
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ m2pp_expression (s, TREE_OPERAND (t, 1));
+ m2pp_print (s, ")");
+ }
+}
+
+/* m2pp_imagpart_expr handle imagpart_expr tree. */
+
+static void
+m2pp_imagpart_expr (pretty *s, tree t)
+{
+ m2pp_print (s, "IM(");
+ m2pp_needspace (s);
+ if (TREE_CODE (t) == IMAGPART_EXPR)
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ else if (TREE_CODE (t) == COMPLEX_CST)
+ m2pp_expression (s, TREE_IMAGPART (t));
+ m2pp_needspace (s);
+ m2pp_print (s, ")");
+}
+
+/* m2pp_realpart_expr handle imagpart_expr tree. */
+
+static void
+m2pp_realpart_expr (pretty *s, tree t)
+{
+ m2pp_print (s, "RE(");
+ m2pp_needspace (s);
+ if (TREE_CODE (t) == REALPART_EXPR)
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ else if (TREE_CODE (t) == COMPLEX_CST)
+ m2pp_expression (s, TREE_REALPART (t));
+ m2pp_needspace (s);
+ m2pp_print (s, ")");
+}
+
+/* m2pp_bit_ior_expr generate a C style bit or. */
+
+static void
+m2pp_bit_ior_expr (pretty *s, tree t)
+{
+ m2pp_binary (s, t, "|");
+}
+
+/* m2pp_truth_expr. */
+
+static void
+m2pp_truth_expr (pretty *s, tree t, const char *op)
+{
+ m2pp_print (s, "(");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ")");
+ m2pp_needspace (s);
+ m2pp_print (s, op);
+ m2pp_needspace (s);
+ m2pp_print (s, "(");
+ m2pp_expression (s, TREE_OPERAND (t, 1));
+ m2pp_print (s, ")");
+}
+
+/* m2pp_simple_expression handle GCC expression tree. */
+
+static void
+m2pp_simple_expression (pretty *s, tree t)
+{
+ enum tree_code code = TREE_CODE (t);
+
+ switch (code)
+ {
+ case ERROR_MARK:
+ m2pp_print (s, "(* !!! ERROR NODE !!! *)");
+ break;
+ case CONSTRUCTOR:
+ m2pp_constructor (s, t);
+ break;
+ case IDENTIFIER_NODE:
+ m2pp_ident_pointer (s, t);
+ break;
+ case PARM_DECL:
+ m2pp_identifier (s, t);
+ break;
+ case FIELD_DECL:
+ m2pp_identifier (s, t);
+ break;
+ case TREE_LIST:
+ m2pp_list (s, t);
+ break;
+ case BLOCK:
+ m2pp_print (s, "(* BLOCK NODE *)");
+ break;
+ case OFFSET_TYPE:
+ m2pp_offset (s, t);
+ break;
+ case INTEGER_CST:
+ m2pp_integer_cst (s, t);
+ break;
+ case REAL_CST:
+ m2pp_real_cst (s, t);
+ break;
+ case STRING_CST:
+ m2pp_string_cst (s, t);
+ break;
+ case INDIRECT_REF:
+ m2pp_indirect_ref (s, t);
+ break;
+ case ADDR_EXPR:
+ m2pp_addr_expr (s, t);
+ break;
+ case NOP_EXPR:
+ m2pp_nop (s, t);
+ break;
+ case CONVERT_EXPR:
+ m2pp_convert (s, t);
+ break;
+ case VAR_DECL:
+ m2pp_var_decl (s, t);
+ break;
+ case RESULT_DECL:
+ m2pp_result_decl (s, t);
+ break;
+ case PLUS_EXPR:
+ m2pp_binary (s, t, "+");
+ break;
+ case MINUS_EXPR:
+ m2pp_binary (s, t, "-");
+ break;
+ case MULT_EXPR:
+ m2pp_binary (s, t, "*");
+ break;
+ case FLOOR_DIV_EXPR:
+ case CEIL_DIV_EXPR:
+ case TRUNC_DIV_EXPR:
+ case ROUND_DIV_EXPR:
+ m2pp_binary (s, t, "DIV");
+ break;
+ case FLOOR_MOD_EXPR:
+ case CEIL_MOD_EXPR:
+ case TRUNC_MOD_EXPR:
+ case ROUND_MOD_EXPR:
+ m2pp_binary (s, t, "MOD");
+ break;
+ case NEGATE_EXPR:
+ m2pp_unary (s, t, "-");
+ break;
+ case CALL_EXPR:
+ m2pp_call_expr (s, t);
+ break;
+ case SSA_NAME:
+ m2pp_ssa (s, t);
+ break;
+ case COMPONENT_REF:
+ m2pp_component_ref (s, t);
+ break;
+ case RETURN_EXPR:
+ m2pp_return_expr (s, t);
+ break;
+ case ARRAY_REF:
+ m2pp_array_ref (s, t);
+ break;
+ case NON_LVALUE_EXPR:
+ m2pp_non_lvalue_expr (s, t);
+ break;
+ case EXPR_STMT:
+ m2pp_expression (s, EXPR_STMT_EXPR (t));
+ break;
+#if 0
+ case EXC_PTR_EXPR:
+ m2pp_print (s, "GCC_EXCEPTION_OBJECT");
+ break;
+#endif
+ case INIT_EXPR:
+ case MODIFY_EXPR:
+ m2pp_assignment (s, t);
+ break;
+ case COMPOUND_EXPR:
+ m2pp_compound_expression (s, t);
+ break;
+ case TARGET_EXPR:
+ m2pp_target_expression (s, t);
+ break;
+ case THROW_EXPR:
+ m2pp_throw (s, t);
+ break;
+ case FUNCTION_DECL:
+ m2pp_identifier (s, t);
+ break;
+ case COMPLEX_EXPR:
+ m2pp_complex_expr (s, t);
+ break;
+ case REALPART_EXPR:
+ m2pp_realpart_expr (s, t);
+ break;
+ case IMAGPART_EXPR:
+ m2pp_imagpart_expr (s, t);
+ break;
+ case CONST_DECL:
+ m2pp_identifier (s, t);
+ break;
+ case POINTER_PLUS_EXPR:
+ m2pp_binary (s, t, "+");
+ break;
+ case CLEANUP_POINT_EXPR:
+ m2pp_cleanup_point_expr (s, t);
+ break;
+ case BIT_IOR_EXPR:
+ m2pp_bit_ior_expr (s, t);
+ break;
+ case TRUTH_ANDIF_EXPR:
+ m2pp_truth_expr (s, t, "AND");
+ break;
+ case TRUTH_ORIF_EXPR:
+ m2pp_truth_expr (s, t, "OR");
+ break;
+ default:
+ m2pp_unknown (s, __FUNCTION__, get_tree_code_name (code));
+ }
+}
+
+/* non_lvalue_expr indicates that operand 0 is not an lvalue. */
+
+static void
+m2pp_non_lvalue_expr (pretty *s, tree t)
+{
+ m2pp_needspace (s);
+ m2pp_print (s, "assert_non_lvalue(");
+ m2pp_needspace (s);
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_needspace (s);
+ m2pp_print (s, ")");
+}
+
+/* m2pp_array_ref prints out the array reference. */
+
+static void
+m2pp_array_ref (pretty *s, tree t)
+{
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, "[");
+ m2pp_expression (s, TREE_OPERAND (t, 1));
+ m2pp_print (s, "]");
+}
+
+/* m2pp_ssa prints out the ssa variable name. */
+
+static void
+m2pp_ssa (pretty *s, tree t)
+{
+ m2pp_identifier (s, SSA_NAME_VAR (t));
+}
+
+/* m2pp_binary print the binary operator, p, and lhs, rhs. */
+
+static void
+m2pp_binary (pretty *s, tree t, const char *p)
+{
+ tree left = TREE_OPERAND (t, 0);
+ tree right = TREE_OPERAND (t, 1);
+
+ m2pp_expression (s, left);
+ m2pp_needspace (s);
+ m2pp_print (s, p);
+ m2pp_needspace (s);
+ m2pp_expression (s, right);
+}
+
+/* m2pp_unary print the unary operator, p, and expression. */
+
+static void
+m2pp_unary (pretty *s, tree t, const char *p)
+{
+ tree expr = TREE_OPERAND (t, 0);
+
+ m2pp_needspace (s);
+ m2pp_print (s, p);
+ m2pp_expression (s, expr);
+}
+
+/* m2pp_integer_cst displays the integer constant. */
+
+static void
+m2pp_integer_cst (pretty *s, tree t)
+{
+ char val[100];
+
+ snprintf (val, 100, "%lud", TREE_INT_CST_LOW (t));
+ m2pp_print (s, val);
+}
+
+/* m2pp_real_cst displays the real constant. */
+
+static void
+m2pp_real_cst (pretty *s, tree t ATTRIBUTE_UNUSED)
+{
+ m2pp_print (s, "<unknown real>");
+}
+
+/* m2pp_string_cst displays the real constant. */
+
+static void
+m2pp_string_cst (pretty *s, tree t)
+{
+ const char *p = TREE_STRING_POINTER (t);
+ int i = 0;
+
+ m2pp_print (s, "\"");
+ while (p[i] != '\0')
+ {
+ m2pp_print_char (s, p[i]);
+ i++;
+ }
+ m2pp_print (s, "\"");
+}
+
+/* m2pp_statement_sequence iterates over a statement list
+ displaying each statement in turn. */
+
+static void
+m2pp_statement_sequence (pretty *s, tree t)
+{
+ if (t != NULL_TREE)
+ {
+ if (TREE_CODE (t) == STATEMENT_LIST)
+ {
+ tree_stmt_iterator i;
+ m2pp_print (s, "(* statement list *)\n");
+
+ for (i = tsi_start (t); !tsi_end_p (i); tsi_next (&i))
+ m2pp_statement (s, *tsi_stmt_ptr (i));
+ }
+ else
+ m2pp_statement (s, t);
+ }
+}
+
+/* m2pp_unknown displays an error message. */
+
+static void
+m2pp_unknown (pretty *s, const char *s1, const char *s2)
+{
+ m2pp_begin (s);
+ m2pp_print (s, s1);
+ m2pp_needspace (s);
+ m2pp_print (s, s2);
+ m2pp_needspace (s);
+}
+
+/* m2pp_throw displays a throw statement. */
+
+static void
+m2pp_throw (pretty *s, tree t)
+{
+ tree expr = TREE_OPERAND (t, 0);
+
+ m2pp_begin (s);
+ if (expr == NULL_TREE)
+ m2pp_print (s, "THROW ;\n");
+ else
+ {
+ m2pp_print (s, "THROW (");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ")\n");
+ }
+}
+
+/* m2pp_catch_expr attempts to reconstruct a catch expr. */
+
+static void
+m2pp_catch_expr (pretty *s, tree t)
+{
+ tree types = CATCH_TYPES (t);
+ tree body = CATCH_BODY (t);
+
+ m2pp_print (s, "(* CATCH expression ");
+ if (types != NULL_TREE)
+ {
+ m2pp_print (s, "(");
+ m2pp_expression (s, types);
+ m2pp_print (s, ")");
+ }
+ m2pp_print (s, "*)\n");
+ m2pp_print (s, "(* catch body *)\n");
+ m2pp_statement_sequence (s, body);
+ m2pp_print (s, "(* end catch body *)\n");
+}
+
+/* m2pp_try_finally_expr attemts to reconstruct a try finally expr. */
+
+static void
+m2pp_try_finally_expr (pretty *s, tree t)
+{
+ m2pp_begin (s);
+ m2pp_print (s, "(* try_finally_expr *)\n");
+ setindent (s, getindent (s) + 3);
+ m2pp_statement_sequence (s, TREE_OPERAND (t, 0));
+ setindent (s, getindent (s) - 3);
+ m2pp_print (s,
+ "(* finally (cleanup which is executed after the above) *)\n");
+ setindent (s, getindent (s) + 3);
+ m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
+ setindent (s, getindent (s) - 3);
+ m2pp_print (s, "(* end try_finally_expr *)\n");
+}
+
+#if !defined(GM2)
+/* m2pp_if_stmt pretty print a C++ if_stmt. */
+
+static void
+m2pp_if_stmt (pretty *s, tree t)
+{
+ m2pp_print (s, "(* only C++ uses if_stmt nodes *)\n");
+ m2pp_print (s, "IF ");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, "\n");
+ m2pp_print (s, "THEN\n");
+ setindent (s, getindent (s) + 3);
+ m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
+ setindent (s, getindent (s) - 3);
+ m2pp_print (s, "ELSE\n");
+ setindent (s, getindent (s) + 3);
+ m2pp_statement_sequence (s, TREE_OPERAND (t, 2));
+ setindent (s, getindent (s) - 3);
+ m2pp_print (s, "END\n");
+}
+#endif
+
+/* m2pp_statement attempts to reconstruct a statement. */
+
+static void
+m2pp_statement (pretty *s, tree t)
+{
+ enum tree_code code = TREE_CODE (t);
+
+ m2pp_loc (s, t);
+ switch (code)
+ {
+ case COND_EXPR:
+ m2pp_conditional (s, t);
+ break;
+ case LABEL_EXPR:
+ m2pp_label_expr (s, t);
+ break;
+ case LABEL_DECL:
+ m2pp_label_decl (s, t);
+ break;
+ case GOTO_EXPR:
+ m2pp_goto (s, t);
+ break;
+ case INIT_EXPR:
+ case MODIFY_EXPR:
+ m2pp_assignment (s, t);
+ break;
+ case CALL_EXPR:
+ m2pp_procedure_call (s, t);
+ break;
+ case BLOCK:
+ m2pp_block_list (s, t);
+ break;
+ case BIND_EXPR:
+ m2pp_bind_expr (s, t);
+ break;
+ case RETURN_EXPR:
+ m2pp_return_expr (s, t);
+ break;
+ case DECL_EXPR:
+ m2pp_decl_expr (s, t);
+ break;
+ case TRY_BLOCK:
+ m2pp_try_block (s, t);
+ break;
+ case HANDLER:
+ m2pp_handler (s, t);
+ break;
+ case CLEANUP_POINT_EXPR:
+ m2pp_cleanup_point_expr (s, t);
+ break;
+ case THROW_EXPR:
+ m2pp_throw (s, t);
+ break;
+ case TRY_CATCH_EXPR:
+ m2pp_try_catch_expr (s, t);
+ break;
+ case TRY_FINALLY_EXPR:
+ m2pp_try_finally_expr (s, t);
+ break;
+ case CATCH_EXPR:
+ m2pp_catch_expr (s, t);
+ break;
+#if defined(CPP)
+ case IF_STMT:
+ m2pp_if_stmt (s, t);
+ break;
+#endif
+ case ERROR_MARK:
+ m2pp_print (s, "<ERROR CODE>\n");
+ break;
+ default:
+ m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t)));
+ }
+}
+
+/* m2pp_try_catch_expr is used after gimplification. */
+
+static void
+m2pp_try_catch_expr (pretty *s, tree t)
+{
+ m2pp_print (s, "(* try_catch_expr begins *)\n");
+ m2pp_statement_sequence (s, TREE_OPERAND (t, 0));
+ setindent (s, 0);
+ m2pp_print (s, "EXCEPT\n");
+ setindent (s, 3);
+ m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
+ m2pp_print (s, "(* try_catch_expr ends *)\n");
+}
+
+/* m2pp_cleanup_point_expr emits a comment indicating a GCC
+ cleanup_point_expr is present. */
+
+static void
+m2pp_cleanup_point_expr (pretty *s, tree t)
+{
+ m2pp_begin (s);
+ m2pp_print (s, "(* cleanup point begins *)\n");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, "(* cleanup point ends *)\n");
+}
+
+/* m2pp_decl_expr displays a local declaration. */
+
+static void
+m2pp_decl_expr (pretty *s, tree t)
+{
+ m2pp_var (s);
+ m2pp_print (s, "(* variable in decl_expr *)\n");
+ m2pp_var_type_decl (s, DECL_EXPR_DECL (t));
+}
+
+/* m2pp_procedure_call print a call to a procedure. */
+
+static void
+m2pp_procedure_call (pretty *s, tree t)
+{
+ m2pp_begin (s);
+ m2pp_call_expr (s, t);
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+}
+
+/* args displays each argument in an iter list by calling expression. */
+
+static void
+m2pp_args (pretty *s, tree e)
+{
+ call_expr_arg_iterator iter;
+ tree arg;
+
+ m2pp_print (s, "(");
+ m2pp_needspace (s);
+ FOR_EACH_CALL_EXPR_ARG (arg, iter, e)
+ {
+ m2pp_expression (s, arg);
+ if (more_call_expr_args_p (&iter))
+ {
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ }
+ }
+ m2pp_print (s, ")");
+}
+
+/* m2pp_call_expr print a call to a procedure or function. */
+
+static void
+m2pp_call_expr (pretty *s, tree t)
+{
+ tree call = CALL_EXPR_FN (t);
+ tree args = TREE_OPERAND (t, 1);
+ tree type = TREE_TYPE (t);
+ int has_return_type = TRUE;
+ tree proc;
+
+ if (type && (TREE_CODE (type) == VOID_TYPE))
+ has_return_type = FALSE;
+
+ if (TREE_CODE (call) == ADDR_EXPR || TREE_CODE (call) == NON_LVALUE_EXPR)
+ proc = TREE_OPERAND (call, 0);
+ else
+ proc = call;
+
+ m2pp_expression (s, proc);
+ if (args || has_return_type)
+ m2pp_args (s, t);
+}
+
+/* m2pp_return_expr displays the return statement. */
+
+static void
+m2pp_return_expr (pretty *s, tree t)
+{
+ tree e = TREE_OPERAND (t, 0);
+
+ m2pp_begin (s);
+ if (e == NULL_TREE)
+ {
+ m2pp_print (s, "RETURN");
+ }
+ else if (TREE_CODE (e) == MODIFY_EXPR || (TREE_CODE (e) == INIT_EXPR))
+ {
+ m2pp_assignment (s, e);
+ m2pp_print (s, "RETURN");
+ m2pp_needspace (s);
+ m2pp_expression (s, TREE_OPERAND (e, 0));
+ }
+ else
+ {
+ m2pp_print (s, "RETURN");
+ m2pp_needspace (s);
+ m2pp_expression (s, e);
+ }
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+}
+
+/* m2pp_try_block displays the try block. */
+
+static void
+m2pp_try_block (pretty *s, tree t)
+{
+ tree stmts = TRY_STMTS (t);
+ tree handlers = TRY_HANDLERS (t);
+
+ m2pp_begin (s);
+ m2pp_print (s, "(* TRY *)\n");
+ m2pp_statement_sequence (s, stmts);
+ setindent (s, 0);
+ m2pp_print (s, "EXCEPT\n");
+ setindent (s, 3);
+ m2pp_statement_sequence (s, handlers);
+ m2pp_print (s, "(* END TRY *)\n");
+}
+
+/* m2pp_try_block displays the handler block. */
+
+static void
+m2pp_handler (pretty *s, tree t)
+{
+ tree parms = HANDLER_PARMS (t);
+ tree body = HANDLER_BODY (t);
+ tree type = HANDLER_TYPE (t);
+
+ m2pp_print (s, "(* handler *)\n");
+ if (parms != NULL_TREE)
+ {
+ m2pp_print (s, "(* handler parameter has a type (should be NULL_TREE) "
+ "in Modula-2 *)\n");
+ m2pp_print (s, "CATCH (");
+ m2pp_expression (s, parms);
+ m2pp_print (s, ")\n");
+ }
+ if (type != NULL_TREE)
+ m2pp_print (s, "(* handler type (should be NULL_TREE) in Modula-2 *)\n");
+ m2pp_statement_sequence (s, body);
+}
+
+/* m2pp_assignment prints out the assignment statement. */
+
+static void
+m2pp_assignment (pretty *s, tree t)
+{
+ int o;
+
+ m2pp_begin (s);
+ m2pp_designator (s, TREE_OPERAND (t, 0));
+ m2pp_needspace (s);
+ m2pp_print (s, ":=");
+ m2pp_needspace (s);
+ o = getindent (s);
+ setindent (s, getcurpos (s) + 1);
+ m2pp_expression (s, TREE_OPERAND (t, 1));
+ m2pp_needspace (s);
+ m2pp_print (s, ";\n");
+ setindent (s, o);
+}
+
+/* m2pp_designator displays the lhs of an assignment. */
+
+static void
+m2pp_designator (pretty *s, tree t)
+{
+ m2pp_expression (s, t);
+}
+
+/* m2pp_indirect_ref displays the indirect operator. */
+
+static void
+m2pp_indirect_ref (pretty *s, tree t)
+{
+ m2pp_print (s, "(");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ")^");
+}
+
+/* m2pp_conditional builds an IF THEN ELSE END. With more work
+ this should be moved into statement sequence which could look for
+ repeat and while loops. */
+
+static void
+m2pp_conditional (pretty *s, tree t)
+{
+ int o;
+
+ m2pp_begin (s);
+ m2pp_print (s, "IF");
+ m2pp_needspace (s);
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, "\nTHEN\n");
+ o = getindent (s);
+ setindent (s, o + 3);
+ m2pp_statement_sequence (s, TREE_OPERAND (t, 1));
+ setindent (s, o);
+ if (TREE_OPERAND (t, 2) != NULL_TREE)
+ {
+ m2pp_print (s, "ELSE\n");
+ setindent (s, o + 3);
+ m2pp_statement_sequence (s, TREE_OPERAND (t, 2));
+ setindent (s, o);
+ }
+ m2pp_print (s, "END ;\n");
+}
+
+/* m2pp_label_decl displays a label. Again should be moved into
+ statement sequence to determine proper loop constructs. */
+
+static void
+m2pp_label_decl (pretty *s, tree t)
+{
+ m2pp_begin (s);
+ m2pp_print (s, "(* label ");
+ m2pp_identifier (s, t);
+ m2pp_print (s, ": *)\n");
+}
+
+/* m2pp_label_expr skips the LABEL_EXPR to find the LABEL_DECL. */
+
+static void
+m2pp_label_expr (pretty *s, tree t)
+{
+ m2pp_begin (s);
+ m2pp_statement (s, TREE_OPERAND (t, 0));
+}
+
+/* m2pp_goto displays a goto statement. Again should be moved into
+ statement sequence to determine proper loop constructs. */
+
+static void
+m2pp_goto (pretty *s, tree t)
+{
+ m2pp_begin (s);
+ m2pp_print (s, "(* goto ");
+ m2pp_identifier (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, " *)\n");
+}
+
+/* m2pp_list prints a TREE_CHAINed list. */
+
+static void
+m2pp_list (pretty *s, tree t)
+{
+ tree u = t;
+
+ m2pp_print (s, "(");
+ m2pp_needspace (s);
+ while (t != NULL_TREE)
+ {
+ m2pp_expression (s, TREE_VALUE (t));
+ t = TREE_CHAIN (t);
+ if (t == u || t == NULL_TREE)
+ break;
+ m2pp_print (s, ",");
+ m2pp_needspace (s);
+ }
+ m2pp_needspace (s);
+ m2pp_print (s, ")");
+}
+
+/* m2pp_offset displays the offset operator. */
+
+static void
+m2pp_offset (pretty *s, tree t)
+{
+ tree type = TREE_TYPE (t);
+ tree base = TYPE_OFFSET_BASETYPE (t);
+
+ m2pp_print (s, "OFFSET (");
+ m2pp_type (s, base);
+ m2pp_print (s, ".");
+ m2pp_type (s, type);
+ m2pp_print (s, ")");
+}
+
+/* m2pp_addr_expr create an ADR expression. */
+
+static void
+m2pp_addr_expr (pretty *s, tree t)
+{
+ m2pp_needspace (s);
+ m2pp_print (s, "ADR (");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ")");
+}
+
+/* m2pp_nop generate a CAST expression. */
+
+static void
+m2pp_nop (pretty *s, tree t)
+{
+ m2pp_needspace (s);
+ m2pp_print (s, "CAST (");
+ m2pp_simple_type (s, TREE_TYPE (t));
+ m2pp_print (s, ", ");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ")");
+}
+
+/* m2pp_convert generate a CONVERT expression. */
+
+static void
+m2pp_convert (pretty *s, tree t)
+{
+ m2pp_needspace (s);
+ m2pp_print (s, "CONVERT (");
+ m2pp_simple_type (s, TREE_TYPE (t));
+ m2pp_print (s, ", ");
+ m2pp_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ")");
+}
+
+/* m2pp_var_decl generate a variable. */
+
+static void
+m2pp_var_decl (pretty *s, tree t)
+{
+ m2pp_identifier (s, t);
+}
+
+/* m2pp_result_decl generate a result declaration (variable). */
+
+static void
+m2pp_result_decl (pretty *s, tree t)
+{
+ m2pp_identifier (s, t);
+}
+
+/* m2pp_component_ref generate a record field access. */
+
+static void
+m2pp_component_ref (pretty *s, tree t)
+{
+ m2pp_simple_expression (s, TREE_OPERAND (t, 0));
+ m2pp_print (s, ".");
+ m2pp_simple_expression (s, TREE_OPERAND (t, 1));
+}
@@ -0,0 +1,42 @@
+/* m2pp.h pretty print trees, output in Modula-2 where possible.
+
+Copyright (C) 2007-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#if !defined(M2PP_H)
+# define M2PP_H
+
+# if defined(M2PP_C)
+# define EXTERN
+# else
+# define EXTERN extern
+# endif
+
+/* These functions allow a maintainer to dump the trees in Modula-2. */
+
+EXTERN void pf (tree t);
+EXTERN void pe (tree t);
+EXTERN void pt (tree t);
+EXTERN void ptl (tree t);
+EXTERN void pv (tree t);
+EXTERN void ptcl (tree t);
+
+
+# undef EXTERN
+#endif
@@ -0,0 +1,24 @@
+/* gm2-tree.def a component of a C header file used to define a SET type.
+
+Copyright (C) 2006-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING. If not, write to the
+Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA. */
+
+/* A SET_TYPE type. */
+DEFTREECODE (SET_TYPE, "set_type", tcc_type, 0)
@@ -0,0 +1,48 @@
+/* m2-tree.h create language specific tree nodes for Modula-2.
+
+Copyright (C) 2001-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 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.
+
+GNU Modula-2 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 GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#ifndef GCC_GM2_TREE_H
+#define GCC_GM2_TREE_H
+
+#include "ggc.h"
+#include "function.h"
+#include "hashtab.h"
+#include "vec.h"
+
+/* These macros provide convenient access to the various statement nodes. */
+
+#define TRY_STMTS(NODE) TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 0)
+#define TRY_HANDLERS(NODE) TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 1)
+
+/* Nonzero if this try block is a function try block. */
+#define FN_TRY_BLOCK_P(NODE) TREE_LANG_FLAG_3 (TRY_BLOCK_CHECK (NODE))
+#define HANDLER_PARMS(NODE) TREE_OPERAND (HANDLER_CHECK (NODE), 0)
+#define HANDLER_BODY(NODE) TREE_OPERAND (HANDLER_CHECK (NODE), 1)
+#define HANDLER_TYPE(NODE) TREE_TYPE (HANDLER_CHECK (NODE))
+
+/* STMT_EXPR accessor. */
+#define STMT_EXPR_STMT(NODE) TREE_OPERAND (STMT_EXPR_CHECK (NODE), 0)
+
+/* EXPR_STMT accessor. This gives the expression associated with an
+ expression statement. */
+#define EXPR_STMT_EXPR(NODE) TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0)
+
+#endif
@@ -0,0 +1 @@
+#define version_string "1.9.5"