[v3,15/19] modula2 front end: cc1gm2 additional non modula2 source files

Message ID E1p2ZEG-004QhG-Bj@lancelot
State New
Headers
Series [v3,1/19] modula2 front end: changes outside gcc/m2, libgm2 and gcc/testsuite. |

Commit Message

Gaius Mulley Dec. 6, 2022, 2:47 p.m. UTC
  This patch set contains the .h, .cc and .flex files found in
gcc/m2.  The files are tightly coupled with the gimple interface
(see 04-gimple-interface) and built using the rules found in
(01-03-make).

 
------8<----------8<----------8<----------8<----------8<----------8<----
  

Patch

diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-lang.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-lang.cc	2022-12-06 02:57:10.909039217 +0000
@@ -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"
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-lang.h
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-lang.h	2022-12-06 02:56:51.344774733 +0000
@@ -0,0 +1,56 @@ 
+/* Language-dependent hooks for GNU Modula-2.
+   Copyright (C) 2003-2022 Free Software Foundation, Inc.
+   Contributed by Gaius Mulley <gaius@glam.ac.uk>
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING.  If not, write to
+the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#if !defined(GM2_LANG_H)
+#  define GM2_LANG_H
+
+#if defined(GM2_LANG_C)
+#  define EXTERN
+#else
+#  define EXTERN extern
+#endif
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+#include "coretypes.h"
+#include "opts.h"
+#include "tree.h"
+#include "gimple.h"
+
+
+EXTERN enum gimplify_status  gm2_gimplify_expr (tree *, tree *, tree *);
+EXTERN bool gm2_mark_addressable (tree);
+EXTERN tree gm2_type_for_size             (unsigned int bits, int unsignedp);
+EXTERN tree gm2_type_for_mode             (enum machine_mode mode, int unsignedp);
+EXTERN bool gm2_langhook_init (void);
+EXTERN bool gm2_langhook_handle_option (size_t scode, const char *arg,
+					int value,
+					int kind ATTRIBUTE_UNUSED,
+					location_t loc ATTRIBUTE_UNUSED,
+					const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED);
+EXTERN void gm2_langhook_init_options (unsigned int decoded_options_count,
+					   struct cl_decoded_option *decoded_options);
+EXTERN void gm2_genericize (tree fndecl);
+EXTERN tree convert_loc (location_t location, tree type, tree expr);
+
+
+#undef EXTERN
+#endif
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2version.h
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2version.h	2022-12-06 02:56:51.360774949 +0000
@@ -0,0 +1,22 @@ 
+/* gm2version provides access to the gm2 front end version number.
+
+Copyright (C) 2008-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+extern void gm2_version (int need_to_exit);
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2.flex
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/m2.flex	2022-12-06 02:56:51.360774949 +0000
@@ -0,0 +1,760 @@ 
+%{
+/* m2.flex implements lexical analysis for Modula-2.
+
+Copyright (C) 2004-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "gm2-gcc/gcc-consolidation.h"
+
+#include "GM2Reserved.h"
+#include "GM2LexBuf.h"
+#include "input.h"
+#include "m2options.h"
+
+
+#if defined(GM2USEGGC)
+#  include "ggc.h"
+#endif
+
+#include "timevar.h"
+
+#define START_FILE(F,L)   m2linemap_StartFile(F,L)
+#define END_FILE()        m2linemap_EndFile()
+#define START_LINE(N,S)   m2linemap_StartLine(N,S)
+#define GET_LOCATION(COLUMN_START,COLUMN_END) \
+        m2linemap_GetLocationRange(COLUMN_START,COLUMN_END)
+#define TIMEVAR_PUSH_LEX  timevar_push (TV_LEX)
+#define TIMEVAR_POP_LEX   timevar_pop (TV_LEX)
+
+#ifdef __cplusplus
+#define EXTERN extern "C"
+#endif
+
+  /* m2.flex provides a lexical analyser for GNU Modula-2.  */
+
+  struct lineInfo {
+    char            *linebuf;          /* line contents */
+    int              linelen;          /* length */
+    int              tokenpos;         /* start position of token within line */
+    int              toklen;           /* a copy of yylen (length of token) */
+    int              nextpos;          /* position after token */
+    int              lineno;           /* line number of this line */
+    int              column;           /* first column number of token on this line */
+    int              inuse;            /* do we need to keep this line info? */
+    location_t       location;         /* the corresponding gcc location_t */
+    struct lineInfo *next;
+  };
+
+  struct functionInfo {
+    char                *name;         /* function name */
+    int                  module;       /* is it really a module? */
+    struct functionInfo *next;         /* list of nested functions */
+  };
+
+  static int                  lineno      =1;   /* a running count of the file line number */
+  static char                *filename    =NULL;
+  static int                  commentLevel=0;
+  static struct lineInfo     *currentLine=NULL;
+  static struct functionInfo *currentFunction=NULL;
+  static int                  seenFunctionStart=FALSE;
+  static int                  seenEnd=FALSE;
+  static int                  seenModuleStart=FALSE;
+  static int                  isDefinitionModule=FALSE;
+  static int                  totalLines=0;
+
+static  void pushLine                 (void);
+static  void popLine                  (void);
+static  void finishedLine             (void);
+static  void resetpos                 (void);
+static  void consumeLine              (void);
+static  void updatepos                (void);
+static  void skippos                  (void);
+static  void poperrorskip             (const char *);
+static  void endOfComment             (void);
+static  void handleDate               (void);
+static  void handleLine               (void);
+static  void handleFile               (void);
+static  void handleFunction           (void);
+static  void handleColumn             (void);
+static  void pushFunction             (char *function, int module);
+static  void popFunction              (void);
+static  void checkFunction            (void);
+EXTERN  void m2flex_M2Error           (const char *);
+EXTERN  location_t m2flex_GetLocation (void);
+EXTERN  int  m2flex_GetColumnNo       (void);
+EXTERN  int  m2flex_OpenSource        (char *s);
+EXTERN  int  m2flex_GetLineNo         (void);
+EXTERN  void m2flex_CloseSource       (void);
+EXTERN  char *m2flex_GetToken         (void);
+EXTERN  void _M2_m2flex_init          (void);
+EXTERN  int  m2flex_GetTotalLines     (void);
+extern  void  yylex                   (void);
+
+#if !defined(TRUE)
+#    define TRUE  (1==1)
+#endif
+#if !defined(FALSE)
+#    define FALSE (1==0)
+#endif
+
+#define YY_DECL void yylex (void)
+%}
+
+%option nounput
+%x COMMENT COMMENT1 LINE0 LINE1 LINE2
+
+%%
+
+"(*"                       { updatepos();
+                             commentLevel=1; pushLine(); skippos();
+			     BEGIN COMMENT; }
+<COMMENT>"*)"              { endOfComment(); }
+<COMMENT>"(*"              { commentLevel++; pushLine(); updatepos(); skippos(); }
+<COMMENT>"<*"              { if (commentLevel == 1) {
+                               updatepos();
+                               pushLine();
+                               skippos();
+                               BEGIN COMMENT1;
+                             } else
+                               updatepos(); skippos();
+                           }
+<COMMENT>\n.*              { consumeLine(); }
+<COMMENT>.                 { updatepos(); skippos(); }
+<COMMENT1>.                { updatepos(); skippos(); }
+<COMMENT1>"*>"             { updatepos(); skippos(); finishedLine(); BEGIN COMMENT; }
+<COMMENT1>\n.*             { consumeLine(); }
+<COMMENT1>"*)"             { poperrorskip("unterminated source code directive, missing *>");
+                             endOfComment(); }
+<COMMENT1><<EOF>>          { poperrorskip("unterminated source code directive, missing *>"); BEGIN COMMENT; }
+<COMMENT><<EOF>>           { poperrorskip("unterminated comment found at the end of the file, missing *)"); BEGIN INITIAL; }
+
+^\#.*                      { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
+\n\#.*                     { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; }
+<LINE0>\#[ \t]*            { updatepos(); }
+<LINE0>[0-9]+[ \t]*\"      { updatepos(); lineno=atoi(yytext)-1; BEGIN LINE1; }
+<LINE0>\n                  { m2flex_M2Error("missing initial quote after #line directive"); resetpos(); BEGIN INITIAL; }
+<LINE0>[^\n]
+<LINE1>[^\"\n]+            { m2flex_M2Error("missing final quote after #line directive"); resetpos(); BEGIN INITIAL; }
+<LINE1>.*\"                { updatepos();
+                             filename = (char *)xrealloc(filename, yyleng+1);
+			     strcpy(filename, yytext);
+                             filename[yyleng-1] = (char)0;  /* remove trailing quote */
+                             START_FILE (filename, lineno);
+                             BEGIN LINE2;
+                           }
+<LINE2>[ \t]*              { updatepos(); }
+<LINE2>\n                  { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>2[ \t]*\n           { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>1[ \t]*\n           { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>1[ \t]*.*\n         { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>2[ \t]*.*\n         { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+<LINE2>3[ \t]*.*\n         { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; }
+
+\n[^\#].*                  { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+\n                         { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+
+\"[^\"\n]*\"               { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; }
+\"[^\"\n]*$                { updatepos();
+                             m2flex_M2Error("missing terminating quote, \"");
+                             resetpos(); return;
+                           }
+
+'[^'\n]*'                  { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; }
+'[^'\n]*$                  { updatepos();
+                             m2flex_M2Error("missing terminating quote, '");
+                             resetpos(); return;
+                           }
+
+<<EOF>>                    { updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return; }
+\+                         { updatepos(); M2LexBuf_AddTok(M2Reserved_plustok); return; }
+-                          { updatepos(); M2LexBuf_AddTok(M2Reserved_minustok); return; }
+"*"                        { updatepos(); M2LexBuf_AddTok(M2Reserved_timestok); return; }
+\/                         { updatepos(); M2LexBuf_AddTok(M2Reserved_dividetok); return; }
+:=                         { updatepos(); M2LexBuf_AddTok(M2Reserved_becomestok); return; }
+\&                         { updatepos(); M2LexBuf_AddTok(M2Reserved_ambersandtok); return; }
+\.                         { updatepos(); M2LexBuf_AddTok(M2Reserved_periodtok); return; }
+\,                         { updatepos(); M2LexBuf_AddTok(M2Reserved_commatok); return; }
+\;                         { updatepos(); M2LexBuf_AddTok(M2Reserved_semicolontok); return; }
+\(                         { updatepos(); M2LexBuf_AddTok(M2Reserved_lparatok); return; }
+\)                         { updatepos(); M2LexBuf_AddTok(M2Reserved_rparatok); return; }
+\[                         { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; }
+\]                         { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; }
+\(\!                       { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; }
+\!\)                       { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; }
+\^                         { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; }
+\@                         { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; }
+\{                         { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; }
+\}                         { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; }
+\(\:                       { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; }
+\:\)                       { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; }
+\'                         { updatepos(); M2LexBuf_AddTok(M2Reserved_singlequotetok); return; }
+\=                         { updatepos(); M2LexBuf_AddTok(M2Reserved_equaltok); return; }
+\#                         { updatepos(); M2LexBuf_AddTok(M2Reserved_hashtok); return; }
+\<                         { updatepos(); M2LexBuf_AddTok(M2Reserved_lesstok); return; }
+\>                         { updatepos(); M2LexBuf_AddTok(M2Reserved_greatertok); return; }
+\<\>                       { updatepos(); M2LexBuf_AddTok(M2Reserved_lessgreatertok); return; }
+\<\=                       { updatepos(); M2LexBuf_AddTok(M2Reserved_lessequaltok); return; }
+\>\=                       { updatepos(); M2LexBuf_AddTok(M2Reserved_greaterequaltok); return; }
+"<*"                       { updatepos(); M2LexBuf_AddTok(M2Reserved_ldirectivetok); return; }
+"*>"                       { updatepos(); M2LexBuf_AddTok(M2Reserved_rdirectivetok); return; }
+\.\.                       { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodtok); return; }
+\.\.\.                     { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodperiodtok); return; }
+\:                         { updatepos(); M2LexBuf_AddTok(M2Reserved_colontok); return; }
+\"                         { updatepos(); M2LexBuf_AddTok(M2Reserved_doublequotestok); return; }
+\|                         { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; }
+\!                         { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; }
+\~                         { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; }
+AND                        { updatepos(); M2LexBuf_AddTok(M2Reserved_andtok); return; }
+ARRAY                      { updatepos(); M2LexBuf_AddTok(M2Reserved_arraytok); return; }
+BEGIN                      { updatepos(); M2LexBuf_AddTok(M2Reserved_begintok); return; }
+BY                         { updatepos(); M2LexBuf_AddTok(M2Reserved_bytok); return; }
+CASE                       { updatepos(); M2LexBuf_AddTok(M2Reserved_casetok); return; }
+CONST                      { updatepos(); M2LexBuf_AddTok(M2Reserved_consttok); return; }
+DEFINITION                 { updatepos(); isDefinitionModule = TRUE;
+                             M2LexBuf_AddTok(M2Reserved_definitiontok); return; }
+DIV                        { updatepos(); M2LexBuf_AddTok(M2Reserved_divtok); return; }
+DO                         { updatepos(); M2LexBuf_AddTok(M2Reserved_dotok); return; }
+ELSE                       { updatepos(); M2LexBuf_AddTok(M2Reserved_elsetok); return; }
+ELSIF                      { updatepos(); M2LexBuf_AddTok(M2Reserved_elsiftok); return; }
+END                        { updatepos(); seenEnd=TRUE;
+                             M2LexBuf_AddTok(M2Reserved_endtok); return; }
+EXCEPT                     { updatepos(); M2LexBuf_AddTok(M2Reserved_excepttok); return; }
+EXIT                       { updatepos(); M2LexBuf_AddTok(M2Reserved_exittok); return; }
+EXPORT                     { updatepos(); M2LexBuf_AddTok(M2Reserved_exporttok); return; }
+FINALLY                    { updatepos(); M2LexBuf_AddTok(M2Reserved_finallytok); return; }
+FOR                        { updatepos(); M2LexBuf_AddTok(M2Reserved_fortok); return; }
+FROM                       { updatepos(); M2LexBuf_AddTok(M2Reserved_fromtok); return; }
+IF                         { updatepos(); M2LexBuf_AddTok(M2Reserved_iftok); return; }
+IMPLEMENTATION             { updatepos(); M2LexBuf_AddTok(M2Reserved_implementationtok); return; }
+IMPORT                     { updatepos(); M2LexBuf_AddTok(M2Reserved_importtok); return; }
+IN                         { updatepos(); M2LexBuf_AddTok(M2Reserved_intok); return; }
+LOOP                       { updatepos(); M2LexBuf_AddTok(M2Reserved_looptok); return; }
+MOD                        { updatepos(); M2LexBuf_AddTok(M2Reserved_modtok); return; }
+MODULE                     { updatepos(); seenModuleStart=TRUE;
+                             M2LexBuf_AddTok(M2Reserved_moduletok); return; }
+NOT                        { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; }
+OF                         { updatepos(); M2LexBuf_AddTok(M2Reserved_oftok); return; }
+OR                         { updatepos(); M2LexBuf_AddTok(M2Reserved_ortok); return; }
+PACKEDSET                  { updatepos(); M2LexBuf_AddTok(M2Reserved_packedsettok); return; }
+POINTER                    { updatepos(); M2LexBuf_AddTok(M2Reserved_pointertok); return; }
+PROCEDURE                  { updatepos(); seenFunctionStart=TRUE;
+                             M2LexBuf_AddTok(M2Reserved_proceduretok); return; }
+QUALIFIED                  { updatepos(); M2LexBuf_AddTok(M2Reserved_qualifiedtok); return; }
+UNQUALIFIED                { updatepos(); M2LexBuf_AddTok(M2Reserved_unqualifiedtok); return; }
+RECORD                     { updatepos(); M2LexBuf_AddTok(M2Reserved_recordtok); return; }
+REM                        { updatepos(); M2LexBuf_AddTok(M2Reserved_remtok); return; }
+REPEAT                     { updatepos(); M2LexBuf_AddTok(M2Reserved_repeattok); return; }
+RETRY                      { updatepos(); M2LexBuf_AddTok(M2Reserved_retrytok); return; }
+RETURN                     { updatepos(); M2LexBuf_AddTok(M2Reserved_returntok); return; }
+SET                        { updatepos(); M2LexBuf_AddTok(M2Reserved_settok); return; }
+THEN                       { updatepos(); M2LexBuf_AddTok(M2Reserved_thentok); return; }
+TO                         { updatepos(); M2LexBuf_AddTok(M2Reserved_totok); return; }
+TYPE                       { updatepos(); M2LexBuf_AddTok(M2Reserved_typetok); return; }
+UNTIL                      { updatepos(); M2LexBuf_AddTok(M2Reserved_untiltok); return; }
+VAR                        { updatepos(); M2LexBuf_AddTok(M2Reserved_vartok); return; }
+WHILE                      { updatepos(); M2LexBuf_AddTok(M2Reserved_whiletok); return; }
+WITH                       { updatepos(); M2LexBuf_AddTok(M2Reserved_withtok); return; }
+ASM                        { updatepos(); M2LexBuf_AddTok(M2Reserved_asmtok); return; }
+VOLATILE                   { updatepos(); M2LexBuf_AddTok(M2Reserved_volatiletok); return; }
+\_\_DATE\_\_               { updatepos(); handleDate(); return; }
+\_\_LINE\_\_               { updatepos(); handleLine(); return; }
+\_\_FILE\_\_               { updatepos(); handleFile(); return; }
+\_\_FUNCTION\_\_           { updatepos(); handleFunction(); return; }
+\_\_COLUMN\_\_             { updatepos(); handleColumn(); return; }
+\_\_ATTRIBUTE\_\_          { updatepos(); M2LexBuf_AddTok(M2Reserved_attributetok); return; }
+\_\_BUILTIN\_\_            { updatepos(); M2LexBuf_AddTok(M2Reserved_builtintok); return; }
+\_\_INLINE\_\_             { updatepos(); M2LexBuf_AddTok(M2Reserved_inlinetok); return; }
+
+
+(([0-9]*\.[0-9]+)(E[+-]?[0-9]+)?) { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
+[0-9]*\.E[+-]?[0-9]+       { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; }
+[a-zA-Z_][a-zA-Z0-9_]*     { checkFunction(); updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_identtok, yytext); return; }
+[0-9]+                     { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9]+B                    { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9]+C                    { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[0-9A-F]+H                 { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; }
+[\t\r ]+                   { currentLine->tokenpos += yyleng;  /* Ignore space.  */; }
+.                          { updatepos(); m2flex_M2Error("unrecognised symbol"); skippos(); }
+
+%%
+
+/* have removed the -? from the beginning of the real/integer constant literal rules */
+
+/*
+ *  hand built routines
+ */
+
+/*
+ *  handleFile - handles the __FILE__ construct by wraping it in double quotes and putting
+ *               it into the token buffer as a string.
+ */
+
+static void handleFile (void)
+{
+  char *s = (char *)alloca(strlen(filename)+2+1);
+
+  strcpy(s, "\"");
+  strcat(s, filename);
+  strcat(s, "\"");
+  M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+}
+
+/*
+ *  handleLine - handles the __LINE__ construct by passing an integer to
+ *               the token buffer.
+ */
+
+static void handleLine (void)
+{
+  M2LexBuf_AddTokInteger(M2Reserved_integertok, lineno);
+}
+
+/*
+ *  handleColumn - handles the __COLUMN__ construct by passing an integer to
+ *                 the token buffer.
+ */
+
+static void handleColumn (void)
+{
+  M2LexBuf_AddTokInteger(M2Reserved_integertok, m2flex_GetColumnNo());
+}
+
+/*
+ *  handleDate - handles the __DATE__ construct by passing the date
+ *               as a string to the token buffer.
+ */
+
+static void handleDate (void)
+{
+  time_t  clock = time ((time_t *)0);
+  char   *sdate = ctime (&clock);
+  char   *s     = (char *) alloca (strlen (sdate) + 2 + 1);
+  char   *p     = index (sdate, '\n');
+
+  if (p != NULL) {
+    *p = (char) 0;
+  }
+  strcpy(s, "\"");
+  strcat(s, sdate);
+  strcat(s, "\"");
+  M2LexBuf_AddTokCharStar (M2Reserved_stringtok, s);
+}
+
+/*
+ *  handleFunction - handles the __FUNCTION__ construct by wrapping
+ *                   it in double quotes and putting it into the token
+ *                   buffer as a string.
+ */
+
+static void handleFunction (void)
+{
+  if (currentFunction == NULL)
+    M2LexBuf_AddTokCharStar(M2Reserved_stringtok, const_cast<char *>("\"\""));
+  else if (currentFunction->module) {
+    char *s = (char *) alloca(strlen(yytext) +
+			      strlen("\"module  initialization\"") + 1);
+    strcpy(s, "\"module ");
+    strcat(s, currentFunction->name);
+    strcat(s, " initialization\"");
+    M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+  } else {
+    char *function = currentFunction->name;
+    char *s = (char *)alloca(strlen(function)+2+1);
+    strcpy(s, "\"");
+    strcat(s, function);
+    strcat(s, "\"");
+    M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s);
+  }
+}
+
+/*
+ *  pushFunction - pushes the function name onto the stack.
+ */
+
+static void pushFunction (char *function, int module)
+{
+  if (currentFunction == NULL) {
+    currentFunction = (struct functionInfo *)xmalloc (sizeof (struct functionInfo));
+    currentFunction->name = xstrdup(function);
+    currentFunction->next = NULL;
+    currentFunction->module = module;
+  } else {
+    struct functionInfo *f = (struct functionInfo *)xmalloc (sizeof (struct functionInfo));
+    f->name = xstrdup(function);
+    f->next = currentFunction;
+    f->module = module;
+    currentFunction = f;
+  }
+}
+
+/*
+ *  popFunction - pops the current function.
+ */
+
+static void popFunction (void)
+{
+  if (currentFunction != NULL && currentFunction->next != NULL) {
+    struct functionInfo *f = currentFunction;
+
+    currentFunction = currentFunction->next;
+    if (f->name != NULL)
+      free(f->name);
+    free(f);
+  }
+}
+
+/*
+ *  endOfComment - handles the end of comment
+ */
+
+static void endOfComment (void)
+{
+  commentLevel--;
+  updatepos();
+  skippos();
+  if (commentLevel==0) {
+    BEGIN INITIAL;
+    finishedLine();
+  } else
+    popLine();
+}
+
+/*
+ *  m2flex_M2Error - displays the error message, s, after the code line and pointer
+ *                   to the erroneous token.
+ */
+
+EXTERN void m2flex_M2Error (const char *s)
+{
+  if (currentLine->linebuf != NULL) {
+    int i=1;
+
+    printf("%s:%d:%s\n", filename, currentLine->lineno, currentLine->linebuf);
+    printf("%s:%d:%*s", filename, currentLine->lineno, 1+currentLine->tokenpos, "^");
+    while (i<currentLine->toklen) {
+      putchar('^');
+      i++;
+    }
+    putchar('\n');
+  }
+  printf("%s:%d:%s\n", filename, currentLine->lineno, s);
+}
+
+static void poperrorskip (const char *s)
+{
+  int nextpos =currentLine->nextpos;
+  int tokenpos=currentLine->tokenpos;
+
+  popLine();
+  m2flex_M2Error(s);
+  if (currentLine != NULL) {
+    currentLine->nextpos  = nextpos;
+    currentLine->tokenpos = tokenpos;
+  }
+}
+
+/*
+ *  consumeLine - reads a line into a buffer, it then pushes back the whole
+ *                line except the initial \n.
+ */
+
+static void consumeLine (void)
+{
+  if (currentLine->linelen<yyleng) {
+    currentLine->linebuf = (char *)xrealloc (currentLine->linebuf, yyleng);
+    currentLine->linelen = yyleng;
+  }
+  strcpy(currentLine->linebuf, yytext+1);  /* copy all except the initial \n */
+  lineno++;
+  totalLines++;
+  currentLine->lineno = lineno;
+  currentLine->tokenpos=0;
+  currentLine->nextpos=0;
+  currentLine->column=0;
+  START_LINE (lineno, yyleng);
+  yyless(1);                  /* push back all but the \n */
+}
+
+static void assert_location (location_t location ATTRIBUTE_UNUSED)
+{
+#if 0
+  if ((location != BUILTINS_LOCATION) && (location != UNKNOWN_LOCATION) && (! M2Options_GetCpp ())) {
+     expanded_location xl = expand_location (location);
+     if (xl.line != currentLine->lineno) {
+       m2flex_M2Error ("mismatched gcc location and front end token number");
+     }
+  }
+#endif
+}
+
+/*
+ *  updatepos - updates the current token position.
+ *              Should be used when a rule matches a token.
+ */
+
+static void updatepos (void)
+{
+  seenFunctionStart    = FALSE;
+  seenEnd              = FALSE;
+  seenModuleStart      = FALSE;
+  currentLine->nextpos = currentLine->tokenpos+yyleng;
+  currentLine->toklen  = yyleng;
+  /* if (currentLine->column == 0) */
+  currentLine->column = currentLine->tokenpos+1;
+  currentLine->location =
+    M2Options_OverrideLocation (GET_LOCATION (currentLine->column,
+                                              currentLine->column+currentLine->toklen-1));
+  assert_location (GET_LOCATION (currentLine->column,
+                                 currentLine->column+currentLine->toklen-1));
+}
+
+/*
+ *  checkFunction - checks to see whether we have seen the start
+ *                  or end of a function.
+ */
+
+static void checkFunction (void)
+{
+  if (! isDefinitionModule) {
+    if (seenModuleStart)
+      pushFunction(yytext, 1);
+    if (seenFunctionStart)
+      pushFunction(yytext, 0);
+    if (seenEnd && currentFunction != NULL &&
+	(strcmp(currentFunction->name, yytext) == 0))
+      popFunction();
+  }
+  seenFunctionStart = FALSE;
+  seenEnd           = FALSE;
+  seenModuleStart   = FALSE;
+}
+
+/*
+ *  skippos - skips over this token. This function should be called
+ *            if we are not returning and thus not calling getToken.
+ */
+
+static void skippos (void)
+{
+  currentLine->tokenpos = currentLine->nextpos;
+}
+
+/*
+ *  initLine - initializes a currentLine
+ */
+
+static void initLine (void)
+{
+  currentLine = (struct lineInfo *)xmalloc (sizeof(struct lineInfo));
+
+  if (currentLine == NULL)
+    perror("xmalloc");
+  currentLine->linebuf    = NULL;
+  currentLine->linelen    = 0;
+  currentLine->tokenpos   = 0;
+  currentLine->toklen     = 0;
+  currentLine->nextpos    = 0;
+  currentLine->lineno = lineno;
+  currentLine->column     = 0;
+  currentLine->inuse      = TRUE;
+  currentLine->next       = NULL;
+}
+
+/*
+ *  pushLine - pushes a new line structure.
+ */
+
+static void pushLine (void)
+{
+  if (currentLine == NULL)
+    initLine();
+  else if (currentLine->inuse) {
+      struct lineInfo *l = (struct lineInfo *)xmalloc (sizeof(struct lineInfo));
+
+      if (currentLine->linebuf == NULL) {
+	l->linebuf  = NULL;
+	l->linelen  = 0;
+      } else {
+	l->linebuf    = (char *)xstrdup (currentLine->linebuf);
+	l->linelen    = strlen (l->linebuf)+1;
+      }
+      l->tokenpos   = currentLine->tokenpos;
+      l->toklen     = currentLine->toklen;
+      l->nextpos    = currentLine->nextpos;
+      l->lineno = currentLine->lineno;
+      l->column     = currentLine->column;
+      l->next       = currentLine;
+      currentLine   = l;
+  }
+  currentLine->inuse = TRUE;
+}
+
+/*
+ *  popLine - pops a line structure.
+ */
+
+static void popLine (void)
+{
+  if (currentLine != NULL) {
+    struct lineInfo *l = currentLine;
+
+    if (currentLine->linebuf != NULL)
+      free(currentLine->linebuf);
+    currentLine = l->next;
+    free(l);
+  }
+}
+
+/*
+ *  resetpos - resets the position of the next token to the start of the line.
+ */
+
+static void resetpos (void)
+{
+  if (currentLine != NULL)
+    currentLine->nextpos = 0;
+}
+
+/*
+ *  finishedLine - indicates that the current line does not need to be preserved when a pushLine
+ *                 occurs.
+ */
+
+static void finishedLine (void)
+{
+  currentLine->inuse = FALSE;
+}
+
+/*
+ *  m2flex_GetToken - returns a new token.
+ */
+
+EXTERN char *m2flex_GetToken (void)
+{
+  TIMEVAR_PUSH_LEX;
+  if (currentLine == NULL)
+    initLine();
+  currentLine->tokenpos = currentLine->nextpos;
+  yylex();
+  TIMEVAR_POP_LEX;
+  return yytext;
+}
+
+/*
+ *  CloseSource - provided for semantic sugar
+ */
+
+EXTERN void m2flex_CloseSource (void)
+{
+  END_FILE ();
+}
+
+/*
+ *  OpenSource - returns TRUE if file s can be opened and
+ *               all tokens are taken from this file.
+ */
+
+EXTERN int m2flex_OpenSource (char *s)
+{
+  FILE *f = fopen(s, "r");
+
+  if (f == NULL)
+    return( FALSE );
+  else {
+    isDefinitionModule = FALSE;
+    while (currentFunction != NULL)
+      {
+	struct functionInfo *f = currentFunction;
+        currentFunction = f->next;
+        if (f->name != NULL)
+  	  free(f->name);
+      	free(f);
+      }
+    yy_delete_buffer (YY_CURRENT_BUFFER);
+    yy_switch_to_buffer (yy_create_buffer(f, YY_BUF_SIZE));
+    filename = xstrdup (s);
+    lineno = 1;
+    if (currentLine == NULL)
+      pushLine ();
+    else
+      currentLine->lineno = lineno;
+    START_FILE (filename, lineno);
+    BEGIN INITIAL; resetpos ();
+    return TRUE;
+  }
+}
+
+/*
+ *  m2flex_GetLineNo - returns the current line number.
+ */
+
+EXTERN int m2flex_GetLineNo (void)
+{
+  if (currentLine != NULL)
+    return currentLine->lineno;
+  else
+    return 0;
+}
+
+/*
+ *  m2flex_GetColumnNo - returns the column where the current
+ *                       token starts.
+ */
+
+EXTERN int m2flex_GetColumnNo (void)
+{
+  if (currentLine != NULL)
+    return currentLine->column;
+  else
+    return 0;
+}
+
+/*
+ *  m2flex_GetLocation - returns the gcc location_t of the current token.
+ */
+
+EXTERN location_t m2flex_GetLocation (void)
+{
+  if (currentLine != NULL)
+    return currentLine->location;
+  else
+    return 0;
+}
+
+/*
+ *  GetTotalLines - returns the total number of lines parsed.
+ */
+
+EXTERN int m2flex_GetTotalLines (void)
+{
+  return totalLines;
+}
+
+/*
+ *  yywrap is called when end of file is seen. We push an eof token
+ *         and tell the lexical analysis to stop.
+ */
+
+int yywrap (void)
+{
+  updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return 1;
+}
+
+EXTERN void _M2_m2flex_init (void) {}
+EXTERN void _M2_m2flex_finish (void) {}
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2pp.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/m2pp.cc	2022-12-06 02:56:51.360774949 +0000
@@ -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));
+}
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2pp.h
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/m2pp.h	2022-12-06 02:56:51.360774949 +0000
@@ -0,0 +1,42 @@ 
+/* m2pp.h pretty print trees, output in Modula-2 where possible.
+
+Copyright (C) 2007-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#if !defined(M2PP_H)
+#   define M2PP_H
+
+#   if defined(M2PP_C)
+#      define EXTERN
+#   else
+#      define EXTERN extern
+#   endif
+
+/* These functions allow a maintainer to dump the trees in Modula-2.  */
+
+EXTERN void pf (tree t);
+EXTERN void pe (tree t);
+EXTERN void pt (tree t);
+EXTERN void ptl (tree t);
+EXTERN void pv (tree t);
+EXTERN void ptcl (tree t);
+
+
+#   undef EXTERN
+#endif
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2-tree.def
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/m2-tree.def	2022-12-06 02:56:51.360774949 +0000
@@ -0,0 +1,24 @@ 
+/* gm2-tree.def a component of a C header file used to define a SET type.
+
+Copyright (C) 2006-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING.  If not, write to the
+Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
+
+/* A SET_TYPE type.  */
+DEFTREECODE (SET_TYPE, "set_type", tcc_type, 0)
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2-tree.h
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/m2-tree.h	2022-12-06 02:56:51.360774949 +0000
@@ -0,0 +1,48 @@ 
+/* m2-tree.h create language specific tree nodes for Modula-2.
+
+Copyright (C) 2001-2022 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius@glam.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GCC_GM2_TREE_H
+#define GCC_GM2_TREE_H
+
+#include "ggc.h"
+#include "function.h"
+#include "hashtab.h"
+#include "vec.h"
+
+/* These macros provide convenient access to the various statement nodes.  */
+
+#define TRY_STMTS(NODE)		TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 0)
+#define TRY_HANDLERS(NODE)	TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 1)
+
+/* Nonzero if this try block is a function try block.  */
+#define FN_TRY_BLOCK_P(NODE)	TREE_LANG_FLAG_3 (TRY_BLOCK_CHECK (NODE))
+#define HANDLER_PARMS(NODE)	TREE_OPERAND (HANDLER_CHECK (NODE), 0)
+#define HANDLER_BODY(NODE)	TREE_OPERAND (HANDLER_CHECK (NODE), 1)
+#define HANDLER_TYPE(NODE)	TREE_TYPE (HANDLER_CHECK (NODE))
+
+/* STMT_EXPR accessor.  */
+#define STMT_EXPR_STMT(NODE)	TREE_OPERAND (STMT_EXPR_CHECK (NODE), 0)
+
+/* EXPR_STMT accessor.  This gives the expression associated with an
+   expression statement.  */
+#define EXPR_STMT_EXPR(NODE)	TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0)
+
+#endif
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/version.c
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/version.c	2022-12-06 02:56:51.380775219 +0000
@@ -0,0 +1 @@ 
+#define version_string  "1.9.5"