@@ -0,0 +1,335 @@
+/* m2rte.cc a plugin to detect runtime exceptions at compiletime.
+
+Copyright (C) 2017-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-plugin.h"
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "options.h"
+#include "tree-pass.h"
+#include "diagnostic-core.h"
+#include "flags.h"
+#include "intl.h"
+#include "plugin.h"
+#include "tree.h"
+#include "gimple.h"
+#include "gimplify.h"
+#include "gimple-iterator.h"
+#include "gimplify-me.h"
+#include "gimple-pretty-print.h"
+#include "plugin-version.h"
+#include "diagnostic.h"
+#include "context.h"
+
+#include "rtegraph.h"
+extern bool ggc_force_collect;
+extern void ggc_collect (void);
+
+#undef DEBUG_BASICBLOCK
+
+int plugin_is_GPL_compatible;
+
+void debug_tree (tree);
+
+/* All dialects of Modula-2 issue some or all of these runtime error calls.
+ This plugin detects whether a runtime error will be called in the first
+ basic block of a reachable function. */
+
+static const char *m2_runtime_error_calls[] = {
+ "M2RTS_AssignmentException",
+ "M2RTS_ReturnException",
+ "M2RTS_IncException",
+ "M2RTS_DecException",
+ "M2RTS_InclException",
+ "M2RTS_ExclException",
+ "M2RTS_ShiftException",
+ "M2RTS_RotateException",
+ "M2RTS_StaticArraySubscriptException",
+ "M2RTS_DynamicArraySubscriptException",
+ "M2RTS_ForLoopBeginException",
+ "M2RTS_ForLoopToException",
+ "M2RTS_ForLoopEndException",
+ "M2RTS_PointerNilException",
+ "M2RTS_NoReturnException",
+ "M2RTS_CaseException",
+ "M2RTS_WholeNonPosDivException",
+ "M2RTS_WholeNonPosModException",
+ "M2RTS_WholeZeroDivException",
+ "M2RTS_WholeZeroRemException",
+ "M2RTS_WholeValueException",
+ "M2RTS_RealValueException",
+ "M2RTS_ParameterException",
+ "M2RTS_NoException",
+ NULL,
+};
+
+
+#if defined(DEBUG_BASICBLOCK)
+/* pretty_function display the name of the function. */
+
+static void
+pretty_function (tree fndecl)
+{
+ if (fndecl != NULL && (DECL_NAME (fndecl) != NULL))
+ {
+ const char *n = IDENTIFIER_POINTER (DECL_NAME (fndecl));
+ fprintf (stderr, "PROCEDURE %s ;\n", n);
+ }
+}
+#endif
+
+void
+print_rtl (FILE *outf, const_rtx rtx_first);
+
+/* strend returns true if string name has ending. */
+
+static bool
+strend (const char *name, const char *ending)
+{
+ unsigned int len = strlen (name);
+ return (len > strlen (ending)
+ && (strcmp (&name[len-strlen (ending)], ending) == 0));
+}
+
+/* is_constructor returns true if the function name is that of a module
+ constructor or deconstructor. */
+
+static bool
+is_constructor (tree fndecl)
+{
+ const char *name = IDENTIFIER_POINTER (DECL_NAME (fndecl));
+ unsigned int len = strlen (name);
+
+ return ((len > strlen ("_M2_"))
+ && (strncmp (name, "_M2_", strlen ("_M2_")) == 0)
+ && (strend (name, "_init") || strend (name, "_finish")));
+}
+
+/* is_external returns true if the function is extern. */
+
+static bool
+is_external (tree function)
+{
+ return (! DECL_EXTERNAL (function))
+ && TREE_PUBLIC (function)
+ && TREE_STATIC (function);
+}
+
+/* is_external returns true if the function is a call to a Modula-2
+ runtime exception handler. */
+
+static bool
+is_rte (tree fndecl)
+{
+ const char *n = IDENTIFIER_POINTER (DECL_NAME (fndecl));
+
+ for (int i = 0; m2_runtime_error_calls[i] != NULL; i++)
+ if (strcmp (m2_runtime_error_calls[i], n) == 0)
+ return true;
+ return false;
+}
+
+/* examine_call extract the function tree from the gimple call
+ statement and check whether it is a call to a runtime exception. */
+
+static void
+examine_call (gimple *stmt)
+{
+ tree fndecl = gimple_call_fndecl (stmt);
+ rtenode *func = rtegraph_lookup (stmt, fndecl, true);
+ // rtegraph_dump ();
+ if (fndecl != NULL && (DECL_NAME (fndecl) != NULL))
+ {
+ /* Firstly check if the function is a runtime exception. */
+ if (is_rte (fndecl))
+ {
+ /* Remember runtime exception call. */
+ rtegraph_include_rtscall (func);
+ /* Add the callee to the list of candidates to be queried reachable. */
+ rtegraph_candidates_include (func);
+ return;
+ }
+ }
+ /* Add it to the list of calls. */
+ rtegraph_include_function_call (func);
+}
+
+
+/* examine_function_decl, check if the current function is a module
+ constructor/deconstructor. Also check if the current function is
+ declared as external. */
+
+static void
+examine_function_decl (rtenode *rt)
+{
+ tree fndecl = rtegraph_get_func (rt);
+ if (fndecl != NULL && (DECL_NAME (fndecl) != NULL))
+ {
+ /* Check if the function is a module constructor. */
+ if (is_constructor (fndecl))
+ rtegraph_constructors_include (rt);
+ /* Can it be called externally? */
+ if (is_external (fndecl))
+ rtegraph_externs_include (rt);
+ }
+}
+
+
+/* Check and warn if STMT is a self-assign statement. */
+
+static void
+runtime_exception_inevitable (gimple *stmt)
+{
+ if (is_gimple_call (stmt))
+ examine_call (stmt);
+}
+
+
+namespace {
+
+const pass_data pass_data_exception_detection =
+{
+ GIMPLE_PASS, /* type */
+ "runtime_exception_inevitable", /* name */
+ OPTGROUP_NONE, /* optinfo_flags */
+ TV_NONE, /* tv_id */
+ PROP_gimple_lcf , /* properties_required */
+ 0, /* properties_provided */
+ 0, /* properties_destroyed */
+ 0, /* todo_flags_start */
+ 0, /* todo_flags_finish */
+};
+
+class pass_warn_exception_inevitable : public gimple_opt_pass
+{
+public:
+ pass_warn_exception_inevitable(gcc::context *ctxt)
+ : gimple_opt_pass(pass_data_exception_detection, ctxt)
+ {}
+
+ virtual unsigned int execute (function *);
+};
+
+/* execute checks the first basic block of function fun to see if it
+ calls a runtime exception. */
+
+unsigned int
+pass_warn_exception_inevitable::execute (function *fun)
+{
+ gimple_stmt_iterator gsi;
+ basic_block bb;
+ /* Record a function declaration. */
+ rtenode *fn = rtegraph_lookup (fun->gimple_body, fun->decl, false);
+
+ rtegraph_set_current_function (fn);
+ /* Check if the current function is a module constructor/deconstructor.
+ Also check if the current function is declared as external. */
+ examine_function_decl (fn);
+
+#if defined(DEBUG_BASICBLOCK)
+ pretty_function (fun->decl);
+ int basic_count = 0;
+#endif
+ FOR_EACH_BB_FN (bb, fun)
+ {
+#if defined(DEBUG_BASICBLOCK)
+ int stmt_count = 0;
+#endif
+ for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+#if defined(DEBUG_BASICBLOCK)
+ printf (" [%d][%d] [basic block][statement]\n",
+ basic_count, stmt_count);
+ stmt_count++;
+#endif
+ runtime_exception_inevitable (gsi_stmt (gsi));
+#if defined(DEBUG_BASICBLOCK)
+ debug (gsi_stmt (gsi));
+#endif
+ }
+ /* We only care about the first basic block in each function.
+ We could continue to search if this edge falls though (top
+ of a loop for example) but for now this is cautiously safe.
+ --fixme-- */
+ return 0;
+#if defined(DEBUG_BASICBLOCK)
+ basic_count++;
+#endif
+ }
+ return 0;
+}
+
+/* analyse_graph discovers any reachable call to a runtime exception in the
+ first basic block of a reachable function. It then calls rtegraph_finish
+ to tidy up and return all dynamic memory used. */
+
+void analyse_graph (void *gcc_data, void *user_data)
+{
+ rtegraph_discover ();
+ rtegraph_finish ();
+}
+
+} // anon namespace
+
+
+static gimple_opt_pass *
+make_pass_warn_exception_inevitable (gcc::context *ctxt)
+{
+ return new pass_warn_exception_inevitable (ctxt);
+}
+
+
+/* plugin_init, check the version and register the plugin. */
+
+int
+plugin_init (struct plugin_name_args *plugin_info,
+ struct plugin_gcc_version *version)
+{
+ struct register_pass_info pass_info;
+ const char *plugin_name = plugin_info->base_name;
+
+ if (!plugin_default_version_check (version, &gcc_version))
+ {
+ fprintf (stderr, "incorrect GCC version (%s) this plugin was built for GCC version %s\n",
+ version->basever, gcc_version.basever);
+ return 1;
+ }
+
+ /* Runtime exception inevitable detection. This plugin is most effective if
+ it is run after all optimizations. This is plugged in at the end of
+ gimple range of optimizations. */
+ pass_info.pass = make_pass_warn_exception_inevitable (g);
+ pass_info.reference_pass_name = "*warn_function_noreturn";
+
+ pass_info.ref_pass_instance_number = 1;
+ pass_info.pos_op = PASS_POS_INSERT_AFTER;
+
+ rtegraph_init ();
+
+ register_callback (plugin_name,
+ PLUGIN_PASS_MANAGER_SETUP,
+ NULL,
+ &pass_info);
+ register_callback (plugin_name,
+ PLUGIN_FINISH, analyse_graph, NULL);
+ return 0;
+}
@@ -0,0 +1,2 @@
+This directory contains the Modula-2 plugin which will elevate runtime
+warnings into compiler errors if they are known to be reachable.
@@ -0,0 +1,42 @@
+/* rtegraph.h runtime exception graph header.
+
+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/>. */
+
+#ifndef RTEGRAPH_H
+#define RTEGRAPH_H
+
+struct rtenode;
+
+extern rtenode *rtegraph_init_rtenode (gimple *g, tree fndecl, bool is_func_call);
+extern rtenode *rtegraph_lookup (gimple *g, tree fndecl, bool is_call);
+extern void rtegraph_candidates_include (rtenode *n);
+extern void rtegraph_allnodes_include (rtenode *n);
+extern void rtegraph_externs_include (rtenode *n);
+extern void rtegraph_constructors_include (rtenode *n);
+extern void rtegraph_include_rtscall (rtenode *func);
+extern void rtegraph_include_function_call (rtenode *func);
+extern void rtegraph_set_current_function (rtenode *func);
+extern tree rtegraph_get_func (rtenode *func);
+
+extern void rtegraph_discover (void);
+extern void rtegraph_init (void);
+extern void rtegraph_finish (void);
+
+#endif /* RTEGRAPH_H. */
@@ -0,0 +1,527 @@
+/* rtegraph.cc graph and nodes used by m2rte.
+
+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/>. */
+
+#include "gcc-consolidation.h"
+
+#include "../gm2-lang.h"
+#include "../m2-tree.h"
+
+#include "langhooks-def.h" /* FIXME: for lhd_set_decl_assembler_name. */
+#include "tree-pass.h" /* FIXME: only for PROP_gimple_any. */
+#include "toplev.h"
+#include "debug.h"
+
+#include "opts.h"
+#include "mpfr.h"
+
+#undef DEBUGGING
+
+struct GTY (()) rtenode
+{
+ bool constructor_reachable; /* Is this guarenteed to be reachable by a constructor? */
+ bool export_reachable; /* Is this reachable via exported functions? */
+ bool exception_routine; /* Is this an exception routine? */
+ bool constructor_final; /* Have we walked this rtenode during constructor testing? */
+ bool export_final; /* Walked this rtenode during exported testing? */
+ bool is_call; /* Is this a function call? */
+ gimple *grtenode;
+ tree func;
+ rtenode *reachable_src; /* If this is reachable which src function will call us? */
+
+ vec<rtenode *, va_gc> *function_call;
+ vec<rtenode *, va_gc> *rts_call;
+ void dump (void);
+ void dump_vec (const char *title, vec<rtenode *, va_gc> *list);
+
+ void propagate_constructor_reachable (rtenode *);
+ void propagate_export_reachable (rtenode *);
+ void error_message (void);
+ void warning_message (void);
+ void note_message (void);
+ const char *get_func_name (void);
+ const char *create_message (const char *with_name, const char *without_name);
+};
+
+
+typedef vec<rtenode *, va_gc> rtevec;
+
+static GTY (()) rtevec *allnodes;
+static GTY (()) rtevec *candidates;
+static GTY (()) rtevec *externs;
+static GTY (()) rtevec *constructors;
+
+
+static void determine_reachable (void);
+static void issue_messages (void);
+void rtegraph_dump (void);
+
+
+static GTY (()) rtenode *rtegraph_current_function = NULL;
+
+
+/* rtegraph_get_func returns the function associated with the rtenode. */
+
+tree
+rtegraph_get_func (rtenode *n)
+{
+ return n->func;
+}
+
+/* rtegraph_set_current_function assigns rtegraph_current_function with func. */
+
+void
+rtegraph_set_current_function (rtenode *func)
+{
+ rtegraph_current_function = func;
+}
+
+/* rtegraph_include_rtscall mark func as an exception routine and remember
+ that it is called from rtegraph_current_function in the rts_call array. */
+
+void rtegraph_include_rtscall (rtenode *func)
+{
+ /* This is a runtime exception, mark it as such. */
+ func->exception_routine = true;
+ /* And remember it. */
+ vec_safe_push (rtegraph_current_function->rts_call, func);
+}
+
+
+/* rtegraph_include_rtscall remember that rtegraph_current_function calls
+ func. */
+
+void rtegraph_include_function_call (rtenode *func)
+{
+ vec_safe_push (rtegraph_current_function->function_call, func);
+}
+
+
+/* rtegraph_discover performs the main work, called by m2rte.cc analyse_graph.
+ It determines which function calls a reachable and then issues any warning
+ message if a reachable function is a call to a runtime exception handler. */
+
+void rtegraph_discover (void)
+{
+ determine_reachable ();
+#if defined (DEBUGGING)
+ rtegraph_dump ();
+#endif
+ issue_messages ();
+}
+
+/* rtegraph_candidates_include include node n in the array of candidates. */
+
+void rtegraph_candidates_include (rtenode *n)
+{
+ unsigned int len = vec_safe_length (candidates);
+
+ for (unsigned int i = 0; i < len; i++)
+ if ((*candidates)[i] == n)
+ return;
+ vec_safe_push (candidates, n);
+}
+
+/* rtegraph_allnodes_include include node n in the array of allnodes. */
+
+void rtegraph_allnodes_include (rtenode *n)
+{
+ unsigned int len = vec_safe_length (allnodes);
+
+ for (unsigned int i = 0; i < len; i++)
+ if ((*allnodes)[i] == n)
+ return;
+ vec_safe_push (allnodes, n);
+}
+
+/* rtegraph_externs_include include node n in the array of externs. */
+
+void rtegraph_externs_include (rtenode *n)
+{
+ unsigned int len = vec_safe_length (externs);
+
+ for (unsigned int i = 0; i < len; i++)
+ if ((*externs)[i] == n)
+ return;
+ vec_safe_push (externs, n);
+}
+
+/* rtegraph_constructors_include include node n in the array of constructors. */
+
+void rtegraph_constructors_include (rtenode *n)
+{
+ unsigned int len = vec_safe_length (constructors);
+
+ for (unsigned int i = 0; i < len; i++)
+ if ((*constructors)[i] == n)
+ return;
+ vec_safe_push (constructors, n);
+}
+
+/* determine_reachable mark modules constructors as reachable and
+ also mark the exported functions as also reachable. */
+
+void determine_reachable (void)
+{
+ unsigned int len = vec_safe_length (constructors);
+ for (unsigned int i = 0; i < len; i++)
+ (*constructors)[i]->propagate_constructor_reachable ((*constructors)[i]);
+ len = vec_safe_length (externs);
+ for (unsigned int i = 0; i < len; i++)
+ (*externs)[i]->propagate_export_reachable ((*externs)[i]);
+}
+
+/* issue_messages for every candidate which is constructor reachable issue
+ an error. For each candidate which is reachable via an external call
+ issue a warning, for any other candidate (of a local procedure) issue
+ a note. */
+
+void issue_messages (void)
+{
+ unsigned int len = vec_safe_length (candidates);
+ for (unsigned int i = 0; i < len; i++)
+ {
+ if ((*candidates)[i]->constructor_reachable)
+ (*candidates)[i]->error_message ();
+ else if ((*candidates)[i]->export_reachable)
+ (*candidates)[i]->warning_message ();
+ else
+ (*candidates)[i]->note_message ();
+ }
+}
+
+
+#if defined (DEBUGGING)
+/* rtegraph_dump_vec display the contents of a vector array. */
+
+void
+rtegraph_dump_vec (const char *title, vec<rtenode *, va_gc> *list)
+{
+ unsigned int len = vec_safe_length (list);
+ printf ("%s (length = %d)\n", title, len);
+ for (unsigned int i = 0; i < len; i++)
+ {
+ printf ("[%d]: rtenode %p ", i, (*list)[i]);
+ (*list)[i]->dump ();
+ }
+ printf ("end\n");
+}
+
+/* rtegraph_dump display the contents of each vector array. */
+
+void rtegraph_dump (void)
+{
+ rtegraph_dump_vec ("allnodes", allnodes);
+ rtegraph_dump_vec ("candidates", candidates);
+ rtegraph_dump_vec ("externs", externs);
+ rtegraph_dump_vec ("constructors", constructors);
+}
+#endif
+
+/* rtegraph_init_rtenode create and return a new rtenode. */
+
+rtenode *
+rtegraph_init_rtenode (gimple *g, tree fndecl, bool is_func_call)
+{
+ rtenode *n = ggc_alloc<rtenode> ();
+
+ n->constructor_reachable = false;
+ n->export_reachable = false;
+ n->constructor_final = false;
+ n->export_final = false;
+ n->is_call = is_func_call;
+ n->grtenode = g;
+ n->func = fndecl;
+ n->reachable_src = NULL;
+
+ vec_alloc (n->function_call, 0);
+ // n->function_call = ggc_alloc<rtevec> ();
+ gcc_assert (vec_safe_length (n->function_call) == 0);
+ vec_alloc (n->rts_call, 0);
+ // n->rts_call = ggc_alloc<rtevec> ();
+ gcc_assert (vec_safe_length (n->rts_call) == 0);
+ return n;
+}
+
+/* rtegraph_lookup attempts to lookup a rtenode associated with a fndecl
+ which is a function call from node g. */
+
+rtenode *
+rtegraph_lookup (gimple *g, tree fndecl, bool is_call)
+{
+ unsigned int len = vec_safe_length (allnodes);
+ for (unsigned int i = 0; i < len; i++)
+ if ((*allnodes)[i]->grtenode == g
+ && (*allnodes)[i]->func == fndecl
+ && (*allnodes)[i]->is_call == is_call)
+ return (*allnodes)[i];
+ rtenode *n = rtegraph_init_rtenode (g, fndecl, is_call);
+ vec_safe_push (allnodes, n);
+#if defined (DEBUGGING)
+ rtegraph_dump ();
+#endif
+ return n;
+}
+
+/* rte_error_at - wraps up an error message. */
+
+static void
+rte_error_at (location_t location, diagnostic_t kind, const char *message, ...)
+{
+ diagnostic_info diagnostic;
+ va_list ap;
+ rich_location richloc (line_table, location);
+
+ va_start (ap, message);
+ diagnostic_set_info (&diagnostic, message, &ap, &richloc, kind);
+ diagnostic_report_diagnostic (global_dc, &diagnostic);
+ va_end (ap);
+}
+
+/* access_int return true if the tree t contains a constant integer, if so then
+ its value is assigned to *value. */
+
+static bool
+access_int (tree t, int *value)
+{
+ enum tree_code code = TREE_CODE (t);
+
+ if (code == SSA_NAME)
+ return access_int (SSA_NAME_VAR (t), value);
+ if (code == INTEGER_CST)
+ {
+ *value = TREE_INT_CST_LOW (t);
+ return true;
+ }
+ if ((code == VAR_DECL || code == PARM_DECL)
+ && DECL_HAS_VALUE_EXPR_P (t))
+ return access_int (DECL_VALUE_EXPR (t), value);
+ return false;
+}
+
+/* access_string return true if the tree t contains a constant string, if so then
+ its value is assigned to *value. */
+
+static bool
+access_string (tree t, const char **value)
+{
+ if (TREE_CODE (t) == ADDR_EXPR)
+ {
+ if (TREE_CODE (TREE_OPERAND (t, 0)) == STRING_CST)
+ {
+ *value = TREE_STRING_POINTER (TREE_OPERAND (t, 0));
+ return true;
+ }
+ }
+ return false;
+}
+
+/* generate an error using the parameters of the M2RTS exception handler to
+ locate the source code. We dont use location, as the error_at function will
+ give the function context which might be misleading if this is inlined. */
+
+static void
+generate_report (gimple *stmt, const char *report, diagnostic_t kind)
+{
+ if (gimple_call_num_args (stmt) == 5)
+ {
+ tree s0 = gimple_call_arg (stmt, 0);
+ tree i1 = gimple_call_arg (stmt, 1);
+ tree i2 = gimple_call_arg (stmt, 2);
+ tree s1 = gimple_call_arg (stmt, 3);
+ tree s2 = gimple_call_arg (stmt, 4);
+ const char *file;
+ int line;
+ int col;
+ const char *scope;
+ const char *message;
+
+ if (access_string (s0, &file)
+ && access_int (i1, &line)
+ && access_int (i2, &col)
+ && access_string (s1, &scope)
+ && access_string (s2, &message))
+ {
+ /* Continue to use scope as this will survive any
+ optimization transforms. */
+ location_t location = gimple_location (stmt);
+ rte_error_at (location, kind, "In %s\n%s, %s",
+ scope, report, message);
+ }
+ }
+}
+
+/* get_func_name returns the name of the function associated with rtenode. */
+
+const char *rtenode::get_func_name (void)
+{
+ if (func != NULL && (DECL_NAME (func) != NULL))
+ return IDENTIFIER_POINTER (DECL_NAME (func));
+ return NULL;
+}
+
+/* create_message if the current rtenode has a named function associated with it then
+ create a new message using with_name and the function name, otherwise
+ return without_name. */
+
+const char *rtenode::create_message (const char *with_name, const char *without_name)
+{
+ const char *name = get_func_name ();
+ if (name == NULL)
+ return without_name;
+
+ int len = strlen (with_name) + 1 + strlen (name);
+ char *message = XNEWVEC (char, len);
+ snprintf (message, len, with_name, name);
+ return message;
+}
+
+/* error_message issue an DK_ERROR from grtenode. */
+
+void rtenode::error_message (void)
+{
+ if (grtenode != NULL)
+ generate_report (grtenode, "runtime error will occur", DK_ERROR);
+}
+
+/* warning_message issue an DK_WARNING from grtenode. */
+
+void rtenode::warning_message (void)
+{
+ const char *message = reachable_src->create_message
+ ("runtime error will occur if an exported procedure is called from %s",
+ "runtime error will occur if an exported procedure is called");
+ if (grtenode != NULL)
+ generate_report (grtenode, message, DK_WARNING);
+}
+
+/* note_message issue an DK_NOTE from grtenode. */
+
+void rtenode::note_message (void)
+{
+ if (grtenode != NULL)
+ generate_report (grtenode, "runtime will occur if this procedure is called", DK_NOTE);
+}
+
+/* dump_vec display contents of vector array list. */
+#if defined (DEBUGGING)
+void
+rtenode::dump_vec (const char *title, vec<rtenode *, va_gc> *list)
+{
+ printf (" %s (length = %d)\n", title, vec_safe_length (list));
+ for (unsigned int i = 0; i < vec_safe_length (list); i++)
+ printf (" [%d]: rtenode %p\n", i, (*list)[i]);
+}
+#endif
+
+/* dump display all vector arrays associated with rtenode. */
+
+void
+rtenode::dump (void)
+{
+#if defined (DEBUGGING)
+ printf ("rtenode::dump:");
+ if (func != NULL && (DECL_NAME (func) != NULL))
+ {
+ const char *n = IDENTIFIER_POINTER (DECL_NAME (func));
+ printf ("%s", n);
+ }
+ if (constructor_reachable)
+ printf (", constructor_reachable");
+ if (export_reachable)
+ printf (", export_reachable");
+ if (constructor_final)
+ printf (", constructor_final");
+ if (export_final)
+ printf (", export_final");
+ if (is_call)
+ printf (", is_call");
+ else
+ printf (", decl");
+ printf (", grtenode %p, func = %p\n", grtenode, func);
+ dump_vec ("function_call", function_call);
+ dump_vec ("rts_call", rts_call);
+#endif
+}
+
+/* propagate_constructor_reachable for every function which is reachable from
+ rtenode call the callee rtenode and mark it as reachable from a
+ constructor. */
+
+void rtenode::propagate_constructor_reachable (rtenode *src)
+{
+ if (constructor_final)
+ return;
+ constructor_final = true;
+ constructor_reachable = true;
+ reachable_src = src;
+ for (unsigned int i = 0; i < vec_safe_length (function_call); i++)
+ (*function_call)[i]->propagate_constructor_reachable (src);
+ for (unsigned int i = 0; i < vec_safe_length (rts_call); i++)
+ (*rts_call)[i]->propagate_constructor_reachable (src);
+}
+
+/* propagate_export_reachable for every function which is reachable
+ from rtenode call the callee rtenode and mark it as reachable from
+ an exported function. */
+
+void rtenode::propagate_export_reachable (rtenode *src)
+{
+ if (export_final)
+ return;
+ export_final = true;
+ export_reachable = true;
+ reachable_src = src;
+ for (unsigned int i = 0; i < vec_safe_length (function_call); i++)
+ (*function_call)[i]->propagate_export_reachable (src);
+ for (unsigned int i = 0; i < vec_safe_length (rts_call); i++)
+ (*rts_call)[i]->propagate_export_reachable (src);
+}
+
+/* rtegraph_init initialize the data structures (vec arrays) in this
+ file. */
+
+void rtegraph_init (void)
+{
+ vec_alloc (allnodes, 0);
+ gcc_assert (vec_safe_length (allnodes) == 0);
+ vec_alloc (candidates, 0);
+ gcc_assert (vec_safe_length (candidates) == 0);
+ vec_alloc (externs, 0);
+ gcc_assert (vec_safe_length (externs) == 0);
+ vec_alloc (constructors, 0);
+ gcc_assert (vec_safe_length (constructors) == 0);
+#if defined (DEBUGGING)
+ rtegraph_dump ();
+#endif
+}
+
+/* rtegraph_finish deallocate all vec arrays in this file. */
+
+void rtegraph_finish (void)
+{
+ rtegraph_current_function = NULL;
+ vec_free (allnodes);
+ vec_free (candidates);
+ vec_free (externs);
+ vec_free (constructors);
+}
+
+#include "gt-m2-rtegraph.h"