From 376f2c69aff23b83cf4cc92e1cbf1a50d6bcbbf1 Mon Sep 17 00:00:00 2001 From: Tyson Dowd Date: Wed, 22 Jul 1998 07:55:19 +0000 Subject: [PATCH] An initial implementation of the accurate garbage collector. Estimated hours taken: 90 An initial implementation of the accurate garbage collector. WORK_IN_PROGRESS: Add an entry for the accurate garbage collector. library/builtin.m: library/mercury_builtin.m: library/std_util.m: runtime/mercury_tabling.h: Deep copy terms using the address of the value instead of just the value. library/io.m: Initialize the garbage collector's rootset with the globals. runtime/Mmakefile: Add new files to the Mmakefile. runtime/mercury_accurate_gc.h: runtime/mercury_accurate_gc.c: The new garbage collector. runtime/mercury_agc_debug.c: runtime/mercury_agc_debug.h: Debugging utilities for the new garbage collector. runtime/mercury_deep_copy.c: runtime/mercury_deep_copy.h: runtime/mercury_deep_copy_body.h: Put the deep copy code in mercury_deep_copy_body.h, and #include it with appropriate #defines in order to get a variant for deep_copy(), and one for agc_deep_copy(). agc_deep_copy() forwards pointers as it copies. Also, deep_copy (all variants) have been modified to take a pointer to the data to be copied, because some variants need to be able to modify it. runtime/mercury_engine.c: runtime/mercury_engine.h: Add a second heap_zone which is the to-space of the copying collector. Add a debug_heap_zone, which is used as a scratch heap for debugging. runtime/mercury_label.c: Instead of realloc(entry_table, ....) do entry_table = realloc(entry_table, ....) to avoid horrible bugs. Also, make sure the tables get initialized before looking up an entry label. runtime/mercury_imp.h: Include mercury_debug.h before most of the modules. (mercury_engine.h adds a new MemoryZone only if we are debugging accurate GC). runtime/mercury_memory.c: Setup the debug_memory_zone sizes. Remove an unnecessary prototype. runtime/mercury_memory_handlers.c: Add code to get the program counter and the stack pointer from the signal context. Call MR_schedule_agc() from default_handler() if doing accurate gc. runtime/mercury_memory_zones.c: Setup the hardzone regardless of whether redzones are used. Add some more debugging information. runtime/mercury_regorder.h: runtime/machdeps/alpha_regs.h: runtime/machdeps/i386_regs.h: Add definitions to make the real machine registers name/number for MR_sp available. runtime/mercury_trace_internal.c: runtime/mercury_trace_util.c: runtime/mercury_trace_util.h: Add MR_trace_write_variable(), which writes terms given their value and type_info. runtime/mercury_wrapper.c: runtime/mercury_wrapper.h: Change the size of the heap redzone when doing accurate GC. Use a small heap when debugging agc. runtime/mercury_debug.h: runtime/mercury_conf_param.h: Add new debugging macros and document them. runtime/mercury_type_info.c: Add const to the pointer arguments of MR_make_type_info. --- runtime/Mmakefile | 7 +- runtime/machdeps/alpha_regs.h | 10 +- runtime/machdeps/i386_regs.h | 8 +- runtime/mercury_accurate_gc.c | 476 +++++++++++++++++++++++++++++++ runtime/mercury_agc_debug.c | 243 ++++++++++++++++ runtime/mercury_deep_copy_body.h | 356 +++++++++++++++++++++++ runtime/mercury_engine.c | 10 + runtime/mercury_engine.h | 6 + runtime/mercury_label.c | 8 +- runtime/mercury_memory.c | 7 +- runtime/mercury_memory.h | 11 + runtime/mercury_stack_trace.h | 30 ++ runtime/mercury_thread.c | 2 + runtime/mercury_trace_util.c | 29 ++ runtime/mercury_trace_util.h | 6 + runtime/mercury_type_info.h | 6 +- runtime/mercury_wrapper.h | 2 + 17 files changed, 1206 insertions(+), 11 deletions(-) create mode 100644 runtime/mercury_accurate_gc.c create mode 100644 runtime/mercury_agc_debug.c create mode 100644 runtime/mercury_deep_copy_body.h diff --git a/runtime/Mmakefile b/runtime/Mmakefile index 441e61322..b54883aa6 100644 --- a/runtime/Mmakefile +++ b/runtime/Mmakefile @@ -24,12 +24,14 @@ MOD2C = $(SCRIPTS_DIR)/mod2c # keep this list in alphabetical order, please HDRS = \ mercury_accurate_gc.h \ + mercury_agc_debug.h \ mercury_calls.h \ mercury_conf.h \ mercury_conf_param.h \ mercury_context.h \ mercury_debug.h \ mercury_deep_copy.h \ + mercury_deep_copy_body.h \ mercury_dummy.h \ mercury_dlist.h \ mercury_engine.h \ @@ -92,7 +94,10 @@ MACHHDRS = machdeps/no_regs.h \ # keep this list in alphabetical order, please -CFILES = mercury_context.c \ +CFILES = \ + mercury_accurate_gc.c \ + mercury_agc_debug.c \ + mercury_context.c \ mercury_deep_copy.c \ mercury_dlist.c \ mercury_dummy.c \ diff --git a/runtime/machdeps/alpha_regs.h b/runtime/machdeps/alpha_regs.h index 0cbd2bd7d..cd676e232 100644 --- a/runtime/machdeps/alpha_regs.h +++ b/runtime/machdeps/alpha_regs.h @@ -1,5 +1,5 @@ /* -** Copyright (C) 1994-1997 The University of Melbourne. +** Copyright (C) 1994-1998 The University of Melbourne. ** This file may only be copied under the terms of the GNU Library General ** Public License - see the file COPYING.LIB in the Mercury distribution. */ @@ -32,6 +32,14 @@ register Word mr4 __asm__("$13"); /* register s4 */ register Word mr5 __asm__("$14"); /* register s5 */ register Word mr6 __asm__("$15"); /* the frame pointer (fp) */ +#define MR_real_reg_number_mr0 9 +#define MR_real_reg_number_mr1 10 +#define MR_real_reg_number_mr2 11 +#define MR_real_reg_number_mr3 12 +#define MR_real_reg_number_mr4 13 +#define MR_real_reg_number_mr5 14 +#define MR_real_reg_number_mr6 15 + #define save_regs_to_mem(save_area) ( \ save_area[0] = mr0, \ save_area[1] = mr1, \ diff --git a/runtime/machdeps/i386_regs.h b/runtime/machdeps/i386_regs.h index a8f485fa1..75da72ad4 100644 --- a/runtime/machdeps/i386_regs.h +++ b/runtime/machdeps/i386_regs.h @@ -1,5 +1,5 @@ /* -** Copyright (C) 1993-1997 The University of Melbourne. +** Copyright (C) 1993-1998 The University of Melbourne. ** This file may only be copied under the terms of the GNU Library General ** Public License - see the file COPYING.LIB in the Mercury distribution. */ @@ -61,10 +61,16 @@ register Word mr0 __asm__("esi"); /* sp */ register Word mr1 __asm__("edi"); /* succip */ +#define MR_real_reg_number_mr0 esi +#define MR_real_reg_number_mr1 edi + #if PIC_REG #define mr2 MR_fake_reg[2] #else register Word mr2 __asm__("ebx"); /* r1 */ + + #define MR_real_reg_number_mr2 ebx + #endif #if PIC_REG diff --git a/runtime/mercury_accurate_gc.c b/runtime/mercury_accurate_gc.c new file mode 100644 index 000000000..cad29037b --- /dev/null +++ b/runtime/mercury_accurate_gc.c @@ -0,0 +1,476 @@ +/* +** Copyright (C) 1998 The University of Melbourne. +** This file may only be copied under the terms of the GNU Library General +** Public License - see the file COPYING.LIB in the Mercury distribution. +*/ + +/* +** This module contains the accurate garbage collector. +*/ + +#include "mercury_imp.h" + +#ifdef NATIVE_GC + +#include "mercury_trace_util.h" +#include "mercury_deep_copy.h" +#include "mercury_agc_debug.h" + +/* +** Function prototypes. +*/ +static void garbage_collect(Code *saved_success, Word *stack_pointer, + Word *current_frame); +static void garbage_collect_roots(void); +static void copy_value(MR_Live_Lval locn, Word *type_info, bool copy_regs, + Word *stack_pointer, Word *current_frame); + +/* +** Global variables (only used in this module, however). +*/ +static Code *saved_success = (Code *) NULL; +static Word *saved_success_location = (Word *) NULL; +static bool gc_scheduled = FALSE; +static bool gc_running = FALSE; + +/* The list of roots */ +static MR_RootList root_list = NULL; + +/* The last root on the list */ +static MR_RootList last_root = NULL; + + +Define_extern_entry(mercury__garbage_collect_0_0); + + +/* +** MR_schedule_agc: +** Schedule garbage collection. +** +** We do this by replacing the succip that is saved in +** the current procedure's stack frame with the address +** of the garbage collector. When the current procedure +** returns, it will call the garbage collectior. +** +** (We go to this trouble because then the stacks will +** be in a known state -- each stack frame is described +** by information associated with the continuation label +** that the code will return to). +*/ +void +MR_schedule_agc(Code *pc_at_signal, Word *sp_at_signal) +{ + MR_Stack_Layout_Label *layout; + const MR_Stack_Layout_Entry *entry_layout; + MR_Lval_Type type; + MR_Live_Lval location; + const char *reason; + MR_Entry *entry_label = NULL; + int determinism, number; + + if (gc_running) { + /* + ** This is bad news, but it can happen if you don't + ** collect any garbage. We should try to avoid it by + ** resizing the heaps so they don't become too full. + ** + ** It might also be worthwhile eventually turning off + ** the redzone in the destination heap (but only when + ** the large problem of handling collections with little + ** garbage has been solved). + */ + + fprintf(stderr, "Mercury runtime: Garbage collection scheduled" + " while collector is already running\n"); + fprintf(stderr, "Mercury_runtime: Trying to continue...\n"); + return; + } + +#ifdef MR_DEBUG_AGC_SCHEDULING + fprintf(stderr, "PC at signal: %ld (%lx)\n", + (long) pc_at_signal, (long) pc_at_signal); + fprintf(stderr, "SP at signal: %ld (%lx)\n", + (long) sp_at_signal, (long) sp_at_signal); + fflush(NULL); +#endif + + /* Search for the entry label */ + + entry_label = MR_prev_entry_by_addr(pc_at_signal); + entry_layout = entry_label->e_layout; + + determinism = entry_layout->MR_sle_detism; + + if (determinism < 0) { + /* + ** This means we have reached some handwritten code that has + ** no further information about the stack frame. + */ + fprintf(stderr, "Mercury runtime: LABEL: %s has no stack" + "layout info\n", entry_label->e_name); + fprintf(stderr, "Mercury runtime: Trying to continue...\n"); + return; + } + +#ifdef MR_DEBUG_AGC_SCHEDULING + fprintf(stderr, "scheduling called at: %s (%ld %lx)\n", + entry_label->e_name, (long) entry_label->e_addr, + (long) entry_label->e_addr); + fflush(NULL); +#endif + + /* + ** If we have already scheduled a garbage collection, undo the + ** last change, and do a new one. + */ + if (gc_scheduled) { +#ifdef MR_DEBUG_AGC_SCHEDULING + fprintf(stderr, "GC scheduled again. Replacing old scheduling," + " and trying to schedule again.\n"); +#endif + *saved_success_location = (Word) saved_success; + } + gc_scheduled = TRUE; + + if (MR_DETISM_DET_STACK(determinism)) { + location = entry_layout->MR_sle_succip_locn; + type = MR_LIVE_LVAL_TYPE(location); + number = MR_LIVE_LVAL_NUMBER(location); + + if (type != MR_LVAL_TYPE_STACKVAR) { + fatal_error("can only handle stackvars"); + } + + /* + ** Save the old succip and its location. + */ + saved_success_location = &based_detstackvar(sp_at_signal, + number); + saved_success = (Code *) *saved_success_location; + +#ifdef MR_DEBUG_AGC_SCHEDULING + fprintf(stderr, "old succip: %ld (%lx) new: %ld (%lx)", + (long) saved_success, + (long) saved_success, + (long) ENTRY(mercury__garbage_collect_0_0), + (long) ENTRY(mercury__garbage_collect_0_0)); +#endif + + /* + ** Replace the old succip with the address of the + ** garbage collector. + */ + *saved_success_location = (Word) mercury__garbage_collect_0_0; + + } else { + /* + ** XXX we don't support nondet stack frames yet. + */ + fatal_error("cannot schedule in nondet stack frame"); + } + + +#ifdef MR_DEBUG_AGC_SCHEDULING + fprintf(stderr, "Accurate GC scheduled.\n"); +#endif +} + +BEGIN_MODULE(native_gc) +BEGIN_CODE + +/* +** Our garbage collection entry label. +** +** It saves the registers -- we use the saved registers +** for garbage collection and leave the real ones alone. +*/ +Define_entry(mercury__garbage_collect_0_0); + + /* record that the collector is running */ + gc_running = TRUE; + + save_registers(); + garbage_collect(saved_success, MR_sp, MR_curfr); + restore_registers(); + gc_scheduled = FALSE; + gc_running = FALSE; + + MR_succip = saved_success; + proceed(); + fatal_error("Unreachable code reached"); + +END_MODULE + +/*---------------------------------------------------------------------------*/ + +/* +** garbage_collect: +** +** The main garbage collection routine. +** +** (We use 4 space tabs here because of the depth of indentation). +*/ +void +garbage_collect(Code *success_ip, Word *stack_pointer, Word *current_frame) +{ + MR_Internal *label, *first_label; + int i, var_count, count; + MR_Determinism determinism; + const MR_Stack_Layout_Label *internal_layout; + const MR_Stack_Layout_Vars *vars; + MemoryZone *old_heap, *new_heap; + Word *type_params; + bool succeeded; + bool top_frame = TRUE; + MR_MemoryList allocated_memory_cells = NULL; + Word *old_hp; + MR_Stack_Layout_Entry *entry_layout; + Word *first_stack_pointer, *first_current_frame; + + + old_heap = MR_ENGINE(heap_zone); + new_heap = MR_ENGINE(heap_zone2); + +#ifdef MR_DEBUG_AGC_COLLECTION + fprintf(stderr, "\ngarbage_collect() called.\n"); + + fprintf(stderr, "old_heap->min: %lx \t old_heap->hardmax: %lx\n", + (long) old_heap->min, (long) old_heap->hardmax); + fprintf(stderr, "new_heap->min: %lx \t new_heap->hardmax: %lx\n", + (long) new_heap->min, (long) new_heap->hardmax); + + fprintf(stderr, "MR_virtual_hp: %lx\n", (long) MR_virtual_hp); +#endif + + old_hp = MR_virtual_hp; + + /* + ** The new heap pointer starts at the bottom of the new heap. + */ + MR_virtual_hp = new_heap->min; + + /* + ** Swap the two heaps. + */ + { + MemoryZone *tmp; + + tmp = MR_ENGINE(heap_zone2); + MR_ENGINE(heap_zone2) = MR_ENGINE(heap_zone); + MR_ENGINE(heap_zone) = tmp; + } + +#ifdef MR_DEBUG_AGC_COLLECTION + fprintf(stderr, "Swapped heaps\n"); + fprintf(stderr, "MR_virtual_hp: %lx\n", (long) MR_virtual_hp); +#endif + + label = MR_lookup_internal_by_addr(success_ip); + internal_layout = label->i_layout; + entry_layout = internal_layout->MR_sll_entry; + +#ifdef MR_DEBUG_AGC_COLLECTION + first_label = label; + first_stack_pointer = stack_pointer; + first_current_frame = current_frame; + fprintf(stderr, "BEFORE:\n"); + MR_agc_dump_stack_frames(first_label, old_heap, first_stack_pointer, + first_current_frame); + MR_agc_dump_roots(root_list); +#endif + + /* + ** For each stack frame ... + */ + do { + MR_Stack_Walk_Step_Result result; + const char *problem; + const MR_Stack_Layout_Label *return_label_layout; + + var_count = internal_layout->MR_sll_var_count; + vars = &(internal_layout->MR_sll_var_info); + + /* Get the type parameters from the stack frame. */ + + type_params = MR_trace_materialize_typeinfos_base(vars, + top_frame, stack_pointer, current_frame); + + /* Copy each live variable */ + + for (i = 0; i < var_count; i++) { + MR_Stack_Layout_Var sl_var; + MR_Live_Type sl_type; + Word *pseudo_type_info, *type_info; + + sl_var = vars->MR_slvs_pairs[i]; + if (MR_LIVE_TYPE_IS_VAR(sl_var.MR_slv_live_type)) { + pseudo_type_info = MR_LIVE_TYPE_GET_VAR_TYPE( + sl_var.MR_slv_live_type); + type_info = MR_make_type_info(type_params, pseudo_type_info, + &allocated_memory_cells); + copy_value(sl_var.MR_slv_locn, type_info, top_frame, + stack_pointer, current_frame); + MR_deallocate(allocated_memory_cells); + allocated_memory_cells = NULL; + } + } + + free(type_params); + + result = MR_stack_walk_step(entry_layout, &return_label_layout, + (Word **) &stack_pointer, ¤t_frame, &problem); + + if (result == STEP_ERROR_BEFORE || result == STEP_ERROR_AFTER) { + fatal_error(problem); + } + + if (return_label_layout == NULL) { + break; + } + entry_layout = return_label_layout->MR_sll_entry; + internal_layout = return_label_layout; + top_frame = FALSE; + } while (TRUE); /* end for each stack frame... */ + + /* + ** Copy any roots that are not on the stack. + */ + garbage_collect_roots(); + +#ifdef MR_DEBUG_AGC_COLLECTION + fprintf(stderr, "AFTER:\n"); + + MR_agc_dump_stack_frames(first_label, new_heap, first_stack_pointer, + first_current_frame); + MR_agc_dump_roots(root_list); + + fprintf(stderr, "old heap: %ld bytes, new heap: %ld bytes\n", + (long) ((char *) old_hp - (char *) old_heap->min), + (long) ((char *) MR_virtual_hp - (char *) new_heap->min)); + fprintf(stderr, "%ld bytes recovered\n", + (long) ((char *) old_hp - (char *) old_heap->min) - + ((char *) MR_virtual_hp - (char *) new_heap->min)); +#endif + + /* Reset the redzone on the old heap */ + reset_redzone(old_heap); + +#ifdef MR_DEBUG_AGC_COLLECTION + fprintf(stderr, "garbage_collect() done.\n\n"); +#endif + +} + +/* +** copy_value: +** Copies a value in a register or stack frame, +** replacing the original with the new copy. +** +** The copying is done using agc_deep_copy, which is +** the accurate GC verison of deep_copy (it leaves +** forwarding pointers in the old copy of the data, if +** it is on the old heap). +*/ +void +copy_value(MR_Live_Lval locn, Word *type_info, bool copy_regs, + Word *stack_pointer, Word *current_frame) +{ + int locn_num; + + locn_num = (int) MR_LIVE_LVAL_NUMBER(locn); + switch (MR_LIVE_LVAL_TYPE(locn)) { + case MR_LVAL_TYPE_R: + if (copy_regs) { + virtual_reg(locn_num) = agc_deep_copy( + &virtual_reg(locn_num), type_info, + MR_ENGINE(heap_zone2->min), + MR_ENGINE(heap_zone2->hardmax)); + } + break; + + case MR_LVAL_TYPE_F: + break; + + case MR_LVAL_TYPE_STACKVAR: + based_detstackvar(stack_pointer, locn_num) = + agc_deep_copy(&based_detstackvar( + stack_pointer,locn_num), + type_info, MR_ENGINE(heap_zone2->min), + MR_ENGINE(heap_zone2->hardmax)); + break; + + case MR_LVAL_TYPE_FRAMEVAR: + bt_var(current_frame, locn_num) = agc_deep_copy( + &bt_var(current_frame, locn_num), type_info, + MR_ENGINE(heap_zone2->min), + MR_ENGINE(heap_zone2->hardmax)); + break; + + case MR_LVAL_TYPE_SUCCIP: + break; + + case MR_LVAL_TYPE_MAXFR: + break; + + case MR_LVAL_TYPE_CURFR: + break; + + case MR_LVAL_TYPE_HP: + break; + + case MR_LVAL_TYPE_SP: + break; + + case MR_LVAL_TYPE_UNKNOWN: + break; + + default: + break; + } +} + +/* +** garbage_collect_roots: +** +** Copies the extra roots. The roots are overwritten +** with the new data. +*/ +void +garbage_collect_roots(void) +{ + MR_RootList current = root_list; + + while (current != NULL) { + *current->root = agc_deep_copy(current->root, + current->type_info, MR_ENGINE(heap_zone2->min), + MR_ENGINE(heap_zone2->hardmax)); + current = current->next; + } + +} + +/* +** MR_agc_add_root_internal: +** +** Adds a new root to the extra roots. +*/ +void +MR_agc_add_root(Word *root_addr, Word *type_info) +{ + MR_RootList node; + + node = checked_malloc(sizeof(*node)); + node->root = root_addr; + node->type_info = type_info; + + if (root_list == NULL) { + root_list = node; + last_root = node; + last_root->next = NULL; + } else { + last_root->next = node; + last_root = node; + } +} + +#endif /* NATIVE_GC */ diff --git a/runtime/mercury_agc_debug.c b/runtime/mercury_agc_debug.c new file mode 100644 index 000000000..ff7b8b05f --- /dev/null +++ b/runtime/mercury_agc_debug.c @@ -0,0 +1,243 @@ +/* +** Copyright (C) 1998 The University of Melbourne. +** This file may only be copied under the terms of the GNU Library General +** Public License - see the file COPYING.LIB in the Mercury distribution. +*/ + +/* +** Debugging support for the accurate garbage collector. +*/ + +#include "mercury_imp.h" +#include "mercury_trace_util.h" +#include "mercury_deep_copy.h" +#include "mercury_agc_debug.h" + +/* +** Function prototypes. +*/ +static void dump_live_value(MR_Live_Lval locn, MemoryZone *heap_zone, + Word * stack_pointer, Word *current_frame, + bool do_regs); + +/*---------------------------------------------------------------------------*/ + + +void +MR_agc_dump_roots(MR_RootList roots) +{ + fflush(NULL); + fprintf(stderr, "Dumping roots\n"); + +#ifdef MR_DEBUG_AGC_PRINT_VARS + while (roots != NULL) { + + + /* + ** Restore the registers, because we need to save them + ** to a more permanent backing store (we are going to + ** call Mercury soon, and we don't want it messing with + ** the saved registers). + */ + restore_registers(); + MR_copy_regs_to_saved_regs(MAX_REAL_REG + NUM_SPECIAL_REG); + + MR_hp = MR_ENGINE(debug_heap_zone->min); + MR_virtual_hp = MR_ENGINE(debug_heap_zone->min); + + fflush(NULL); + MR_trace_write_variable((Word) roots->type_info, *roots->root); + fflush(NULL); + fprintf(stderr, "\n"); + + MR_copy_saved_regs_to_regs(MAX_REAL_REG + NUM_SPECIAL_REG); + save_registers(); + roots = roots->next; + } +#endif +} + +void +MR_agc_dump_stack_frames(MR_Internal *label, MemoryZone *heap_zone, + Word *stack_pointer, Word *current_frame) +{ + int i, var_count; + const MR_Stack_Layout_Vars *vars; + Word *type_params, type_info, value; + MR_Stack_Layout_Entry *entry_layout; + const MR_Stack_Layout_Label *layout; + Code *success_ip; + bool top_frame = TRUE; + + layout = label->i_layout; + entry_layout = layout->MR_sll_entry; + + /* + ** For each stack frame... + */ + + while (MR_DETISM_DET_STACK(entry_layout->MR_sle_detism)) { + fprintf(stderr, " label: %s\n", label->i_name); + + if (success_ip == MR_stack_trace_bottom) { + break; + } + + var_count = layout->MR_sll_var_count; + vars = &(layout->MR_sll_var_info); + + type_params = MR_trace_materialize_typeinfos_base(vars, + top_frame, stack_pointer, current_frame); + + for (i = 0; i < var_count; i++) { + MR_Stack_Layout_Var sl_var; + MR_Live_Type sl_type; + + + fprintf(stderr, "%-12s\t", vars->MR_slvs_names[i]); + + sl_var = vars->MR_slvs_pairs[i]; + + dump_live_value(sl_var.MR_slv_locn, heap_zone, + stack_pointer, current_frame, top_frame); + fprintf(stderr, "\n"); + fflush(NULL); + +#ifdef MR_DEBUG_AGC_PRINT_VARS + /* + ** Restore the registers, because we need to + ** save them to a more permanent backing store + ** (we are going to call Mercury soon, and we + ** don't want it messing with the saved + ** registers). + */ + restore_registers(); + MR_copy_regs_to_saved_regs(MAX_REAL_REG + + NUM_SPECIAL_REG); + + MR_hp = MR_ENGINE(debug_heap_zone->min); + MR_virtual_hp = MR_ENGINE(debug_heap_zone->min); + + if (MR_trace_get_type_and_value_base(&sl_var, + top_frame, stack_pointer, + current_frame, type_params, + &type_info, &value)) { + printf("\t"); + MR_trace_write_variable(type_info, value); + printf("\n"); + } + + MR_copy_saved_regs_to_regs(MAX_REAL_REG + + NUM_SPECIAL_REG); + save_registers(); +#endif /* MR_DEBUG_AGC_PRINT_VARS */ + + fflush(NULL); + + } + free(type_params); + + /* + ** Move to the next stack frame. + */ + { + MR_Live_Lval location; + MR_Lval_Type type; + int number; + + location = entry_layout->MR_sle_succip_locn; + type = MR_LIVE_LVAL_TYPE(location); + number = MR_LIVE_LVAL_NUMBER(location); + if (type != MR_LVAL_TYPE_STACKVAR) { + fatal_error("can only handle stackvars"); + } + + success_ip = (Code *) + based_detstackvar(stack_pointer, number); + stack_pointer = stack_pointer - + entry_layout->MR_sle_stack_slots; + label = MR_lookup_internal_by_addr(success_ip); + } + + top_frame = FALSE; + + layout = label->i_layout; + entry_layout = layout->MR_sll_entry; + } +} + +static void +dump_live_value(MR_Live_Lval locn, MemoryZone *heap_zone, Word *stack_pointer, + Word *current_frame, bool do_regs) +{ + int locn_num; + Word value = 0; + int difference; + bool have_value = FALSE; + + locn_num = (int) MR_LIVE_LVAL_NUMBER(locn); + switch (MR_LIVE_LVAL_TYPE(locn)) { + case MR_LVAL_TYPE_R: + if (do_regs) { + value = virtual_reg(locn_num); + have_value = TRUE; + fprintf(stderr, "r%d\t", locn_num); + } + break; + + case MR_LVAL_TYPE_F: + fprintf(stderr, "f%d\t", locn_num); + break; + + case MR_LVAL_TYPE_STACKVAR: + value = based_detstackvar(stack_pointer, locn_num); + have_value = TRUE; + fprintf(stderr, "stackvar%d", locn_num); + break; + + case MR_LVAL_TYPE_FRAMEVAR: + value = bt_var(current_frame, locn_num); + have_value = TRUE; + fprintf(stderr, "framevar%d", locn_num); + break; + + case MR_LVAL_TYPE_SUCCIP: + fprintf(stderr, "succip"); + break; + + case MR_LVAL_TYPE_MAXFR: + fprintf(stderr, "maxfr"); + break; + + case MR_LVAL_TYPE_CURFR: + fprintf(stderr, "curfr"); + break; + + case MR_LVAL_TYPE_HP: + fprintf(stderr, "hp"); + break; + + case MR_LVAL_TYPE_SP: + fprintf(stderr, "sp"); + break; + + case MR_LVAL_TYPE_UNKNOWN: + fprintf(stderr, "unknown"); + break; + + default: + fprintf(stderr, "DEFAULT"); + break; + } + if (have_value) { + if (value >= (Word) heap_zone->min && + value < (Word) heap_zone->hardmax) { + difference = (Word *) value - (Word *) heap_zone->min; + fprintf(stderr, "\thp[%d]\t(%lx)", difference, + (long) value); + } else { + fprintf(stderr, "\t \t(%lx)", (long) value); + } + } +} + diff --git a/runtime/mercury_deep_copy_body.h b/runtime/mercury_deep_copy_body.h new file mode 100644 index 000000000..caf19c7ee --- /dev/null +++ b/runtime/mercury_deep_copy_body.h @@ -0,0 +1,356 @@ +/* +** Copyright (C) 1997-1998 The University of Melbourne. +** This file may only be copied under the terms of the GNU Library General +** Public License - see the file COPYING.LIB in the Mercury distribution. +*/ + +/* +** The internals of deep copy. +** +** Functions such as "copy", "copy_arg", "copy_type_info", "in_range", +** etc can be #defined to whatever functions are needed for a particular +** copying application. +*/ + + +/* +** Prototypes. +*/ +static Word copy_arg(maybeconst Word *data_ptr, const Word *type_info, + const Word *arg_type_info, const Word *lower_limit, + const Word *upper_limit); +static Word *copy_type_info(maybeconst Word *type_info, + const Word *lower_limit, const Word *upper_limit); + +Word +copy(maybeconst Word *data_ptr, const Word *type_info, + const Word *lower_limit, const Word *upper_limit) +{ + Word *base_type_info, *base_type_layout, *base_type_functors; + Word functors_indicator; + Word layout_entry, *entry_value, *data_value; + enum MR_DataRepresentation data_rep; + int data_tag; + Word new_data, data; + + data = *data_ptr; + + data_tag = tag(data); + data_value = (Word *) body(data, data_tag); + + base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info); + base_type_layout = MR_BASE_TYPEINFO_GET_TYPELAYOUT(base_type_info); + layout_entry = base_type_layout[data_tag]; + + base_type_functors = MR_BASE_TYPEINFO_GET_TYPEFUNCTORS(base_type_info); + functors_indicator = MR_TYPEFUNCTORS_INDICATOR(base_type_functors); + + entry_value = (Word *) strip_tag(layout_entry); + + data_rep = MR_categorize_data(functors_indicator, layout_entry); + + switch (data_rep) { + case MR_DATAREP_ENUM: /* fallthru */ + case MR_DATAREP_COMPLICATED_CONST: + new_data = data; /* just a copy of the actual item */ + break; + + case MR_DATAREP_COMPLICATED: { + Word secondary_tag; + Word *new_entry; + Word *argument_vector, *type_info_vector; + int arity, i; + + /* + ** if the vector containing the secondary tags and the + ** arguments is in range, copy it. + */ + if (in_range(data_value)) { + secondary_tag = *data_value; + argument_vector = data_value + 1; + new_entry = (Word *) entry_value[secondary_tag +1]; + arity = new_entry[TYPELAYOUT_SIMPLE_ARITY_OFFSET]; + type_info_vector = new_entry + TYPELAYOUT_SIMPLE_ARGS_OFFSET; + + /* allocate space for new args, and secondary tag */ + incr_saved_hp(new_data, arity + 1); + + /* copy secondary tag */ + field(0, new_data, 0) = secondary_tag; + + /* copy arguments */ + for (i = 0; i < arity; i++) { + field(0, new_data, i + 1) = copy_arg( + &argument_vector[i], type_info, + (Word *) type_info_vector[i], lower_limit, + upper_limit); + } + + /* tag this pointer */ + new_data = (Word) mkword(data_tag, new_data); + leave_forwarding_pointer(data_ptr, new_data); + } else { + new_data = data; + found_forwarding_pointer(data); + } + break; + } + + case MR_DATAREP_SIMPLE: { + int arity, i; + Word *argument_vector, *type_info_vector; + argument_vector = data_value; + + /* If the argument vector is in range, copy the arguments */ + if (in_range(argument_vector)) { + arity = entry_value[TYPELAYOUT_SIMPLE_ARITY_OFFSET]; + type_info_vector = entry_value + TYPELAYOUT_SIMPLE_ARGS_OFFSET; + + /* allocate space for new args. */ + incr_saved_hp(new_data, arity); + + /* copy arguments */ + for (i = 0; i < arity; i++) { + field(0, new_data, i) = copy_arg(&argument_vector[i], + type_info, (Word *) type_info_vector[i], lower_limit, + upper_limit); + } + /* tag this pointer */ + new_data = (Word) mkword(data_tag, new_data); + leave_forwarding_pointer(data_ptr, new_data); + } else { + new_data = data; + found_forwarding_pointer(data); + } + break; + } + + case MR_DATAREP_NOTAG: + new_data = copy_arg(data_ptr, type_info, + (Word *) *MR_TYPELAYOUT_NO_TAG_VECTOR_ARGS(entry_value), + lower_limit, upper_limit); + break; + + case MR_DATAREP_EQUIV: + new_data = copy_arg(data_ptr, type_info, + (const Word *) MR_TYPELAYOUT_EQUIV_TYPE((Word *) + entry_value), lower_limit, upper_limit); + break; + + case MR_DATAREP_EQUIV_VAR: + new_data = copy(data_ptr, (Word *) type_info[(Word) entry_value], + lower_limit, upper_limit); + break; + + case MR_DATAREP_INT: + case MR_DATAREP_CHAR: + new_data = data; + break; + + case MR_DATAREP_FLOAT: + #ifdef BOXED_FLOAT + if (in_range(data_value)) { + incr_saved_hp(new_data, FLOAT_WORDS); + field(0, new_data, 0) = *data_value; + leave_forwarding_pointer(data_ptr, new_data); + } else { + new_data = data; + found_forwarding_pointer(data); + } + #else + new_data = data; + #endif + break; + + case MR_DATAREP_STRING: + if (in_range(data_value)) { + incr_saved_hp_atomic(new_data, + (strlen((String) data_value) + sizeof(Word)) + / sizeof(Word)); + strcpy((String) new_data, (String) data_value); + leave_forwarding_pointer(data_ptr, new_data); + } else { + new_data = data; + found_forwarding_pointer(data); + } + break; + + case MR_DATAREP_PRED: { + /* + ** predicate closures store the number of curried arguments + ** as their first argument, the Code * as their second, and + ** then the arguments + ** + ** Their type-infos have a pointer to base_type_info for + ** pred/0, arity, and then argument typeinfos. + */ + if (in_range(data_value)) { + int args, i; + Word *new_closure; + + /* get number of curried arguments */ + args = data_value[0]; + + /* create new closure */ + incr_saved_hp(LVALUE_CAST(Word, new_closure), args + 2); + + /* copy number of arguments */ + new_closure[0] = args; + + /* copy pointer to code for closure */ + new_closure[1] = data_value[1]; + + /* copy arguments */ + for (i = 0; i < args; i++) { + new_closure[i + 2] = copy(&data_value[i + 2], + (const Word *) + type_info[i + TYPEINFO_OFFSET_FOR_PRED_ARGS], + lower_limit, upper_limit); + } + new_data = (Word) new_closure; + leave_forwarding_pointer(data_ptr, new_data); + } else { + new_data = data; + found_forwarding_pointer(data); + } + } + break; + + case MR_DATAREP_UNIV: + /* if the univ is stored in range, copy it */ + if (in_range(data_value)) { + Word *new_data_ptr; + + /* allocate space for a univ */ + incr_saved_hp(new_data, 2); + new_data_ptr = (Word *) new_data; + new_data_ptr[UNIV_OFFSET_FOR_TYPEINFO] = + (Word) copy_type_info( + &data_value[UNIV_OFFSET_FOR_TYPEINFO], + lower_limit, upper_limit); + new_data_ptr[UNIV_OFFSET_FOR_DATA] = copy( + &data_value[UNIV_OFFSET_FOR_DATA], + (const Word *) data_value[UNIV_OFFSET_FOR_TYPEINFO], + lower_limit, upper_limit); + leave_forwarding_pointer(data_ptr, new_data); + } else { + new_data = data; + found_forwarding_pointer(data); + } + break; + + case MR_DATAREP_VOID: + fatal_error("Cannot copy a void type"); + break; + + case MR_DATAREP_ARRAY: { + int i; + + if (in_range(data_value)) { + MR_ArrayType *new_array; + MR_ArrayType *old_array; + Integer array_size; + + old_array = (MR_ArrayType *) data_value; + array_size = old_array->size; + new_array = MR_make_array(array_size); + new_array->size = array_size; + for (i = 0; i < array_size; i++) { + new_array->elements[i] = copy_arg( + &old_array->elements[i], type_info, + (const Word *) 1, lower_limit, upper_limit); + } + new_data = (Word) new_array; + leave_forwarding_pointer(data_ptr, new_data); + } else { + new_data = data; + found_forwarding_pointer(data); + } + break; + } + + case MR_DATAREP_TYPEINFO: + new_data = (Word) copy_type_info(data_ptr, + lower_limit, upper_limit); + break; + + case MR_DATAREP_C_POINTER: + if (in_range(data_value)) { + /* + ** This error occurs if we try to copy() a + ** `c_pointer' type that points to memory allocated + ** on the Mercury heap. + */ + fatal_error("Cannot copy a c_pointer type"); + } else { + new_data = data; + } + break; + + case MR_DATAREP_UNKNOWN: /* fallthru */ + default: + fatal_error("Unknown layout type in deep copy"); + break; + } + + return new_data; +} + +/* +** copy_arg is like copy() except that it takes a +** pseudo_type_info (namely arg_pseudo_type_info) rather than +** a type_info. The pseudo_type_info may contain type variables, +** which refer to arguments of the term_type_info. +*/ +static Word +copy_arg(maybeconst Word *data_ptr, const Word *term_type_info, + const Word *arg_pseudo_type_info, const Word *lower_limit, + const Word *upper_limit) +{ + MR_MemoryList allocated_memory_cells; + Word *new_type_info; + Word new_data; + + allocated_memory_cells = NULL; + new_type_info = MR_make_type_info(term_type_info, arg_pseudo_type_info, + &allocated_memory_cells); + new_data = copy(data_ptr, new_type_info, lower_limit, upper_limit); + MR_deallocate(allocated_memory_cells); + + return new_data; +} + + +static Word * +copy_type_info(maybeconst Word *type_info_ptr, const Word *lower_limit, + const Word *upper_limit) +{ + Word *type_info = (Word *) *type_info_ptr; + + if (in_range(type_info)) { + Word *base_type_info; + Word *new_type_info; + Integer arity, i; + + /* XXX this doesn't handle higher-order types properly */ + + base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO((Word *) + type_info); + arity = MR_BASE_TYPEINFO_GET_TYPE_ARITY(base_type_info); + incr_saved_hp(LVALUE_CAST(Word, new_type_info), arity + 1); + new_type_info[0] = type_info[0]; + for (i = 1; i < arity + 1; i++) { + new_type_info[i] = (Word) copy_type_info( + (Word *) type_info[i], + lower_limit, upper_limit); + } + leave_forwarding_pointer(type_info_ptr, (Word) new_type_info); + return new_type_info; + } else { + found_forwarding_pointer(type_info); + return type_info; + } +} + + + diff --git a/runtime/mercury_engine.c b/runtime/mercury_engine.c index d660f7627..dc3d4c048 100644 --- a/runtime/mercury_engine.c +++ b/runtime/mercury_engine.c @@ -81,6 +81,16 @@ init_engine(MercuryEngine *eng) heap_zone_size, default_handler); eng->e_hp = eng->heap_zone->min; +#ifdef NATIVE_GC + eng->heap_zone2 = create_zone("heap2", 1, heap_size, next_offset(), + heap_zone_size, default_handler); + + #ifdef MR_DEBUG_AGC_PRINT_VARS + eng->debug_heap_zone = create_zone("debug_heap", 1, debug_heap_size, + next_offset(), debug_heap_zone_size, default_handler); + #endif +#endif + eng->solutions_heap_zone = create_zone("solutions_heap", 1, solutions_heap_size, next_offset(), solutions_heap_zone_size, default_handler); diff --git a/runtime/mercury_engine.h b/runtime/mercury_engine.h index 81eef4923..c2ba2d4cb 100644 --- a/runtime/mercury_engine.h +++ b/runtime/mercury_engine.h @@ -201,6 +201,12 @@ typedef struct MR_mercury_engine_struct { MemoryZone *solutions_heap_zone; MemoryZone *global_heap_zone; #endif +#ifdef NATIVE_GC + MemoryZone *heap_zone2; + #ifdef MR_DEBUG_AGC_PRINT_VARS + MemoryZone *debug_heap_zone; + #endif +#endif #ifndef SPEED MemoryZone *dumpstack_zone; int dumpindex; diff --git a/runtime/mercury_label.c b/runtime/mercury_label.c index 17ee8e2e7..f5ca4f8d9 100644 --- a/runtime/mercury_label.c +++ b/runtime/mercury_label.c @@ -109,8 +109,9 @@ MR_insert_entry_label(const char *name, Code *addr, if (entry_array_next >= entry_array_size) { entry_array_size *= 2; - if (realloc(entry_array, entry_array_size * sizeof(MR_Entry)) - == NULL) { + entry_array = realloc(entry_array, + entry_array_size * sizeof(MR_Entry)); + if (entry_array == NULL) { fatal_error("run out of memory for entry label array"); } } @@ -153,6 +154,9 @@ MR_prev_entry_by_addr(const Code *addr) int mid; int i; + MR_do_init_label_tables(); + do_init_modules(); + if (!entry_array_sorted) { qsort(entry_array, entry_array_next, sizeof(MR_Entry), compare_entry_addr); diff --git a/runtime/mercury_memory.c b/runtime/mercury_memory.c index 460d65359..a0b5be649 100644 --- a/runtime/mercury_memory.c +++ b/runtime/mercury_memory.c @@ -98,8 +98,6 @@ /*---------------------------------------------------------------------------*/ -static void setup_mprotect(void); - #ifdef HAVE_SIGINFO static bool try_munprotect(void *address, void *context); static char *explain_context(void *context); @@ -144,6 +142,8 @@ init_memory(void) solutions_heap_size = 0; global_heap_zone_size = 0; global_heap_size = 0; + debug_heap_zone_size = 0; + debug_heap_size = 0; #else heap_zone_size = round_up(heap_zone_size * 1024, unit); heap_size = round_up(heap_size * 1024, unit); @@ -152,8 +152,9 @@ init_memory(void) solutions_heap_size = round_up(solutions_heap_size * 1024, unit); global_heap_zone_size = round_up(global_heap_zone_size * 1024, unit); global_heap_size = round_up(global_heap_size * 1024, unit); + debug_heap_zone_size = round_up(debug_heap_zone_size * 1024, unit); + debug_heap_size = round_up(debug_heap_size * 1024, unit); #endif - detstack_size = round_up(detstack_size * 1024, unit); detstack_zone_size = round_up(detstack_zone_size * 1024, unit); nondstack_size = round_up(nondstack_size * 1024, unit); diff --git a/runtime/mercury_memory.h b/runtime/mercury_memory.h index 9b5d7371c..8877a1158 100644 --- a/runtime/mercury_memory.h +++ b/runtime/mercury_memory.h @@ -105,5 +105,16 @@ void *checked_realloc(void *old, size_t n); extern size_t unit; extern size_t page_size; +/* +** Users need to call MR_add_root() for any global variable which +** contains pointers to the Mercury heap. This information is only +** used for agc grades. +*/ +#ifdef NATIVE_GC + #define MR_add_root(root_ptr, type_info) \ + MR_agc_add_root((root_ptr), (type_info)) +#else + #define MR_add_root(root_ptr, type_info) /* nothing */ +#endif #endif /* not MERCURY_MEMORY_H */ diff --git a/runtime/mercury_stack_trace.h b/runtime/mercury_stack_trace.h index 7427311a4..d3549777d 100644 --- a/runtime/mercury_stack_trace.h +++ b/runtime/mercury_stack_trace.h @@ -102,4 +102,34 @@ Code *MR_stack_trace_bottom; Word *MR_nondet_stack_trace_bottom; + +typedef enum { + STEP_ERROR_BEFORE, /* the current entry_layout has no valid info */ + STEP_ERROR_AFTER, /* the current entry_layout has valid info, + but the next one does not */ + STEP_OK /* both have valid info */ +} MR_Stack_Walk_Step_Result; + +/* +** MR_stack_walk_step: +** This function takes the entry_layout for the current stack +** frame (which is the topmost stack frame from the two stack +** pointers given), and moves down one stack frame, setting the +** stack pointers to their new levels. +** +** return_label_layout will be set to the stack_layout of the +** continuation label, or NULL if the bottom of the stack has +** been reached. +** +** The meaning of the return value for MR_stack_walk_step is +** described in its type definiton above. If an error is +** encountered, problem_ptr will be set to a string representation +** of the error. +*/ +extern MR_Stack_Walk_Step_Result +MR_stack_walk_step(const MR_Stack_Layout_Entry *entry_layout, + const MR_Stack_Layout_Label **return_label_layout, + Word **stack_trace_sp_ptr, Word **stack_trace_curfr_ptr, + const char **problem_ptr); + #endif /* MERCURY_STACK_TRACE_H */ diff --git a/runtime/mercury_thread.c b/runtime/mercury_thread.c index 9bc803a88..6ae79e7f3 100644 --- a/runtime/mercury_thread.c +++ b/runtime/mercury_thread.c @@ -27,6 +27,8 @@ void *init_thread(void *unused); Declare_entry(do_runnext); +MR_MAKE_STACK_LAYOUT_ENTRY(do_runnext) + #ifdef MR_THREAD_SAFE MercuryThread * create_thread(int x) diff --git a/runtime/mercury_trace_util.c b/runtime/mercury_trace_util.c index 505047578..aa33b6297 100644 --- a/runtime/mercury_trace_util.c +++ b/runtime/mercury_trace_util.c @@ -313,3 +313,32 @@ MR_trace_get_type_and_value_base(const MR_Stack_Layout_Var *var, saved_regs_valid, base_sp, base_curfr, &succeeded); return succeeded; } + +void +MR_trace_write_variable(Word type_info, Word value) +{ + + /* + ** XXX It would be nice if we could call an exported C function + ** version of the browser predicate, and thus avoid going + ** through call_engine, but for some unknown reason, that seemed + ** to cause the Mercury code in the browser to clobber part of + ** the C stack. + ** + ** Probably that was due to a bug which has since been fixed, so + ** we should change the code below back again... + ** + ** call_engine() expects the transient registers to be in + ** fake_reg, others in their normal homes. That is the case on + ** entry to this function. But r1 or r2 may be transient, so we + ** need to save/restore transient regs around the assignments to + ** them. + */ + + restore_transient_registers(); + r1 = type_info; + r2 = value; + save_transient_registers(); + call_engine(MR_library_trace_browser); +} + diff --git a/runtime/mercury_trace_util.h b/runtime/mercury_trace_util.h index 0e0aab734..7a90a80b7 100644 --- a/runtime/mercury_trace_util.h +++ b/runtime/mercury_trace_util.h @@ -28,4 +28,10 @@ extern bool MR_trace_get_type_and_value_base(const MR_Stack_Layout_Var *var, bool saved_regs_valid, Word *base_sp, Word *base_curfr, Word *type_params, Word *type_info, Word *value); +/* +** MR_trace_write_variable: +** Write a variable to stdout. +*/ +extern void MR_trace_write_variable(Word type_info, Word value); + #endif /* MERCURY_TRACE_UTIL_H */ diff --git a/runtime/mercury_type_info.h b/runtime/mercury_type_info.h index a81b62696..dc1d85df1 100644 --- a/runtime/mercury_type_info.h +++ b/runtime/mercury_type_info.h @@ -662,7 +662,7 @@ typedef struct { */ #define MR_TYPEINFO_GET_BASE_TYPEINFO(TypeInfo) \ - ((*TypeInfo) ? ((Word *) *TypeInfo) : TypeInfo) + ((*TypeInfo) ? (Word *) *TypeInfo : (Word *) (Word) TypeInfo) #define MR_TYPEINFO_GET_HIGHER_ARITY(TypeInfo) \ ((Integer) (Word *) (TypeInfo)[TYPEINFO_OFFSET_FOR_PRED_ARITY]) @@ -795,8 +795,8 @@ struct MR_MemoryCellNode { }; typedef struct MR_MemoryCellNode *MR_MemoryList; -Word * MR_make_type_info(Word *term_type_info, Word *arg_pseudo_type_info, - MR_MemoryList *allocated); +Word * MR_make_type_info(const Word *term_type_info, + const Word *arg_pseudo_type_info, MR_MemoryList *allocated); void MR_deallocate(MR_MemoryList allocated_memory_cells); /*---------------------------------------------------------------------------*/ diff --git a/runtime/mercury_wrapper.h b/runtime/mercury_wrapper.h index 18e3ba7b0..4593a5410 100644 --- a/runtime/mercury_wrapper.h +++ b/runtime/mercury_wrapper.h @@ -81,6 +81,7 @@ extern size_t nondstack_size; extern size_t solutions_heap_size; extern size_t trail_size; extern size_t global_heap_size; +extern size_t debug_heap_size; /* sizes of the red zones */ extern size_t heap_zone_size; @@ -89,6 +90,7 @@ extern size_t nondstack_zone_size; extern size_t solutions_heap_zone_size; extern size_t trail_zone_size; extern size_t global_heap_zone_size; +extern size_t debug_heap_zone_size; /* size of the primary cache */ extern size_t pcache_size;