Beispiel #1
0
MR_bool
MR_trace_proc_layout_is_builtin_catch(const MR_ProcLayout *layout)
{
    const MR_UserProcId *user;

    if (MR_PROC_LAYOUT_HAS_PROC_ID(layout)) {
        if (! MR_PROC_LAYOUT_IS_UCI(layout)) {
            user = &layout->MR_sle_user;
            if (MR_streq(user->MR_user_decl_module, "exception") &&
                MR_streq(user->MR_user_name, "builtin_catch") &&
                (user->MR_user_arity == 3))
            {
                return MR_TRUE;
            }
        }
    }
    return MR_FALSE;
}
Beispiel #2
0
MR_Next
MR_trace_cmd_level(char **words, int word_count, MR_TraceCmdInfo *cmd,
                   MR_EventInfo *event_info, MR_Code **jumpaddr)
{
    MR_Unsigned n;
    MR_bool     detailed;
    MR_Level    selected_level;

    detailed = MR_FALSE;
    if (! MR_trace_options_detailed(&detailed, &words, &word_count)) {
        ; /* the usage message has already been printed */
    } else if (word_count == 2 &&
               ( MR_streq(words[1], "clique") || MR_streq(words[1], "clentry") ))
    {
        if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_FRAME,
                                     &selected_level))
        {
            /* the error message has already been printed */
            return KEEP_INTERACTING;
        }
    } else if (word_count == 2 && MR_streq(words[1], "clparent")) {
        if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_PARENT_FRAME,
                                     &selected_level))
        {
            /* the error message has already been printed */
            return KEEP_INTERACTING;
        }
    } else if (word_count == 2 && MR_trace_is_natural_number(words[1], &n)) {
        selected_level = n;
    } else {
        MR_trace_usage_cur_cmd();
        return KEEP_INTERACTING;
    }

    MR_trace_set_level_and_report(selected_level, detailed,
                                  MR_print_optionals);
    return KEEP_INTERACTING;
}
Beispiel #3
0
static MR_bool
MR_proc_matches_name(const MR_Code *proc, const char *name)
{
#ifdef  MR_NEED_ENTRY_LABEL_ARRAY
    MR_Entry    *entry;

    entry = MR_prev_entry_by_addr(proc);
    if (entry != NULL && entry->MR_entry_addr == proc
            && entry->MR_entry_name != NULL)
    {
        if (MR_streq(entry->MR_entry_name, name)) {
            return MR_TRUE;
        }
    }

#endif  // MR_NEED_ENTRY_LABEL_ARRAY
    return MR_FALSE;
}
MR_Next
MR_trace_cmd_trust(char **words, int word_count, MR_TraceCmdInfo *cmd,
    MR_EventInfo *event_info, MR_Code **jumpaddr)
{
    MR_ProcSpec         spec;
    MR_MatchesInfo      matches;

    if (word_count == 2) {
        spec.MR_proc_module = NULL;
        spec.MR_proc_name   = NULL;
        spec.MR_proc_arity  = -1;
        spec.MR_proc_mode   = -1;
        spec.MR_proc_prefix = (MR_ProcPrefix) -1;

        MR_register_all_modules_and_procs(MR_mdb_out, MR_TRUE);

        /* First see if the argument is a module name */
        spec.MR_proc_module = words[1];
        matches = MR_search_for_matching_procedures(&spec);
        if (matches.match_proc_next > 0) {
            MR_decl_add_trusted_module(words[1]);
            fprintf(MR_mdb_out, "Trusting module %s\n", words[1]);
        } else if (MR_parse_proc_spec(words[1], &spec)) {
            /* Check to see if the argument is a pred/func */
            matches = MR_search_for_matching_procedures(&spec);
            MR_filter_user_preds(&matches);
            if (matches.match_proc_next == 0) {
                fprintf(MR_mdb_err,
                    "mdb: there is no such module, predicate or function.\n");
            } else if (matches.match_proc_next == 1) {
                MR_decl_add_trusted_pred_or_func(matches.match_procs[0]);
                fprintf(MR_mdb_out, "Trusting ");
                MR_print_pred_id_and_nl(MR_mdb_out, matches.match_procs[0]);
            } else {
                MR_Unsigned i;
                char        buf[80];
                char        *line2;

                fprintf(MR_mdb_out, "Ambiguous predicate or function"
                    " specification. The matches are:\n");
                for (i = 0; i < matches.match_proc_next; i++) {
                    fprintf(MR_mdb_out, "%" MR_INTEGER_LENGTH_MODIFIER "u: ",
                        i);
                    MR_print_pred_id_and_nl(MR_mdb_out,
                        matches.match_procs[i]);
                }
                sprintf(buf, "\nWhich predicate or function "
                    "do you want to trust (0-%" MR_INTEGER_LENGTH_MODIFIER
                    "u or *)? ",
                    matches.match_proc_next - 1);
                line2 = MR_trace_getline(buf, MR_mdb_in, MR_mdb_out);
                if (line2 == NULL) {
                    /* This means the user input EOF. */
                    fprintf(MR_mdb_out, "none of them\n");
                } else if (MR_streq(line2, "*")) {
                    for (i = 0; i < matches.match_proc_next; i++) {
                        MR_decl_add_trusted_pred_or_func(
                            matches.match_procs[i]);

                        fprintf(MR_mdb_out, "Trusting ");
                        MR_print_pred_id_and_nl(MR_mdb_out,
                            matches.match_procs[i]);
                    }
                    MR_free(line2);
                } else if(MR_trace_is_natural_number(line2, &i)) {
                    if (0 <= i && i < matches.match_proc_next) {
                        MR_decl_add_trusted_pred_or_func(
                            matches.match_procs[i]);

                        fprintf(MR_mdb_out, "Trusting ");
                        MR_print_pred_id_and_nl(MR_mdb_out,
                            matches.match_procs[i]);
                    } else {
                        fprintf(MR_mdb_out, "no such match\n");
                    }
                    MR_free(line2);
                } else {
                    fprintf(MR_mdb_out, "none of them\n");
                    MR_free(line2);
                }
            }
        }
    } else if (word_count == 3 &&
        ((MR_streq(words[1], "std") && MR_streq(words[2], "lib"))
        || (MR_streq(words[1], "standard") && MR_streq(words[2], "library"))))
    {
        MR_decl_trust_standard_library();
        fprintf(MR_mdb_out, "Trusting the Mercury standard library\n");
    } else {
        MR_trace_usage_cur_cmd();
    }

    return KEEP_INTERACTING;
}
MR_Next
MR_trace_cmd_finish(char **words, int word_count, MR_TraceCmdInfo *cmd,
    MR_EventInfo *event_info, MR_Code **jumpaddr)
{
    const MR_ProcLayout     *proc_layout;
    const MR_LabelLayout    *ancestor_layout;
    MR_Unsigned             depth;
    MR_Unsigned             stop_depth;
    MR_Unsigned             n;
    MR_Level                ancestor_level;
    MR_TracePort            port;
    MR_Word                 *base_sp;
    MR_Word                 *base_curfr;
    MR_Unsigned             reused_frames;
    MR_Level                actual_level;
    const char              *problem;       // Not used.

    depth = event_info->MR_call_depth;
    cmd->MR_trace_strict = MR_TRUE;
    cmd->MR_trace_print_level_specified = MR_FALSE;
    cmd->MR_trace_print_level = MR_default_print_level;
    MR_init_trace_check_integrity(cmd);
    if (! MR_trace_options_movement_cmd(cmd, &words, &word_count)) {
        // The usage message has already been printed.
        ;
        return KEEP_INTERACTING;
    } else if (word_count == 2 &&
        ( MR_streq(words[1], "entry") || MR_streq(words[1], "clentry")))
    {
        if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_FRAME,
            &ancestor_level))
        {
            // The error message has already been printed.
            return KEEP_INTERACTING;
        }
    } else if (word_count == 2 && MR_streq(words[1], "clparent"))
    {
        if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_PARENT_FRAME,
            &ancestor_level))
        {
            // The error message has already been printed.
            return KEEP_INTERACTING;
        }
    } else if (word_count == 2 && MR_trace_is_natural_number(words[1], &n)) {
        ancestor_level = n;
    } else if (word_count == 1) {
        ancestor_level = 0;
    } else {
        MR_trace_usage_cur_cmd();
        return KEEP_INTERACTING;
    }

    base_sp = MR_saved_sp(event_info->MR_saved_regs);
    base_curfr = MR_saved_curfr(event_info->MR_saved_regs);
    proc_layout = event_info->MR_event_sll->MR_sll_entry;
    MR_trace_find_reused_frames(proc_layout, base_sp, reused_frames);
    port = event_info->MR_trace_port;

    stop_depth = depth - ancestor_level;
    if (MR_port_is_final(port) && depth == stop_depth) {
        MR_trace_do_noop();
    } else if (MR_port_is_final(port) &&
        depth - reused_frames <= stop_depth && stop_depth < depth)
    {
        MR_trace_do_noop_tail_rec();
    } else {
        ancestor_layout = MR_find_nth_ancestor(event_info->MR_event_sll,
            ancestor_level, &base_sp, &base_curfr, &actual_level, &problem);
        if (ancestor_layout == NULL) {
            fflush(MR_mdb_out);
            if (problem != NULL) {
                fprintf(MR_mdb_err, "mdb: %s\n", problem);
            } else {
                fprintf(MR_mdb_err, "mdb: not that many ancestors.\n");
            }
            return KEEP_INTERACTING;
        } else if (actual_level != ancestor_level) {
            fflush(MR_mdb_out);
            fprintf(MR_mdb_err, "%d %d\n",
                (int) ancestor_level, (int) actual_level);
            fprintf(MR_mdb_err,
                "mdb: that stack frame has been reused, "
                "will stop at finish of reusing call.\n");
        } else {
            cmd->MR_trace_cmd = MR_CMD_FINISH;
            cmd->MR_trace_stop_depth = stop_depth;
            return STOP_INTERACTING;
        }
    }

    return KEEP_INTERACTING;
}
Beispiel #6
0
MR_Next
MR_trace_cmd_browse(char **words, int word_count, MR_TraceCmdInfo *cmd,
                    MR_EventInfo *event_info, MR_Code **jumpaddr)
{
    MR_BrowseFormat     format;
    MR_bool             xml;
    MR_IoActionNum      action;
    MR_GoalBrowser      goal_browser;
    MR_Browser          browser;
    const char          *problem;

    if (! MR_trace_options_format(&format, &xml, &words, &word_count)) {
        ; /* the usage message has already been printed */
    } else {
        if (xml) {
            goal_browser = MR_trace_browse_goal_xml;
            browser = MR_trace_browse_xml;
        } else {
            goal_browser = MR_trace_browse_goal_internal;
            browser = MR_trace_browse_internal;
        }

        if (word_count == 1) {
            problem = MR_trace_browse_one_goal(MR_mdb_out, goal_browser,
                                               MR_BROWSE_CALLER_BROWSE, format);

            if (problem != NULL) {
                fflush(MR_mdb_out);
                fprintf(MR_mdb_err, "mdb: %s.\n", problem);
            }
        } else if (word_count == 2) {
            if (MR_streq(words[1], "goal")) {
                problem = MR_trace_browse_one_goal(MR_mdb_out, goal_browser,
                                                   MR_BROWSE_CALLER_BROWSE, format);
            } else if (MR_streq(words[1], "exception")) {
                problem = MR_trace_browse_exception(event_info, browser,
                                                    MR_BROWSE_CALLER_BROWSE, format);
            } else if (MR_streq(words[1], "proc_body")) {
                problem = MR_trace_browse_proc_body(event_info, browser,
                                                    MR_BROWSE_CALLER_BROWSE, format);
            } else {
                problem = MR_trace_parse_browse_one(MR_mdb_out, MR_FALSE,
                                                    words[1], browser, MR_BROWSE_CALLER_BROWSE, format,
                                                    MR_TRUE);
            }

            if (problem != NULL) {
                fflush(MR_mdb_out);
                fprintf(MR_mdb_err, "mdb: %s.\n", problem);
            }
        } else if (word_count == 3 &&
                   (MR_streq(words[1], "io") || MR_streq(words[1], "action"))
                   && MR_trace_is_natural_number(words[2], &action))
        {
            problem = MR_trace_browse_action(MR_mdb_out, action, goal_browser,
                                             MR_BROWSE_CALLER_BROWSE, format);

            if (problem != NULL) {
                fflush(MR_mdb_out);
                fprintf(MR_mdb_err, "mdb: %s.\n", problem);
            }
        } else {
            MR_trace_usage_cur_cmd();
        }
    }

    return KEEP_INTERACTING;
}
Beispiel #7
0
MR_Next
MR_trace_cmd_print(char **words, int word_count, MR_TraceCmdInfo *cmd,
                   MR_EventInfo *event_info, MR_Code **jumpaddr)
{
    MR_BrowseFormat     format;
    MR_bool             xml;
    const char          *problem;
    MR_Unsigned         action;
    MR_Unsigned         lo_action;
    MR_Unsigned         hi_action;
    static MR_bool      have_next_io_action = MR_FALSE;
    static MR_Unsigned  next_io_action = 0;

    if (! MR_trace_options_format(&format, &xml, &words, &word_count)) {
        ; /* the usage message has already been printed */
    } else if (xml) {
        /* the --xml option is not valid for print */
        MR_trace_usage_cur_cmd();
    } else if (word_count == 1) {
        problem = MR_trace_browse_one_goal(MR_mdb_out,
                                           MR_trace_browse_goal_internal, MR_BROWSE_CALLER_PRINT, format);

        if (problem != NULL) {
            fflush(MR_mdb_out);
            fprintf(MR_mdb_err, "mdb: %s.\n", problem);
        }
    } else if (word_count == 2) {
        if (MR_streq(words[1], "*")) {
            problem = MR_trace_browse_all(MR_mdb_out,
                                          MR_trace_browse_internal, format);
        } else if (MR_streq(words[1], "goal")) {
            problem = MR_trace_browse_one_goal(MR_mdb_out,
                                               MR_trace_browse_goal_internal, MR_BROWSE_CALLER_PRINT, format);
        } else if (MR_streq(words[1], "exception")) {
            problem = MR_trace_browse_exception(event_info,
                                                MR_trace_browse_internal, MR_BROWSE_CALLER_PRINT, format);
        } else if (MR_streq(words[1], "proc_body")) {
            problem = MR_trace_browse_proc_body(event_info,
                                                MR_trace_browse_internal, MR_BROWSE_CALLER_PRINT, format);
        } else if ((MR_streq(words[1], "io") || MR_streq(words[1], "action")))
        {
            MR_Unsigned num_printed_actions;

            if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE) {
                fflush(MR_mdb_out);
                fprintf(MR_mdb_err,
                        "mdb: I/O tabling has not yet started.\n");
                return KEEP_INTERACTING;
            }

            if (MR_io_tabling_counter_hwm == 0) {
                fflush(MR_mdb_out);
                fprintf(MR_mdb_err,
                        "mdb: There are no tabled I/O actions yet.\n");
                return KEEP_INTERACTING;
            }

            if (have_next_io_action && (!
                                        (MR_io_tabling_start <= next_io_action
                                         && next_io_action < MR_io_tabling_counter_hwm)))
            {
                have_next_io_action = MR_FALSE;
            }

            if (have_next_io_action) {
                lo_action = next_io_action;
            } else {
                lo_action = MR_io_tabling_start;
            }

            hi_action = lo_action + MR_MAX_NUM_IO_ACTIONS_TO_PRINT;
            if (hi_action >= MR_io_tabling_counter_hwm) {
                hi_action = MR_io_tabling_counter_hwm - 1;
            }

            num_printed_actions = hi_action - lo_action + 1;
            if (num_printed_actions <= 0) {
                fprintf(MR_mdb_out, "There are no I/O actions to print\n");
                have_next_io_action = MR_FALSE;
            } else {
                for (action = lo_action; action <= hi_action; action++) {
                    fprintf(MR_mdb_out,
                            "action %" MR_INTEGER_LENGTH_MODIFIER "u: ", action);
                    problem = MR_trace_browse_action(MR_mdb_out, action,
                                                     MR_trace_browse_goal_internal,
                                                     MR_BROWSE_CALLER_PRINT, format);

                    if (problem != NULL) {
                        fflush(MR_mdb_out);
                        fprintf(MR_mdb_err, "mdb: %s.\n", problem);
                        return KEEP_INTERACTING;
                    }
                }

                if (hi_action == MR_io_tabling_counter_hwm - 1) {
                    fprintf(MR_mdb_out,
                            "there are no more actions (yet)\n");
                } else {
                    fprintf(MR_mdb_out,
                            "there are more actions, up to action "
                            "%" MR_INTEGER_LENGTH_MODIFIER "u\n",
                            MR_io_tabling_counter_hwm - 1);
                }

                next_io_action = hi_action + 1;
                have_next_io_action = MR_TRUE;
            }
        } else {
            problem = MR_trace_parse_browse_one(MR_mdb_out, MR_TRUE, words[1],
                                                MR_trace_browse_internal, MR_BROWSE_CALLER_PRINT, format,
                                                MR_FALSE);
        }

        if (problem != NULL) {
            fflush(MR_mdb_out);
            fprintf(MR_mdb_err, "mdb: %s.\n", problem);
        }
    } else if (word_count == 3 &&
               (MR_streq(words[1], "io") || MR_streq(words[1], "action")))
    {
        if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE) {
            fflush(MR_mdb_out);
            fprintf(MR_mdb_err,
                    "mdb: I/O tabling has not yet started.\n");
            return KEEP_INTERACTING;
        }

        if (MR_io_tabling_counter_hwm == 0) {
            fflush(MR_mdb_out);
            fprintf(MR_mdb_err,
                    "mdb: There are no tabled I/O actions yet.\n");
            return KEEP_INTERACTING;
        }

        if (MR_streq(words[2], "limits")) {
            fprintf(MR_mdb_out,
                    "I/O tabling has recorded actions "
                    "%" MR_INTEGER_LENGTH_MODIFIER "u to "
                    "%" MR_INTEGER_LENGTH_MODIFIER "u.\n",
                    MR_io_tabling_start, MR_io_tabling_counter_hwm - 1);
            fflush(MR_mdb_out);
        } else if (MR_trace_is_natural_number(words[2], &action)) {
            problem = MR_trace_browse_action(MR_mdb_out, action,
                                             MR_trace_browse_goal_internal,
                                             MR_BROWSE_CALLER_PRINT, format);

            if (problem != NULL) {
                fflush(MR_mdb_out);
                fprintf(MR_mdb_err, "mdb: %s.\n", problem);
                have_next_io_action = MR_FALSE;
            }

            next_io_action = action + 1;
            have_next_io_action = MR_TRUE;
        } else if (MR_trace_is_natural_number_pair(words[2],
                   &lo_action, &hi_action))
        {
            if (lo_action >= hi_action) {
                /* swap lo_action and hi_action */
                MR_Unsigned tmp;

                tmp = lo_action;
                lo_action = hi_action;
                hi_action = tmp;
            }

            if (! (MR_io_tabling_start <= lo_action
                    && hi_action < MR_io_tabling_counter_hwm))
            {
                fflush(MR_mdb_out);
                fprintf(MR_mdb_err,
                        "I/O tabling has only recorded actions "
                        "%" MR_INTEGER_LENGTH_MODIFIER "u to "
                        "%" MR_INTEGER_LENGTH_MODIFIER "u.\n",
                        MR_io_tabling_start, MR_io_tabling_counter_hwm - 1);
                have_next_io_action = MR_FALSE;
                return KEEP_INTERACTING;
            }

            for (action = lo_action; action <= hi_action; action++) {
                fprintf(MR_mdb_out,
                        "action %" MR_INTEGER_LENGTH_MODIFIER "u: ", action);
                problem = MR_trace_browse_action(MR_mdb_out, action,
                                                 MR_trace_browse_goal_internal,
                                                 MR_BROWSE_CALLER_PRINT, format);

                if (problem != NULL) {
                    fflush(MR_mdb_out);
                    fprintf(MR_mdb_err, "mdb: %s.\n", problem);
                    return KEEP_INTERACTING;
                }
            }

            next_io_action = hi_action + 1;
            have_next_io_action = MR_TRUE;
        } else {
            MR_trace_usage_cur_cmd();
        }
    } else {
        MR_trace_usage_cur_cmd();
    }

    return KEEP_INTERACTING;
}
MR_Next
MR_trace_cmd_table_io(char **words, int word_count, MR_TraceCmdInfo *cmd,
    MR_EventInfo *event_info, MR_Code **jumpaddr)
{
    if (word_count == 1) {
        if (! MR_io_tabling_allowed) {
            fprintf(MR_mdb_err,
                "This executable wasn't prepared for I/O tabling.\n");
            return KEEP_INTERACTING;
        }

        if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE) {
            fprintf(MR_mdb_out, "I/O tabling has not yet started.\n");
        } else if (MR_io_tabling_phase == MR_IO_TABLING_DURING) {
            fprintf(MR_mdb_out, "I/O tabling has started.\n");
        } else if (MR_io_tabling_phase == MR_IO_TABLING_AFTER) {
            fprintf(MR_mdb_out, "I/O tabling has stopped.\n");
        } else {
            MR_fatal_error("I/O tabling in impossible phase.\n");
        }
    } else if (word_count == 2 &&
        (MR_streq(words[1], "start") || MR_streq(words[1], "begin")))
    {
        if (! MR_io_tabling_allowed) {
            fprintf(MR_mdb_err,
                "This executable wasn't prepared for I/O tabling.\n");
            return KEEP_INTERACTING;
        }

        if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE) {
            MR_io_tabling_phase = MR_IO_TABLING_DURING;
            MR_io_tabling_start = MR_io_tabling_counter;
            MR_io_tabling_end = MR_IO_ACTION_MAX;
            MR_io_tabling_start_event_num = event_info->MR_event_number;
#ifdef  MR_DEBUG_RETRY
            MR_io_tabling_debug = MR_TRUE;
#endif
            fprintf(MR_mdb_out, "I/O tabling started.\n");
        } else if (MR_io_tabling_phase == MR_IO_TABLING_DURING) {
            fprintf(MR_mdb_out, "I/O tabling has already started.\n");
        } else if (MR_io_tabling_phase == MR_IO_TABLING_AFTER) {
            fprintf(MR_mdb_out, "I/O tabling has already stopped.\n");
        } else {
            MR_fatal_error("I/O tabling in impossible phase.\n");
        }
    } else if (word_count == 2 &&
        (MR_streq(words[1], "stop") || MR_streq(words[1], "end")))
    {
        if (! MR_io_tabling_allowed) {
            fprintf(MR_mdb_err,
                "This executable wasn't prepared for I/O tabling.\n");
            return KEEP_INTERACTING;
        }

        if (MR_io_tabling_phase == MR_IO_TABLING_BEFORE) {
            fprintf(MR_mdb_out, "I/O tabling has not yet started.\n");
        } else if (MR_io_tabling_phase == MR_IO_TABLING_DURING) {
            MR_io_tabling_phase = MR_IO_TABLING_AFTER;
            MR_io_tabling_end = MR_io_tabling_counter_hwm;
            MR_io_tabling_stop_event_num = event_info->MR_event_number;
            fprintf(MR_mdb_out, "I/O tabling stopped.\n");
        } else if (MR_io_tabling_phase == MR_IO_TABLING_AFTER) {
            fprintf(MR_mdb_out, "I/O tabling has already stopped.\n");
        } else {
            MR_fatal_error("I/O tabling in impossible phase.\n");
        }
    } else if (word_count == 2 && MR_streq(words[1], "stats")) {
        if (! MR_io_tabling_allowed) {
            fprintf(MR_mdb_err,
                "This executable wasn't prepared for I/O tabling.\n");
            return KEEP_INTERACTING;
        }

        fprintf(MR_mdb_out, "phase = %d\n", MR_io_tabling_phase);
        MR_print_unsigned_var(MR_mdb_out, "counter", MR_io_tabling_counter);
        MR_print_unsigned_var(MR_mdb_out, "hwm", MR_io_tabling_counter_hwm);
        MR_print_unsigned_var(MR_mdb_out, "start", MR_io_tabling_start);
        MR_print_unsigned_var(MR_mdb_out, "end", MR_io_tabling_end);
    } else if (word_count == 2 && MR_streq(words[1], "allow")) {
        /*
        ** The "table_io allow" command allows the programmer to give
        ** the command "table_io start" even in grades in which there
        ** is no guarantee that all I/O primitives are tabled. It is
        ** for developers only, because if it is used on programs in
        ** which some but not all I/O primitives are tabled, the
        ** results of turning on I/O tabling can be weird.
        */

        MR_io_tabling_allowed = MR_TRUE;
    } else {
        MR_trace_usage_cur_cmd();
    }

    return KEEP_INTERACTING;
}
MR_Next
MR_trace_cmd_retry(char **words, int word_count, MR_TraceCmdInfo *cmd,
    MR_EventInfo *event_info, MR_Code **jumpaddr)
{
    MR_Level            n;
    MR_Level            ancestor_level;
    MR_RetryAcrossIo    across_io;
    const char          *problem;
    MR_RetryResult      result;
    MR_bool             assume_all_io_is_tabled;
    MR_bool             unsafe_retry;

    ancestor_level = 0;
    across_io = MR_RETRY_IO_INTERACTIVE;
    assume_all_io_is_tabled = MR_FALSE;
    if (! MR_trace_options_retry(&across_io, &assume_all_io_is_tabled,
        &words, &word_count))
    {
        ; /* the usage message has already been printed */
    } else if (word_count == 2 &&
        ( MR_streq(words[1], "clique") || MR_streq(words[1], "clentry")))
    {
        if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_FRAME,
            &ancestor_level))
        {
            /* the error message has already been printed */
            return KEEP_INTERACTING;
        }
    } else if (word_count == 2 && MR_streq(words[1], "clparent")) {
        if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_PARENT_FRAME,
            &ancestor_level))
        {
            /* the error message has already been printed */
            return KEEP_INTERACTING;
        }
    } else if (word_count == 2 && MR_trace_is_natural_number(words[1], &n)) {
        ancestor_level = n;
    } else if (word_count == 1) {
        ancestor_level = 0;
    } else {
        MR_trace_usage_cur_cmd();
        return KEEP_INTERACTING;
    }

    if (ancestor_level == 0 && MR_port_is_entry(event_info->MR_trace_port)) {
        MR_trace_do_noop();
        return KEEP_INTERACTING;
    }

    result = MR_trace_retry(event_info, ancestor_level,
        across_io, assume_all_io_is_tabled, MR_UNTABLED_IO_RETRY_MESSAGE,
        &unsafe_retry, &problem, MR_mdb_in, MR_mdb_out, jumpaddr);
    switch (result) {

    case MR_RETRY_OK_DIRECT:
        cmd->MR_trace_cmd = MR_CMD_GOTO;
        cmd->MR_trace_stop_event = MR_trace_event_number + 1;
        cmd->MR_trace_strict = MR_FALSE;
        cmd->MR_trace_print_level = MR_default_print_level;
        return STOP_INTERACTING;

    case MR_RETRY_OK_FINISH_FIRST:
        cmd->MR_trace_cmd = MR_CMD_FINISH;
        cmd->MR_trace_stop_depth = event_info->MR_call_depth - ancestor_level;
        cmd->MR_trace_strict = MR_TRUE;
        cmd->MR_trace_print_level = MR_PRINT_LEVEL_NONE;

        /* Arrange to retry the call once it is finished. */
        /* XXX we should use the same options as the original retry */
        MR_insert_command_line_at_head("retry -o");
        return STOP_INTERACTING;

    case MR_RETRY_OK_FAIL_FIRST:
        cmd->MR_trace_cmd = MR_CMD_FAIL;
        cmd->MR_trace_stop_depth = event_info->MR_call_depth - ancestor_level;
        cmd->MR_trace_strict = MR_TRUE;
        cmd->MR_trace_print_level = MR_PRINT_LEVEL_NONE;

        /* Arrange to retry the call once it is finished. */
        /* XXX we should use the same options as the original retry */
        MR_insert_command_line_at_head("retry -o");
        return STOP_INTERACTING;

    case MR_RETRY_ERROR:
        fflush(MR_mdb_out);
        fprintf(MR_mdb_err, "%s\n", problem);
        return KEEP_INTERACTING;
    }

    MR_fatal_error("unrecognized retry result");
}
MR_bool
MR_event_matches_spy_point(const MR_LabelLayout *layout,
    MR_TracePort port, MR_SpyAction *action_ptr,
    MR_SpyPrintList *print_list_ptr)
{
    int                     slot;
    MR_bool                 enabled;
    MR_SpyPoint             *point;
    MR_SpyAction            action;
    MR_SpyPrintList         print_list;
    const MR_LabelLayout    *parent;
    const MR_UserEvent      *user_event;
    const MR_UserEventSpec  *user_event_spec;
    const char              *user_event_set;
    const char              *user_event_name;
    const char              *problem;
    MR_Word                 *base_sp;
    MR_Word                 *base_curfr;
    MR_Level                actual_level;

    enabled = MR_FALSE;
    action = MR_SPY_PRINT;
    print_list = NULL;

    if (MR_spied_label_next > 0) {
        slot = MR_search_spy_table_for_label(layout);
        if (slot >= 0) {
            point = MR_spy_points[MR_spied_labels[slot].MR_sl_point_num];
            if (point->MR_spy_when != MR_SPY_LINENO) {
                MR_fatal_error("non-lineno spy point in spied labels array");
            }

            MR_update_enabled_action(point, layout, port,
                &enabled, &action, &print_list);
        }

        if (MR_port_is_interface(port)) {
            MR_restore_transient_registers();
            base_sp = MR_sp;
            base_curfr = MR_curfr;
            parent = MR_find_nth_ancestor(layout, 1, &base_sp, &base_curfr,
                &actual_level, &problem);
            if (parent != NULL && actual_level == 1 &&
                0 <= (slot = MR_search_spy_table_for_label(parent)))
            {
                point = MR_spy_points[MR_spied_labels[slot].MR_sl_point_num];
                if (point->MR_spy_when != MR_SPY_LINENO) {
                    MR_fatal_error("non-lineno spy point in "
                        "spied labels array");
                }

                MR_update_enabled_action(point, layout, port,
                    &enabled, &action, &print_list);
            }
        }
    }

    user_event = layout->MR_sll_user_event;
    if (user_event != NULL) {
        user_event_spec = &MR_user_event_spec(layout);
        user_event_name = user_event_spec->MR_ues_event_name;
        user_event_set = MR_user_event_set_name(layout);

        /*
        ** Check for breakpoints that specify an event name, and possibly
        ** and event set.
        */

        slot = MR_search_spy_table_for_user_event_name(user_event_name);
        if (slot >= 0) {
            for (point = MR_spied_user_events[slot].MR_sue_points;
                point != NULL; point = point->MR_spy_next)
            {
                if (point->MR_spy_when != MR_SPY_USER_EVENT) {
                    MR_fatal_error("non-named-user-event spy point "
                        "in named user event array");
                }

                if (point->MR_spy_user_event_set == NULL ||
                    MR_streq(user_event_set, point->MR_spy_user_event_set))
                {
                    MR_update_enabled_action(point, layout, port,
                        &enabled, &action, &print_list);
                }
            }
        }

        /*
        ** Check for breakpoints that specify just an event set.
        */

        slot = MR_search_spy_table_for_user_event_set(user_event_set);
        if (slot >= 0) {
            for (point = MR_spied_user_event_sets[slot].MR_sues_points;
                point != NULL; point = point->MR_spy_next)
            {
                if (point->MR_spy_when != MR_SPY_USER_EVENT_SET) {
                    MR_fatal_error("non-named-user-event spy point "
                        "in named user event array");
                }

                MR_update_enabled_action(point, layout, port,
                    &enabled, &action, &print_list);
            }
        }

        /*
        ** Check for breakpoints that specify neither event name nor event set.
        */

        for (point = MR_spied_universal_user_events; point != NULL;
            point = point->MR_spy_next)
        {
            if (point->MR_spy_when != MR_SPY_USER_EVENT_SET) {
                MR_fatal_error("non-unnamed-user-event spy point "
                    "in unnamed user event list");
            }

            MR_update_enabled_action(point, layout, port,
                &enabled, &action, &print_list);
        }
    }

    slot = MR_search_spy_table_for_proc(layout->MR_sll_entry);
    if (slot >= 0) {
        for (point = MR_spied_procs[slot].MR_sp_points; point != NULL;
            point = point->MR_spy_next)
        {
            switch (point->MR_spy_when) {

                case MR_SPY_ALL:
                    MR_update_enabled_action(point, layout, port,
                        &enabled, &action, &print_list);
                    break;

                case MR_SPY_ENTRY:
                    if (MR_port_is_entry(port)) {
                        MR_update_enabled_action(point, layout, port,
                            &enabled, &action, &print_list);
                    } else {
                        continue;
                    }

                    break;

                case MR_SPY_INTERFACE:
                    if (MR_port_is_interface(port)) {
                        MR_update_enabled_action(point, layout, port,
                            &enabled, &action, &print_list);
                    } else {
                        continue;
                    }

                    break;

                case MR_SPY_SPECIFIC:
                    if (layout == point->MR_spy_label) {
                        MR_update_enabled_action(point, layout, port,
                            &enabled, &action, &print_list);
                    } else {
                        continue;
                    }

                    break;

                case MR_SPY_LINENO:
                    MR_fatal_error("lineno spy point in spied procs array");
                    break;

                case MR_SPY_USER_EVENT:
                    MR_fatal_error("user_event spy point "
                        "in spied procs array");
                    break;

                case MR_SPY_USER_EVENT_SET:
                    MR_fatal_error("user_event_set spy point "
                        "in spied procs array");
                    break;

                default:
                    MR_fatal_error("bad spy point when in "
                        "MR_event_matches_spy_point");
            }
        }
    }

    if (enabled) {
        *action_ptr = action;
        *print_list_ptr = print_list;
        return MR_TRUE;
    } else {
        return MR_FALSE;
    }
}