@@ -0,0 +1,887 @@
+/* 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;
+};
+
+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;
+};
+
+/* Language hooks. */
+
+bool
+gm2_langhook_init (void)
+{
+ build_common_tree_nodes (false);
+ 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. */
+ opts->x_flag_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;
+
+ 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;
+
+ for (int 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);
+
+ 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;
+ if (is_int_mode (mode, &imode))
+ return gm2_langhook_type_for_size (GET_MODE_BITSIZE (imode), unsignedp);
+
+ if (mode == TYPE_MODE (float_type_node))
+ return float_type_node;
+
+ if (mode == TYPE_MODE (double_type_node))
+ return double_type_node;
+
+ if (mode == TYPE_MODE (long_double_type_node))
+ return long_double_type_node;
+
+ if (COMPLEX_MODE_P (mode))
+ {
+ if (mode == TYPE_MODE (complex_float_type_node))
+ return complex_float_type_node;
+ if (mode == TYPE_MODE (complex_double_type_node))
+ return complex_double_type_node;
+ if (mode == 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;
+}
+
+/* Unused langhook. */
+
+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 creating an array
+ of the declarations and calling wrapup_global_declarations. */
+
+static void
+m2_write_global_declarations (tree globals)
+{
+ auto_vec<tree> global_decls;
+ tree decl = globals;
+ int n = 0;
+
+ while (decl != NULL)
+ {
+ global_decls.safe_push (decl);
+ decl = TREE_CHAIN (decl);
+ n++;
+ }
+ wrapup_global_declarations (global_decls.address (), 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;
+ }
+}
+
+static GTY(()) tree gm2_eh_personality_decl;
+
+static tree
+gm2_langhook_eh_personality (void)
+{
+ if (!gm2_eh_personality_decl)
+ gm2_eh_personality_decl = build_personality_function ("gxx");
+
+ return gm2_eh_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"