[m-dev.] For Review: Bytecode interpreter (full diff 2)
Levi Cameron
l.cameron2 at ugrad.unimelb.edu.au
Tue Jan 30 18:06:02 AEDT 2001
Full diff Part 2
Levi
l.cameron2 at ugrad.unimelb.edu.au
---------------------------------------------
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_interface.h Tue Jan 30 16:21:22 2001
@@ -0,0 +1,173 @@
+
+/*
+** Copyright (C) 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.
+**
+** Native-bytecode interface
+**
+*/
+
+#ifndef MB_INTERFACE_H
+#define MB_INTERFACE_H
+
+#include "mb_basetypes.h"
+#include "mb_module.h"
+#include "mb_util.h"
+
+typedef struct {
+ /* if cached_ip is NULL, this procedure hasn't been looked up yet */
+ MB_Bytecode_Addr cached_ip;
+
+ const char *module_name;
+ const char *pred_name;
+ MB_Word proc_num;
+ MB_Word arity;
+ MB_Bool is_func;
+} MB_Call;
+
+/*
+** Entry point for a native code call to det bytecode.
+** Returns native code address to return to
+*/
+MB_Native_Addr MB_bytecode_call_entry(MB_Call *bytecode_call);
+
+/*
+** Return to deterministic code after call to native code.
+** Returns native code address to return to.
+** Determines bytecode address to jump to by the contents of the
+** MB_DETFRAME_BC_SUCCIP det stack slot
+*/
+MB_Native_Addr MB_bytecode_return_det(void);
+
+/* Returns pointer to the stub that calls bytecode_return_det */
+MB_Native_Addr MB_native_get_return_det(void);
+
+/* Find the native code entry point for a procedure */
+MB_Native_Addr MB_code_find_proc_native(MB_CString_Const module,
+ MB_CString_Const pred, MB_Word proc,
+ MB_Word arity, MB_Bool is_func);
+
+/**************************************************************/
+/*
+** det stack
+**
+** Each normal det stack frame looks like the following:
+** sp-1: [succip]
+** sp-2: [var 0]
+** sp-3: [var 1]
+** ...
+** sp-n: [temp 0]
+** sp-n-1: [temp 1]
+** ...
+**
+** If model semidet, then temp 0 is the semidet success indicator
+*/
+
+/* saved succip */
+#define MB_DETFRAME_SUCCIP (1)
+
+/* fixed size of deterministic stack frame */
+#define MB_DETFRAME_SIZE (1)
+
+/*
+**
+** An interface det stack frame is pushed when bytecode wishes
+** to jump to native code and later return to bytecode. succip
+** will have been set to a stub that reads the interface stack
+** frame and directs control appropriately
+** sp-1: [succip in bytecode to return to]
+** sp-2: [initial frame]
+**
+** The initial frame field is used to determine whether a procedure should
+** return to bytecode or native code when it reaches endof_proc. If it reaches
+** an endof_proc instruction and after removing its stack frame finds that the
+** (det or nondet) stack pointer is equal to the initial frame it knows that
+** it is the most ancestral called procedure and should return to native code
+**
+*/
+
+/* bytecode return address for stub */
+#define MB_DETFRAME_INTERFACE_BC_SUCCIP (1)
+#define MB_DETFRAME_INTERFACE_INITIAL_FRAME (2)
+
+/* Size of a deterministic interface frame */
+#define MB_DETFRAME_INTERFACE_SIZE (2)
+
+/*
+** Nondet stack
+**
+** An ordinary stack frame looks like so:
+** curfr[ 0] prevfr
+** curfr[-1] redoip
+** curfr[-2] redofr
+** curfr[-3] succip
+** curfr[-4] succfr
+** then follows var[0] to var[n]
+** then follows temp[0] to temp[n]
+**
+*/
+#define MB_FRAME_PREVFR (0)
+#define MB_FRAME_REDOIP (1)
+#define MB_FRAME_REDOFR (2)
+
+#define MB_FRAME_DETFR (3)
+
+#define MB_FRAME_SUCCIP (3)
+#define MB_FRAME_SUCCFR (4)
+
+/* size of normal nondet stack frame */
+#define MB_FRAME_SIZE 5
+
+/* size of temp nondet stack frame created by model det/semidet code */
+#define MB_FRAME_TEMP_DET_SIZE 4
+
+/* size of temp nondet stack frame created by model nondet code */
+#define MB_FRAME_TEMP_SIZE 3
+
+/* Invalid frame address */
+#define MB_FRAME_INVALID ((MB_Word) (-1))
+
+/*
+** semidet success flags: stored in a temp slot until the procedure
+** returns, when it is returned in a register
+*/
+#define MB_SEMIDET_SUCCESS TRUE
+#define MB_SEMIDET_FAILURE FALSE
+
+#define MB_SEMIDET_SUCCESS_REG 1
+#define MB_SEMIDET_SUCCESS_SLOT 0
+
+/**************************************************************/
+/* register definitions */
+#define MB_reg(n) MR_virtual_reg(n)
+#define MB_succip MR_virtual_succip
+#define MB_sp MR_virtual_sp
+#define MB_curfr MR_virtual_curfr
+#define MB_maxfr MR_virtual_maxfr
+
+/* Det stack: 1 is the top (used - slot 0 is unused) */
+#define MB_stackitem(x) ((MB_sp)[-(x)])
+
+/* Nondet stack - same as with det statck */
+#define MB_frameitem(x) ((MB_maxfr)[-(x)])
+
+#define MB_incr_sp(x) ( \
+ MB_sp += (x), \
+ (void)0 \
+ )
+
+#define MB_decr_sp(x) MB_incr_sp(-(x))
+
+/**************************************************************/
+/* tags */
+#include "mercury_tags.h"
+#define MB_mktag(t) MR_mktag(t)
+#define MB_mkbody(b) MR_mkbody(b)
+#define MB_tag(t) MR_tag(t)
+#define MB_body(w,t) MR_body(w,t)
+#define MB_mkword(t,b) MR_mkword(t,b)
+#define MB_strip_tag(w) MR_strip_tag(w)
+
+
+#endif /* MB_INTERFACE_H */
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_interface.c Tue Jan 30 17:04:16 2001
@@ -0,0 +1,189 @@
+
+/*
+** Copyright (C) 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.
+**
+*/
+
+
+#include "mercury_imp.h"
+#include "mercury_regs.h"
+#include "mercury_trace.h"
+#include "mercury_trace_tables.h"
+
+#include "mb_interface.h"
+#include "mb_module.h"
+#include "mb_machine.h"
+
+/* Exported definitions */
+
+/* Local declarations */
+
+/* Implementation */
+
+MR_declare_entry(MB_native_return_det_stub);
+
+MB_Native_Addr
+MB_native_get_return_det(void)
+{
+ return (MB_Native_Addr) MR_ENTRY(MB_native_return_det_stub);
+}
+
+
+/* Search for the native code address of a procedure */
+MB_Native_Addr
+MB_code_find_proc_native(MB_CString_Const module, MB_CString_Const pred,
+ MB_Word proc, MB_Word arity, MB_Bool is_func)
+{
+ MR_Matches_Info matches;
+ MR_Proc_Spec spec;
+
+ MR_register_all_modules_and_procs(stderr, TRUE);
+ MB_SAY("\n");
+
+ spec.MR_proc_module = module;
+ spec.MR_proc_name = pred;
+ spec.MR_proc_arity = arity;
+ spec.MR_proc_mode = proc;
+ spec.MR_proc_pf = (is_func) ? MR_FUNCTION : MR_PREDICATE;
+
+ MB_SAY("Looking for procedures .... ");
+ matches = MR_search_for_matching_procedures(&spec);
+
+ {
+ MB_Word i;
+ for (i = 0; i < matches.match_proc_next; i++) {
+ MB_SAY("Match %d: %s %s__%s/%d (%d)",
+ i,
+ (matches.match_procs[i]
+ ->MR_sle_proc_id.MR_proc_user
+ .MR_user_pred_or_func == MR_PREDICATE) ?
+ "pred" : "func",
+ matches.match_procs[i]
+ ->MR_sle_proc_id.MR_proc_user
+ .MR_user_def_module,
+ matches.match_procs[i]
+ ->MR_sle_proc_id.MR_proc_user
+ .MR_user_name,
+ matches.match_procs[i]
+ ->MR_sle_proc_id.MR_proc_user
+ .MR_user_arity,
+ matches.match_procs[i]
+ ->MR_sle_proc_id.MR_proc_user
+ .MR_user_mode
+ );
+ }
+ }
+
+ switch (matches.match_proc_next) {
+ case 0:
+ return NULL;
+ case 1:
+ {
+ MB_Native_Addr addr = (MB_Native_Addr)
+ matches.match_procs[0]->
+ MR_sle_traversal.MR_trav_code_addr;
+ MB_SAY("Adr %08x", addr);
+ }
+ return (MB_Native_Addr)matches.match_procs[0]->
+ MR_sle_traversal.MR_trav_code_addr;
+ default:
+ MB_fatal("More than one native code entry found!");
+ return NULL;
+ }
+}
+
+/*
+** A native code procedure wishes to call a deterministic bytecode procedure
+*/
+
+/*
+** Needed to instantiate MB_Machine_State. Not #included above because nothing
+** else in this module should need to know what is inside an MB_Machine_State
+*/
+#include "mb_machine_def.h"
+
+MB_Native_Addr
+MB_bytecode_call_entry(MB_Call *bytecode_call)
+{
+
+ MB_Native_Addr native_ip;
+ MB_Bytecode_Addr bc_ip;
+ MB_SAY("Det stack is at %08x", MB_sp);
+
+ MB_SAY("\n\nHello from bytecode_entry_det");
+
+ if ((void *) bytecode_call->cached_ip == NULL) {
+ bc_ip = MB_code_find_proc(bytecode_call->module_name,
+ bytecode_call->pred_name,
+ bytecode_call->proc_num,
+ bytecode_call->arity,
+ bytecode_call->is_func);
+ } else {
+ bc_ip = bytecode_call->cached_ip;
+ }
+ if (bc_ip == MB_CODE_INVALID_ADR) {
+ MB_util_error("Attempting to call bytecode %s %s__%s/%d (%d):",
+ bytecode_call->is_func ? "func" : "pred",
+ bytecode_call->module_name,
+ bytecode_call->pred_name,
+ bytecode_call->arity,
+ bytecode_call->proc_num);
+ MB_fatal("Unable to find procedure\n"
+ "(Is the native code and the bytecode consistent?)");
+ }
+
+ MB_SAY(" bytecode addr %08x", bc_ip);
+
+ {
+ /* Create a new machine and start executing */
+ MB_Machine_State ms;
+ MB_machine_create(&ms, bc_ip, NULL);
+
+ MB_SAY("ZZZ ENTERING BYTECODE");
+ MB_show_state(&ms, stderr);
+
+ native_ip = MB_machine_exec(&ms);
+
+ MB_SAY("ZZZ RETURNING TO NATIVE1");
+ MB_show_state(&ms, stderr);
+ }
+
+ return native_ip;
+}
+
+/*
+** This is the reentry point after a det bytecode procedure has called
+** native code. See mb_interface.h for a description of how this occurs
+*/
+MB_Native_Addr
+MB_bytecode_return_det(void)
+{
+ /* Get the bytecode reentry address */
+ MB_Bytecode_Addr ip = (MB_Bytecode_Addr)
+ MB_stackitem(MB_DETFRAME_INTERFACE_BC_SUCCIP);
+ /* Get the initial stack frame */
+ MB_Word *initial_frame = (MB_Word *)
+ MB_stackitem(MB_DETFRAME_INTERFACE_INITIAL_FRAME);
+
+ MB_Native_Addr ret_ip;
+
+ MB_Machine_State ms;
+
+ MB_decr_sp(MB_DETFRAME_INTERFACE_SIZE);
+
+ MB_machine_create(&ms, ip, initial_frame);
+
+ MB_SAY("ZZZ RETURNING TO BYTECODE");
+ MB_show_state(&ms, stderr);
+
+ ret_ip = MB_machine_exec(&ms);
+
+ MB_SAY("ZZZ RETURNING TO NATIVE2");
+ MB_show_state(&ms, stderr);
+
+ return ret_ip;
+
+}
+
--- ../bytecode.old/mb_machine_show.h Wed Jan 24 18:42:27 2001
+++ mb_machine_show.h Thu Jan 25 16:20:53 2001
@@ -1,16 +1,13 @@
/*
-** Copyright (C) 1997 The University of Melbourne.
+** Copyright (C) 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.
**
-** $Id: mb_machine_show.h,v 1.1 2001/01/24 07:42:27 lpcam Exp $
-**
-** Abstract mercury machine
+** Module to display the state of the mercury machine
**
*/
-
#ifndef MB_MACHINE_SHOW_H
#define MB_MACHINE_SHOW_H
@@ -19,11 +16,10 @@
#include "mb_machine.h"
/* 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);
#endif /* MB_MACHINE_SHOW_H */
-
--- ../bytecode.old/mb_machine_show.c Wed Jan 24 18:42:26 2001
+++ mb_machine_show.c Tue Jan 30 17:00:43 2001
@@ -1,304 +1,130 @@
/*
-** Copyright (C) 2000 The University of Melbourne.
+** Copyright (C) 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.
**
-** $Id: mb_machine_show.c,v 1.1 2001/01/24 07:42:26 lpcam Exp $
*/
+#include "mercury_imp.h"
+
/* Imports */
#include <stdio.h>
#include <assert.h>
#include "mb_stack.h"
#include "mb_disasm.h"
+#include "mb_interface.h"
+#include "mb_machine.h"
+#include "mb_machine_def.h"
#include "mb_machine_show.h"
/* Exported definitions */
-
-void MB_show_state(MB_Machine_State* ms, FILE* fp);
-void MB_show_call(MB_Machine_State* ms, FILE* fp);
+void MB_show_state(MB_Machine_State *ms, FILE *fp);
/* Local declarations */
-static char
-rcs_id[] = "$Id: mb_machine_show.c,v 1.1 2001/01/24 07:42:26 lpcam Exp $";
+#define NREGS 14
+#define NSTACK 8
-#define NREGS 5
-#define NSTACK 10
-typedef struct {
- char reg_name[NREGS][10+1];
- char reg[NREGS][8+1];
-
- char succip[9+1];
- char succip_str[25+1];
-
- char detsp[8+1];
- char det_name[NSTACK][10+1];
- char det[NSTACK][8+1];
- char det_str[NSTACK][16+1];
-
- char nondetsp[8+1];
- char nondet_name[NSTACK][10+1];
- char nondet[NSTACK][8+1];
- char nondet_str[NSTACK][10+1];
-} MB_View_Vars; /* structure containing variable names & values for output */
-
-static void pad_space(char* buffer, MB_Word len);
-static MB_View_Vars vars_state(MB_Machine_State* ms);
-
-/* appends spaces to the end of a string so that a buffer is filled (includes
null) */
-static void
-pad_space(char* buffer, MB_Word len)
+
+/* Display the current state of the machine */
+#define LINE_LEN 78 /* XXX: make this adjustable */
+void
+MB_show_state(MB_Machine_State *ms, FILE *fp)
{
- if (buffer == NULL && len == 0) return;
-
- assert(buffer != NULL);
-
- /* find the null terminator */
- while (len > 0) {
- if (*buffer == 0) break;
- buffer++;
- len--;
- }
+ char buffer[LINE_LEN];
+ MB_Bytecode_Addr ip = MB_ip_get(ms);
- while (len > 1) {
- buffer++[0] = ' ';
- len--;
- }
+ /* Work out what predicate & proc we are in */
+ MB_Bytecode_Addr cur_pred;
+ MB_Bytecode_Addr cur_proc;
- *buffer = 0;
-}
+ if (fp == NULL) return;
-/* Returns a structure containing formatted strings with
-** various state variables in (so it is easier to print
-** multiple columns on stdout)
-*/
+ fprintf(fp, "----------------------------------------"
+ "------------------------------------\n");
-static MB_View_Vars
-vars_state(MB_Machine_State* ms)
-{
- MB_View_Vars vars;
- MB_Word ip = MB_ip_get(ms);
- MB_Bytecode cur_proc = MB_code_get_proc(ms, ip);
+ if (MB_code_range_clamp(ip) == ip) {
+ /* Show what predicate we are in */
+ cur_pred = MB_code_get_pred_addr(ip);
+ cur_proc = MB_code_get_proc_addr(ip);
- /* display the succip */
- {
- MB_Word succip = MB_succip_get(ms);
- MB_Bytecode succ_pred = MB_code_get_pred(ms, succip);
- if (succip == MB_CODE_INVALID_ADR) {
- snprintf(vars.succip, sizeof(vars.succip),
- "(invalid)");
- snprintf(vars.succip_str, sizeof(vars.succip_str),
- " ");
- } else {
- snprintf(vars.succip, sizeof(vars.succip),
- "%08x",
- (int)succip);
- snprintf(vars.succip_str, sizeof(vars.succip_str),
- "(%s/%d)",
- succ_pred.opt.enter_pred.pred_name,
- (int)succ_pred.opt.enter_pred.pred_arity);
- }
- }
+ MB_str_bytecode(ms, cur_pred, buffer, sizeof(buffer), 0);
+ fprintf(fp, "%s\n", buffer);
- /* display the register variables */
- {
- MB_Word j;
+ MB_str_bytecode(ms, cur_proc, buffer, sizeof(buffer), 1);
+ fprintf(fp, "%s\n", buffer);
- for (j = 0; j < NREGS; j++) {
- snprintf(vars.reg_name[j], sizeof(vars.reg_name[j]),
- "reg[%02x]",
- (int)j);
- snprintf(vars.reg[j], sizeof(vars.reg[j]),
- "%08x",
- (int)MB_reg_get(ms, j));
- }
- }
+ fprintf(fp, "\n");
- /* display the det stack */
- {
- MB_Word j;
+ fprintf(fp, "ip: %p\n", ip);
- snprintf(vars.detsp, sizeof(vars.detsp),
- "%08x",
- (int)MB_stack_size(&ms->det.stack));
- /* display only the local variables on the stack */
- if (MB_code_get_id(ms, ip) != MB_BC_enter_proc) {
- for (j = 0;
- (j < cur_proc.opt.enter_proc.list_length) &&
- (j < NSTACK);
- j++)
- {
- snprintf(vars.det_name[j], sizeof(vars.det_name[j]),
- "detstack[%1x]",
- (int)j);
- snprintf(vars.det[j], sizeof(vars.det[j]),
- "%08x",
- (int)MB_var_get(ms, j));
- snprintf(vars.det_str[j], sizeof(vars.det_name[j]),
- "%s",
- cur_proc.opt.enter_proc.var_info_list[j]);
- }
+ /* show the surrounding lines of code */
+ MB_listing(ms, fp, ip - 2, ip + 4, LINE_LEN);
+ } else {
+ if (MB_ip_special(ip)) {
+ fprintf(fp, " Special execution address (%p)\n", ip);
} else {
- j = 0;
- }
-
- /* fill the rest with blanks*/
- for (; j < NSTACK; j++) {
- snprintf(vars.det_name[j], sizeof(vars.det_name[j]), " ");
- snprintf(vars.det[j], sizeof(vars.det[j]), " ");
- snprintf(vars.det_str[j], sizeof(vars.det_name[j]), " ");
+ fprintf(fp, " Invalid execution address\n");
}
}
- /* display the nondet stack */
- {
- MB_Word j;
- snprintf(vars.nondetsp, sizeof(vars.nondetsp),
- "%08x",
- ms->nondet.curfr);
- for (j = 0;
- (j < NSTACK) &&
- ((ms->nondet.curfr+j) < MB_stack_size(&ms->nondet.stack));
- j++)
- {
- snprintf(vars.nondet_name[j], sizeof(vars.nondet_name[j]),
- "nondet[%1x]",
- (int)j);
-
- snprintf(vars.nondet[j], sizeof(vars.nondet[j]),
- "%08x",
- (int)MB_frame_get(ms, j));
-
- snprintf(vars.nondet_str[j], sizeof(vars.nondet_name[j]),
- "%s",
- ( (j == MB_FRAME_PREVFR) ? "prevfr" :
- (j == MB_FRAME_REDOIP) ? "redoip" :
- (j == MB_FRAME_REDOFR) ? "redofr" :
- (j == MB_FRAME_SUCCIP) ? "[succip?]" :
- (j == MB_FRAME_SUCCFR) ? "[succfr?]" :
- " ")
- );
- }
- /* fill the rest with blanks */
- for (; j < NSTACK; j++) {
- snprintf(vars.nondet_name[j], sizeof(vars.nondet_name[j]), " ");
- snprintf(vars.nondet[j], sizeof(vars.nondet[j]), " ");
- snprintf(vars.nondet_str[j], sizeof(vars.nondet_name[j]), " ");
- }
- }
- /* pad with spaces */
+ fprintf(fp, "\n");
+
{
- #define PAD(x) pad_space(vars.##x, sizeof(vars.##x))
- MB_Word i;
-
+ int i;
+
+ /* Show the registers */
for (i = 0; i < NREGS; i++) {
- PAD(reg_name[i]);
- PAD(reg[i]);
+ int j = i / 2 +
+ ((i & 1) ? (NREGS / 2) : 0);
+ fprintf(fp, "reg[%02d] = " MB_FMT_INT" ("MB_FMT_HEX ") ",
+ j, MB_reg(j), MB_reg(j));
+ if (i & 1) {
+ fprintf(fp, "\n");
+ }
+ }
+ if (!(i & 1)) {
+ fprintf(fp, "\n");
}
- PAD(succip);
- PAD(succip_str);
+ fprintf(fp, "\n");
- PAD(detsp);
- PAD(nondetsp);
- for (i = 0; i < NSTACK; i++) {
- PAD(det_name[i]);
- PAD(det[i]);
- PAD(det_str[i]);
- PAD(nondet_name[i]);
- PAD(nondet[i]);
- PAD(nondet_str[i]);
+ /* Show the machine state */
+ fprintf(fp, " succip = " MB_FMT_HEX " "
+ " 0 = " MB_FMT_HEX "\n",
+ (MB_Unsigned) MB_succip,
+ (MB_Unsigned) 0);
+
+ fprintf(fp, " init_frame = " MB_FMT_HEX " "
+ " natv_retun = " MB_FMT_HEX "\n",
+ (MB_Unsigned) ms->initial_stack,
+ (MB_Unsigned) ms->native_return);
+
+ /* Show the stack */
+ fprintf(fp, "\n");
+
+ fprintf(fp, " sp = " MB_FMT_HEX " "
+ " maxfr = " MB_FMT_HEX "\n",
+ (MB_Unsigned) MB_sp,
+ (MB_Unsigned) MB_maxfr);
+ for (i = 1; i < NSTACK; i++) {
+ fprintf(fp, "%cdet[%02d] = " MB_FMT_INT
+ " (" MB_FMT_HEX ") "
+ "%cnondet[%02d] = " MB_FMT_INT
+ " (" MB_FMT_HEX ")\n",
+ (&MB_stackitem(i) == ms->cur_proc.var) ?
+ '>' : ' ',
+ (int) i, MB_stackitem(i), MB_stackitem(i),
+ (&MB_frameitem(i) == ms->cur_proc.var) ?
+ '>' : ' ',
+ (int) i, MB_frameitem(i), MB_frameitem(i));
}
}
- return vars;
-}
-
-/* Display the current state of the machine */
-void
-MB_show_state(MB_Machine_State* ms, FILE* fp)
-{
- char buffer[78];
- MB_Word ip = MB_ip_get(ms);
-
- /* Work out what predicate & proc we are in */
- MB_Bytecode cur_pred = MB_code_get_pred(ms, ip);
- MB_Bytecode cur_proc = MB_code_get_proc(ms, ip);
-
- /* Show the call stack */
- MB_show_call(ms, fp);
-
- fprintf(fp,
"----------------------------------------------------------------------------\n");
- if (ip >= MB_code_size(ms) || ip < 0) {
- fprintf(fp, " Invalid execution address\n");
- return;
- }
-
- /* Show what predicate we are in */
- MB_str_bytecode(cur_pred, buffer, sizeof(buffer), 0);
- fprintf(fp, "%s\n", buffer);
-
- MB_str_bytecode(cur_proc, buffer, sizeof(buffer), 1);
- fprintf(fp, "%s\n", buffer);
-
- fprintf(fp, "\n");
-
- /* show the surrounding lines of code */
- MB_listing(ms, fp, ip-2, ip+4);
fprintf(fp, "\n");
- /* Print variables */
- {
- MB_View_Vars vars = vars_state(ms);
- MB_Word j;
-
- fprintf(fp, " succip %s %s\n", vars.succip, vars.succip_str);
-
- for (j = 0; j < NREGS; j++) {
- fprintf(fp, " %s %s \n",
- vars.reg_name[j],
- vars.reg[j]
- );
- }
-
-
- fprintf(fp, " det.sp %s curfr %s\n",
- vars.detsp, vars.nondetsp);
- for (j = 0; j < NSTACK; j++) {
- fprintf(fp, " %s %s %s %s %s %s\n",
- vars.det_name[j],
- vars.det[j],
- vars.det_str[j],
- vars.nondet_name[j],
- vars.nondet[j],
- vars.nondet_str[j]);
- }
- }
- fprintf(fp, "\n");
} /* MB_show_state */
-
-/* Display the call stack of the machine */
-void
-MB_show_call(MB_Machine_State* ms, FILE* fp)
-{
- char buffer[76];
- MB_Word i;
- MB_Word num_calls = MB_stack_size(&ms->call.stack);
- fprintf(fp, "Call stack: \n");
- for (i = 0; i < num_calls; i++) {
- MB_Bytecode bc = MB_code_get_pred(ms, MB_stack_peek(&ms->call.stack, i));
- MB_str_bytecode(bc, buffer, sizeof(buffer), 0);
- fprintf(fp, "%2x %s\n", i, buffer);
-
- bc = MB_code_get(ms, MB_stack_peek(&ms->call.stack, i));
- MB_str_bytecode(bc, buffer, sizeof(buffer), 0);
- fprintf(fp, " %s\n", buffer);
- }
-
-}
-
--- ../bytecode.old/mb_mem.h Wed Jan 24 18:42:28 2001
+++ mb_mem.h Mon Jan 29 18:16:42 2001
@@ -1,41 +1,77 @@
/*
-** Copyright (C) 2000 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.
**
-** $$
-**
** This file provides basic memory management interfaces
**
*/
-
#ifndef MB_MEM_H
#define MB_MEM_H
#include <stdlib.h>
+#include "mb_basetypes.h"
+
/*
** Do not use MB_malloc() or MB_realloc() directly, unless you want
** to allocate raw memory. Normally you should use the macros
-** MB_new(), MB_new_array(), and MB_resize_array() instead.
+** MB_NEW(), MB_NEW_ARRAY(), and MB_RESIZE_ARRAY() instead.
+**
+** None of these are garbage collected and are invisible to the garbage
+** collector
*/
-void*
-MB_malloc(size_t size);
+/*
+** These should not be used for small allocations; guard bytes are added
+** for checking. The garbage collected versions are faster for small
+** allocations
+*/
+void* MB_malloc(size_t size);
-void*
-MB_realloc(void* mem, size_t size);
+void* MB_realloc(void* mem, size_t size);
-void
-MB_free(void *mem);
+void MB_free(void *mem);
-#define MB_new(type) ((type *) MB_malloc(sizeof(type)))
-#define MB_new_array(type, num) ((type *) MB_malloc((num) * sizeof(type)))
-#define MB_resize_array(array, type, num) \
+#define MB_NEW(type) ((type *) MB_malloc(sizeof(type)))
+#define MB_NEW_ARRAY(type, num) ((type *) MB_malloc((num) * sizeof(type)))
+#define MB_RESIZE_ARRAY(array, type, num) \
((type *) MB_realloc((array), (num) * sizeof(type)))
+/*
+** Garbage collected versions of the above
+** Uses Hans Boehm's conservative garbage collector
+*/
+
+/* Atomic == doesn't contain any pointers */
+
+void* MB_GC_malloc(size_t size);
+
+void* MB_GC_malloc_atomic(size_t size);
+
+/* works for both atomic and nonatomic memory */
+void* MB_GC_realloc(void* mem, size_t size);
+
+void MB_GC_free(void *mem);
+
+#define MB_GC_NEW(type) \
+ ((type *) MB_GC_malloc(sizeof(type)))
+
+#define MB_GC_NEW_ATOMIC(type) \
+ ((type *) MB_GC_malloc_atomic(sizeof(type)))
+
+#define MB_GC_NEW_ARRAY(type, num) \
+ ((type *) MB_GC_malloc((num) * sizeof(type)))
+
+#define MB_GC_NEW_ARRAY_ATOMIC(type, num) \
+ ((type *) MB_GC_malloc((num) * sizeof(type)))
+
+/* works for both atomic and nonatomic memory */
+#define MB_GC_RESIZE_ARRAY(array, type, num) \
+ ((type *) MB_GC_realloc((array), (num) * sizeof(type)))
#endif /* MB_MEM_H */
+
--- ../bytecode.old/mb_mem.c Wed Jan 24 18:42:28 2001
+++ mb_mem.c Tue Jan 30 11:48:42 2001
@@ -1,15 +1,15 @@
/*
-** Copyright (C) 1997 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.
**
-** $Id:"
*/
/* Imports */
#include <stdlib.h>
#include <string.h>
+#include "mercury_tags.h"
#include "mb_mem.h"
#include "mb_util.h"
@@ -18,9 +18,6 @@
/* Local declarations */
-static char
-rcs_id[] = "$Id:";
-
/* Implementation */
/*
@@ -32,7 +29,13 @@
/* Implementation */
-void*
+#ifndef MB_NO_GC
+
+#include "gc.h"
+
+#endif
+
+void *
MB_malloc(size_t size)
{
size_t real_size;
@@ -81,10 +84,12 @@
return;
}
-void*
+void *
MB_realloc(void *mem, size_t size)
{
+ return realloc(mem, size);
+#if 0
void *new_mem;
/*
@@ -102,7 +107,56 @@
MB_free(mem);
return new_mem;
+#endif
+}
+
+/* ------------------------------------------------------------------------- */
+
+#ifndef MB_NO_GC
+
+void *
+MB_GC_malloc(size_t size)
+{
+ return GC_malloc(size);
+}
+
+void *
+MB_GC_malloc_atomic(size_t size)
+{
+ return GC_malloc_atomic(size);
+}
+
+void
+MB_GC_free(void *mem)
+{
+ GC_free(mem);
+}
+
+void *
+MB_GC_realloc(void *mem, size_t size)
+{
+ return GC_realloc(mem, size);
+}
+
+#else /* MB_NO_GC */
+
+void *
+MB_GC_malloc(size_t size, MB_Bool atomic)
+{
+ return MB_malloc(size);
}
+void
+MB_GC_free(void *mem)
+{
+ MB_free(mem);
+}
+
+void *
+MB_GC_realloc(void *mem, size_t size)
+{
+ return MB_realloc(mem, size);
+}
+#endif /* MB_NO_GC */
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_module.h Tue Jan 30 16:54:00 2001
@@ -0,0 +1,101 @@
+
+/*
+** Copyright (C) 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.
+**
+** Code module
+**
+*/
+
+#ifndef MB_MODULE_H
+#define MB_MODULE_H
+
+#include <limits.h>
+
+#include "mb_bytecode.h"
+#include "mb_util.h"
+
+struct MB_Module_Struct;
+typedef struct MB_Module_Struct MB_Module;
+
+/*
+** Special code addresses. INVALID_ADR must be last as the asserts
+** assume that any address above INVALID_ADR is a special code
+**
+** If you alter these, ensure MB_ip_special reflects this
+*/
+#define MB_CODE_DO_FAIL ((MB_Bytecode_Addr) (-1))
+#define MB_CODE_DO_REDO ((MB_Bytecode_Addr) (-2))
+#define MB_CODE_NATIVE_RETURN ((MB_Bytecode_Addr) (-3))
+#define MB_CODE_INVALID_ADR ((MB_Bytecode_Addr) (-4))
+
+/* Ensure a module is loaded */
+MB_Module *MB_module_load_name(MB_CString_Const module_name);
+MB_Module *MB_module_load(MB_CString_Const module_name, FILE *fp);
+/* Unload a module */
+void MB_module_unload(MB_Module *module);
+
+/*
+** Returns a pointer to a given module.
+** If the module is not loaded, loads it.
+*/
+MB_Module *MB_module_get(MB_CString_Const module_name);
+
+/* Return the number of bytecodes loaded so far */
+MB_Unsigned MB_code_size(void);
+
+/* Return the bytecode id of the bytecode at a given address */
+MB_Byte MB_code_get_id(MB_Bytecode_Addr addr);
+
+/* Get the procedure model that a bytecode at a given address is in */
+#define MB_ISDET_NO 0 /* nondet */
+#define MB_ISDET_YES 1 /* det, semidet */
+MB_Byte MB_code_get_det(MB_Bytecode_Addr addr);
+
+/* Get the bytecode argument at a given address */
+MB_Bytecode_Arg *MB_code_get_arg(MB_Bytecode_Addr addr);
+
+/* Get the predicate in which the following address resides */
+MB_Bytecode_Addr MB_code_get_pred_addr(MB_Bytecode_Addr addr);
+
+/* Get the procedure in which the following address resides */
+MB_Bytecode_Addr MB_code_get_proc_addr(MB_Bytecode_Addr addr);
+
+MB_Bytecode_Addr MB_code_find_proc(MB_CString_Const module,
+ MB_CString_Const pred,
+ MB_Word proc,
+ MB_Word arity,
+ MB_Bool is_func);
+
+/* Returns a code address clipped into the valid code range */
+MB_Bytecode_Addr MB_code_range_clamp(MB_Bytecode_Addr addr);
+
+/* True if the code address is 'normal' (not invalid or one of MB_CODE_xxx) */
+MB_Bool MB_ip_normal(MB_Bytecode_Addr ip);
+
+/* True if the code address is one of MB_CODE_xxx */
+MB_Bool MB_ip_special(MB_Bytecode_Addr ip);
+
+/* True if a native code address */
+MB_Bool MB_ip_native(MB_Bytecode_Addr ip);
+
+/* Allocate memory in the code argument data array */
+#define MB_CODE_DATA_ALLOC(type, number) \
+ ((type *) (MB_code_data_alloc_words(MB_NUMBLOCKS(sizeof(type)*(number),
sizeof(MB_Word)))))
+
+MB_Word *MB_code_data_alloc_words(MB_Word num_words);
+
+/*
+** This is only here so pointer arithmetic will work; you shold never need
+** to use any of these fields: the MB_BCID_xxx wrappers in mb_module.c are
+** the only things that should use them
+*/
+struct MB_BCId_Struct {
+ MB_Unsigned id : 7;
+ MB_Unsigned is_det : 1;
+ MB_Unsigned arg : MB_WORD_BITS - (7 + 1);
+};
+
+#endif /* MB_MODULE_H */
+
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_module.c Tue Jan 30 16:57:16 2001
@@ -0,0 +1,937 @@
+/*
+** Copyright (C) 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.
+**
+*/
+
+/*
+#include "mercury_layout_util.h"
+#include "mercury_array_macros.h"
+#include "mercury_getopt.h"
+
+#include "mercury_trace.h"
+#include "mercury_trace_internal.h"
+#include "mercury_trace_declarative.h"
+#include "mercury_trace_alias.h"
+#include "mercury_trace_help.h"
+#include "mercury_trace_browse.h"
+#include "mercury_trace_spy.h"
+#include "mercury_trace_tables.h"
+#include "mercury_trace_util.h"
+#include "mercury_trace_vars.h"
+#include "mercury_trace_readline.h"
+*/
+
+#include "mb_module.h"
+#include "mb_interface.h"
+
+#include <assert.h>
+#include <string.h>
+#include "mb_mem.h"
+
+/* 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 */
+
+
+/* Local declarations */
+
+/*
+** The bytecodes consist of a sequence of words with each containing the
+** bytecode and an index into the code_arg_data array, the data at that
+** index being the argument for the bytecode
+**
+** The bytecode id is just a byte with the uppermost bit being used to
+** indicate whether the code executing is in a nondet or det procedure
+** (this is needed to work out which stack the var list is on)
+**
+** If you change this, ensure the bytecodes in mb_bytecode.h will
+** still fit in the number of bits allocated to an id
+**
+** 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 */
+#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 *) \
+ (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_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_Struct {
+ /* XXX: Hash the module & predicate names */
+ /* The name of the module */
+ MB_CString module_name;
+
+ /*
+ ** The following should not be directly accessed unless
+ ** absolutely necessary; use one of the (many) wrapper functions
+ */
+
+ /*
+ ** The code indices of all the predicates in this module
+ ** If this is empty, then it means we tried to load
+ ** the module but we couldn't find bytecodes for it
+ */
+ /* XXX: This really should be hashed too */
+ MB_Stack pred_index_stack;
+
+};
+
+/* 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_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_order(pred_const) bytecodes
+** Returns TRUE if successful
+*/
+static MB_Bool
+translate_calls(MB_Bytecode_Addr bc, MB_Unsigned number_codes)
+{
+ /*
+ ** 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_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_Bool is_func;
+ MB_Word mode_num;
+ /* location to store the proc to be called */
+ 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_name;
+ arity = call_arg->call.arity;
+ is_func = call_arg->call.is_func;
+ 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_code_get_arg(bc);
+ if (construct_arg->construct.consid.id ==
+ MB_CONSID_PRED_CONST)
+ {
+ MB_fatal("Unable to translate predicate constructs");
+ #if 0
+ module_name = construct_arg->construct.
+ 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_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) {
+ MB_SAY("Looking for %s %s__%s/%d mode %d",
+ (is_func) ? "func" : "pred",
+ module_name,
+ pred_name,
+ arity,
+ mode_num);
+ }
+
+ /* Find the predicate start */
+ if (pred_name != NULL) {
+ /* First check if we can find it in the bytecode */
+ MB_Bytecode_Addr bc_addr = MB_code_find_proc(module_name,
+ pred_name, mode_num,
+ arity, is_func);
+
+ if (bc_addr == MB_CODE_INVALID_ADR) {
+ /* Otherwise look in the native code */
+ 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");
+
+ MB_SAY(" Address from native: %08x"
+ , native_addr);
+
+ if (native_addr == NULL) {
+ MB_util_error(
+ "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) mode_num);
+ MB_util_error("Are you sure the module"
+ " was compiled with trace"
+ " information enabled?");
+ }
+ target_addr->is_native = TRUE;
+ target_addr->addr.native = native_addr;
+ } else {
+ target_addr->is_native = FALSE;
+ target_addr->addr.bc = bc_addr;
+ }
+ }
+ }
+
+ return TRUE;
+} /* translate_calls */
+
+/*
+** 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_Bytecode_Addr bc, MB_Unsigned number_codes,
+ MB_Stack *label_stack)
+{
+ MB_Unsigned i;
+ MB_Bytecode_Arg *cur_proc_arg = NULL;
+
+ for (i = 0; i < number_codes; i++, bc++) {
+ MB_Bytecode_Arg *cur_arg =
+ MB_code_get_arg(bc);
+
+ switch (MB_code_get_id(bc)) {
+
+ case MB_BC_enter_proc:
+ cur_proc_arg = cur_arg;
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_proc.end_label);
+ break;
+
+ case MB_BC_enter_if:
+ 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:
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->endof_then.follow_label);
+ break;
+
+ case MB_BC_enter_disjunction:
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_disjunction.end_label);
+ break;
+
+ case MB_BC_enter_disjunct:
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_disjunct.next_label);
+ break;
+
+ case MB_BC_endof_disjunct:
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->endof_disjunct.end_label);
+ break;
+
+ case MB_BC_enter_switch:
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_switch.end_label);
+ break;
+
+ case MB_BC_enter_switch_arm:
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_switch_arm.next_label);
+ break;
+
+ case MB_BC_endof_switch_arm:
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->endof_switch_arm.end_label);
+ break;
+
+ case MB_BC_enter_negation:
+ translate_label(cur_proc_arg, label_stack,
+ &cur_arg->enter_negation.end_label);
+ break;
+ }
+ }
+ return TRUE;
+} /* translate_labels */
+
+
+/*
+** 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_Bytecode_Addr bc, MB_Unsigned number_codes)
+{
+ MB_Unsigned i;
+ MB_Byte bc_id;
+ MB_Byte cur_detism = MB_BCID_ISDET;
+
+ for (i = 0; i < number_codes; i++, bc++) {
+ bc_id = MB_code_get_id(bc);
+ if (bc_id == MB_BC_enter_proc) {
+ switch (MB_code_get_arg(bc)->enter_proc.det) {
+ case MB_DET_DET:
+ case MB_DET_SEMIDET:
+ cur_detism = MB_BCID_ISDET;
+ break;
+ case MB_DET_MULTIDET:
+ case MB_DET_NONDET:
+ cur_detism = 0;
+ break;
+ case MB_DET_UNUSABLE:
+ cur_detism = 0;
+ break;
+ default:
+ assert(FALSE);
+ }
+ }
+ if (cur_detism) {
+ MB_BCID_DET_SET(*bc, cur_detism);
+ }
+
+ if (bc_id == MB_BC_endof_proc) cur_detism = 0;
+ }
+ return TRUE;
+} /* translate_detism */
+
+
+/*
+** Fill in the variable that each switch arm is using
+** Returns TRUE if successful
+*/
+static MB_Bool
+translate_switch(MB_Bytecode_Addr bc, MB_Unsigned number_codes)
+{
+ 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:
+ cur_switch = MB_code_get_arg(bc);
+ break;
+
+ case MB_BC_enter_switch_arm: {
+ MB_Bytecode_Arg *cur_arg
+ = MB_code_get_arg(bc);
+
+ cur_arg->enter_switch_arm.var =
+ cur_switch->enter_switch.var;
+
+ break;
+ }
+ }
+ }
+ return TRUE;
+} /* translate_switch */
+
+/*
+** 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); \
+ cur_arg->name.frame_ptr_tmp += \
+ cur_proc_arg->enter_proc.list_length; \
+ break;
+static MB_Bool
+translate_temps(MB_Bytecode_Addr bc, MB_Unsigned number_codes)
+{
+ 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)) {
+ case MB_BC_enter_proc:
+ cur_proc_arg = MB_code_get_arg(bc);
+ break;
+ XLATTEMP(enter_if);
+ XLATTEMP(enter_then);
+ XLATTEMP(enter_negation);
+ XLATTEMP(endof_negation_goal);
+ XLATTEMP(enter_commit);
+ }
+ }
+ return TRUE;
+}
+
+/*
+** Load a module by name. Assumes the bytecode file is just the module name
+** with '.mbc' appended.
+*/
+MB_Module *
+MB_module_load_name(MB_CString_Const module_name)
+{
+ MB_Module *module;
+ MB_CString filename = MB_str_new_cat(module_name, ".mbc");
+
+ FILE *fp = fopen(filename, "rb");
+
+ module = MB_module_load(module_name, fp);
+
+ MB_str_delete(filename);
+ return module;
+} /* MB_module_load_name */
+
+
+/*
+** 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_get(MB_CString_Const module_name)
+{
+ /* Search for the module */
+ MB_Word i;
+ MB_SAY(" Looking for %s among %d modules", module_name, module_count);
+ for (i = 0; i < module_count; i++) {
+ MB_SAY(" Testing module %d", i);
+ if (!MB_str_cmp(module_name, module_arr[i]->module_name)) {
+ MB_SAY(" Module %s found", module_name);
+ return module_arr[i];
+ }
+ }
+
+ 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 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 */
+static const MB_Word argument_size[] = {
+ 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, 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_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);
+ 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 */
+ if (module_count >= MAX_MODULES) {
+ MB_fatal("Too many modules");
+ }
+ module_arr[module_count++] = module;
+
+ if (fp == NULL) return module;
+
+ /* Check the file version is ok */
+ if (!MB_read_bytecode_version_number(fp, &version)) {
+ MB_util_error("Unable to read version number\n");
+ return NULL;
+ }
+
+ if (version != FILEVERSION) {
+ MB_util_error("Unknown file format version\n");
+ return NULL;
+ }
+
+ {
+ MB_Bytecode bc;
+ 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;
+
+ if (bc.id == MB_BC_label) {
+ /*
+ ** 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
+ */
+ if (cur_proc_arg == NULL) {
+ MB_fatal("Label outside proc\n");
+ }
+
+ /* Add the label to the current proc's list of labels */
+ MB_stack_poke(&label_stack,
+ cur_proc_arg->enter_proc.label_index
+ + bc.opt.label.label,
+ (MB_Word)(code_id + code_count));
+ } else if (bc.id == MB_BC_not_supported) {
+ /*
+ ** We came across unsupported code. Mark this proc as
+ ** unusable
+ */
+
+ if (cur_proc_arg == NULL) {
+ MB_fatal("Code outside proc\n");
+ }
+
+ cur_proc_arg->enter_proc.det = MB_DET_UNUSABLE;
+ }
+
+ /*
+ ** 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 (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,
+ argument_size[bc.id]);
+
+ /* Copy arguments onto argument data stack */
+ memcpy(cur_arg,
+ &(bc.opt),
+ argument_size[bc.id]*sizeof(MB_Word));
+
+ /* Check if we just entered/exited a procedure*/
+ switch (bc.id) {
+ case MB_BC_enter_proc:
+ /*
+ ** Save the new current proc (so
+ ** labels know where they are)
+ */
+ cur_proc = code_id + code_count;
+ cur_proc_arg = cur_arg;
+
+ /*
+ ** and mark where the label indexes
+ ** will begin
+ */
+ cur_proc_arg->enter_proc.label_index =
+ MB_stack_size(&label_stack);
+
+ MB_stack_alloc(&label_stack,
+ cur_proc_arg->
+ enter_proc.label_count);
+ break;
+
+ case MB_BC_endof_proc: {
+ /* Save the proc we were in */
+ cur_arg->endof_proc.proc_start =
+ cur_proc;
+
+ cur_proc_arg = NULL;
+ break;
+ }
+
+ case MB_BC_enter_pred:
+ MB_stack_push(&module->pred_index_stack,
+ code_count);
+ break;
+ }
+ }
+
+ /* 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);
+ MB_stack_delete(&label_stack);
+ return NULL;
+ }
+ code_count++;
+ module_code_count++;
+ }
+
+ }
+
+ if (feof(fp) &&
+ (module_code_count > 0) &&
+ (translate_labels(module_start, module_code_count,
+ &label_stack)) &&
+ (translate_calls(module_start, module_code_count)) &&
+ (translate_detism(module_start, module_code_count)) &&
+ (translate_switch(module_start, module_code_count)) &&
+ (translate_temps(module_start, module_code_count)))
+ {
+ /* Delete the label stack (we've done all the translations) */
+ MB_stack_delete(&label_stack);
+
+ return module;
+ } else {
+ MB_fatal("Error reading bytecode file");
+ }
+ return NULL;
+
+} /* MB_module_load */
+
+
+/*
+** 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)
+{
+ if (module != NULL) {
+ /*
+ ** The stacks will always be allocated since it will
+ ** have aborted if their allocation failed
+ */
+ MB_str_delete(module->module_name);
+ MB_stack_delete(&module->pred_index_stack);
+ MB_GC_free(module);
+ }
+}
+
+/* Get the actual size of a program, in bytecodes */
+MB_Unsigned
+MB_code_size(void)
+{
+ return code_count;
+}
+
+/* Get the bytecode type at a given address */
+MB_Byte
+MB_code_get_id(MB_Bytecode_Addr addr)
+{
+ if (!MB_ip_normal(addr))
+ return MB_BC_debug_invalid;
+
+ /* return the code with the determinism flag stripped away */
+ return MB_BCID_ID(*addr);
+}
+
+/* Get a bytecode's procedure's determinism */
+MB_Byte
+MB_code_get_det(MB_Bytecode_Addr addr)
+{
+ assert(MB_ip_normal(addr));
+
+ /* return the determinism flag */
+ 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_Bytecode_Addr addr)
+{
+ MB_Bytecode_Arg *data_p;
+
+ if (!MB_ip_normal(addr)) return NULL;
+
+ 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 */
+
+MB_Bytecode_Addr
+MB_code_get_pred_addr(MB_Bytecode_Addr addr) {
+
+ while (MB_code_get_id(addr) != MB_BC_enter_pred) {
+
+ addr--;
+ if (!MB_ip_normal(addr)) {
+ return MB_CODE_INVALID_ADR;
+ }
+ }
+
+ return addr;
+}
+
+MB_Bytecode_Addr
+MB_code_get_proc_addr(MB_Bytecode_Addr addr)
+{
+ MB_Byte bc_id;
+ addr++;
+ do {
+ 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);
+
+ return addr;
+} /* MB_code_get_proc_addr */
+
+/* Finds the location of a given proc */
+MB_Bytecode_Addr
+MB_code_find_proc(MB_CString_Const module_name,
+ MB_CString_Const pred_name, MB_Word mode_num,
+ MB_Word arity, MB_Bool is_func)
+{
+ MB_Bytecode_Addr addr;
+ MB_Word size;
+ MB_Module *module = MB_module_get(module_name);
+ MB_Word j;
+
+ MB_SAY(" Looking for %s %s__%s/%d mode %d",
+ (is_func) ? "func" : "pred",
+ module_name, pred_name, arity, mode_num);
+
+ if (MB_stack_size(&module->pred_index_stack) == 0) {
+ 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;
+ addr = code_id + MB_stack_peek(&module->pred_index_stack, j);
+
+ pred_arg = MB_code_get_arg(addr);
+
+ if ((pred_arg->enter_pred.pred_arity
+ == arity)
+ && (pred_arg->enter_pred.is_func
+ == is_func)
+ && MB_str_cmp(pred_arg->
+ enter_pred.pred_name,
+ pred_name) == 0)
+ {
+ break;
+ }
+ }
+
+ /* Check if any of the predicates matched */
+ if (j == MB_stack_size(&module->pred_index_stack)) {
+ MB_SAY(" Not found");
+ return MB_CODE_INVALID_ADR;
+ }
+
+ /* one obviously did */
+ /* Now find the right proc */
+ do {
+ MB_Byte bc_id;
+
+ addr++;
+
+ assert(MB_ip_normal(addr));
+
+ bc_id = MB_code_get_id(addr);
+ if (bc_id == MB_BC_enter_proc) {
+ 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 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))
+ {
+ MB_SAY("Predicate does not contain "
+ "procedure: %s/%d mode %d",
+ pred_name,
+ (int) arity,
+ (int) mode_num);
+ return MB_CODE_INVALID_ADR;
+ }
+
+ } while (1);
+
+ return MB_CODE_INVALID_ADR;
+}
+
+
+MB_Word *
+MB_code_data_alloc_words(MB_Word num_words)
+{
+ code_data_count += num_words;
+ if (code_data_count >= MAX_CODE_DATA_COUNT) {
+ MB_fatal("Out of bytecode argument data space");
+ }
+ return code_arg_data + code_data_count - num_words;
+}
+
+/* given a code address, forces it into a valid range */
+MB_Bytecode_Addr
+MB_code_range_clamp(MB_Bytecode_Addr addr)
+{
+ MB_Bytecode_Addr max_addr;
+ if ((MB_Unsigned) addr < (MB_Unsigned) code_id) return code_id;
+
+ max_addr = code_id + code_count - 1;
+ if ((MB_Unsigned) addr > (MB_Unsigned) max_addr) return max_addr;
+
+ return addr;
+}
+
+/*
+** Returns true if a given instruction pointer points to a normal
+** address (ie: valid range and not one of MB_CODE_xxxx)
+*/
+MB_Bool
+MB_ip_normal(MB_Bytecode_Addr ip)
+{
+ /* 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_special(MB_Bytecode_Addr ip)
+{
+ return ((MB_Unsigned) ip > (MB_Unsigned) MB_CODE_INVALID_ADR);
+}
+
+
--- ../bytecode.old/mb_stack.h Wed Jan 24 18:42:28 2001
+++ mb_stack.h Mon Jan 29 16:19:52 2001
@@ -1,56 +1,80 @@
/*
-** Copyright (C) 1997 The University of Melbourne.
+** Copyright (C) 1997-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.
**
-** $Id: mb_stack.h,v 1.1 2001/01/24 07:42:28 lpcam Exp $
-**
** High-water marked stack of 'MB_Word's
**
*/
-
#ifndef MB_STACK_H
-#define MB_STACK_H
+#define MB_STACK_H
-#include "mb_bytecode.h"
+#include "mb_basetypes.h"
+#include "mb_util.h"
-typedef struct {
- MB_Word*data;
+typedef struct MB_Stack_Struct {
+ MB_Word *data;
MB_Word sp;
- MB_Word max_size;
+ MB_Word max_size: (MB_WORD_BITS-1);
+ MB_Word gc : 1;
} MB_Stack;
-/* allocates space for a new stack */
-MB_Stack MB_stack_new(MB_Word init_size);
+/*
+** 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);
-/* pushes a value onto the stack */
-void MB_stack_push(MB_Stack* s, MB_Word x);
+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);
+
/* 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);
+** NOTE: if you add or remove items, this value could change */
+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);
-#endif /* MB_STACK_H */
+/*
+** 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(stack, type, num) \
+ MB_STACK_ALLOC((stack), MB_NUMBLOCKS(num * sizeof(type), sizeof(MB_Word))
+#endif /* MB_STACK_H */
--- ../bytecode.old/mb_stack.c Wed Jan 24 18:42:28 2001
+++ mb_stack.c Mon Jan 29 16:21:25 2001
@@ -1,11 +1,9 @@
/*
-** Copyright (C) 1997 The University of Melbourne.
+** Copyright (C) 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.
**
-** $Id: mb_stack.c,v 1.1 2001/01/24 07:42:28 lpcam Exp $
-**
** High-water marked stack of 'MB_Word's
**
*/
@@ -20,72 +18,88 @@
/* Exported definitions */
-MB_Stack MB_stack_new(MB_Word init_size);
-MB_Word MB_stack_size(MB_Stack* s);
-void 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_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);
/* Local declarations */
-static char
-rcs_id[] = "$Id: mb_stack.c,v 1.1 2001/01/24 07:42:28 lpcam Exp $";
-
-
/* Implementation */
MB_Stack
-MB_stack_new(MB_Word init_size) {
+MB_stack_new(MB_Word init_size, MB_Bool gc) {
MB_Stack s;
s.max_size = init_size;
- s.data = MB_new_array(MB_Word, init_size);
- s.sp = 0;
- if (s.data == NULL) {
- MB_fatal("Unable to allocate memory");
+ s.gc = gc;
+ if (init_size == 0) {
+ s.data = NULL;
+ } else {
+ s.data = (gc)
+ ? 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");
+ }
}
+ s.sp = 0;
return s;
}
MB_Word
-MB_stack_size(MB_Stack* s) {
+MB_stack_size(MB_Stack *s) {
return s->sp;
}
-void
-MB_stack_push(MB_Stack* s, MB_Word x)
+MB_Word
+MB_stack_push(MB_Stack *s, MB_Word x)
{
if (s->sp == s->max_size) {
s->max_size *= 2;
- s->data = MB_resize_array(s->data, MB_Word, s->max_size);
+ 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);
+ } else {
+ s->data = (s->gc)
+ ? MB_GC_RESIZE_ARRAY(s->data, MB_Word,
+ s->max_size)
+ : MB_RESIZE_ARRAY(s->data, MB_Word,
+ s->max_size);
+ }
+
assert(s->data != NULL);
}
- s->data[s->sp++] = x;
+ s->data[s->sp] = x;
+ return s->sp++;
}
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;
+
while (s->sp + num_words > s->max_size) {
num_words -= (s->max_size - s->sp);
s->sp = s->max_size;
@@ -98,51 +112,54 @@
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_free(s->data);
+MB_stack_delete(MB_Stack *s) {
+ if (s->gc) {
+ MB_GC_free(s->data);
+ } else {
+ MB_free(s->data);
+ }
}
-
--- ../bytecode.old/mb_util.h Wed Jan 24 18:42:28 2001
+++ mb_util.h Tue Jan 30 11:51:00 2001
@@ -1,15 +1,15 @@
/*
-** Copyright (C) 1997 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.
**
-** $Id: mb_util.h,v 1.1 2001/01/24 07:42:28 lpcam Exp $
*/
-
#ifndef MB_UTIL_H
-#define MB_UTIL_H
+#define MB_UTIL_H
+
+#include "mb_basetypes.h"
typedef char *
MB_CString;
@@ -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,12 +31,37 @@
void
MB_util_error(const char *fmt, ...);
+/* 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);
-/* compare two strings */
-int MB_strcmp(MB_CString_Const a, MB_CString_Const b);
+/* allocate space for a new string */
+MB_CString MB_str_new(MB_Word len); /* len is w/o null terminator */
-#endif /* MB_UTIL_H */
+/* 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 (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.old/mb_util.c Wed Jan 24 18:42:28 2001
+++ mb_util.c Tue Jan 30 17:07:55 2001
@@ -1,10 +1,9 @@
-
+#define NOSAY 1 /* To disable SAYings */
/*
-** Copyright (C) 2000 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.
**
-** $Id: mb_util.c,v 1.1 2001/01/24 07:42:28 lpcam Exp $
*/
/* Imports */
@@ -13,18 +12,21 @@
#include <stdlib.h>
#include <string.h>
+#include "mb_mem.h"
#include "mb_util.h"
/* Exported definitions */
-int MB_strcmp(MB_CString_Const a, MB_CString_Const b);
-void MB_util_error(const char *fmt, ...);
-void MB_fatal(const char* message);
+void MB_util_error(const char *fmt, ...);
+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);
+MB_CString MB_str_dup(MB_CString_Const str);
+void MB_str_delete(MB_CString str);
-/* Local declarations */
-static char
-rcs_id[] = "$Id: mb_util.c,v 1.1 2001/01/24 07:42:28 lpcam Exp $";
+/* Local declarations */
/* Implementation */
@@ -41,9 +43,23 @@
fprintf(stderr, "\n");
}
+void MB_SAY(const char *fmt, ...)
+{
+#if NOSAY
+
+#else
+ va_list arg_p;
+ va_start(arg_p, fmt);
+ 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");
@@ -54,9 +70,45 @@
}
/* compare two strings */
-int MB_strcmp(MB_CString_Const a, MB_CString_Const b) {
+int MB_str_cmp(MB_CString_Const a, MB_CString_Const b) {
return strcmp(a, b);
}
+MB_CString
+MB_str_new(MB_Word len)
+{
+ MB_CString c = MB_GC_NEW_ARRAY_ATOMIC(char, len + 1);
+ if (c == NULL) MB_fatal("Not enough string space");
+ return c;
+}
+
+MB_CString
+MB_str_new_cat(MB_CString_Const a, MB_CString_Const b)
+{
+ MB_Word len_a = strlen(a);
+ MB_Word len_b = strlen(b);
+ 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);
+
+ new_str[len_a + len_b] = 0;
+
+ return new_str;
+}
+
+MB_CString
+MB_str_dup(MB_CString_Const str)
+{
+ MB_CString c = MB_str_new(strlen(str) + 1);
+ strcpy(c, str);
+ return c;
+}
+
+void
+MB_str_delete(MB_CString str)
+{
+ MB_GC_free(str);
+}
--------------------------------------------------------------------------
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