[m-dev.] For Review: Bytecode interpreter
Levi Cameron
l.cameron2 at ugrad.unimelb.edu.au
Wed Jan 24 19:14:37 AEDT 2001
The code as below will compile & run but nondet code
(ie: most of the bytecodes) have been '#if'ed out since
they haven't been tested to run with native code.
Note that there still exists debugging code throughout
(various SAY() calls) and that originally I assumed that
code & data could not occupy the same address which I
realised later they could, so this assumption hasn't been
completely removed yet.
Levi
l.cameron2 at ugrad.unimelb.edu.au
bytecode/bytecode.c
bytecode/bytecode.h
bytecode/dict.c
bytecode/dict.h
bytecode/disasm.c
bytecode/disasm.h
bytecode/machine.c
bytecode/machine.h
bytecode/mbi_main.c
bytecode/mdb.m
bytecode/mem.c
bytecode/mem.h
bytecode/slist.c
bytecode/slist.h
bytecode/template.c
bytecode/template.h
bytecode/util.c
bytecode/util.h
Removed. Thesr contains all the old bytecode files from
before I started. Any parts that were useful have already
been salvaged and used in the new interpreter.
bytecode/Mmakefile
bytecode/Mmake.params
Makefile for test bytecode program. Note that any library
functions that are called from bytecode must be compiled
with trace information. (So their entry labels can be
looked up)
bytecode/mb_basetypes.h
Added. Contains basic type definitions.
bytecode/mb_bytecode.c
bytecode/mb_bytecode.h
Better error messages.
Changed var_lists to direct pointers rather than
lookups through data stacks (much simpler but stop you
using realloc() on the bytecode argument data)
Label addresses are computed at module load time rather
than being looked up each jump
Added endof_negation_goal
Temporary stack slot numbers are translated to variable
numbers (now there is no distinction between temps & vars)
MB_read_cstring changed (see comments for new arguments)
Added distinction between functions and predicates
Added enter_else
Code addresses are all pointers rather than simple ints
bytecode/mb_disasm.c
bytecode/mb_disasm.h
Added endof_negation_goal & enter_else
Output strings are now easier to read
MB_listing does not display anything for invalid addresses
MB_listing takes line length argument
bytecode/mb_interface.c
bytecode/mb_interface.h
bytecode/mb_interface_stub.m
Interfacing between native/bytecode
bytecode/mb_machine.c
bytecode/mb_machine.h
bytecode/mb_machine_def.h
Large sections of code branched off into mb_module.?
Most instructions completed, but not integrated with native
code.
Most of mb_machine_def has been removed as the native
code functions provide the same functionality.
bytecode/mb_machine_show.c
bytecode/mb_machine_show.h
Completely changed. Less information now as a lot of what
was being displayed before cannot be determined as easily
now that it is stored in the mercury runtime.
bytecode/mb_mem.c
bytecode/mb_mem.h
Added routines for garbage collected memory
bytecode/mb_module.c
bytecode/mb_module.h
Loading & accessing bytecode. Argument data indexes & id are now
stored in a single word. (see MB_BCID_xxx macros).
Call & label addresses are now calculated at load time.
bytecode/mb_stack.c
bytecode/mb_stack.h
Added options for garbage collection of MB_Stack memory
bytecode/mb_util.c
bytecode/mb_util.h
Miscellaneous string functions added and SAY() for debugging
bytecode/simple01.m
Added. Simple test program. (replace with whatever
program is being tested at the time).
==========================================================================
Index: Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/Mmakefile,v
retrieving revision 1.15
diff -u -r1.15 Mmakefile
--- Mmakefile 2001/01/24 07:42:22 1.15
+++ Mmakefile 2001/01/24 07:44:34
@@ -1,124 +1,137 @@
#-----------------------------------------------------------------------------#
-# Copyright (C) 1997-2000 The University of Melbourne.
+# Copyright (C) 1998-2001 The University of Melbourne.
# This file may only be copied under the terms of the GNU General
# Public License - see the file COPYING in the Mercury distribution.
#-----------------------------------------------------------------------------#
-# Mmake - Mmake file for the Mercury bytecode utilities
+# Mmake - Mmake file for the bytecode interpreter
MAIN_TARGET=all
-MERCURY_DIR=..
+MERCURY_DIR=/home/stude/l/lpcam/mercury/src
include $(MERCURY_DIR)/Mmake.common
+-include Mmake.params
#-----------------------------------------------------------------------------#
-INCPATH = -I$(RUNTIME_DIR) \
+INC_DIRS = -I$(LIBRARY_DIR) \
+ -I$(RUNTIME_DIR) \
-I$(BOEHM_GC_DIR) \
-I$(BOEHM_GC_DIR)/include \
- -I.
-LIBPATH = -L$(RUNTIME_DIR) -L$(BOEHM_GC_DIR) -L.
-CFLAGS = -g $(EXTRA_CFLAGS) -D_POSIX_SOURCE $(INCPATH) -DDEBUGGING
-MGNUC = MERCURY_ALL_C_INCL_DIRS="$(INCPATH)" $(SCRIPTS_DIR)/mgnuc
-MGNUCFLAGS = $(CFLAGS)
+ -I$(TRACE_DIR)
+
+EXTRA_MGNUCFLAGS= --no-ansi $(INC_DIRS)
+
+
+EXTRA_MCFLAGS = --generate-bytecode -V -O 0 --inline-simple-threshold
20
+
+
+TAGFLAGS = -T -d
+
+#-----------------------------------------------------------------------------#
+# keep this list in alphabetical order, please
+MB_HDRS = mb_basetypes.h \
+ mb_bytecode.h \
+ mb_disasm.h \
+ mb_interface.h \
+ mb_machine.h \
+ mb_machine_def.h \
+ mb_machine_show.h \
+ mb_mem.h \
+ mb_module.h \
+ mb_stack.h \
+ mb_util.h
+
+# keep this list in alphabetical order, please
+HDRS = $(MB_HDRS)
+
+BYTECODE = *.mbc *.bytedebug
+
+# keep this list in alphabetical order, please
+CFILES = \
+ mb_bytecode.c \
+ mb_disasm.c \
+ mb_interface.c \
+ mb_machine.c \
+ mb_machine_show.c \
+ mb_mem.c \
+ mb_module.c \
+ mb_stack.c \
+ mb_util.c \
+ simple01_init.c
+# bug.c
+
+MFILES = \
+ simple01.m \
+ mb_interface_stub.m
+
+MERCURY_INCLUDES = \
+ $(RUNTIME_DIR)/*.c $(RUNTIME_DIR)/*.h \
+ $(RUNTIME_DIR)/machdeps/*.c $(RUNTIME_DIR)/machdeps/*.h \
+ $(TRACE_DIR)/*.h $(TRACE_DIR)/*.c \
+ $(BROWSER_DIR)/*.h $(BROWSER_DIR)/*.c \
+ $(BOEHM_GC_DIR)/*.h $(BOEHM_GC_DIR)/include/*.h
+
+OBJS = $(CFILES:.c=.$O)
+
+#-----------------------------------------------------------------------------#
+
+$(OBJS): $(HDRS)
+
+#-----------------------------------------------------------------------------#
+
+# prevent Mmake from removing C files
+RM_C=:
+
+LIBS = $(TRACE_DIR)/libmer_trace.a
+
+TEST_OBJS = \
+ mb_bytecode.o \
+ mb_disasm.o \
+ mb_interface.o \
+ mb_machine.o \
+ mb_machine_show.o \
+ mb_mem.o \
+ mb_module.o \
+ mb_stack.o \
+ mb_util.o \
+ simple01.o \
+ simple01_init.o \
+ mb_interface_stub.o
+# bug.o
-MAKEDEPEND = makedepend
+#%.mbc: %.c
+# $(MC) $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) --generate-bytecode
--compile-to-c
-# We need VPATH so we can find getopt.h (!)
-VPATH = $(MERCURY_DIR)/runtime
-
#-----------------------------------------------------------------------------#
-MB_HDRS = bytecode.h dict.h disasm.h mbi.h mem.h machine.h \
- mdis.h static_data.h template.h util.h
-
-HDRS = $(MB_HDRS) getopt.h
-
-ORIG_CS = bytecode.c dict.c disasm.c machine.c mbi.c mbi_main.c \
- mdis.c mem.c static_data.c template.c util.c
-
-#LIBS = -lmer ` \
-# case "$(GRADE)" in \
-# *.par*.gc*.prof*) echo "-lpar_gc_prof" ;; \
-# *.par*.gc*) echo "-lpar_gc" ;; \
-# *.gc*.prof*) echo "-lgc_prof" ;; \
-# *.gc*) echo "-lgc" ;; \
-# esac \
-# `
-LIBS = libgc.a
-
-#-----------------------------------------------------------------------------#
-
.PHONY: all
-
-all: mdb mdis mbi libmbi
-
-MDIS_OBJS = bytecode.o disasm.o mdis.o mem.o util.o
-mdis: $(MDIS_OBJS)
- $(MGNUC) $(CFLAGS) -o mdis $(MDIS_OBJS) $(LIBPATH) $(LIBS)
+all: test
-LIBMBI_OBJS = bytecode.o dict.o mbi.o mem.o util.o
-LIBMBI_PIC_OBJS = $(LIBMBI_OBJS:.o=.$(EXT_FOR_PIC_OBJECTS))
-MBI_OBJS = mbi_main.o $(LIBMBI_OBJS)
-
-mbi: $(MBI_OBJS)
- $(MGNUC) $(CFLAGS) -o mbi $(MBI_OBJS) $(LIBPATH) $(LIBS)
-
-libmbi: libmbi.a libmbi.$(EXT_FOR_SHARED_LIB)
-
-libmbi.a: $(LIBMBI_OBJS)
- rm -f libmbi.a
- ar cr libmbi.a $(LIBMBI_OBJS)
-
-libmbi.so: $(LIBMBI_OBJS)
- $(LINK_SHARED_OBJ) -o libmbi.so $(LIBMBI_PIC_OBJS) \
- $(LIBPATH) $(LIBS) $(SHARED_LIBS)
-
-mdb: libmbi.so mdb.m
- $(MC) -o mdb mdb.m -L. -lmbi
-
-
+tags: $(CFILES) $(HDRS)
+ ctags $(TAGFLAGS) $(CFILES) $(MFILES) $(HDRS) $(MERCURY_INCLUDES)
+
+test: $(TEST_OBJS)
+ $(ML) $(ALL_GRADEFLAGS) $(ALL_MLFLAGS) $(TEST_OBJS)
$(BROWSER_DIR)/libmer_browser.a -o test
+
+simple01_init.c: simple01.c
+ $(C2INIT) $(ALL_GRADEFLAGS) $(ALL_C2INITFLAGS) simple01.c >
simple01_init.c
+
+clean_local: clean_o
+
+realclean_local: realclean_o
+
+.PHONY: clean_o
+clean_o:
+ rm -f $(GENCFILES)
+ rm -f $(OBJS)
+ rm -f $(BYTECODE)
+ rm -f simple01.c simple01_init.c
+ rm -f mb_interface_stub.c simple01_init.c
+
+.PHONY: realclean_o
+realclean_o:
+ rm -f *.d *.o *.err
+ rm -f tags test
#-----------------------------------------------------------------------------#
-tags: $(ORIG_CS)
- ctags $(ORIG_CS) $(MB_HDRS)
-
-.PHONY: check_headers
-check_headers:
- for file in $(HDRS); do \
- echo "$$file"; \
- echo "#include \"$$file\"" > tmp.c; \
- $(MGNUC) $(MGNUCFLAGS) -c tmp.c || exit 1; \
- done
- rm -f tmp.c
-
-# Create dependencies.
-depend: $(ORIG_CS) $(HDR)
- if test ! -f depend.mk ; then touch depend.mk ; else true ; fi
- $(MAKEDEPEND) $(INCPATH) -f depend.mk $^
-
-
-#-----------------------------------------------------------------------------#
-
-# installation rules
-
-install:
- echo "Module \"bytecode\" does not yet install anything."
-
-uninstall:
- echo "Nothing to uninstall for module \"bytecode\""
-
-#-----------------------------------------------------------------------------#
-
-clean_local:
- rm -f *.o *.pic_o
-
-realclean_local:
- -$(RM) mbi mdis depend.mk* libmbi.a libmbi.so \
- mdb mdb.c mdb.d mdb_init.c
-
-#-----------------------------------------------------------------------------#
-
--include depend.mk
-
-#-----------------------------------------------------------------------------#
Index: mb_bytecode.c
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_bytecode.c,v
retrieving revision 1.1
diff -u -r1.1 mb_bytecode.c
--- mb_bytecode.c 2001/01/24 07:42:22 1.1
+++ mb_bytecode.c 2001/01/24 07:44:34
@@ -1,10 +1,9 @@
/*
-** Copyright (C) 2000 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_bytecode.c,v 1.1 2001/01/24 07:42:22 lpcam Exp $
*/
/* Imports */
@@ -14,15 +13,13 @@
#include "mb_bytecode.h"
#include "mb_mem.h"
+#include "mb_module.h"
#include "mb_util.h"
/* Exported definitions */
/* Local declarations */
-static char
-rcs_id[] = "$Id: mb_bytecode.c,v 1.1 2001/01/24 07:42:22 lpcam Exp $";
-
/*
** All read functions return true if successful
*/
@@ -70,7 +67,6 @@
MB_Byte c;
if (! MB_read_byte(fp, &c)) {
- MB_util_error("Unable to read bytecode id\n");
return FALSE;
}
@@ -92,6 +88,7 @@
bc_p->opt.enter_pred.pred_arity = pred_arity;
bc_p->opt.enter_pred.is_func = is_func;
bc_p->opt.enter_pred.proc_count = proc_count;
+
return TRUE;
}
break;
@@ -103,37 +100,44 @@
{
MB_Byte proc_id;
MB_Determinism det;
- MB_Short label_count, temp_count, list_length;
- MB_CString *var_info_list;
+ MB_Short label_count, end_label;
+ MB_Short temp_count, list_length;
+ MB_CString* var_info;
if (MB_read_byte(fp, &proc_id) &&
MB_read_byte(fp, &det) &&
MB_read_short(fp, &label_count) &&
+ MB_read_short(fp, &end_label) &&
MB_read_short(fp, &temp_count) &&
MB_read_short(fp, &list_length))
{
int i;
MB_CString str;
- var_info_list = MB_new_array(MB_CString,
- list_length);
+ var_info = (list_length == 0) ? NULL :
+ MB_code_data_alloc(MB_CString,
+ list_length);
for (i = 0; i < list_length; i++) {
if (MB_read_cstring(fp, &str)) {
- var_info_list[i] = str;
+ var_info[i] = str;
} else {
- MB_fatal("XXX: decent message");
+ MB_fatal("enter_proc var"
+ " read error");
}
}
bc_p->opt.enter_proc.proc_id = proc_id;
bc_p->opt.enter_proc.det = det;
bc_p->opt.enter_proc.label_count = label_count;
+ bc_p->opt.enter_proc.end_label.index =
+ end_label;
bc_p->opt.enter_proc.temp_count = temp_count;
bc_p->opt.enter_proc.list_length = list_length;
- bc_p->opt.enter_proc.var_info_list =
- var_info_list;
+ bc_p->opt.enter_proc.var_info = var_info;
return TRUE;
+ } else {
+ MB_fatal("enter_proc read error");
}
break;
}
@@ -157,7 +161,7 @@
MB_Short end_label;
if (MB_read_short(fp, &end_label)) {
- bc_p->opt.enter_disjunction.end_label =
+ bc_p->opt.enter_disjunction.end_label.index =
end_label;
return TRUE;
} else {
@@ -173,7 +177,7 @@
MB_Short next_label;
if (MB_read_short(fp, &next_label)) {
- bc_p->opt.enter_disjunct.next_label =
+ bc_p->opt.enter_disjunct.next_label.index =
next_label;
return TRUE;
} else {
@@ -186,10 +190,11 @@
MB_Short label;
if (MB_read_short(fp, &label)) {
- bc_p->opt.endof_disjunct.label = label;
+ bc_p->opt.endof_disjunct.end_label.index
+ = label;
return TRUE;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("endof_disjunct read error");
}
break;
}
@@ -201,10 +206,11 @@
MB_read_short(fp, &end_label))
{
bc_p->opt.enter_switch.var = var;
- bc_p->opt.enter_switch.end_label = end_label;
+ bc_p->opt.enter_switch.end_label.index =
+ end_label;
return TRUE;
} else {
- MB_fatal("enter_switch malformed");
+ MB_fatal("enter_switch read error");
}
break;
}
@@ -219,11 +225,11 @@
MB_read_short(fp, &next_label))
{
bc_p->opt.enter_switch_arm.cons_id = cons_id;
- bc_p->opt.enter_switch_arm.next_label
- = next_label;
+ bc_p->opt.enter_switch_arm.next_label.index =
+ next_label;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("enter_switch_arm read error");
}
break;
}
@@ -231,11 +237,11 @@
MB_Short label;
if (MB_read_short(fp, &label)) {
- bc_p->opt.endof_switch_arm.label =
+ bc_p->opt.endof_switch_arm.end_label.index =
label;
return TRUE;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("endof_switch_arm read error");
}
break;
}
@@ -246,15 +252,15 @@
MB_read_short(fp, &end_label) &&
MB_read_short(fp, &frame_ptr_tmp))
{
- bc_p->opt.enter_if.else_label =
+ bc_p->opt.enter_if.else_label.index =
else_label;
- bc_p->opt.enter_if.end_label =
+ bc_p->opt.enter_if.end_label.index =
end_label;
bc_p->opt.enter_if.frame_ptr_tmp =
frame_ptr_tmp;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("enter_if read error");
}
break;
}
@@ -267,59 +273,96 @@
frame_ptr_tmp;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("enter_then read error");
}
break;
}
- case MB_BC_endof_then: { /* XXX: change to enter_else */
+ case MB_BC_endof_then: {
MB_Short follow_label;
if (MB_read_short(fp, &follow_label)) {
- bc_p->opt.endof_then.follow_label =
+ bc_p->opt.endof_then.follow_label.index =
follow_label;
return TRUE;
+ } else {
+ MB_fatal("endof_then read error");
+ }
+ break;
+ }
+
+ case MB_BC_enter_else: {
+ MB_Short frame_ptr_tmp;
+
+ if (MB_read_short(fp, &frame_ptr_tmp))
+ {
+ bc_p->opt.enter_else.frame_ptr_tmp =
+ frame_ptr_tmp;
+ return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("enter_else read error");
}
break;
}
+
case MB_BC_endof_if:
return TRUE;
break;
+
case MB_BC_enter_negation: {
+ MB_Short frame_ptr_tmp;
MB_Short end_label;
- if (MB_read_short(fp, &end_label)) {
- bc_p->opt.enter_negation.end_label =
+ if (MB_read_short(fp, &frame_ptr_tmp) &&
+ MB_read_short(fp, &end_label))
+ {
+ bc_p->opt.enter_negation.frame_ptr_tmp =
+ frame_ptr_tmp;
+ bc_p->opt.enter_negation.end_label.index =
end_label;
return TRUE;
+ } else {
+ MB_fatal("enter_negation read error");
+ }
+ break;
+ }
+ case MB_BC_endof_negation_goal: {
+ MB_Short frame_ptr_tmp;
+
+ if (MB_read_short(fp, &frame_ptr_tmp))
+ {
+ bc_p->opt.endof_negation_goal.frame_ptr_tmp =
+ frame_ptr_tmp;
+ return TRUE;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("enter_negation_goal read error");
}
break;
}
case MB_BC_endof_negation:
return TRUE;
break;
+
case MB_BC_enter_commit: {
- MB_Short temp;
+ MB_Short frame_ptr_tmp;
- if (MB_read_short(fp, &temp)) {
- bc_p->opt.enter_commit.temp = temp;
+ if (MB_read_short(fp, &frame_ptr_tmp)) {
+ bc_p->opt.enter_commit.frame_ptr_tmp =
+ frame_ptr_tmp;
return TRUE;
} else {
- assert(FALSE); /*XXX */
+ MB_fatal("enter_commit read error");
}
break;
}
case MB_BC_endof_commit: {
- MB_Short temp;
+ MB_Short frame_ptr_tmp;
- if (MB_read_short(fp, &temp)) {
- bc_p->opt.endof_commit.temp = temp;
+ if (MB_read_short(fp, &frame_ptr_tmp)) {
+ bc_p->opt.endof_commit.frame_ptr_tmp
+ = frame_ptr_tmp;
return TRUE;
} else {
- assert(FALSE); /*XXX */
+ MB_fatal("endof_commit read error");
}
break;
}
@@ -334,7 +377,7 @@
from_var;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("assign read error");
}
break;
}
@@ -348,7 +391,7 @@
bc_p->opt.test.var2 = var2;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("test read error");
}
break;
}
@@ -362,9 +405,11 @@
MB_read_cons_id(fp, &consid) &&
MB_read_short(fp, &list_length))
{
- MB_Short i;
+ MB_Short i;
- var_list = MB_new_array(MB_Short, list_length);
+ var_list = (list_length == 0) ? NULL :
+ MB_code_data_alloc(MB_Short,
+ list_length);
for (i = 0; i < list_length; i++) {
MB_Short var;
@@ -372,17 +417,19 @@
if (MB_read_short(fp, &var)) {
var_list[i] = var;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("construct var"
+ " read error");
}
}
+
bc_p->opt.construct.to_var = to_var;
bc_p->opt.construct.consid = consid;
bc_p->opt.construct.list_length = list_length;
bc_p->opt.construct.var_list = var_list;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("construct read error");
}
break;
}
@@ -396,9 +443,11 @@
MB_read_cons_id(fp, &consid) &&
MB_read_short(fp, &list_length))
{
- MB_Short i;
+ MB_Short i;
- var_list = MB_new_array(MB_Short, list_length);
+ var_list = (list_length == 0) ? NULL :
+ MB_code_data_alloc(MB_Short,
+ list_length);
for (i = 0; i < list_length; i++) {
MB_Short var;
@@ -406,7 +455,8 @@
if (MB_read_short(fp, &var)) {
var_list[i] = var;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("deconstruct var"
+ " read error");
}
}
@@ -415,11 +465,10 @@
bc_p->opt.deconstruct.consid = consid;
bc_p->opt.deconstruct.list_length =
list_length;
- bc_p->opt.deconstruct.var_list =
- var_list;
+ bc_p->opt.deconstruct.var_list = var_list;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("deconstruct read error");
}
break;
}
@@ -432,17 +481,19 @@
MB_read_cons_id(fp, &consid) &&
MB_read_short(fp, &list_length))
{
- MB_Var_dir *var_dir_list;
+ MB_Var_dir* var_dir_list;
MB_Var_dir var_dir;
int i;
- var_dir_list = MB_new_array(MB_Var_dir,
- list_length);
+ var_dir_list = MB_code_data_alloc(MB_Var_dir,
+ list_length);
+
for (i = 0; i < list_length ; i++) {
if (MB_read_var_dir(fp, &var_dir)) {
var_dir_list[i] = var_dir;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("complex_construct"
+ " var read error");
}
}
@@ -450,9 +501,11 @@
bc_p->opt.complex_construct.consid = consid;
bc_p->opt.complex_construct.list_length
= list_length;
+ bc_p->opt.complex_construct.var_dir
+ = var_dir_list;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("complex_construct read error");
}
break;
}
@@ -465,17 +518,19 @@
MB_read_cons_id(fp, &consid) &&
MB_read_short(fp, &list_length))
{
- MB_Var_dir *var_dir_list;
+ MB_Var_dir* var_dir_list;
MB_Var_dir var_dir;
int i;
+
+ var_dir_list = MB_code_data_alloc(MB_Var_dir,
+ list_length);
- var_dir_list = MB_new_array(MB_Var_dir,
- list_length);
for (i = 0; i < list_length; i++) {
if (MB_read_var_dir(fp, &var_dir)) {
var_dir_list[i] = var_dir;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("complex_deconstruct"
+ " var read error");
}
}
bc_p->opt.complex_deconstruct.from_var =
@@ -483,11 +538,11 @@
bc_p->opt.complex_deconstruct.consid = consid;
bc_p->opt.complex_deconstruct.list_length =
list_length;
- bc_p->opt.complex_deconstruct.var_dir_list =
+ bc_p->opt.complex_deconstruct.var_dir =
var_dir_list;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("complex_deconstruct read error");
}
break;
}
@@ -503,7 +558,7 @@
from_var;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("place_arg read error");
}
break;
}
@@ -520,7 +575,7 @@
to_var;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("pickup_arg read error");
}
break;
}
@@ -528,11 +583,13 @@
MB_CString module_id;
MB_CString pred_id;
MB_Short arity;
+ MB_Byte is_func;
MB_Byte proc_id;
if (MB_read_cstring(fp, &module_id) &&
MB_read_cstring(fp, &pred_id) &&
MB_read_short(fp, &arity) &&
+ MB_read_byte(fp, &is_func) &&
MB_read_byte(fp, &proc_id))
{
bc_p->opt.call.module_id =
@@ -540,10 +597,14 @@
bc_p->opt.call.pred_id =
pred_id;
bc_p->opt.call.arity = arity;
+ bc_p->opt.call.is_func = is_func;
bc_p->opt.call.proc_id = proc_id;
+
+ bc_p->opt.call.is_native = TRUE;
+ bc_p->opt.call.adr = NULL;
return TRUE;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("call read error");
}
break;
}
@@ -568,7 +629,7 @@
det = det;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("higher_order_call read error");
}
break;
}
@@ -583,17 +644,13 @@
MB_read_op_arg(fp, &arg2) &&
MB_read_short(fp, &to_var))
{
- bc_p->opt.builtin_binop.binop =
- binop;
- bc_p->opt.builtin_binop.arg1 =
- arg1;
- bc_p->opt.builtin_binop.arg2 =
- arg2;
- bc_p->opt.builtin_binop.to_var =
- to_var;
+ bc_p->opt.builtin_binop.binop = binop;
+ bc_p->opt.builtin_binop.arg1 = arg1;
+ bc_p->opt.builtin_binop.arg2 = arg2;
+ bc_p->opt.builtin_binop.to_var = to_var;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("builtin_binop read error");
}
break;
}
@@ -611,7 +668,7 @@
bc_p->opt.builtin_unop.to_var = to_var;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("builtin_unop read error");
}
break;
}
@@ -629,7 +686,7 @@
bc_p->opt.builtin_bintest.arg2 = arg2;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("builtin_bintest read error");
}
break;
}
@@ -644,7 +701,7 @@
bc_p->opt.builtin_untest.arg = arg;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("builtin_untest read error");
}
break;
}
@@ -666,13 +723,14 @@
line_number;
return TRUE;
} else {
- assert(FALSE); /* XXX */
+ MB_fatal("context read error");
}
break;
}
case MB_BC_not_supported:
return TRUE;
break;
+
default:
MB_fatal("bytecode.MB_read_bytecode: unknown bytecode");
break;
@@ -708,7 +766,7 @@
*short_p = (c0 << 8) | c1;
return TRUE;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("Unexpected file error reading short");
return FALSE; /* not reached */
}
} /* MB_read_short */
@@ -775,7 +833,7 @@
*int_p = tmp_int;
return TRUE;
} else {
- assert(FALSE); /*XXX*/
+ MB_fatal("Unexpected file error reading int");
return FALSE;
}
} /* MB_read_int */
@@ -845,50 +903,55 @@
}
/*
-** MB_read_cstring MB_mallocs a string each time. The caller MB_frees
it.
-** Starts assuming string won't be more than a certain length,
-** reallocates if it gets too long
+** Returned string is allocated with string routines MB_str_xxx
+** It is the responsibility of the caller to free it using
MB_str_delete
+**
+** Will read from the file a complete string, but will only store in
+** memory string of maximum size of buffer below
*/
static MB_Bool
MB_read_cstring(FILE *fp, MB_CString *str_p)
{
- char *str = NULL;
- int str_size = 128; /* highwater mark for str */
+ /*
+ ** reads in string BUFSIZE characters at a time and when buffer
+ ** is full or the end is encountered, allocates space for the string.
+ ** If the string is longer than BUFSIZE chars, the rest is ignored.
+ */
+ char buffer[127];
+ char* str = buffer;
+
int i = 0;
MB_Byte c;
-
- /* Allocate initial static string */
- str = MB_new_array(char, str_size);
-
+
for (i=0;;) {
- MB_Bool got_byte;
-
- got_byte = MB_read_byte(fp, &c);
+ /* get the next char */
+ if (!MB_read_byte(fp, &c)) {
+ MB_fatal("Error reading C String from file");
+ }
- if (i + 1 > str_size) {
- str_size *= 2; /* Double buffer size */
- str = MB_resize_array(str, char, str_size);
- assert(str != NULL); /* XXX */
- }
-
- if ('\0' == c || ! got_byte) {
- int str_len;
- MB_CString ret_str;
-
- str[i] = '\0';
- str_len = strlen(str);
- ret_str = MB_new_array(char, str_len + 1);
- strcpy(ret_str, str);
- *str_p = ret_str;
- MB_free(str);
+ /* If we haven't yet filled the buffer*/
+ if (i < sizeof(buffer)) {
+ if (c) {
+ str[i] = c;
+ i++;
+ /* Save the string if we filled the buffer */
+ if (i == sizeof(buffer)-1) {
+ buffer[sizeof(buffer)-1] = 0;
+ *str_p = MB_str_dup(buffer);
+ }
+ } else {
+ str[i] = 0;
+ *str_p = MB_str_dup(buffer);
+ return TRUE;
+ }
+ } else if (!c) {
+ /* Otherwise, continue until we get a null terminator*/
return TRUE;
- } else {
- str[i] = c;
- i++;
}
} /* end for */
- assert(str != NULL);
- MB_free(str);
+
+ assert(FALSE);
+
} /* end MB_read_cstring() */
@@ -936,8 +999,8 @@
cons_id_p->opt.int_const = int_const;
return TRUE;
} else {
- MB_util_error("Unable to read constructor integer"
- " constant\n");
+ MB_util_error("Unable to read constructor"
+ " integer constant\n");
return FALSE;
}
break;
@@ -949,8 +1012,8 @@
cons_id_p->opt.string_const = string_const;
return TRUE;
} else {
- MB_util_error("Unable to read constructor string"
- " constant\n");
+ MB_util_error("Unable to read constructor"
+ " string constant\n");
return FALSE;
}
break;
@@ -962,8 +1025,8 @@
cons_id_p->opt.float_const = float_const;
return TRUE;
} else {
- MB_util_error("Unable to read constructor float"
- " constant\n");
+ MB_util_error("Unable to read constructor"
+ " float constant\n");
return FALSE;
}
break;
@@ -972,16 +1035,19 @@
MB_CString module_id;
MB_CString pred_id;
MB_Short arity;
+ MB_Byte is_func;
MB_Byte proc_id;
if (MB_read_cstring(fp, &module_id) &&
MB_read_cstring(fp, &pred_id) &&
MB_read_short(fp, &arity) &&
+ MB_read_byte(fp, &is_func) &&
MB_read_byte(fp, &proc_id))
{
cons_id_p->opt.pred_const.module_id = module_id;
cons_id_p->opt.pred_const.pred_id = pred_id;
cons_id_p->opt.pred_const.arity = arity;
+ cons_id_p->opt.pred_const.is_func = is_func;
cons_id_p->opt.pred_const.proc_id = proc_id;
return TRUE;
} else {
@@ -1106,7 +1172,8 @@
tag_p->opt.pair.secondary = secondary;
return TRUE;
} else {
- MB_util_error("Unable to read complicated tag\n");
+ MB_util_error(
+ "Unable to read complicated tag\n");
return FALSE;
}
break;
@@ -1173,7 +1240,8 @@
op_arg_p->opt.var = var;
return TRUE;
} else {
- MB_util_error("Unable to read variable argument\n");
+ MB_util_error("Unable to read variable"
+ " argument\n");
return FALSE;
}
break;
@@ -1213,6 +1281,5 @@
assert(FALSE); /* not reached*/
return FALSE;
} /* end MB_read_op_arg() */
-
Index: mb_bytecode.h
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_bytecode.h,v
retrieving revision 1.1
diff -u -r1.1 mb_bytecode.h
--- mb_bytecode.h 2001/01/24 07:42:22 1.1
+++ mb_bytecode.h 2001/01/24 07:44:34
@@ -1,49 +1,26 @@
/*
-** 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_bytecode.h,v 1.1 2001/01/24 07:42:22 lpcam Exp $
-**
** This file contains the bytecode format and data types
** This must be the same as that in compiler/bytecode.m
*/
-
#ifndef MB_BYTECODE_H
-#define MB_BYTECODE_H
+#define MB_BYTECODE_H
#include <stdio.h>
-#include "mercury_conf.h"
-#include "mercury_types.h"
-#include "mercury_float.h"
+#include <mercury_conf.h>
+#include <mercury_types.h>
+#include <mercury_float.h>
+#include "mb_basetypes.h"
+#include "mb_stack.h"
#include "mb_util.h"
-/* XXX expects sizeof(unsigned char) == 1 */
-typedef unsigned char
- MB_Byte;
-
-typedef MR_INT_LEAST16_TYPE
- MB_Short;
-
-typedef MR_Word
- MB_Word;
-
-typedef MR_Integer
- MB_Integer;
-
-typedef MR_Float
- MB_Float;
-
-typedef MR_Float64
- MB_Float64;
-
-typedef MR_Bool
- MB_Bool;
-
typedef struct MB_Tag_struct {
MB_Byte id;
union {
@@ -78,6 +55,12 @@
#define MB_DET_CC_NONDET 5
#define MB_DET_ERRONEOUS 6
#define MB_DET_FAILURE 7
+ /*
+ ** Invalid is used to indicate that there is something wrong with
+ ** this predicate. (Probably contains foreign code) and the bytecode
+ ** version should not be used
+ */
+#define MB_DET_INVALID 99
typedef struct MB_Op_arg_struct {
MB_Byte id;
@@ -128,7 +111,13 @@
MB_CString module_id;
MB_CString pred_id;
MB_Short arity;
+ MB_Byte is_func;
MB_Byte proc_id;
+
+ /* Whether call is a native code call */
+ MB_Byte is_native;
+ /* code address to call */
+ MB_Word* adr;
} pred_const;
struct {
MB_CString module_id;
@@ -159,9 +148,18 @@
#define MB_CONSID_BASE_TYPE_INFO_CONST 6
#define MB_CONSID_CHAR_CONST 7
+/*
+** Internal label structure. index is read from the file and translated
+** into adr, which is the actual code address of a label
+*/
+typedef union {
+ MB_Short index;
+ MB_Word* adr;
+} MB_Label;
+
typedef union MB_Bytecode_Arg_tag {
struct {
- MB_CString pred_name; /* XXX: malloc */
+ MB_CString pred_name;
MB_Short pred_arity;
MB_Byte is_func;
MB_Short proc_count;
@@ -174,16 +172,21 @@
MB_Byte proc_id;
MB_Determinism det;
MB_Short label_count;
+ MB_Label end_label;
MB_Short temp_count;
MB_Short list_length;
- MB_CString *var_info_list; /* XXX: malloc */
+ MB_CString* var_info;
- /* index onto label heap for label indexes
- * (not in the file) */
+ /*
+ ** index onto label heap for label indexes
+ ** (not in the file)
+ */
MB_Word label_index;
} enter_proc;
struct {
+ /* start of proc (not in file) */
+ MB_Word* proc_start;
} endof_proc;
struct {
@@ -191,67 +194,89 @@
} label;
struct {
- MB_Short end_label;
+ MB_Label end_label;
} enter_disjunction;
struct {
} endof_disjunction;
struct {
- MB_Short next_label;
+ MB_Label next_label;
} enter_disjunct;
struct {
- MB_Short label; /* XXX: what's label for? */
+ MB_Label end_label;
} endof_disjunct;
struct {
MB_Short var;
- MB_Short end_label;
+ MB_Label end_label;
} enter_switch;
struct {
+
} endof_switch;
struct {
MB_Cons_id cons_id;
- MB_Short next_label;
+ MB_Label next_label;
+
+ /* filled in at load time */
+ MB_Short var;
} enter_switch_arm;
struct {
- MB_Short label; /* XXX: what's this label for? */
+ MB_Label end_label;
} endof_switch_arm;
struct {
- MB_Short else_label;
- MB_Short end_label;
+ MB_Label else_label;
+ MB_Label end_label;
MB_Short frame_ptr_tmp;
} enter_if;
+ /*
+ ** identical to enter_else: if you change this, modify instr_else
+ ** to reflect
+ */
struct {
MB_Short frame_ptr_tmp;
} enter_then;
struct {
- MB_Short follow_label;
- } endof_then; /* XXX: should rename to enter_else */
+ MB_Label follow_label;
+ } endof_then;
+ /*
+ ** identical to enter_then: if you change this, modify instr_then
+ ** to reflect
+ */
struct {
+ MB_Short frame_ptr_tmp;
+ } enter_else;
+
+ struct {
+
} endof_if;
struct {
- MB_Short end_label;
+ MB_Short frame_ptr_tmp;
+ MB_Label end_label;
} enter_negation;
struct {
+ MB_Short frame_ptr_tmp;
+ } endof_negation_goal;
+
+ struct {
} endof_negation;
struct {
- MB_Short temp;
+ MB_Short frame_ptr_tmp;
} enter_commit;
struct {
- MB_Short temp;
+ MB_Short frame_ptr_tmp;
} endof_commit;
struct {
@@ -268,28 +293,28 @@
MB_Short to_var;
MB_Cons_id consid;
MB_Short list_length;
- MB_Short *var_list; /* XXX: malloc */
+ MB_Short* var_list;
} construct;
struct {
MB_Short from_var;
MB_Cons_id consid;
MB_Short list_length;
- MB_Short *var_list; /* XXX: malloc */
+ MB_Short* var_list;
} deconstruct;
struct {
MB_Short to_var;
MB_Cons_id consid;
MB_Short list_length;
- MB_Var_dir *var_dir_list;/* XXX: malloc */
+ MB_Var_dir* var_dir;
} complex_construct;
struct {
MB_Short from_var;
MB_Cons_id consid;
MB_Short list_length;
- MB_Var_dir *var_dir_list;/* XXX: malloc */
+ MB_Var_dir* var_dir;
} complex_deconstruct;
struct {
@@ -303,13 +328,16 @@
} pickup_arg;
struct {
- MB_CString module_id; /* XXX: malloc */
- MB_CString pred_id; /* XXX: malloc */
+ MB_CString module_id;
+ MB_CString pred_id;
MB_Short arity;
+ MB_Byte is_func;
MB_Byte proc_id;
+ /* Whether call is local (to bytecode) or external */
+ MB_Byte is_native;
/* code address to call (generated when file is loaded) */
- MB_Word adr;
+ MB_Word* adr;
} call;
struct {
@@ -359,6 +387,7 @@
struct {
} not_supported;
+
} MB_Bytecode_Arg;
typedef struct MB_Bytecode_struct {
@@ -384,7 +413,6 @@
#define MB_BC_endof_switch_arm 12
#define MB_BC_enter_if 13
#define MB_BC_enter_then 14
-/* XXX: enter_else would be a better name than endof_then */
#define MB_BC_endof_then 15
#define MB_BC_endof_if 16
#define MB_BC_enter_negation 17
@@ -410,30 +438,34 @@
#define MB_BC_fail 37
#define MB_BC_context 38
#define MB_BC_not_supported 39
+#define MB_BC_enter_else 40
+#define MB_BC_endof_negation_goal 41
/* These are used internally by the interpreter */
/* all codes above MB_BC_debug are debugging values */
-#define MB_BC_debug 254
-#define MB_BC_debug_trap 254
-#define MB_BC_debug_invalid 255
-/*#define MB_BC_noop 255*/
+#define MB_BC_debug 0x3d
+#define MB_BC_debug_trap 0x3e
+#define MB_BC_debug_invalid 0x3f
+/*
+** Note that the limit to these is determined in mb_module.c by the
+** number of bits allocated to an id
+*/
/*
- * Read the next bytecode from the stream fp.
- * If no bytecode can be read, return FALSE.
- * Otherwise, return TRUE.
- */
+** Read the next bytecode from the stream fp.
+** If no bytecode can be read, return FALSE.
+** Otherwise, return TRUE.
+*/
MB_Bool
MB_read_bytecode(FILE *fp, MB_Bytecode *bc_p);
/*
- * Read the bytecode version number from the stream fp.
- * If the version number cannot be read, return FALSE.
- * Otherwise, return TRUE.
- */
+** Read the bytecode version number from the stream fp.
+** If the version number cannot be read, return FALSE.
+** Otherwise, return TRUE.
+*/
MB_Bool
MB_read_bytecode_version_number(FILE *fp, MB_Short *version_number_p);
#endif /* MB_BYTECODE_H */
-
Index: mb_disasm.c
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_disasm.c,v
retrieving revision 1.1
diff -u -r1.1 mb_disasm.c
--- mb_disasm.c 2001/01/24 07:42:23 1.1
+++ mb_disasm.c 2001/01/24 07:44:34
@@ -1,35 +1,36 @@
/*
-** Copyright (C) 2000 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_disasm.c,v 1.1 2001/01/24 07:42:23 lpcam Exp $
-**
** Contains functions for disassembling bytecodes into human readable
form
**
*/
+/* XXX: the format strings used below assume that MB_Word is an int and
+** that casting MB_Word to int for printing will produce no strange
effects
+*/
+
/* Imports */
#include <assert.h>
#include <ctype.h>
#include <string.h>
+#include <stdio.h>
#include "mb_disasm.h"
#include "mb_util.h"
+#include "mb_machine_def.h"
/* Exported definitions */
-int MB_str_bytecode(MB_Bytecode bc, char* buffer, int buffer_len, int
indent_level);
-void MB_listing(MB_Machine_State* ms, FILE* fp, MB_Word start, MB_Word
end);
+int MB_str_bytecode(MB_Machine_State* ms, MB_Word* adr,
+ char* buffer, int buffer_len, int indent_level);
-/* Local declarations */
+void MB_listing(MB_Machine_State* ms, FILE* fp, MB_Word* start,
MB_Word* end,
+ MB_Word line_len);
-static char
-rcs_id[] = "$Id: mb_disasm.c,v 1.1 2001/01/24 07:42:23 lpcam Exp $";
-
-/* Fills a string buffer with the name of a bytecode */
-int MB_str_bytecode(MB_Bytecode bc, char* buffer, int buffer_len, int
indent_level);
+/* Local declarations */
/* Fills a c string buffer with to the name of a constructor id */
static void str_cons_id(MB_Cons_id cons_id, char* buffer, int
buffer_len);
@@ -106,16 +107,29 @@
*/
#define PrintCall(x, y) (x)((y), buffer, buffer_len); \
PrintFillCheck()
+/*
+** Fills a string corresponding to a bytecode
+** returns indent level for subsequent instructions
+**
+** if buffer is NULL or buffer_len is <= 0 then only returns
+** new indent level
+**
+** The general convention is for arguments to be in square brackets
+** and calculated arguments (ie not in the bytecode file) in round
brackets
+*/
-/* Fills a string corresponding to a bytecode */
-/* returns indent level for subsequent instructions */
-/* if buffer is NULL then only returns change in indent level */
int
-MB_str_bytecode(MB_Bytecode bc, char* buffer, int buffer_len, int
indent_level)
+MB_str_bytecode(MB_Machine_State* ms, MB_Word* adr, char* buffer,
+ int buffer_len, int indent_level)
{
+ MB_Byte bc_id = MB_code_get_id(adr);
+ MB_Bytecode_Arg* bca = MB_code_get_arg(adr);
+
+ /* calculate indent changes */
int this_indent = indent_level;
int next_indent = indent_level;
- switch (bc.id) {
+
+ switch (bc_id) {
case MB_BC_enter_pred:
case MB_BC_enter_proc:
case MB_BC_enter_disjunction:
@@ -130,6 +144,8 @@
case MB_BC_label:
case MB_BC_enter_then:
case MB_BC_endof_then:
+ case MB_BC_enter_else:
+ case MB_BC_endof_negation_goal:
this_indent--;
break;
case MB_BC_endof_pred:
@@ -169,9 +185,22 @@
}
if (next_indent < 0) next_indent = 0;
+
- if (buffer == NULL) return next_indent;
+ /* if we only wanted to calculate the indents, return now */
+ if (buffer == NULL || buffer_len <= 0) return next_indent;
+
+ /* indicate det/nondet code */
+ /*
+ Print()
+ "%c",
+ (MB_code_get_det(adr) ? '+' : '-')
+ EndPrint()
+ */
+
+
+ /* print the indents */
while (this_indent > 0) {
Print()
" "
@@ -181,185 +210,237 @@
Print()
"%s",
- str_bytecode_name(bc.id)
+ str_bytecode_name(bc_id)
EndPrint()
- switch (bc.id) {
+ switch (bc_id) {
case MB_BC_enter_pred:
Print()
" %s %s/%d (%d procs)",
- bc.opt.enter_pred.is_func ? "func" : "pred",
- bc.opt.enter_pred.pred_name,
- bc.opt.enter_pred.pred_arity,
- bc.opt.enter_pred.proc_count
+ bca->enter_pred.is_func ? "func" : "pred",
+ bca->enter_pred.pred_name,
+ (int)bca->enter_pred.pred_arity,
+ (int)bca->enter_pred.proc_count
EndPrint()
break;
+
case MB_BC_endof_pred:
/* No args */
buffer[0] = 0;
break;
+
case MB_BC_enter_proc: {
MB_Short i;
MB_Short len;
Print()
- " proc %d: %s, %d labels, %d temps, %d vars:",
- bc.opt.enter_proc.proc_id,
- str_determinism_name(bc.opt.enter_proc.det),
- bc.opt.enter_proc.label_count,
- bc.opt.enter_proc.temp_count,
- bc.opt.enter_proc.list_length
+ " proc %d: [%s] [%d labels] [endlabel %p]"
+ " [%d temps] [%d vars]",
+ (int)bca->enter_proc.proc_id,
+ str_determinism_name(bca->enter_proc.det),
+ (int)bca->enter_proc.label_count,
+ bca->enter_proc.end_label.adr,
+ (int)bca->enter_proc.temp_count,
+ (int)bca->enter_proc.list_length
EndPrint()
- len = bc.opt.enter_proc.list_length;
+ len = bca->enter_proc.list_length;
for (i = 0; i < len; i++) {
Print()
" %s",
- bc.opt.enter_proc.var_info_list[i]
+ bca->enter_proc.var_info[i]
+
EndPrint()
}
break;
}
case MB_BC_endof_proc:
- /* No args */
+ Print()
+ " (%p)",
+ bca->endof_proc.proc_start
+ EndPrint()
break;
+
case MB_BC_label:
Print()
" %d",
- bc.opt.label.label
+ (int)bca->label.label
EndPrint()
break;
+
case MB_BC_enter_disjunction:
Print()
- " %d",
- bc.opt.enter_disjunction.end_label
+ " [endlabel %p]",
+ bca->enter_disjunction.end_label.adr
EndPrint()
break;
+
case MB_BC_endof_disjunction:
/* No args */
buffer[0] = 0;
break;
+
case MB_BC_enter_disjunct:
Print()
- " %d",
- bc.opt.enter_disjunct.next_label
+ " [nextlabel %p]",
+ bca->enter_disjunct.next_label.adr
EndPrint()
break;
+
case MB_BC_endof_disjunct:
Print()
- " %d",
- bc.opt.endof_disjunct.label
+ " [endlabel %p]",
+ bca->endof_disjunct.end_label.adr
EndPrint()
break;
+
case MB_BC_enter_switch:
Print()
- " on %d, label %d",
- bc.opt.enter_switch.var,
- bc.opt.enter_switch.end_label
+ " [var %d] [endlabel %p]",
+ bca->enter_switch.var,
+ bca->enter_switch.end_label.adr
EndPrint()
break;
+
case MB_BC_endof_switch:
/* No args */
buffer[0] = 0;
break;
+
case MB_BC_enter_switch_arm:
Print()
- " "
+ " (on var %d) ",
+ (int)bca->enter_switch_arm.var
EndPrint()
- PrintCall(str_cons_id, bc.opt.enter_switch_arm.cons_id)
+ PrintCall(str_cons_id, bca->enter_switch_arm.cons_id)
Print()
- " %d",
- bc.opt.enter_switch_arm.next_label
+ " [nextlabel %p]",
+ bca->enter_switch_arm.next_label.adr
EndPrint()
break;
+
case MB_BC_endof_switch_arm:
Print()
- " endlabel %d",
- bc.opt.endof_switch_arm.label
+ " [endlabel %p]",
+ bca->endof_switch_arm.end_label.adr
EndPrint()
break;
+
case MB_BC_enter_if:
Print()
- " else %d, end %d, frame %d",
- bc.opt.enter_if.else_label,
- bc.opt.enter_if.end_label,
- bc.opt.enter_if.frame_ptr_tmp
+ " [else %p] [end %p] [frame %d]",
+ bca->enter_if.else_label.adr,
+ bca->enter_if.end_label.adr,
+ (int)bca->enter_if.frame_ptr_tmp
EndPrint()
break;
+
case MB_BC_enter_then:
Print()
- " %d",
- bc.opt.enter_then.frame_ptr_tmp
+ " [frame %d]",
+ (int)bca->enter_then.frame_ptr_tmp
EndPrint()
break;
+
case MB_BC_endof_then:
Print()
- " %d",
- bc.opt.endof_then.follow_label
+ " [follow %p]",
+ bca->endof_then.follow_label.adr
EndPrint()
break;
+
+ case MB_BC_enter_else:
+ Print()
+ " [frame %d]",
+ (int)bca->enter_else.frame_ptr_tmp
+ EndPrint()
+ break;
+
+
case MB_BC_endof_if:
/* No args */
buffer[0] = 0;
break;
+
case MB_BC_enter_negation:
- printf(" %d", bc.opt.enter_negation.end_label);
+ Print()
+ " [frame %d] [endlabel %p]",
+ (int)bca->enter_negation.frame_ptr_tmp,
+ bca->enter_negation.end_label.adr
+ EndPrint()
break;
+
+ case MB_BC_endof_negation_goal:
+ Print()
+ " [frame %d]",
+ (int)bca->endof_negation_goal.frame_ptr_tmp
+ EndPrint()
+
case MB_BC_endof_negation:
/* No args */
buffer[0] = 0;
break;
+
case MB_BC_enter_commit:
Print()
- " %d",
- bc.opt.enter_commit.temp
+ " [frame %d]",
+ (int)bca->enter_commit.frame_ptr_tmp
EndPrint()
break;
+
case MB_BC_endof_commit:
Print()
- " %d",
- bc.opt.endof_commit.temp
+ " [frame %d]",
+ (int)bca->endof_commit.frame_ptr_tmp
EndPrint()
break;
+
case MB_BC_assign:
Print()
- " %d %d",
- bc.opt.assign.to_var,
- bc.opt.assign.from_var
+ " [var %d] <= [var %d]",
+ (int)bca->assign.to_var,
+ (int)bca->assign.from_var
EndPrint()
break;
+
case MB_BC_test:
Print()
- " %d %d",
- bc.opt.test.var1,
- bc.opt.test.var2
+ " [var %d] == [var %d]",
+ (int)bca->test.var1,
+ (int)bca->test.var2
EndPrint()
break;
+
case MB_BC_construct: {
MB_Short len;
MB_Short i;
Print()
- " %d ",
- bc.opt.construct.to_var
+ " [var %d] <= ",
+ (int)bca->construct.to_var
EndPrint()
- PrintCall(str_cons_id,bc.opt.construct.consid)
+ PrintCall(str_cons_id,bca->construct.consid)
- len = bc.opt.construct.list_length;
+ len = bca->construct.list_length;
Print()
- " %d",
- len
+ " [%d var%s%s",
+ (int)len,
+ (len != 0) ? "s" : "",
+ (len > 0) ? ":" : ""
EndPrint()
for (i = 0; i < len; i++) {
Print()
" %d",
- bc.opt.construct.var_list[i]
+ (int)bca->construct.var_list[i]
EndPrint()
}
+ Print()
+ "]"
+ EndPrint()
break;
}
case MB_BC_deconstruct: {
@@ -367,25 +448,30 @@
MB_Short i;
Print()
- " %d ",
- bc.opt.deconstruct.from_var
+ " [var %d] ",
+ (int)bca->deconstruct.from_var
EndPrint()
- PrintCall(str_cons_id,bc.opt.deconstruct.consid)
+ PrintCall(str_cons_id,bca->deconstruct.consid)
- len = bc.opt.deconstruct.list_length;
+ len = bca->deconstruct.list_length;
Print()
- " %d",
- len
+ " [%d var%s%s",
+ (int)len,
+ (len != 0) ? "s" : "",
+ (len > 0) ? ":" : ""
EndPrint()
for (i = 0; i < len; i++) {
Print()
" %d",
- bc.opt.deconstruct.var_list[i]
+ (int)bca->deconstruct.var_list[i]
EndPrint()
}
+ Print()
+ "]"
+ EndPrint()
break;
}
case MB_BC_complex_construct: {
@@ -394,15 +480,15 @@
Print()
" %d ",
- bc.opt.complex_construct.to_var
+ (int)bca->complex_construct.to_var
EndPrint()
- PrintCall(str_cons_id,bc.opt.complex_construct.consid);
+ PrintCall(str_cons_id,bca->complex_construct.consid);
- len = bc.opt.complex_construct.list_length;
+ len = bca->complex_construct.list_length;
Print()
- " %d", len
+ " %d", (int)len
EndPrint()
for (i = 0; i < len; i++) {
@@ -411,7 +497,7 @@
EndPrint()
PrintCall(str_var_dir,
- bc.opt.complex_construct.var_dir_list[i])
+ bca->complex_construct.var_dir[i])
}
break;
}
@@ -421,15 +507,15 @@
Print()
" %d ",
- bc.opt.complex_deconstruct.from_var
+ (int)bca->complex_deconstruct.from_var
EndPrint()
- PrintCall(str_cons_id,bc.opt.complex_deconstruct.consid);
+ PrintCall(str_cons_id,bca->complex_deconstruct.consid);
- len = bc.opt.complex_deconstruct.list_length;
+ len = bca->complex_deconstruct.list_length;
Print()
" %d",
- len
+ (int)len
EndPrint()
for (i = 0; i < len; i++) {
@@ -438,120 +524,136 @@
EndPrint()
PrintCall(str_var_dir,
- bc.opt.complex_deconstruct.var_dir_list[i])
+ bca->complex_deconstruct.var_dir[i])
}
break;
}
case MB_BC_place_arg:
Print()
- ": r[%d] <= slot %d",
- bc.opt.place_arg.to_reg,
- bc.opt.place_arg.from_var
+ " [r%d] <= [var %d]",
+ (int)bca->place_arg.to_reg,
+ (int)bca->place_arg.from_var
EndPrint()
break;
+
case MB_BC_pickup_arg:
Print()
- ": r[%d] => slot %d",
- bc.opt.pickup_arg.from_reg,
- bc.opt.pickup_arg.to_var
+ " [r%d] => [var %d]",
+ (int)bca->pickup_arg.from_reg,
+ (int)bca->pickup_arg.to_var
EndPrint()
break;
+
case MB_BC_call:
Print()
- " %s %s %d %d (%08x)",
- bc.opt.call.module_id,
- bc.opt.call.pred_id,
- bc.opt.call.arity,
- bc.opt.call.proc_id,
- bc.opt.call.adr
+ " [%s %s__%s/%d] [proc %d (%s %p)]",
+ 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.is_native ? "natv" : "byte",
+ bca->call.adr
EndPrint()
break;
+
case MB_BC_higher_order_call:
Print()
- " %d %d %d %s",
- bc.opt.higher_order_call.pred_var,
- bc.opt.higher_order_call.in_var_count,
- bc.opt.higher_order_call.out_var_count,
- str_determinism_name(bc.opt.higher_order_call.det)
+ " [var %d] [invars %d] [outvars %d] [%s]",
+ (int)bca->higher_order_call.pred_var,
+ (int)bca->higher_order_call.in_var_count,
+ (int)bca->higher_order_call.out_var_count,
+ str_determinism_name(bca->higher_order_call.det)
EndPrint()
break;
+
case MB_BC_builtin_binop:
Print()
": "
EndPrint()
- PrintCall(str_op_arg,bc.opt.builtin_binop.arg1)
+ PrintCall(str_op_arg,bca->builtin_binop.arg1)
Print()
" %s ",
- str_binop_name(bc.opt.builtin_binop.binop)
+ str_binop_name(bca->builtin_binop.binop)
EndPrint()
- PrintCall(str_op_arg,bc.opt.builtin_binop.arg2)
+ PrintCall(str_op_arg,bca->builtin_binop.arg2)
Print()
- " => %d",
- bc.opt.builtin_binop.to_var
+ " => [var %d]",
+ (int)bca->builtin_binop.to_var
EndPrint()
break;
+
case MB_BC_builtin_unop:
Print()
" %s ",
- str_unop_name(bc.opt.builtin_unop.unop)
+ str_unop_name(bca->builtin_unop.unop)
EndPrint()
- PrintCall(str_op_arg,bc.opt.builtin_unop.arg)
+ PrintCall(str_op_arg,bca->builtin_unop.arg)
Print()
" %d",
- bc.opt.builtin_unop.to_var
+ (int)bca->builtin_unop.to_var
EndPrint()
break;
+
case MB_BC_builtin_bintest:
+
Print()
- " %s ",
- str_binop_name(bc.opt.builtin_bintest.binop)
+ " "
EndPrint()
- PrintCall(str_op_arg,bc.opt.builtin_binop.arg1)
+ PrintCall(str_op_arg,bca->builtin_binop.arg1)
Print()
- " "
+ " %s ",
+ str_binop_name(bca->builtin_bintest.binop)
EndPrint()
- PrintCall(str_op_arg,bc.opt.builtin_binop.arg2)
+ PrintCall(str_op_arg,bca->builtin_binop.arg2)
break;
+
case MB_BC_builtin_untest:
Print()
" %s ",
- str_unop_name(bc.opt.builtin_untest.unop)
+ str_unop_name(bca->builtin_untest.unop)
EndPrint()
- PrintCall(str_op_arg,bc.opt.builtin_unop.arg)
+ PrintCall(str_op_arg,bca->builtin_unop.arg)
break;
+
case MB_BC_semidet_succeed:
/* No args */
buffer[0] = 0;
break;
+
case MB_BC_semidet_success_check:
/* No args */
buffer[0] = 0;
break;
+
case MB_BC_fail:
/* No args */
buffer[0] = 0;
break;
+
case MB_BC_context:
Print()
" %d",
- bc.opt.context.line_number
+ bca->context.line_number
EndPrint()
break;
+
case MB_BC_not_supported:
/* No args */
buffer[0] = 0;
break;
+
default:
- assert(FALSE); /*XXX*/
+ MB_fatal("Attempt to disassemble unknown bytecode");
break;
} /* end switch */
@@ -562,39 +664,29 @@
static void
str_cons_id(MB_Cons_id cons_id, char* buffer, int buffer_len)
{
+ Print()
+ "["
+ EndPrint()
switch (cons_id.id) {
case MB_CONSID_CONS: {
Print()
- "functor %s %s %d ",
+ "functor %s__%s/%d ",
cons_id.opt.cons.module_id,
cons_id.opt.cons.string,
- cons_id.opt.cons.arity
+ (int)cons_id.opt.cons.arity
EndPrint()
PrintCall(str_tag, cons_id.opt.cons.tag)
break;
}
case MB_CONSID_INT_CONST:
- /*
- ** (This comment is labelled "CAST COMMENT".
- ** If you remove this comment, also
- ** remove references to it in this file.
- ** Search for "CAST COMMENT".)
- **
- ** XXX: The cast to `long' in the following code
- ** is needed to remove a warning. `int_const' has
- ** type `Integer', but Integer may be typedef'ed
- ** to `int', `long', `long long' or whatever.
- ** The correct solution may be to define a
- ** format string for Integer in conf.h.
- */
Print()
- "int_const %ld",
- (long) cons_id.opt.int_const
+ "int_const %x",
+ (int)cons_id.opt.int_const
EndPrint()
break;
case MB_CONSID_STRING_CONST: {
Print()
- "string_const "
+ "string_const"
EndPrint()
buffer[buffer_len-1] = 0; /* snprintf may not do it */
@@ -609,12 +701,14 @@
break;
case MB_CONSID_PRED_CONST:
Print()
- "%s %s %s %d %d",
- "pred_const ",
+ "%s %s %s__%s/%d proc %d (%p)",
+ "pred_const",
+ cons_id.opt.pred_const.is_func ?"func":"pred",
cons_id.opt.pred_const.module_id,
cons_id.opt.pred_const.pred_id,
- cons_id.opt.pred_const.arity,
- cons_id.opt.pred_const.proc_id
+ (int)cons_id.opt.pred_const.arity,
+ (int)cons_id.opt.pred_const.proc_id,
+ cons_id.opt.pred_const.adr
EndPrint()
break;
case MB_CONSID_CODE_ADDR_CONST:
@@ -623,38 +717,41 @@
"code_addr_const",
cons_id.opt.code_addr_const.module_id,
cons_id.opt.code_addr_const.pred_id,
- cons_id.opt.code_addr_const.arity,
- cons_id.opt.code_addr_const.proc_id
+ (int)cons_id.opt.code_addr_const.arity,
+ (int)cons_id.opt.code_addr_const.proc_id
EndPrint()
break;
case MB_CONSID_BASE_TYPE_INFO_CONST:
Print()
- "%s %s %s %d",
- "base_type_info_const ",
+ "%s %s__%s/%d",
+ "base_type_info_const",
cons_id.opt.base_type_info_const.module_id,
cons_id.opt.base_type_info_const.type_name,
- cons_id.opt.base_type_info_const.type_arity
+ (int)cons_id.opt.base_type_info_const.type_arity
EndPrint()
break;
case MB_CONSID_CHAR_CONST:
if (isprint(cons_id.opt.char_const.ch)) {
Print()
"%s '%c'",
- "char_const ",
+ "char_const",
cons_id.opt.char_const.ch
EndPrint()
} else {
Print()
"%s %2X",
- "char_const ",
+ "char_const",
(int)cons_id.opt.char_const.ch
EndPrint()
}
break;
default:
- assert(FALSE); /*XXX*/
+ MB_fatal("Attempt to disassemble unknown cons");
break;
} /* end switch */
+ Print()
+ "]"
+ EndPrint()
buffer[buffer_len-1] = 0; /* snprintf may not do it if a long string
*/
} /* end print_cons_id() */
@@ -666,33 +763,34 @@
switch (tag.id) {
case MB_TAG_SIMPLE:
snprintf(buffer, buffer_len,
- "%s %d", "simple_tag", tag.opt.primary);
+ "%s %d",
+ "simple_tag",
+ (int)tag.opt.primary);
break;
case MB_TAG_COMPLICATED:
- /*
- ** See comment labelled "CAST COMMENT".
- */
snprintf(buffer, buffer_len,
- "%s %d %ld", "complicated_tag",
- tag.opt.pair.primary,
- (long) tag.opt.pair.secondary);
+ "%s %d %ld",
+ "complicated_tag",
+ (int)tag.opt.pair.primary,
+ (long int)tag.opt.pair.secondary);
break;
case MB_TAG_COMPLICATED_CONSTANT:
- /*
- ** See comment labelled "CAST COMMENT".
- */
snprintf(buffer, buffer_len,
- "%s %d %ld", "complicated_constant_tag",
- tag.opt.pair.primary,
- (long) tag.opt.pair.secondary);
+ "%s %d %ld",
+ "complicated_constant_tag",
+ (int)tag.opt.pair.primary,
+ (long int)tag.opt.pair.secondary);
break;
case MB_TAG_ENUM:
snprintf(buffer, buffer_len,
- "%s %d", "enum_tag", tag.opt.enum_tag);
+ "%s %d",
+ "enum_tag",
+ (int)tag.opt.enum_tag);
break;
case MB_TAG_NONE:
snprintf(buffer, buffer_len,
- "%s", "no_tag");
+ "%s",
+ "no_tag");
break;
default:
MB_util_error("Invalid tag: %d\n", tag.id);
@@ -724,7 +822,7 @@
"endof_switch_arm",
"enter_if",
"enter_then",
- "endof_then", /* XXX: change to enter_else */
+ "endof_then",
"endof_if",
"enter_negation",
"endof_negation",
@@ -736,7 +834,7 @@
"deconstruct",
"complex_construct",
"complex_deconstruct",
- "place_arg",
+ "place_arg ",
"pickup_arg",
"call",
"higher_order_call",
@@ -748,7 +846,9 @@
"semidet_success_check",
"fail",
"context",
- "not_supported"
+ "not_supported",
+ "enter_else",
+ "endof_negation_goal"
};
static const MB_CString
@@ -940,22 +1040,19 @@
switch (op_arg.id) {
case MB_ARG_VAR:
Print()
- "var %d",
+ "[var %d]",
op_arg.opt.var
EndPrint()
break;
case MB_ARG_INT_CONST:
- /*
- ** See comment labelled "CAST COMMENT".
- */
Print()
- "int %ld",
- (long) op_arg.opt.int_const
+ "[int %x]",
+ (int) op_arg.opt.int_const
EndPrint()
break;
case MB_ARG_FLOAT_CONST:
Print()
- "float %f",
+ "[float %f]",
op_arg.opt.float_const
EndPrint()
break;
@@ -969,37 +1066,42 @@
*/
void
-MB_listing(MB_Machine_State* ms, FILE* fp, MB_Word start, MB_Word end)
+MB_listing(MB_Machine_State* ms, FILE* fp, MB_Word* start, MB_Word*
end,
+ MB_Word line_len)
{
- char buffer[73];
- MB_Word i;
+ char buffer[256];
+ MB_Word* i;
MB_Word indent = 0;
- MB_Word ip = MB_ip_get(ms);
+ MB_Word* ip = MB_ip_get(ms);
+
+ SAY("linelen: %d\n", line_len);
+ start = MB_code_range_check(start);
+ end = MB_code_range_check(end);
+
+ if (sizeof(buffer) < line_len) line_len = sizeof(buffer);
+
/* backtrack to the previous predicate */
/* and assume that it is at indent level 0 */
- i = MB_code_get_pred_adr(ms, start);
+ i = MB_code_get_pred_adr(start);
- /* work out the indent level at the start */
- while (i != start) {
- indent = MB_str_bytecode(MB_code_get(ms, i), NULL, 0, indent);
- i++;
+ if (i != MB_CODE_INVALID_ADR) {
+ /* work out the indent level at the start */
+ while (i != start) {
+ indent = MB_str_bytecode(ms,
+ i, NULL, 0, indent);
+ i++;
+ }
}
/* Show the code */
for (; i != end+1; i++) {
- if (i < 0 || i >= MB_code_size(ms)) {
- fprintf(fp, " %04x (????)\n", i & 0xffff);
- } else {
- indent = MB_str_bytecode(MB_code_get(ms, i),
- buffer, sizeof(buffer), indent);
- fprintf(fp, "%s%04x %s\n",
- (i == ip) ? "-> " : " ",
- i,
- buffer);
- }
+ indent = MB_str_bytecode(ms, i,
+ buffer, line_len, indent);
+ fprintf(fp, "%s%p %s\n",
+ (i == ip) ? "-> " : " ",
+ i,
+ buffer);
}
}
-
-
Index: mb_disasm.h
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_disasm.h,v
retrieving revision 1.1
diff -u -r1.1 mb_disasm.h
--- mb_disasm.h 2001/01/24 07:42:23 1.1
+++ mb_disasm.h 2001/01/24 07:44:34
@@ -1,10 +1,9 @@
/*
-** 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_disasm.h,v 1.1 2001/01/24 07:42:23 lpcam Exp $
*/
#ifndef MB_DISASM_H
@@ -14,17 +13,18 @@
#include "mb_bytecode.h"
#include "mb_machine.h"
+#include "mb_module.h"
-/* Fills a string buffer with the name of a bytecode
-** returns the new indent level after the instruction
+/*
+** Fills a string buffer with the name of a bytecode (if buffer_len >
0)
+** Returns the new indent level after the instruction
*/
-int
-MB_str_bytecode(MB_Bytecode bc, char* buffer, int buffer_len, int
indent_level);
+int MB_str_bytecode(MB_Machine_State* module, MB_Word* adr, char*
buffer,
+ int buffer_len, int indent_level);
/* displays a code listing (see source file for argument description)
*/
-void
-MB_listing(MB_Machine_State* ms, FILE* fp, MB_Word start, MB_Word end);
+void MB_listing(MB_Machine_State*ms, FILE* fp, MB_Word* start, MB_Word*
end,
+ MB_Word line_len);
#endif /* MB_DISASM_H */
-
Index: mb_machine.c
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_machine.c,v
retrieving revision 1.1
diff -u -r1.1 mb_machine.c
--- mb_machine.c 2001/01/24 07:42:25 1.1
+++ mb_machine.c 2001/01/24 07:44:34
@@ -1,10 +1,8 @@
-
/*
-** 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.c,v 1.1 2001/01/24 07:42:25 lpcam Exp $
*/
/* XXX: make this variable */
@@ -17,861 +15,1098 @@
#define INIT_LABELSTACK_SIZE 1000
/* Imports */
+#include <mercury_imp.h>
+
#include <assert.h>
#include <stdio.h>
#include <string.h>
#include "mb_bytecode.h"
#include "mb_disasm.h"
+#include "mb_interface.h"
#include "mb_machine.h"
+#include "mb_machine_def.h"
+
#include "mb_mem.h"
#include "mb_stack.h"
/* Exported definitions */
-
-/* Get the value of a register */
-MB_Word MB_reg_get(MB_Machine_State* ms, MB_Word idx);
-void MB_reg_set(MB_Machine_State* ms, MB_Word idx, MB_Word value);
-MB_Word MB_ip_get(MB_Machine_State* ms);
-void MB_ip_set(MB_Machine_State* ms, MB_Word new_ip);
-MB_Word MB_succip_get(MB_Machine_State* ms);
-void MB_succip_set(MB_Machine_State* ms, MB_Word);
-MB_Bytecode MB_code_get(MB_Machine_State* ms, MB_Word adr);
-MB_Byte MB_code_get_id(MB_Machine_State* ms, MB_Word adr);
-MB_Bytecode_Arg*MB_code_get_arg(MB_Machine_State* ms, MB_Word adr);
-MB_Bytecode MB_code_get_pred(MB_Machine_State* ms, MB_Word adr);
-MB_Word MB_code_get_pred_adr(MB_Machine_State* ms, MB_Word adr);
-MB_Bytecode MB_code_get_proc(MB_Machine_State* ms, MB_Word adr);
-MB_Word MB_code_size(MB_Machine_State* ms);
+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_get(MB_Machine_State* ms,
- MB_Word frame_num, MB_Word idx);
-void MB_frame_temp_set(MB_Machine_State* ms,
- MB_Word frame_num, 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);
-void MB_frame_temp_add(MB_Machine_State* ms, MB_Word count);
-void MB_frame_temp_remove(MB_Machine_State* ms, MB_Word count);
-void MB_frame_add(MB_Machine_State* ms, MB_Word var_count);
-void MB_frame_remove(MB_Machine_State* ms, MB_Word var_count);
-
-MB_Machine_State* MB_load_program(FILE* fp);
-MB_Machine_State* MB_load_program_name(MB_CString filename);
-MB_Bool MB_reset_program(MB_Machine_State* ms);
-void MB_unload_program(MB_Machine_State* ms);
+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
+
+#define CLOBBERPICKUPS 0 /* clobber reg after pickup */
+#define CLOBBERPLACES 0 /* clobber slot after place */
+#define CLOBBERSTACK 1 /* reset new stack vars */
+
#define FILEVERSION 9
/* Local declarations */
-
-static char
-rcs_id[] = "$Id: mb_machine.c,v 1.1 2001/01/24 07:42:25 lpcam Exp $";
-static MB_Word find_entry_point(MB_Machine_State* ms);
+static MB_Bool ip_special(MB_Word ip);
static MB_Bool translate_calls(MB_Machine_State* ms);
-
-/* Implementation */
+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);
-/* Finds the main/2 entry point */
-/* returns (MB_Word)-1 if it can't find it */
-static MB_Word
-find_entry_point(MB_Machine_State* ms)
-{
- /* First find the main procedure */
- MB_Word code_size = MB_code_size(ms);
- MB_Bytecode bc;
- MB_Integer i;
- MB_Byte bcid;
- for (i = 0; i < code_size; i++) {
- /* Search for the main predicate */
- bcid = MB_code_get_id(ms, i);
- if (bcid == MB_BC_enter_pred) {
- bc = MB_code_get(ms, i);
- if (bc.opt.enter_pred.pred_arity == 2 &&
- !bc.opt.enter_pred.is_func &&
- MB_strcmp(bc.opt.enter_pred.pred_name, "main") == 0)
- {
- /* XXX: is proc 0 always the correct entry point? */
- /* Find proc 0 */
- for (i++; i < code_size; i++) {
- bc = MB_code_get(ms, i);
- if (bc.id == MB_BC_endof_pred) break;
- if (bc.id == MB_BC_enter_proc &&
- ((bc.opt.enter_proc.det == MB_DET_DET) ||
- (bc.opt.enter_proc.det == MB_DET_CC_MULTIDET)) &&
- bc.opt.enter_proc.proc_id == 0) {
-
- MB_stack_push(&ms->call.stack, i);
- return i;
- }
-
- }
- }
- }
- }
+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);
- MB_util_error("Unable to find main/2 entry point");
- return (MB_Word)-1;
-} /* find_entry_point */
-
-/* Get the value of a register */
-MB_Word
-MB_reg_get(MB_Machine_State* ms, MB_Word idx)
-{
- assert(idx >= 0);
- assert(idx < MB_MACHINEREGS);
- return ms->reg[idx];
-}
-
-/* Set the value of a register */
-void
-MB_reg_set(MB_Machine_State* ms, MB_Word idx, MB_Word value)
-{
- assert(idx >= 0);
- assert(idx < MB_MACHINEREGS);
- ms->reg[idx] = value;
-}
+/* Implementation */
/* Get the next instruction pointer */
-MB_Word
+MB_Word*
MB_ip_get(MB_Machine_State* ms)
{
return ms->ip;
}
-
+/* set the native code return address */
void
-MB_ip_set(MB_Machine_State* ms, MB_Word new_ip)
+MB_native_return_set(MB_Machine_State* ms, MB_Word* native_return)
{
- assert(new_ip >= 0);
- assert(new_ip < ms->code.count);
- ms->ip = new_ip;
+ ms->native_return = native_return;
}
- /* Get the success instruction pointer */
-MB_Word
-MB_succip_get(MB_Machine_State* ms)
+MB_Word*
+MB_native_return_get(MB_Machine_State* ms)
{
- return ms->det.succip;
+ return ms->native_return;
}
-
void
-MB_succip_set(MB_Machine_State* ms, MB_Word new_ip)
+MB_ip_set(MB_Machine_State* ms, MB_Word* new_ip)
{
- ms->det.succip = new_ip;
-}
-
-/* Get the actual size of a program, in bytecodes */
-MB_Word
-MB_code_size(MB_Machine_State* ms)
-{
- return ms->code.count;
+ if (MB_ip_special(new_ip)) {
+ 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:
+ instr_do_redo(ms, NULL);
+ 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;
+ }
}
-
-#define ARGSIZE(name) (sizeof(((MB_Bytecode*)NULL)->opt.##name) + \
- sizeof(MB_Word)-1) \
- / sizeof(MB_Word)
-/* 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)
-};
-/* Get the bytecode at a given address; performs a range check */
-MB_Bytecode
-MB_code_get(MB_Machine_State* ms, MB_Word adr)
+/* Check which function we are in & save pointers to temp & var slots
*/
+void
+MB_func_type_check(MB_Machine_State* ms)
{
- MB_Bytecode bc;
+ /*
+ ** 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);
- assert(adr >= 0 && adr < ms->code.count);
+ SAY("Hello from func_type_check");
- bc.id = MB_code_get_id(ms, adr);
+ if (!MB_ip_normal(ip)) return;
- assert(bc.id < sizeof(argument_size)/sizeof(argument_size[0]));
+ /* Check that we are actually in a function and not just entering one
*/
+ if (MB_code_get_id(ip) != MB_BC_enter_proc) {
- if (argument_size[bc.id] > 0) {
-
- memcpy(&(bc.opt),
- MB_code_get_arg(ms, adr),
- argument_size[bc.id]*sizeof(MB_Word));
+ /* 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_frameitem(MB_FRAME_SIZE));
+
+ } else {
+ SAY(" not getting func type of unentered function");
}
- return bc;
}
-/* Get the bytecode type at a given address */
-MB_Byte
-MB_code_get_id(MB_Machine_State* ms, MB_Word adr)
+/* Get a variable */
+/* XXX no range check (even when debugging) */
+MB_Word
+MB_var_get(MB_Machine_State* ms, MB_Word idx)
{
- if (adr < 0 || adr >= ms->code.count)
- return MB_BC_debug_invalid;
- return ms->code.id[adr];
+ return ms->cur_proc.var[-idx];
}
-/* Get the bytecode argument at a given address */
-MB_Bytecode_Arg*
-MB_code_get_arg(MB_Machine_State* ms, MB_Word adr)
+/* Set a variable on the det stack */
+void
+MB_var_set(MB_Machine_State* ms, MB_Word idx, MB_Word value)
{
- MB_Word data_index;
+ ms->cur_proc.var[-idx] = value;
+}
- if (adr < 0 || adr >= ms->code.count) return NULL;
+/* Add a temporary det stack frame */
+MB_Word
+MB_frame_temp_det_push(MB_Machine_State* ms, MB_Word redoip)
+{
+ MB_fatal("MB_frame_temp_det_push not implemented yet");
+ return 0;
+#if 0
+ MB_Word maxfr = MB_maxfr_get(ms);
+ MB_Word prevfr = maxfr;
- data_index = MB_stack_peek(&ms->code.data_index, adr);
- if (data_index == 0) {
- return NULL;
- } else {
- return (void*)MB_stack_peek_p(&ms->code.data, data_index);
- }
-}
+ maxfr += MB_FRAME_TEMP_DET_SIZE;
+ MB_maxfr_set(ms, maxfr);
-/* Get the predicate owning the code at adr */
-MB_Bytecode
-MB_code_get_pred(MB_Machine_State* ms, MB_Word adr)
-{
- MB_Word pred_adr = MB_code_get_pred_adr(ms, 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;
- }
-
+ MB_frame_max_set(ms, MB_FRAME_PREVFR, prevfr);
+ MB_frame_max_set(ms, MB_FRAME_REDOIP, redoip);
+ MB_frame_max_set(ms, MB_FRAME_REDOFR, MB_curfr_get(ms));
+ MB_frame_max_set(ms, MB_FRAME_DETFR, MB_stack_size(&ms->det.stack));
- return MB_code_get(ms, pred_adr);
+ return maxfr;
+#endif
}
+/* Add a temporary stack frame */
MB_Word
-MB_code_get_pred_adr(MB_Machine_State* ms, MB_Word adr) {
+MB_frame_temp_push(MB_Machine_State* ms, MB_Word redoip)
+{
+ MB_fatal("MB_frame_temp_push not implemented yet");
+ return 0;
+#if 0
+ if (ms->cur_proc.detism == MB_CUR_DET) {
+ return MB_frame_temp_det_push(ms, redoip);
+ } else {
+ MB_Word maxfr = MB_maxfr_get(ms);
+ MB_Word prevfr = maxfr;
- while (MB_code_get_id(ms, adr) != MB_BC_enter_pred) {
+ maxfr += MB_FRAME_TEMP_SIZE;
+ MB_maxfr_set(ms, maxfr);
- adr--;
- if (adr < 0 || adr >= ms->code.count) {
- return MB_CODE_INVALID_ADR;
- }
- }
+ MB_frame_max_set(ms, MB_FRAME_PREVFR, prevfr);
+ MB_frame_max_set(ms, MB_FRAME_REDOIP, redoip);
+ MB_frame_max_set(ms, MB_FRAME_REDOFR, MB_curfr_get(ms));
- return adr;
+ return maxfr;
+ }
+#endif
}
-/* Get the procedure owning the code at adr */
-MB_Bytecode
-MB_code_get_proc(MB_Machine_State* ms, MB_Word adr)
+/* Add a stack frame */
+MB_Word
+MB_frame_push(MB_Machine_State*ms, MB_Word redoip,
+ MB_Word succip, MB_Word vars, MB_Word temps)
{
- MB_Byte bc_id;
- adr++;
- do {
- adr--;
- assert(adr >= 0 && adr < ms->code.count);
- bc_id = MB_code_get_id(ms, adr);
- assert(bc_id != MB_BC_enter_pred);
- assert(bc_id != MB_BC_endof_pred);
- }
- while (bc_id != MB_BC_enter_proc);
+ MB_fatal("MB_frame_temp_push not implemented yet");
+ return 0;
+#if 0
+ MB_Word maxfr = MB_maxfr_get(ms);
+ MB_Word prevfr = maxfr;
+ MB_Word succfr = MB_curfr_get(ms);
+
+ maxfr += MB_FRAME_SIZE + vars + temps;
+
+ MB_maxfr_set(ms, maxfr);
+ MB_curfr_set(ms, maxfr);
+
+ MB_frame_cur_set(ms, MB_FRAME_NUMVARS, vars);
+ MB_frame_cur_set(ms, MB_FRAME_REDOIP, redoip);
+ MB_frame_cur_set(ms, MB_FRAME_PREVFR, prevfr);
+ MB_frame_cur_set(ms, MB_FRAME_SUCCIP, succip);
+ MB_frame_cur_set(ms, MB_FRAME_SUCCFR, succfr);
+ MB_frame_cur_set(ms, MB_FRAME_REDOFR, MB_curfr_get(ms));
- return MB_code_get(ms, adr);
+ return maxfr;
+#endif
}
-/* Translates calls from a predicate name / procedure to an actual code
address */
-static MB_Bool
-translate_calls(MB_Machine_State* ms)
+/* 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)
{
- /* first run through and save all the predicate names table
- ** XXX: should use a hash table for this: mercury_hash_table
- ** has one but it doesn't use the same memory allocation as
- ** in mb_mem.h - Is this a problem?
- */
- MB_Stack pred_stack;
- MB_Word i;
- pred_stack = MB_stack_new(100); /* guess 100 preds (grows as needed)
*/
- for (i = 0; i < MB_code_size(ms); i++) {
- if (MB_code_get_id(ms, i) == MB_BC_enter_pred) {
- MB_stack_push(&pred_stack, i);
- }
- }
+ MB_fatal("MB_frame_var_set not implemented yet");
+#if 0
+ MB_stack_poke(&ms->nondet.stack,
+ MB_curfr_get(ms) - MB_FRAME_SIZE - idx, val);
+#endif
+}
+/* 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_fatal("MB_frame_var_get not implemented yet");
+ return 0;
+#if 0
+ return MB_stack_peek(&ms->nondet.stack,
+ MB_curfr_get(ms) - MB_FRAME_SIZE - idx);
+#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);
+/* 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);
+
+/* 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);
+
+/* 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);
- /* XXX: should also 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
- */
+/* XXX det and nondet conditions (ite / disjunct / commit) all use the
same
+** [would require modifying bytecode ids?]
+*/
- for (i = 0; i < MB_code_size(ms); i++) {
+/* 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*/
+ instr_enter_proc,
+ instr_endof_proc,
+ instr_noop, /* label */
+ instr_enter_disjunction,
+ instr_endof_disjunction,
+ instr_enter_disjunct,
+ instr_endof_disjunct,
+ instr_enter_switch,
+ instr_endof_switch,
+ instr_enter_switch_arm,
+ instr_endof_switch_arm,
+ instr_enter_if,
+ instr_enter_then,
+ instr_endof_then,
+ instr_endof_if,
+ instr_enter_negation,
+ instr_endof_negation,
+ instr_enter_commit,
+ instr_endof_commit,
+ instr_assign,
+ instr_test,
+ instr_construct,
+ instr_deconstruct,
+ instr_notdone, /**** complex construct */
+ instr_notdone, /**** complex deconstruct */
+ instr_place,
+ instr_pickup,
+ instr_call,
+ instr_higher_order_call,
+ instr_builtin_binop,
+ instr_builtin_unop, /**** unop */
+ instr_builtin_bintest,
+ instr_builtin_untest, /**** unop test */
+ instr_semidet_success,
+ instr_semidet_success_check,
+ instr_do_redo, /* fail */
+ instr_noop, /* context */
+ instr_notdone, /* not supported */
+ instr_enter_then, /* enter_else (identical to enter_then) */
+ instr_endof_negation_goal
+};
- /* If we have found a call, find its destination address */
- if (MB_code_get_id(ms, i) == MB_BC_call) {
+static void
+instr_invalid(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+{
+ assert(FALSE);
+}
- MB_Bytecode_Arg* call_arg = MB_code_get_arg(ms, i);
- MB_Byte bc_id;
- MB_Word adr;
- MB_Word j = MB_CODE_INVALID_ADR;
-
- adr = MB_CODE_INVALID_ADR;
- /* Search for the right procedure*/
- for (j = 0; j < MB_stack_size(&pred_stack); j++) {
-
- MB_Bytecode_Arg* pred_arg;
- adr = MB_stack_peek(&pred_stack, j);
-
- pred_arg = MB_code_get_arg(ms, adr);
-
-
-
- /* XXX: we can't distinguish between predicates
- ** and functions in the same module, of the same
- ** arity! (bug in bytecode generator)
- */
-
- /* XXX: We ignore the module*/
- if ((pred_arg->enter_pred.pred_arity == call_arg->call.arity) &&
- MB_strcmp(pred_arg->enter_pred.pred_name,
- call_arg->call.pred_id) == 0)
- {
- break;
- }
- }
+/* Enter/exit procedure */
+static void
+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+
+ MB_DETFRAME_SIZE;
+ 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;
- if (j == MB_stack_size(&pred_stack)) {
- MB_util_error("Call from %08x to unknown predicate %s/%d",
- (int)i, call_arg->call.pred_id,
- (int)call_arg->call.arity);
- call_arg->call.adr = MB_CODE_INVALID_ADR;
- continue;
- }
+ MB_ip_set(ms, MB_ip_get(ms)+1);
- /* Now find the right proc */
- do {
- adr++;
-
- assert(adr < MB_code_size(ms) && adr >= 0);
-
- bc_id = MB_code_get_id(ms, adr);
- if (bc_id == MB_BC_enter_proc) {
- if (MB_code_get_arg(ms, adr)->enter_proc.proc_id ==
- call_arg->call.proc_id)
- {
- call_arg->call.adr = adr;
- break;
- }
- } else if ((bc_id == MB_BC_endof_pred) ||
- (bc_id == MB_BC_enter_pred))
- {
- MB_util_error(
- "Call from %08x to unknown predicate"
- "procedure %s/%d (%d)",
- i, call_arg->call.pred_id,
- (int)call_arg->call.arity,
- (int)call_arg->call.proc_id);
- /* XXX: This should eventually be fatal */
- MB_fatal("Error generating call addresses\n");
- break;
- }
- } while (1);
+ break;
+ }
+ case MB_DET_MULTIDET:
+ case MB_DET_NONDET: {
- if (adr >= MB_code_size(ms)) {
- MB_stack_delete(&pred_stack);
- return FALSE;
- }
+ #if 0
+ MB_fatal("enter_proc/multidet,nondet");
+ 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);
+ #endif
+
+ break;
}
+ /* XXX Other options */
+ default:
+ instr_notdone(ms, NULL);
}
-
- MB_stack_delete(&pred_stack);
- return TRUE;
-} /* translate_calls */
+ /* set function type info*/
+ MB_func_type_check(ms);
-/* Create a new machine given a pointer to a file containing the
bytecodes */
-MB_Machine_State*
-MB_load_program(FILE* fp)
-{
+ #if CLOBBERSTACK
+ {
+ MB_Word i;
+ 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);
+ }
+ }
+ #endif
+#if 0
+ if (bca->enter_proc.det == MB_DET_SEMIDET) {
+ /*
+ ** If a semidet procedure then mark our success slot as failure
+ ** until we know otherwise.
+ */
+ MB_temp_set(ms, MB_SEMIDET_SUCCESS_SLOT, MB_SEMIDET_FAILURE);
- int indent_level = 0;
- MB_Short version;
- MB_Bytecode bc;
- MB_Bytecode_Arg* cur_proc_arg = NULL;
- MB_Word cur_adr = 0;
+ /*
+ ** Also push a failure context in case fail is encountered
+ */
+ MB_frame_temp_push(ms, bca->enter_proc.end_label.adr);
+ }
+#endif
+}
- MB_Machine_State* ms = MB_new(MB_Machine_State);
- if (ms == NULL) return NULL;
+static void
+instr_endof_proc(MB_Machine_State* ms, const MB_Bytecode_Arg*
endof_bca)
+{
+ /* get the current proc */
+ MB_Bytecode_Arg* bca =
+ MB_code_get_arg(endof_bca->endof_proc.proc_start);
- ms->code.data = MB_stack_new(INIT_CODE_DATA);
- ms->det.stack = MB_stack_new(INIT_DET_SIZE);
- ms->nondet.stack= MB_stack_new(INIT_NONDET_SIZE);
- ms->call.stack = MB_stack_new(INIT_CALLSTACK_SIZE);
- ms->label.stack = MB_stack_new(INIT_LABELSTACK_SIZE);
- ms->code.data_index= MB_stack_new(INIT_CODE_SIZE);
- /* XXX don't use fixed limits */
- ms->code.id = MB_new_array(MB_Byte, MAX_CODE_SIZE);
-
- MB_stack_push(&ms->code.data, 0); /* reserve 0 for indicating no data
*/
-
- if (!ms->code.id) {
- MB_unload_program(ms);
- return NULL;
- }
-
- /* Check the file version is ok */
- if (!MB_read_bytecode_version_number(fp, &version)) {
- MB_util_error("Unable to read version number\n");
- return FALSE;
- }
- if (version != FILEVERSION) {
- MB_util_error("Unknown file format version\n");
- return FALSE;
- }
-
- /* read in each bytecode */
- while (MB_read_bytecode(fp, &bc)) {
- if (cur_adr+1 >= MAX_CODE_SIZE) {
- MB_util_error("Not enough code space."
- " Increase MAX_CODE_SIZE.\n");
- MB_unload_program(ms);
- return NULL;
- }
+ switch (bca->enter_proc.det) {
+ case MB_DET_SEMIDET:
+ MB_fatal("endof semidet");
+#if 0
+ /* put the success indicator into a register */
+ MB_reg_set(ms, MB_SEMIDET_SUCCESS_REG,
+ MB_temp_get(ms, MB_SEMIDET_SUCCESS_SLOT));
+
+ /* remove the failure context */
+ MB_maxfr_pop(ms);
+#endif
- ms->code.id[cur_adr] = bc.id;
+ case MB_DET_DET: {
+ MB_Word detframe_size =
+ bca->enter_proc.temp_count+
+ bca->enter_proc.list_length+
+ MB_DETFRAME_SIZE;
+ MB_succip = MB_stackitem(MB_DETFRAME_SUCCIP);
- if (bc.id == MB_BC_label) {
- /* XXX: we don't actually need to save the labels
- ** in the code (but it makes printing the
- ** debugging output easier)
- */
- if (cur_proc_arg == NULL) {
- MB_fatal("Label encountered outside of a proc\n");
- }
+ /* deallocate stack variables */
+ MB_decr_sp(detframe_size);
- /* Add the label to the current proc's list of labels */
- MB_stack_push(&ms->label.stack, cur_adr);
+ MB_ip_set(ms, MB_succip);
+ return;
}
- /* 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 allocation */
- MB_stack_push(&ms->code.data_index, CODE_DATA_NONE);
- } else {
- /* Allocate the space for the bytecode's arguments */
- MB_Word cur_arg_index =
- MB_stack_alloc(
- &ms->code.data,
- argument_size[bc.id]);
-
- /* If we just read a procedure */
- if (bc.id == MB_BC_enter_proc) {
- /* Save the new current proc (so
- ** labels know where they are)
- */
- cur_proc_arg =
- (MB_Bytecode_Arg*)MB_stack_peek_p(
- &ms->code.data,
- cur_arg_index);
-
- /* and mark where the label indexes will begin */
- cur_proc_arg->enter_proc.label_index =
- MB_stack_alloc(&ms->label.stack, 0);
- }
-
- MB_stack_push(&ms->code.data_index, cur_arg_index);
-
- /* Copy the arguments into the argument data stack */
- memcpy(MB_stack_peek_p(&ms->code.data,
- cur_arg_index),
- &(bc.opt),
- argument_size[bc.id]*
- sizeof(MB_Word));
- }
- } else {
- MB_util_error("Unknown op code");
- MB_unload_program(ms);
- return NULL;
+#if 0
+ case MB_DET_MULTIDET:
+ case MB_DET_NONDET: {
+ MB_ip_set(ms, MB_frame_cur_get(ms, MB_FRAME_SUCCIP));
+ MB_curfr_set(ms, MB_frame_cur_get(ms, MB_FRAME_SUCCFR));
+ break;
}
- cur_adr++;
- }
- ms->code.count = cur_adr;
- ms->nondet.curfr = MB_stack_alloc(&ms->nondet.stack, MB_FRAME_SIZE);
-
- if (feof(fp) &&
- (ms->code.count > 0) &&
- (translate_calls(ms)) &&
- (MB_reset_program(ms)))
- {
- return ms;
+#endif
+ /* XXX other options */
+ default:
+ instr_notdone(ms, NULL);
}
- MB_unload_program(ms);
-
- return NULL;
-} /* MB_load_program */
-
-/* add/remove an ordinary nondet stack frame */
-void
-MB_frame_add(MB_Machine_State* ms, MB_Word var_count)
-{
- /* XXX */
- MB_fatal("frame stuff not done");
+ MB_func_type_check(ms);
}
-void
-MB_frame_remove(MB_Machine_State* ms, MB_Word var_count)
+static void
+instr_enter_disjunction(MB_Machine_State* ms, const MB_Bytecode_Arg*
bca)
{
- /* XXX */
- MB_fatal("frame stuff not done");
+ MB_fatal("enter_disjunction");
+#if 0
+ /* push a new temp frame */
+ MB_frame_temp_push(ms, MB_CODE_INVALID_ADR);
+ instr_noop(ms, NULL);
+#endif
}
-/* Load a program given a file name */
-MB_Machine_State*
-MB_load_program_name(MB_CString filename)
+static void
+instr_enter_disjunct(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- FILE* fp = fopen(filename, "rb");
- if (fp != NULL) {
- return MB_load_program(fp);
+ MB_fatal("enter_disjunct");
+#if 0
+ /*
+ ** set the redo point of the topmost frame (pushed in
+ ** enter_disjunction) to the disjunct after the current one
+ **
+ ** 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*/
+ 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);
}
- return FALSE;
+ instr_noop(ms, NULL);
+#endif
}
-/* reset a program back to an unrun state*/
-MB_Bool
-MB_reset_program(MB_Machine_State* ms)
+static void
+instr_endof_disjunct(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- ms->call.stack.sp = 0;
-
- MB_succip_set(ms, MB_CODE_INVALID_ADR);
+ MB_fatal("endof_disjunct");
+#if 0
+ /*
+ ** a simple jump to the end of the disjunction
+ ** if we are coming from a nonlast disjunct then we will
+ ** 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);
+#endif
+}
- MB_ip_set(ms, find_entry_point(ms));
-
- if (MB_ip_get(ms) == (MB_Word)-1) {
- return FALSE;
- }
+static void
+instr_endof_disjunction(MB_Machine_State* ms, const MB_Bytecode_Arg*
bca)
+{
+ MB_fatal("endof_disjunction");
+#if 0
+ /*
+ ** do nothing
+ */
+ instr_noop(ms, NULL);
+#endif
+}
- return TRUE;
+static void
+instr_enter_switch(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+{
+ instr_noop(ms, NULL);
}
-/* free all memory associated with a machine state */
-void
-MB_unload_program(MB_Machine_State* ms)
+static void
+instr_enter_switch_arm(MB_Machine_State* ms, const MB_Bytecode_Arg*
bca)
{
- if (ms != NULL) {
- /* the stacks will always be allocated since it will
- ** have aborted if their allocation failed
+ /* Check if this deconstruct is going to succeed */
+ if (do_deconstruct(ms, &bca->enter_switch_arm.cons_id,
+ bca->enter_switch_arm.var, 0, 0))
+ {
+ /*
+ ** If it does succeed, then step into the switch
*/
- MB_stack_delete(&ms->label.stack);
- MB_stack_delete(&ms->call.stack);
- MB_stack_delete(&ms->nondet.stack);
- MB_stack_delete(&ms->det.stack);
- MB_stack_delete(&ms->code.data);
- MB_stack_delete(&ms->code.data_index);
- if (ms->code.id) MB_free(ms->code.id);
- MB_free(ms);
+ instr_noop(ms, NULL);
+
+ } else {
+ /*
+ ** If it fails, go to the next switch arm
+ */
+ MB_ip_set(ms, bca->enter_switch_arm.next_label.adr);
}
}
-/* Get a variable on the det stack */
-MB_Word
-MB_var_get(MB_Machine_State* ms, MB_Word idx)
+static void
+instr_endof_switch_arm(MB_Machine_State* ms, const MB_Bytecode_Arg*
bca)
{
- assert(idx >= 0);
- assert(idx <
- MB_code_get_arg(ms, MB_stack_peek_rel(&ms->call.stack, 1))
- ->enter_proc.list_length);
- return MB_stack_peek_rel(&ms->det.stack, idx+1);
+ /* This switch arm has succeeded, now go to the end of the switch */
+ MB_ip_set(ms, bca->endof_switch_arm.end_label.adr);
}
-/* Set a variable on the det stack */
-void
-MB_var_set(MB_Machine_State* ms, MB_Word idx, MB_Word value)
+static void
+instr_endof_switch(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- assert(idx >= 0);
- assert(idx <
- MB_code_get_arg(ms, MB_stack_peek_rel(&ms->call.stack, 1))
- ->enter_proc.list_length);
- MB_stack_poke_rel(&ms->det.stack, idx+1, value);
+ /*
+ ** If we get here, no switch arm matched, so trigger a redo
+ */
+ instr_do_redo(ms, NULL);
}
-/* Get/set an entry on the nondet stack, relative to the current frame
*/
-MB_Word
-MB_frame_get(MB_Machine_State* ms, MB_Word idx)
+static void
+instr_enter_if(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- return MB_stack_peek(&ms->nondet.stack,
- ms->nondet.curfr + idx);
+ MB_fatal("enter_if");
+#if 0
+ /*
+ ** push a failure context and save the frame address in a
+ ** temp stack slot
+ */
+ MB_temp_set(ms, bca->enter_if.frame_ptr_tmp,
+ MB_frame_temp_push(ms, bca->enter_if.else_label.adr)
+ );
+
+ instr_noop(ms, NULL);
+#endif
}
-void
-MB_frame_set(MB_Machine_State* ms, MB_Word idx, MB_Word val)
+/* enter_else is identical to enter_then */
+/*
+instr_enter_else()
+*/
+static void
+instr_enter_then(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- MB_stack_poke(&ms->nondet.stack, ms->nondet.curfr + idx, val);
+ MB_fatal("enter_then");
+#if 0
+ MB_Word tempfr = MB_temp_get(ms, bca->enter_then.frame_ptr_tmp);
+
+ /* If the frame is on top, can we pop it */
+ if (MB_maxfr_get(ms) == tempfr) {
+ MB_maxfr_pop(ms);
+ } else {
+ /* otherwise replace redoip with do_fail, effectively
+ * discarding it when the stack gets unwound */
+ MB_frame_set(ms,
+ tempfr + MB_FRAME_REDOIP,
+ MB_CODE_DO_FAIL
+ );
+ }
+
+ instr_noop(ms, NULL);
+#endif
}
-MB_Word
-MB_frame_temp_get(MB_Machine_State* ms, MB_Word frame_num, MB_Word idx)
+static void
+instr_endof_then(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- return MB_frame_get(ms,
- MB_FRAME_SIZE + frame_num*MB_FRAME_TEMP_SIZE + idx);
+ MB_fatal("endof_then");
+#if 0
+ /* jump to the end of the construct */
+ MB_ip_set(ms, bca->endof_then.follow_label.adr);
+#endif
}
-void
-MB_frame_temp_set(MB_Machine_State* ms,
- MB_Word frame_num, MB_Word idx, MB_Word val)
+static void
+instr_endof_if(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- MB_frame_set(
- ms,
- MB_FRAME_SIZE + frame_num*MB_FRAME_TEMP_SIZE + idx,
- val);
-
+ MB_fatal("endof_if");
+#if 0
+ /* do nothing */
+ instr_noop(ms, NULL);
+#endif
}
-/* Get/set a variable in the current stack frame variable list */
-MB_Word
-MB_frame_var_get(MB_Machine_State* ms, MB_Word idx)
+static void
+instr_enter_negation(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- return MB_stack_peek(&ms->nondet.stack, MB_FRAME_SIZE + idx);
+ MB_fatal("enter_negation");
+#if 0
+ /* push a fail context: if the negation fails we want it
+ ** 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));
+ instr_noop(ms, NULL);
+#endif
}
-void
-MB_frame_var_set(MB_Machine_State* ms, MB_Word idx, MB_Word val)
+static void
+instr_endof_negation_goal(MB_Machine_State* ms, const MB_Bytecode_Arg*
bca)
{
- MB_stack_poke(&ms->nondet.stack, MB_FRAME_SIZE + idx, val);
+ MB_fatal("endof_negation_goal");
+#if 0
+ /*
+ ** the negation has succeeded. Now we want to indicate
+ ** failure.
+ ** Rewind the stack back to before the negation and do a redo
+ */
+
+ MB_maxfr_set(ms,
+ MB_frame_get(ms, MB_FRAME_PREVFR +
+ MB_temp_get(ms, bca->endof_negation_goal.frame_ptr_tmp))
+ );
+
+ instr_do_redo(ms, NULL);
+#endif
}
-/* add/remove a number of temporary stack frames to the nondet stack */
-void
-MB_frame_temp_add(MB_Machine_State* ms, MB_Word count)
+static void
+instr_endof_negation(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- MB_stack_alloc(&ms->nondet.stack, count * MB_FRAME_TEMP_SIZE);
+ MB_fatal("endof_negation");
+#if 0
+ /*
+ ** the negation failed. remove the temp frame which will
+ ** be at the top and continue
+ */
+ MB_maxfr_pop(ms);
+
+ instr_noop(ms, NULL);
+#endif
}
-void
-MB_frame_temp_remove(MB_Machine_State* ms, MB_Word count)
+static void
+instr_enter_commit(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- MB_stack_free(&ms->nondet.stack, count * MB_FRAME_TEMP_SIZE);
+ MB_fatal("enter_commit");
+#if 0
+ /*
+ ** push a new stack frame & save its location in a temp
+ ** stack slot
+ */
+ MB_temp_set(ms, bca->enter_commit.frame_ptr_tmp,
+ MB_frame_temp_push(ms, MB_CODE_DO_FAIL));
+
+ instr_noop(ms, NULL);
+#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_if (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_construct (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_builtin_binop (MB_Machine_State* ms, const
MB_Bytecode_Arg* bca);
+static void
+instr_endof_commit(MB_Machine_State* ms, const MB_Bytecode_Arg *bca)
+{
+ MB_fatal("endof_commit");
+#if 0
+ /*
+ ** Unwind the stack back to where it was before the commit
+ */
+ MB_maxfr_set(ms,
+ MB_frame_get(ms, MB_FRAME_PREVFR +
+ MB_temp_get(ms, bca->endof_commit.frame_ptr_tmp))
+ );
-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);
+ instr_noop(ms, NULL);
+#endif
+}
+static void
+instr_assign(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+{
+ MB_fatal("assign");
+#if 0
+ /* copy variable from one slot to another */
+ MB_var_set(ms, bca->assign.to_var,
MB_var_get(ms,bca->assign.from_var));
-/* XXX: 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*/
- instr_enter_proc,
- instr_endof_proc,
- instr_noop, /* label */
- instr_notdone, /* disjunction */
- instr_notdone,
- instr_notdone, /* disjunct */
- instr_notdone,
- instr_notdone, /* switch */
- instr_notdone,
- instr_notdone,
- instr_notdone,
- instr_enter_if,
- instr_notdone,
- instr_notdone,
- instr_endof_if,
- instr_notdone, /* neg */
- instr_notdone,
- instr_notdone, /* commit */
- instr_notdone,
- instr_notdone, /* assign */
- instr_notdone, /* test */
- instr_construct,/* construct */
- instr_notdone,
- instr_notdone,
- instr_notdone,
- instr_place, /* place */
- instr_pickup, /* pickup */
- instr_call, /* call */
- instr_notdone,
- instr_builtin_binop,
- instr_notdone,
- instr_notdone,
- instr_notdone,
- instr_notdone, /* semidet */
- instr_notdone,
- instr_notdone, /* fail */
- instr_noop, /* context */
- instr_notdone /* not supported */
-};
+ instr_noop(ms, NULL);
+#endif
+}
static void
-instr_invalid(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+instr_test(MB_Machine_State* ms, const MB_Bytecode_Arg *bca)
{
- assert(FALSE);
+ MB_fatal("test");
+#if 0
+ /* test the equality of two variable slots */
+ if (MB_var_get(ms, bca->test.var1) == MB_var_get(ms, bca->test.var2))
{
+ instr_noop(ms, NULL);
+ } else {
+ instr_do_redo(ms, NULL);
+ }
+#endif
}
+static MB_Word
+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(
+ MB_mktag(cons_tag->opt.pair.primary),
+ MB_mkbody((MB_Word)NULL));
-/* Just something to set new stack vars to to help find bugs */
-#define UNSETSTACK 0xbadbad00
+ /* the final value we will put in the reg */
-/* Enter/exit procedure */
-static void
-instr_enter_proc(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
-{
- /* save the current address (for debugging) */
- MB_stack_push(&ms->call.stack, MB_ip_get(ms));
+ assert(cid->id == MB_CONSID_CONS);
+
+ assert(cid->opt.cons.arity == list_length);
- switch (bca->enter_proc.det) {
- case MB_DET_DET: {
- MB_Word i;
+ switch (cons_tag->id) {
+ case MB_TAG_SIMPLE: /* only need a primary tag */
+ case MB_TAG_COMPLICATED: /* need primary + remote 2ndary tag */
+ {
+ /*
+ ** The code for these two is virtually identical except
+ ** that if it is complicated we need one extra heap
+ ** slot for the remote secondary tag
+ */
+ MB_Word extra = (cons_tag->id == MB_TAG_COMPLICATED)
+ ? 1 : 0;
+ MB_Word*heap_data;
+ MB_Word i;
+
+
+ if (list_length + extra) {
+ MB_Short* var_list;
+
+ /* allocate heap memory */
+ heap_data = (MB_Word*)MB_GC_malloc(
+ sizeof(MB_Word) * (list_length + extra),
+ MB_GC_NOT_ATOMIC);
- /* Allocate nondet stack frames */
- MB_frame_temp_add(ms, bca->enter_proc.temp_count);
+ /* ensure tag bits aren't used */
+ assert(MB_tag((MB_Word)heap_data) == 0);
- /* save our succip */
- MB_stack_push(&ms->det.stack, MB_succip_get(ms));
+ /* get variable list */
+ var_list = (MB_Short*)MB_stack_peek_p(
+ &ms->code.data,
+ var_list_index);
- /* allocate new stack variables */
- for (i = 0; i < bca->enter_proc.list_length; i++) {
- MB_stack_push(&ms->det.stack, UNSETSTACK+i);
+ /* copy variables to allocate heap block */
+ for (i = 0; i < list_length; i++)
+ {
+ heap_data[i+extra] =
+ MB_var_get(ms, var_list[i]);
+ }
+ } else {
+ heap_data = NULL;
}
- MB_ip_set(ms, MB_ip_get(ms)+1);
+ /*
+ ** copy the secondary tag if we need to
+ ** and combine the pointer & tag
+ */
+ if (cons_tag->id == MB_TAG_COMPLICATED_CONSTANT) {
+ 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_mktag(0)));
+ } else {
+ val = MB_mkword(
+ MB_mktag(cons_tag->opt.primary),
+ MB_body((MB_Word)heap_data,
+ MB_mktag(0)));
+ }
+
break;
}
+
+ case MB_TAG_COMPLICATED_CONSTANT:
+ /* primary + local secondary tag*/
+ assert(list_length == 0);
+ val = MB_mkword(
+ MB_mktag(cons_tag->opt.pair.primary),
+ MB_mkbody(cons_tag->opt.pair.secondary));
+ break;
+
+ case MB_TAG_ENUM:
+ assert(list_length == 0);
+ val = MB_mkword(MB_mktag(cons_tag->opt.enum_tag),
+ MB_mkbody(0));
+ break;
+
+ case MB_TAG_NONE:
default:
- instr_notdone(ms, bca);
+ instr_notdone(ms, NULL);
}
+ return (MB_Word)val;
+#endif
+ return 0;
}
static void
-instr_endof_proc(MB_Machine_State* ms, const MB_Bytecode_Arg*
endof_bca)
+instr_construct(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- /* get the current proc off the top of the call stack */
- MB_Bytecode_Arg* bca = MB_code_get_arg(ms,
- MB_stack_pop(&ms->call.stack));
-
- switch (bca->enter_proc.det) {
- case MB_DET_DET: {
- /* deallocate stack variables */
- MB_stack_free(&ms->det.stack, bca->enter_proc.list_length);
- MB_succip_set(ms, MB_stack_pop(&ms->det.stack));
+ 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);
+ val = bca->construct.consid.opt.int_const;
+ break;
+
+ case MB_CONSID_STRING_CONST:
+ assert(bca->construct.list_length == 0);
+ val = (MB_Word)bca->construct.consid.opt.string_const;
+ break;
+
+ case MB_CONSID_CONS:
+ val = do_construct_cons(ms,
+ &bca->construct.consid,
+ bca->construct.list_length,
+ bca->construct.var_list);
+ break;
+
+ case MB_CONSID_FLOAT_CONST:
+ instr_notdone(ms, NULL);
+
+ case MB_CONSID_PRED_CONST: {
+ MB_fatal("Construct closure not done");
+ #if 0
+ int i;
+
+ 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(
+ &ms->code.data,
+ bca->construct.var_list_index);
+
+ closure->code_adr = bca->construct
+ .consid.opt.pred_const.adr;
+ closure->num_hidden_args = bca->construct.list_length;
+
+ for (i = 0; i < closure->num_hidden_args; i++) {
+ closure->closure_hidden_args[i] =
+ MB_var_get(ms, var_list[i]);
+ }
- /* dellocate nondet stack frames */
- MB_frame_temp_remove(ms, bca->enter_proc.temp_count);
+ val = (MB_Word)closure;
- MB_ip_set(ms, MB_succip_get(ms));
break;
+ #endif
}
+
+ case MB_CONSID_CODE_ADDR_CONST:
+ case MB_CONSID_BASE_TYPE_INFO_CONST:
+ instr_notdone(ms, NULL);
+ case MB_CONSID_CHAR_CONST:
+ val = (MB_Word)bca->construct.consid.opt.char_const.ch;
+ break;
+
default:
- instr_notdone(ms, bca);
+ instr_notdone(ms, NULL);
}
+ MB_var_set(ms, bca->construct.to_var, val);
+ instr_noop(ms, NULL);
}
-static void
-instr_enter_if (MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+/*
+** returns true if the deconstruction succeeds
+** if a int/string/char const, checks for equality and triggers a redo
if it
+** fails.
+** 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)
{
-// MB_Word* temp_frame = ms-> bca
- instr_notdone(ms, bca);
-}
+ MB_Word var_val = MB_var_get(ms, var);
+
+ /* XXX not all deconstructions done */
+ switch (cid->id) {
+ case MB_CONSID_INT_CONST:
+ return (var_val == cid->opt.int_const);
-static void
-instr_endof_if (MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
-{
- instr_notdone(ms, bca);
+ case MB_CONSID_STRING_CONST:
+ return (!MB_str_cmp((char*)var_val,
+ cid->opt.string_const));
+
+ case MB_CONSID_CONS: {
+ return do_deconstruct_cons(ms, cid, var_val,
+ list_length, var_list);
+ }
+
+ case MB_CONSID_CHAR_CONST:
+ return (var_val == (MB_Word)cid->opt.char_const.ch);
+
+ default:
+ instr_notdone(ms, NULL);
+ }
+
+ assert(FALSE);
+ return FALSE;
}
-static void
-instr_construct(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+/* 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)
{
- assert(bca->construct.list_length == 0);
- switch (bca->construct.consid.id) {
- case MB_CONSID_INT_CONST:
- MB_var_set(ms, bca->construct.to_var,
- bca->construct.consid.opt.int_const);
+ const MB_Tag* cons_tag = &cid->opt.cons.tag;
+
+ assert(cid->id == MB_CONSID_CONS);
+
+ /*
+ ** We should either check all variables (eg: deconstruct instruction)
+ ** or none of them (eg: switch_arm instruction)
+ */
+ assert((cid->opt.cons.arity == list_length) || (list_length == 0));
- instr_noop(ms, bca);
+ switch (cons_tag->id) {
+ case MB_TAG_SIMPLE: /* only need a primary tag */
+ case MB_TAG_COMPLICATED: /* need primary + remote 2ndary tag */
+ {
+ /*
+ ** The code for these two is virtually identical except
+ ** that if it is complicated we need one extra heap
+ ** slot for the remote secondary tag
+ */
+ MB_Word extra = (cons_tag->id == MB_TAG_COMPLICATED)
+ ? 1 : 0;
+ MB_Word*heap_data = (MB_Word*)MB_strip_tag(val);
+ MB_Word i;
+
+ /* check that tags are identical */
+ if (cons_tag->id == MB_TAG_COMPLICATED) {
+ if ((MB_tag(val) != cons_tag->opt.pair.primary)
+ || (heap_data[0] !=
+ cons_tag->opt.pair.secondary))
+ {
+ return FALSE;
+ }
+ } else {
+ if (MB_tag(val) != cons_tag->opt.primary) {
+ return FALSE;
+ }
+ }
+
+
+ /* Deconstruct variables */
+ if (list_length) {
+ /* ensure variables are the same */
+ for (i = 0; i < list_length; i++)
+ {
+ MB_var_set(ms, var_list[i],
+ heap_data[i+extra]);
+ }
+ }
+
break;
- case MB_CONSID_STRING_CONST:
- MB_var_set(ms, bca->construct.to_var,
- (MB_Word)bca->construct.consid.opt.string_const);
+ }
- instr_noop(ms, bca);
+ case MB_TAG_COMPLICATED_CONSTANT:
+ /* primary + local secondary tag*/
+ assert(list_length == 0);
+ if (val != (MB_Word)MB_mkword(
+ MB_mktag(cons_tag->opt.pair.primary),
+ MB_mkbody(cons_tag->opt.pair.secondary)))
+ {
+ return FALSE;
+ }
+
break;
+
+ case MB_TAG_ENUM:
+ assert(list_length == 0);
+ if (val != (MB_Word)
+ MB_mkword(MB_mktag(cons_tag->opt.enum_tag),
+ MB_mkbody(0)))
+ {
+ return FALSE;
+ }
+ break;
+
+ case MB_TAG_NONE:
default:
- instr_notdone(ms, bca);
+ instr_notdone(ms, NULL);
}
+
+ return TRUE;
}
+
static void
+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 */
+ if (!do_deconstruct(ms, &bca->deconstruct.consid,
+ bca->deconstruct.from_var,
+ bca->deconstruct.list_length,
+ bca->deconstruct.var_list))
+ {
+ instr_do_redo(ms, NULL);
+ } else {
+ instr_noop(ms, NULL);
+ }
+}
+
+static void
instr_place(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
/* copy value from var slot to reg */
- MB_reg_set(ms, bca->place_arg.to_reg,
- MB_var_get(ms, bca->place_arg.from_var));
+ MB_reg(bca->place_arg.to_reg) =
+ MB_var_get(ms, bca->place_arg.from_var);
- /* XXX for debugging only */
- MB_var_set(ms, bca->place_arg.from_var, UNSETSTACK);
+ #if CLOBBERPLACES
+ /* XXX for debugging only */
+ MB_var_set(ms, bca->place_arg.from_var, CLOBBERED);
+ #endif
/* go to the next instruction */
- instr_noop(ms, bca);
+ instr_noop(ms, NULL);
}
static void
@@ -879,62 +1114,139 @@
{
/* copy value from reg to var slot*/
MB_var_set(ms, bca->pickup_arg.to_var,
- MB_reg_get(ms, bca->pickup_arg.from_reg));
+ MB_reg(bca->pickup_arg.from_reg));
- /* XXX for debugging only */
- MB_reg_set(ms, bca->pickup_arg.from_reg, UNSETSTACK);
+ #if CLOBBERPICKUPS
+ /* XXX for debugging only */
+ MB_reg_set(ms, bca->pickup_arg.from_reg, CLOBBERED);
+ #endif
/* go to the next instruction */
- instr_noop(ms, bca);
+ instr_noop(ms, NULL);
}
static void
instr_call(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
- MB_Word new_adr;
- new_adr = bca->call.adr;
+ /* Call another function */
+
+ MB_Word* next_ip = MB_ip_get(ms) + 1;
+ MB_Word* new_adr = bca->call.adr;
- if (new_adr == MB_CODE_INVALID_ADR) {
- MB_util_error("Attempt to call unknown predicate %s/%d (%d)",
- bca->call.pred_id,
- (int)bca->call.arity,
- (int)bca->call.proc_id);
- instr_noop(ms, bca);
+ if (!bca->call.is_native) {
+ if (new_adr == MB_CODE_INVALID_ADR) {
+ MB_util_error("Attempt to call unknown bytecode"
+ " %s %s__%s/%d (%d)",
+ bca->call.is_func ? "func" : "pred",
+ bca->call.module_id,
+ bca->call.pred_id,
+ (int)bca->call.arity,
+ (int)bca->call.proc_id);
+ MB_fatal("");
+ } else {
+ if (MB_ip_normal(new_adr)) {
+ /* set the return address to the next instr */
+ MB_succip = next_ip;
+ /* set the new execution point*/
+ MB_ip_set(ms, new_adr);
+ } else {
+ MB_fatal("Unexpected call address"
+ " (special address not implemented?)");
+ }
+ }
} else {
- /* set the new execution point*/
- MB_succip_set(ms, MB_ip_get(ms)+1);
-
- /* set the return address to the next instruction */
- MB_ip_set(ms, new_adr);
+ SAY("Attempting to call native code from bytecode");
+ if (ms->cur_proc.is_det == MB_ISDET_YES) {
+ /* set success ip to the next instruction */
+ 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;
+ } else {
+ MB_fatal("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.
+**
+** Why does the call need to know the number of output arguments ???
+**
+** If semidet, do I need to make space for an extra argument ???
+**
+*/
+static void
+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,
+ bca->higher_order_call.pred_var);
+ /*
+ ** shift the input arguments to the right so we can insert the
+ ** arguments inside the closure
+ */
+ if (bca->higher_order_call.in_var_count != 0) {
+ signed int i = closure->num_hidden_args;
+ signed int j = i + bca->higher_order_call.in_var_count;
+ for (; i >= 1; i--, j--) {
+ MB_reg_set(ms, j, MB_reg_get(ms, i));
+ }
+ }
+ /*
+ ** Now insert the hidden arguments
+ */
+ if (closure->num_hidden_args) {
+ signed int i;
+ MB_Word num_hidden_args = closure->num_hidden_args;
+ for (i = 1; i <= num_hidden_args; i++) {
+ MB_reg_set(ms, i, closure->closure_hidden_args[i-1]);
+ }
+ }
+
+ /*
+ ** Do the actual call
+ */
+
+ /* set the return address to the next instruction */
+ MB_succip_set(ms, MB_ip_get(ms)+1);
+
+ /* set the new execution point*/
+ MB_ip_set(ms, closure->code_adr);
+#endif
+}
+/*
--------------------------------------------------------------------------
*/
-static MB_Word binop_add (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_sub (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_mul (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_div (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_mod (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_lshift (MB_Machine_State* ms, const
MB_Bytecode_Arg* bca);
-static MB_Word binop_rshift (MB_Machine_State* ms, const
MB_Bytecode_Arg* bca);
-static MB_Word binop_and (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_or (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_xor (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_logand (MB_Machine_State* ms, const
MB_Bytecode_Arg* bca);
-static MB_Word binop_logor (MB_Machine_State* ms, const
MB_Bytecode_Arg* bca);
-static MB_Word binop_eq (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_ne (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_lt (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_gt (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-static MB_Word binop_le (MB_Machine_State* ms, const MB_Bytecode_Arg*
bca);
-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);
+static MB_Word binop_add (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_sub (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_mul (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_div (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_mod (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_lshift (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_rshift (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_and (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_or (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_xor (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_logand (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_logor (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_eq (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_ne (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_lt (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_gt (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word binop_le (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+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);
/*
-** XXX: Currently we depend on the order of elements in the table.
+** 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_Word (*binop_table[])(MB_Machine_State* ms,
+ const MB_Bytecode_Arg* bca) =
+{
binop_add,
binop_sub,
binop_mul,
@@ -979,8 +1291,10 @@
{ \
assert(bca->builtin_binop.arg1.id == MB_ARG_VAR); \
assert(bca->builtin_binop.arg2.id == MB_ARG_VAR); \
- return (MB_Integer)(MB_var_get(ms, bca->builtin_binop.arg1.opt.var))
\
- op (MB_Integer)(MB_var_get(ms, bca->builtin_binop.arg2.opt.var)); \
+ return (MB_Integer)(MB_var_get(ms, \
+ bca->builtin_binop.arg1.opt.var)) \
+ op (MB_Integer)(MB_var_get(ms, \
+ bca->builtin_binop.arg2.opt.var)); \
}
SIMPLEBINOP(add, +)
@@ -1010,8 +1324,8 @@
return 0;
}
-/*
--------------------------------------------------------------------- */
+
static void
instr_builtin_binop(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
@@ -1020,14 +1334,156 @@
MB_var_set(ms,
bca->builtin_binop.to_var,
binop_table[bca->builtin_binop.binop](ms, bca));
+
+ instr_noop(ms, NULL);
} else {
- MB_fatal("Invlid binop");
+ MB_fatal("Invalid binop");
}
+}
- /* move to the next instruction*/
- instr_noop(ms, bca);
+static void
+instr_builtin_bintest(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+{
+ MB_fatal("builtin_bintest");
+#if 0
+ MB_Byte binop = bca->builtin_binop.binop;
+ if (binop < (sizeof(binop_table)/sizeof(binop_table[0]))) {
+ if (binop_table[bca->builtin_binop.binop](ms, bca)) {
+ /* If successful, just go to the next instr */
+ instr_noop(ms, NULL);
+ } else {
+ /* otherwise follow the failure context */
+ /*instr_do_fail(ms, NULL);*/
+ instr_do_redo(ms, NULL);
+ }
+ } else {
+ MB_fatal("Invalid bintest");
+ }
+#endif
+}
+/*
--------------------------------------------------------------------------
*/
+static MB_Word unop_bad (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+static MB_Word unop_bitwise_complement
+ (MB_Machine_State*ms,const MB_Bytecode_Arg*bca);
+static MB_Word unop_not (MB_Machine_State*ms,const
MB_Bytecode_Arg*bca);
+/*
+** 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) =
+{
+ unop_bad, /* mktag */
+ unop_bad, /* tag */
+ unop_bad, /* unmktag */
+ unop_bad, /* unmkbody */
+ unop_bad, /* cast_to_unsigned */
+ unop_bad, /* hash_string */
+ unop_bitwise_complement,
+ unop_not
+};
+
+#define SIMPLEUNOP(name, op) \
+ static MB_Word \
+ unop_##name(MB_Machine_State* ms, const MB_Bytecode_Arg* bca) \
+ { \
+ assert(bca->builtin_unop.arg.id == MB_ARG_VAR); \
+ return op (MB_Integer) \
+ (MB_var_get(ms, bca->builtin_unop.arg.opt.var)); \
+ }
+
+SIMPLEUNOP(bitwise_complement, ~)
+SIMPLEUNOP(not, !)
+
+static MB_Word
+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)
+{
+ MB_fatal("builtin_unop");
+#if 0
+ MB_Byte unop = bca->builtin_unop.unop;
+
+ /* XXX until I learn properly what unary operations are */
+ instr_notdone(ms, NULL);
+
+ if (unop < (sizeof(unop_table)/sizeof(unop_table[0]))) {
+ MB_var_set(ms,
+ bca->builtin_unop.to_var,
+ unop_table[bca->builtin_unop.unop](ms, bca));
+
+ instr_noop(ms, NULL);
+ } else {
+ MB_fatal("Invalid unop");
+ }
+#endif
+}
+
+
+static void
+instr_builtin_untest(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+{
+ MB_fatal("builtin_untest");
+#if 0
+ instr_notdone(ms, NULL);
+#endif
+}
+
+/*
--------------------------------------------------------------------- */
+static void
+instr_semidet_success(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+{
+ MB_fatal("semidet_success");
+#if 0
+ MB_temp_set(ms, MB_SEMIDET_SUCCESS_SLOT, MB_SEMIDET_SUCCESS);
+
+ instr_noop(ms, NULL);
+#endif
+}
+
+static void
+instr_semidet_success_check(MB_Machine_State* ms, const
MB_Bytecode_Arg* bca)
+{
+ MB_fatal("semidet_success_check");
+#if 0
+ if (MB_reg_get(ms, MB_SEMIDET_SUCCESS_REG) != MB_SEMIDET_SUCCESS) {
+ instr_do_redo(ms, NULL);
+ } else {
+ instr_noop(ms, NULL);
+ }
+#endif
+}
+
+static void
+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_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));
+#endif
+}
+
+static void
+instr_do_fail(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
+{
+ MB_fatal("do_fail");
+#if 0
+ MB_maxfr_pop(ms);
+ instr_do_redo(ms, bca);
+#endif
+}
+
+static void
instr_noop(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
/* increment instruction pointer */
@@ -1037,29 +1493,48 @@
static void
instr_notdone(MB_Machine_State* ms, const MB_Bytecode_Arg* bca)
{
+ MB_fatal("notdone");
+#if 0
/* invalid instruction */
- MB_fatal("That instruction is not implemened yet\n");
- instr_noop(ms, bca);
+ MB_fatal("That instruction is not implemented yet\n");
+ instr_noop(ms, NULL);
+#endif
}
+/* Execute the current instruction. Returns false if instruction could
*/
+/* not be executed */
+static MB_Bool
+dispatch(MB_Byte bc_id, MB_Machine_State* ms)
+{
+ MB_Word* 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));
+ return TRUE;
+ }
+
+ return FALSE;
+}
/* Single step execute */
void
MB_step(MB_Machine_State* ms)
{
+#if 0
MB_Word ip = MB_ip_get(ms);
MB_Byte bc_id = MB_code_get_id(ms, ip);
- if (bc_id >= sizeof(instruction_table) / sizeof(instruction_table[0]))
{
+ if (!dispatch(bc_id, ms)) {
+ MB_fatal("Invalid instruction encountered\n");
instr_noop(ms, NULL);
- } else {
- instruction_table[bc_id](ms, MB_code_get_arg(ms, ip));
}
+#endif
}
void
MB_step_over(MB_Machine_State* ms)
{
+#if 0
MB_Word ip = MB_ip_get(ms);
MB_Byte bc_id = MB_code_get_id(ms, ip);
@@ -1072,7 +1547,7 @@
/* If we are about to step into a predicate */
/* then replace the following bytecode with */
- /* a MB_BC_debug_trap and run until it traps */
+ /* 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));
@@ -1087,28 +1562,83 @@
default:
MB_step(ms);
}
+#endif
}
/* Run until invalid instruction or debug_trap bytecode encountered */
void
MB_run(MB_Machine_State* ms)
{
+#if 0
do {
MB_Word ip = MB_ip_get(ms);
MB_Byte bc_id = MB_code_get_id(ms, ip);
- if (bc_id >= sizeof(instruction_table) /
sizeof(instruction_table[0])) {
+ if (!dispatch(bc_id, ms)) {
switch (bc_id) {
case MB_BC_debug_trap:
return;
}
- MB_util_error("Attempt to execute invalid instruction\n");
+ MB_util_error(
+ "Attempt to execute invalid instruction\n");
instr_noop(ms, NULL);
return;
+ }
+ } while (1);
+#endif
+}
+/*
--------------------------------------------------------------------- */
+void
+MB_machine_create(MB_Word* new_ip, MB_Machine_State* ms)
+{
+
+ ms->ip = new_ip;
+ MB_func_type_check(ms);
+}
+
+MB_Word*
+MB_machine_exec(MB_Machine_State* ms)
+{
+ char buffer[4];
+ MB_Word count = 0;
+ SAY("Hello from machine_exec");
+
+ do {
+ MB_Word* ip = MB_ip_get(ms);
+
+ if (MB_ip_normal(ip)) {
+
+ MB_Byte bc_id = MB_code_get_id(ip);
+
+ #if 1
+ MB_show_state(ms, stdout);
+ SAY("count: %d, execing %p", count++, ip);
+ SAY("press enter to continue");
+ fgets(buffer, sizeof(buffer), stdin);
+ #endif
+
+ if (!dispatch(bc_id, ms)) {
+ switch (bc_id) {
+ case MB_BC_debug_trap:
+ return 0;
+ }
+ MB_util_error("Attempt to execute"
+ " invalid instruction\n");
+ instr_noop(ms, NULL);
+ return 0;
+ }
} else {
- instruction_table[bc_id](ms, MB_code_get_arg(ms, ip));
+ switch ((MB_Word)ip) {
+ case (MB_Word)MB_CODE_NATIVE_RETURN:
+ return MB_native_return_get(ms);
+ default:
+ MB_fatal("Attempt to execute invalid"
+ " address\n");
+ }
}
} while (1);
+
+ return 0;
}
Index: mb_machine.h
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_machine.h,v
retrieving revision 1.1
diff -u -r1.1 mb_machine.h
--- mb_machine.h 2001/01/24 07:42:25 1.1
+++ mb_machine.h 2001/01/24 07:44:34
@@ -1,182 +1,60 @@
/*
-** 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_machine.h,v 1.1 2001/01/24 07:42:25 lpcam Exp $
-**
** Abstract mercury machine
**
*/
-
#ifndef MB_MACHINE_H
-#define MB_MACHINE_H
+#define MB_MACHINE_H
#include <stdio.h>
#include "mb_bytecode.h"
+#include "mb_module.h"
#include "mb_util.h"
#include "mb_stack.h"
-#define MB_MACHINEREGS 21
+struct MB_Machine_State_Tag;
+typedef struct MB_Machine_State_Tag MB_Machine_State;
-/* Don't directly access data from a machine state; go through the
-** wrappers below which provide some measure of error checking
-** (C++, C++, oh where art thou C++?)
+/*
+** Returns an instruction describing a pointer to the next instruction
+** Executes some 'special' IPs (eg: redo, fail) & returns their
resultant ip
*/
-typedef struct MB_Machine_State_Tag {
- MB_Word ip; /* next instruction pointer*/
-
- /* det stack */
- struct {
- MB_Word succip; /* sucess return address */
- MB_Stack stack; /* stack data */
- } det;
-
- /* nondet stack */
- struct {
- MB_Word curfr; /* stack frame of current procedure */
- MB_Word maxfr; /* highest frame on nondet stack */
- MB_Stack stack; /* stack data */
- } nondet;
-
- /* heap */
- struct {
- /* XXX */
- } heap;
-
- /* MB_Bytecode is 44 bytes long - this is obviously very inefficient
- ** for most instructions.
- **
- ** All code accesses should go through MB_get_code so the following
- ** is abstracted away:
- **
- ** code_id is an array of bytecode types
- ** code_index is the index into code_data for the bytecode arguments
- ** code_data is the bytecode arguments
- **
- ** This way each instruction takes 5 bytes + argument size
- ** rather than 1 byte + size of largest possible argument
- */
- struct {
- MB_Word count; /* number of instructions */
- MB_Byte* id; /* instruction types */
- MB_Stack data_index; /* index into code data for aguments */
- MB_Stack data; /* argument data stack */
- } code;
-
- #define CODE_DATA_NONE 0 /* If a bytecode's data_index is this
- ** then we will assume it has no data
- */
-
- MB_Word reg[MB_MACHINEREGS]; /* machine regs */
-
-
- /* For the simulation only (not part of the abstract machine) */
-
- /* Call stack: each stack frame consists of:
- ** stack[sp-1]: index into code.data[] containing info on current proc
- ** stack[sp-2]: index into code.data[] containing info on previous
proc
- ** etc.
- */
- struct {
- MB_Stack stack;
- } call;
-
- /* high-water marked */
- struct {
- MB_Stack stack;
- } label;
-
-} MB_Machine_State;
-
-#define MB_CODE_INVALID_ADR ((MB_Word)-1)
-
-typedef struct MB_Stack_Frame_Tag {
- MB_Word prevfr;
- MB_Word succfr;
- MB_Word redoip;
- MB_Word succip;
-} MB_Stack_Frame;
-
-/* Get the value of a register */
-MB_Word MB_reg_get(MB_Machine_State* ms, MB_Word idx);
-
-/* Set the value of a register */
-void MB_reg_set(MB_Machine_State* ms, MB_Word idx, MB_Word value);
-
-/* Get/set the next instruction pointer */
-MB_Word MB_ip_get(MB_Machine_State* ms);
-void MB_ip_set(MB_Machine_State* ms, MB_Word);
-
-/* Get/set the success instruction pointer */
-MB_Word MB_succip_get(MB_Machine_State* ms);
-void MB_succip_set(MB_Machine_State* ms, MB_Word);
-
-/* Read the bytecode at a given address */
-MB_Bytecode MB_code_get(MB_Machine_State* ms, MB_Word adr);
-
-/* Get the bytecode type at a given address */
-MB_Byte MB_code_get_id(MB_Machine_State* ms, MB_Word adr);
-
-/* Get the bytecode argument at a given address */
-MB_Bytecode_Arg*MB_code_get_arg(MB_Machine_State* ms, MB_Word adr);
-
-/* Get the predicate in which the following address resides */
-MB_Bytecode MB_code_get_pred(MB_Machine_State* ms, MB_Word adr);
-MB_Word MB_code_get_pred_adr(MB_Machine_State* ms, MB_Word adr);
-
-/* Get the procedure in which the following address resides */
-MB_Bytecode MB_code_get_proc(MB_Machine_State* ms, MB_Word adr);
+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);
-/* Return how many bytecodes there are */
-MB_Word MB_code_size(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);
-
-/* The positions of frame variables*/
-#define MB_FRAME_PREVFR 0
-#define MB_FRAME_REDOIP 1
-#define MB_FRAME_REDOFR 2
-#define MB_FRAME_SUCCIP 3
-#define MB_FRAME_SUCCFR 4
-
-#define MB_FRAME_SIZE 5
-#define MB_FRAME_TEMP_SIZE 3
-
/* 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);
+
+/* 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);
-/* get/set a value inside a temporary frame */
-MB_Word MB_frame_temp_get(MB_Machine_State* ms,
- MB_Word frame_num, MB_Word idx);
-void MB_frame_temp_set(MB_Machine_State* ms,
- MB_Word frame_num, 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 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);
-
-/* add/remove a number of temporary stack frames to the nondet stack */
-void MB_frame_temp_add(MB_Machine_State* ms, MB_Word count);
-void MB_frame_temp_remove(MB_Machine_State* ms, MB_Word count);
-
-/* add/remove an ordinary nondet stack frame */
-void MB_frame_add(MB_Machine_State* ms, MB_Word var_count);
-void MB_frame_remove(MB_Machine_State* ms, MB_Word var_count);
-
-/* Load a program from a file */
-/* Returns false for failure */
-MB_Machine_State*MB_load_program(FILE* fp);
-MB_Machine_State*MB_load_program_name(MB_CString filename);
-MB_Bool MB_reset_program(MB_Machine_State* ms);
-void MB_unload_program(MB_Machine_State* ms);
+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);
@@ -193,6 +71,11 @@
/* Run until exception */
void MB_run(MB_Machine_State* ms);
-#endif /* MB_MACHINE_H */
+/* Create a bytecode machine */
+void MB_machine_create(MB_Word* new_ip, MB_Machine_State* ms);
+
+/* Execute a bytecode machine */
+MB_Word* MB_machine_exec(MB_Machine_State* ms);
+#endif /* MB_MACHINE_H */
Index: mb_machine_show.c
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_machine_show.c,v
retrieving revision 1.1
diff -u -r1.1 mb_machine_show.c
--- mb_machine_show.c 2001/01/24 07:42:26 1.1
+++ mb_machine_show.c 2001/01/24 07:44:34
@@ -1,304 +1,102 @@
/*
-** 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);
/* Local declarations */
-
-static char
-rcs_id[] = "$Id: mb_machine_show.c,v 1.1 2001/01/24 07:42:26 lpcam Exp
$";
-
-#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)
-{
- if (buffer == NULL && len == 0) return;
-
- assert(buffer != NULL);
-
- /* find the null terminator */
- while (len > 0) {
- if (*buffer == 0) break;
- buffer++;
- len--;
- }
-
- while (len > 1) {
- buffer++[0] = ' ';
- len--;
- }
-
- *buffer = 0;
-}
-
-/* Returns a structure containing formatted strings with
-** various state variables in (so it is easier to print
-** multiple columns on stdout)
-*/
-
-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);
-
- /* 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);
- }
- }
-
- /* display the register variables */
- {
- MB_Word j;
-
- 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));
- }
- }
- /* display the det stack */
- {
- MB_Word j;
+#define NREGS 14
+#define NSTACK 8
- 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]);
- }
- } 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]), " ");
- }
- }
- /* 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 */
- {
- #define PAD(x) pad_space(vars.##x, sizeof(vars.##x))
- MB_Word i;
-
- for (i = 0; i < NREGS; i++) {
- PAD(reg_name[i]);
- PAD(reg[i]);
- }
-
- PAD(succip);
- PAD(succip_str);
-
- 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]);
- }
- }
- 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);
+ 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);
+ MB_Word* cur_pred = MB_code_get_pred_adr(ip);
+ MB_Word* cur_proc = MB_code_get_proc_adr(ip);
- /* Show the call stack */
- MB_show_call(ms, fp);
+ if (fp == NULL) return;
- fprintf(fp,
"----------------------------------------------------------------------------\n");
- if (ip >= MB_code_size(ms) || ip < 0) {
+ fprintf(fp, "----------------------------------------"
+ "------------------------------------\n");
+ if (MB_code_range_check(ip) != ip) {
fprintf(fp, " Invalid execution address\n");
return;
}
/* Show what predicate we are in */
- MB_str_bytecode(cur_pred, buffer, sizeof(buffer), 0);
+ MB_str_bytecode(ms, cur_pred, buffer, sizeof(buffer), 0);
fprintf(fp, "%s\n", buffer);
- MB_str_bytecode(cur_proc, buffer, sizeof(buffer), 1);
+ MB_str_bytecode(ms, 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);
+ MB_listing(ms, fp, ip-2, ip+4, 73);
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);
+ MB_Word i;
- for (j = 0; j < NREGS; j++) {
- fprintf(fp, " %s %s \n",
- vars.reg_name[j],
- vars.reg[j]
- );
+ /* Show the registers */
+ for (i = 0; i < NREGS; i++) {
+ fprintf(fp, "reg[%02d] = %08x ",
+ (int)i, (int)MB_reg(i));
+ if (i & 1) {
+ fprintf(fp, "\n");
+ }
+ }
+ if (i & 1) {
+ fprintf(fp, "\n");
}
-
- 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]);
+ /* Show the stack */
+ fprintf(fp, "\n");
+
+ fprintf(fp, " sp = %08x "
+ " maxfr = %08x\n",
+ (int)MB_sp,
+ (int)MB_maxfr);
+ for (i = 0; i < NSTACK; i++) {
+ fprintf(fp, "%cdet[%02d] = %08x "
+ "%cnondet[%02d] = %08x\n",
+ (&MB_stackitem(i) == ms->cur_proc.var) ?
+ '>' : ' ',
+ (int)i, MB_stackitem(i),
+ (&MB_frameitem(i) == ms->cur_proc.var) ?
+ '>' : ' ',
+ (int)i, MB_frameitem(i));
}
}
- 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);
- }
-
-}
+ fprintf(fp, "\n");
+} /* MB_show_state */
Index: mb_machine_show.h
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_machine_show.h,v
retrieving revision 1.1
diff -u -r1.1 mb_machine_show.h
--- mb_machine_show.h 2001/01/24 07:42:27 1.1
+++ mb_machine_show.h 2001/01/24 07:44:34
@@ -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 $
+** Module to display the state of the mercury machine
**
-** Abstract mercury machine
-**
*/
-
#ifndef MB_MACHINE_SHOW_H
#define MB_MACHINE_SHOW_H
@@ -25,5 +22,4 @@
void MB_show_call(MB_Machine_State* ms, FILE* fp);
#endif /* MB_MACHINE_SHOW_H */
-
Index: mb_mem.c
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_mem.c,v
retrieving revision 1.1
diff -u -r1.1 mb_mem.c
--- mb_mem.c 2001/01/24 07:42:28 1.1
+++ mb_mem.c 2001/01/24 07:44:34
@@ -1,15 +1,15 @@
/*
-** 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:"
*/
/* 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,6 +29,33 @@
/* Implementation */
+#ifndef MB_NO_GC
+# pragma message "Garbage collection is on"
+# define GC_DEBUG
+# include <gc.h>
+#else
+# pragma message "Garbage collection is off"
+#endif
+
+
+/*
+** Initialise memory allocation
+*/
+void
+MB_mem_init()
+{
+#ifndef MB_NO_GC
+ int i;
+
+ /* Initialise the garbage collector */
+ GC_INIT();
+
+ for (i = 0; i < (1 << TAGBITS); i++) {
+ GC_REGISTER_DISPLACEMENT(i);
+ }
+#endif
+}
+
void*
MB_malloc(size_t size)
{
@@ -104,5 +128,53 @@
return new_mem;
}
+/*
-------------------------------------------------------------------------
*/
+
+#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)
+{
+ return MB_free(mem);
+}
+
+void*
+MB_GC_realloc(void *mem, size_t size)
+{
+ return MB_realloc(mem, size);
+}
+#endif /* MB_NO_GC */
Index: mb_mem.h
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_mem.h,v
retrieving revision 1.1
diff -u -r1.1 mb_mem.h
--- mb_mem.h 2001/01/24 07:42:28 1.1
+++ mb_mem.h 2001/01/24 07:44:34
@@ -1,6 +1,6 @@
/*
-** Copyright (C) 2000 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.
**
@@ -10,32 +10,73 @@
**
*/
-
#ifndef MB_MEM_H
#define MB_MEM_H
#include <stdlib.h>
+#include "mb_basetypes.h"
+
+/*
+** Initialise memory allocation
+*/
+void MB_mem_init(void);
+
/*
** 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.
+**
+** 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) \
((type *) MB_realloc((array), (num) * sizeof(type)))
+/*
+** Garbage collected versions of the above
+**
+*/
+
+/* Atomic == doesn't contain any pointers */
+
+void* MB_GC_malloc(size_t size);
+
+void* MB_GC_malloc_atomic(size_t size);
+
+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)))
+
+#define MB_GC_resize_array(array, type, num) \
+ ((type *) MB_GC_realloc((array), (num) * sizeof(type)))
+
#endif /* MB_MEM_H */
+
Index: mb_stack.c
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_stack.c,v
retrieving revision 1.1
diff -u -r1.1 mb_stack.c
--- mb_stack.c 2001/01/24 07:42:28 1.1
+++ mb_stack.c 2001/01/24 07:44:34
@@ -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,9 +18,9 @@
/* Exported definitions */
-MB_Stack MB_stack_new(MB_Word init_size);
+MB_Stack MB_stack_new(MB_Word init_size, MB_Bool gc);
MB_Word MB_stack_size(MB_Stack* s);
-void MB_stack_push(MB_Stack* s, MB_Word x);
+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);
@@ -37,23 +35,26 @@
/* 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;
}
@@ -64,15 +65,27 @@
return s->sp;
}
-void
+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
@@ -86,6 +99,7 @@
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;
@@ -141,8 +155,11 @@
void
MB_stack_delete(MB_Stack* s) {
- MB_free(s->data);
+ if (s->gc) {
+ MB_GC_free(s->data);
+ } else {
+ MB_free(s->data);
+ }
}
-
Index: mb_stack.h
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_stack.h,v
retrieving revision 1.1
diff -u -r1.1 mb_stack.h
--- mb_stack.h 2001/01/24 07:42:28 1.1
+++ mb_stack.h 2001/01/24 07:44:34
@@ -1,33 +1,36 @@
/*
-** 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"
-typedef struct {
+typedef struct MB_Stack_Tag {
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 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);
+/* 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);
/* allocates space for multiple places on the stack */
@@ -40,7 +43,7 @@
/* 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);
/* get the address for the item at index
-** Note: if you add or remove items, this value could change */
+** 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);
@@ -51,6 +54,16 @@
/* deallocate space for the stack */
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_mem(stack, type, num) \
+ MB_stack_alloc((stack), \
+ ( (num) \
+ * (sizeof(type)+sizeof(MB_Word)-1) \
+ / sizeof(MB_Word) ) \
+ )
+#endif /* MB_STACK_H */
Index: mb_util.c
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_util.c,v
retrieving revision 1.1
diff -u -r1.1 mb_util.c
--- mb_util.c 2001/01/24 07:42:28 1.1
+++ mb_util.c 2001/01/24 07:44:34
@@ -1,10 +1,9 @@
-
+#define NOSAY 0 /* To disable SAYings */
/*
-** 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_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,6 +43,19 @@
fprintf(stderr, "\n");
}
+void 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");
+#endif
+}
+
/* prints an error and aborts program */
void
MB_fatal(const char* message)
@@ -54,9 +69,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));
+ strcpy(c, str);
+ return c;
+}
+
+void
+MB_str_delete(MB_CString str)
+{
+ MB_GC_free(str);
+}
Index: mb_util.h
===================================================================
RCS file: /home/mercury1/repository/mercury/bytecode/mb_util.h,v
retrieving revision 1.1
diff -u -r1.1 mb_util.h
--- mb_util.h 2001/01/24 07:42:28 1.1
+++ mb_util.h 2001/01/24 07:44:34
@@ -1,15 +1,15 @@
/*
-** 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_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;
@@ -31,12 +31,23 @@
void
MB_util_error(const char *fmt, ...);
+void SAY(const char* fmr, ...);
+
/* Prints an error message and exits */
void
MB_fatal(const char* message);
+/* 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 */
-int MB_strcmp(MB_CString_Const a, MB_CString_Const b);
+int MB_str_cmp(MB_CString_Const a, MB_CString_Const b);
+/* deallocate space for string */
+void MB_str_delete(MB_CString str);
#endif /* MB_UTIL_H */
-
===================================================================
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_interface.h Wed Jan 24 18:44:34 2001
@@ -0,0 +1,138 @@
+
+/*
+** 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_util.h"
+
+typedef struct {
+ /*
+ ** if cached_adr is NULL, this function hasn't been looked up yet
+ */
+
+ MB_Word* cached_ip;
+ const char* module_name;
+ const char* pred_name;
+ MB_Word proc_num;
+ MB_Word arity;
+ MB_Byte is_func;
+} MB_Call;
+
+/* Entry point for a native code call to det bytecode */
+MB_Word* MB_bytecode_call_entry(MB_Call* bytecode_call);
+
+/* Return to deterministic code after call to native code */
+MB_Word* MB_bytecode_return_det(void);
+
+/* Returns pointer to the stub that calls bytecode_return_det */
+MB_Word* MB_native_get_return_det(void);
+
+/* Find the native code entry point for a procedure */
+MB_Word* MB_code_find_proc_native(MB_CString_Const module,
+ MB_CString_Const pred, MB_Word proc,
+ MB_Word arity, MB_Byte is_func);
+
+/**************************************************************/
+/*
+** det stack
+**
+** Each det stack frame looks like the following:
+** sp-0: [succip]
+** sp-1: [semidet success indicator - may or may not be there]
+** sp-2: [var 0]
+** sp-3: [var 1]
+** ...
+** sp-n: [temp 0]
+** sp-n-1: [temp 1]
+** ...
+**
+** Note the addition of [number of vars] so that MB_func_type_check
+** can determine where the temp list begins
+*/
+
+#define MB_DETFRAME_SUCCIP (0) /* saved succip */
+#define MB_DETFRAME_BC_SUCCIP (1) /* bytecode return address for stub
*/
+
+#define MB_DETFRAME_SIZE (2) /* size of det stack frame */
+
+/*
+** 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)
+
+#define MB_FRAME_SIZE 5
+#define MB_FRAME_TEMP_DET_SIZE 4
+#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: 0 is the top (unused), 1 is the first used slot*/
+#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 = 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 Wed Jan 24 18:44:34 2001
@@ -0,0 +1,172 @@
+
+/*
+** 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 */
+
+/*
+** A native code procedure wishes to call a deterministic bytecode
procedure
+*/
+
+#include "mb_machine_def.h" /* needed to instantiate MB_Machine_State
*/
+
+/* This is called when native code wishes to call bytecode */
+MB_Word*
+MB_bytecode_call_entry(MB_Call* bytecode_call)
+{
+
+ MB_Word* ip;
+
+ SAY("\n\nHello from bytecode_entry_det");
+ if ((void*)bytecode_call->cached_ip == NULL) {
+ SAY("mad cow");
+ 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 {
+ SAY("fast mad cow");
+ ip = bytecode_call->cached_ip;
+ }
+ if (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 bytecode consistent?)");
+ }
+
+ SAY(" bytecode adr %04x", ip);
+
+ {
+ /* Create a new machine and start executing */
+ MB_Machine_State ms;
+ MB_machine_create(ip, &ms);
+ ip = MB_machine_exec(&ms);
+ }
+
+ return ip;
+}
+
+/*
+** When a det procedure wishes to call native code:
+** Bytecode sets SUCCIP to MB_bytecode_return_det,
+** Bytecode sets MB_DETFRAME_BC_SUCCIP to bytecode return address
+** returns to native code, passing the address of the native code
+** to be called
+**
+** After native code is finished, returns to this function which
+** reads MB_DETFRAME_BC_SUCCIP and returns to that location
+*/
+MB_Word*
+MB_bytecode_return_det(void)
+{
+ MB_Word* ip = (MB_Word*)MB_stackitem(MB_DETFRAME_BC_SUCCIP);
+
+ MB_Machine_State ms;
+ MB_machine_create(ip, &ms);
+
+ ip = MB_machine_exec(&ms);
+
+ return ip;
+}
+
+MB_Word*
+MB_native_get_return_det(void)
+{
+ static MB_Word* return_det_stub = NULL;
+ if (return_det_stub == NULL) {
+ return_det_stub =
+ MB_code_find_proc_native(
+ "mb_interface_stub",
+ "mb_native_return_det",
+ 0, 1, FALSE);
+ }
+ return return_det_stub;
+}
+
+
+MB_Word*
+MB_code_find_proc_native(MB_CString_Const module, MB_CString_Const
pred,
+ MB_Word proc, MB_Word arity, MB_Byte is_func)
+{
+ MR_Matches_Info matches;
+ MR_Proc_Spec spec;
+
+ MR_register_all_modules_and_procs(stderr, TRUE);
+ 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;
+
+ SAY("Looking for procedures .... ");
+ matches = MR_search_for_matching_procedures(&spec);
+
+ {
+ MB_Word i;
+ for (i = 0; i < matches.match_proc_next; i++) {
+ 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_Word adr = (MB_Word)
+ matches.match_procs[0]->
+ MR_sle_traversal.MR_trav_code_addr;
+ SAY("Adr %08x", adr);
+ }
+ return matches.match_procs[0]->
+ MR_sle_traversal.MR_trav_code_addr;
+ default:
+ MB_fatal("More than one native code entry found!");
+ return NULL;
+ }
+}
+
===================================================================
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_basetypes.h Wed Jan 24 18:44:34 2001
@@ -0,0 +1,48 @@
+
+/*
+** 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.
+**
+** This file contains the basic type definitions
+*/
+
+#ifndef MB_BASETYPES_H
+#define MB_BASETYPES_H
+
+#include <stdio.h>
+
+#include <mercury_conf.h>
+#include <mercury_types.h>
+#include <mercury_float.h>
+
+/* XXX expects sizeof(unsigned char) == 1 */
+typedef unsigned char
+ MB_Byte;
+
+typedef MR_INT_LEAST16_TYPE
+ MB_Short;
+
+typedef MR_Word
+ MB_Word;
+
+typedef MR_Unsigned
+ MB_Unsigned;
+
+/* XXX Assume char is 8 bits (Is there a system where is isn't) */
+#define MB_WORD_BITS ((sizeof(MB_Word)/sizeof(char))*8)
+
+typedef MR_Integer
+ MB_Integer;
+
+typedef MR_Float
+ MB_Float;
+
+typedef MR_Float64
+ MB_Float64;
+
+typedef MR_Bool
+ MB_Bool;
+
+#endif /* MB_BASETYPES_H */
+
===================================================================
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_interface_stub.m Wed Jan 24 18:44:34 2001
@@ -0,0 +1,17 @@
+:- module mb_interface_stub.
+
+:- interface.
+
+:- pred mb_native_return_det_stub(int).
+:- mode mb_native_return_det_stub(out) is det.
+
+:- implementation.
+
+:- pragma c_code(
+ mb_native_return_det_stub(Garbage::out),
+ [may_call_mercury],
+" {
+ }
+ Garbage = 4;
+"
+ ).
===================================================================
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_machine_def.h Wed Jan 24 18:44:34 2001
@@ -0,0 +1,49 @@
+/*
+** 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.
+**
+*/
+
+#ifndef MB_MACHINE_DEF_H
+#define MB_MACHINE_DEF_H
+
+#include "mb_stack.h"
+
+struct MB_Machine_State_Tag {
+
+ MB_Module* module;
+ MB_Word* ip; /* next instruction pointer*/
+
+ /* The native code address to return to at finish */
+ MB_Word* native_return;
+
+ /* The following proc information is all set by MB_func_type_check()
*/
+ struct {
+ /* The determinism of the currently executing function */
+ /* (set to a return value from MB_code_get_det) */
+ MB_Word is_det;
+
+ /* Pointer to vars for current procedure */
+ MB_Word* var;
+ } cur_proc;
+};
+
+#include <mercury_std.h>
+
+#if (MR_VARIABLE_SIZED > 0)
+# define MB_CLOSURE_SIZE(x) (sizeof(MB_Closure) \
+ - sizeof(((MB_Closure*)(NULL))-> \
+ closure_hidden_args \
+ + sizeof(MB_Word)*(x))
+#else
+# define MB_CLOSURE_SIZE(x) (sizeof(MB_Closure) \
+ + sizeof(MB_Word)*(x))
+#endif
+typedef struct {
+ MB_Word code_adr;
+ MB_Word num_hidden_args;
+ MB_Word closure_hidden_args[MR_VARIABLE_SIZED];
+} MB_Closure;
+
+#endif /* MB_MACHINE_DEF_H */
===================================================================
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_module.h Wed Jan 24 18:44:34 2001
@@ -0,0 +1,88 @@
+
+/*
+** 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_Tag;
+typedef struct MB_Module_Tag 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_Word*)(-1))
+#define MB_CODE_DO_REDO ((MB_Word*)(-2))
+#define MB_CODE_NATIVE_RETURN ((MB_Word*)(-3))
+#define MB_CODE_INVALID_ADR ((MB_Word*)(-4))
+
+/*
+** A native code procedure wishes to call a deterministic bytecode
procedure
+*/
+MB_Module* MB_module_load_name(MB_CString_Const module_name);
+MB_Module* MB_module_load(MB_CString_Const module_name, FILE* fp);
+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 there are */
+MB_Word MB_code_size(void);
+/* Read the bytecode at a given address */
+/*MB_Bytecode MB_code_get(MB_Word*adr);*/
+/* Get the bytecode type at a given address */
+MB_Byte MB_code_get_id(MB_Word*adr);
+
+#define MB_ISDET_NO 0
+#define MB_ISDET_YES 1
+/* Get the determinism of the procedure a code at a given address is in
*/
+MB_Byte MB_code_get_det(MB_Word*adr);
+/* Get the bytecode argument at a given address */
+MB_Bytecode_Arg*MB_code_get_arg(MB_Word*adr);
+/* Get the predicate in which the following address resides */
+/*MB_Bytecode MB_code_get_pred(MB_Word* adr);*/
+MB_Word* MB_code_get_pred_adr(MB_Word* adr);
+/* Get the procedure in which the following address resides */
+/*MB_Bytecode MB_code_get_proc(MB_Word* adr);*/
+MB_Word* MB_code_get_proc_adr(MB_Word* adr);
+
+MB_Word* MB_code_find_proc(MB_CString_Const module,
+ MB_CString_Const pred,
+ MB_Word proc,
+ MB_Word arity,
+ MB_Byte is_func);
+/* Returns a code address clipped into the valid code range */
+MB_Word* MB_code_range_check(MB_Word* adr);
+/* True if the code address is 'normal' (not invalid or one of
MB_CODE_xxx) */
+MB_Bool MB_ip_normal(MB_Word* ip);
+/* True if the code address is one of MB_CODE_xxx */
+MB_Bool MB_ip_special(MB_Word* ip);
+/* True if a native code address */
+MB_Bool MB_ip_native(MB_Word* ip);
+
+/* Allocate memory in the code argument data array */
+#define MB_code_data_alloc(type, number) \
+ ((type*)(MB_code_data_alloc_words(((sizeof(type)*(number))+3) / 4)))
+
+MB_Word* MB_code_data_alloc_words(MB_Word num_words);
+
+
+#endif /* MB_MODULE_H */
+
===================================================================
--- /dev/null Wed Nov 22 17:39:10 2000
+++ mb_module.c Wed Jan 24 18:44:34 2001
@@ -0,0 +1,936 @@
+/*
+** 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: no fixed limits */
+#define MAX_CODE_COUNT 10000
+#define MAX_CODE_DATA_COUNT 160000
+#define MAX_MODULES 64
+
+#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
+*/
+
+#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) */
+#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)) \
+ )
+
+/* XXX: not thread safe */
+static MB_Word code_count = 0;
+static MB_Word 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 {
+ /* 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: not thread safe */
+static MB_Word module_count = 0;
+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);
+
+/* Implementation */
+
+/*
+** Translates calls from a predicate name/procedure to an actual code
address
+** Translates call & higher_or
+*/
+static MB_Bool
+translate_calls(MB_Word*bc, MB_Word number_codes)
+{
+ /* XXX: 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;
+ 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;
+ /* location to store the proc to be called */
+ MB_Byte* target_is_native = NULL;
+ MB_Word** target_adr = 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;
+ 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;
+
+ } 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_id;
+ 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;
+ #endif
+ }
+ }
+
+
+ if (pred_name != NULL) {
+ SAY("Looking for %s %s__%s/%d (%d)",
+ (is_func) ? "func" : "pred",
+ module_name,
+ pred_name,
+ arity,
+ proc_id);
+ }
+
+ /* 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,
+ arity, is_func);
+
+ if (adr == MB_CODE_INVALID_ADR) {
+ SAY(" Not found in bytecode");
+ /* Otherwise look in the native code */
+ adr = MB_code_find_proc_native(module_name,
+ pred_name, proc_id, arity, is_func);
+
+ SAY(" Address from native: %08x", adr);
+ if (adr == NULL) {
+ MB_util_error(
+ "Reference in bytecode %08x"
+ " to unknown"
+ " %s %s__%s/%d (%d)",
+ (int)i,
+ is_func ? "func" : "pred",
+ module_name,
+ pred_name,
+ (int)arity,
+ (int)proc_id);
+ MB_fatal("(Are you sure the module"
+ " was compiled with trace"
+ " information enabled?)");
+ } else {
+ *target_is_native = FALSE;
+ }
+
+ } else {
+ *target_is_native = TRUE;
+ }
+ *target_adr = adr;
+ }
+ }
+
+ 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
+*/
+static MB_Bool
+translate_labels(MB_Word* bc, MB_Word number_codes, MB_Stack*
label_stack)
+{
+ MB_Word 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);
+ #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);
+ break;
+
+ case MB_BC_enter_if:
+ XLATLABEL(enter_if, else_label);
+ XLATLABEL(enter_if, end_label);
+ break;
+
+ case MB_BC_endof_then:
+ XLATLABEL(endof_then, follow_label);
+ break;
+
+ case MB_BC_enter_disjunction:
+ XLATLABEL(enter_disjunction, end_label);
+ break;
+
+ case MB_BC_enter_disjunct:
+ XLATLABEL(enter_disjunct, next_label);
+ break;
+
+ case MB_BC_endof_disjunct:
+ XLATLABEL(endof_disjunct, end_label);
+ break;
+
+ case MB_BC_enter_switch:
+ XLATLABEL(enter_switch, end_label);
+ break;
+
+ case MB_BC_enter_switch_arm:
+ XLATLABEL(enter_switch_arm, next_label);
+ break;
+
+ case MB_BC_endof_switch_arm:
+ XLATLABEL(endof_switch_arm, end_label);
+ break;
+
+ case MB_BC_enter_negation:
+ XLATLABEL(enter_negation, end_label);
+ break;
+
+ default:
+
+ }
+ }
+ return TRUE;
+} /* translate_labels */
+
+
+/* Store the procedure's determinism that each instruction is executing
under */
+static MB_Bool
+translate_detism(MB_Word* bc, MB_Word number_codes)
+{
+ MB_Word 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_INVALID:
+ cur_detism = 0;
+ break;
+ default:
+ assert(FALSE);
+ }
+ }
+ if (cur_detism) {
+ *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
+*/
+static MB_Bool
+translate_switch(MB_Word* bc, MB_Word number_codes)
+{
+ MB_Word 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
+*/
+#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_Word* bc, MB_Word number_codes)
+{
+ MB_Word 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;
+}
+
+/*
+** A native code procedure wishes to call a deterministic bytecode
procedure
+*/
+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;
+ SAY(" Looking for %s among %d modules", module_name, module_count);
+ for (i = 0; i < module_count; i++) {
+ SAY(" Testing module %d", i);
+ if (!MB_str_cmp(module_name, module_arr[i]->module_name)) {
+ SAY(" Module %s found", module_name);
+ return module_arr[i];
+ }
+ }
+
+ 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)
+/* XXX ORDER */
+/* 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)
+}; /* argument_size */
+
+/*
+** Load a module
+** If fp is NULL then that means there is no bytecode information
+** for this module -- revert to native code.
+*/
+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;
+
+ /* 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_Word* 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_INVALID;
+ }
+
+ /* 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;
+ }
+ }
+
+ /* actually save the bytecode id & argument index*/
+ code_id[code_count] = MB_BCID_MAKE(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)
+*/
+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_Word
+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)
+{
+ if (!MB_ip_normal(adr))
+ return MB_BC_debug_invalid;
+
+ /* return the code with the determinism flag stripped away */
+ return MB_BCID_ID(*adr);
+}
+
+/* Get a bytecode's procedure's determinism */
+MB_Byte
+MB_code_get_det(MB_Word* adr)
+{
+ assert(MB_ip_normal(adr));
+
+ /* return the determinism flag */
+ return MB_BCID_DET(*adr) ? 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* data_p;
+
+ if (!MB_ip_normal(adr)) return NULL;
+
+ data_p = MB_BCID_ARG(*adr);
+ 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) {
+
+ while (MB_code_get_id(adr) != MB_BC_enter_pred) {
+
+ adr--;
+ if (!MB_ip_normal(adr)) {
+ return MB_CODE_INVALID_ADR;
+ }
+ }
+
+ return adr;
+}
+
+#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_Byte bc_id;
+ adr++;
+ do {
+ adr--;
+ assert(MB_ip_normal(adr));
+ bc_id = MB_code_get_id(adr);
+ assert(bc_id != MB_BC_enter_pred);
+ assert(bc_id != MB_BC_endof_pred);
+ }
+ while (bc_id != MB_BC_enter_proc);
+
+ return adr;
+} /* MB_code_get_proc_adr */
+
+/* Finds the location of a given proc */
+MB_Word*
+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_Word* adr;
+ MB_Word size;
+ MB_Module* module = MB_module_get(module_name);
+ MB_Word j;
+
+ SAY(" Looking for %s %s__%s/%d (%d)",
+ (is_func) ? "func" : "pred",
+ module_name, pred_name, arity, proc_id);
+
+ if (MB_stack_size(&module->pred_index_stack) == 0) {
+ 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);
+
+ pred_arg = MB_code_get_arg(adr);
+
+ 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)) {
+ SAY(" Not found");
+ return MB_CODE_INVALID_ADR;
+ }
+
+ /* one obviously did */
+ /* Now find the right proc */
+ do {
+ MB_Byte bc_id;
+
+ adr++;
+
+ assert(MB_ip_normal(adr));
+
+ bc_id = MB_code_get_id(adr);
+ 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)
+ {
+ return adr;
+ }
+
+ /* 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)",
+ pred_name,
+ (int)arity,
+ (int)proc_id);
+ 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_Word*
+MB_code_range_check(MB_Word* adr)
+{
+ MB_Word* max_adr;
+ if (adr < code_id) return code_id;
+
+ max_adr = code_id + code_count - 1;
+ if (adr >= max_adr) return max_adr;
+
+ return adr;
+}
+
+/*
+** Returns true if a given instruction pointer points to a normal
+** address
+*/
+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)
+{
+ return ((MB_Unsigned)ip > (MB_Unsigned)MB_CODE_INVALID_ADR);
+}
+
+MB_Bool
+MB_ip_native(MB_Word* ip)
+{
+ return !MB_ip_special(ip) && !MB_ip_normal(ip);
+}
+
===================================================================
--- /dev/null Wed Nov 22 17:39:10 2000
+++ simple01.m Wed Jan 24 18:44:34 2001
@@ -0,0 +1,52 @@
+% enum tags
+
+:- module simple01.
+
+:- interface.
+
+:- import_module int, io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- func temp(colour) = int.
+:- mode temp(in) = out is det.
+
+:- func temp2(int) = int.
+:- mode temp2(in) = out is det.
+
+:- pred ccode(int, int, int, int, int).
+:- mode ccode(in, in, in, out, out) is det.
+
+:- type colour
+ ---> red
+ ; green
+ ; blue
+ .
+
+:- implementation.
+
+:- pragma c_code(
+ ccode(A::in, B::in, C::in, X::out, Y::out),
+ [may_call_mercury],
+ "X = A+B; Y = A+B+C;"
+ ).
+
+temp(X) = Y :-
+ ( X = red, ccode(1, 2, 3, Q, R), Y = Q+R
+ ; X = green, Y = temp2(3)
+ ; X = blue, Y = temp2(5)
+ ).
+
+temp2(X) = X + 1.
+
+main -->
+ {
+ R = temp(red),
+ G = temp(green),
+ B = temp(blue)
+
+ },
+ io__write_int(R),
+ io__write_int(G),
+ io__write_int(B).
--------------------------------------------------------------------------
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