Beispiel #1
0
MR_TypeInfo
MR_make_type(int arity, MR_TypeCtorDesc type_ctor_desc, MR_Word arg_types_list)
{
    MR_TypeCtorInfo type_ctor_info;
    MR_Word         *new_type_info_arena;
    MR_Word         new_type_info_arena_word;
    MR_TypeInfo     *new_type_info_args;
    int             i;

    // We need to treat variable-arity types as a special case here.

    if (MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
        type_ctor_info = MR_TYPECTOR_DESC_GET_VA_TYPE_CTOR_INFO(
            type_ctor_desc);

        MR_restore_transient_registers();
        MR_offset_incr_hp_msg(new_type_info_arena_word, 0,
            MR_var_arity_type_info_size(arity),
            MR_ALLOC_SITE_TYPE_INFO, NULL);
        new_type_info_arena = (MR_Word *) new_type_info_arena_word;
        MR_save_transient_registers();
        MR_fill_in_var_arity_type_info(new_type_info_arena, type_ctor_info,
            arity, new_type_info_args);
    } else {
        type_ctor_info =
            MR_TYPECTOR_DESC_GET_FIXED_ARITY_TYPE_CTOR_INFO(type_ctor_desc);

        if (arity == 0) {
            return (MR_TypeInfo) type_ctor_info;
        }

        MR_restore_transient_registers();
        MR_offset_incr_hp_msg(new_type_info_arena_word, 0,
            MR_fixed_arity_type_info_size(arity),
            MR_ALLOC_SITE_TYPE_INFO, NULL);
        new_type_info_arena = (MR_Word *) new_type_info_arena_word;
        MR_save_transient_registers();
        MR_fill_in_fixed_arity_type_info(new_type_info_arena, type_ctor_info,
            new_type_info_args);
    }

    for (i = 1; i <= arity; i++) {
        new_type_info_args[i] = (MR_TypeInfo) MR_list_head(arg_types_list);
        arg_types_list = MR_list_tail(arg_types_list);
    }

    return (MR_TypeInfo) new_type_info_arena;
}
Beispiel #2
0
MR_Word
MR_arg_name_vector_to_list(int arity, const MR_ConstString *arg_names)
{
    MR_Word     arg_names_list;

    MR_restore_transient_registers();
    arg_names_list = MR_list_empty();

    if (arg_names == NULL) {
        /* No arguments have names. */
        while (arity > 0) {
            --arity;
            arg_names_list = MR_string_list_cons((MR_Word) NULL,
                arg_names_list);
        }
    } else {
        while (arity > 0) {
            --arity;
            arg_names_list = MR_string_list_cons((MR_Word) arg_names[arity],
                arg_names_list);
        }
    }

    MR_save_transient_registers();
    return arg_names_list;
}
Beispiel #3
0
void
MR_mkframe_msg(FILE *fp, const char *predname)
{
    MR_restore_transient_registers();

    if (!MR_lld_print_enabled) {
        return;
    }

    fprintf(fp, "\nnew choice point for procedure %s\n", predname);
    fprintf(fp, "new  fr: ");
    MR_printnondetstack(fp, MR_curfr);
    fprintf(fp, "\nprev fr: ");
    MR_printnondetstack(fp, MR_prevfr_slot(MR_curfr));
    fprintf(fp, "\nsucc fr: ");
    MR_printnondetstack(fp, MR_succfr_slot(MR_curfr));
    fprintf(fp, "\nsucc ip: ");
    MR_printlabel(fp, MR_succip_slot(MR_curfr));
    fprintf(fp, "redo fr: ");
    MR_printnondetstack(fp, MR_redofr_slot(MR_curfr));
    fprintf(fp, "\nredo ip: ");
    MR_printlabel(fp, MR_redoip_slot(MR_curfr));
#ifdef  MR_USE_MINIMAL_MODEL_OWN_STACKS
    fprintf(fp, "\ndet fr:  ");
    MR_printdetstack(fp, MR_table_detfr_slot(MR_curfr));
#endif
    fprintf(fp, "\n");

    if (MR_detaildebug) {
        MR_dumpnondetstack(fp);
    }

    fflush(fp);
}
Beispiel #4
0
void
MR_tailcall_msg(FILE *fp, const MR_Code *proc)
{
    MR_restore_transient_registers();

    MR_count_call(fp, proc);

#ifdef  MR_DEEP_PROFILING
    MR_check_watch_csd_start(proc);
#endif  // MR_DEEP_PROFILING

    MR_do_watches(fp);

    if (!MR_lld_print_enabled) {
        return;
    }

    fprintf(fp, "\ntail call %lu: ", MR_lld_cur_call);
    MR_printlabel(fp, proc);
    fprintf(fp, "cont ");
    MR_printlabel(fp, MR_succip);

    if (MR_anyregdebug) {
        MR_printregs(fp, "at tailcall:");
    }

#ifdef  MR_DEEP_PROFILING
    MR_print_deep_prof_vars(fp, "MR_tailcall_msg");
#endif
}
Beispiel #5
0
void
MR_mkdettempframe_msg(FILE *fp)
{
    MR_restore_transient_registers();

    if (!MR_lld_print_enabled) {
        return;
    }

    fprintf(fp, "\nnew det temp nondet frame");
    fprintf(fp, "\nnew  fr: ");
    MR_printnondetstack(fp, MR_maxfr);
    fprintf(fp, "\nprev fr: ");
    MR_printnondetstack(fp, MR_prevfr_slot(MR_maxfr));
    fprintf(fp, "\nredo fr: ");
    MR_printnondetstack(fp, MR_redofr_slot(MR_maxfr));
    fprintf(fp, "\nredo ip: ");
    MR_printlabel(fp, MR_redoip_slot(MR_maxfr));
    fprintf(fp, "det fr:  ");
    MR_printdetstack(fp, MR_tmp_detfr_slot(MR_maxfr));
    fprintf(fp, "\n");

    if (MR_detaildebug) {
        MR_dumpnondetstack(fp);
    }
}
Beispiel #6
0
MR_Word
MR_pseudo_type_info_vector_to_pseudo_type_info_list(int arity,
    MR_TypeInfoParams type_params,
    const MR_PseudoTypeInfo *arg_pseudo_type_infos)
{
    MR_PseudoTypeInfo   pseudo;
    MR_PseudoTypeInfo   arg_pseudo_type_info;
    MR_Word             pseudo_type_info_list;

    MR_restore_transient_registers();
    pseudo_type_info_list = MR_list_empty();

    while (--arity >= 0) {
            /* Get the argument type_info */

        pseudo = arg_pseudo_type_infos[arity];
        if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pseudo) &&
            MR_TYPE_VARIABLE_IS_EXIST_QUANT(pseudo))
        {
            arg_pseudo_type_info = pseudo;
        } else {
            MR_save_transient_registers();
            arg_pseudo_type_info =
                MR_create_pseudo_type_info(
                    (MR_PseudoTypeInfoParams) type_params, pseudo);
            MR_restore_transient_registers();

            MR_save_transient_registers();
            arg_pseudo_type_info =
                MR_collapse_equivalences_pseudo(arg_pseudo_type_info);
            MR_restore_transient_registers();
        }

        pseudo_type_info_list = MR_pseudo_type_info_list_cons(
            (MR_Word) arg_pseudo_type_info, pseudo_type_info_list);
    }

    MR_save_transient_registers();
    return pseudo_type_info_list;
}
Beispiel #7
0
MR_Word
MR_set_reg(int num, MR_Word val)
{
    MR_restore_transient_registers();
    switch (num) {

        case 1:  MR_r1  = val; MR_save_transient_registers(); return val;
        case 2:  MR_r2  = val; MR_save_transient_registers(); return val;
        case 3:  MR_r3  = val; MR_save_transient_registers(); return val;
        case 4:  MR_r4  = val; MR_save_transient_registers(); return val;
        case 5:  MR_r5  = val; MR_save_transient_registers(); return val;
        case 6:  MR_r6  = val; MR_save_transient_registers(); return val;
        case 7:  MR_r7  = val; MR_save_transient_registers(); return val;
        case 8:  MR_r8  = val; MR_save_transient_registers(); return val;
        case 9:  MR_r9  = val; MR_save_transient_registers(); return val;
        case 10: MR_r10 = val; MR_save_transient_registers(); return val;
        case 11: MR_r11 = val; MR_save_transient_registers(); return val;
        case 12: MR_r12 = val; MR_save_transient_registers(); return val;
        case 13: MR_r13 = val; MR_save_transient_registers(); return val;
        case 14: MR_r14 = val; MR_save_transient_registers(); return val;
        case 15: MR_r15 = val; MR_save_transient_registers(); return val;
        case 16: MR_r16 = val; MR_save_transient_registers(); return val;
        case 17: MR_r17 = val; MR_save_transient_registers(); return val;
        case 18: MR_r18 = val; MR_save_transient_registers(); return val;
        case 19: MR_r19 = val; MR_save_transient_registers(); return val;
        case 20: MR_r20 = val; MR_save_transient_registers(); return val;
        case 21: MR_r21 = val; MR_save_transient_registers(); return val;
        case 22: MR_r22 = val; MR_save_transient_registers(); return val;
        case 23: MR_r23 = val; MR_save_transient_registers(); return val;
        case 24: MR_r24 = val; MR_save_transient_registers(); return val;
        case 25: MR_r25 = val; MR_save_transient_registers(); return val;
        case 26: MR_r26 = val; MR_save_transient_registers(); return val;
        case 27: MR_r27 = val; MR_save_transient_registers(); return val;
        case 28: MR_r28 = val; MR_save_transient_registers(); return val;
        case 29: MR_r29 = val; MR_save_transient_registers(); return val;
        case 30: MR_r30 = val; MR_save_transient_registers(); return val;
        case 31: MR_r31 = val; MR_save_transient_registers(); return val;
        case 32: MR_r32 = val; MR_save_transient_registers(); return val;

    }

    /* NOTREACHED */
    fprintf(stderr, "register %d out of range in set_reg\n", num);
    abort();
    return 0;
}
Beispiel #8
0
MR_Word
MR_get_reg(int num)
{
    MR_restore_transient_registers();
    switch (num) {

        case 1:  return MR_r1;
        case 2:  return MR_r2;
        case 3:  return MR_r3;
        case 4:  return MR_r4;
        case 5:  return MR_r5;
        case 6:  return MR_r6;
        case 7:  return MR_r7;
        case 8:  return MR_r8;
        case 9:  return MR_r9;
        case 10: return MR_r10;
        case 11: return MR_r11;
        case 12: return MR_r12;
        case 13: return MR_r13;
        case 14: return MR_r14;
        case 15: return MR_r15;
        case 16: return MR_r16;
        case 17: return MR_r17;
        case 18: return MR_r18;
        case 19: return MR_r19;
        case 20: return MR_r20;
        case 21: return MR_r21;
        case 22: return MR_r22;
        case 23: return MR_r23;
        case 24: return MR_r24;
        case 25: return MR_r25;
        case 26: return MR_r26;
        case 27: return MR_r27;
        case 28: return MR_r28;
        case 29: return MR_r29;
        case 30: return MR_r30;
        case 31: return MR_r31;
        case 32: return MR_r32;

    }

    /* NOTREACHED */
    fprintf(stderr, "register %d out of range in get_reg\n", num);
    abort();
    return 0;
}
Beispiel #9
0
MR_Word
MR_type_params_vector_to_list(int arity, MR_TypeInfoParams type_params)
{
    MR_TypeInfo arg_type;
    MR_Word     type_info_list;

    MR_restore_transient_registers();
    type_info_list = MR_list_empty();
    while (arity > 0) {
        type_info_list = MR_type_info_list_cons((MR_Word) type_params[arity],
            type_info_list);
        --arity;
    }

    MR_save_transient_registers();
    return type_info_list;
}
Beispiel #10
0
void
MR_redo_msg(FILE *fp)
{
    MR_restore_transient_registers();

    MR_do_watches(fp);

    if (!MR_lld_print_enabled) {
        return;
    }

    fprintf(fp, "\nredo from procedure");
    fprintf(fp, "\ncurr fr: ");
    MR_printnondetstack(fp, MR_curfr);
    fprintf(fp, "\nredo fr: ");
    MR_printnondetstack(fp, MR_maxfr);
    fprintf(fp, "\nredo ip: ");
    MR_printlabel(fp, MR_redoip_slot(MR_maxfr));
}
void
MR_copy_regs_to_saved_regs(int max_mr_num, MR_Word *saved_regs,
    int max_f_num, MR_Float *saved_f_regs)
{
    /*
    ** In the process of browsing within the debugger, we call Mercury,
    ** which may clobber the contents of the virtual machine registers,
    ** both control and general purpose, and both real and virtual
    ** registers. We must therefore save and restore these.
    ** We store them in the saved_regs array.
    **
    ** The call to MR_trace will clobber the transient registers
    ** on architectures that have them. The compiler generated code
    ** will therefore call MR_save_transient_registers to save the
    ** transient registers in the fake_reg array. We here restore them
    ** to the real registers, save them with the other registers back in
    ** fake_reg, and then copy all fake_reg entries to saved_regs.
    **
    ** If float registers are used, we must save them as well.
    ** We never use real machine registers for floats so we just have
    ** to copy them from the MR_float_reg array.
    */

    int i;

    MR_restore_transient_registers();
    MR_save_registers();

    for (i = 0; i <= max_mr_num; i++) {
        saved_regs[i] = MR_fake_reg[i];
    }

#ifdef MR_BOXED_FLOAT
    for (i = 0; i <= max_f_num; i++) {
        saved_f_regs[i] = MR_float_reg[i];
    }
#else
    (void) max_f_num;
    (void) saved_f_regs;
#endif
}
Beispiel #12
0
void
MR_succeeddiscard_msg(FILE *fp)
{
    MR_restore_transient_registers();

    MR_do_watches(fp);

    if (!MR_lld_print_enabled) {
        return;
    }

    fprintf(fp, "\nsucceeding from procedure\n");
    fprintf(fp, "curr fr: ");
    MR_printnondetstack(fp, MR_curfr);
    fprintf(fp, "succ fr: ");
    MR_printnondetstack(fp, MR_succfr_slot(MR_curfr));
    fprintf(fp, "succ ip: ");
    MR_printlabel(fp, MR_succip_slot(MR_curfr));

    if (MR_detaildebug) {
        MR_printregs(fp, "registers at success");
    }
}
Beispiel #13
0
void
MR_printregs(FILE *fp, const char *msg)
{
    MR_restore_transient_registers();

    fprintf(fp, "\n%s\n", msg);

    if (MR_sregdebug) {
        fprintf(fp, "%-9s", "succip:");
        MR_printlabel(fp, MR_succip);
        fprintf(fp, "%-9s", "curfr:");
        MR_printnondetstack(fp, MR_curfr);
        fprintf(fp, "%-9s", "maxfr:");
        MR_printnondetstack(fp, MR_maxfr);
        fprintf(fp, "%-9s", "hp:");
        MR_printheap(fp, MR_hp);
        fprintf(fp, "%-9s", "sp:");
        MR_printdetstack(fp, MR_sp);
    }

    if (MR_ordregdebug) {
        MR_print_ordinary_regs(fp);
    }
}
static MR_bool
MR_spy_cond_is_true(MR_SpyPoint *point, const MR_LabelLayout *label_layout)
{
    int             max_mr_num;
    MR_Word         saved_regs[MR_MAX_FAKE_REG];
    int             max_f_num;
    MR_Float        saved_f_regs[MR_MAX_VIRTUAL_F_REG];
    const char      *problem;
    char            *bad_path;
    MR_TypeInfo     type_info;
    MR_Word         value;
    const char      *name;
    MR_Word         *value_ptr;
    MR_TypeInfo     sub_type_info;
    MR_Word         *sub_value_ptr;
    MR_Word         match;
    MR_bool         saved_trace_func_enabled;
    MR_bool         retval;
    MR_SpyCond      *cond;

    if (point->MR_spy_cond == NULL) {
        return MR_TRUE;
    }

    MR_restore_transient_registers();

    cond = point->MR_spy_cond;

    /*
    ** From this point, returning should be done by setting both
    ** MR_spy_point_cond_problem and retval, and goto end.
    */

    MR_spy_point_cond_bad = cond;
    MR_spy_point_cond_problem = "internal error in MR_spy_cond_is_true";
    retval = MR_TRUE;

    MR_compute_max_mr_num(max_mr_num, label_layout);
    max_f_num = label_layout->MR_sll_entry->MR_sle_max_f_num;
    /* This also saves the regs in MR_fake_regs. */
    MR_copy_regs_to_saved_regs(max_mr_num, saved_regs,
        max_f_num, saved_f_regs);
    MR_trace_init_point_vars(label_layout, saved_regs, saved_f_regs,
        (MR_TracePort) label_layout->MR_sll_port, MR_FALSE);

    problem = MR_lookup_unambiguous_var_spec(cond->MR_cond_var_spec,
        &type_info, &value, &name);
    if (problem != NULL) {
        if (cond->MR_cond_require_var) {
            MR_spy_point_cond_problem = problem;
            retval = MR_TRUE;
        } else {
            MR_spy_point_cond_problem = NULL;
            retval = MR_FALSE;
        }

        goto end;
    }

    value_ptr = &value;
    bad_path = MR_select_specified_subterm(cond->MR_cond_path,
        type_info, value_ptr, &sub_type_info, &sub_value_ptr);

    if (bad_path != NULL) {
        if (cond->MR_cond_require_var) {
            MR_spy_point_cond_problem = MR_trace_bad_path(cond->MR_cond_path,
                bad_path);
            retval = MR_TRUE;
        } else {
            MR_spy_point_cond_problem = NULL;
            retval = MR_FALSE;
        }
        goto end;
    }

#ifdef MR_DEBUG_SPY_COND
    MR_print_cterm(stdout, cond->cond_term);
    fprintf(stdout, ": ");
#endif

    saved_trace_func_enabled = MR_trace_func_enabled;
    MR_trace_func_enabled = MR_FALSE;
    MR_TRACE_CALL_MERCURY(
        ML_BROWSE_match_with_cterm((MR_Word) sub_type_info, *sub_value_ptr,
            cond->MR_cond_term, &match);
    );
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;
    }
}
MR_bool
MR_default_handler(MR_Word *fault_addr, MR_MemoryZone *zone, void *context)
{
#ifndef MR_CHECK_OVERFLOW_VIA_MPROTECT
    return MR_FALSE;
#else
    MR_Word *new_zone;
    size_t  zone_size;

    new_zone = (MR_Word *) MR_round_up((MR_Unsigned) fault_addr
        + sizeof(MR_Word), MR_unit);

    if (new_zone <= zone->MR_zone_hardmax) {
        zone_size = (char *) new_zone - (char *) zone->MR_zone_redzone;

        if (MR_memdebug) {
            fprintf(stderr, "trying to unprotect %s#%"
                MR_INTEGER_LENGTH_MODIFIER "d from %p to %p (%x)\n",
            zone->MR_zone_name, zone->MR_zone_id,
            (void *) zone->MR_zone_redzone, (void *) new_zone,
            (int) zone_size);
        }
        if (MR_protect_pages((char *) zone->MR_zone_redzone, zone_size,
            PROT_READ|PROT_WRITE) < 0)
        {
            char buf[2560];
            sprintf(buf, "Mercury runtime: cannot unprotect %s#%"
                    MR_INTEGER_LENGTH_MODIFIER "d zone",
                zone->MR_zone_name, zone->MR_zone_id);
            perror(buf);
            exit(1);
        }

        zone->MR_zone_redzone = new_zone;

        if (MR_memdebug) {
            fprintf(stderr, "successful: %s#%" MR_INTEGER_LENGTH_MODIFIER
                    "d redzone now %p to %p\n",
                zone->MR_zone_name, zone->MR_zone_id,
                (void *) zone->MR_zone_redzone, (void *) zone->MR_zone_top);
        }
      #if defined(MR_NATIVE_GC) && !defined(MR_HIGHLEVEL_CODE)
        MR_schedule_agc(get_pc_from_context(context),
            get_sp_from_context(context),
            get_curfr_from_context(context));
      #endif
        return MR_TRUE;
    } else {
        char buf[2560];
        if (MR_memdebug) {
            fprintf(stderr, "can't unprotect last page of %s#%"
                    MR_INTEGER_LENGTH_MODIFIER "d\n",
                zone->MR_zone_name, zone->MR_zone_id);
            fflush(stdout);
        }
#ifdef  MR_STACK_EXTEND_DEBUG
        MR_restore_transient_registers();
        fprintf(stderr, "sp = %p, maxfr = %p\n", MR_sp, MR_maxfr);
        MR_debug_memory_zone(stderr, zone);
#endif
        sprintf(buf, "\nMercury runtime: memory zone %s#%"
                MR_INTEGER_LENGTH_MODIFIER "d overflowed\n",
            zone->MR_zone_name, zone->MR_zone_id);
        MR_fatal_abort(context, buf, MR_TRUE);
    }

    return MR_FALSE;
#endif
}