[m-dev.] For Review: Bytecode interpreter
Levi Cameron
l.cameron2 at ugrad.unimelb.edu.au
Tue Jan 30 17:44:58 AEDT 2001
Here is the relative diff (part 2)
Levi
l.cameron2 at ugrad.unimelb.edu.au
--- ../bytecode.posted/mb_module.c Tue Jan 30 14:04:54 2001
+++ mb_module.c Tue Jan 30 16:57:16 2001
@@ -30,11 +30,15 @@
#include <string.h>
#include "mb_mem.h"
-/* XXX: no fixed limits */
+/* XXX: We should remove these fixed limits */
#define MAX_CODE_COUNT 10000
#define MAX_CODE_DATA_COUNT 160000
#define MAX_MODULES 64
+/*
+** File version (simple check for correct bytecode file format)
+** Should be the same as that in bytecode.m
+*/
#define FILEVERSION 9
/* Exported definitions */
@@ -57,32 +61,50 @@
** XXX: Can only handle 64MB of bytecode data
*/
+#if 0
#define MB_BCID_MAKE(id, arg) ( ((id) & ((1 << CHAR_BIT) - 1)) | \
(((MB_Word*)(arg) - code_arg_data) << CHAR_BIT)\
)
-/* get the bytecode id (with determinism flag) */
-#define MB_BCID_IDDET(x) ((x) & ((1 << CHAR_BIT)-1))
-/* get the bytecode id (without determinism flag) */
+/* get the bytecode id */
#define MB_BCID_ID(x) ((x) & ((1<<(CHAR_BIT-1)) - 1))
/* get the determinism flag for the given bytecode */
#define MB_BCID_ISDET ((1) << (CHAR_BIT-1))
#define MB_BCID_DET(x) ((x) & MB_BCID_ISDET)
/* get the bytecode argument pointer */
-#define MB_BCID_ARG(x) ((MB_Bytecode_Arg*) \
+#define MB_BCID_ARG(x) ((MB_Bytecode_Arg *) \
(code_arg_data + \
((MB_Unsigned)(x) >> CHAR_BIT)) \
)
+#else
+
+
+#define MB_BCID_MAKE(dest, new_id, new_arg) \
+ ((dest).id = (new_id), \
+ (dest).is_det = 0, \
+ (dest).arg = (((MB_Word *) (new_arg) - code_arg_data)), \
+ (dest))
+
+#define MB_BCID_ID(x) ((x).id)
+
+#define MB_BCID_ISDET 1
+
+#define MB_BCID_DET_GET(x) ((x).is_det)
+#define MB_BCID_DET_SET(x, det) ((x).is_det = (det))
+
+#define MB_BCID_ARG(x) ((MB_Bytecode_Arg *) (code_arg_data + (x).arg))
+#endif
+
/* XXX: not thread safe */
static MB_Word code_count = 0;
-static MB_Word code_id[MAX_CODE_COUNT];
+static MB_BCId code_id[MAX_CODE_COUNT];
#define CODE_DATA_NONE 0 /* 0 is reserved for indicating no data */
static MB_Word code_data_count = 1;
static MB_Word code_arg_data[MAX_CODE_DATA_COUNT];
-struct MB_Module_Tag {
+struct MB_Module_Struct {
/* XXX: Hash the module & predicate names */
/* The name of the module */
MB_CString module_name;
@@ -102,57 +124,57 @@
};
-/* XXX: not thread safe */
+/* XXX: The current accesses to these variables are thread safe */
static MB_Word module_count = 0;
-static MB_Module* module_arr[MAX_MODULES];
+static MB_Module *module_arr[MAX_MODULES];
-static MB_Bool translate_calls(MB_Word* bc, MB_Word number_codes);
-static MB_Bool translate_labels(MB_Word* bc, MB_Word number_codes,
- MB_Stack* label_stack);
-static MB_Bool translate_detism(MB_Word* bc, MB_Word number_codes);
-static MB_Bool translate_switch(MB_Word* bc, MB_Word number_codes);
-static MB_Bool translate_temps(MB_Word* bc, MB_Word number_codes);
+static MB_Bool translate_calls(MB_Bytecode_Addr bc, MB_Unsigned number_codes);
+static MB_Bool translate_labels(MB_Bytecode_Addr bc, MB_Unsigned number_codes,
+ MB_Stack *label_stack);
+static MB_Bool translate_detism(MB_Bytecode_Addr bc, MB_Unsigned number_codes);
+static MB_Bool translate_switch(MB_Bytecode_Addr bc, MB_Unsigned number_codes);
+static MB_Bool translate_temps(MB_Bytecode_Addr bc, MB_Unsigned number_codes);
/* Implementation */
/*
** Translates calls from a predicate name/procedure to an actual code address
-** Translates call & higher_or
+** Translates call & higher_order(pred_const) bytecodes
+** Returns TRUE if successful
*/
static MB_Bool
-translate_calls(MB_Word*bc, MB_Word number_codes)
+translate_calls(MB_Bytecode_Addr bc, MB_Unsigned number_codes)
{
- /* XXX: temporarily table the procs, instead of re-searching
+ /*
+ ** XXX: We should temporarily table the procs, instead of re-searching
** each time, but since there is usually only one proc per predicate,
** don't bother for now
*/
- MB_Word i;
+ MB_Unsigned i;
for (i = 0; i < number_codes; i++, bc++) {
/* proc to be called attributes */
MB_CString module_name = NULL;
MB_CString pred_name = NULL;
MB_Word arity;
- MB_Byte is_func;
- MB_Word proc_id;
+ MB_Bool is_func;
+ MB_Word mode_num;
/* location to store the proc to be called */
- MB_Byte* target_is_native = NULL;
- MB_Word** target_adr = NULL;
+ MB_Code_Addr *target_addr = NULL;
/* Get the information about the procedure to call */
MB_Byte call_id = MB_code_get_id(bc);
if (call_id == MB_BC_call) {
- MB_Bytecode_Arg* call_arg = MB_code_get_arg(bc);
- module_name = call_arg->call.module_id;
+ MB_Bytecode_Arg *call_arg = MB_code_get_arg(bc);
+ module_name = call_arg->call.module_name;
arity = call_arg->call.arity;
is_func = call_arg->call.is_func;
- pred_name = call_arg->call.pred_id;
- proc_id = call_arg->call.proc_id;
- target_is_native=&call_arg->call.is_native;
- target_adr = &call_arg->call.adr;
+ pred_name = call_arg->call.pred_name;
+ mode_num = call_arg->call.mode_num;
+ target_addr = &call_arg->call.addr;
} else if (call_id == MB_BC_construct) {
- MB_Bytecode_Arg* construct_arg =
+ MB_Bytecode_Arg *construct_arg =
MB_code_get_arg(bc);
if (construct_arg->construct.consid.id ==
MB_CONSID_PRED_CONST)
@@ -160,155 +182,179 @@
MB_fatal("Unable to translate predicate constructs");
#if 0
module_name = construct_arg->construct.
- consid.opt.pred_const.module_id;
+ consid.opt.pred_const.module_name;
arity = construct_arg->construct.
consid.opt.pred_const.arity;
is_func = construct_arg->construct.
consid.opt.pred_const.is_func;
pred_name = construct_arg->construct.
- consid.opt.pred_const.pred_id;
- proc_id = construct_arg->construct.
- consid.opt.pred_const.proc_id;
- target_adr = &construct_arg->construct.
- consid.opt.pred_const.adr;
+ consid.opt.pred_const.pred_name;
+ mode_num = construct_arg->construct.
+ consid.opt.pred_const.mode_num;
+ target_addr = &construct_arg->construct.
+ consid.opt.pred_const.addr;
#endif
}
}
if (pred_name != NULL) {
- SAY("Looking for %s %s__%s/%d (%d)",
+ MB_SAY("Looking for %s %s__%s/%d mode %d",
(is_func) ? "func" : "pred",
module_name,
pred_name,
arity,
- proc_id);
+ mode_num);
}
/* Find the predicate start */
if (pred_name != NULL) {
/* First check if we can find it in the bytecode */
- MB_Word* adr = MB_code_find_proc(module_name,
- pred_name, proc_id,
+ MB_Bytecode_Addr bc_addr = MB_code_find_proc(module_name,
+ pred_name, mode_num,
arity, is_func);
- if (adr == MB_CODE_INVALID_ADR) {
- SAY(" Not found in bytecode");
+ if (bc_addr == MB_CODE_INVALID_ADR) {
/* Otherwise look in the native code */
- adr = MB_code_find_proc_native(module_name,
- pred_name, proc_id, arity, is_func);
+ MB_Native_Addr native_addr =
+ MB_code_find_proc_native(module_name,
+ pred_name, mode_num, arity, is_func);
+
+ MB_SAY(" Not found in bytecode");
- SAY(" Address from native: %08x", adr);
- if (adr == NULL) {
+ MB_SAY(" Address from native: %08x"
+ , native_addr);
+
+ if (native_addr == NULL) {
MB_util_error(
- "Reference in bytecode %08x"
- " to unknown"
- " %s %s__%s/%d (%d)",
- (int)i,
+ "Warning: proc ref in bytecode"
+ " at %08x to unknown"
+ " %s %s__%s/%d mode %d"
+ " (will evaluate lazily)",
+ (int) i,
is_func ? "func" : "pred",
module_name,
pred_name,
- (int)arity,
- (int)proc_id);
- MB_fatal("(Are you sure the module"
+ (int) arity,
+ (int) mode_num);
+ MB_util_error("Are you sure the module"
" was compiled with trace"
- " information enabled?)");
- } else {
- *target_is_native = FALSE;
+ " information enabled?");
}
-
+ target_addr->is_native = TRUE;
+ target_addr->addr.native = native_addr;
} else {
- *target_is_native = TRUE;
+ target_addr->is_native = FALSE;
+ target_addr->addr.bc = bc_addr;
}
- *target_adr = adr;
}
}
return TRUE;
} /* translate_calls */
-
-/* Translates labels to code addresses for those instructions that need it
+/*
+** Translates labels to code addresses for those instructions that need it
** those translated are:
** enter_if, endof_then, enter_disjunction, enter_disjunct, endof_disjunct
** enter_switch, enter_switch_arm, endof_switch_arm, enter_negation, enter_proc
+** Returns TRUE if successful
*/
+
+/* Helper function for translate_labels: translates an invididual label */
+static void translate_label(MB_Bytecode_Arg* cur_proc_arg,
+ MB_Stack* label_stack, MB_Label* label)
+{
+ if (label->index < cur_proc_arg->enter_proc.label_count
+ && label->index > 0) {
+ label->addr = (MB_Bytecode_Addr) MB_stack_peek(label_stack,
+ cur_proc_arg->enter_proc.label_index + label->index);
+ } else {
+ label->addr = MB_CODE_INVALID_ADR;
+ }
+}
+
static MB_Bool
-translate_labels(MB_Word* bc, MB_Word number_codes, MB_Stack* label_stack)
+translate_labels(MB_Bytecode_Addr bc, MB_Unsigned number_codes,
+ MB_Stack *label_stack)
{
- MB_Word i;
- MB_Bytecode_Arg* cur_proc_arg = NULL;
+ MB_Unsigned i;
+ MB_Bytecode_Arg *cur_proc_arg = NULL;
for (i = 0; i < number_codes; i++, bc++) {
- MB_Bytecode_Arg* cur_arg =
+ MB_Bytecode_Arg *cur_arg =
MB_code_get_arg(bc);
- #define XLATLABEL(bytecodetype, lbl) \
- cur_arg->bytecodetype.lbl.adr = \
- ((cur_arg->bytecodetype.lbl.index < \
- cur_proc_arg->enter_proc.label_count) \
- && (cur_arg->bytecodetype.lbl.index > 0) \
- ? (MB_Word*)MB_stack_peek(label_stack, \
- cur_proc_arg->enter_proc.label_index + \
- cur_arg->bytecodetype.lbl.index) \
- : MB_CODE_INVALID_ADR)
-
+
switch (MB_code_get_id(bc)) {
case MB_BC_enter_proc:
cur_proc_arg = cur_arg;
- XLATLABEL(enter_proc, end_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_proc.end_label);
break;
case MB_BC_enter_if:
- XLATLABEL(enter_if, else_label);
- XLATLABEL(enter_if, end_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_if.else_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_if.end_label);
break;
case MB_BC_endof_then:
- XLATLABEL(endof_then, follow_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->endof_then.follow_label);
break;
case MB_BC_enter_disjunction:
- XLATLABEL(enter_disjunction, end_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_disjunction.end_label);
break;
case MB_BC_enter_disjunct:
- XLATLABEL(enter_disjunct, next_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_disjunct.next_label);
break;
case MB_BC_endof_disjunct:
- XLATLABEL(endof_disjunct, end_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->endof_disjunct.end_label);
break;
case MB_BC_enter_switch:
- XLATLABEL(enter_switch, end_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_switch.end_label);
break;
case MB_BC_enter_switch_arm:
- XLATLABEL(enter_switch_arm, next_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_switch_arm.next_label);
break;
case MB_BC_endof_switch_arm:
- XLATLABEL(endof_switch_arm, end_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->endof_switch_arm.end_label);
break;
case MB_BC_enter_negation:
- XLATLABEL(enter_negation, end_label);
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_negation.end_label);
break;
-
- default:
-
}
}
return TRUE;
} /* translate_labels */
-/* Store the procedure's determinism that each instruction is executing under
*/
+/*
+** Store the procedure's determinism that each instruction is executing under
+** This is used when returning into a procedure to decide whether the
+** vars & temps are on the det or nondet stack
+** Returns TRUE if successful
+*/
static MB_Bool
-translate_detism(MB_Word* bc, MB_Word number_codes)
+translate_detism(MB_Bytecode_Addr bc, MB_Unsigned number_codes)
{
- MB_Word i;
+ MB_Unsigned i;
MB_Byte bc_id;
MB_Byte cur_detism = MB_BCID_ISDET;
@@ -324,7 +370,7 @@
case MB_DET_NONDET:
cur_detism = 0;
break;
- case MB_DET_INVALID:
+ case MB_DET_UNUSABLE:
cur_detism = 0;
break;
default:
@@ -332,7 +378,7 @@
}
}
if (cur_detism) {
- *bc |= cur_detism;
+ MB_BCID_DET_SET(*bc, cur_detism);
}
if (bc_id == MB_BC_endof_proc) cur_detism = 0;
@@ -343,12 +389,13 @@
/*
** Fill in the variable that each switch arm is using
+** Returns TRUE if successful
*/
static MB_Bool
-translate_switch(MB_Word* bc, MB_Word number_codes)
+translate_switch(MB_Bytecode_Addr bc, MB_Unsigned number_codes)
{
- MB_Word i;
- MB_Bytecode_Arg* cur_switch = NULL;
+ MB_Unsigned i;
+ MB_Bytecode_Arg *cur_switch = NULL;
for (i = 0; i < number_codes; i++, bc++) {
switch (MB_code_get_id(bc)) {
case MB_BC_enter_switch:
@@ -356,7 +403,7 @@
break;
case MB_BC_enter_switch_arm: {
- MB_Bytecode_Arg* cur_arg
+ MB_Bytecode_Arg *cur_arg
= MB_code_get_arg(bc);
cur_arg->enter_switch_arm.var =
@@ -370,8 +417,9 @@
} /* translate_switch */
/*
-** transform temporary stack slot numbers into variable slot numbers
+** Transform temporary stack slot numbers into variable slot numbers
** for all bytecodes that use a temporary stack slot
+** Returns TRUE if successful
*/
#define XLATTEMP(name) case MB_BC_##name: \
cur_arg = MB_code_get_arg(bc); \
@@ -379,11 +427,11 @@
cur_proc_arg->enter_proc.list_length; \
break;
static MB_Bool
-translate_temps(MB_Word* bc, MB_Word number_codes)
+translate_temps(MB_Bytecode_Addr bc, MB_Unsigned number_codes)
{
- MB_Word i;
- MB_Bytecode_Arg* cur_arg ;
- MB_Bytecode_Arg* cur_proc_arg = NULL;
+ MB_Unsigned i;
+ MB_Bytecode_Arg *cur_arg ;
+ MB_Bytecode_Arg *cur_proc_arg = NULL;
MB_Word code_size = MB_code_size();
for (i = 0; i < number_codes; i++, bc++) {
switch (MB_code_get_id(bc)) {
@@ -401,15 +449,16 @@
}
/*
-** A native code procedure wishes to call a deterministic bytecode procedure
+** Load a module by name. Assumes the bytecode file is just the module name
+** with '.mbc' appended.
*/
-MB_Module*
+MB_Module *
MB_module_load_name(MB_CString_Const module_name)
{
- MB_Module* module;
+ MB_Module *module;
MB_CString filename = MB_str_new_cat(module_name, ".mbc");
- FILE* fp = fopen(filename, "rb+");
+ FILE *fp = fopen(filename, "rb");
module = MB_module_load(module_name, fp);
@@ -422,96 +471,98 @@
** Gets a module. Loads the module if it is not already loaded.
** If there is no bytecode information for this module, returns NULL
*/
-MB_Module*
+MB_Module *
MB_module_get(MB_CString_Const module_name)
{
/* Search for the module */
MB_Word i;
- SAY(" Looking for %s among %d modules", module_name, module_count);
+ MB_SAY(" Looking for %s among %d modules", module_name, module_count);
for (i = 0; i < module_count; i++) {
- SAY(" Testing module %d", i);
+ MB_SAY(" Testing module %d", i);
if (!MB_str_cmp(module_name, module_arr[i]->module_name)) {
- SAY(" Module %s found", module_name);
+ MB_SAY(" Module %s found", module_name);
return module_arr[i];
}
}
- SAY(" module %s not found, attempting to load", module_name);
+ MB_SAY(" module %s not found, attempting to load", module_name);
/* We didn't find it so load it */
return MB_module_load_name(module_name);
} /* MB_module_get */
-#define ARGSIZE(name) (sizeof(((MB_Bytecode*)NULL)->opt.name) + \
- sizeof(MB_Word)-1) \
- / sizeof(MB_Word)
+#define MB_ARGSIZE_WORDS(name) \
+ MB_NUMBLOCKS(sizeof(((MB_Bytecode *)NULL)->opt.name), sizeof(MB_Word))
+
/* XXX ORDER */
-/* the size of the arguments in a MB_Bytecode struct, in number of MB_Words*/
+/* the size of the arguments in a MB_Bytecode struct, in number of MB_Words */
static const MB_Word argument_size[] = {
- ARGSIZE(enter_pred),
- ARGSIZE(endof_pred),
- ARGSIZE(enter_proc),
- ARGSIZE(endof_proc),
- ARGSIZE(label),
- ARGSIZE(enter_disjunction),
- ARGSIZE(endof_disjunction),
- ARGSIZE(enter_disjunct),
- ARGSIZE(endof_disjunct),
- ARGSIZE(enter_switch),
- ARGSIZE(endof_switch),
- ARGSIZE(enter_switch_arm),
- ARGSIZE(endof_switch_arm),
- ARGSIZE(enter_if),
- ARGSIZE(enter_then),
- ARGSIZE(endof_then),
- ARGSIZE(endof_if),
- ARGSIZE(enter_negation),
- ARGSIZE(endof_negation),
- ARGSIZE(enter_commit),
- ARGSIZE(endof_commit),
- ARGSIZE(assign),
- ARGSIZE(test),
- ARGSIZE(construct),
- ARGSIZE(deconstruct),
- ARGSIZE(complex_construct),
- ARGSIZE(complex_deconstruct),
- ARGSIZE(place_arg),
- ARGSIZE(pickup_arg),
- ARGSIZE(call),
- ARGSIZE(higher_order_call),
- ARGSIZE(builtin_binop),
- ARGSIZE(builtin_unop),
- ARGSIZE(builtin_bintest),
- ARGSIZE(builtin_untest),
- ARGSIZE(semidet_succeed),
- ARGSIZE(semidet_success_check),
- ARGSIZE(fail),
- ARGSIZE(context),
- ARGSIZE(not_supported),
- ARGSIZE(enter_else),
- ARGSIZE(endof_negation_goal)
+ MB_ARGSIZE_WORDS(enter_pred),
+ MB_ARGSIZE_WORDS(endof_pred),
+ MB_ARGSIZE_WORDS(enter_proc),
+ MB_ARGSIZE_WORDS(endof_proc),
+ MB_ARGSIZE_WORDS(label),
+ MB_ARGSIZE_WORDS(enter_disjunction),
+ MB_ARGSIZE_WORDS(endof_disjunction),
+ MB_ARGSIZE_WORDS(enter_disjunct),
+ MB_ARGSIZE_WORDS(endof_disjunct),
+ MB_ARGSIZE_WORDS(enter_switch),
+ MB_ARGSIZE_WORDS(endof_switch),
+ MB_ARGSIZE_WORDS(enter_switch_arm),
+ MB_ARGSIZE_WORDS(endof_switch_arm),
+ MB_ARGSIZE_WORDS(enter_if),
+ MB_ARGSIZE_WORDS(enter_then),
+ MB_ARGSIZE_WORDS(endof_then),
+ MB_ARGSIZE_WORDS(endof_if),
+ MB_ARGSIZE_WORDS(enter_negation),
+ MB_ARGSIZE_WORDS(endof_negation),
+ MB_ARGSIZE_WORDS(enter_commit),
+ MB_ARGSIZE_WORDS(endof_commit),
+ MB_ARGSIZE_WORDS(assign),
+ MB_ARGSIZE_WORDS(test),
+ MB_ARGSIZE_WORDS(construct),
+ MB_ARGSIZE_WORDS(deconstruct),
+ MB_ARGSIZE_WORDS(complex_construct),
+ MB_ARGSIZE_WORDS(complex_deconstruct),
+ MB_ARGSIZE_WORDS(place_arg),
+ MB_ARGSIZE_WORDS(pickup_arg),
+ MB_ARGSIZE_WORDS(call),
+ MB_ARGSIZE_WORDS(higher_order_call),
+ MB_ARGSIZE_WORDS(builtin_binop),
+ MB_ARGSIZE_WORDS(builtin_unop),
+ MB_ARGSIZE_WORDS(builtin_bintest),
+ MB_ARGSIZE_WORDS(builtin_untest),
+ MB_ARGSIZE_WORDS(semidet_succeed),
+ MB_ARGSIZE_WORDS(semidet_success_check),
+ MB_ARGSIZE_WORDS(fail),
+ MB_ARGSIZE_WORDS(context),
+ MB_ARGSIZE_WORDS(not_supported),
+ MB_ARGSIZE_WORDS(enter_else),
+ MB_ARGSIZE_WORDS(endof_negation_goal)
}; /* argument_size */
/*
** Load a module
** If fp is NULL then that means there is no bytecode information
-** for this module -- revert to native code.
+** for this module -- revert to native code, and mark the module
+** as native code only
*/
-MB_Module* MB_module_load(MB_CString_Const module_name, FILE* fp) {
- MB_Short version;
- MB_Word module_code_count = 0;
- MB_Word*module_start = code_id + code_count;
+MB_Module *MB_module_load(MB_CString_Const module_name, FILE *fp)
+{
+ MB_Short version;
+ MB_Word module_code_count = 0;
+ MB_Bytecode_Addr module_start = code_id + code_count;
/* Array of indexes for label translation (used only during load) */
MB_Stack label_stack = MB_stack_new(128, FALSE);
/* Create the new module */
- MB_Module* module = MB_GC_new(MB_Module);
+ MB_Module *module = MB_GC_NEW(MB_Module);
module->pred_index_stack= MB_stack_new((fp == NULL) ? 0 : 64, FALSE);
module->module_name = MB_str_dup(module_name);
- /* XXX adding to the array like this is not thread safe */
+ /* XXX Adding to the array like this is not thread safe */
if (module_count >= MAX_MODULES) {
MB_fatal("Too many modules");
}
@@ -532,15 +583,16 @@
{
MB_Bytecode bc;
- MB_Bytecode_Arg*cur_proc_arg = NULL;
- MB_Word* cur_proc = MB_CODE_INVALID_ADR;
+ MB_Bytecode_Arg *cur_proc_arg = NULL;
+ MB_Bytecode_Addr cur_proc = MB_CODE_INVALID_ADR;
/* read in each bytecode */
while (MB_read_bytecode(fp, &bc)) {
- MB_Bytecode_Arg* cur_arg;
+ MB_Bytecode_Arg *cur_arg;
if (bc.id == MB_BC_label) {
- /* XXX: we strictly don't actually need to save the
+ /*
+ ** XXX: we strictly don't actually need to save the
** labels but it makes label translations a lot faster.
** After translation, the label stack is deleted
*/
@@ -563,21 +615,21 @@
MB_fatal("Code outside proc\n");
}
- cur_proc_arg->enter_proc.det = MB_DET_INVALID;
+ cur_proc_arg->enter_proc.det = MB_DET_UNUSABLE;
}
- /* copy the bytecode arguments into the code.data
+ /*
+ ** Copy the bytecode arguments into the code.data
** structure, save the index & increment code.data
** counters
*/
- if (bc.id < sizeof(argument_size)/sizeof(argument_size[0]))
- {
+ if (bc.id < sizeof(argument_size)/sizeof(argument_size[0])) {
if (argument_size[bc.id] == 0) {
/* If bytecode has no arguments, skip alloc */
cur_arg = NULL;
} else {
/* Allocate space for bytecode's arguments */
- cur_arg = MB_code_data_alloc(MB_Bytecode_Arg,
+ cur_arg = MB_CODE_DATA_ALLOC(MB_Bytecode_Arg,
argument_size[bc.id]);
/* Copy arguments onto argument data stack */
@@ -608,9 +660,7 @@
break;
case MB_BC_endof_proc: {
- /*
- ** Save the proc we were in
- */
+ /* Save the proc we were in */
cur_arg->endof_proc.proc_start =
cur_proc;
@@ -625,8 +675,8 @@
}
}
- /* actually save the bytecode id & argument index*/
- code_id[code_count] = MB_BCID_MAKE(bc.id, cur_arg);
+ /* Write bytecode id & argument index */
+ MB_BCID_MAKE(code_id[code_count], bc.id, cur_arg);
} else {
MB_util_error("Unknown op code");
MB_module_unload(module);
@@ -648,7 +698,7 @@
(translate_switch(module_start, module_code_count)) &&
(translate_temps(module_start, module_code_count)))
{
- /* delete the label stack; we've done all the translations*/
+ /* Delete the label stack (we've done all the translations) */
MB_stack_delete(&label_stack);
return module;
@@ -661,14 +711,20 @@
/*
-** free memory associated with module structure itself
-** (does not unload bytecodes from code array)
+** Free memory associated with module structure itself
+** (does not unload bytecodes from code array, since other
+** modules may have been loaded on top of this one)
+**
+** XXX: Should add code to unload all modules and reload
+** only the ones needed, thus effectively unloading a
+** given module
*/
void
-MB_module_unload(MB_Module* module)
+MB_module_unload(MB_Module *module)
{
if (module != NULL) {
- /* the stacks will always be allocated since it will
+ /*
+ ** The stacks will always be allocated since it will
** have aborted if their allocation failed
*/
MB_str_delete(module->module_name);
@@ -678,162 +734,106 @@
}
/* Get the actual size of a program, in bytecodes */
-MB_Word
+MB_Unsigned
MB_code_size(void)
{
return code_count;
}
-#if 0
-/* Get the bytecode at a given address */
-MB_Bytecode
-MB_code_get(MB_Word* adr)
-{
- MB_Bytecode bc;
-
- assert(MB_ip_normal(adr));
-
- bc.id = MB_code_get_id(adr);
-
- assert(bc.id < sizeof(argument_size)/sizeof(argument_size[0]));
-
- if (argument_size[bc.id] > 0) {
-
- memcpy(&(bc.opt),
- MB_code_get_arg(adr),
- argument_size[bc.id]*sizeof(MB_Word));
- }
- return bc;
-} /* MB_code_get */
-#endif
-
/* Get the bytecode type at a given address */
MB_Byte
-MB_code_get_id(MB_Word* adr)
+MB_code_get_id(MB_Bytecode_Addr addr)
{
- if (!MB_ip_normal(adr))
+ if (!MB_ip_normal(addr))
return MB_BC_debug_invalid;
/* return the code with the determinism flag stripped away */
- return MB_BCID_ID(*adr);
+ return MB_BCID_ID(*addr);
}
/* Get a bytecode's procedure's determinism */
MB_Byte
-MB_code_get_det(MB_Word* adr)
+MB_code_get_det(MB_Bytecode_Addr addr)
{
- assert(MB_ip_normal(adr));
+ assert(MB_ip_normal(addr));
/* return the determinism flag */
- return MB_BCID_DET(*adr) ? MB_ISDET_YES : MB_ISDET_NO;
+ return (MB_BCID_DET_GET(*addr) == MB_BCID_ISDET)
+ ? MB_ISDET_YES : MB_ISDET_NO;
}
/* Get the bytecode argument at a given address */
-MB_Bytecode_Arg*
-MB_code_get_arg(MB_Word* adr)
+MB_Bytecode_Arg *
+MB_code_get_arg(MB_Bytecode_Addr addr)
{
- MB_Bytecode_Arg* data_p;
+ MB_Bytecode_Arg *data_p;
- if (!MB_ip_normal(adr)) return NULL;
+ if (!MB_ip_normal(addr)) return NULL;
- data_p = MB_BCID_ARG(*adr);
- if (data_p == (MB_Bytecode_Arg*)code_arg_data) {
+ data_p = MB_BCID_ARG(*addr);
+ if (data_p == (MB_Bytecode_Arg *)code_arg_data) {
return NULL;
} else {
return data_p;
}
} /* MB_code_get_arg */
-#if 0
-/* Get the predicate owning the code at adr */
-MB_Bytecode
-MB_code_get_pred(MB_Word* adr)
-{
- MB_Word* pred_adr = MB_code_get_pred_adr(adr);
- if (pred_adr == MB_CODE_INVALID_ADR) {
- MB_Bytecode bc;
- bc.id = MB_BC_enter_pred;
- bc.opt.enter_pred.pred_name = MB_NULL_STR;
- bc.opt.enter_pred.pred_arity = 0;
- bc.opt.enter_pred.is_func = 0;
- bc.opt.enter_pred.proc_count = 0;
- return bc;
- }
-
-
- return MB_code_get(pred_adr);
-} /* MB_code_get_pred */
-#endif
-
-MB_Word*
-MB_code_get_pred_adr(MB_Word* adr) {
+MB_Bytecode_Addr
+MB_code_get_pred_addr(MB_Bytecode_Addr addr) {
- while (MB_code_get_id(adr) != MB_BC_enter_pred) {
+ while (MB_code_get_id(addr) != MB_BC_enter_pred) {
- adr--;
- if (!MB_ip_normal(adr)) {
+ addr--;
+ if (!MB_ip_normal(addr)) {
return MB_CODE_INVALID_ADR;
}
}
- return adr;
+ return addr;
}
-#if 0
-/* Get the procedure owning the code at adr */
-MB_Bytecode
-MB_code_get_proc(MB_Word* adr)
-{
- adr = MB_code_get_proc_adr(adr);
- assert(MB_ip_normal(adr));
-
- return MB_code_get(adr);
-}
-#endif
-
-MB_Word*
-MB_code_get_proc_adr(MB_Word* adr)
+MB_Bytecode_Addr
+MB_code_get_proc_addr(MB_Bytecode_Addr addr)
{
MB_Byte bc_id;
- adr++;
+ addr++;
do {
- adr--;
- assert(MB_ip_normal(adr));
- bc_id = MB_code_get_id(adr);
+ addr--;
+ assert(MB_ip_normal(addr));
+ bc_id = MB_code_get_id(addr);
assert(bc_id != MB_BC_enter_pred);
assert(bc_id != MB_BC_endof_pred);
- }
- while (bc_id != MB_BC_enter_proc);
+ } while (bc_id != MB_BC_enter_proc);
- return adr;
-} /* MB_code_get_proc_adr */
+ return addr;
+} /* MB_code_get_proc_addr */
/* Finds the location of a given proc */
-MB_Word*
+MB_Bytecode_Addr
MB_code_find_proc(MB_CString_Const module_name,
- MB_CString_Const pred_name, MB_Word proc_id,
- MB_Word arity, MB_Byte is_func)
+ MB_CString_Const pred_name, MB_Word mode_num,
+ MB_Word arity, MB_Bool is_func)
{
- MB_Word* adr;
+ MB_Bytecode_Addr addr;
MB_Word size;
- MB_Module* module = MB_module_get(module_name);
+ MB_Module *module = MB_module_get(module_name);
MB_Word j;
- SAY(" Looking for %s %s__%s/%d (%d)",
+ MB_SAY(" Looking for %s %s__%s/%d mode %d",
(is_func) ? "func" : "pred",
- module_name, pred_name, arity, proc_id);
+ module_name, pred_name, arity, mode_num);
if (MB_stack_size(&module->pred_index_stack) == 0) {
- SAY(" No bytecode information for this module");
+ MB_SAY(" No bytecode information for this module");
return MB_CODE_INVALID_ADR;
}
size = MB_stack_size(&module->pred_index_stack);
for (j = 0; j < size; j++) {
- MB_Bytecode_Arg* pred_arg;
- adr = code_id + MB_stack_peek(&module->pred_index_stack, j);
+ MB_Bytecode_Arg *pred_arg;
+ addr = code_id + MB_stack_peek(&module->pred_index_stack, j);
- pred_arg = MB_code_get_arg(adr);
+ pred_arg = MB_code_get_arg(addr);
if ((pred_arg->enter_pred.pred_arity
== arity)
@@ -849,7 +849,7 @@
/* Check if any of the predicates matched */
if (j == MB_stack_size(&module->pred_index_stack)) {
- SAY(" Not found");
+ MB_SAY(" Not found");
return MB_CODE_INVALID_ADR;
}
@@ -858,28 +858,28 @@
do {
MB_Byte bc_id;
- adr++;
+ addr++;
- assert(MB_ip_normal(adr));
+ assert(MB_ip_normal(addr));
- bc_id = MB_code_get_id(adr);
+ bc_id = MB_code_get_id(addr);
if (bc_id == MB_BC_enter_proc) {
- MB_Bytecode_Arg* proc_arg = MB_code_get_arg(adr);
- if (proc_arg->enter_proc.proc_id == proc_id &&
- proc_arg->enter_proc.det != MB_DET_INVALID)
+ MB_Bytecode_Arg *proc_arg = MB_code_get_arg(addr);
+ if (proc_arg->enter_proc.mode_num == mode_num &&
+ proc_arg->enter_proc.det != MB_DET_UNUSABLE)
{
- return adr;
+ return addr;
}
/* Check if we've got to the end of this pred */
} else if ((bc_id == MB_BC_endof_pred) ||
(bc_id == MB_BC_enter_pred))
{
- SAY("Predicate does not contain "
- "procedure: %s/%d (%d)",
+ MB_SAY("Predicate does not contain "
+ "procedure: %s/%d mode %d",
pred_name,
- (int)arity,
- (int)proc_id);
+ (int) arity,
+ (int) mode_num);
return MB_CODE_INVALID_ADR;
}
@@ -889,7 +889,7 @@
}
-MB_Word*
+MB_Word *
MB_code_data_alloc_words(MB_Word num_words)
{
code_data_count += num_words;
@@ -899,39 +899,39 @@
return code_arg_data + code_data_count - num_words;
}
-/* given a code address, forces it into a valid range*/
-MB_Word*
-MB_code_range_check(MB_Word* adr)
+/* given a code address, forces it into a valid range */
+MB_Bytecode_Addr
+MB_code_range_clamp(MB_Bytecode_Addr addr)
{
- MB_Word* max_adr;
- if (adr < code_id) return code_id;
+ MB_Bytecode_Addr max_addr;
+ if ((MB_Unsigned) addr < (MB_Unsigned) code_id) return code_id;
- max_adr = code_id + code_count - 1;
- if (adr >= max_adr) return max_adr;
+ max_addr = code_id + code_count - 1;
+ if ((MB_Unsigned) addr > (MB_Unsigned) max_addr) return max_addr;
- return adr;
+ return addr;
}
/*
** Returns true if a given instruction pointer points to a normal
-** address
+** address (ie: valid range and not one of MB_CODE_xxxx)
*/
MB_Bool
-MB_ip_normal(MB_Word* ip)
-{
- return ((ip >= code_id) && (ip < code_id+MAX_CODE_COUNT));
-}
-
-MB_Bool
-MB_ip_special(MB_Word* ip)
+MB_ip_normal(MB_Bytecode_Addr ip)
{
- return ((MB_Unsigned)ip > (MB_Unsigned)MB_CODE_INVALID_ADR);
+ /* XXX pointer comparison; assume cast to unsigned will work */
+ return (((MB_Unsigned) ip >= (MB_Unsigned) code_id) &&
+ ((MB_Unsigned) ip < (MB_Unsigned) (code_id + MAX_CODE_COUNT)));
}
+/*
+** Returns true if a given instruction pointer is a 'special'
+** address (ie: one of the MB_CODE_xxxx macros)
+*/
MB_Bool
-MB_ip_native(MB_Word* ip)
+MB_ip_special(MB_Bytecode_Addr ip)
{
- return !MB_ip_special(ip) && !MB_ip_normal(ip);
+ return ((MB_Unsigned) ip > (MB_Unsigned) MB_CODE_INVALID_ADR);
}
--- ../bytecode.posted/mb_stack.h Tue Jan 30 14:04:54 2001
+++ mb_stack.h Mon Jan 29 16:19:52 2001
@@ -12,58 +12,69 @@
#define MB_STACK_H
#include "mb_basetypes.h"
+#include "mb_util.h"
-typedef struct MB_Stack_Tag {
- MB_Word*data;
+typedef struct MB_Stack_Struct {
+ MB_Word *data;
MB_Word sp;
MB_Word max_size: (MB_WORD_BITS-1);
MB_Word gc : 1;
} MB_Stack;
-/* allocates space for a new stack. gc indicates whether the stack region
-** should be allocated with the garbage collector or with the C malloc
-** (the garbage collector won't follow references from the c malloc area)
+/*
+** Allocates space for a new stack. 'gc' indicates whether the stack region
+** should be allocated with the garbage collector (see mb_mem.h) or with the
+** C malloc (the garbage collector won't follow references from the c malloc
+** area)
**
** For the garbage collector, assumes that data is not atomic
*/
MB_Stack MB_stack_new(MB_Word init_size, MB_Bool gc);
+
/* get number of words already pushed on stack */
-MB_Word MB_stack_size(MB_Stack* s);
+MB_Word MB_stack_size(MB_Stack *s);
+
/* pushes a value onto the stack. Return index of pushed word */
-MB_Word MB_stack_push(MB_Stack* s, MB_Word x);
+MB_Word MB_stack_push(MB_Stack *s, MB_Word x);
+
/* removes a value off the stack */
-MB_Word MB_stack_pop(MB_Stack* s);
+MB_Word MB_stack_pop(MB_Stack *s);
+
/* allocates space for multiple places on the stack */
/* return value is index of lowest word */
-MB_Word MB_stack_alloc(MB_Stack* s, MB_Word num_words);
+MB_Word MB_stack_alloc(MB_Stack *s, MB_Word num_words);
+
/* remove multiple items off the stack */
-void MB_stack_free(MB_Stack* s, MB_Word num_words);
-/* peek at an item at a given stack index*/
-MB_Word MB_stack_peek(MB_Stack* s, MB_Word idx);
+void MB_stack_free(MB_Stack *s, MB_Word num_words);
+
+/* peek at an item at a given stack index */
+MB_Word MB_stack_peek(MB_Stack *s, MB_Word idx);
+
/* peek at an item index items away from the top of the stack */
-MB_Word MB_stack_peek_rel(MB_Stack* s, MB_Word idx);
+MB_Word MB_stack_peek_rel(MB_Stack *s, MB_Word idx);
+
/* get the address for the item at index
** NOTE: if you add or remove items, this value could change */
-MB_Word* MB_stack_peek_p(MB_Stack* s, MB_Word idx);
+MB_Word *MB_stack_peek_p(MB_Stack *s, MB_Word idx);
+
/* get the address for the item at index relative to the top of the stack */
-MB_Word* MB_stack_peek_rel_p(MB_Stack* s, MB_Word idx);
+MB_Word *MB_stack_peek_rel_p(MB_Stack *s, MB_Word idx);
+
/* Set the value of an item on the stack */
-void MB_stack_poke(MB_Stack* s, MB_Word idx, MB_Word x);
+void MB_stack_poke(MB_Stack *s, MB_Word idx, MB_Word x);
+
/* Set the value of an item on the stack, idx items from the top */
-void MB_stack_poke_rel(MB_Stack* s, MB_Word rel_idx, MB_Word value);
+void MB_stack_poke_rel(MB_Stack *s, MB_Word rel_idx, MB_Word value);
+
/* deallocate space for the stack */
-void MB_stack_delete(MB_Stack* s);
+void MB_stack_delete(MB_Stack *s);
/*
** Uses the stack to allocate num elements of type, returns pointer to first
** element (rounds total memory allocated up to a multiple of sizeof(MB_Word))
*/
-#define MB_stack_alloc_mem(stack, type, num) \
- MB_stack_alloc((stack), \
- ( (num) \
- * (sizeof(type)+sizeof(MB_Word)-1) \
- / sizeof(MB_Word) ) \
- )
+#define MB_STACK_ALLOC(stack, type, num) \
+ MB_STACK_ALLOC((stack), MB_NUMBLOCKS(num * sizeof(type), sizeof(MB_Word))
#endif /* MB_STACK_H */
--- ../bytecode.posted/mb_stack.c Tue Jan 30 14:04:54 2001
+++ mb_stack.c Mon Jan 29 16:21:25 2001
@@ -19,18 +19,18 @@
/* Exported definitions */
MB_Stack MB_stack_new(MB_Word init_size, MB_Bool gc);
-MB_Word MB_stack_size(MB_Stack* s);
-MB_Word MB_stack_push(MB_Stack* s, MB_Word x);
-MB_Word MB_stack_pop(MB_Stack* s);
-MB_Word MB_stack_alloc(MB_Stack* s, MB_Word num_words);
-void MB_stack_free(MB_Stack* s, MB_Word num_words);
-MB_Word MB_stack_peek(MB_Stack* s, MB_Word index);
-MB_Word MB_stack_peek_rel(MB_Stack* s, MB_Word rel_index);
-MB_Word* MB_stack_peek_p(MB_Stack* s, MB_Word index);
-MB_Word* MB_stack_peek_rel_p(MB_Stack* s, MB_Word rel_index);
-void MB_stack_poke(MB_Stack* s, MB_Word index, MB_Word x);
-void MB_stack_poke_rel(MB_Stack* s, MB_Word rel_idx, MB_Word value);
-void MB_stack_delete(MB_Stack* s);
+MB_Word MB_stack_size(MB_Stack *s);
+MB_Word MB_stack_push(MB_Stack *s, MB_Word x);
+MB_Word MB_stack_pop(MB_Stack *s);
+MB_Word MB_stack_alloc(MB_Stack *s, MB_Word num_words);
+void MB_stack_free(MB_Stack *s, MB_Word num_words);
+MB_Word MB_stack_peek(MB_Stack *s, MB_Word index);
+MB_Word MB_stack_peek_rel(MB_Stack *s, MB_Word rel_index);
+MB_Word *MB_stack_peek_p(MB_Stack *s, MB_Word index);
+MB_Word *MB_stack_peek_rel_p(MB_Stack *s, MB_Word rel_index);
+void MB_stack_poke(MB_Stack *s, MB_Word index, MB_Word x);
+void MB_stack_poke_rel(MB_Stack *s, MB_Word rel_idx, MB_Word value);
+void MB_stack_delete(MB_Stack *s);
/* Local declarations */
@@ -48,8 +48,8 @@
s.data = NULL;
} else {
s.data = (gc)
- ? MB_GC_new_array(MB_Word, init_size)
- : MB_new_array(MB_Word, init_size);
+ ? MB_GC_NEW_ARRAY(MB_Word, init_size)
+ : MB_NEW_ARRAY(MB_Word, init_size);
if (s.data == NULL) {
MB_fatal("Unable to allocate memory");
}
@@ -61,24 +61,24 @@
MB_Word
-MB_stack_size(MB_Stack* s) {
+MB_stack_size(MB_Stack *s) {
return s->sp;
}
MB_Word
-MB_stack_push(MB_Stack* s, MB_Word x)
+MB_stack_push(MB_Stack *s, MB_Word x)
{
if (s->sp == s->max_size) {
s->max_size *= 2;
if (s->data == NULL) {
s->data = (s->gc)
- ? MB_GC_new_array(MB_Word, s->max_size)
- : MB_new_array(MB_Word, s->max_size);
+ ? MB_GC_NEW_ARRAY(MB_Word, s->max_size)
+ : MB_NEW_ARRAY(MB_Word, s->max_size);
} else {
s->data = (s->gc)
- ? MB_GC_resize_array(s->data, MB_Word,
+ ? MB_GC_RESIZE_ARRAY(s->data, MB_Word,
s->max_size)
- : MB_resize_array(s->data, MB_Word,
+ : MB_RESIZE_ARRAY(s->data, MB_Word,
s->max_size);
}
@@ -89,14 +89,14 @@
}
MB_Word
-MB_stack_pop(MB_Stack* s) {
+MB_stack_pop(MB_Stack *s) {
assert(s->sp != 0);
s->sp--;
return s->data[s->sp];
}
MB_Word
-MB_stack_alloc(MB_Stack* s, MB_Word num_words)
+MB_stack_alloc(MB_Stack *s, MB_Word num_words)
{
MB_Word orig_sp = s->sp;
@@ -112,49 +112,49 @@
void
-MB_stack_free(MB_Stack* s, MB_Word num_words) {
+MB_stack_free(MB_Stack *s, MB_Word num_words) {
s->sp -= num_words;
assert(s->sp >= 0);
}
MB_Word
-MB_stack_peek(MB_Stack* s, MB_Word index) {
+MB_stack_peek(MB_Stack *s, MB_Word index) {
assert(index >= 0);
assert(index < s->sp);
return s->data[index];
}
MB_Word
-MB_stack_peek_rel(MB_Stack* s, MB_Word rel_index) {
+MB_stack_peek_rel(MB_Stack *s, MB_Word rel_index) {
return MB_stack_peek(s, s->sp - rel_index);
}
-MB_Word*
-MB_stack_peek_p(MB_Stack* s, MB_Word index) {
+MB_Word *
+MB_stack_peek_p(MB_Stack *s, MB_Word index) {
assert(index >= 0);
assert(index < s->sp);
return s->data + index;
}
-MB_Word*
-MB_stack_peek_rel_p(MB_Stack* s, MB_Word rel_index) {
+MB_Word *
+MB_stack_peek_rel_p(MB_Stack *s, MB_Word rel_index) {
return MB_stack_peek_p(s, s->sp - rel_index);
}
void
-MB_stack_poke(MB_Stack* s, MB_Word index, MB_Word x) {
+MB_stack_poke(MB_Stack *s, MB_Word index, MB_Word x) {
assert(index >= 0);
assert(index < s->sp);
s->data[index] = x;
}
void
-MB_stack_poke_rel(MB_Stack* s, MB_Word rel_idx, MB_Word value) {
+MB_stack_poke_rel(MB_Stack *s, MB_Word rel_idx, MB_Word value) {
MB_stack_poke(s, s->sp - rel_idx, value);
}
void
-MB_stack_delete(MB_Stack* s) {
+MB_stack_delete(MB_Stack *s) {
if (s->gc) {
MB_GC_free(s->data);
} else {
--- ../bytecode.posted/mb_util.h Tue Jan 30 14:04:54 2001
+++ mb_util.h Tue Jan 30 11:51:00 2001
@@ -1,6 +1,6 @@
/*
-** Copyright (C) 1997-2001 The University of Melbourne.
+** Copyright (C) 1997,2000-2001 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.
**
@@ -17,7 +17,7 @@
typedef const char *
MB_CString_Const;
-#define MB_NULL_STR ((MB_CString)NULL)
+#define MB_NULL_STR ((MB_CString) NULL)
/* Standard TRUE & FALSE macros, if not defined */
#ifndef TRUE
@@ -31,23 +31,37 @@
void
MB_util_error(const char *fmt, ...);
-void SAY(const char* fmr, ...);
+/* Debugging printf */
+void MB_SAY(const char *fmt, ...);
/* Prints an error message and exits */
void
-MB_fatal(const char* message);
+MB_fatal(const char *message);
-/* allocate space for a new string*/
+/* allocate space for a new string */
MB_CString MB_str_new(MB_Word len); /* len is w/o null terminator */
+
/* return a new string created from two strings concatenated together */
MB_CString MB_str_new_cat(MB_CString_Const a, MB_CString_Const b);
+
/* free the memory allocated for a string */
void MB_str_delete(MB_CString str);
+
/* duplicate a null terminated string */
MB_CString MB_str_dup(MB_CString_Const str);
-/* compare two strings */
+
+/* compare two strings (returns zero for equality) */
int MB_str_cmp(MB_CString_Const a, MB_CString_Const b);
+
/* deallocate space for string */
void MB_str_delete(MB_CString str);
+
+
+/*
+** Given an arbitrary blocksize, returns how many blocks are required to
+** contain something of size x
+*/
+#define MB_NUMBLOCKS(x, blocksize) \
+ (((x) + (blocksize) - 1) / (blocksize))
#endif /* MB_UTIL_H */
--- ../bytecode.posted/mb_util.c Tue Jan 30 14:04:54 2001
+++ mb_util.c Tue Jan 30 17:07:55 2001
@@ -1,6 +1,6 @@
-#define NOSAY 0 /* To disable SAYings */
+#define NOSAY 1 /* To disable SAYings */
/*
-** Copyright (C) 2000-2001 The University of Melbourne.
+** Copyright (C) 1997,2000-2001 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.
**
@@ -18,7 +18,7 @@
/* Exported definitions */
void MB_util_error(const char *fmt, ...);
-void MB_fatal(const char* message);
+void MB_fatal(const char *message);
int MB_str_cmp(MB_CString_Const a, MB_CString_Const b);
MB_CString MB_str_new(MB_Word len);
MB_CString MB_str_new_cat(MB_CString_Const a, MB_CString_Const b);
@@ -43,7 +43,7 @@
fprintf(stderr, "\n");
}
-void SAY(const char* fmt, ...)
+void MB_SAY(const char *fmt, ...)
{
#if NOSAY
@@ -53,12 +53,13 @@
vfprintf(stderr, fmt, arg_p);
va_end(argp);
fprintf(stderr, "\n");
+ fflush(stdout); /* in case redirected to stdout */
#endif
}
/* prints an error and aborts program */
void
-MB_fatal(const char* message)
+MB_fatal(const char *message)
{
MB_util_error(message);
fprintf(stderr, " NOTE: The program will now abort.\n");
@@ -76,7 +77,7 @@
MB_CString
MB_str_new(MB_Word len)
{
- MB_CString c = MB_GC_new_array_atomic(char, len+1);
+ MB_CString c = MB_GC_NEW_ARRAY_ATOMIC(char, len + 1);
if (c == NULL) MB_fatal("Not enough string space");
return c;
@@ -90,9 +91,9 @@
MB_CString new_str = MB_str_new(len_a + len_b + 1);
memcpy(new_str, a, len_a);
- memcpy(new_str+len_a, b, len_b);
+ memcpy(new_str + len_a, b, len_b);
- new_str[len_a+len_b] = 0;
+ new_str[len_a + len_b] = 0;
return new_str;
}
@@ -100,7 +101,7 @@
MB_CString
MB_str_dup(MB_CString_Const str)
{
- MB_CString c = MB_str_new(strlen(str));
+ MB_CString c = MB_str_new(strlen(str) + 1);
strcpy(c, str);
return c;
}
--- ../bytecode.posted/mb_machine.h Tue Jan 30 14:04:54 2001
+++ mb_machine.h Tue Jan 30 16:33:06 2001
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1997-2001 The University of Melbourne.
+** Copyright (C) 1997,2000-2001 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.
**
@@ -13,69 +13,80 @@
#include <stdio.h>
#include "mb_bytecode.h"
-#include "mb_module.h"
+/*#include "mb_module.h"*/
#include "mb_util.h"
#include "mb_stack.h"
-struct MB_Machine_State_Tag;
-typedef struct MB_Machine_State_Tag MB_Machine_State;
+struct MB_Machine_State_Struct;
+typedef struct MB_Machine_State_Struct MB_Machine_State;
/*
** Returns an instruction describing a pointer to the next instruction
** Executes some 'special' IPs (eg: redo, fail) & returns their resultant ip
*/
-void MB_ip_set(MB_Machine_State* ms, MB_Word* new_ip);
-MB_Word* MB_ip_get(MB_Machine_State* ms);
-void MB_native_return_set(MB_Machine_State* ms, MB_Word* return_adr);
-MB_Word* MB_native_return_get(MB_Machine_State* ms);
-
-/* check which function we are currently in & set variables accordingly */
-/* (requires the nondet stack to be in a correct state) */
-void MB_func_type_check(MB_Machine_State* ms);
+void MB_ip_set(MB_Machine_State *ms, MB_Bytecode_Addr new_ip);
+MB_Bytecode_Addr MB_ip_get(MB_Machine_State *ms);
+void MB_native_return_set(MB_Machine_State *ms, MB_Native_Addr return_addr);
+MB_Native_Addr MB_native_return_get(MB_Machine_State *ms);
+
+/*
+** Check which procedure we are in & set variable stack pointer appropriately
+*/
+void MB_proc_var_init(MB_Machine_State *ms);
/* Get/set a variable on the det stack */
-MB_Word MB_var_get(MB_Machine_State* ms, MB_Word idx);
-void MB_var_set(MB_Machine_State* ms, MB_Word idx, MB_Word value);
+MB_Word MB_var_get(MB_Machine_State *ms, MB_Word idx);
+void MB_var_set(MB_Machine_State *ms, MB_Word idx, MB_Word value);
+
+/* Get/set the initial stack frame (see machine_def.h for use) */
+MB_Word *MB_initialstackframe_get(MB_Machine_State *ms);
+void MB_initialstackframe_set(MB_Machine_State *ms, MB_Word *stack);
/* Get/set an entry on the nondet stack, relative to curfr */
/* index zero is the topmost element */
-MB_Word MB_frame_max_get(MB_Machine_State* ms, MB_Word idx);
-void MB_frame_max_set(MB_Machine_State* ms, MB_Word idx,MB_Word val);
+MB_Word MB_frame_max_get(MB_Machine_State *ms, MB_Word idx);
+void MB_frame_max_set(MB_Machine_State *ms, MB_Word idx,MB_Word val);
/* Get an entry on the nondet stack */
-MB_Word MB_frame_get(MB_Machine_State* ms, MB_Word idx);
-void MB_frame_set(MB_Machine_State* ms, MB_Word idx, MB_Word val);
+MB_Word MB_frame_get(MB_Machine_State *ms, MB_Word idx);
+void MB_frame_set(MB_Machine_State *ms, MB_Word idx, MB_Word val);
/* Add nondet stack frame */
-MB_Word MB_frame_temp_det_push(MB_Machine_State* ms, MB_Word redoip);
-MB_Word MB_frame_temp_push(MB_Machine_State* ms, MB_Word redoip);
-MB_Word MB_frame_push(MB_Machine_State* ms, MB_Word redoip,
+MB_Word MB_frame_temp_det_push(MB_Machine_State *ms, MB_Word redoip);
+MB_Word MB_frame_temp_push(MB_Machine_State *ms, MB_Word redoip);
+MB_Word MB_frame_push(MB_Machine_State *ms, MB_Word redoip,
MB_Word succip, MB_Word vars, MB_Word temps);
/* Get/set a variable in the current stack frame variable list */
-MB_Word MB_frame_var_get(MB_Machine_State* ms, MB_Word idx);
-void MB_frame_var_set(MB_Machine_State* ms, MB_Word idx,MB_Word val);
+MB_Word MB_frame_var_get(MB_Machine_State *ms, MB_Word idx);
+void MB_frame_var_set(MB_Machine_State *ms, MB_Word idx,MB_Word val);
/* Display the current state of the machine */
-void MB_show_state(MB_Machine_State* ms, FILE* fp);
+void MB_show_state(MB_Machine_State *ms, FILE *fp);
/* Display the call stack of the machine */
-void MB_show_call(MB_Machine_State* ms, FILE* fp);
+void MB_show_call(MB_Machine_State *ms, FILE *fp);
/* Single step execute */
-void MB_step(MB_Machine_State* ms);
+void MB_step(MB_Machine_State *ms);
/* Single step execute over predicates */
-void MB_step_over(MB_Machine_State* ms);
+void MB_step_over(MB_Machine_State *ms);
/* Run until exception */
-void MB_run(MB_Machine_State* ms);
+void MB_run(MB_Machine_State *ms);
-/* Create a bytecode machine */
-void MB_machine_create(MB_Word* new_ip, MB_Machine_State* ms);
+/*
+** Create a bytecode interpreter machine with an initial bytecode ip of new_ip
+*/
+void MB_machine_create(MB_Machine_State *ms, MB_Bytecode_Addr new_ip,
+ MB_Word *initial_stack);
-/* Execute a bytecode machine */
-MB_Word* MB_machine_exec(MB_Machine_State* ms);
+/*
+** Execute a bytecode machine until native code invocation required.
+** Return address of native code to return to
+*/
+MB_Native_Addr MB_machine_exec(MB_Machine_State *ms);
#endif /* MB_MACHINE_H */
--- ../bytecode.posted/mb_machine.c Tue Jan 30 14:04:54 2001
+++ mb_machine.c Tue Jan 30 17:13:42 2001
@@ -15,7 +15,7 @@
#define INIT_LABELSTACK_SIZE 1000
/* Imports */
-#include <mercury_imp.h>
+#include "mercury_imp.h"
#include <assert.h>
#include <stdio.h>
@@ -32,31 +32,6 @@
/* Exported definitions */
-MB_Word* MB_ip_get(MB_Machine_State* ms);
-void MB_ip_set(MB_Machine_State* ms, MB_Word* new_ip);
-void MB_native_return_set(MB_Machine_State* ms, MB_Word* return_adr);
-MB_Word* MB_native_return_get(MB_Machine_State* ms);
-void MB_func_type_check(MB_Machine_State* ms);
-MB_Word MB_var_get(MB_Machine_State* ms, MB_Word idx);
-void MB_var_set(MB_Machine_State* ms, MB_Word idx, MB_Word value);
-MB_Word MB_frame_get(MB_Machine_State* ms, MB_Word idx);
-void MB_frame_set(MB_Machine_State* ms, MB_Word idx, MB_Word val);
-MB_Word MB_frame_temp_det_push(MB_Machine_State* ms, MB_Word redoip);
-MB_Word MB_frame_temp_push(MB_Machine_State* ms, MB_Word redoip);
-MB_Word MB_frame_push(MB_Machine_State* ms, MB_Word redoip,
- MB_Word succip, MB_Word vars, MB_Word temps);
-MB_Word MB_frame_var_get(MB_Machine_State* ms, MB_Word idx);
-void MB_frame_var_set(MB_Machine_State* ms, MB_Word idx,MB_Word val);
-MB_Word MB_label_get_adr(MB_Machine_State* ms, MB_Word idx);
-
-void MB_step(MB_Machine_State* ms);
-void MB_step_over(MB_Machine_State* ms);
-void MB_run(MB_Machine_State* ms);
-
-void MB_machine_create(MB_Word* new_ip, MB_Machine_State* ms);
-MB_Word* MB_machine_exec(MB_Machine_State* ms);
-void MB_machine_destroy(MB_Machine_State* ms);
-
/* Set new stack vars to this help find bugs */
#define CLOBBERED 0xbadbad00
@@ -68,12 +43,7 @@
/* Local declarations */
-static MB_Bool ip_special(MB_Word ip);
-static MB_Bool translate_calls(MB_Machine_State* ms);
-static MB_Bool translate_labels(MB_Machine_State* ms);
-static MB_Bool translate_detism(MB_Machine_State* ms);
-static MB_Bool translate_switch(MB_Machine_State* ms);
-static MB_Bool dispatch(MB_Byte bc_id, MB_Machine_State* ms);
+static MB_Bool dispatch(MB_Byte bc_id, MB_Machine_State *ms);
static void instr_do_redo (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
static void instr_do_fail (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
@@ -81,99 +51,125 @@
/* Implementation */
/* Get the next instruction pointer */
-MB_Word*
-MB_ip_get(MB_Machine_State* ms)
+MB_Bytecode_Addr
+MB_ip_get(MB_Machine_State *ms)
{
return ms->ip;
}
/* set the native code return address */
void
-MB_native_return_set(MB_Machine_State* ms, MB_Word* native_return)
+MB_native_return_set(MB_Machine_State *ms, MB_Native_Addr native_return)
{
ms->native_return = native_return;
}
-MB_Word*
-MB_native_return_get(MB_Machine_State* ms)
+MB_Native_Addr
+MB_native_return_get(MB_Machine_State * ms)
{
return ms->native_return;
}
void
-MB_ip_set(MB_Machine_State* ms, MB_Word* new_ip)
+MB_ip_set(MB_Machine_State *ms, MB_Bytecode_Addr new_ip)
{
if (MB_ip_special(new_ip)) {
- switch ((MB_Word)new_ip) {
- case (MB_Word)MB_CODE_DO_FAIL:
+ switch ((MB_Word) new_ip) {
+ case (MB_Word) MB_CODE_DO_FAIL:
instr_do_fail(ms, NULL);
break;
- case (MB_Word)MB_CODE_DO_REDO:
+
+ case (MB_Word) MB_CODE_DO_REDO:
instr_do_redo(ms, NULL);
break;
+
+ case (MB_Word) MB_CODE_NATIVE_RETURN:
+ ms->ip = new_ip;
+ break;
+
default:
assert(FALSE);
}
- } else if (MB_ip_native(new_ip)) {
- ms->ip = MB_CODE_NATIVE_RETURN;
- ms->native_return = new_ip;
} else {
ms->ip = new_ip;
}
}
-/* Check which function we are in & save pointers to temp & var slots */
+/*
+** Check which procedure we are in & set variable stack pointer appropriately
+**
+** If you don't call this after the ip switches to a new function
+** then MB_var_get and MB_var_set will give incorrect results
+**
+** If det/semidet, set the machine state variable slot pointer to the det stack
+** If nondet, set the machine state variable slot pointer to the nondet stack
+*/
void
-MB_func_type_check(MB_Machine_State* ms)
+MB_proc_var_init(MB_Machine_State *ms)
{
- /*
- ** The old method (based on stack frame sizes) wasn't as good as
- ** this one because a det function can contain commits within which
- ** temporary nondet stack frames are on top of the nondet stack,
- ** So you can't tell whether a nondet or det function was really
- ** being run
- **
- ** Instead the bytecode id now encodes whether it is operating in a
- ** det or nondet procedure in a single bit.
- */
- MB_Word* ip = MB_ip_get(ms);
+ MB_Bytecode_Addr ip = MB_ip_get(ms);
- SAY("Hello from func_type_check");
+ MB_SAY("Hello from proc_var_init");
if (!MB_ip_normal(ip)) return;
- /* Check that we are actually in a function and not just entering one */
+ /* Check that we are actually in a procedure and not just entering one*/
if (MB_code_get_id(ip) != MB_BC_enter_proc) {
/* If we are, check the determinism & set vars as appropriate */
ms->cur_proc.is_det = MB_code_get_det(ip);
+
ms->cur_proc.var = (ms->cur_proc.is_det == MB_ISDET_YES)
- ? &(MB_stackitem(MB_DETFRAME_SIZE))
+ ? &(MB_stackitem(MB_DETFRAME_SIZE+1))
: &(MB_frameitem(MB_FRAME_SIZE));
} else {
- SAY(" not getting func type of unentered function");
+ MB_SAY(" not getting proc det of unentered procedure");
}
}
-/* Get a variable */
-/* XXX no range check (even when debugging) */
+/*
+** Get a variable from the appropriate mercury stack
+**
+** It knows which stack to use because you have of course already
+** called MB_proc_var_init to set the current procedure's
+** variable pointer to point to variable 0.
+*/
MB_Word
-MB_var_get(MB_Machine_State* ms, MB_Word idx)
+MB_var_get(MB_Machine_State *ms, MB_Word idx)
{
+ /*
+ ** idx is negative because variable 0 is the topmost and
+ ** higher number variables are below it on the stack
+ */
return ms->cur_proc.var[-idx];
}
-/* Set a variable on the det stack */
+/* Set a variable on the mercury stack */
void
-MB_var_set(MB_Machine_State* ms, MB_Word idx, MB_Word value)
+MB_var_set(MB_Machine_State *ms, MB_Word idx, MB_Word value)
{
ms->cur_proc.var[-idx] = value;
}
+/* Get/set the initial stack frame (see machine_def.h for use) */
+MB_Word *
+MB_initialstackframe_get(MB_Machine_State *ms)
+{
+ return ms->initial_stack;
+}
+
+void
+MB_initialstackframe_set(MB_Machine_State *ms, MB_Word *frame)
+{
+ MB_SAY("'spector gadget %08x\n", frame);
+ assert(ms->initial_stack == NULL);
+ ms->initial_stack = frame;
+}
+
/* Add a temporary det stack frame */
MB_Word
-MB_frame_temp_det_push(MB_Machine_State* ms, MB_Word redoip)
+MB_frame_temp_det_push(MB_Machine_State *ms, MB_Word redoip)
{
MB_fatal("MB_frame_temp_det_push not implemented yet");
return 0;
@@ -195,7 +191,7 @@
/* Add a temporary stack frame */
MB_Word
-MB_frame_temp_push(MB_Machine_State* ms, MB_Word redoip)
+MB_frame_temp_push(MB_Machine_State *ms, MB_Word redoip)
{
MB_fatal("MB_frame_temp_push not implemented yet");
return 0;
@@ -220,7 +216,7 @@
/* Add a stack frame */
MB_Word
-MB_frame_push(MB_Machine_State*ms, MB_Word redoip,
+MB_frame_push(MB_Machine_State *ms, MB_Word redoip,
MB_Word succip, MB_Word vars, MB_Word temps)
{
MB_fatal("MB_frame_temp_push not implemented yet");
@@ -248,7 +244,7 @@
/* Get/set a variable in the current stack frame variable list */
void
-MB_frame_var_set(MB_Machine_State* ms, MB_Word idx, MB_Word val)
+MB_frame_var_set(MB_Machine_State *ms, MB_Word idx, MB_Word val)
{
MB_fatal("MB_frame_var_set not implemented yet");
#if 0
@@ -258,7 +254,7 @@
}
/* Get/set a variable in the current stack frame variable list */
MB_Word
-MB_frame_var_get(MB_Machine_State* ms, MB_Word idx)
+MB_frame_var_get(MB_Machine_State *ms, MB_Word idx)
{
MB_fatal("MB_frame_var_get not implemented yet");
return 0;
@@ -268,73 +264,109 @@
#endif
}
/* --------------------------------------------------------------------------
*/
-static void instr_invalid (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_enter_proc (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_endof_proc (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_enter_disjunction
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_endof_disjunction
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_enter_disjunct(MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
-static void instr_endof_disjunct(MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
-static void instr_enter_switch (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_enter_switch_arm
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_endof_switch_arm
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_endof_switch (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_enter_if (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_enter_then (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_endof_then (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
+static void instr_invalid (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_proc (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_proc (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_disjunction (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_disjunction (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_disjunct (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_disjunct (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_switch (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_switch_arm (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_switch_arm (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_switch (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_if (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_then (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_then (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
/* instr_enter_else is identical to enter_then */
-static void instr_endof_if (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_enter_negation(MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
-static void instr_endof_negation_goal
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_endof_negation(MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
-static void instr_enter_commit (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_endof_commit (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_assign (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_test (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_construct (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_deconstruct (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_place (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_pickup (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_call (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_higher_order_call
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_builtin_binop (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
-static void instr_builtin_bintest
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_builtin_unop (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_builtin_untest(MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
-static void instr_semidet_success
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_semidet_success_check
- (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_do_redo (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_do_fail (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_noop (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
-static void instr_notdone (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
+static void instr_endof_if (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_negation (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_negation_goal (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_negation (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_enter_commit (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_endof_commit (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_assign (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_test (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_construct (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_deconstruct (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_place (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_pickup (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_call (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_higher_order_call (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_builtin_binop (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_builtin_bintest (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_builtin_unop (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_builtin_untest (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_semidet_success (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_semidet_success_check (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_do_redo (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_do_fail (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_noop (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
+static void instr_notdone (MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca);
/* return true if a construction succeeds */
-static MB_Word do_construct_cons(MB_Machine_State* ms, const MB_Cons_id* cid,
- MB_Word list_length, MB_Short* var_list);
+static MB_Word do_construct_cons(MB_Machine_State *ms, const MB_Cons_id *cid,
+ MB_Word list_length, MB_Short *var_list);
/* return true if a deconstruction succeeds */
-static MB_Bool do_deconstruct(MB_Machine_State*ms, const MB_Cons_id* cid,
- MB_Word var, MB_Word list_length, MB_Short* var_list);
-static MB_Bool do_deconstruct_cons(MB_Machine_State* ms, const MB_Cons_id* cid,
- MB_Word val, MB_Word list_length, MB_Short* var_list);
+static MB_Bool do_deconstruct(MB_Machine_State *ms, const MB_Cons_id *cid,
+ MB_Word var, MB_Word list_length, MB_Short *var_list);
+static MB_Bool do_deconstruct_cons(MB_Machine_State *ms, const MB_Cons_id *cid,
+ MB_Word val, MB_Word list_length, MB_Short *var_list);
/* XXX det and nondet conditions (ite / disjunct / commit) all use the same
** [would require modifying bytecode ids?]
*/
-/* XXX ORDER relies on the order of the definitions */
-static void (*instruction_table[])(MB_Machine_State*, const MB_Bytecode_Arg*) =
{
- instr_invalid, /*enter_pred*/
- instr_invalid, /*endof_pred*/
+/*typedef void (MB_Instruction_Handler)(MB_Machine_State *,
+ const MB_Bytecode_Arg *);
+*/
+
+typedef void (*MB_Instruction_Handler) (MB_Machine_State *,
+ const MB_Bytecode_Arg *);
+
+/* XXX ORDER: relies on the order of the definitions */
+static MB_Instruction_Handler instruction_table[] = {
+ instr_invalid, /* enter_pred */
+ instr_invalid, /* endof_pred */
instr_enter_proc,
instr_endof_proc,
instr_noop, /* label */
@@ -358,16 +390,16 @@
instr_test,
instr_construct,
instr_deconstruct,
- instr_notdone, /**** complex construct */
- instr_notdone, /**** complex deconstruct */
+ instr_notdone, /* XXX complex construct */
+ instr_notdone, /* XXX complex deconstruct */
instr_place,
instr_pickup,
instr_call,
instr_higher_order_call,
instr_builtin_binop,
- instr_builtin_unop, /**** unop */
+ instr_builtin_unop, /* XXX unop */
instr_builtin_bintest,
- instr_builtin_untest, /**** unop test */
+ instr_builtin_untest, /* XXX unop test */
instr_semidet_success,
instr_semidet_success_check,
instr_do_redo, /* fail */
@@ -378,46 +410,61 @@
};
static void
-instr_invalid(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_invalid(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
- assert(FALSE);
+ MB_fatal("Invalid instruction encountered");
}
/* Enter/exit procedure */
static void
-instr_enter_proc(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_proc(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
switch (bca->enter_proc.det) {
case MB_DET_SEMIDET:
MB_fatal("semidet");
+
case MB_DET_DET: {
MB_Word detframe_size =
- bca->enter_proc.temp_count+
- bca->enter_proc.list_length+
+ bca->enter_proc.temp_count +
+ bca->enter_proc.list_length +
MB_DETFRAME_SIZE;
+
+ /*
+ ** Save the initial stack frame if this function is
+ ** going to be the one that returns to native code
+ */
+ MB_SAY( "MB_sp: %08x\n"
+ "initialstackframe: %08x\n",
+ MB_sp,
+ ms->initial_stack);
+
+ if (MB_initialstackframe_get(ms) == NULL) {
+ MB_initialstackframe_set(ms, MB_sp);
+ }
+
MB_incr_sp(detframe_size);
/* save succip */
- MB_stackitem(MB_DETFRAME_SUCCIP) = (MB_Word)MB_succip;
- MB_stackitem(MB_DETFRAME_BC_SUCCIP) = (MB_Word)NULL;
+ MB_stackitem(MB_DETFRAME_SUCCIP) = (MB_Word) MB_succip;
- MB_ip_set(ms, MB_ip_get(ms)+1);
+ MB_ip_set(ms, MB_ip_get(ms) + 1);
break;
}
case MB_DET_MULTIDET:
case MB_DET_NONDET: {
- #if 0
MB_fatal("enter_proc/multidet,nondet");
+
+ #if 0
MB_frame_push(ms,
MB_CODE_DO_FAIL,
MB_succip_get(ms),
bca->enter_proc.list_length,
bca->enter_proc.temp_count);
- MB_ip_set(ms, MB_ip_get(ms)+1);
+ MB_ip_set(ms, MB_ip_get(ms) + 1);
#endif
break;
@@ -427,8 +474,8 @@
instr_notdone(ms, NULL);
}
- /* set function type info*/
- MB_func_type_check(ms);
+ /* set procedure detism info & variable stack pointer */
+ MB_proc_var_init(ms);
#if CLOBBERSTACK
{
@@ -436,12 +483,12 @@
MB_Word count = bca->enter_proc.list_length +
bca->enter_proc.temp_count;
for (i = 0; i < count; i++) {
- MB_var_set(ms, i, CLOBBERED+i);
+ MB_var_set(ms, i, CLOBBERED + i);
}
}
#endif
#if 0
- if (bca->enter_proc.det == MB_DET_SEMIDET) {
+ if (MB_model_semi(bca->enter_proc.det)) {
/*
** If a semidet procedure then mark our success slot as failure
** until we know otherwise.
@@ -451,16 +498,16 @@
/*
** Also push a failure context in case fail is encountered
*/
- MB_frame_temp_push(ms, bca->enter_proc.end_label.adr);
+ MB_frame_temp_push(ms, bca->enter_proc.end_label.addr);
}
#endif
}
static void
-instr_endof_proc(MB_Machine_State* ms, const MB_Bytecode_Arg* endof_bca)
+instr_endof_proc(MB_Machine_State *ms, const MB_Bytecode_Arg *endof_bca)
{
/* get the current proc */
- MB_Bytecode_Arg* bca =
+ MB_Bytecode_Arg *bca =
MB_code_get_arg(endof_bca->endof_proc.proc_start);
switch (bca->enter_proc.det) {
@@ -477,8 +524,8 @@
case MB_DET_DET: {
MB_Word detframe_size =
- bca->enter_proc.temp_count+
- bca->enter_proc.list_length+
+ bca->enter_proc.temp_count +
+ bca->enter_proc.list_length +
MB_DETFRAME_SIZE;
MB_succip = MB_stackitem(MB_DETFRAME_SUCCIP);
@@ -486,7 +533,19 @@
/* deallocate stack variables */
MB_decr_sp(detframe_size);
- MB_ip_set(ms, MB_succip);
+ /* Check whether we should return to native code */
+ if (MB_sp == MB_initialstackframe_get(ms)) {
+ MB_SAY("trying to go native again");
+ MB_native_return_set(ms, MB_succip);
+ MB_ip_set(ms, MB_CODE_NATIVE_RETURN);
+ } else {
+ MB_SAY("just doing an easy bc ret");
+ MB_SAY( "MB_sp: %08x\n"
+ "initialstackframe: %08x\n",
+ MB_sp,
+ ms->initial_stack);
+ MB_ip_set(ms, MB_succip);
+ }
return;
}
#if 0
@@ -502,11 +561,11 @@
instr_notdone(ms, NULL);
}
- MB_func_type_check(ms);
+ MB_proc_var_init(ms);
}
static void
-instr_enter_disjunction(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_disjunction(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("enter_disjunction");
#if 0
@@ -517,7 +576,7 @@
}
static void
-instr_enter_disjunct(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_disjunct(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("enter_disjunct");
#if 0
@@ -527,20 +586,20 @@
**
** if this is the last disjunct, then remove the top frame instead
*/
- if (bca->enter_disjunct.next_label.adr == MB_CODE_INVALID_ADR) {
- /* remove the top frame*/
+ if (bca->enter_disjunct.next_label.addr == MB_CODE_INVALID_ADR) {
+ /* remove the top frame */
MB_maxfr_set(ms, MB_frame_max_get(ms, MB_FRAME_REDOFR));
} else {
/* set a new redoip */
MB_frame_max_set(ms, MB_FRAME_REDOIP,
- bca->enter_disjunct.next_label.adr);
+ bca->enter_disjunct.next_label.addr);
}
instr_noop(ms, NULL);
#endif
}
static void
-instr_endof_disjunct(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_endof_disjunct(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("endof_disjunct");
#if 0
@@ -550,12 +609,12 @@
** be leaving one or more nondet stack frames so we can backtrack
** into the disjunction if we fail later on
*/
- MB_ip_set(ms, bca->endof_disjunct.end_label.adr);
+ MB_ip_set(ms, bca->endof_disjunct.end_label.addr);
#endif
}
static void
-instr_endof_disjunction(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_endof_disjunction(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("endof_disjunction");
#if 0
@@ -567,13 +626,13 @@
}
static void
-instr_enter_switch(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_switch(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
instr_noop(ms, NULL);
}
static void
-instr_enter_switch_arm(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_switch_arm(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
/* Check if this deconstruct is going to succeed */
if (do_deconstruct(ms, &bca->enter_switch_arm.cons_id,
@@ -588,19 +647,19 @@
/*
** If it fails, go to the next switch arm
*/
- MB_ip_set(ms, bca->enter_switch_arm.next_label.adr);
+ MB_ip_set(ms, bca->enter_switch_arm.next_label.addr);
}
}
static void
-instr_endof_switch_arm(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_endof_switch_arm(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
/* This switch arm has succeeded, now go to the end of the switch */
- MB_ip_set(ms, bca->endof_switch_arm.end_label.adr);
+ MB_ip_set(ms, bca->endof_switch_arm.end_label.addr);
}
static void
-instr_endof_switch(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_endof_switch(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
/*
** If we get here, no switch arm matched, so trigger a redo
@@ -609,7 +668,7 @@
}
static void
-instr_enter_if(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_if(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("enter_if");
#if 0
@@ -618,7 +677,7 @@
** temp stack slot
*/
MB_temp_set(ms, bca->enter_if.frame_ptr_tmp,
- MB_frame_temp_push(ms, bca->enter_if.else_label.adr)
+ MB_frame_temp_push(ms, bca->enter_if.else_label.addr)
);
instr_noop(ms, NULL);
@@ -630,7 +689,7 @@
instr_enter_else()
*/
static void
-instr_enter_then(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_then(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("enter_then");
#if 0
@@ -653,17 +712,17 @@
}
static void
-instr_endof_then(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_endof_then(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("endof_then");
#if 0
/* jump to the end of the construct */
- MB_ip_set(ms, bca->endof_then.follow_label.adr);
+ MB_ip_set(ms, bca->endof_then.follow_label.addr);
#endif
}
static void
-instr_endof_if(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_endof_if(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("endof_if");
#if 0
@@ -673,7 +732,7 @@
}
static void
-instr_enter_negation(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_negation(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("enter_negation");
#if 0
@@ -681,14 +740,14 @@
** to drop through to the end of the negation and succeed
*/
MB_temp_set(ms, bca->enter_negation.frame_ptr_tmp,
- MB_frame_temp_push(ms, bca->enter_negation.end_label.adr));
+ MB_frame_temp_push(ms, bca->enter_negation.end_label.addr));
instr_noop(ms, NULL);
#endif
}
static void
-instr_endof_negation_goal(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_endof_negation_goal(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("endof_negation_goal");
#if 0
@@ -708,7 +767,7 @@
}
static void
-instr_endof_negation(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_endof_negation(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("endof_negation");
#if 0
@@ -723,7 +782,7 @@
}
static void
-instr_enter_commit(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_enter_commit(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("enter_commit");
#if 0
@@ -739,7 +798,7 @@
}
static void
-instr_endof_commit(MB_Machine_State* ms, const MB_Bytecode_Arg *bca)
+instr_endof_commit(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("endof_commit");
#if 0
@@ -756,7 +815,7 @@
}
static void
-instr_assign(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_assign(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("assign");
#if 0
@@ -768,7 +827,7 @@
}
static void
-instr_test(MB_Machine_State* ms, const MB_Bytecode_Arg *bca)
+instr_test(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("test");
#if 0
@@ -782,15 +841,15 @@
}
static MB_Word
-do_construct_cons(MB_Machine_State* ms, const MB_Cons_id* cid,
- MB_Word list_length, MB_Short* var_list)
+do_construct_cons(MB_Machine_State *ms, const MB_Cons_id *cid,
+ MB_Word list_length, MB_Short *var_list)
{
MB_fatal("do_construct_cons");
#if 0
- const MB_Tag* cons_tag = &cid->opt.cons.tag;
- MB_Word* val = MB_mkword(
+ const MB_Tag *cons_tag = &cid->opt.cons.tag;
+ MB_Word *val = MB_mkword(
MB_mktag(cons_tag->opt.pair.primary),
- MB_mkbody((MB_Word)NULL));
+ MB_mkbody((MB_Word) NULL));
/* the final value we will put in the reg */
@@ -809,30 +868,28 @@
*/
MB_Word extra = (cons_tag->id == MB_TAG_COMPLICATED)
? 1 : 0;
- MB_Word*heap_data;
+ MB_Word *heap_data;
MB_Word i;
if (list_length + extra) {
- MB_Short* var_list;
+ MB_Short *var_list;
/* allocate heap memory */
- heap_data = (MB_Word*)MB_GC_malloc(
- sizeof(MB_Word) * (list_length + extra),
- MB_GC_NOT_ATOMIC);
+ heap_data = (MB_Word *) MB_GC_new_array(
+ MB_Word, list_length + extra);
/* ensure tag bits aren't used */
- assert(MB_tag((MB_Word)heap_data) == 0);
+ assert(MB_tag((MB_Word) heap_data) == 0);
/* get variable list */
- var_list = (MB_Short*)MB_stack_peek_p(
+ var_list = (MB_Short *)MB_stack_peek_p(
&ms->code.data,
var_list_index);
/* copy variables to allocate heap block */
- for (i = 0; i < list_length; i++)
- {
- heap_data[i+extra] =
+ for (i = 0; i < list_length; i++) {
+ heap_data[i + extra] =
MB_var_get(ms, var_list[i]);
}
} else {
@@ -847,12 +904,12 @@
heap_data[0] = cons_tag->opt.pair.secondary;
val = MB_mkword(
MB_mktag(cons_tag->opt.pair.primary),
- MB_body((MB_Word)heap_data,
+ MB_body((MB_Word) heap_data,
MB_mktag(0)));
} else {
val = MB_mkword(
MB_mktag(cons_tag->opt.primary),
- MB_body((MB_Word)heap_data,
+ MB_body((MB_Word) heap_data,
MB_mktag(0)));
}
@@ -860,7 +917,7 @@
}
case MB_TAG_COMPLICATED_CONSTANT:
- /* primary + local secondary tag*/
+ /* primary + local secondary tag */
assert(list_length == 0);
val = MB_mkword(
MB_mktag(cons_tag->opt.pair.primary),
@@ -878,17 +935,16 @@
default:
instr_notdone(ms, NULL);
}
- return (MB_Word)val;
+ return (MB_Word) val;
#endif
return 0;
}
static void
-instr_construct(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_construct(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_Word val;
/* construct a variable into a slot */
- /* XXX */
switch (bca->construct.consid.id) {
case MB_CONSID_INT_CONST:
assert(bca->construct.list_length == 0);
@@ -897,7 +953,7 @@
case MB_CONSID_STRING_CONST:
assert(bca->construct.list_length == 0);
- val = (MB_Word)bca->construct.consid.opt.string_const;
+ val = (MB_Word) bca->construct.consid.opt.string_const;
break;
case MB_CONSID_CONS:
@@ -915,15 +971,15 @@
#if 0
int i;
- MB_Closure* closure = MB_GC_malloc(
+ MB_Closure *closure = MB_GC_malloc(
MB_CLOSURE_SIZE(bca->construct.list_length),
MB_GC_NOT_ATOMIC);
- MB_Short* var_list = (MB_Short*)MB_stack_peek_p(
+ MB_Short *var_list = (MB_Short *)MB_stack_peek_p(
&ms->code.data,
bca->construct.var_list_index);
- closure->code_adr = bca->construct
- .consid.opt.pred_const.adr;
+ closure->code_addr = bca->construct
+ .consid.opt.pred_const.addr;
closure->num_hidden_args = bca->construct.list_length;
for (i = 0; i < closure->num_hidden_args; i++) {
@@ -931,7 +987,7 @@
MB_var_get(ms, var_list[i]);
}
- val = (MB_Word)closure;
+ val = (MB_Word) closure;
break;
#endif
@@ -942,7 +998,7 @@
instr_notdone(ms, NULL);
case MB_CONSID_CHAR_CONST:
- val = (MB_Word)bca->construct.consid.opt.char_const.ch;
+ val = (MB_Word) bca->construct.consid.opt.char_const.ch;
break;
default:
@@ -959,8 +1015,8 @@
** if a functor then deconstructs arguments into variable slots
*/
static MB_Bool
-do_deconstruct(MB_Machine_State*ms, const MB_Cons_id* cid, MB_Word var,
- MB_Word list_length, MB_Short* var_list)
+do_deconstruct(MB_Machine_State *ms, const MB_Cons_id *cid, MB_Word var,
+ MB_Word list_length, MB_Short *var_list)
{
MB_Word var_val = MB_var_get(ms, var);
@@ -970,7 +1026,7 @@
return (var_val == cid->opt.int_const);
case MB_CONSID_STRING_CONST:
- return (!MB_str_cmp((char*)var_val,
+ return (!MB_str_cmp((char *)var_val,
cid->opt.string_const));
case MB_CONSID_CONS: {
@@ -979,7 +1035,7 @@
}
case MB_CONSID_CHAR_CONST:
- return (var_val == (MB_Word)cid->opt.char_const.ch);
+ return (var_val == (MB_Word) cid->opt.char_const.ch);
default:
instr_notdone(ms, NULL);
@@ -991,10 +1047,10 @@
/* returns true if val is equivalent to a construction given by cid */
static MB_Bool
-do_deconstruct_cons(MB_Machine_State* ms, const MB_Cons_id* cid,
- MB_Word val, MB_Word list_length, MB_Short* var_list)
+do_deconstruct_cons(MB_Machine_State *ms, const MB_Cons_id *cid,
+ MB_Word val, MB_Word list_length, MB_Short *var_list)
{
- const MB_Tag* cons_tag = &cid->opt.cons.tag;
+ const MB_Tag *cons_tag = &cid->opt.cons.tag;
assert(cid->id == MB_CONSID_CONS);
@@ -1015,7 +1071,7 @@
*/
MB_Word extra = (cons_tag->id == MB_TAG_COMPLICATED)
? 1 : 0;
- MB_Word*heap_data = (MB_Word*)MB_strip_tag(val);
+ MB_Word *heap_data = (MB_Word *)MB_strip_tag(val);
MB_Word i;
/* check that tags are identical */
@@ -1039,7 +1095,7 @@
for (i = 0; i < list_length; i++)
{
MB_var_set(ms, var_list[i],
- heap_data[i+extra]);
+ heap_data[i + extra]);
}
}
@@ -1047,9 +1103,9 @@
}
case MB_TAG_COMPLICATED_CONSTANT:
- /* primary + local secondary tag*/
+ /* primary + local secondary tag */
assert(list_length == 0);
- if (val != (MB_Word)MB_mkword(
+ if (val != (MB_Word) MB_mkword(
MB_mktag(cons_tag->opt.pair.primary),
MB_mkbody(cons_tag->opt.pair.secondary)))
{
@@ -1078,7 +1134,7 @@
static void
-instr_deconstruct(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_deconstruct(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("deconstruct");
/* test the equality of a variable in a slot with a given value */
@@ -1094,7 +1150,7 @@
}
static void
-instr_place(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_place(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
/* copy value from var slot to reg */
MB_reg(bca->place_arg.to_reg) =
@@ -1110,9 +1166,9 @@
}
static void
-instr_pickup(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_pickup(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
- /* copy value from reg to var slot*/
+ /* copy value from reg to var slot */
MB_var_set(ms, bca->pickup_arg.to_var,
MB_reg(bca->pickup_arg.from_reg));
@@ -1126,65 +1182,110 @@
}
static void
-instr_call(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_call(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
- /* Call another function */
+ /* Call another procedure */
- MB_Word* next_ip = MB_ip_get(ms) + 1;
- MB_Word* new_adr = bca->call.adr;
+ MB_Bytecode_Addr next_ip = MB_ip_get(ms) + 1;
- if (!bca->call.is_native) {
- if (new_adr == MB_CODE_INVALID_ADR) {
+ /* Call bytecode */
+ if (!bca->call.addr.is_native) {
+ MB_Bytecode_Addr new_addr = bca->call.addr.addr.bc;
+ if (new_addr == MB_CODE_INVALID_ADR) {
MB_util_error("Attempt to call unknown bytecode"
- " %s %s__%s/%d (%d)",
+ " %s %s__%s/%d mode %d",
bca->call.is_func ? "func" : "pred",
- bca->call.module_id,
- bca->call.pred_id,
- (int)bca->call.arity,
- (int)bca->call.proc_id);
+ bca->call.module_name,
+ bca->call.pred_name,
+ (int) bca->call.arity,
+ (int) bca->call.mode_num);
MB_fatal("");
} else {
- if (MB_ip_normal(new_adr)) {
+ if (MB_ip_normal(new_addr)) {
/* set the return address to the next instr */
MB_succip = next_ip;
- /* set the new execution point*/
- MB_ip_set(ms, new_adr);
+ /* set the new execution point */
+ MB_ip_set(ms, new_addr);
} else {
MB_fatal("Unexpected call address"
" (special address not implemented?)");
}
}
+
+ /* Call native code */
} else {
- SAY("Attempting to call native code from bytecode");
+ MB_Native_Addr new_addr = bca->call.addr.addr.native;
+ MB_SAY("Attempting to call native code from bytecode");
+
+ /* Make sure the address has been looked up */
+ if (new_addr == NULL) {
+ new_addr = MB_code_find_proc_native(
+ bca->call.module_name,
+ bca->call.pred_name,
+ bca->call.arity,
+ bca->call.mode_num,
+ bca->call.is_func);
+ if (new_addr == NULL) {
+ MB_util_error(
+ "Warning: proc ref in bytecode"
+ " to unknown %s %s__%s/%d mode %d",
+ bca->call.is_func ? "func" : "pred",
+ bca->call.module_name,
+ bca->call.pred_name,
+ (int) bca->call.arity,
+ (int) bca->call.mode_num);
+ MB_fatal("Are you sure the module"
+ " was compiled with trace"
+ " information enabled?");
+ }
+
+ /* XXX: Write to constant data */
+ bca->call.addr.addr.native = new_addr;
+ }
+
if (ms->cur_proc.is_det == MB_ISDET_YES) {
- /* set success ip to the next instruction */
+ /* Push a interface det stack frame */
+ MB_incr_sp(MB_DETFRAME_INTERFACE_SIZE);
+
+ /* Set success ip to reentry stub */
MB_succip = MB_native_get_return_det();
- MB_stackitem(MB_DETFRAME_BC_SUCCIP) = (MB_Word)next_ip;
- /* return to native code at address new_adr */
- ms->ip = MB_CODE_NATIVE_RETURN;
- ms->native_return = new_adr;
+ /* Save initial stack frame pointer */
+ MB_stackitem(MB_DETFRAME_INTERFACE_INITIAL_FRAME)
+ = (MB_Word) MB_initialstackframe_get(ms);
+
+ /* Save bytecode reentry point */
+ MB_stackitem(MB_DETFRAME_INTERFACE_BC_SUCCIP)
+ = (MB_Word) next_ip;
+
+ /* return to native code at address new_addr */
+ MB_ip_set(ms, MB_CODE_NATIVE_RETURN);
+ MB_native_return_set(ms, new_addr);
+
+ MB_SAY("New ip: %08x\n", ms->ip);
+ MB_SAY("native_return: %08x\n", ms->native_return);
} else {
- MB_fatal("Calls from nondet code not done");
+ MB_fatal("Native calls from nondet code not done");
}
}
}
/*
-** XXX BOOGER: Does the surrouding code expect that the registers can be
-** changed during the call & not restored? It should.
**
+** XXX:
+**
** Why does the call need to know the number of output arguments ???
**
-** If semidet, do I need to make space for an extra argument ???
+** If semidet, do I need to make space for the extra argument or has
+** the mercury compiler already done that ???
**
*/
static void
-instr_higher_order_call(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_higher_order_call(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("higher_order_call");
#if 0
- MB_Closure* closure = (MB_Closure*)MB_var_get(ms,
+ MB_Closure *closure = (MB_Closure *)MB_var_get(ms,
bca->higher_order_call.pred_var);
/*
** shift the input arguments to the right so we can insert the
@@ -1213,10 +1314,10 @@
*/
/* set the return address to the next instruction */
- MB_succip_set(ms, MB_ip_get(ms)+1);
+ MB_succip_set(ms, MB_ip_get(ms) + 1);
- /* set the new execution point*/
- MB_ip_set(ms, closure->code_adr);
+ /* set the new execution point */
+ MB_ip_set(ms, closure->code_addr);
#endif
}
/* --------------------------------------------------------------------------
*/
@@ -1241,12 +1342,13 @@
static MB_Word binop_ge (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
static MB_Word binop_bad (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
+
+typedef MB_Word (*MB_Instruction_Binop) (MB_Machine_State *,
+ const MB_Bytecode_Arg *);
/*
** XXX ORDER Currently we depend on the order of elements in the table.
*/
-static MB_Word (*binop_table[])(MB_Machine_State* ms,
- const MB_Bytecode_Arg* bca) =
-{
+static MB_Instruction_Binop binop_table[] = {
binop_add,
binop_sub,
binop_mul,
@@ -1287,7 +1389,7 @@
#define SIMPLEBINOP(name, op) \
static MB_Word \
- binop_##name(MB_Machine_State* ms, const MB_Bytecode_Arg* bca) \
+ binop_##name(MB_Machine_State *ms, const MB_Bytecode_Arg *bca) \
{ \
assert(bca->builtin_binop.arg1.id == MB_ARG_VAR); \
assert(bca->builtin_binop.arg2.id == MB_ARG_VAR); \
@@ -1318,7 +1420,7 @@
static MB_Word
-binop_bad(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+binop_bad(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("Unsupported binop\n");
return 0;
@@ -1327,7 +1429,7 @@
static void
-instr_builtin_binop(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_builtin_binop(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_Byte binop = bca->builtin_binop.binop;
if (binop < (sizeof(binop_table)/sizeof(binop_table[0]))) {
@@ -1342,7 +1444,7 @@
}
static void
-instr_builtin_bintest(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_builtin_bintest(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("builtin_bintest");
#if 0
@@ -1369,8 +1471,8 @@
/*
** XXX ORDER Currently we depend on the order of elements in the table
*/
-static MB_Word (*unop_table[])(MB_Machine_State* ms,
- const MB_Bytecode_Arg* bca) =
+static MB_Word (*unop_table[])(MB_Machine_State *ms,
+ const MB_Bytecode_Arg *bca) =
{
unop_bad, /* mktag */
unop_bad, /* tag */
@@ -1384,7 +1486,7 @@
#define SIMPLEUNOP(name, op) \
static MB_Word \
- unop_##name(MB_Machine_State* ms, const MB_Bytecode_Arg* bca) \
+ unop_##name(MB_Machine_State *ms, const MB_Bytecode_Arg *bca) \
{ \
assert(bca->builtin_unop.arg.id == MB_ARG_VAR); \
return op (MB_Integer) \
@@ -1395,14 +1497,14 @@
SIMPLEUNOP(not, !)
static MB_Word
-unop_bad(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+unop_bad(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("Unsupported unop\n");
return 0;
}
static void
-instr_builtin_unop(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_builtin_unop(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("builtin_unop");
#if 0
@@ -1425,7 +1527,7 @@
static void
-instr_builtin_untest(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_builtin_untest(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("builtin_untest");
#if 0
@@ -1435,7 +1537,7 @@
/* --------------------------------------------------------------------- */
static void
-instr_semidet_success(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_semidet_success(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("semidet_success");
#if 0
@@ -1446,7 +1548,7 @@
}
static void
-instr_semidet_success_check(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_semidet_success_check(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("semidet_success_check");
#if 0
@@ -1459,22 +1561,22 @@
}
static void
-instr_do_redo(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_do_redo(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("do_redo");
#if 0
- SAY("setting redo -> %d", MB_frame_max_get(ms, MB_FRAME_REDOIP));
+ MB_SAY("setting redo -> %d", MB_frame_max_get(ms, MB_FRAME_REDOIP));
MB_ip_set(ms, MB_frame_max_get(ms, MB_FRAME_REDOIP));
MB_curfr_set(ms, MB_frame_max_get(ms, MB_FRAME_REDOFR));
- SAY("checking func", MB_frame_max_get(ms, MB_FRAME_REDOIP));
- MB_func_type_check(ms);
- SAY("checked func", MB_frame_max_get(ms, MB_FRAME_REDOIP));
+ MB_SAY("checking proc", MB_frame_max_get(ms, MB_FRAME_REDOIP));
+ MB_proc_var_init(ms);
+ MB_SAY("checked proc", MB_frame_max_get(ms, MB_FRAME_REDOIP));
#endif
}
static void
-instr_do_fail(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_do_fail(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("do_fail");
#if 0
@@ -1484,14 +1586,14 @@
}
static void
-instr_noop(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_noop(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
/* increment instruction pointer */
- MB_ip_set(ms, MB_ip_get(ms)+1);
+ MB_ip_set(ms, MB_ip_get(ms) + 1);
}
static void
-instr_notdone(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_notdone(MB_Machine_State *ms, const MB_Bytecode_Arg *bca)
{
MB_fatal("notdone");
#if 0
@@ -1501,12 +1603,14 @@
#endif
}
-/* Execute the current instruction. Returns false if instruction could */
-/* not be executed */
+/*
+** Execute the current instruction. Returns false if instruction could
+** not be executed
+*/
static MB_Bool
-dispatch(MB_Byte bc_id, MB_Machine_State* ms)
+dispatch(MB_Byte bc_id, MB_Machine_State *ms)
{
- MB_Word* ip = MB_ip_get(ms);
+ MB_Bytecode_Addr ip = MB_ip_get(ms);
if (bc_id < sizeof(instruction_table) / sizeof(instruction_table[0])) {
instruction_table[bc_id](ms, MB_code_get_arg(ip));
@@ -1518,8 +1622,9 @@
/* Single step execute */
void
-MB_step(MB_Machine_State* ms)
+MB_step(MB_Machine_State *ms)
{
+ MB_fatal("Untested step");
#if 0
MB_Word ip = MB_ip_get(ms);
@@ -1532,8 +1637,9 @@
}
void
-MB_step_over(MB_Machine_State* ms)
+MB_step_over(MB_Machine_State *ms)
{
+ MB_fatal("Untested step_over");
#if 0
MB_Word ip = MB_ip_get(ms);
MB_Byte bc_id = MB_code_get_id(ms, ip);
@@ -1550,13 +1656,13 @@
/* an MB_BC_debug_trap and run until it halts */
/* then put things back to what they were */
MB_Byte old_id;
- assert(ip+1 < MB_code_size(ms));
- old_id = ms->code.id[ip+1];
+ assert(ip + 1 < MB_code_size(ms));
+ old_id = ms->code.id[ip + 1];
- ms->code.id[ip+1] = MB_BC_debug_trap;
+ ms->code.id[ip + 1] = MB_BC_debug_trap;
MB_run(ms);
- ms->code.id[ip+1] = old_id;
+ ms->code.id[ip + 1] = old_id;
break;
}
default:
@@ -1567,8 +1673,9 @@
/* Run until invalid instruction or debug_trap bytecode encountered */
void
-MB_run(MB_Machine_State* ms)
+MB_run(MB_Machine_State *ms)
{
+ MB_fatal("Untested run");
#if 0
do {
MB_Word ip = MB_ip_get(ms);
@@ -1587,24 +1694,27 @@
} while (1);
#endif
}
+
/* --------------------------------------------------------------------- */
void
-MB_machine_create(MB_Word* new_ip, MB_Machine_State* ms)
+MB_machine_create(MB_Machine_State *ms, MB_Bytecode_Addr new_ip,
+ MB_Word *initial_stack)
{
ms->ip = new_ip;
- MB_func_type_check(ms);
+ ms->initial_stack = initial_stack;
+ MB_proc_var_init(ms);
}
-MB_Word*
-MB_machine_exec(MB_Machine_State* ms)
+MB_Native_Addr
+MB_machine_exec(MB_Machine_State *ms)
{
char buffer[4];
MB_Word count = 0;
- SAY("Hello from machine_exec");
+ MB_SAY("Hello from machine_exec");
do {
- MB_Word* ip = MB_ip_get(ms);
+ MB_Bytecode_Addr ip = MB_ip_get(ms);
if (MB_ip_normal(ip)) {
@@ -1612,8 +1722,8 @@
#if 1
MB_show_state(ms, stdout);
- SAY("count: %d, execing %p", count++, ip);
- SAY("press enter to continue");
+ MB_SAY("count: %d, execing %p", count++, ip);
+ MB_SAY("press enter to continue");
fgets(buffer, sizeof(buffer), stdin);
#endif
@@ -1628,12 +1738,14 @@
return 0;
}
} else {
- switch ((MB_Word)ip) {
- case (MB_Word)MB_CODE_NATIVE_RETURN:
+ switch ((MB_Word) ip) {
+ case (MB_Word) MB_CODE_NATIVE_RETURN:
+ MB_SAY("Returning to a native state");
return MB_native_return_get(ms);
default:
+ MB_SAY("Address %08x", ip);
MB_fatal("Attempt to execute invalid"
- " address\n");
+ " address\n");
}
}
} while (1);
--- ../bytecode.posted/mb_machine_def.h Tue Jan 30 17:28:47 2001
+++ mb_machine_def.h Tue Jan 30 11:52:59 2001
@@ -10,30 +10,47 @@
#include "mb_stack.h"
-struct MB_Machine_State_Tag {
+struct MB_Machine_State_Struct {
- MB_Module* module;
- MB_Word* ip; /* next instruction pointer*/
+ MB_Module *module;
+ MB_Bytecode_Addr ip; /* next instruction pointer */
+
+ /*
+ ** The stack that the most ancestral bytecode function was using.
+ ** If a procedure finds that its stack frame is equal to this then
+ ** it knows it should return to native code rather than bytecode
+ */
+ MB_Word *initial_stack;
/* The native code address to return to at finish */
- MB_Word* native_return;
+ MB_Native_Addr native_return;
- /* The following proc information is all set by MB_func_type_check() */
+ /* The following proc information is all set by MB_proc_type_check() */
struct {
- /* The determinism of the currently executing function */
- /* (set to a return value from MB_code_get_det) */
+ /*
+ ** The determinism of the currently executing procedure
+ ** (set to a return value from MB_code_get_det)
+ */
MB_Word is_det;
- /* Pointer to vars for current procedure */
- MB_Word* var;
+ /*
+ ** Pointer to vars for current procedure
+ ** Points to variable 0 on either the det or nondet stack
+ ** (depending on current procedure).
+ */
+ MB_Word *var;
} cur_proc;
};
-#include <mercury_std.h>
+#include "mercury_std.h"
+
+#if 0
+
+/* When you redo this, try offsetof() instead */
#if (MR_VARIABLE_SIZED > 0)
# define MB_CLOSURE_SIZE(x) (sizeof(MB_Closure) \
- - sizeof(((MB_Closure*)(NULL))-> \
+ - sizeof(((MB_Closure *)(NULL))-> \
closure_hidden_args \
+ sizeof(MB_Word)*(x))
#else
@@ -41,9 +58,10 @@
+ sizeof(MB_Word)*(x))
#endif
typedef struct {
- MB_Word code_adr;
+ MB_Word code_addr;
MB_Word num_hidden_args;
MB_Word closure_hidden_args[MR_VARIABLE_SIZED];
} MB_Closure;
+#endif
#
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list