mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-13 12:53:53 +00:00
Code Issues Projects Releases Wiki Activity

An initial implementation of the accurate garbage collector.

Browse Source 
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.
This commit is contained in:
Tyson Dowd
1998-07-22 07:55:19 +00:00
parent c8ba3551ea
commit 376f2c69af
17 changed files with 1206 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
runtime/Mmakefile
View File

@@ -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 \

10
runtime/machdeps/alpha_regs.h
View File

@@ -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, \

8
runtime/machdeps/i386_regs.h
View File

@@ -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

476
runtime/mercury_accurate_gc.c Normal file
View File

@@ -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, &current_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 */

243
runtime/mercury_agc_debug.c Normal file
View File

@@ -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);
}
}
}

356
runtime/mercury_deep_copy_body.h Normal file
View File

@@ -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;
}
}

10
runtime/mercury_engine.c
View File

@@ -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);

6
runtime/mercury_engine.h
View File

@@ -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;

8
runtime/mercury_label.c
View File

@@ -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);

7
runtime/mercury_memory.c
View File

@@ -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);

11
runtime/mercury_memory.h
View File

@@ -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 */

30
runtime/mercury_stack_trace.h
View File

@@ -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 */

2
runtime/mercury_thread.c
View File

@@ -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)

29
runtime/mercury_trace_util.c
View File

@@ -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);
}

6
runtime/mercury_trace_util.h
View File

@@ -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 */

6
runtime/mercury_type_info.h
View File

@@ -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);
/*---------------------------------------------------------------------------*/

2
runtime/mercury_wrapper.h
View File

@@ -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;