11/19 modula2 front end: gimple interface *[a-d]*.cc

Message ID E1ohukU-00Bm2V-Q5@lancelot
State Accepted, archived
Headers
Series 11/19 modula2 front end: gimple interface *[a-d]*.cc |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Gaius Mulley Oct. 10, 2022, 3:31 p.m. UTC
  This patchset contains the gimple interface.

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

Patch

diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2assert.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2assert.cc	2022-10-07 20:21:18.650096940 +0100
@@ -0,0 +1,41 @@ 
+/* m2assert.cc provides a simple assertion for location.
+
+Copyright (C) 2012-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/>.  */
+
+#include "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2assert_c
+#include "m2assert.h"
+#include "m2options.h"
+
+void
+m2assert_AssertLocation (location_t location)
+{
+  /* Internally the compiler will use unknown location and
+     builtins_location so we ignore these values.  */
+  if (location == BUILTINS_LOCATION || location == UNKNOWN_LOCATION)
+    return;
+
+  if (M2Options_OverrideLocation (location) != location)
+    internal_error ("the location value is corrupt");
+}
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2block.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2block.cc	2022-10-07 20:21:18.650096940 +0100
@@ -0,0 +1,770 @@ 
+/* m2block.cc provides an interface to maintaining block structures.
+
+Copyright (C) 2012-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/>.  */
+
+#include "gcc-consolidation.h"
+
+#define m2block_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2decl.h"
+#include "m2options.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+
+/* For each binding contour we allocate a binding_level structure
+   which records the entities defined or declared in that contour.
+   Contours include:
+
+   the global one one for each subprogram definition
+
+   Binding contours are used to create GCC tree BLOCK nodes.  */
+
+struct GTY (()) binding_level
+{
+  /* The function associated with the scope.  This is NULL_TREE for the
+     global scope.  */
+  tree fndecl;
+
+  /* A chain of _DECL nodes for all variables, constants, functions,
+     and typedef types.  These are in the reverse of the order supplied.  */
+  tree names;
+
+  /* A boolean to indicate whether this is binding level is a global ie
+     outer module scope.  In which case fndecl will be NULL_TREE.  */
+  int is_global;
+
+  /* The context of the binding level, for a function binding level
+     this will be the same as fndecl, however for a global binding level
+     this is a translation_unit.  */
+  tree context;
+
+  /* The binding level below this one.  This field is only used when
+     the binding level has been pushed by pushFunctionScope.  */
+  struct binding_level *next;
+
+  /* All binding levels are placed onto this list.  */
+  struct binding_level *list;
+
+  /* A varray of trees, which represent the list of statement
+     sequences.  */
+  vec<tree, va_gc> *m2_statements;
+
+  /* A list of constants (only kept in the global binding level).
+     Constants need to be kept through the life of the compilation, as the
+     same constants can be used in any scope.  */
+  tree constants;
+
+  /* A list of inner module initialization functions.  */
+  tree init_functions;
+
+  /* A list of types created by M2GCCDeclare prior to code generation
+     and those which may not be specifically declared and saved via a
+     push_decl.  */
+  tree types;
+
+  /* A list of all DECL_EXPR created within this binding level.  This
+     will be prepended to the statement list once the binding level (scope
+     is finished).  */
+  tree decl;
+
+  /* A list of labels which have been created in this scope.  */
+  tree labels;
+
+  /* The number of times this level has been pushed.  */
+  int count;
+};
+
+/* The binding level currently in effect.  */
+
+static GTY (()) struct binding_level *current_binding_level;
+
+/* The outermost binding level, for names of file scope.  This is
+   created when the compiler is started and exists through the entire
+   run.  */
+
+static GTY (()) struct binding_level *global_binding_level;
+
+/* The head of the binding level lists.  */
+static GTY (()) struct binding_level *head_binding_level;
+
+/* The current statement tree.  */
+
+typedef struct stmt_tree_s *stmt_tree_t;
+
+#undef DEBUGGING
+
+static location_t pending_location;
+static int pending_statement = FALSE;
+
+/* assert_global_names asserts that the global_binding_level->names
+   can be chained.  */
+
+static void
+assert_global_names (void)
+{
+  tree p = global_binding_level->names;
+
+  while (p)
+    p = TREE_CHAIN (p);
+}
+
+/* lookupLabel return label tree in current scope, otherwise
+   NULL_TREE.  */
+
+static tree
+lookupLabel (tree id)
+{
+  tree t;
+
+  for (t = current_binding_level->labels; t != NULL_TREE; t = TREE_CHAIN (t))
+    {
+      tree l = TREE_VALUE (t);
+
+      if (id == DECL_NAME (l))
+        return l;
+    }
+  return NULL_TREE;
+}
+
+/* getLabel return the label name or create a label name in the
+   current scope.  */
+
+tree
+m2block_getLabel (location_t location, char *name)
+{
+  tree id = get_identifier (name);
+  tree label = lookupLabel (id);
+
+  if (label == NULL_TREE)
+    {
+      label = build_decl (location, LABEL_DECL, id, void_type_node);
+      current_binding_level->labels
+          = tree_cons (NULL_TREE, label, current_binding_level->labels);
+    }
+  if (DECL_CONTEXT (label) == NULL_TREE)
+    DECL_CONTEXT (label) = current_function_decl;
+  ASSERT ((DECL_CONTEXT (label) == current_function_decl),
+          current_function_decl);
+
+  DECL_MODE (label) = VOIDmode;
+  return label;
+}
+
+static void
+init_binding_level (struct binding_level *l)
+{
+  l->fndecl = NULL;
+  l->names = NULL;
+  l->is_global = 0;
+  l->context = NULL;
+  l->next = NULL;
+  l->list = NULL;
+  vec_alloc (l->m2_statements, 1);
+  l->constants = NULL;
+  l->init_functions = NULL;
+  l->types = NULL;
+  l->decl = NULL;
+  l->labels = NULL;
+  l->count = 0;
+}
+
+static struct binding_level *
+newLevel (void)
+{
+  struct binding_level *newlevel = ggc_alloc<binding_level> ();
+
+  init_binding_level (newlevel);
+
+  /* Now we a push_statement_list.  */
+  vec_safe_push (newlevel->m2_statements, m2block_begin_statement_list ());
+  return newlevel;
+}
+
+tree *
+m2block_cur_stmt_list_addr (void)
+{
+  ASSERT_CONDITION (current_binding_level != NULL);
+  int l = vec_safe_length (current_binding_level->m2_statements) - 1;
+
+  return &(*current_binding_level->m2_statements)[l];
+}
+
+tree
+m2block_cur_stmt_list (void)
+{
+  tree *t = m2block_cur_stmt_list_addr ();
+
+  return *t;
+}
+
+/* is_building_stmt_list returns TRUE if we are building a
+   statement list.  TRUE is returned if we are in a binding level and
+   a statement list is under construction.  */
+
+int
+m2block_is_building_stmt_list (void)
+{
+  ASSERT_CONDITION (current_binding_level != NULL);
+  return !vec_safe_is_empty (current_binding_level->m2_statements);
+}
+
+/* push_statement_list pushes the statement list t onto the
+   current binding level.  */
+
+tree
+m2block_push_statement_list (tree t)
+{
+  ASSERT_CONDITION (current_binding_level != NULL);
+  vec_safe_push (current_binding_level->m2_statements, t);
+  return t;
+}
+
+/* pop_statement_list pops and returns a statement list from the
+   current binding level.  */
+
+tree
+m2block_pop_statement_list (void)
+{
+  ASSERT_CONDITION (current_binding_level != NULL);
+  {
+    tree t = current_binding_level->m2_statements->pop ();
+
+    return t;
+  }
+}
+
+/* begin_statement_list starts a tree statement.  It pushes the
+   statement list and returns the list node.  */
+
+tree
+m2block_begin_statement_list (void)
+{
+  return alloc_stmt_list ();
+}
+
+/* findLevel returns the binding level associated with fndecl one
+   is created if there is no existing one on head_binding_level.  */
+
+static struct binding_level *
+findLevel (tree fndecl)
+{
+  struct binding_level *b;
+
+  if (fndecl == NULL_TREE)
+    return global_binding_level;
+
+  b = head_binding_level;
+  while ((b != NULL) && (b->fndecl != fndecl))
+    b = b->list;
+
+  if (b == NULL)
+    {
+      b = newLevel ();
+      b->fndecl = fndecl;
+      b->context = fndecl;
+      b->is_global = FALSE;
+      b->list = head_binding_level;
+      b->next = NULL;
+    }
+  return b;
+}
+
+/* pushFunctionScope push a binding level.  */
+
+void
+m2block_pushFunctionScope (tree fndecl)
+{
+  struct binding_level *n;
+  struct binding_level *b;
+
+#if defined(DEBUGGING)
+  if (fndecl != NULL)
+    printf ("pushFunctionScope\n");
+#endif
+
+  /* Allow multiple consecutive pushes of the same scope.  */
+
+  if (current_binding_level != NULL
+      && (current_binding_level->fndecl == fndecl))
+    {
+      current_binding_level->count++;
+      return;
+    }
+
+  /* Firstly check to see that fndecl is not already on the binding
+     stack.  */
+
+  for (b = current_binding_level; b != NULL; b = b->next)
+    /* Only allowed one instance of the binding on the stack at a time.  */
+    ASSERT_CONDITION (b->fndecl != fndecl);
+
+  n = findLevel (fndecl);
+
+  /* Add this level to the front of the stack.  */
+  n->next = current_binding_level;
+  current_binding_level = n;
+}
+
+/* popFunctionScope - pops a binding level, returning the function
+   associated with the binding level.  */
+
+tree
+m2block_popFunctionScope (void)
+{
+  tree fndecl = current_binding_level->fndecl;
+
+#if defined(DEBUGGING)
+  if (fndecl != NULL)
+    printf ("popFunctionScope\n");
+#endif
+
+  if (current_binding_level->count > 0)
+    {
+      /* Multiple pushes have occurred of the same function scope (and
+         ignored), pop them likewise.  */
+      current_binding_level->count--;
+      return fndecl;
+    }
+  ASSERT_CONDITION (current_binding_level->fndecl
+                    != NULL_TREE); /* Expecting local scope.  */
+
+  ASSERT_CONDITION (current_binding_level->constants
+                    == NULL_TREE); /* Should not be used.  */
+  ASSERT_CONDITION (current_binding_level->names
+                    == NULL_TREE); /* Should be cleared.  */
+  ASSERT_CONDITION (current_binding_level->decl
+                    == NULL_TREE); /* Should be cleared.  */
+
+  current_binding_level = current_binding_level->next;
+  return fndecl;
+}
+
+/* pushGlobalScope push the global scope onto the binding level
+   stack.  There can only ever be one instance of the global binding
+   level on the stack.  */
+
+void
+m2block_pushGlobalScope (void)
+{
+#if defined(DEBUGGING)
+  printf ("pushGlobalScope\n");
+#endif
+  m2block_pushFunctionScope (NULL_TREE);
+}
+
+/* popGlobalScope pops the current binding level, it expects this
+   binding level to be the global binding level.  */
+
+void
+m2block_popGlobalScope (void)
+{
+  ASSERT_CONDITION (
+      current_binding_level->is_global);  /* Expecting global scope.  */
+  ASSERT_CONDITION (current_binding_level == global_binding_level);
+
+  if (current_binding_level->count > 0)
+    {
+      current_binding_level->count--;
+      return;
+    }
+
+  current_binding_level = current_binding_level->next;
+#if defined(DEBUGGING)
+  printf ("popGlobalScope\n");
+#endif
+
+  assert_global_names ();
+}
+
+/* finishFunctionDecl removes declarations from the current binding
+   level and places them inside fndecl.  The current binding level is
+   then able to be destroyed by a call to popFunctionScope.
+
+   The extra tree nodes associated with fndecl will be created such
+   as BIND_EXPR, BLOCK and the initial STATEMENT_LIST containing the
+   DECL_EXPR is also created.  */
+
+void
+m2block_finishFunctionDecl (location_t location, tree fndecl)
+{
+  tree context = current_binding_level->context;
+  tree block = DECL_INITIAL (fndecl);
+  tree bind_expr = DECL_SAVED_TREE (fndecl);
+  tree i;
+
+  if (block == NULL_TREE)
+    {
+      block = make_node (BLOCK);
+      DECL_INITIAL (fndecl) = block;
+      TREE_USED (block) = TRUE;
+      BLOCK_SUBBLOCKS (block) = NULL_TREE;
+    }
+  BLOCK_SUPERCONTEXT (block) = context;
+
+  BLOCK_VARS (block)
+      = chainon (BLOCK_VARS (block), current_binding_level->names);
+  TREE_USED (fndecl) = TRUE;
+
+  if (bind_expr == NULL_TREE)
+    {
+      bind_expr
+          = build3 (BIND_EXPR, void_type_node, current_binding_level->names,
+                    current_binding_level->decl, block);
+      DECL_SAVED_TREE (fndecl) = bind_expr;
+    }
+  else
+    {
+      if (!chain_member (current_binding_level->names,
+                         BIND_EXPR_VARS (bind_expr)))
+        {
+          BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr),
+                                                current_binding_level->names);
+
+          if (current_binding_level->names != NULL_TREE)
+            {
+              for (i = current_binding_level->names; i != NULL_TREE;
+                   i = DECL_CHAIN (i))
+                append_to_statement_list_force (i,
+                                                &BIND_EXPR_BODY (bind_expr));
+
+            }
+        }
+    }
+  SET_EXPR_LOCATION (bind_expr, location);
+
+  current_binding_level->names = NULL_TREE;
+  current_binding_level->decl = NULL_TREE;
+}
+
+/* finishFunctionCode adds cur_stmt_list to fndecl.  The current
+   binding level is then able to be destroyed by a call to
+   popFunctionScope.  The cur_stmt_list is appended to the
+   STATEMENT_LIST.  */
+
+void
+m2block_finishFunctionCode (tree fndecl)
+{
+  tree bind_expr;
+  tree block;
+  tree statements = m2block_pop_statement_list ();
+  tree_stmt_iterator i;
+
+  ASSERT_CONDITION (DECL_SAVED_TREE (fndecl) != NULL_TREE);
+
+  bind_expr = DECL_SAVED_TREE (fndecl);
+  ASSERT_CONDITION (TREE_CODE (bind_expr) == BIND_EXPR);
+
+  block = DECL_INITIAL (fndecl);
+  ASSERT_CONDITION (TREE_CODE (block) == BLOCK);
+
+  if (current_binding_level->names != NULL_TREE)
+    {
+      BIND_EXPR_VARS (bind_expr)
+          = chainon (BIND_EXPR_VARS (bind_expr), current_binding_level->names);
+      current_binding_level->names = NULL_TREE;
+    }
+  if (current_binding_level->labels != NULL_TREE)
+    {
+      tree t;
+
+      for (t = current_binding_level->labels; t != NULL_TREE;
+           t = TREE_CHAIN (t))
+        {
+          tree l = TREE_VALUE (t);
+
+          BIND_EXPR_VARS (bind_expr) = chainon (BIND_EXPR_VARS (bind_expr), l);
+        }
+      current_binding_level->labels = NULL_TREE;
+    }
+
+  BLOCK_VARS (block) = BIND_EXPR_VARS (bind_expr);
+
+  if (current_binding_level->decl != NULL_TREE)
+    for (i = tsi_start (current_binding_level->decl); !tsi_end_p (i);
+         tsi_next (&i))
+      append_to_statement_list_force (*tsi_stmt_ptr (i),
+                                      &BIND_EXPR_BODY (bind_expr));
+
+  for (i = tsi_start (statements); !tsi_end_p (i); tsi_next (&i))
+    append_to_statement_list_force (*tsi_stmt_ptr (i),
+                                    &BIND_EXPR_BODY (bind_expr));
+
+  current_binding_level->decl = NULL_TREE;
+}
+
+void
+m2block_finishGlobals (void)
+{
+  tree context = global_binding_level->context;
+  tree block = make_node (BLOCK);
+  tree p = global_binding_level->names;
+
+  BLOCK_SUBBLOCKS (block) = NULL;
+  TREE_USED (block) = 1;
+
+  BLOCK_VARS (block) = p;
+
+  DECL_INITIAL (context) = block;
+  BLOCK_SUPERCONTEXT (block) = context;
+}
+
+/* pushDecl pushes a declaration onto the current binding level.  */
+
+tree
+m2block_pushDecl (tree decl)
+{
+  /* External objects aren't nested, other objects may be.  */
+
+  if (decl != current_function_decl)
+    DECL_CONTEXT (decl) = current_binding_level->context;
+
+  /* Put the declaration on the list.  The list of declarations is in
+     reverse order.  The list will be reversed later if necessary.  This
+     needs to be this way for compatibility with the back-end.  */
+
+  TREE_CHAIN (decl) = current_binding_level->names;
+  current_binding_level->names = decl;
+
+  assert_global_names ();
+
+  return decl;
+}
+
+/* includeDecl pushes a declaration onto the current binding level
+   providing it is not already present.  */
+
+void
+m2block_includeDecl (tree decl)
+{
+  tree p = current_binding_level->names;
+
+  while (p != decl && p != NULL)
+    p = TREE_CHAIN (p);
+  if (p != decl)
+    m2block_pushDecl (decl);
+}
+
+/* addDeclExpr adds the DECL_EXPR node t to the statement list
+   current_binding_level->decl.  This allows us to order all
+   declarations at the beginning of the function.  */
+
+void
+m2block_addDeclExpr (tree t)
+{
+  append_to_statement_list_force (t, &current_binding_level->decl);
+}
+
+/* RememberType remember the type t in the ggc marked list.  */
+
+tree
+m2block_RememberType (tree t)
+{
+  global_binding_level->types
+      = tree_cons (NULL_TREE, t, global_binding_level->types);
+  return t;
+}
+
+/* global_constant returns t.  It chains t onto the
+   global_binding_level list of constants, if it is not already
+   present.  */
+
+tree
+m2block_global_constant (tree t)
+{
+  tree s;
+
+  if (global_binding_level->constants != NULL_TREE)
+    for (s = global_binding_level->constants; s != NULL_TREE;
+         s = TREE_CHAIN (s))
+      {
+        tree c = TREE_VALUE (s);
+
+        if (c == t)
+          return t;
+      }
+
+  global_binding_level->constants
+      = tree_cons (NULL_TREE, t, global_binding_level->constants);
+  return t;
+}
+
+/* RememberConstant adds a tree t onto the list of constants to
+   be marked whenever the ggc re-marks all used storage.  Constants
+   live throughout the whole compilation and they can be used by
+   many different functions if necessary.  */
+
+tree
+m2block_RememberConstant (tree t)
+{
+  if ((t != NULL) && (m2tree_IsAConstant (t)))
+    return m2block_global_constant (t);
+  return t;
+}
+
+/* DumpGlobalConstants displays all global constants and checks
+   none are poisoned.  */
+
+tree
+m2block_DumpGlobalConstants (void)
+{
+  tree s;
+
+  if (global_binding_level->constants != NULL_TREE)
+    for (s = global_binding_level->constants; TREE_CHAIN (s);
+         s = TREE_CHAIN (s))
+      debug_tree (s);
+  return NULL_TREE;
+}
+
+/* RememberInitModuleFunction records tree t in the global
+   binding level.  So that it will not be garbage collected.  In
+   theory the inner modules could be placed inside the
+   current_binding_level I suspect.  */
+
+tree
+m2block_RememberInitModuleFunction (tree t)
+{
+  global_binding_level->init_functions
+      = tree_cons (NULL_TREE, t, global_binding_level->init_functions);
+  return t;
+}
+
+/* toplevel return TRUE if we are in the global scope.  */
+
+int
+m2block_toplevel (void)
+{
+  if (current_binding_level == NULL)
+    return TRUE;
+  if (current_binding_level->fndecl == NULL)
+    return TRUE;
+  return FALSE;
+}
+
+/* GetErrorNode returns the gcc error_mark_node.  */
+
+tree
+m2block_GetErrorNode (void)
+{
+  return error_mark_node;
+}
+
+/* GetGlobals - returns a list of global variables, functions,
+   constants.  */
+
+tree
+m2block_GetGlobals (void)
+{
+  assert_global_names ();
+  return global_binding_level->names;
+}
+
+/* GetGlobalContext - returns the global context tree.  */
+
+tree
+m2block_GetGlobalContext (void)
+{
+  return global_binding_level->context;
+}
+
+/* do_add_stmt - t is a statement.  Add it to the statement-tree.  */
+
+static tree
+do_add_stmt (tree t)
+{
+  if (current_binding_level != NULL)
+    append_to_statement_list_force (t, m2block_cur_stmt_list_addr ());
+  return t;
+}
+
+/* flush_pending_note - flushes a pending_statement note if
+   necessary.  */
+
+static void
+flush_pending_note (void)
+{
+  if (pending_statement && (M2Options_GetM2g ()))
+    {
+#if 0
+      /* --fixme-- we need a machine independant way to generate a nop.  */
+      tree instr = m2decl_BuildStringConstant ("nop", 3);
+      tree string
+          = resolve_asm_operand_names (instr, NULL_TREE, NULL_TREE, NULL_TREE);
+      tree note = build_stmt (pending_location, ASM_EXPR, string, NULL_TREE,
+                              NULL_TREE, NULL_TREE, NULL_TREE);
+
+      ASM_INPUT_P (note) = FALSE;
+      ASM_VOLATILE_P (note) = FALSE;
+#else
+      tree note = build_empty_stmt (pending_location);
+#endif
+      pending_statement = FALSE;
+      do_add_stmt (note);
+    }
+}
+
+/* add_stmt t is a statement.  Add it to the statement-tree.  */
+
+tree
+m2block_add_stmt (location_t location, tree t)
+{
+  if ((CAN_HAVE_LOCATION_P (t)) && (!EXPR_HAS_LOCATION (t)))
+    SET_EXPR_LOCATION (t, location);
+
+  if (pending_statement && (pending_location != location))
+    flush_pending_note ();
+
+  pending_statement = FALSE;
+  return do_add_stmt (t);
+}
+
+/* addStmtNote remember this location represents the start of a
+   Modula-2 statement.  It is flushed if another different location
+   is generated or another tree is given to add_stmt.  */
+
+void
+m2block_addStmtNote (location_t location)
+{
+  if (pending_statement && (pending_location != location))
+    flush_pending_note ();
+
+  pending_statement = TRUE;
+  pending_location = location;
+}
+
+void
+m2block_removeStmtNote (void)
+{
+  pending_statement = FALSE;
+}
+
+/* init - initialize the data structures in this module.  */
+
+void
+m2block_init (void)
+{
+  global_binding_level = newLevel ();
+  global_binding_level->context = build_translation_unit_decl (NULL);
+  global_binding_level->is_global = TRUE;
+  current_binding_level = NULL;
+}
+
+#include "gt-m2-m2block.h"
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2builtins.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2builtins.cc	2022-10-07 20:21:18.650096940 +0100
@@ -0,0 +1,1330 @@ 
+/* m2builtins.cc provides an interface to the GCC builtins.
+
+Copyright (C) 2012-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/>.  */
+
+#include "gcc-consolidation.h"
+
+#include "m2block.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2statement.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+
+#define GM2
+#define GM2_BUG_REPORT                                                        \
+  "Please report this crash to the GNU Modula-2 mailing list "                \
+  "<gm2@nongnu.org>\n"
+
+#define ASSERT(X, Y)                                                          \
+  {                                                                           \
+    if (!(X))                                                                 \
+      {                                                                       \
+        debug_tree (Y);                                                       \
+        internal_error ("%s:%d:assertion of condition `%s' failed", __FILE__, __LINE__,  \
+                        #X);                                                  \
+      }                                                                       \
+  }
+#define ERROR(X)                                                              \
+  {                                                                           \
+    internal_error ("%s:%d:%s", __FILE__, __LINE__, X);                     \
+  }
+
+typedef enum {
+  BT_FN_NONE,
+  BT_FN_PTR_SIZE,
+  BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE,
+  BT_FN_FLOAT,
+  BT_FN_DOUBLE,
+  BT_FN_LONG_DOUBLE,
+  BT_FN_FLOAT_FLOAT,
+  BT_FN_DOUBLE_DOUBLE,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE,
+  BT_FN_STRING_CONST_STRING_INT,
+  BT_FN_INT_CONST_PTR_CONST_PTR_SIZE,
+  BT_FN_TRAD_PTR_PTR_INT_SIZE,
+  BT_FN_STRING_STRING_CONST_STRING,
+  BT_FN_STRING_STRING_CONST_STRING_SIZE,
+  BT_FN_INT_CONST_STRING_CONST_STRING,
+  BT_FN_INT_CONST_STRING_CONST_STRING_SIZE,
+  BT_FN_INT_CONST_STRING,
+  BT_FN_STRING_CONST_STRING_CONST_STRING,
+  BT_FN_SIZE_CONST_STRING_CONST_STRING,
+  BT_FN_PTR_UNSIGNED,
+  BT_FN_VOID_PTR_INT,
+  BT_FN_INT_PTR,
+  BT_FN_INT_FLOAT,
+  BT_FN_INT_DOUBLE,
+  BT_FN_INT_LONG_DOUBLE,
+  BT_FN_FLOAT_FCOMPLEX,
+  BT_FN_DOUBLE_DCOMPLEX,
+  BT_FN_LONG_DOUBLE_LDCOMPLEX,
+
+  BT_FN_FCOMPLEX_FCOMPLEX,
+  BT_FN_DCOMPLEX_DCOMPLEX,
+  BT_FN_LDCOMPLEX_LDCOMPLEX,
+
+  BT_FN_DCOMPLEX_DOUBLE_DCOMPLEX,
+  BT_FN_FCOMPLEX_FLOAT_FCOMPLEX,
+  BT_FN_LDCOMPLEX_LONG_DOUBLE_LDCOMPLEX,
+
+  BT_FN_FLOAT_FLOAT_FLOATPTR,
+  BT_FN_DOUBLE_DOUBLE_DOUBLEPTR,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLEPTR,
+
+  BT_FN_FLOAT_FLOAT_LONG_DOUBLE,
+  BT_FN_DOUBLE_DOUBLE_LONG_DOUBLE,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+
+  BT_FN_FLOAT_FLOAT_LONG,
+  BT_FN_DOUBLE_DOUBLE_LONG,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG,
+
+  BT_FN_FLOAT_FLOAT_INT,
+  BT_FN_DOUBLE_DOUBLE_INT,
+  BT_FN_LONG_DOUBLE_LONG_DOUBLE_INT,
+
+  BT_FN_FLOAT_FLOAT_FLOAT,
+  BT_FN_DOUBLE_DOUBLE_DOUBLE,
+} builtin_prototype;
+
+struct builtin_function_entry
+{
+  const char *name;
+  builtin_prototype defn;
+  int function_code;
+  enum built_in_class fclass;
+  const char *library_name;
+  tree function_node;
+  tree return_node;
+};
+
+/* Entries are added by examining gcc/builtins.def and copying those
+   functions which can be applied to Modula-2.  */
+
+static struct builtin_function_entry list_of_builtins[] = {
+  { "__builtin_alloca", BT_FN_PTR_SIZE, BUILT_IN_ALLOCA, BUILT_IN_NORMAL,
+    "alloca", NULL, NULL },
+  { "__builtin_memcpy", BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE, BUILT_IN_MEMCPY,
+    BUILT_IN_NORMAL, "memcpy", NULL, NULL },
+
+  { "__builtin_isfinite", BT_FN_INT_DOUBLE, BUILT_IN_ISFINITE, BUILT_IN_NORMAL,
+    "isfinite", NULL, NULL },
+
+  { "__builtin_sinf", BT_FN_FLOAT_FLOAT, BUILT_IN_SINF, BUILT_IN_NORMAL,
+    "sinf", NULL, NULL },
+  { "__builtin_sin", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SIN, BUILT_IN_NORMAL, "sin",
+    NULL, NULL },
+  { "__builtin_sinl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_SINL,
+    BUILT_IN_NORMAL, "sinl", NULL, NULL },
+  { "__builtin_cosf", BT_FN_FLOAT_FLOAT, BUILT_IN_SINF, BUILT_IN_NORMAL,
+    "cosf", NULL, NULL },
+  { "__builtin_cos", BT_FN_DOUBLE_DOUBLE, BUILT_IN_COS, BUILT_IN_NORMAL, "cos",
+    NULL, NULL },
+  { "__builtin_cosl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_COSL,
+    BUILT_IN_NORMAL, "cosl", NULL, NULL },
+  { "__builtin_sqrtf", BT_FN_FLOAT_FLOAT, BUILT_IN_SQRTF, BUILT_IN_NORMAL,
+    "sqrtf", NULL, NULL },
+  { "__builtin_sqrt", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SQRT, BUILT_IN_NORMAL,
+    "sqrt", NULL, NULL },
+  { "__builtin_sqrtl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_SQRTL,
+    BUILT_IN_NORMAL, "sqrtl", NULL, NULL },
+  { "__builtin_fabsf", BT_FN_FLOAT_FLOAT, BUILT_IN_FABSF, BUILT_IN_NORMAL,
+    "fabsf", NULL, NULL },
+  { "__builtin_fabs", BT_FN_DOUBLE_DOUBLE, BUILT_IN_FABS, BUILT_IN_NORMAL,
+    "fabs", NULL, NULL },
+  { "__builtin_fabsl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_FABSL,
+    BUILT_IN_NORMAL, "fabsl", NULL, NULL },
+  { "__builtin_logf", BT_FN_FLOAT_FLOAT, BUILT_IN_LOGF, BUILT_IN_NORMAL,
+    "logf", NULL, NULL },
+  { "__builtin_log", BT_FN_DOUBLE_DOUBLE, BUILT_IN_LOG, BUILT_IN_NORMAL, "log",
+    NULL, NULL },
+  { "__builtin_logl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_LOGL,
+    BUILT_IN_NORMAL, "logl", NULL, NULL },
+  { "__builtin_expf", BT_FN_FLOAT_FLOAT, BUILT_IN_EXPF, BUILT_IN_NORMAL,
+    "expf", NULL, NULL },
+  { "__builtin_exp", BT_FN_DOUBLE_DOUBLE, BUILT_IN_EXP, BUILT_IN_NORMAL, "exp",
+    NULL, NULL },
+  { "__builtin_expl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_EXPL,
+    BUILT_IN_NORMAL, "expl", NULL, NULL },
+  { "__builtin_log10f", BT_FN_FLOAT_FLOAT, BUILT_IN_LOG10F, BUILT_IN_NORMAL,
+    "log10f", NULL, NULL },
+  { "__builtin_log10", BT_FN_DOUBLE_DOUBLE, BUILT_IN_LOG10, BUILT_IN_NORMAL,
+    "log10", NULL, NULL },
+  { "__builtin_log10l", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_LOG10L,
+    BUILT_IN_NORMAL, "log10l", NULL, NULL },
+  { "__builtin_ilogbf", BT_FN_INT_FLOAT, BUILT_IN_ILOGBF, BUILT_IN_NORMAL,
+    "ilogbf", NULL, NULL },
+  { "__builtin_ilogb", BT_FN_INT_DOUBLE, BUILT_IN_ILOGB, BUILT_IN_NORMAL,
+    "ilogb", NULL, NULL },
+  { "__builtin_ilogbl", BT_FN_INT_LONG_DOUBLE, BUILT_IN_ILOGBL,
+    BUILT_IN_NORMAL, "ilogbl", NULL, NULL },
+
+  { "__builtin_atan2f", BT_FN_FLOAT_FLOAT_FLOAT, BUILT_IN_ATAN2F,
+    BUILT_IN_NORMAL, "atan2f", NULL, NULL },
+  { "__builtin_atan2", BT_FN_DOUBLE_DOUBLE_DOUBLE, BUILT_IN_ATAN2,
+    BUILT_IN_NORMAL, "atan2", NULL, NULL },
+  { "__builtin_atan2l", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_ATAN2L, BUILT_IN_NORMAL, "atan2l", NULL, NULL },
+
+  { "__builtin_signbit", BT_FN_INT_DOUBLE, BUILT_IN_SIGNBIT, BUILT_IN_NORMAL,
+    "signbit", NULL, NULL },
+  { "__builtin_signbitf", BT_FN_INT_FLOAT, BUILT_IN_SIGNBITF, BUILT_IN_NORMAL,
+    "signbitf", NULL, NULL },
+  { "__builtin_signbitl", BT_FN_INT_LONG_DOUBLE, BUILT_IN_SIGNBITL,
+    BUILT_IN_NORMAL, "signbitl", NULL, NULL },
+  { "__builtin_significand", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SIGNIFICAND,
+    BUILT_IN_NORMAL, "significand", NULL, NULL },
+  { "__builtin_significandf", BT_FN_FLOAT_FLOAT, BUILT_IN_SIGNIFICANDF,
+    BUILT_IN_NORMAL, "significandf", NULL, NULL },
+  { "__builtin_significandl", BT_FN_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_SIGNIFICANDL, BUILT_IN_NORMAL, "significandl", NULL, NULL },
+  { "__builtin_modf", BT_FN_DOUBLE_DOUBLE_DOUBLEPTR, BUILT_IN_MODF,
+    BUILT_IN_NORMAL, "modf", NULL, NULL },
+  { "__builtin_modff", BT_FN_FLOAT_FLOAT_FLOATPTR, BUILT_IN_MODFF,
+    BUILT_IN_NORMAL, "modff", NULL, NULL },
+  { "__builtin_modfl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLEPTR,
+    BUILT_IN_MODFL, BUILT_IN_NORMAL, "modfl", NULL, NULL },
+  { "__builtin_nextafter", BT_FN_DOUBLE_DOUBLE_DOUBLE, BUILT_IN_NEXTAFTER,
+    BUILT_IN_NORMAL, "nextafter", NULL, NULL },
+  { "__builtin_nextafterf", BT_FN_FLOAT_FLOAT_FLOAT, BUILT_IN_NEXTAFTERF,
+    BUILT_IN_NORMAL, "nextafterf", NULL, NULL },
+  { "__builtin_nextafterl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_NEXTAFTERL, BUILT_IN_NORMAL, "nextafterl", NULL, NULL },
+  { "__builtin_nexttoward", BT_FN_DOUBLE_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_NEXTTOWARD, BUILT_IN_NORMAL, "nexttoward", NULL, NULL },
+  { "__builtin_nexttowardf", BT_FN_FLOAT_FLOAT_LONG_DOUBLE,
+    BUILT_IN_NEXTTOWARDF, BUILT_IN_NORMAL, "nexttowardf", NULL, NULL },
+  { "__builtin_nexttowardl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_NEXTTOWARDL, BUILT_IN_NORMAL, "nexttowardl", NULL, NULL },
+  { "__builtin_scalb", BT_FN_DOUBLE_DOUBLE_DOUBLE, BUILT_IN_SCALB,
+    BUILT_IN_NORMAL, "scalb", NULL, NULL },
+  { "__builtin_scalbf", BT_FN_FLOAT_FLOAT_FLOAT, BUILT_IN_SCALBF,
+    BUILT_IN_NORMAL, "scalbf", NULL, NULL },
+  { "__builtin_scalbl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE,
+    BUILT_IN_SCALBL, BUILT_IN_NORMAL, "scalbl", NULL, NULL },
+  { "__builtin_scalbln", BT_FN_DOUBLE_DOUBLE_LONG, BUILT_IN_SCALBLN,
+    BUILT_IN_NORMAL, "scalbln", NULL, NULL },
+  { "__builtin_scalblnf", BT_FN_FLOAT_FLOAT_LONG, BUILT_IN_SCALBLNF,
+    BUILT_IN_NORMAL, "scalblnf", NULL, NULL },
+  { "__builtin_scalblnl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG,
+    BUILT_IN_SCALBLNL, BUILT_IN_NORMAL, "scalblnl", NULL, NULL },
+  { "__builtin_scalbn", BT_FN_DOUBLE_DOUBLE_INT, BUILT_IN_SCALBN,
+    BUILT_IN_NORMAL, "scalbln", NULL, NULL },
+  { "__builtin_scalbnf", BT_FN_FLOAT_FLOAT_INT, BUILT_IN_SCALBNF,
+    BUILT_IN_NORMAL, "scalblnf", NULL, NULL },
+  { "__builtin_scalbnl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_INT, BUILT_IN_SCALBNL,
+    BUILT_IN_NORMAL, "scalblnl", NULL, NULL },
+
+  /* Complex intrinsic functions.  */
+  { "__builtin_cabs", BT_FN_DOUBLE_DCOMPLEX, BUILT_IN_CABS, BUILT_IN_NORMAL,
+    "cabs", NULL, NULL },
+  { "__builtin_cabsf", BT_FN_FLOAT_FCOMPLEX, BUILT_IN_CABSF, BUILT_IN_NORMAL,
+    "cabsf", NULL, NULL },
+  { "__builtin_cabsl", BT_FN_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CABSL,
+    BUILT_IN_NORMAL, "cabsl", NULL, NULL },
+
+  { "__builtin_carg", BT_FN_DOUBLE_DCOMPLEX, BUILT_IN_CABS, BUILT_IN_NORMAL,
+    "carg", NULL, NULL },
+  { "__builtin_cargf", BT_FN_FLOAT_FCOMPLEX, BUILT_IN_CABSF, BUILT_IN_NORMAL,
+    "cargf", NULL, NULL },
+  { "__builtin_cargl", BT_FN_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CABSL,
+    BUILT_IN_NORMAL, "cargl", NULL, NULL },
+
+  { "__builtin_conj", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CONJ, BUILT_IN_NORMAL,
+    "carg", NULL, NULL },
+  { "__builtin_conjf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CONJF,
+    BUILT_IN_NORMAL, "conjf", NULL, NULL },
+  { "__builtin_conjl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CONJL,
+    BUILT_IN_NORMAL, "conjl", NULL, NULL },
+
+  { "__builtin_cpow", BT_FN_DCOMPLEX_DOUBLE_DCOMPLEX, BUILT_IN_CPOW,
+    BUILT_IN_NORMAL, "cpow", NULL, NULL },
+  { "__builtin_cpowf", BT_FN_FCOMPLEX_FLOAT_FCOMPLEX, BUILT_IN_CPOWF,
+    BUILT_IN_NORMAL, "cpowf", NULL, NULL },
+  { "__builtin_cpowl", BT_FN_LDCOMPLEX_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CPOWL,
+    BUILT_IN_NORMAL, "cpowl", NULL, NULL },
+
+  { "__builtin_csqrt", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CSQRT,
+    BUILT_IN_NORMAL, "csqrt", NULL, NULL },
+  { "__builtin_csqrtf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CSQRTF,
+    BUILT_IN_NORMAL, "csqrtf", NULL, NULL },
+  { "__builtin_csqrtl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CSQRTL,
+    BUILT_IN_NORMAL, "csqrtl", NULL, NULL },
+
+  { "__builtin_cexp", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CEXP, BUILT_IN_NORMAL,
+    "cexp", NULL, NULL },
+  { "__builtin_cexpf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CEXPF,
+    BUILT_IN_NORMAL, "cexpf", NULL, NULL },
+  { "__builtin_cexpl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CEXPL,
+    BUILT_IN_NORMAL, "cexpl", NULL, NULL },
+
+  { "__builtin_cln", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CLOG, BUILT_IN_NORMAL,
+    "cln", NULL, NULL },
+  { "__builtin_clnf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CLOGF, BUILT_IN_NORMAL,
+    "clnf", NULL, NULL },
+  { "__builtin_clnl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CLOGL,
+    BUILT_IN_NORMAL, "clnl", NULL, NULL },
+
+  { "__builtin_csin", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CSIN, BUILT_IN_NORMAL,
+    "csin", NULL, NULL },
+  { "__builtin_csinf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CSINF,
+    BUILT_IN_NORMAL, "csinf", NULL, NULL },
+  { "__builtin_csinl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CSINL,
+    BUILT_IN_NORMAL, "csinl", NULL, NULL },
+
+  { "__builtin_ccos", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CCOS, BUILT_IN_NORMAL,
+    "ccos", NULL, NULL },
+  { "__builtin_ccosf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CCOSF,
+    BUILT_IN_NORMAL, "ccosf", NULL, NULL },
+  { "__builtin_ccosl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CCOSL,
+    BUILT_IN_NORMAL, "ccosl", NULL, NULL },
+
+  { "__builtin_ctan", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CTAN, BUILT_IN_NORMAL,
+    "ctan", NULL, NULL },
+  { "__builtin_ctanf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CTANF,
+    BUILT_IN_NORMAL, "ctanf", NULL, NULL },
+  { "__builtin_ctanl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CTANL,
+    BUILT_IN_NORMAL, "ctanl", NULL, NULL },
+
+  { "__builtin_casin", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CASIN,
+    BUILT_IN_NORMAL, "casin", NULL, NULL },
+  { "__builtin_casinf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CASINF,
+    BUILT_IN_NORMAL, "casinf", NULL, NULL },
+  { "__builtin_casinl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CASINL,
+    BUILT_IN_NORMAL, "casinl", NULL, NULL },
+
+  { "__builtin_cacos", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CACOS,
+    BUILT_IN_NORMAL, "cacos", NULL, NULL },
+  { "__builtin_cacosf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CACOSF,
+    BUILT_IN_NORMAL, "cacosf", NULL, NULL },
+  { "__builtin_cacosl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CACOSL,
+    BUILT_IN_NORMAL, "cacosl", NULL, NULL },
+
+  { "__builtin_catan", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CATAN,
+    BUILT_IN_NORMAL, "catan", NULL, NULL },
+  { "__builtin_catanf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CATANF,
+    BUILT_IN_NORMAL, "catanf", NULL, NULL },
+  { "__builtin_catanl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CATANL,
+    BUILT_IN_NORMAL, "catanl", NULL, NULL },
+
+  { "__builtin_huge_val", BT_FN_DOUBLE, BUILT_IN_HUGE_VAL, BUILT_IN_NORMAL,
+    "huge_val", NULL, NULL },
+  { "__builtin_huge_valf", BT_FN_FLOAT, BUILT_IN_HUGE_VALF, BUILT_IN_NORMAL,
+    "huge_valf", NULL, NULL },
+  { "__builtin_huge_vall", BT_FN_LONG_DOUBLE, BUILT_IN_HUGE_VALL,
+    BUILT_IN_NORMAL, "huge_vall", NULL, NULL },
+
+  { "__builtin_index", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_INDEX,
+    BUILT_IN_NORMAL, "index", NULL, NULL },
+  { "__builtin_rindex", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_RINDEX,
+    BUILT_IN_NORMAL, "rindex", NULL, NULL },
+  { "__builtin_memcmp", BT_FN_INT_CONST_PTR_CONST_PTR_SIZE, BUILT_IN_MEMCMP,
+    BUILT_IN_NORMAL, "memcmp", NULL, NULL },
+  { "__builtin_memmove", BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE, BUILT_IN_MEMMOVE,
+    BUILT_IN_NORMAL, "memmove", NULL, NULL },
+  { "__builtin_memset", BT_FN_TRAD_PTR_PTR_INT_SIZE, BUILT_IN_MEMSET,
+    BUILT_IN_NORMAL, "memset", NULL, NULL },
+  { "__builtin_strcat", BT_FN_STRING_STRING_CONST_STRING, BUILT_IN_STRCAT,
+    BUILT_IN_NORMAL, "strcat", NULL, NULL },
+  { "__builtin_strncat", BT_FN_STRING_STRING_CONST_STRING_SIZE,
+    BUILT_IN_STRNCAT, BUILT_IN_NORMAL, "strncat", NULL, NULL },
+  { "__builtin_strcpy", BT_FN_STRING_STRING_CONST_STRING, BUILT_IN_STRCPY,
+    BUILT_IN_NORMAL, "strcpy", NULL, NULL },
+  { "__builtin_strncpy", BT_FN_STRING_STRING_CONST_STRING_SIZE,
+    BUILT_IN_STRNCPY, BUILT_IN_NORMAL, "strncpy", NULL, NULL },
+  { "__builtin_strcmp", BT_FN_INT_CONST_STRING_CONST_STRING, BUILT_IN_STRCMP,
+    BUILT_IN_NORMAL, "strcmp", NULL, NULL },
+  { "__builtin_strncmp", BT_FN_INT_CONST_STRING_CONST_STRING_SIZE,
+    BUILT_IN_STRNCMP, BUILT_IN_NORMAL, "strncmp", NULL, NULL },
+  { "__builtin_strlen", BT_FN_INT_CONST_STRING, BUILT_IN_STRLEN,
+    BUILT_IN_NORMAL, "strlen", NULL, NULL },
+  { "__builtin_strstr", BT_FN_STRING_CONST_STRING_CONST_STRING,
+    BUILT_IN_STRSTR, BUILT_IN_NORMAL, "strstr", NULL, NULL },
+  { "__builtin_strpbrk", BT_FN_STRING_CONST_STRING_CONST_STRING,
+    BUILT_IN_STRPBRK, BUILT_IN_NORMAL, "strpbrk", NULL, NULL },
+  { "__builtin_strspn", BT_FN_SIZE_CONST_STRING_CONST_STRING, BUILT_IN_STRSPN,
+    BUILT_IN_NORMAL, "strspn", NULL, NULL },
+  { "__builtin_strcspn", BT_FN_SIZE_CONST_STRING_CONST_STRING,
+    BUILT_IN_STRCSPN, BUILT_IN_NORMAL, "strcspn", NULL, NULL },
+  { "__builtin_strchr", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_STRCHR,
+    BUILT_IN_NORMAL, "strchr", NULL, NULL },
+  { "__builtin_strrchr", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_STRCHR,
+    BUILT_IN_NORMAL, "strrchr", NULL, NULL },
+  //{ "__builtin_constant_p", BT_FN_INT_VAR, BUILT_IN_CONSTANT_P,
+  //BUILT_IN_NORMAL, "constant_p", NULL, NULL},
+  { "__builtin_frame_address", BT_FN_PTR_UNSIGNED, BUILT_IN_FRAME_ADDRESS,
+    BUILT_IN_NORMAL, "frame_address", NULL, NULL },
+  { "__builtin_return_address", BT_FN_PTR_UNSIGNED, BUILT_IN_RETURN_ADDRESS,
+    BUILT_IN_NORMAL, "return_address", NULL, NULL },
+  //{ "__builtin_aggregate_incoming_address", BT_FN_PTR_VAR,
+  //BUILT_IN_AGGREGATE_INCOMING_ADDRESS, BUILT_IN_NORMAL,
+  //"aggregate_incoming_address", NULL, NULL},
+  { "__builtin_longjmp", BT_FN_VOID_PTR_INT, BUILT_IN_LONGJMP, BUILT_IN_NORMAL,
+    "longjmp", NULL, NULL },
+  { "__builtin_setjmp", BT_FN_INT_PTR, BUILT_IN_SETJMP, BUILT_IN_NORMAL,
+    "setjmp", NULL, NULL },
+  { NULL, BT_FN_NONE, 0, NOT_BUILT_IN, "", NULL, NULL }
+};
+
+struct builtin_type_info
+{
+  const char *name;
+  unsigned int returnType;
+  tree (*functionHandler) (location_t, tree);
+};
+
+static GTY (()) tree sizetype_endlink;
+static GTY (()) tree unsigned_endlink;
+static GTY (()) tree endlink;
+static GTY (()) tree math_endlink;
+static GTY (()) tree int_endlink;
+static GTY (()) tree ptr_endlink;
+static GTY (()) tree const_ptr_endlink;
+static GTY (()) tree double_ftype_void;
+static GTY (()) tree float_ftype_void;
+static GTY (()) tree ldouble_ftype_void;
+static GTY (()) tree float_ftype_float;
+static GTY (()) tree double_ftype_double;
+static GTY (()) tree ldouble_ftype_ldouble;
+static GTY (()) tree gm2_alloca_node;
+static GTY (()) tree gm2_memcpy_node;
+static GTY (()) tree gm2_isfinite_node;
+static GTY (()) tree gm2_huge_valf_node;
+static GTY (()) tree gm2_huge_val_node;
+static GTY (()) tree gm2_huge_vall_node;
+static GTY (()) tree long_doubleptr_type_node;
+static GTY (()) tree doubleptr_type_node;
+static GTY (()) tree floatptr_type_node;
+static GTY (()) tree builtin_ftype_int_var;
+
+/* Prototypes for locally defined functions.  */
+static tree DoBuiltinAlloca (location_t location, tree n);
+static tree DoBuiltinMemCopy (location_t location, tree dest, tree src,
+                              tree n);
+static tree DoBuiltinIsfinite (location_t location, tree value);
+static void create_function_prototype (location_t location,
+                                       struct builtin_function_entry *fe);
+static tree doradix (location_t location, tree type);
+static tree doplaces (location_t location, tree type);
+static tree doexponentmin (location_t location, tree type);
+static tree doexponentmax (location_t location, tree type);
+static tree dolarge (location_t location, tree type);
+static tree dosmall (location_t location, tree type);
+static tree doiec559 (location_t location, tree type);
+static tree dolia1 (location_t location, tree type);
+static tree doiso (location_t location, tree type);
+static tree doieee (location_t location, tree type);
+static tree dorounds (location_t location, tree type);
+static tree dogUnderflow (location_t location, tree type);
+static tree doexception (location_t location, tree type);
+static tree doextend (location_t location, tree type);
+static tree donModes (location_t location, tree type);
+/* Prototypes finish here.  */
+
+#define m2builtins_c
+#include "m2builtins.h"
+
+static struct builtin_type_info m2_type_info[] = {
+  { "radix", 2, doradix },
+  { "places", 2, doplaces },
+  { "expoMin", 2, doexponentmin },
+  { "expoMax", 2, doexponentmax },
+  { "large", 3, dolarge },
+  { "small", 3, dosmall },
+  { "IEC559", 1, doiec559 },
+  { "LIA1", 1, dolia1 },
+  { "ISO", 1, doiso },
+  { "IEEE", 1, doieee },
+  { "rounds", 1, dorounds },
+  { "gUnderflow", 1, dogUnderflow },
+  { "exception", 1, doexception },
+  { "extend", 1, doextend },
+  { "nModes", 2, donModes },
+  { NULL, 0, NULL },
+};
+
+/* Return a definition for a builtin function named NAME and whose
+data type is TYPE.  TYPE should be a function type with argument
+types.  FUNCTION_CODE tells later passes how to compile calls to this
+function.  See tree.h for its possible values.
+
+If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME, the
+name to be called if we can't opencode the function.  */
+
+tree
+builtin_function (location_t location, const char *name, tree type,
+                  int function_code, enum built_in_class fclass,
+                  const char *library_name, tree attrs)
+{
+  tree decl = add_builtin_function (name, type, function_code, fclass,
+                                    library_name, attrs);
+  DECL_SOURCE_LOCATION (decl) = location;
+
+  m2block_pushDecl (decl);
+  return decl;
+}
+
+/* GetBuiltinConst - returns the gcc tree of a builtin constant,
+   name.  NIL is returned if the constant is unknown.  */
+
+tree
+m2builtins_GetBuiltinConst (char *name)
+{
+  if (strcmp (name, "BITS_PER_UNIT") == 0)
+    return m2decl_BuildIntegerConstant (BITS_PER_UNIT);
+  if (strcmp (name, "BITS_PER_WORD") == 0)
+    return m2decl_BuildIntegerConstant (BITS_PER_WORD);
+  if (strcmp (name, "BITS_PER_CHAR") == 0)
+    return m2decl_BuildIntegerConstant (CHAR_TYPE_SIZE);
+  if (strcmp (name, "UNITS_PER_WORD") == 0)
+    return m2decl_BuildIntegerConstant (UNITS_PER_WORD);
+
+  return NULL_TREE;
+}
+
+/* GetBuiltinConstType - returns the type of a builtin constant,
+   name.  0 = unknown constant name 1 = integer 2 = real.  */
+
+unsigned int
+m2builtins_GetBuiltinConstType (char *name)
+{
+  if (strcmp (name, "BITS_PER_UNIT") == 0)
+    return 1;
+  if (strcmp (name, "BITS_PER_WORD") == 0)
+    return 1;
+  if (strcmp (name, "BITS_PER_CHAR") == 0)
+    return 1;
+  if (strcmp (name, "UNITS_PER_WORD") == 0)
+    return 1;
+
+  return 0;
+}
+
+/* GetBuiltinTypeInfoType - returns value: 0 is ident is unknown.  1
+   if ident is IEC559, LIA1, ISO, IEEE, rounds, underflow, exception,
+   extend.  2 if ident is radix, places, exponentmin, exponentmax,
+   noofmodes.  3 if ident is large, small.  */
+
+unsigned int
+m2builtins_GetBuiltinTypeInfoType (const char *ident)
+{
+  int i = 0;
+
+  while (m2_type_info[i].name != NULL)
+    if (strcmp (m2_type_info[i].name, ident) == 0)
+      return m2_type_info[i].returnType;
+    else
+      i++;
+  return 0;
+}
+
+/* GetBuiltinTypeInfo - returns value: NULL_TREE if ident is unknown.
+   boolean Tree if ident is IEC559, LIA1, ISO, IEEE, rounds,
+   underflow, exception, extend.  ZType Tree if ident is radix,
+   places, exponentmin, exponentmax, noofmodes.
+   RType Tree if ident is large, small.  */
+
+tree
+m2builtins_GetBuiltinTypeInfo (location_t location, tree type,
+                               const char *ident)
+{
+  int i = 0;
+
+  type = m2tree_skip_type_decl (type);
+  while (m2_type_info[i].name != NULL)
+    if (strcmp (m2_type_info[i].name, ident) == 0)
+      return (*m2_type_info[i].functionHandler) (location, type);
+    else
+      i++;
+  return NULL_TREE;
+}
+
+/* doradix - returns the radix of the floating point, type.  */
+
+static tree
+doradix (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      enum machine_mode mode = TYPE_MODE (type);
+      int radix = REAL_MODE_FORMAT (mode)->b;
+      return m2decl_BuildIntegerConstant (radix);
+    }
+  else
+    return NULL_TREE;
+}
+
+/* doplaces - returns the whole number value of the number of radix
+   places used to store values of the corresponding real number type.  */
+
+static tree
+doplaces (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      /* Taken from c-family/c-cppbuiltin.cc.  */
+      /* The number of decimal digits, q, such that any floating-point
+         number with q decimal digits can be rounded into a
+         floating-point number with p radix b digits and back again
+         without change to the q decimal digits, p log10 b if b is a
+         power of 10 floor((p - 1) log10 b) otherwise.  */
+      enum machine_mode mode = TYPE_MODE (type);
+      const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+      const double log10_2 = .30102999566398119521;
+      double log10_b = log10_2;
+      int digits = (fmt->p - 1) * log10_b;
+      return m2decl_BuildIntegerConstant (digits);
+    }
+  else
+    return NULL_TREE;
+}
+
+/* doexponentmin - returns the whole number of the exponent minimum.  */
+
+static tree
+doexponentmin (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      enum machine_mode mode = TYPE_MODE (type);
+      int emin = REAL_MODE_FORMAT (mode)->emin;
+      return m2decl_BuildIntegerConstant (emin);
+    }
+  else
+    return NULL_TREE;
+}
+
+/* doexponentmax - returns the whole number of the exponent maximum.  */
+
+static tree
+doexponentmax (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      enum machine_mode mode = TYPE_MODE (type);
+      int emax = REAL_MODE_FORMAT (mode)->emax;
+      return m2decl_BuildIntegerConstant (emax);
+    }
+  else
+    return NULL_TREE;
+}
+
+static tree
+computeLarge (tree type)
+{
+  enum machine_mode mode = TYPE_MODE (type);
+  const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+  REAL_VALUE_TYPE real;
+  char buf[128];
+
+  /* Shamelessly taken from c-cppbuiltin.cc:builtin_define_float_constants.  */
+
+  /* Since, for the supported formats, B is always a power of 2, we
+  construct the following numbers directly as a hexadecimal constants.  */
+
+  get_max_float (fmt, buf, sizeof (buf), false);
+  real_from_string (&real, buf);
+  return build_real (type, real);
+}
+
+/* dolarge - return the largest value of the corresponding real type.  */
+
+static tree
+dolarge (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    return computeLarge (type);
+  return NULL_TREE;
+}
+
+static tree
+computeSmall (tree type)
+{
+  enum machine_mode mode = TYPE_MODE (type);
+  const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+  REAL_VALUE_TYPE real;
+  char buf[128];
+
+  /* The minimum normalized positive floating-point number,
+  b**(emin-1).  */
+
+  sprintf (buf, "0x1p%d", fmt->emin - 1);
+  real_from_string (&real, buf);
+  return build_real (type, real);
+}
+
+/* dosmall - return the smallest positive value of the corresponding
+   real type.  */
+
+static tree
+dosmall (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    return computeSmall (type);
+  return NULL_TREE;
+}
+
+/* doiec559 - a boolean value that is true if and only if the
+   implementation of the corresponding real number type conforms to
+   IEC 559:1989 (also known as IEEE 754:1987) in all regards.  */
+
+static tree
+doiec559 (location_t location, tree type)
+{
+  if (m2expr_IsTrue (m2expr_BuildEqualTo (location,
+                                          m2decl_BuildIntegerConstant (32),
+                                          m2expr_GetSizeOfInBits (type))))
+    return m2type_GetBooleanTrue ();
+  if (m2expr_IsTrue (m2expr_BuildEqualTo (location,
+                                          m2decl_BuildIntegerConstant (64),
+                                          m2expr_GetSizeOfInBits (type))))
+    return m2type_GetBooleanTrue ();
+  return m2type_GetBooleanFalse ();
+}
+
+/* dolia1 - returns TRUE if using ieee (currently always TRUE).  */
+
+static tree
+dolia1 (location_t location, tree type)
+{
+  return doieee (location, type);
+}
+
+/* doiso - returns TRUE if using ieee (--fixme--).  */
+
+static tree
+doiso (location_t location, tree type)
+{
+  return doieee (location, type);
+}
+
+/* doieee - returns TRUE if ieee arithmetic is being used.  */
+
+static tree
+doieee (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  /* --fixme-- maybe we should look for the -mno-ieee flag and return this
+     result.  */
+  return m2type_GetBooleanTrue ();
+}
+
+/* dorounds - returns TRUE if and only if each operation produces a
+   result that is one of the values of the corresponding real number
+   type nearest to the mathematical result.  */
+
+static tree
+dorounds (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  if (FLT_ROUNDS)
+    return m2type_GetBooleanTrue ();
+  else
+    return m2type_GetBooleanFalse ();
+}
+
+/* dogUnderflow - returns TRUE if and only if there are values of the
+   corresponding real number type between 0.0 and small.  */
+
+static tree
+dogUnderflow (location_t location ATTRIBUTE_UNUSED, tree type)
+{
+  if (TREE_CODE (type) == REAL_TYPE)
+    {
+      enum machine_mode mode = TYPE_MODE (type);
+      const struct real_format *fmt = REAL_MODE_FORMAT (mode);
+      if (fmt->has_denorm)
+        return m2type_GetBooleanTrue ();
+      else
+        return m2type_GetBooleanFalse ();
+    }
+  return NULL_TREE;
+}
+
+/* doexception - */
+
+static tree
+doexception (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  return m2type_GetBooleanTrue ();
+}
+
+/* doextend - */
+
+static tree
+doextend (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  return m2type_GetBooleanTrue ();
+}
+
+/* donModes - */
+
+static tree
+donModes (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED)
+{
+  return m2decl_BuildIntegerConstant (1);
+}
+
+/* BuiltInMemCopy - copy n bytes of memory efficiently from address
+   src to dest.  */
+
+tree
+m2builtins_BuiltInMemCopy (location_t location, tree dest, tree src, tree n)
+{
+  return DoBuiltinMemCopy (location, dest, src, n);
+}
+
+/* BuiltInAlloca - given an expression, n, allocate, n, bytes on the
+   stack for the life of the current function.  */
+
+tree
+m2builtins_BuiltInAlloca (location_t location, tree n)
+{
+  return DoBuiltinAlloca (location, n);
+}
+
+/* BuiltInIsfinite - return integer 1 if the real expression is
+   finite otherwise return integer 0.  */
+
+tree
+m2builtins_BuiltInIsfinite (location_t location, tree expression)
+{
+  return DoBuiltinIsfinite (location, expression);
+}
+
+/* BuiltinExists - returns TRUE if the builtin function, name, exists
+   for this target architecture.  */
+
+int
+m2builtins_BuiltinExists (char *name)
+{
+  struct builtin_function_entry *fe;
+
+  for (fe = &list_of_builtins[0]; fe->name != NULL; fe++)
+    if (strcmp (name, fe->name) == 0)
+      return TRUE;
+
+  return FALSE;
+}
+
+/* BuildBuiltinTree - returns a Tree containing the builtin function,
+   name.  */
+
+tree
+m2builtins_BuildBuiltinTree (location_t location, char *name)
+{
+  struct builtin_function_entry *fe;
+  tree t;
+
+  m2statement_SetLastFunction (NULL_TREE);
+  for (fe = &list_of_builtins[0]; fe->name != NULL; fe++)
+    if (strcmp (name, fe->name) == 0)
+      {
+        tree functype = TREE_TYPE (fe->function_node);
+        tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype),
+                               fe->function_node);
+
+        m2statement_SetLastFunction (m2treelib_DoCall (
+            location, fe->return_node, funcptr, m2statement_GetParamList ()));
+        m2statement_SetParamList (NULL_TREE);
+        t = m2statement_GetLastFunction ();
+        if (fe->return_node == void_type_node)
+          m2statement_SetLastFunction (NULL_TREE);
+        return t;
+      }
+
+  m2statement_SetParamList (NULL_TREE);
+  return m2statement_GetLastFunction ();
+}
+
+static tree
+DoBuiltinMemCopy (location_t location, tree dest, tree src, tree bytes)
+{
+  tree functype = TREE_TYPE (gm2_memcpy_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_memcpy_node);
+  tree call
+      = m2treelib_DoCall3 (location, ptr_type_node, funcptr, dest, src, bytes);
+  return call;
+}
+
+static tree
+DoBuiltinAlloca (location_t location, tree bytes)
+{
+  tree functype = TREE_TYPE (gm2_alloca_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_alloca_node);
+  tree call = m2treelib_DoCall1 (location, ptr_type_node, funcptr, bytes);
+
+  return call;
+}
+
+static tree
+DoBuiltinIsfinite (location_t location, tree value)
+{
+  tree functype = TREE_TYPE (gm2_isfinite_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_isfinite_node);
+  tree call = m2treelib_DoCall1 (location, ptr_type_node, funcptr, value);
+
+  return call;
+}
+
+tree
+m2builtins_BuiltInHugeVal (location_t location)
+{
+  tree functype = TREE_TYPE (gm2_huge_val_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_huge_val_node);
+  tree call = m2treelib_DoCall0 (location, ptr_type_node, funcptr);
+  return call;
+}
+
+tree
+m2builtins_BuiltInHugeValShort (location_t location)
+{
+  tree functype = TREE_TYPE (gm2_huge_valf_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_huge_valf_node);
+  tree call = m2treelib_DoCall0 (location, ptr_type_node, funcptr);
+  return call;
+}
+
+tree
+m2builtins_BuiltInHugeValLong (location_t location)
+{
+  tree functype = TREE_TYPE (gm2_huge_vall_node);
+  tree funcptr
+      = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_huge_vall_node);
+  tree call = m2treelib_DoCall0 (location, ptr_type_node, funcptr);
+  return call;
+}
+
+static void
+create_function_prototype (location_t location,
+                           struct builtin_function_entry *fe)
+{
+  tree ftype;
+
+  switch (fe->defn)
+    {
+
+    case BT_FN_PTR_SIZE:
+      ftype = build_function_type (ptr_type_node, sizetype_endlink);
+      fe->return_node = ptr_type_node;
+      break;
+
+    case BT_FN_STRING_STRING_CONST_STRING_SIZE:
+    case BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE:
+      ftype = build_function_type (
+          ptr_type_node, tree_cons (NULL_TREE, ptr_type_node,
+                                    tree_cons (NULL_TREE, const_ptr_type_node,
+                                               sizetype_endlink)));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_FLOAT:
+      ftype = float_ftype_void;
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE:
+      ftype = double_ftype_void;
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE:
+      ftype = ldouble_ftype_void;
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT:
+      ftype = float_ftype_float;
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE:
+      ftype = double_ftype_double;
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE:
+      ftype = ldouble_ftype_ldouble;
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_STRING_CONST_STRING_INT:
+      ftype = build_function_type (
+          ptr_type_node, tree_cons (NULL_TREE, ptr_type_node, int_endlink));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_INT_CONST_PTR_CONST_PTR_SIZE:
+      ftype = build_function_type (
+          integer_type_node,
+          tree_cons (NULL_TREE, const_ptr_type_node,
+                     tree_cons (NULL_TREE, const_ptr_type_node, int_endlink)));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_TRAD_PTR_PTR_INT_SIZE:
+      ftype = build_function_type (
+          ptr_type_node, tree_cons (NULL_TREE, ptr_type_node,
+                                    tree_cons (NULL_TREE, integer_type_node,
+                                               sizetype_endlink)));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_STRING_STRING_CONST_STRING:
+      ftype = build_function_type (
+          ptr_type_node, tree_cons (NULL_TREE, ptr_type_node, ptr_endlink));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_INT_CONST_STRING_CONST_STRING:
+      ftype = build_function_type (
+          integer_type_node,
+          tree_cons (NULL_TREE, const_ptr_type_node, ptr_endlink));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_CONST_STRING_CONST_STRING_SIZE:
+      ftype = build_function_type (
+          integer_type_node,
+          tree_cons (
+              NULL_TREE, const_ptr_type_node,
+              tree_cons (NULL_TREE, const_ptr_type_node, sizetype_endlink)));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_CONST_STRING:
+      ftype = build_function_type (integer_type_node, ptr_endlink);
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_STRING_CONST_STRING_CONST_STRING:
+      ftype = build_function_type (
+          ptr_type_node,
+          tree_cons (NULL_TREE, const_ptr_type_node, const_ptr_endlink));
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_SIZE_CONST_STRING_CONST_STRING:
+      ftype = build_function_type (
+          sizetype,
+          tree_cons (NULL_TREE, const_ptr_type_node, const_ptr_endlink));
+      fe->return_node = sizetype;
+      break;
+    case BT_FN_PTR_UNSIGNED:
+      ftype = build_function_type (ptr_type_node, unsigned_endlink);
+      fe->return_node = ptr_type_node;
+      break;
+    case BT_FN_VOID_PTR_INT:
+      ftype = build_function_type (
+          void_type_node, tree_cons (NULL_TREE, ptr_type_node, int_endlink));
+      fe->return_node = void_type_node;
+      break;
+    case BT_FN_INT_PTR:
+      ftype = build_function_type (integer_type_node, ptr_endlink);
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_FLOAT:
+      ftype = build_function_type (
+          integer_type_node, tree_cons (NULL_TREE, float_type_node, endlink));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_DOUBLE:
+      ftype = build_function_type (
+          integer_type_node, tree_cons (NULL_TREE, double_type_node, endlink));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_INT_LONG_DOUBLE:
+      ftype = build_function_type (
+          integer_type_node,
+          tree_cons (NULL_TREE, long_double_type_node, endlink));
+      fe->return_node = integer_type_node;
+      break;
+    case BT_FN_FLOAT_FCOMPLEX:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, complex_float_type_node, endlink));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DCOMPLEX:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, complex_double_type_node, endlink));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LDCOMPLEX:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (NULL_TREE, complex_long_double_type_node, endlink));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FCOMPLEX_FCOMPLEX:
+      ftype = build_function_type (
+          complex_float_type_node,
+          tree_cons (NULL_TREE, complex_float_type_node, endlink));
+      fe->return_node = complex_float_type_node;
+      break;
+    case BT_FN_DCOMPLEX_DCOMPLEX:
+      ftype = build_function_type (
+          complex_double_type_node,
+          tree_cons (NULL_TREE, complex_double_type_node, endlink));
+      fe->return_node = complex_double_type_node;
+      break;
+    case BT_FN_LDCOMPLEX_LDCOMPLEX:
+      ftype = build_function_type (
+          complex_long_double_type_node,
+          tree_cons (NULL_TREE, complex_long_double_type_node, endlink));
+      fe->return_node = complex_long_double_type_node;
+      break;
+    case BT_FN_DCOMPLEX_DOUBLE_DCOMPLEX:
+      ftype = build_function_type (
+          complex_double_type_node,
+          tree_cons (NULL_TREE, complex_double_type_node,
+                     tree_cons (NULL_TREE, double_type_node, endlink)));
+      fe->return_node = complex_double_type_node;
+      break;
+    case BT_FN_FCOMPLEX_FLOAT_FCOMPLEX:
+      ftype = build_function_type (
+          complex_float_type_node,
+          tree_cons (NULL_TREE, complex_float_type_node,
+                     tree_cons (NULL_TREE, float_type_node, endlink)));
+      fe->return_node = complex_float_type_node;
+      break;
+    case BT_FN_LDCOMPLEX_LONG_DOUBLE_LDCOMPLEX:
+      ftype = build_function_type (
+          complex_long_double_type_node,
+          tree_cons (NULL_TREE, complex_long_double_type_node,
+                     tree_cons (NULL_TREE, long_double_type_node, endlink)));
+      fe->return_node = complex_long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_FLOATPTR:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, floatptr_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_DOUBLEPTR:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, doubleptr_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLEPTR:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (
+              NULL_TREE, long_double_type_node,
+              tree_cons (NULL_TREE, long_doubleptr_type_node, endlink)));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_LONG_DOUBLE:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, long_double_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_LONG_DOUBLE:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, long_double_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (NULL_TREE, long_double_type_node,
+                     tree_cons (NULL_TREE, long_double_type_node, endlink)));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_LONG:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, long_integer_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_LONG:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, long_integer_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (NULL_TREE, long_double_type_node,
+                     tree_cons (NULL_TREE, long_integer_type_node, endlink)));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_INT:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, integer_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_INT:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, integer_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    case BT_FN_LONG_DOUBLE_LONG_DOUBLE_INT:
+      ftype = build_function_type (
+          long_double_type_node,
+          tree_cons (NULL_TREE, long_double_type_node,
+                     tree_cons (NULL_TREE, integer_type_node, endlink)));
+      fe->return_node = long_double_type_node;
+      break;
+    case BT_FN_FLOAT_FLOAT_FLOAT:
+      ftype = build_function_type (
+          float_type_node,
+          tree_cons (NULL_TREE, float_type_node,
+                     tree_cons (NULL_TREE, float_type_node, endlink)));
+      fe->return_node = float_type_node;
+      break;
+    case BT_FN_DOUBLE_DOUBLE_DOUBLE:
+      ftype = build_function_type (
+          double_type_node,
+          tree_cons (NULL_TREE, double_type_node,
+                     tree_cons (NULL_TREE, double_type_node, endlink)));
+      fe->return_node = double_type_node;
+      break;
+    default:
+      ERROR ("enum has no case");
+    }
+  fe->function_node
+      = builtin_function (location, fe->name, ftype, fe->function_code,
+                          fe->fclass, fe->library_name, NULL);
+}
+
+static tree
+find_builtin_tree (const char *name)
+{
+  struct builtin_function_entry *fe;
+
+  for (fe = &list_of_builtins[0]; fe->name != NULL; fe++)
+    if (strcmp (name, fe->name) == 0)
+      return fe->function_node;
+
+  ERROR ("cannot find builtin function");
+  return NULL_TREE;
+}
+
+
+static void
+set_decl_built_in_class (tree decl, built_in_class c)
+{
+  FUNCTION_DECL_CHECK (decl)->function_decl.built_in_class = c;
+}
+
+
+static void
+set_decl_function_code (tree decl, built_in_function f)
+{
+  tree_function_decl &fndecl = FUNCTION_DECL_CHECK (decl)->function_decl;
+  fndecl.function_code = f;
+}
+
+/* Define a single builtin.  */
+static void
+define_builtin (enum built_in_function val, const char *name, tree type,
+                const char *libname, int flags)
+{
+  tree decl;
+
+  decl = build_decl (BUILTINS_LOCATION, FUNCTION_DECL, get_identifier (name),
+                     type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  SET_DECL_ASSEMBLER_NAME (decl, get_identifier (libname));
+  m2block_pushDecl (decl);
+  set_decl_built_in_class (decl, BUILT_IN_NORMAL);
+  set_decl_function_code (decl, val);
+  set_call_expr_flags (decl, flags);
+
+  set_builtin_decl (val, decl, true);
+}
+
+void
+m2builtins_init (location_t location)
+{
+  int i;
+
+  m2block_pushGlobalScope ();
+  endlink = void_list_node;
+  sizetype_endlink = tree_cons (NULL_TREE, sizetype, endlink);
+  math_endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+  int_endlink = tree_cons (NULL_TREE, integer_type_node, NULL_TREE);
+  ptr_endlink = tree_cons (NULL_TREE, ptr_type_node, NULL_TREE);
+  const_ptr_endlink = tree_cons (NULL_TREE, const_ptr_type_node, NULL_TREE);
+  unsigned_endlink = tree_cons (NULL_TREE, unsigned_type_node, NULL_TREE);
+
+  float_ftype_void = build_function_type (float_type_node, math_endlink);
+  double_ftype_void = build_function_type (double_type_node, math_endlink);
+  ldouble_ftype_void
+      = build_function_type (long_double_type_node, math_endlink);
+
+  long_doubleptr_type_node = build_pointer_type (long_double_type_node);
+  doubleptr_type_node = build_pointer_type (double_type_node);
+  floatptr_type_node = build_pointer_type (float_type_node);
+
+  float_ftype_float = build_function_type (
+      float_type_node, tree_cons (NULL_TREE, float_type_node, math_endlink));
+
+  double_ftype_double = build_function_type (
+      double_type_node, tree_cons (NULL_TREE, double_type_node, math_endlink));
+
+  ldouble_ftype_ldouble = build_function_type (
+      long_double_type_node,
+      tree_cons (NULL_TREE, long_double_type_node, endlink));
+
+  builtin_ftype_int_var = build_function_type (
+      integer_type_node, tree_cons (NULL_TREE, double_type_node, endlink));
+
+  for (i = 0; list_of_builtins[i].name != NULL; i++)
+    create_function_prototype (location, &list_of_builtins[i]);
+
+  define_builtin (BUILT_IN_TRAP, "__builtin_trap",
+                  build_function_type_list (void_type_node, NULL_TREE),
+                  "__builtin_trap", ECF_NOTHROW | ECF_LEAF | ECF_NORETURN);
+  define_builtin (BUILT_IN_ISGREATER, "isgreater", builtin_ftype_int_var,
+                  "__builtin_isgreater", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISGREATEREQUAL, "isgreaterequal",
+                  builtin_ftype_int_var, "__builtin_isgreaterequal",
+                  ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISLESS, "isless", builtin_ftype_int_var,
+                  "__builtin_isless", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISLESSEQUAL, "islessequal", builtin_ftype_int_var,
+                  "__builtin_islessequal", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISLESSGREATER, "islessgreater",
+                  builtin_ftype_int_var, "__builtin_islessgreater",
+                  ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+  define_builtin (BUILT_IN_ISUNORDERED, "isunordered", builtin_ftype_int_var,
+                  "__builtin_isunordered", ECF_CONST | ECF_NOTHROW | ECF_LEAF);
+
+  gm2_alloca_node = find_builtin_tree ("__builtin_alloca");
+  gm2_memcpy_node = find_builtin_tree ("__builtin_memcpy");
+  gm2_huge_valf_node = find_builtin_tree ("__builtin_huge_valf");
+  gm2_huge_val_node = find_builtin_tree ("__builtin_huge_val");
+  gm2_huge_vall_node = find_builtin_tree ("__builtin_huge_vall");
+  gm2_isfinite_node = find_builtin_tree ("__builtin_isfinite");
+  m2block_popGlobalScope ();
+}
+
+#include "gt-m2-m2builtins.h"
+
+/* END m2builtins.  */
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2color.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2color.cc	2022-10-07 20:21:18.650096940 +0100
@@ -0,0 +1,66 @@ 
+/* m2color.cc interface to gcc colorization.
+
+Copyright (C) 2019-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/>.  */
+
+#define m2color_c
+#include "m2color.h"
+
+#include "gcc-consolidation.h"
+#include "diagnostic-color.h"
+
+
+char *
+m2color_colorize_start (bool show_color, char *name, unsigned int name_len)
+{
+  return const_cast<char*> (colorize_start (show_color, name, name_len));
+}
+
+
+char *
+m2color_colorize_stop (bool show_color)
+{
+  return const_cast<char*> (colorize_stop (show_color));
+}
+
+
+char *
+m2color_open_quote (void)
+{
+  return const_cast<char*> (open_quote);
+}
+
+
+char *
+m2color_close_quote (void)
+{
+  return const_cast<char*> (close_quote);
+}
+
+
+void
+_M2_m2color_init ()
+{
+}
+
+
+void
+_M2_m2color_finish ()
+{
+}
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2configure.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2configure.cc	2022-10-07 20:21:18.650096940 +0100
@@ -0,0 +1,101 @@ 
+/* m2configure.cc provides an interface to some configuration values.
+
+Copyright (C) 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/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "libiberty.h"
+
+#include "config.h"
+#include "system.h"
+#include "libiberty.h"
+
+#include "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+#include "m2convert.h"
+
+/* Prototypes.  */
+
+#define m2configure_c
+
+#include "m2assert.h"
+#include "m2builtins.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2options.h"
+#include "m2configure.h"
+
+#include "m2/gm2version.h"
+#include "m2/gm2config.h"
+
+#define CPPPROGRAM  "cc1"
+
+
+/* gen_gm2_libexec returns a string containing libexec /
+   DEFAULT_TARGET_MACHINE string / DEFAULT_TARGET_MACHINE.  */
+
+static char *
+gen_gm2_libexec (const char *libexec)
+{
+  int l = strlen (libexec) + 1 + strlen (DEFAULT_TARGET_MACHINE) + 1
+          + strlen (DEFAULT_TARGET_VERSION) + 1;
+  char *s = (char *)xmalloc (l);
+  char dir_sep[2];
+
+  dir_sep[0] = DIR_SEPARATOR;
+  dir_sep[1] = (char)0;
+
+  strcpy (s, libexec);
+  strcat (s, dir_sep);
+  strcat (s, DEFAULT_TARGET_MACHINE);
+  strcat (s, dir_sep);
+  strcat (s, DEFAULT_TARGET_VERSION);
+  return s;
+}
+
+/* FullPathCPP returns the fullpath and program name to cpp.  */
+
+char *
+m2configure_FullPathCPP (void)
+{
+  if (M2Options_GetCpp ())
+    {
+      char *path = (char *) M2Options_GetB ();
+
+      if (path == NULL)
+	path = gen_gm2_libexec (STANDARD_LIBEXEC_PREFIX);
+
+      if (strcmp (path, "") == 0)
+	return xstrdup (CPPPROGRAM);
+
+      char *full = (char *)xmalloc (strlen (path) + 1 + strlen (CPPPROGRAM) + 1);
+      strcpy (full, path);
+      char *sep = (char *)alloca (2);
+      sep[0] = DIR_SEPARATOR;
+      sep[1] = (char)0;
+      strcat (full, sep);
+      strcat (full, CPPPROGRAM);
+      return full;
+    }
+  return NULL;
+}
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2convert.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2convert.cc	2022-10-07 20:21:18.650096940 +0100
@@ -0,0 +1,659 @@ 
+/* m2convert.cc provides GCC tree conversion for the Modula-2 language.
+
+Copyright (C) 2012-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/>.  */
+
+#include "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2convert_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2convert.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2expr.h"
+#include "m2statement.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+
+static tree const_to_ISO_type (location_t location, tree expr, tree iso_type);
+static tree const_to_ISO_aggregate_type (location_t location, tree expr,
+                                         tree iso_type);
+
+/* These enumerators are possible types of unsafe conversions.
+   SAFE_CONVERSION The conversion is safe UNSAFE_OTHER Another type of
+   conversion with problems UNSAFE_SIGN Conversion between signed and
+   unsigned integers which are all warned about immediately, so this is
+   unused UNSAFE_REAL Conversions that reduce the precision of reals
+   including conversions from reals to integers.  */
+enum conversion_safety
+{
+  SAFE_CONVERSION = 0,
+  UNSAFE_OTHER,
+  UNSAFE_SIGN,
+  UNSAFE_REAL
+};
+
+/* ConvertString - converts string, expr, into a string of type,
+   type.  */
+
+tree
+m2convert_ConvertString (tree type, tree expr)
+{
+  const char *str = TREE_STRING_POINTER (expr);
+  int len = TREE_STRING_LENGTH (expr);
+  return m2decl_BuildStringConstantType (len, str, type);
+}
+
+
+/* (Taken from c-common.cc and trimmed for Modula-2)
+
+   Checks if expression EXPR of real/integer type cannot be converted to
+   the real/integer type TYPE.  Function returns non-zero when:
+   EXPR is a constant which cannot be exactly converted to TYPE.
+   EXPR is not a constant and size of EXPR's type > than size of
+   TYPE, for EXPR type and TYPE being both integers or both real.
+   EXPR is not a constant of real type and TYPE is an integer.
+   EXPR is not a constant of integer type which cannot be exactly
+   converted to real type.  Function allows conversions between types
+   of different signedness and can return SAFE_CONVERSION (zero) in
+   that case.  Function can produce signedness warnings if
+   PRODUCE_WARNS is true.  */
+
+enum conversion_safety
+unsafe_conversion_p (location_t loc, tree type, tree expr, bool produce_warns)
+{
+  enum conversion_safety give_warning = SAFE_CONVERSION; /* Is 0 or false.  */
+  tree expr_type = TREE_TYPE (expr);
+
+  if (TREE_CODE (expr) == REAL_CST || TREE_CODE (expr) == INTEGER_CST)
+    {
+
+      /* Warn for real constant that is not an exact integer converted to
+         integer type.  */
+      if (TREE_CODE (expr_type) == REAL_TYPE
+          && TREE_CODE (type) == INTEGER_TYPE)
+        {
+          if (!real_isinteger (TREE_REAL_CST_PTR (expr),
+                               TYPE_MODE (expr_type)))
+            give_warning = UNSAFE_REAL;
+        }
+      /* Warn for an integer constant that does not fit into integer type.  */
+      else if (TREE_CODE (expr_type) == INTEGER_TYPE
+               && TREE_CODE (type) == INTEGER_TYPE
+               && !int_fits_type_p (expr, type))
+        {
+          if (TYPE_UNSIGNED (type) && !TYPE_UNSIGNED (expr_type)
+              && tree_int_cst_sgn (expr) < 0)
+            {
+              if (produce_warns)
+                warning_at (loc, OPT_Wsign_conversion,
+                            "negative integer"
+                            " implicitly converted to unsigned type");
+            }
+          else if (!TYPE_UNSIGNED (type) && TYPE_UNSIGNED (expr_type))
+            {
+              if (produce_warns)
+                warning_at (loc, OPT_Wsign_conversion,
+                            "conversion of unsigned"
+                            " constant value to negative integer");
+            }
+          else
+            give_warning = UNSAFE_OTHER;
+        }
+      else if (TREE_CODE (type) == REAL_TYPE)
+        {
+          /* Warn for an integer constant that does not fit into real type.  */
+          if (TREE_CODE (expr_type) == INTEGER_TYPE)
+            {
+              REAL_VALUE_TYPE a = real_value_from_int_cst (0, expr);
+              if (!exact_real_truncate (TYPE_MODE (type), &a))
+                give_warning = UNSAFE_REAL;
+            }
+
+          /* Warn for a real constant that does not fit into a smaller real
+          type.  */
+          else if (TREE_CODE (expr_type) == REAL_TYPE
+                   && TYPE_PRECISION (type) < TYPE_PRECISION (expr_type))
+            {
+              REAL_VALUE_TYPE a = TREE_REAL_CST (expr);
+              if (!exact_real_truncate (TYPE_MODE (type), &a))
+                give_warning = UNSAFE_REAL;
+            }
+        }
+    }
+  else
+    {
+      /* Warn for real types converted to integer types.  */
+      if (TREE_CODE (expr_type) == REAL_TYPE
+          && TREE_CODE (type) == INTEGER_TYPE)
+        give_warning = UNSAFE_REAL;
+
+    }
+
+  return give_warning;
+}
+
+/* (Taken from c-common.cc and trimmed for Modula-2)
+
+   Warns if the conversion of EXPR to TYPE may alter a value.  This is
+   a helper function for warnings_for_convert_and_check.  */
+
+static void
+conversion_warning (location_t loc, tree type, tree expr)
+{
+  tree expr_type = TREE_TYPE (expr);
+  enum conversion_safety conversion_kind;
+
+  if (!warn_conversion && !warn_sign_conversion && !warn_float_conversion)
+    return;
+
+  switch (TREE_CODE (expr))
+    {
+    case EQ_EXPR:
+    case NE_EXPR:
+    case LE_EXPR:
+    case GE_EXPR:
+    case LT_EXPR:
+    case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case TRUTH_XOR_EXPR:
+    case TRUTH_NOT_EXPR:
+
+      /* Conversion from boolean to a signed:1 bit-field (which only can
+	 hold the values 0 and -1) doesn't lose information - but it does
+	 change the value.  */
+      if (TYPE_PRECISION (type) == 1 && !TYPE_UNSIGNED (type))
+        warning_at (loc, OPT_Wconversion,
+                    "conversion to %qT from boolean expression", type);
+      return;
+
+    case REAL_CST:
+    case INTEGER_CST:
+      conversion_kind = unsafe_conversion_p (loc, type, expr, true);
+      if (conversion_kind == UNSAFE_REAL)
+        warning_at (loc, OPT_Wfloat_conversion,
+                    "conversion to %qT alters %qT constant value", type,
+                    expr_type);
+      else if (conversion_kind)
+        warning_at (loc, OPT_Wconversion,
+                    "conversion to %qT alters %qT constant value", type,
+                    expr_type);
+      return;
+
+    case COND_EXPR:
+      {
+
+        /* In case of COND_EXPR, we do not care about the type of COND_EXPR,
+	   only about the conversion of each operand.  */
+        tree op1 = TREE_OPERAND (expr, 1);
+        tree op2 = TREE_OPERAND (expr, 2);
+
+        conversion_warning (loc, type, op1);
+        conversion_warning (loc, type, op2);
+        return;
+      }
+
+    default:  /* 'expr' is not a constant.  */
+      conversion_kind = unsafe_conversion_p (loc, type, expr, true);
+      if (conversion_kind == UNSAFE_REAL)
+        warning_at (loc, OPT_Wfloat_conversion,
+                    "conversion to %qT from %qT may alter its value", type,
+                    expr_type);
+      else if (conversion_kind)
+        warning_at (loc, OPT_Wconversion,
+                    "conversion to %qT from %qT may alter its value", type,
+                    expr_type);
+    }
+}
+
+/* (Taken from c-common.cc and trimmed for Modula-2)
+
+   Produce warnings after a conversion.  RESULT is the result of
+   converting EXPR to TYPE.  This is a helper function for
+   convert_and_check and cp_convert_and_check.  */
+
+void
+warnings_for_convert_and_check (location_t loc, tree type, tree expr,
+                                tree result)
+{
+  if (TREE_CODE (expr) == INTEGER_CST && (TREE_CODE (type) == INTEGER_TYPE
+                                          || TREE_CODE (type) == ENUMERAL_TYPE)
+      && !int_fits_type_p (expr, type))
+    {
+
+      /* Do not diagnose overflow in a constant expression merely because a
+	 conversion overflowed.  */
+      if (TREE_OVERFLOW (result))
+        TREE_OVERFLOW (result) = TREE_OVERFLOW (expr);
+
+      if (TYPE_UNSIGNED (type))
+        {
+
+          /* This detects cases like converting -129 or 256 to unsigned
+	     char.  */
+          if (!int_fits_type_p (expr, m2type_gm2_signed_type (type)))
+            warning_at (loc, OPT_Woverflow,
+                        "large integer implicitly truncated to unsigned type");
+          else
+            conversion_warning (loc, type, expr);
+        }
+      else if (!int_fits_type_p (expr, m2type_gm2_unsigned_type (type)))
+        warning_at (loc, OPT_Woverflow,
+                    "overflow in implicit constant conversion");
+      /* No warning for converting 0x80000000 to int.  */
+      else if (pedantic && (TREE_CODE (TREE_TYPE (expr)) != INTEGER_TYPE
+                            || TYPE_PRECISION (TREE_TYPE (expr))
+                                   != TYPE_PRECISION (type)))
+        warning_at (loc, OPT_Woverflow,
+                    "overflow in implicit constant conversion");
+
+      else
+        conversion_warning (loc, type, expr);
+    }
+  else if ((TREE_CODE (result) == INTEGER_CST
+            || TREE_CODE (result) == FIXED_CST)
+           && TREE_OVERFLOW (result))
+    warning_at (loc, OPT_Woverflow,
+                "overflow in implicit constant conversion");
+  else
+    conversion_warning (loc, type, expr);
+}
+
+/* (Taken from c-common.cc and trimmed for Modula-2)
+
+   Convert EXPR to TYPE, warning about conversion problems with
+   constants.  Invoke this function on every expression that is
+   converted implicitly, i.e.  because of language rules and not
+   because of an explicit cast.  */
+
+static tree
+convert_and_check (location_t loc, tree type, tree expr)
+{
+  tree result;
+  tree expr_for_warning;
+
+  /* Convert from a value with possible excess precision rather than
+     via the semantic type, but do not warn about values not fitting
+     exactly in the semantic type.  */
+  if (TREE_CODE (expr) == EXCESS_PRECISION_EXPR)
+    {
+      tree orig_type = TREE_TYPE (expr);
+      expr = TREE_OPERAND (expr, 0);
+      expr_for_warning = convert (orig_type, expr);
+      if (orig_type == type)
+        return expr_for_warning;
+    }
+  else
+    expr_for_warning = expr;
+
+  if (TREE_TYPE (expr) == type)
+    return expr;
+
+  result = convert_loc (loc, type, expr);
+
+  if (!TREE_OVERFLOW_P (expr) && result != error_mark_node)
+    warnings_for_convert_and_check (loc, type, expr_for_warning, result);
+
+  return result;
+}
+
+
+static tree
+doOrdinal (tree value)
+{
+  if (TREE_CODE (value) == STRING_CST && (m2expr_StringLength (value) <= 1))
+    {
+      const char *p = TREE_STRING_POINTER (value);
+      int i = p[0];
+
+      return m2decl_BuildIntegerConstant (i);
+    }
+  return value;
+}
+
+static int
+same_size_types (location_t location, tree t1, tree t2)
+{
+  tree n1 = m2expr_GetSizeOf (location, t1);
+  tree n2 = m2expr_GetSizeOf (location, t2);
+
+  return m2expr_CompareTrees (n1, n2) == 0;
+}
+
+static int
+converting_ISO_generic (location_t location, tree type, tree value,
+                        tree generic_type, tree *result)
+{
+  tree value_type = m2tree_skip_type_decl (TREE_TYPE (value));
+
+  if (value_type == type)
+    /* We let the caller deal with this.  */
+    return FALSE;
+
+  if ((TREE_CODE (value) == INTEGER_CST) && (type == generic_type))
+    {
+      *result = const_to_ISO_type (location, value, generic_type);
+      return TRUE;
+    }
+
+  if (same_size_types (location, type, value_type))
+    {
+      if (value_type == generic_type)
+        {
+          tree pt = build_pointer_type (type);
+          tree a = build1 (ADDR_EXPR, pt, value);
+          tree t = build1 (INDIRECT_REF, type, a);
+          *result = build1 (NOP_EXPR, type, t);
+          return TRUE;
+        }
+      else if (type == generic_type)
+        {
+          tree pt = build_pointer_type (type);
+          tree a = build1 (ADDR_EXPR, pt, value);
+          tree t = build1 (INDIRECT_REF, type, a);
+          *result = build1 (NOP_EXPR, type, t);
+          return TRUE;
+        }
+    }
+  return FALSE;
+}
+
+/* convert_char_to_array - convert a single char, value, into an
+   type.  The type will be array [..] of char.  The array type
+   returned will have nuls appended to pad the single char to the
+   correct array length.  */
+
+static tree
+convert_char_to_array (location_t location, tree type, tree value)
+{
+  tree i = m2decl_BuildIntegerConstant (0);
+  struct struct_constructor *c
+      = (struct struct_constructor *)m2type_BuildStartArrayConstructor (type);
+  tree n = m2type_GetArrayNoOfElements (location, type);
+  char nul[1];
+
+  nul[0] = (char)0;
+
+  /* Store the initial char.  */
+  m2type_BuildArrayConstructorElement (c, value, i);
+  i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1), FALSE);
+
+  /* Now pad out the remaining elements with nul chars.  */
+  while (m2expr_CompareTrees (i, n) < 0)
+    {
+      m2type_BuildArrayConstructorElement (
+          c, m2type_BuildCharConstant (location, &nul[0]), i);
+      i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
+                           FALSE);
+    }
+  return m2type_BuildEndArrayConstructor (c);
+}
+
+/* convert_string_to_array - convert a STRING_CST into an array type.
+   array [..] of char.  The array constant returned will have nuls
+   appended to pad the contents to the correct length.  */
+
+static tree
+convert_string_to_array (location_t location, tree type, tree value)
+{
+  tree n = m2type_GetArrayNoOfElements (location, type);
+
+  return m2type_BuildArrayStringConstructor (location, type, value, n);
+}
+
+/* BuildConvert - build and return tree VAL (type, value).
+   checkOverflow determines whether we should suppress overflow
+   checking.  */
+
+tree
+m2convert_BuildConvert (location_t location, tree type, tree value,
+                        int checkOverflow)
+{
+  type = m2tree_skip_type_decl (type);
+  tree t;
+
+  value = fold (value);
+  STRIP_NOPS (value);
+  value = m2expr_FoldAndStrip (value);
+
+  if (TREE_CODE (value) == STRING_CST && (m2expr_StringLength (value) <= 1)
+      && (m2tree_IsOrdinal (type)))
+    value = doOrdinal (value);
+  else if (TREE_CODE (value) == FUNCTION_DECL && TREE_TYPE (value) != type)
+    value = m2expr_BuildAddr (0, value, FALSE);
+
+  if (converting_ISO_generic (location, type, value, m2type_GetByteType (), &t)
+      || converting_ISO_generic (location, type, value,
+                                 m2type_GetISOLocType (), &t)
+      || converting_ISO_generic (location, type, value,
+                                 m2type_GetISOByteType (), &t)
+      || converting_ISO_generic (location, type, value,
+                                 m2type_GetISOWordType (), &t)
+      || converting_ISO_generic (location, type, value, m2type_GetM2Word16 (),
+                                 &t)
+      || converting_ISO_generic (location, type, value, m2type_GetM2Word32 (),
+                                 &t)
+      || converting_ISO_generic (location, type, value, m2type_GetM2Word64 (),
+                                 &t))
+    return t;
+
+  if (TREE_CODE (type) == ARRAY_TYPE
+      && TREE_TYPE (type) == m2type_GetM2CharType ())
+    {
+      if (TREE_TYPE (value) == m2type_GetM2CharType ())
+
+        /* Passing a const char to an array [..] of char.  So we convert
+	   const char into the correct length string.  */
+        return convert_char_to_array (location, type, value);
+      if (TREE_CODE (value) == STRING_CST)
+        /* Convert a string into an array constant, padding with zeros if
+           necessary.  */
+        return convert_string_to_array (location, type, value);
+    }
+
+  if (checkOverflow)
+    return convert_and_check (location, type, value);
+  else
+    return convert (type, value);
+}
+
+/* const_to_ISO_type - perform VAL (iso_type, expr).  */
+
+static tree
+const_to_ISO_type (location_t location, tree expr, tree iso_type)
+{
+  tree n = m2expr_GetSizeOf (location, iso_type);
+
+  if ((m2expr_CompareTrees (n, m2decl_BuildIntegerConstant (1)) == 0)
+      && (iso_type == m2type_GetByteType ()
+          || iso_type == m2type_GetISOLocType ()
+          || iso_type == m2type_GetISOByteType ()))
+    return build1 (NOP_EXPR, iso_type, expr);
+  return const_to_ISO_aggregate_type (location, expr, iso_type);
+}
+
+/* const_to_ISO_aggregate_type - perform VAL (iso_type, expr).  The
+   iso_type will be declared by the SYSTEM module as: TYPE iso_type =
+   ARRAY [0..n] OF LOC
+
+   this function will store a constant into the iso_type in the correct
+   endian order.  It converts the expr into a unsigned int or signed
+   int and then strips it a byte at a time.  */
+
+static tree
+const_to_ISO_aggregate_type (location_t location, tree expr, tree iso_type)
+{
+  tree byte;
+  m2type_Constructor c;
+  tree i = m2decl_BuildIntegerConstant (0);
+  tree n = m2expr_GetSizeOf (location, iso_type);
+  tree max_uint = m2decl_BuildIntegerConstant (256);
+
+  while (m2expr_CompareTrees (i, n) < 0)
+    {
+      max_uint = m2expr_BuildMult (location, max_uint,
+                                   m2decl_BuildIntegerConstant (256), FALSE);
+      i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
+                           FALSE);
+    }
+  max_uint = m2expr_BuildDivFloor (location, max_uint,
+                                   m2decl_BuildIntegerConstant (2), FALSE);
+
+  if (m2expr_CompareTrees (expr, m2decl_BuildIntegerConstant (0)) < 0)
+    expr = m2expr_BuildAdd (location, expr, max_uint, FALSE);
+
+  i = m2decl_BuildIntegerConstant (0);
+  c = m2type_BuildStartArrayConstructor (iso_type);
+  while (m2expr_CompareTrees (i, n) < 0)
+    {
+      byte = m2expr_BuildModTrunc (location, expr,
+                                   m2decl_BuildIntegerConstant (256), FALSE);
+      if (BYTES_BIG_ENDIAN)
+        m2type_BuildArrayConstructorElement (
+            c, m2convert_ToLoc (location, byte),
+            m2expr_BuildSub (location, m2expr_BuildSub (location, n, i, FALSE),
+                             m2decl_BuildIntegerConstant (1), FALSE));
+      else
+        m2type_BuildArrayConstructorElement (
+            c, m2convert_ToLoc (location, byte), i);
+
+      i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
+                           FALSE);
+      expr = m2expr_BuildDivFloor (location, expr,
+                                   m2decl_BuildIntegerConstant (256), FALSE);
+    }
+
+  return m2type_BuildEndArrayConstructor (c);
+}
+
+/* ConvertConstantAndCheck - in Modula-2 sementics: RETURN( VAL(type,
+   expr) ).  Only to be used for a constant expr, overflow checking
+   is performed.  */
+
+tree
+m2convert_ConvertConstantAndCheck (location_t location, tree type, tree expr)
+{
+  tree etype;
+  expr = fold (expr);
+  STRIP_NOPS (expr);
+  expr = m2expr_FoldAndStrip (expr);
+  etype = TREE_TYPE (expr);
+
+  m2assert_AssertLocation (location);
+  if (etype == type)
+    return expr;
+
+  if (TREE_CODE (expr) == FUNCTION_DECL)
+    expr = m2expr_BuildAddr (location, expr, FALSE);
+
+  type = m2tree_skip_type_decl (type);
+  if (type == m2type_GetByteType () || type == m2type_GetISOLocType ()
+      || type == m2type_GetISOByteType () || type == m2type_GetISOWordType ()
+      || type == m2type_GetM2Word16 () || type == m2type_GetM2Word32 ()
+      || type == m2type_GetM2Word64 ())
+    return const_to_ISO_type (location, expr, type);
+
+  return convert_and_check (location, type, m2expr_FoldAndStrip (expr));
+}
+
+/* ToWord - converts an expression (Integer or Ordinal type) into a
+   WORD.  */
+
+tree
+m2convert_ToWord (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetWordType (), expr, FALSE);
+}
+
+/* ToCardinal - convert an expression, expr, to a CARDINAL.  */
+
+tree
+m2convert_ToCardinal (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetCardinalType (), expr,
+                                 FALSE);
+}
+
+/* convertToPtr - if the type of tree, t, is not a ptr_type_node then
+   convert it.  */
+
+tree
+m2convert_convertToPtr (location_t location, tree type)
+{
+  if (TREE_CODE (TREE_TYPE (type)) == POINTER_TYPE)
+    return type;
+  else
+    return m2convert_BuildConvert (location, m2type_GetPointerType (), type,
+                                   FALSE);
+}
+
+/* ToInteger - convert an expression, expr, to an INTEGER.  */
+
+tree
+m2convert_ToInteger (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetIntegerType (), expr,
+                                 FALSE);
+}
+
+/* ToBitset - convert an expression, expr, to a BITSET type.  */
+
+tree
+m2convert_ToBitset (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetBitsetType (), expr,
+                                 FALSE);
+}
+
+/* ToLoc - convert an expression, expr, to a LOC.  */
+
+tree
+m2convert_ToLoc (location_t location, tree expr)
+{
+  return m2convert_BuildConvert (location, m2type_GetISOByteType (), expr,
+                                 FALSE);
+}
+
+/* GenericToType - converts, expr, into, type, providing that expr is
+   a generic system type (byte, word etc).  Otherwise expr is
+   returned unaltered.  */
+
+tree
+m2convert_GenericToType (location_t location, tree type, tree expr)
+{
+  tree etype = TREE_TYPE (expr);
+
+  type = m2tree_skip_type_decl (type);
+  if (type == etype)
+    return expr;
+
+  if (type == m2type_GetISOWordType () || type == m2type_GetM2Word16 ()
+      || type == m2type_GetM2Word32 () || type == m2type_GetM2Word64 ())
+    return const_to_ISO_type (location, expr, type);
+
+  return expr;
+}
diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2decl.cc
--- /dev/null	2022-08-24 16:22:16.888000070 +0100
+++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2decl.cc	2022-10-07 20:21:18.650096940 +0100
@@ -0,0 +1,438 @@ 
+/* m2decl.cc provides an interface to GCC decl trees.
+
+Copyright (C) 2012-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/>.  */
+
+#include "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#define m2decl_c
+#include "m2assert.h"
+#include "m2block.h"
+#include "m2decl.h"
+#include "m2expr.h"
+#include "m2tree.h"
+#include "m2treelib.h"
+#include "m2type.h"
+#include "m2convert.h"
+
+extern GTY (()) tree current_function_decl;
+
+/* Used in BuildStartFunctionType.  */
+static GTY (()) tree param_type_list;
+static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
+                                                call/define a function.  */
+
+/* DeclareM2linkGlobals creates the following code in the application
+   module globals:
+
+   int StaticInitialization = ScaffoldStatic;
+   const char *ForcedModuleInitOrder = RuntimeOverride;  */
+
+void
+m2decl_DeclareM2linkGlobals (location_t location,
+			     int ScaffoldStatic, const char *RuntimeOverride)
+{
+  m2block_pushGlobalScope ();
+  /* Generate: int StaticInitialization = ScaffoldStatic;  */
+  tree static_init = m2decl_DeclareKnownVariable (location, "StaticInitialization",
+						  integer_type_node,
+						  TRUE, FALSE, FALSE, TRUE, NULL_TREE);
+  DECL_INITIAL (static_init) = m2decl_BuildIntegerConstant (ScaffoldStatic);
+  /* Generate: const char *ForcedModuleInitOrder = RuntimeOverride;  */
+  tree ptr_to_char = build_pointer_type (char_type_node);
+  TYPE_READONLY (ptr_to_char) = TRUE;
+  tree forced_order = m2decl_DeclareKnownVariable (location, "ForcedModuleInitOrder",
+						   ptr_to_char,
+						   TRUE, FALSE, FALSE, TRUE, NULL_TREE);
+  if (RuntimeOverride == NULL || (strlen (RuntimeOverride) == 0))
+    DECL_INITIAL (forced_order) = m2convert_BuildConvert (location, ptr_to_char,
+							  m2decl_BuildIntegerConstant (0),
+							  FALSE);
+  else
+    DECL_INITIAL (forced_order) = build_string_literal (strlen (RuntimeOverride), RuntimeOverride);
+  m2block_popGlobalScope ();
+}
+
+
+/* DeclareKnownVariable declares a variable to GCC.  */
+
+tree
+m2decl_DeclareKnownVariable (location_t location, const char *name, tree type,
+                             int exported, int imported, int istemporary,
+                             int isglobal, tree scope)
+{
+  tree id;
+  tree decl;
+
+  m2assert_AssertLocation (location);
+  ASSERT (m2tree_is_type (type), type);
+  ASSERT_BOOL (isglobal);
+
+  id = get_identifier (name);
+  type = m2tree_skip_type_decl (type);
+  decl = build_decl (location, VAR_DECL, id, type);
+
+  DECL_SOURCE_LOCATION (decl) = location;
+
+  DECL_EXTERNAL (decl) = imported;
+  TREE_STATIC (decl) = isglobal;
+  TREE_PUBLIC (decl) = exported || imported;
+
+  gcc_assert ((istemporary == 0) || (istemporary == 1));
+
+  /* The variable was not declared by GCC, but by the front end.  */
+  DECL_ARTIFICIAL (decl) = istemporary;
+  /* If istemporary then we don't want debug info for it.  */
+  DECL_IGNORED_P (decl) = istemporary;
+  /* If istemporary we don't want even the fancy names of those printed in
+     -fdump-final-insns= dumps.  */
+  DECL_NAMELESS (decl) = istemporary;
+
+  /* Make the variable writable.  */
+  TREE_READONLY (decl) = 0;
+
+  DECL_CONTEXT (decl) = scope;
+
+  m2block_pushDecl (decl);
+
+  if (DECL_SIZE (decl) == 0)
+    error ("storage size of %qD has not been resolved", decl);
+
+  if ((TREE_PUBLIC (decl) == 0) && DECL_EXTERNAL (decl))
+    internal_error ("inconsistant because %qs",
+		    "PUBLIC_DECL(decl) == 0 && DECL_EXTERNAL(decl) == 1");
+
+  m2block_addDeclExpr (build_stmt (location, DECL_EXPR, decl));
+
+  return decl;
+}
+
+/* DeclareKnownConstant - given a constant, value, of, type, create a
+   constant in the GCC symbol table.  Note that the name of the
+   constant is not used as _all_ constants are declared in the global
+   scope.  The front end deals with scoping rules - here we declare
+   all constants with no names in the global scope.  This allows
+   M2SubExp and constant folding routines the liberty of operating
+   with quadruples which all assume constants can always be
+   referenced.  */
+
+tree
+m2decl_DeclareKnownConstant (location_t location, tree type, tree value)
+{
+  tree id = make_node (IDENTIFIER_NODE); /* Ignore the name of the constant. */
+  tree decl;
+
+  m2assert_AssertLocation (location);
+  m2expr_ConstantExpressionWarning (value);
+  type = m2tree_skip_type_decl (type);
+  layout_type (type);
+
+  decl = build_decl (location, CONST_DECL, id, type);
+
+  DECL_INITIAL (decl) = value;
+  TREE_TYPE (decl) = type;
+
+  decl = m2block_global_constant (decl);
+
+  return decl;
+}
+
+/* BuildParameterDeclaration - creates and returns one parameter
+   from, name, and, type.  It appends this parameter to the internal
+   param_type_list.  */
+
+tree
+m2decl_BuildParameterDeclaration (location_t location, char *name, tree type,
+                                  int isreference)
+{
+  tree parm_decl;
+
+  m2assert_AssertLocation (location);
+  ASSERT_BOOL (isreference);
+  type = m2tree_skip_type_decl (type);
+  layout_type (type);
+  if (isreference)
+    type = build_reference_type (type);
+
+  if (name == NULL)
+    parm_decl = build_decl (location, PARM_DECL, NULL, type);
+  else
+    parm_decl = build_decl (location, PARM_DECL, get_identifier (name), type);
+  DECL_ARG_TYPE (parm_decl) = type;
+  if (isreference)
+    TREE_READONLY (parm_decl) = TRUE;
+
+  param_list = chainon (parm_decl, param_list);
+  layout_type (type);
+  param_type_list = tree_cons (NULL_TREE, type, param_type_list);
+  return parm_decl;
+}
+
+/* BuildStartFunctionDeclaration - initializes global variables ready
+   for building a function.  */
+
+void
+m2decl_BuildStartFunctionDeclaration (int uses_varargs)
+{
+  if (uses_varargs)
+    param_type_list = NULL_TREE;
+  else
+    param_type_list = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+  param_list = NULL_TREE; /* Ready for when we define a function.  */
+}
+
+/* BuildEndFunctionDeclaration - build a function which will return a
+   value of returntype.  The arguments have been created by
+   BuildParameterDeclaration.  */
+
+tree
+m2decl_BuildEndFunctionDeclaration (location_t location_begin,
+                                    location_t location_end, const char *name,
+                                    tree returntype, int isexternal,
+                                    int isnested, int ispublic)
+{
+  tree fntype;
+  tree fndecl;
+
+  m2assert_AssertLocation (location_begin);
+  m2assert_AssertLocation (location_end);
+  ASSERT_BOOL (isexternal);
+  ASSERT_BOOL (isnested);
+  ASSERT_BOOL (ispublic);
+  returntype = m2tree_skip_type_decl (returntype);
+  /* The function type depends on the return type and type of args,
+     both of which we have created in BuildParameterDeclaration */
+  if (returntype == NULL_TREE)
+    returntype = void_type_node;
+  else if (TREE_CODE (returntype) == FUNCTION_TYPE)
+    returntype = ptr_type_node;
+
+  fntype = build_function_type (returntype, param_type_list);
+  fndecl = build_decl (location_begin, FUNCTION_DECL, get_identifier (name),
+                       fntype);
+
+  if (isexternal)
+    ASSERT_CONDITION (ispublic);
+
+  DECL_EXTERNAL (fndecl) = isexternal;
+  TREE_PUBLIC (fndecl) = ispublic;
+  TREE_STATIC (fndecl) = (!isexternal);
+  DECL_ARGUMENTS (fndecl) = param_list;
+  DECL_RESULT (fndecl)
+      = build_decl (location_end, RESULT_DECL, NULL_TREE, returntype);
+  DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+  TREE_TYPE (fndecl) = fntype;
+
+  DECL_SOURCE_LOCATION (fndecl) = location_begin;
+
+  /* Prevent the optimizer from removing it if it is public.  */
+  if (TREE_PUBLIC (fndecl))
+    gm2_mark_addressable (fndecl);
+
+  m2block_pushDecl (fndecl);
+
+  rest_of_decl_compilation (fndecl, 1, 0);
+  param_list
+      = NULL_TREE; /* Ready for the next time we call/define a function.  */
+  return fndecl;
+}
+
+/* BuildModuleCtor creates the per module constructor used as part of
+   the dynamic linking scaffold.  */
+
+void
+m2decl_BuildModuleCtor (tree module_ctor)
+{
+  decl_init_priority_insert (module_ctor, DEFAULT_INIT_PRIORITY);
+}
+
+/* DeclareModuleCtor configures the function to be used as a ctor.  */
+
+tree
+m2decl_DeclareModuleCtor (tree decl)
+{
+  /* Declare module_ctor ().  */
+  TREE_PUBLIC (decl) = 1;
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_VISIBILITY (decl) = VISIBILITY_HIDDEN;
+  DECL_VISIBILITY_SPECIFIED (decl) = 1;
+  DECL_STATIC_CONSTRUCTOR (decl) = 1;
+  return decl;
+}
+
+
+/* DetermineSizeOfConstant - given, str, and, base, fill in needsLong
+   and needsUnsigned appropriately.  */
+
+void
+m2decl_DetermineSizeOfConstant (location_t location,
+				const char *str, unsigned int base,
+                                int *needsLong, int *needsUnsigned)
+{
+  unsigned int ulow;
+  int high;
+  int overflow = m2expr_interpret_m2_integer (str, base, &ulow, &high,
+					      needsLong, needsUnsigned);
+  if (overflow)
+    error_at (location, "constant %qs is too large", str);
+}
+
+/* BuildConstLiteralNumber - returns a GCC TREE built from the
+   string, str.  It assumes that, str, represents a legal number in
+   Modula-2.  It always returns a positive value.  */
+
+tree
+m2decl_BuildConstLiteralNumber (location_t location, const char *str, unsigned int base)
+{
+  tree value, type;
+  unsigned HOST_WIDE_INT low;
+  HOST_WIDE_INT high;
+  HOST_WIDE_INT ival[3];
+  int overflow = m2expr_interpret_integer (str, base, &low, &high);
+  int needLong, needUnsigned;
+
+  ival[0] = low;
+  ival[1] = high;
+  ival[2] = 0;
+
+  widest_int wval = widest_int::from_array (ival, 3);
+
+  m2decl_DetermineSizeOfConstant (location, str, base, &needLong, &needUnsigned);
+
+  if (needUnsigned && needLong)
+    type = m2type_GetM2LongCardType ();
+  else
+    type = m2type_GetM2LongIntType ();
+
+  value = wide_int_to_tree (type, wval);
+
+  if (overflow || m2expr_TreeOverflow (value))
+    error_at (location, "constant %qs is too large", str);
+
+  return m2block_RememberConstant (value);
+}
+
+/* BuildCStringConstant - creates a string constant given a, string,
+   and, length.  */
+
+tree
+m2decl_BuildCStringConstant (const char *string, int length)
+{
+  tree elem, index, type;
+
+  /* +1 ensures that we always nul terminate our strings.  */
+  elem = build_type_variant (char_type_node, 1, 0);
+  index = build_index_type (build_int_cst (integer_type_node, length + 1));
+  type = build_array_type (elem, index);
+  return m2decl_BuildStringConstantType (length + 1, string, type);
+}
+
+/* BuildStringConstant - creates a string constant given a, string,
+   and, length.  */
+
+tree
+m2decl_BuildStringConstant (const char *string, int length)
+{
+  tree elem, index, type;
+
+  elem = build_type_variant (char_type_node, 1, 0);
+  index = build_index_type (build_int_cst (integer_type_node, length));
+  type = build_array_type (elem, index);
+  return m2decl_BuildStringConstantType (length, string, type);
+  // maybe_wrap_with_location
+}
+
+/* BuildIntegerConstant - return a tree containing the integer value.  */
+
+tree
+m2decl_BuildIntegerConstant (int value)
+{
+  switch (value)
+    {
+
+    case 0:
+      return integer_zero_node;
+    case 1:
+      return integer_one_node;
+
+    default:
+      return m2block_RememberConstant (
+          build_int_cst (integer_type_node, value));
+    }
+}
+
+/* BuildStringConstantType - builds a string constant with a type.  */
+
+tree
+m2decl_BuildStringConstantType (int length, const char *string, tree type)
+{
+  tree id = build_string (length, string);
+
+  TREE_TYPE (id) = type;
+  TREE_CONSTANT (id) = TRUE;
+  TREE_READONLY (id) = TRUE;
+  TREE_STATIC (id) = TRUE;
+
+  return m2block_RememberConstant (id);
+}
+
+/* GetBitsPerWord - returns the number of bits in a WORD.  */
+
+int
+m2decl_GetBitsPerWord (void)
+{
+  return BITS_PER_WORD;
+}
+
+/* GetBitsPerInt - returns the number of bits in a INTEGER.  */
+
+int
+m2decl_GetBitsPerInt (void)
+{
+  return INT_TYPE_SIZE;
+}
+
+/* GetBitsPerBitset - returns the number of bits in a BITSET.  */
+
+int
+m2decl_GetBitsPerBitset (void)
+{
+  return SET_WORD_SIZE;
+}
+
+/* GetBitsPerUnit - returns the number of bits in a UNIT.  */
+
+int
+m2decl_GetBitsPerUnit (void)
+{
+  return BITS_PER_UNIT;
+}
+
+/* m2decl_GetDeclContext - returns the DECL_CONTEXT of tree, t.  */
+
+tree
+m2decl_GetDeclContext (tree t)
+{
+  return DECL_CONTEXT (t);
+}
+
+#include "gt-m2-m2decl.h"