for review: a big step towards the trace-based debugger (part 3 of 3)
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Mar 20 19:57:37 AEDT 1998
Index: runtime/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace.c,v
retrieving revision 1.8
diff -u -r1.8 mercury_trace.c
--- mercury_trace.c 1998/03/11 22:07:31 1.8
+++ mercury_trace.c 1998/03/20 08:11:37
@@ -18,7 +18,29 @@
#include "mercury_trace.h"
#include "mercury_engine.h"
#include "mercury_wrapper.h"
+#include "mercury_misc.h"
#include <stdio.h>
+#include <ctype.h>
+
+/*
+** Do we want to use the debugger within this process, or do want to use
+** the Opium-style trace analyzer debugger implemented by an external process.
+** This variable is set in mercury_wrapper.c and never modified afterwards.
+*/
+
+MR_trace_type MR_trace_handler = MR_TRACE_INTERNAL;
+
+/*
+** Compiler generated tracing code will check whether MR_trace_enabled is true,
+** before calling MR_trace. For now, and until we implement interface tracing,
+** MR_trace_enabled should keep the same value throughout the execution of
+** the entire program after being set in mercury_wrapper.c. There is one
+** exception to this: the Mercury routines called as part of the functionality
+** of the tracer itself (e.g. the term browser) should always be executed
+** with MR_trace_enabled set to FALSE.
+*/
+
+bool MR_trace_enabled = FALSE;
/*
** MR_trace_call_seqno counts distinct calls. The prologue of every
@@ -42,11 +64,13 @@
int MR_trace_call_depth = 0;
/*
-** MR_trace_event_number is a simple counter of events; currently we only
-** use it for display.
+** MR_trace_event_number is a simple counter of events. This is used in
+** two places: here, for display to the user and for skipping a given number
+** of events, and when printing an abort message, so that the programmer
+** can zero in on the source of the problem more quickly.
*/
-static int MR_trace_event_number = 0;
+int MR_trace_event_number = 0;
/*
** MR_trace_cmd and MR_trace_seqno are globals variables that we use
@@ -61,17 +85,16 @@
*/
typedef enum {
- MR_CMD_CONT, /* c: continue to end, not printing the trace */
- MR_CMD_DUMP, /* d: continue to end, printing the trace */
- MR_CMD_NEXT, /* n: go to the next trace event */
- MR_CMD_SKIP, /* s: skip the current call, not printing trace */
- MR_CMD_JUMP /* j: jump to end of current call, printing trace */
+ MR_CMD_GOTO,
+ MR_CMD_FINISH,
+ MR_CMD_TO_END
} MR_trace_cmd_type;
/*
** This type must match the definition of classify_request in
** library/debugger_interface.m.
*/
+
typedef enum {
MR_REQUEST_HELLO_REPLY = 0, /* initiate debugging session */
MR_REQUEST_FORWARD_MOVE = 1, /* go to the next matching trace event */
@@ -81,8 +104,10 @@
MR_REQUEST_ERROR = 5 /* something went wrong */
} MR_debugger_request_type;
-static MR_trace_cmd_type MR_trace_cmd = MR_CMD_NEXT;
-static int MR_trace_seqno = 0;
+static MR_trace_cmd_type MR_trace_cmd = MR_CMD_GOTO;
+static int MR_trace_stop_seqno = 0;
+static int MR_trace_stop_event = 0;
+static bool MR_trace_print_intermediate = FALSE;
typedef enum {
MR_INTERACT,
@@ -90,25 +115,28 @@
} MR_trace_interact;
static void MR_trace_event(MR_trace_interact interact,
- const MR_stack_layout_entry *layout,
+ const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth,
- const char *path);
+ const char *path, int max_r_num);
+static void MR_copy_saved_regs_to_regs(int max_mr_num);
+static void MR_copy_regs_to_saved_regs(int max_mr_num);
static void MR_trace_display_user(MR_trace_interact interact,
- const MR_stack_layout_entry *layout,
+ const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth,
const char *path);
static void MR_trace_browse(int var_count,
- const MR_stack_layout_vars *var_info);
-static void MR_trace_browse_var(char *name,
- const MR_stack_layout_var *var);
-static int MR_trace_get_cmd(void);
+ const MR_Stack_Layout_Vars *var_info);
+static void MR_trace_browse_var(const char *name,
+ const MR_Stack_Layout_Var *var, Word *type_params);
+static int MR_trace_skip_spaces(int c);
+static void MR_trace_discard_to_eol(int c);
static void MR_trace_help(void);
static Word MR_trace_make_var_list(MR_trace_port port,
- const MR_stack_layout_entry *layout);
+ const MR_Stack_Layout_Label *layout);
static Word MR_trace_lookup_live_lval(MR_Live_Lval locn, bool *succeeded);
-static bool MR_trace_get_type_and_value(const MR_stack_layout_var *var,
- Word *type_info, Word *value);
+static bool MR_trace_get_type_and_value(const MR_Stack_Layout_Var *var,
+ Word *type_params, Word *type_info, Word *value);
/*
We could use
@@ -118,7 +146,7 @@
check for an additional flag in the MERCURY_OPTIONS
environment variable and set MR_use_debugger accordingly.
*/
-#ifdef MR_USE_DEBUGGER
+#ifdef MR_USE_EXTERNAL_DEBUGGER
static MercuryFile MR_debugger_socket_in;
static MercuryFile MR_debugger_socket_out;
@@ -129,21 +157,18 @@
Integer *debugger_request_type_ptr);
static void MR_debugger_step(MR_trace_interact interact,
- const MR_stack_layout_entry *layout,
+ const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth,
const char *path);
-static bool MR_found_match(const MR_stack_layout_entry *layout,
+static bool MR_found_match(const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth,
/* XXX registers */
const char *path, Word search_data);
-static void MR_output_current(const MR_stack_layout_entry *layout,
+static void MR_output_current(const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth,
Word var_list,
const char *path, Word current_request);
-static void MR_copy_saved_regs_to_regs(void);
-static void MR_copy_regs_to_saved_regs(void);
-
#endif
#define MR_port_is_final(port) (port == MR_PORT_EXIT || port == MR_PORT_FAIL)
@@ -154,72 +179,167 @@
*/
void
-MR_trace(const Word *layout_word, MR_trace_port port,
- int seqno, int depth, const char *path)
+MR_trace(const MR_Stack_Layout_Label *layout, MR_trace_port port,
+ int seqno, int depth, const char *path, int max_r_num)
{
- const MR_stack_layout_entry *layout;
MR_trace_interact interact;
- layout = (const MR_stack_layout_entry *) layout_word;
-
MR_trace_event_number++;
switch (MR_trace_cmd) {
- case MR_CMD_NEXT:
- MR_trace_event(MR_INTERACT, layout,
- port, seqno, depth, path);
- break;
+ case MR_CMD_FINISH:
+ if (MR_trace_stop_seqno == seqno
+ && MR_port_is_final(port)) {
+ MR_trace_event(MR_INTERACT, layout,
+ port, seqno, depth, path, max_r_num);
- case MR_CMD_JUMP:
- if (MR_trace_seqno == seqno && MR_port_is_final(port))
- {
- interact = MR_INTERACT;
- } else {
- interact = MR_NO_INTERACT;
+ } else if (MR_trace_print_intermediate) {
+ MR_trace_event(MR_NO_INTERACT, layout,
+ port, seqno, depth, path, max_r_num);
}
- MR_trace_event(interact, layout,
- port, seqno, depth, path);
-
break;
- case MR_CMD_SKIP:
- if (MR_trace_seqno == seqno && MR_port_is_final(port))
- {
+ case MR_CMD_GOTO:
+ if (MR_trace_event_number >= MR_trace_stop_event) {
MR_trace_event(MR_INTERACT, layout,
- port, seqno, depth, path);
+ port, seqno, depth, path, max_r_num);
+ } else if (MR_trace_print_intermediate) {
+ MR_trace_event(MR_NO_INTERACT, layout,
+ port, seqno, depth, path, max_r_num);
}
- break;
-
- case MR_CMD_CONT:
- break;
+ case MR_CMD_TO_END:
+ if (MR_trace_print_intermediate) {
+ MR_trace_event(MR_NO_INTERACT, layout,
+ port, seqno, depth, path, max_r_num);
+ }
- case MR_CMD_DUMP:
- MR_trace_event(MR_NO_INTERACT, layout,
- port, seqno, depth, path);
break;
default:
- fatal_error("MR_trace called with inappropriate port");
+ fatal_error("invalid cmd in MR_trace");
break;
}
}
static void
MR_trace_event(MR_trace_interact interact,
- const MR_stack_layout_entry *layout,
- MR_trace_port port, int seqno, int depth, const char *path)
+ const MR_Stack_Layout_Label *layout, MR_trace_port port,
+ int seqno, int depth, const char *path, int max_r_num)
{
-#ifdef MR_USE_DEBUGGER
- MR_copy_regs_to_saved_regs();
- MR_debugger_step(interact, layout, port, seqno, depth, path);
- MR_copy_saved_regs_to_regs();
+ int max_mr_num;
+
+ if (max_r_num + MR_NUM_SPECIAL_REG > MR_MAX_SPECIAL_REG_MR)
+ max_mr_num = max_r_num + MR_NUM_SPECIAL_REG;
+ else
+ max_mr_num = MR_MAX_SPECIAL_REG_MR;
+
+ MR_copy_regs_to_saved_regs(max_mr_num);
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+ if (MR_trace_debugger == MR_TRACE_EXTERNAL)
+ MR_debugger_step(interact, layout, port, seqno, depth, path);
+ else
+ MR_trace_display_user(interact, layout, port, seqno, depth,
+ path);
#else
+ /*
+ ** We should get here only if MR_trace_debugger == MR_TRACE_INTERNAL.
+ ** This is enforced by mercury_wrapper.c.
+ */
+
MR_trace_display_user(interact, layout, port, seqno, depth, path);
#endif
+ MR_copy_saved_regs_to_regs(max_mr_num);
+}
+
+static Word MR_saved_regs[MAX_FAKE_REG];
+
+static void
+MR_copy_regs_to_saved_regs(int max_mr_num)
+{
+ /*
+ ** In the process of browsing, we call Mercury code,
+ ** which may clobber the contents of the virtual machine registers,
+ ** both control and general purpose, and both real and virtual
+ ** registers. We must therefore save and restore these.
+ ** We store them in the MR_saved_regs array.
+ **
+ ** The call to MR_trace will clobber the transient registers
+ ** on architectures that have them. The compiler generated code
+ ** will therefore call save_transient_registers to save the transient
+ ** registers in the fake_reg array. We here restore them to the
+ ** real registers, save them with the other registers back in
+ ** fake_reg, and then copy all fake_reg entries to MR_saved_regs.
+ **
+ ** If any code invoked by MR_trace is itself traced,
+ ** MR_saved_regs will be overwritten, leading to a crash later on.
+ ** This is one reason (but not the only one) why we turn off
+ ** tracing when we call back Mercury code from this file.
+ */
+
+ int i;
+
+ restore_transient_registers();
+ save_registers();
+
+ for (i = 0; i < max_mr_num; i++) {
+ MR_saved_regs[i] = fake_reg[i];
+ }
+}
+
+static void
+MR_copy_saved_regs_to_regs(int max_mr_num)
+{
+ /*
+ ** We execute the converse procedure to MR_copy_regs_to_saved_regs.
+ ** The save_transient_registers is there so that a call to the
+ ** restore_transient_registers macro after MR_trace will do the
+ ** right thing.
+ */
+
+ int i;
+
+ for (i = 0; i < max_mr_num; i++) {
+ fake_reg[i] = MR_saved_regs[i];
+ }
+
+ restore_registers();
+ save_transient_registers();
+}
+
+void
+MR_trace_report(void)
+{
+ if (MR_trace_event_number > 0) {
+ /*
+ ** This means that the executable was compiled with tracing,
+ ** which implies that the user wants trace info on abort.
+ */
+
+ fprintf(stderr, "Last event was event #%d.\n",
+ MR_trace_event_number);
+ }
+}
+
+void
+MR_trace_init(void)
+{
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+ if (MR_trace_handler == MR_TRACE_EXTERNAL)
+ MR_trace_init_external();
+#endif
}
-#ifdef MR_USE_DEBUGGER
+void
+MR_trace_end(void)
+{
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+ if (MR_trace_handler == MR_TRACE_EXTERNAL)
+ MR_trace_end_external();
+#endif
+}
+
+#ifdef MR_USE_EXTERNAL_DEBUGGER
#include <errno.h>
#include <sys/types.h>
@@ -289,7 +409,7 @@
static bool MR_debug_socket = FALSE;
void
-MR_trace_init(void)
+MR_trace_init_external(void)
{
int fd;
int len;
@@ -446,7 +566,7 @@
}
void
-MR_trace_end(void)
+MR_trace_end_external(void)
{
/*
** This can only happen during a forward_move(),
@@ -466,7 +586,7 @@
static void
MR_debugger_step(MR_trace_interact interact,
- const MR_stack_layout_entry *layout,
+ const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth, const char *path)
{
static bool searching = FALSE;
@@ -519,7 +639,7 @@
break;
case MR_REQUEST_NO_TRACE:
- MR_trace_cmd = MR_CMD_CONT;
+ MR_trace_cmd = MR_CMD_TO_END;
return;
default:
@@ -530,7 +650,7 @@
}
static void
-MR_output_current(const MR_stack_layout_entry *layout,
+MR_output_current(const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth,
Word var_list,
const char *path, Word current_request)
@@ -540,11 +660,11 @@
seqno,
depth,
port,
- layout->MR_sle_def_module,
- layout->MR_sle_name,
- layout->MR_sle_arity,
- layout->MR_sle_mode,
- layout->MR_sle_detism,
+ layout->MR_sll_entry->MR_sle_def_module,
+ layout->MR_sll_entry->MR_sle_name,
+ layout->MR_sll_entry->MR_sle_arity,
+ layout->MR_sll_entry->MR_sle_mode,
+ layout->MR_sll_entry->MR_sle_detism,
var_list,
(String) (Word) path,
current_request,
@@ -565,7 +685,7 @@
static bool
-MR_found_match(const MR_stack_layout_entry *layout,
+MR_found_match(const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth,
/* XXX live vars */
const char *path, Word search_data)
@@ -579,11 +699,11 @@
seqno,
depth,
port,
- layout->MR_sle_def_module,
- layout->MR_sle_name,
- layout->MR_sle_arity,
- layout->MR_sle_mode,
- layout->MR_sle_detism,
+ layout->MR_sll_entry->MR_sle_def_module,
+ layout->MR_sll_entry->MR_sle_name,
+ layout->MR_sll_entry->MR_sle_arity,
+ layout->MR_sll_entry->MR_sle_mode,
+ layout->MR_sll_entry->MR_sle_detism,
arguments,
(String) (Word) path,
search_data);
@@ -598,27 +718,21 @@
MR_debugger_socket_out.line_number++;
}
-#else /* !MR_USE_DEBUGGER */
-
-void MR_trace_init(void) {}
-void MR_trace_end(void) {}
-
-#endif /* MR_USE_DEBUGGER */
+#endif /* MR_USE_EXTERNAL_DEBUGGER */
static void
MR_trace_display_user(MR_trace_interact interact,
- const MR_stack_layout_entry *layout,
+ const MR_Stack_Layout_Label *layout,
MR_trace_port port, int seqno, int depth, const char *path)
{
int i;
+ int c;
+ int count;
+ bool count_given;
fflush(stdout);
fprintf(stderr, "%8d: %6d %2d ", MR_trace_event_number, seqno, depth);
- for (i = 0; i < depth; i++) {
- putc(' ', stderr);
- }
-
switch (port) {
case MR_PORT_CALL:
fprintf(stderr, "CALL ");
@@ -653,7 +767,7 @@
"with bad port");
}
- switch ((int) layout->MR_sle_detism) {
+ switch ((int) layout->MR_sll_entry->MR_sle_detism) {
case MR_DETISM_DET:
fprintf(stderr, "DET ");
break;
@@ -698,81 +812,122 @@
*/
fprintf(stderr, "%s:%s/%ld-%ld %s\n",
- layout->MR_sle_def_module,
- layout->MR_sle_name,
- (long) layout->MR_sle_arity,
- (long) layout->MR_sle_mode,
+ layout->MR_sll_entry->MR_sle_def_module,
+ layout->MR_sll_entry->MR_sle_name,
+ (long) layout->MR_sll_entry->MR_sle_arity,
+ (long) layout->MR_sll_entry->MR_sle_mode,
path);
while (interact == MR_INTERACT) {
fprintf(stderr, "mtrace> ");
- switch (MR_trace_get_cmd()) {
- case 'n':
- case '\n':
- MR_trace_cmd = MR_CMD_NEXT;
- break;
+ count = 1;
+ count_given = FALSE;
+ MR_trace_print_intermediate = FALSE;
+
+ c = MR_trace_skip_spaces(' ');
+ if (isdigit(c)) {
+ count_given = TRUE;
+ count = c - '0';
+ c = getchar();
+ while (c != EOF && isdigit(c)) {
+ count = (count * 10) + c - '0';
+ c = getchar();
+ }
- case 'c':
- MR_trace_cmd = MR_CMD_CONT;
- break;
+ c = MR_trace_skip_spaces(c);
+ }
- case 'd':
- MR_trace_cmd = MR_CMD_DUMP;
+ switch (c) {
+ case 'S':
+ MR_trace_print_intermediate = TRUE;
+ /* fall through */
+
+ case 's':
+ case '\n':
+ MR_trace_cmd = MR_CMD_GOTO;
+ MR_trace_stop_event =
+ MR_trace_event_number + count;
+ MR_trace_discard_to_eol(c);
break;
- case 'j':
- if (MR_port_is_final(port)) {
- fprintf(stderr, "mtrace: cannot jump"
- " from this port\n");
+ case 'G':
+ MR_trace_print_intermediate = TRUE;
+ /* fall through */
+
+ case 'g':
+ if (! count_given) {
+ MR_trace_discard_to_eol(c);
+ fprintf(stderr, "mtrace: "
+ "no count given\n");
continue;
- } else {
- MR_trace_cmd = MR_CMD_JUMP;
- MR_trace_seqno = seqno;
}
+ MR_trace_cmd = MR_CMD_GOTO;
+ MR_trace_stop_event = count;
+ MR_trace_discard_to_eol(c);
break;
- case 'p':
- if (port == MR_PORT_CALL) {
- MR_trace_browse((int)
- layout->MR_sle_in_arg_count,
- &layout->MR_sle_in_arg_info);
- } else if (port == MR_PORT_EXIT) {
- MR_trace_browse((int)
- layout->MR_sle_out_arg_count,
- &layout->MR_sle_out_arg_info);
- } else {
- fprintf(stderr, "mtrace: cannot print"
- " from this port\n");
- }
-
- continue;
+ case 'F':
+ MR_trace_print_intermediate = TRUE;
+ /* fall through */
- case 's':
+ case 'f':
if (MR_port_is_final(port)) {
- fprintf(stderr, "mtrace: cannot skip"
- " from this port\n");
+ MR_trace_discard_to_eol(c);
+ fprintf(stderr, "mtrace: this port"
+ "is already final\n");
continue;
} else {
- MR_trace_cmd = MR_CMD_SKIP;
- MR_trace_seqno = seqno;
+ MR_trace_cmd = MR_CMD_FINISH;
+ MR_trace_stop_seqno = seqno;
}
+ MR_trace_discard_to_eol(c);
break;
- case EOF:
+ case 'C':
+ MR_trace_print_intermediate = TRUE;
+ /* fall through */
+
+ case 'c':
+ if (count_given)
+ fprintf(stderr, "mtrace: "
+ "count ignored\n");
+
+ MR_trace_cmd = MR_CMD_TO_END;
+ MR_trace_discard_to_eol(c);
+ break;
+
+ case 'p':
+ if (count_given)
+ fprintf(stderr, "mtrace: "
+ "count ignored\n");
+
+ MR_trace_discard_to_eol(c);
+ MR_trace_browse((int)
+ layout->MR_sll_var_count,
+ &layout->MR_sll_var_info);
+
+ continue;
+
case 'a':
+ case EOF:
+ MR_trace_discard_to_eol(c);
fprintf(stderr, "mtrace: are you sure"
" you want to abort? ");
- if (MR_trace_get_cmd() == 'y') {
+ c = MR_trace_skip_spaces(' ');
+ if (c == 'y' | c == EOF) {
fatal_error("aborting the execution "
"on user request");
}
+
+ MR_trace_discard_to_eol(c);
continue;
default:
+ MR_trace_discard_to_eol(c);
MR_trace_help();
continue;
}
@@ -781,71 +936,24 @@
}
}
-static Word MR_saved_regs[MAX_FAKE_REG];
-
-static void
-MR_copy_regs_to_saved_regs(void)
-{
- /*
- ** In the process of browsing, we call Mercury code,
- ** which may clobber the contents of the registers,
- ** both the control registers and the general purpose registers.
- ** We must therefore save and restore these.
- **
- ** XXX This is very inefficient!
- **
- ** Some are in real machine registers; others in the fake_reg array.
- ** We need to copy them all to the fake_reg array, because the
- ** calling convention for calling Mercury functions exported to C
- ** assumes that they will be in the fake_reg array.
- */
-
- int i;
-
- restore_transient_registers();
- save_registers();
- for (i = 0; i < MAX_FAKE_REG; i++) {
- MR_saved_regs[i] = fake_reg[i];
- }
-}
-
-static void
-MR_copy_saved_regs_to_regs(void)
-{
- int i;
-
- for (i = 0; i < MAX_FAKE_REG; i++) {
- fake_reg[i] = MR_saved_regs[i];
- }
- restore_registers();
- save_transient_registers();
-}
-
static Word
-MR_trace_make_var_list(MR_trace_port port, const MR_stack_layout_entry *layout)
+MR_trace_make_var_list(MR_trace_port port, const MR_Stack_Layout_Label *layout)
{
int var_count;
- const MR_stack_layout_vars *vars;
+ const MR_Stack_Layout_Vars *vars;
int i;
const char *name;
Word univ_list;
- MR_stack_layout_var* var;
+ MR_Stack_Layout_Var* var;
Word univ, value;
MR_Live_Type live_type;
Word type_info;
restore_transient_registers();
- if (port == MR_PORT_CALL) {
- var_count = layout->MR_sle_in_arg_count;
- vars = &layout->MR_sle_in_arg_info;
- } else if (port == MR_PORT_EXIT) {
- var_count = layout->MR_sle_out_arg_count;
- vars = &layout->MR_sle_out_arg_info;
- } else {
- return list_empty();
- }
+ var_count = layout->MR_sll_var_count;
+ vars = &layout->MR_sll_var_info;
/* build up the live variable list, starting from the end */
univ_list = list_empty();
@@ -855,15 +963,22 @@
** (XXX we don't include the name or the inst
** in the list that we return)
*/
- if (vars->MR_slvs_names != NULL &&
- vars->MR_slvs_names[i] != NULL)
- {
- name = vars->MR_slvs_names[i];
- } else {
- name = "";
- }
+
+ name = MR_name_if_present(vars, i);
var = &vars->MR_slvs_pairs[i];
- if (!MR_trace_get_type_and_value(var, &type_info, &value)) {
+
+ /*
+ ** XXX The printing of type_infos is buggy at the moment
+ ** due to the fake arity of mercury_builtin:typeinfo/1.
+ **
+ ** "variables" representing the saved values of succip, hp etc,
+ ** which are the "variables" for which get_type_and_value
+ ** fails, are not of interest to the trace analyzer.
+ */
+
+ if (strncmp(name, "TypeInfo", 8) == 0
+ || !MR_trace_get_type_and_value(var, NULL, &type_info, &value))
+ {
continue;
}
@@ -881,31 +996,34 @@
}
static void
-MR_trace_browse(int var_count, const MR_stack_layout_vars *vars)
+MR_trace_browse(int var_count, const MR_Stack_Layout_Vars *vars)
{
+ Word *type_params;
+ bool succeeded;
int i;
- char *name;
if (var_count == 0) {
printf("mtrace: no live variables\n");
return;
}
- MR_copy_regs_to_saved_regs();
-
- for (i = 0; i < var_count; i++) {
- if (vars->MR_slvs_names != NULL &&
- vars->MR_slvs_names[i] != NULL)
- {
- name = vars->MR_slvs_names[i];
- } else {
- name = NULL;
+ type_params = checked_malloc((vars->MR_slvs_tvar_count + 1)
+ * sizeof(Word));
+ /* type_params should look like a typeinfo; type_params[0] is empty */
+ for (i = 0; i < vars->MR_slvs_tvar_count; i++) {
+ type_params[i+1] = MR_trace_lookup_live_lval(
+ vars->MR_slvs_tvars[i], &succeeded);
+ if (!succeeded) {
+ fatal_error("missing type param in MR_trace_browse");
}
+ }
- MR_trace_browse_var(name, &vars->MR_slvs_pairs[i]);
+ for (i = 0; i < var_count; i++) {
+ MR_trace_browse_var(MR_name_if_present(vars, i),
+ &vars->MR_slvs_pairs[i], type_params);
}
- MR_copy_saved_regs_to_regs();
+ free(type_params);
}
/* if you want to debug this code, you may want to set this var to TRUE */
@@ -991,26 +1109,44 @@
return value;
}
+/* XXX fix this ref to the library */
+extern Word *ML_create_type_info(Word *term_type_info,
+ Word *arg_pseudo_type_info);
+
static bool
-MR_trace_get_type_and_value(const MR_stack_layout_var *var,
- Word *type_info, Word *value)
+MR_trace_get_type_and_value(const MR_Stack_Layout_Var *var,
+ Word *type_params, Word *type_info, Word *value)
{
- bool succeeded;
+ bool succeeded;
+ Word *pseudo_type_info;
+ int i;
- if (MR_LIVE_TYPE_IS_VAR(var->MR_slv_live_type)) {
- *type_info = MR_LIVE_TYPE_GET_VAR_TYPE(var->MR_slv_live_type);
- } else {
+ if (!MR_LIVE_TYPE_IS_VAR(var->MR_slv_live_type)) {
return FALSE;
}
- *value = MR_trace_lookup_live_lval(var->MR_slv_locn, &succeeded);
+
+ pseudo_type_info = MR_LIVE_TYPE_GET_VAR_TYPE(var->MR_slv_live_type);
+ *type_info = (Word) ML_create_type_info(type_params, pseudo_type_info);
+ *value = MR_trace_lookup_live_lval(var->MR_slv_locn,
+ &succeeded);
return succeeded;
}
static void
-MR_trace_browse_var(char *name, const MR_stack_layout_var *var)
+MR_trace_browse_var(const char *name, const MR_Stack_Layout_Var *var,
+ Word *type_params)
{
- Word value, type_info;
- bool print_value;
+ Word value, type_info;
+ bool print_value;
+ int i;
+
+ /*
+ ** XXX The printing of type_infos is buggy at the moment
+ ** due to the fake arity of the type mercury_builtin:typeinfo/1.
+ */
+
+ if (strncmp(name, "TypeInfo", 8) == 0)
+ return;
/* The initial blanks are to visually separate */
/* the variable names from the prompt. */
@@ -1021,7 +1157,14 @@
printf("%10s%-21s\t", "", "anonymous variable");
}
- if (MR_trace_get_type_and_value(var, &type_info, &value)) {
+ /*
+ ** "variables" representing the saved values of succip, hp etc,
+ ** which are the "variables" for which get_type_and_value fails,
+ ** are not of interest to the user.
+ */
+
+ if (MR_trace_get_type_and_value(var, type_params, &type_info, &value))
+ {
printf("\t");
/*
@@ -1030,42 +1173,72 @@
** avoid going through call_engine, but for some unknown
** reason, that seemed to cause the Mercury code in the
** browser to clobber part of the C stack.
+ **
** Probably that was due to a bug which has since been
** fixed, so we should change the code below back again...
+ **
+ ** call_engine expects the transient registers to be
+ ** in fake_reg, others in their normal homes.
+ ** The code below works by placing r1, r2 and all other
+ ** transient registers both in their normal homes and
+ ** and in fake_reg as well.
*/
+
+ MR_trace_enabled = FALSE;
+ for (i = 0; i < MAX_FAKE_REG; i++) {
+ fake_reg[i] = MR_saved_regs[i];
+ }
+ restore_registers();
r1 = type_info;
r2 = value;
+ save_transient_registers(); /* XXX probably redundant now */
call_engine(MR_library_trace_browser);
+ MR_trace_enabled = TRUE;
}
printf("\n");
}
static int
-MR_trace_get_cmd(void)
+MR_trace_skip_spaces(int c)
{
- int cmd;
- int c;
+ while (c != EOF && c != '\n' && isspace(c))
+ c = getchar();
- cmd = getchar(); /* read the trace command */
+ return c;
+}
- /* skip the rest of the line */
- c = cmd;
+static void
+MR_trace_discard_to_eol(int c)
+{
while (c != EOF && c != '\n')
c = getchar();
-
- return cmd;
}
+
static void
MR_trace_help(void)
{
fprintf(stderr, "valid commands are:\n"
- " a: abort the current execution.\n"
- " c: continue to end, not printing the trace.\n"
- " d: continue to end, printing the trace.\n"
- " n: go to the next trace event.\n"
- " s: skip the current call, not printing trace.\n"
- " j: jump to end of current call, printing trace.\n"
- " p: print the variables live at this point.\n");
+ "a, EOF:\t\t"
+ "\tabort the current execution.\n"
+ "c:\t\t"
+ "\tcontinue to end of program, not printing the trace.\n"
+ "C:\t\t"
+ "\tcontinue to end of program, printing the trace.\n"
+ "f:\t\t"
+ "\tfinish this call, not printing the trace.\n"
+ "F:\t\t"
+ "\tfinish this call, printing the trace.\n"
+ "<N> g:\t\t"
+ "\tgo to event #N, not printing the trace.\n"
+ "<N> G:\t\t"
+ "\tgo to event #N, printing the trace.\n"
+ "p:\t\t"
+ "\tprint the variables live at this point.\n"
+ "[<N>] s, [N] CR:"
+ "\tskip N events, not printing the trace.\n"
+ "[<N>] S:\t"
+ "\tskip N events, printing the trace.\n"
+ );
}
Index: runtime/mercury_trace.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace.h,v
retrieving revision 1.6
diff -u -r1.6 mercury_trace.h
--- mercury_trace.h 1998/03/11 22:07:32 1.6
+++ mercury_trace.h 1998/03/20 08:13:07
@@ -8,9 +8,9 @@
** mercury_trace.h - defines the interface between
** the tracing subsystem and compiled code.
**
-** The macros and the function defined in this module are intended to be
-** called only from code generated by the Mercury compiler, and from
-** hand-compiled code in the Mercury runtime or the Mercury standard library.
+** The macros and functions defined in this module are intended to be called
+** only from code generated by the Mercury compiler, and from hand-written
+** code in the Mercury runtime or the Mercury standard library.
*/
#ifndef MERCURY_TRACE_H
@@ -27,6 +27,7 @@
** This enum should exactly match the definition of the `trace_port' type in
** library/debugger_interface.
*/
+
typedef enum {
MR_PORT_CALL,
MR_PORT_EXIT,
@@ -38,11 +39,19 @@
} MR_trace_port;
extern void MR_trace(
- const Word *, /* pointer to stack layout info */
+ const MR_Stack_Layout_Label *, /* layout info for the event */
MR_trace_port,
int, /* call sequence number */
int, /* call depth */
- const char *); /* path to event goal within procedure */
+ const char *, /* path to event goal within procedure */
+ int); /* highest numbered rN register in use */
+
+/*
+** This function will report the number of the last event,
+** if there have been some events, and will do nothing otherwise.
+*/
+
+extern void MR_trace_report(void);
/*
** MR_trace_init() is called from mercury_runtime_init()
@@ -50,7 +59,18 @@
** MR_trace_end() is called from mercury_runtime_terminate()
** when the debuggee programs is exiting.
*/
+
extern void MR_trace_init(void);
extern void MR_trace_end(void);
+
+typedef enum {
+ MR_TRACE_INTERNAL,
+ MR_TRACE_EXTERNAL
+} MR_trace_type;
+
+extern MR_trace_type MR_trace_handler;
+extern bool MR_trace_enabled;
+
+extern int MR_trace_event_number;
#endif /* MERCURY_TRACE_H */
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.8
diff -u -r1.8 mercury_wrapper.c
--- mercury_wrapper.c 1998/03/16 12:23:40 1.8
+++ mercury_wrapper.c 1998/03/18 01:11:31
@@ -443,7 +443,7 @@
unsigned long size;
int c;
- while ((c = getopt(argc, argv, "acC:d:hLlP:pr:s:tT:w:xz:1:2:3:")) != EOF)
+ while ((c = getopt(argc, argv, "acC:d:D:hLlP:pr:s:tT:w:xz:")) != EOF)
{
switch (c)
{
@@ -512,6 +512,21 @@
use_own_timer = FALSE;
break;
+ case 'D':
+ MR_trace_enabled = TRUE;
+
+ if (streq(optarg, "i"))
+ MR_trace_handler = MR_TRACE_INTERNAL;
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+ else if (streq(optarg, "e"))
+ MR_trace_handler = MR_TRACE_EXTERNAL;
+#endif
+
+ else
+ usage();
+
+ break;
+
case 'h':
usage();
break;
@@ -647,24 +662,6 @@
break;
- case '1':
- if (sscanf(optarg, "%d", &r1val) != 1)
- usage();
-
- break;
-
- case '2':
- if (sscanf(optarg, "%d", &r2val) != 1)
- usage();
-
- break;
-
- case '3':
- if (sscanf(optarg, "%d", &r3val) != 1)
- usage();
-
- break;
-
default:
usage();
@@ -698,6 +695,10 @@
"-dm \t\tdebug memory allocation\n"
"-dG \t\tdebug garbage collection\n"
"-dd \t\tdetailed debug\n"
+ "-Di \t\tdebug the program using the internal debugger\n"
+#ifdef MR_USE_EXTERNAL_DEBUGGER
+ "-De \t\tdebug the program using the external debugger\n"
+#endif
"-sh<n> \t\tallocate n kb for the heap\n"
"-sd<n> \t\tallocate n kb for the det stack\n"
"-sn<n> \t\tallocate n kb for the nondet stack\n"
@@ -718,9 +719,7 @@
#endif
"-r<n> \t\trepeat n times\n"
"-w<name> \tcall predicate with given name (default: main/2)\n"
- "-1<x> \t\tinitialize register r1 with value x\n"
- "-2<x> \t\tinitialize register r2 with value x\n"
- "-3<x> \t\tinitialize register r3 with value x\n");
+ );
fflush(stdout);
exit(1);
} /* end usage() */
Index: scripts/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/Mmakefile,v
retrieving revision 1.6
diff -u -r1.6 Mmakefile
--- Mmakefile 1997/11/21 07:11:00 1.6
+++ Mmakefile 1998/03/14 06:07:48
@@ -14,7 +14,7 @@
#-----------------------------------------------------------------------------#
-SCRIPTS = mmake mmc c2init mgnuc ml mprof mprof_merge_runs mint \
+SCRIPTS = mmake mmc mmd c2init mgnuc ml mprof mprof_merge_runs mint \
sicstus_conv mtags vpath_find mercury_update_interface \
mkfifo_using_mknod
NUPROLOG_SCRIPTS = mnc mnl mnp
Index: tests/misc_tests/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/misc_tests/Mmakefile,v
retrieving revision 1.6
diff -u -r1.6 Mmakefile
--- Mmakefile 1998/02/16 17:23:15 1.6
+++ Mmakefile 1998/03/18 00:57:55
@@ -9,41 +9,14 @@
mdemangle_test.out: mdemangle_test.inp
mdemangle < mdemangle_test.inp > mdemangle_test.out 2>&1
-debugger_regs.out: debugger_regs debugger_regs.inp
- ./debugger_regs debugger_regs.m < debugger_regs.inp \
- > debugger_regs.out 2>&1
-
-debugger_test.out: debugger_test debugger_test.inp
- ./debugger_test debugger_test.m < debugger_test.inp \
- > debugger_test.out 2>&1
-
pretty_print_test.out: pretty_print_test.ugly
cp pretty_print_test.ugly pretty_print_test.out
#-----------------------------------------------------------------------------#
-STACK_LAYOUT_PROGS= \
- debugger_regs \
- debugger_test
-
-OTHER_PROGS =
+PROGS =
OTHER_TESTS = mdemangle_test pretty_print_test
-
-MCFLAGS-debugger_regs = --generate-trace
-MCFLAGS-debugger_test = --generate-trace
-
-# Not all grades can be used with stack layouts
-#
-ifeq ($(GRADE),jump)
- PROGS=$(OTHER_PROGS)
-else
- ifeq ($(GRADE),fast)
- PROGS=$(OTHER_PROGS)
- else
- PROGS=$(STACK_LAYOUT_PROGS) $(OTHER_PROGS)
- endif
-endif
#-----------------------------------------------------------------------------#
New File: scripts/mmd
===================================================================
#!/bin/sh
case $# in
0) echo "Usage: mmd <executable> [<arg> ...]"
exit 1;;
esac
MERCURY_OPTIONS="$MERCURY_OPTIONS -Di"
export MERCURY_OPTIONS
exec "$@"
New File: tests/debugger/Mmakefile
===================================================================
#-----------------------------------------------------------------------------#
MMD_WRAPPER = yes
main_target: check
include ../Mmake.common
#-----------------------------------------------------------------------------#
DEBUGGER_PROGS= \
debugger_regs \
interpreter \
queens
MCFLAGS = --generate-trace
# Not all grades can be used with stack layouts
#
ifeq ($(GRADE),jump)
PROGS=
else
ifeq ($(GRADE),fast)
PROGS=
else
PROGS=$(DEBUGGER_PROGS)
endif
endif
#-----------------------------------------------------------------------------#
debugger_regs.out: debugger_regs debugger_regs.inp
mmd ./debugger_regs < debugger_regs.inp > debugger_regs.out 2>&1
interpreter.out: interpreter interpreter.inp
mmd ./interpreter interpreter.m < interpreter.inp \
> interpreter.out 2>&1
queens.out: queens queens.inp
mmd ./queens < queens.inp > queens.out 2>&1
#-----------------------------------------------------------------------------#
DEPS= $(PROGS:%=%.dep)
DEPENDS=$(PROGS:%=%.depend)
OUTS= $(PROGS:%=%.out)
RESS= $(PROGS:%=%.res)
MODS= $(PROGS:%=%.mod)
#-----------------------------------------------------------------------------#
dep: $(DEPS)
depend: $(DEPENDS)
check: $(OUTS) $(RESS)
mods: $(MODS)
all: $(PROGS)
#-----------------------------------------------------------------------------#
New File: tests/debugger/debugger_regs.exp
===================================================================
1: 1 1 CALL DET debugger_regs:main/2-0
mtrace> 2: 2 2 CALL DET debugger_regs:data/41-0
mtrace> 3: 2 2 EXIT DET debugger_regs:data/41-0
mtrace> mtrace> HeadVar__1 [1, 2, 3, 4, 5]
HeadVar__2 a0
HeadVar__3 a1
HeadVar__4 a2
HeadVar__5 a3
HeadVar__6 a4
HeadVar__7 a5
HeadVar__8 a6
HeadVar__9 a7
HeadVar__10 a8
HeadVar__11 a9
HeadVar__12 b0
HeadVar__13 b1
HeadVar__14 b2
HeadVar__15 b3
HeadVar__16 b4
HeadVar__17 b5
HeadVar__18 b6
HeadVar__19 b7
HeadVar__20 b8
HeadVar__21 b9
HeadVar__22 c0
HeadVar__23 c1
HeadVar__24 c2
HeadVar__25 c3
HeadVar__26 c4
HeadVar__27 c5
HeadVar__28 c6
HeadVar__29 c7
HeadVar__30 c8
HeadVar__31 c9
HeadVar__32 d0
HeadVar__33 d1
HeadVar__34 d2
HeadVar__35 d3
HeadVar__36 d4
HeadVar__37 d5
HeadVar__38 d6
HeadVar__39 d7
HeadVar__40 d8
HeadVar__41 d9
a0a1a2a3a4a5a6a7a8a9
b0b1b2b3b4b5b6b7b8b9
c0c1c2c3c4c5c6c7c8c9
d0d1d2d3d4d5d6d7d8d9
New File: tests/debugger/debugger_regs.inp
===================================================================
p
c
New File: tests/debugger/debugger_regs.m
===================================================================
% This program tests whether the tracer works for procedures with
% lots of arguments (beyond NUM_REAL_REGS and MAX_REAL_REGS).
% At the moment, MAX_REAL_REGS is 32, so a procedure with 41 args
% is a full test.
:- module debugger_regs.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module list, int.
main -->
% The purpose of list is to force the tracer to call the Mercury
% code to print a list of integers, when the input script asks
% for the outputs of data to be printed. In the past this was
% sufficed to cause part of the C stack to be overwritten.
% It also tests whether the values of A0 etc that the tracer prints
% are derived from the register contents produced by data,
% or from the register contents left there by the code that
% prints _List.
{ data(_List,
A0, A1, A2, A3, A4, A5, A6, A7, A8, A9,
B0, B1, B2, B3, B4, B5, B6, B7, B8, B9,
C0, C1, C2, C3, C4, C5, C6, C7, C8, C9,
D0, D1, D2, D3, D4, D5, D6, D7, D8, D9) },
io__write_string(A0),
io__write_string(A1),
io__write_string(A2),
io__write_string(A3),
io__write_string(A4),
io__write_string(A5),
io__write_string(A6),
io__write_string(A7),
io__write_string(A8),
io__write_string(A9),
io__write_string("\n"),
io__write_string(B0),
io__write_string(B1),
io__write_string(B2),
io__write_string(B3),
io__write_string(B4),
io__write_string(B5),
io__write_string(B6),
io__write_string(B7),
io__write_string(B8),
io__write_string(B9),
io__write_string("\n"),
io__write_string(C0),
io__write_string(C1),
io__write_string(C2),
io__write_string(C3),
io__write_string(C4),
io__write_string(C5),
io__write_string(C6),
io__write_string(C7),
io__write_string(C8),
io__write_string(C9),
io__write_string("\n"),
io__write_string(D0),
io__write_string(D1),
io__write_string(D2),
io__write_string(D3),
io__write_string(D4),
io__write_string(D5),
io__write_string(D6),
io__write_string(D7),
io__write_string(D8),
io__write_string(D9),
io__write_string("\n").
:- pred data(list(int)::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out,
string::out, string::out, string::out, string::out, string::out) is det.
data([1, 2, 3, 4, 5],
"a0", "a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9",
"b0", "b1", "b2", "b3", "b4", "b5", "b6", "b7", "b8", "b9",
"c0", "c1", "c2", "c3", "c4", "c5", "c6", "c7", "c8", "c9",
"d0", "d1", "d2", "d3", "d4", "d5", "d6", "d7", "d8", "d9").
New File: tests/debugger/interpreter.exp
===================================================================
1: 1 1 CALL DET interpreter:main/2-0
mtrace> valid commands are:
a, EOF: abort the current execution.
c: continue to end of program, not printing the trace.
C: continue to end of program, printing the trace.
f: finish this call, not printing the trace.
F: finish this call, printing the trace.
<N> g: go to event #N, not printing the trace.
<N> G: go to event #N, printing the trace.
p: print the variables live at this point.
[<N>] s, [N] CR: skip N events, not printing the trace.
[<N>] S: skip N events, printing the trace.
mtrace> Pure Prolog Interpreter.
Consulting file `interpreter.m'...
11: 6 5 SWTC DET interpreter:consult_until_eof_2/5-0 s3;
mtrace> mtrace> HeadVar__1 term(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)))
HeadVar__2 []
HeadVar__4 state('<<c_pointer>>')
30: 16 12 CALL DET interpreter:database_assert_clause/4-0
mtrace> mtrace> HeadVar__1 [clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
HeadVar__2 varset(0, empty, empty)
HeadVar__3 functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))
30: 16 12 CALL DET interpreter:database_assert_clause/4-0
31: 16 12 ELSE DET interpreter:database_assert_clause/4-0 e;
32: 16 12 EXIT DET interpreter:database_assert_clause/4-0
mtrace> mtrace> HeadVar__4 [clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22)
)], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
HeadVar__1 [clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("import_module"), [functor(atom("io"), [], context("interpreter.m", 24))], context("interpreter.m", 24))], context("interpreter.m", 24)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("interface"), [], context("interpreter.m", 23))], context("interpreter.m", 23)), functor(atom("true"), [], context("", 0))), clause(varset(0, empty, empty), functor(atom(":-"), [functor(atom("module"), [functor(atom("interpreter"), [], context("interpreter.m", 22))], context("interpreter.m", 22))], context("interpreter.m", 22)), functor(atom("true"), [], context("", 0)))]
HeadVar__2 varset(0, empty, empty)
HeadVar__3 functor(atom(":-"), [functor(atom("pred"), [functor(atom("main"), [functor(atom("io__state"), [], context("interpreter.m", 26)), functor(atom("io__state"), [], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))], context("interpreter.m", 26))
33: 17 12 CALL DET interpreter:consult_until_eof/4-0
mtrace> 677: 17 12 EXIT DET interpreter:consult_until_eof/4-0
mtrace> 678: 15 11 EXIT DET interpreter:consult_until_eof_2/5-0
mtrace> 679: 14 10 EXIT DET interpreter:consult_until_eof/4-0
mtrace> 679: 14 10 EXIT DET interpreter:consult_until_eof/4-0
680: 12 9 EXIT DET interpreter:consult_until_eof_2/5-0
681: 11 8 EXIT DET interpreter:consult_until_eof/4-0
682: 9 7 EXIT DET interpreter:consult_until_eof_2/5-0
683: 8 6 EXIT DET interpreter:consult_until_eof/4-0
684: 6 5 EXIT DET interpreter:consult_until_eof_2/5-0
685: 5 4 EXIT DET interpreter:consult_until_eof/4-0
686: 4 3 EXIT DET interpreter:consult/5-0
687: 259 3 CALL DET interpreter:consult_list/5-0
688: 259 3 SWTC DET interpreter:consult_list/5-0 s2;
689: 259 3 EXIT DET interpreter:consult_list/5-0
690: 3 2 EXIT DET interpreter:consult_list/5-0
691: 260 2 CALL DET interpreter:main_loop/3-0
?- 692: 261 3 CALL DET interpreter:main_loop_2/4-0
693: 261 3 SWTC DET interpreter:main_loop_2/4-0 s1;
694: 261 3 EXIT DET interpreter:main_loop_2/4-0
695: 260 2 EXIT DET interpreter:main_loop/3-0
696: 1 1 EXIT DET interpreter:main/2-0
New File: tests/debugger/interpreter.inp
===================================================================
h
10s
p
30 g
p
F
p
f
C
New File: tests/debugger/interpreter.m
===================================================================
%-----------------------------------------------------------------------------%
% File: interpreter.m.
% Main author: fjh.
% This is an interpreter for definite logic programs
% (i.e. pure Prolog with no negation or if-then-else.)
%
% This is just intended as a demonstration of the use of the
% meta-programming library modules term, varset, and term_io.
% There are many extensions/improvements that could be made;
% they're left as an exercise for the reader.
% For a more efficient version (using backtrackable destructive update),
% see extras/trailed_update/samples/interpreter.m.
% This source file is hereby placed in the public domain. -fjh (the author).
%-----------------------------------------------------------------------------%
:- module interpreter.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module list, string, term, varset, term_io, require, std_util.
main -->
io__write_string("Pure Prolog Interpreter.\n\n"),
io__command_line_arguments(Args),
( { Args = [] } ->
io__stderr_stream(StdErr),
io__write_string(StdErr, "Usage: interpreter filename ...\n"),
io__set_exit_status(1)
;
{ database_init(Database0) },
consult_list(Args, Database0, Database),
main_loop(Database)
).
:- pred main_loop(database, io__state, io__state).
:- mode main_loop(in, di, uo) is det.
main_loop(Database) -->
io__write_string("?- "),
term_io__read_term(ReadTerm),
main_loop_2(ReadTerm, Database).
:- pred main_loop_2(read_term, database, io__state, io__state).
:- mode main_loop_2(in, in, di, uo) is det.
main_loop_2(eof, _Database) --> [].
main_loop_2(error(ErrorMessage, LineNumber), Database) -->
io__write_string("Error reading term at line "),
io__write_int(LineNumber),
io__write_string(" of standard input: "),
io__write_string(ErrorMessage),
io__write_string("\n"),
main_loop(Database).
main_loop_2(term(VarSet0, Goal), Database) -->
%%% It would be a good idea to add some special commands
%%% with side-effects (such as `consult' and `listing');
%%% these could be identified and processed here.
{ solutions(solve(Database, Goal, VarSet0), Solutions) },
write_solutions(Solutions, Goal),
main_loop(Database).
:- pred write_solutions(list(varset), term, io__state, io__state).
:- mode write_solutions(in, in, di, uo) is det.
write_solutions(Solutions, Goal) -->
( { Solutions = [] } ->
io__write_string("No.\n")
;
write_solutions_2(Solutions, Goal),
io__write_string("Yes.\n")
).
:- pred write_solutions_2(list(varset), term, io__state, io__state).
:- mode write_solutions_2(in, in, di, uo) is det.
write_solutions_2([], _) --> [].
write_solutions_2([VarSet | VarSets], Goal) -->
term_io__write_term_nl(VarSet, Goal),
write_solutions_2(VarSets, Goal).
%-----------------------------------------------------------------------------%
:- pred consult_list(list(string), database, database, io__state, io__state).
:- mode consult_list(in, in, out, di, uo) is det.
consult_list([], Database, Database) --> [].
consult_list([File | Files], Database0, Database) -->
consult(File, Database0, Database1),
consult_list(Files, Database1, Database).
:- pred consult(string, database, database, io__state, io__state).
:- mode consult(in, in, out, di, uo) is det.
consult(File, Database0, Database) -->
io__write_string("Consulting file `"),
io__write_string(File),
io__write_string("'...\n"),
io__see(File, Result),
( { Result = ok } ->
consult_until_eof(Database0, Database),
io__seen
;
io__write_string("Error opening file `"),
io__write_string(File),
io__write_string("' for input.\n"),
{ Database = Database0 }
).
:- pred consult_until_eof(database, database, io__state, io__state).
:- mode consult_until_eof(in, out, di, uo) is det.
consult_until_eof(Database0, Database) -->
term_io__read_term(ReadTerm),
consult_until_eof_2(ReadTerm, Database0, Database).
:- pred consult_until_eof_2(read_term, database, database,
io__state, io__state).
:- mode consult_until_eof_2(in, in, out, di, uo) is det.
consult_until_eof_2(eof, Database, Database) --> [].
consult_until_eof_2(error(ErrorMessage, LineNumber), Database0, Database) -->
io__write_string("Error reading term at line "),
io__write_int(LineNumber),
io__write_string(" of standard input: "),
io__write_string(ErrorMessage),
io__write_string("\n"),
consult_until_eof(Database0, Database).
consult_until_eof_2(term(VarSet, Term), Database0, Database) -->
{ database_assert_clause(Database0, VarSet, Term, Database1) },
consult_until_eof(Database1, Database).
%-----------------------------------------------------------------------------%
% Solve takes a database of rules and facts, a goal to be solved,
% and a varset (which includes a supply of fresh vars, a substitution,
% and names for [some subset of] the variables). It updates
% the varset, producing a new substitution and perhaps introducing
% some new vars, and returns the result.
% Goals are stored just as terms.
% (It might be more efficient to parse them
% before storing them in the database. Currently we do
% this parsing work every time we interpret a clause.)
:- pred solve(database, term, varset, varset).
:- mode solve(in, in, in, out) is nondet.
solve(_Database, term__functor(term__atom("true"), [], _)) --> [].
solve(Database, term__functor(term__atom(","), [A, B], _)) -->
solve(Database, A),
solve(Database, B).
solve(Database, term__functor(term__atom(";"), [A, B], _)) -->
solve(Database, A)
;
solve(Database, B).
solve(_Database, term__functor(term__atom("="), [A, B], _)) -->
unify(A, B).
solve(Database, Goal) -->
{ database_lookup_clause(Database, Goal, ClauseVarSet, Head0, Body0) },
rename_apart(ClauseVarSet, [Head0, Body0], [Head, Body]),
unify(Goal, Head),
solve(Database, Body).
%-----------------------------------------------------------------------------%
:- pred rename_apart(varset, list(term), list(term), varset, varset).
:- mode rename_apart(in, in, out, in, out) is det.
rename_apart(NewVarSet, Terms0, Terms, VarSet0, VarSet) :-
varset__merge(VarSet0, NewVarSet, Terms0, VarSet, Terms).
%-----------------------------------------------------------------------------%
% The standard library module `term' contains routines for
% unifying terms based on separate substitutions, but we are
% using the substitutions that are contained in the `varset',
% so we can't use those versions.
:- pred unify(term, term, varset, varset).
:- mode unify(in, in, in, out) is semidet.
unify(term__variable(X), term__variable(Y), VarSet0, VarSet) :-
(
varset__search_var(VarSet0, X, BindingOfX)
->
(
varset__search_var(VarSet0, Y, BindingOfY)
->
% both X and Y already have bindings - just
% unify the terms they are bound to
unify(BindingOfX, BindingOfY, VarSet0, VarSet)
;
% Y is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfX, VarSet0,
SubstBindingOfX),
( SubstBindingOfX = term__variable(Y) ->
VarSet = VarSet0
;
\+ occurs(SubstBindingOfX, Y, VarSet0),
varset__bind_var(VarSet0, Y, SubstBindingOfX,
VarSet)
)
)
;
(
varset__search_var(VarSet0, Y, BindingOfY2)
->
% X is a variable which hasn't been bound yet
apply_rec_substitution(BindingOfY2, VarSet0,
SubstBindingOfY2),
( SubstBindingOfY2 = term__variable(X) ->
VarSet = VarSet0
;
\+ occurs(SubstBindingOfY2, X, VarSet0),
varset__bind_var(VarSet0, X, SubstBindingOfY2,
VarSet)
)
;
% both X and Y are unbound variables -
% bind one to the other
( X = Y ->
VarSet = VarSet0
;
varset__bind_var(VarSet0, X, term__variable(Y),
VarSet)
)
)
).
unify(term__variable(X), term__functor(F, As, C), VarSet0, VarSet) :-
(
varset__search_var(VarSet0, X, BindingOfX)
->
unify(BindingOfX, term__functor(F, As, C), VarSet0,
VarSet)
;
\+ occurs_list(As, X, VarSet0),
varset__bind_var(VarSet0, X, term__functor(F, As, C), VarSet)
).
unify(term__functor(F, As, C), term__variable(X), VarSet0, VarSet) :-
(
varset__search_var(VarSet0, X, BindingOfX)
->
unify(term__functor(F, As, C), BindingOfX, VarSet0,
VarSet)
;
\+ occurs_list(As, X, VarSet0),
varset__bind_var(VarSet0, X, term__functor(F, As, C), VarSet)
).
unify(term__functor(F, AsX, _), term__functor(F, AsY, _)) -->
unify_list(AsX, AsY).
:- pred unify_list(list(term), list(term), varset, varset).
:- mode unify_list(in, in, in, out) is semidet.
unify_list([], []) --> [].
unify_list([X | Xs], [Y | Ys]) -->
unify(X, Y),
unify_list(Xs, Ys).
%-----------------------------------------------------------------------------%
% occurs(Term, Var, Subst) succeeds if Term contains Var,
% perhaps indirectly via the substitution. (The variable must
% not be mapped by the substitution.)
:- pred occurs(term, var, varset).
:- mode occurs(in, in, in) is semidet.
occurs(term__variable(X), Y, VarSet) :-
X = Y
;
varset__search_var(VarSet, X, BindingOfX),
occurs(BindingOfX, Y, VarSet).
occurs(term__functor(_F, As, _), Y, VarSet) :-
occurs_list(As, Y, VarSet).
:- pred occurs_list(list(term), var, varset).
:- mode occurs_list(in, in, in) is semidet.
occurs_list([Term | Terms], Y, VarSet) :-
occurs(Term, Y, VarSet)
;
occurs_list(Terms, Y, VarSet).
%-----------------------------------------------------------------------------%
% apply_rec_substitution(Term0, VarSet, Term) :
% recursively apply substitution to Term0 until
% no more substitions can be applied, and then
% return the result in Term.
:- pred apply_rec_substitution(term, varset, term).
:- mode apply_rec_substitution(in, in, out) is det.
apply_rec_substitution(term__variable(Var), VarSet, Term) :-
(
varset__search_var(VarSet, Var, Replacement)
->
% recursively apply the substition to the replacement
apply_rec_substitution(Replacement, VarSet, Term)
;
Term = term__variable(Var)
).
apply_rec_substitution(term__functor(Name, Args0, Context), VarSet,
term__functor(Name, Args, Context)) :-
apply_rec_substitution_to_list(Args0, VarSet, Args).
:- pred apply_rec_substitution_to_list(list(term), varset, list(term)).
:- mode apply_rec_substitution_to_list(in, in, out) is det.
apply_rec_substitution_to_list([], _VarSet, []).
apply_rec_substitution_to_list([Term0 | Terms0], VarSet,
[Term | Terms]) :-
apply_rec_substitution(Term0, VarSet, Term),
apply_rec_substitution_to_list(Terms0, VarSet, Terms).
%-----------------------------------------------------------------------------%
% We store the database just as a list of clauses.
% (It would be more realistic to index this on the predicate name/arity
% and subindex on the name/arity of the first argument.)
:- type database == list(clause).
:- type clause ---> clause(varset, term, term).
:- pred database_init(database).
:- mode database_init(out) is det.
database_init([]).
:- pred database_assert_clause(database, varset, term, database).
:- mode database_assert_clause(in, in, in, out) is det.
database_assert_clause(Database, VarSet, Term, [Clause | Database]) :-
( Term = term__functor(term__atom(":-"), [H, B], _) ->
Head = H,
Body = B
;
Head = Term,
term__context_init(Context),
Body = term__functor(term__atom("true"), [], Context)
),
Clause = clause(VarSet, Head, Body).
:- pred database_lookup_clause(database, term, varset, term, term).
:- mode database_lookup_clause(in, in, out, out, out) is nondet.
database_lookup_clause(Database, _Goal, VarSet, Head, Body) :-
list__member(Clause, Database),
Clause = clause(VarSet, Head, Body).
%-----------------------------------------------------------------------------%
New File: tests/debugger/queens.exp
===================================================================
1: 1 1 CALL CCMUL queens:main/2-0
mtrace> mtrace> HeadVar__1 state('<<c_pointer>>')
2: 2 2 CALL DET queens:data/1-0
mtrace> mtrace> mtrace: no live variables
3: 2 2 EXIT DET queens:data/1-0
mtrace> mtrace> HeadVar__1 [1, 2, 3, 4, 5]
4: 3 2 CALL NON queens:queen/2-0
mtrace> mtrace> HeadVar__1 [1, 2, 3, 4, 5]
5: 4 3 CALL NON queens:qperm/2-0
mtrace> mtrace> HeadVar__1 [1, 2, 3, 4, 5]
6: 4 3 SWTC NON queens:qperm/2-0 s1;
mtrace> mtrace> HeadVar__1 [1, 2, 3, 4, 5]
7: 5 4 CALL NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__2 [1, 2, 3, 4, 5]
8: 5 4 DISJ NON queens:qdelete/3-0 c2;d1;
mtrace> mtrace> HeadVar__2 [1, 2, 3, 4, 5]
V_11 1
V_10 [2, 3, 4, 5]
9: 5 4 EXIT NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__1 1
HeadVar__3 [2, 3, 4, 5]
HeadVar__2 [1, 2, 3, 4, 5]
10: 6 4 CALL NON queens:qperm/2-0
mtrace> mtrace> HeadVar__1 [2, 3, 4, 5]
11: 6 4 SWTC NON queens:qperm/2-0 s1;
mtrace> mtrace> HeadVar__1 [2, 3, 4, 5]
12: 7 5 CALL NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__2 [2, 3, 4, 5]
13: 7 5 DISJ NON queens:qdelete/3-0 c2;d1;
mtrace> mtrace> HeadVar__2 [2, 3, 4, 5]
V_11 2
V_10 [3, 4, 5]
14: 7 5 EXIT NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__1 2
HeadVar__3 [3, 4, 5]
HeadVar__2 [2, 3, 4, 5]
15: 8 5 CALL NON queens:qperm/2-0
mtrace> mtrace> HeadVar__1 [3, 4, 5]
16: 8 5 SWTC NON queens:qperm/2-0 s1;
mtrace> mtrace> HeadVar__1 [3, 4, 5]
17: 9 6 CALL NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__2 [3, 4, 5]
18: 9 6 DISJ NON queens:qdelete/3-0 c2;d1;
mtrace> mtrace> HeadVar__2 [3, 4, 5]
V_11 3
V_10 [4, 5]
19: 9 6 EXIT NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__1 3
HeadVar__3 [4, 5]
HeadVar__2 [3, 4, 5]
20: 10 6 CALL NON queens:qperm/2-0
mtrace> mtrace> HeadVar__1 [4, 5]
21: 10 6 SWTC NON queens:qperm/2-0 s1;
mtrace> mtrace> HeadVar__1 [4, 5]
22: 11 7 CALL NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__2 [4, 5]
23: 11 7 DISJ NON queens:qdelete/3-0 c2;d1;
mtrace> mtrace> HeadVar__2 [4, 5]
V_11 4
V_10 [5]
24: 11 7 EXIT NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__1 4
HeadVar__3 [5]
HeadVar__2 [4, 5]
25: 12 7 CALL NON queens:qperm/2-0
mtrace> mtrace> HeadVar__1 [5]
26: 12 7 SWTC NON queens:qperm/2-0 s1;
mtrace> mtrace> HeadVar__1 [5]
27: 13 8 CALL NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__2 [5]
28: 13 8 DISJ NON queens:qdelete/3-0 c2;d1;
mtrace> mtrace> HeadVar__2 [5]
V_11 5
V_10 []
29: 13 8 EXIT NON queens:qdelete/3-0
mtrace> mtrace> HeadVar__1 5
HeadVar__3 []
HeadVar__2 [5]
30: 14 8 CALL NON queens:qperm/2-0
mtrace> mtrace> HeadVar__1 []
31: 14 8 SWTC NON queens:qperm/2-0 s2;
mtrace> mtrace> 32: 14 8 EXIT NON queens:qperm/2-0
mtrace> mtrace> HeadVar__2 []
HeadVar__1 []
33: 12 7 EXIT NON queens:qperm/2-0
mtrace> mtrace> HeadVar__2 [5]
HeadVar__1 [5]
34: 10 6 EXIT NON queens:qperm/2-0
mtrace> mtrace> HeadVar__2 [4, 5]
HeadVar__1 [4, 5]
35: 8 5 EXIT NON queens:qperm/2-0
mtrace> mtrace> HeadVar__2 [3, 4, 5]
HeadVar__1 [3, 4, 5]
36: 6 4 EXIT NON queens:qperm/2-0
mtrace> mtrace> HeadVar__2 [2, 3, 4, 5]
HeadVar__1 [2, 3, 4, 5]
37: 4 3 EXIT NON queens:qperm/2-0
mtrace> mtrace> HeadVar__2 [1, 2, 3, 4, 5]
HeadVar__1 [1, 2, 3, 4, 5]
38: 15 3 CALL SEMI queens:safe/1-0
mtrace> mtrace> HeadVar__1 [1, 2, 3, 4, 5]
39: 15 3 SWTC SEMI queens:safe/1-0 s1;
mtrace> mtrace> HeadVar__1 [1, 2, 3, 4, 5]
40: 16 4 CALL SEMI queens:nodiag/3-0
mtrace> mtrace> HeadVar__1 1
HeadVar__2 1
HeadVar__3 [2, 3, 4, 5]
41: 16 4 SWTC SEMI queens:nodiag/3-0 s1;
mtrace> mtrace> HeadVar__1 1
HeadVar__2 1
HeadVar__3 [2, 3, 4, 5]
[1, 3, 5, 2, 4]
New File: tests/debugger/queens.inp
===================================================================
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
p
c
New File: tests/debugger/queens.m
===================================================================
:- module queens.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is cc_multi.
:- implementation.
:- import_module list, int.
main -->
( { data(Data), queen(Data, Out) } ->
print_list(Out)
;
io__write_string("No solution\n")
).
:- pred data(list(int)).
:- mode data(out) is det.
:- pred queen(list(int), list(int)).
:- mode queen(in, out) is nondet.
:- pred qperm(list(T), list(T)).
:- mode qperm(in, out) is nondet.
:- pred qdelete(T, list(T), list(T)).
:- mode qdelete(out, in, out) is nondet.
:- pred safe(list(int)).
:- mode safe(in) is semidet.
:- pred nodiag(int, int, list(int)).
:- mode nodiag(in, in, in) is semidet.
data([1,2,3,4,5]).
queen(Data, Out) :-
qperm(Data, Out),
safe(Out).
qperm([], []).
qperm([X|Y], K) :-
qdelete(U, [X|Y], Z),
K = [U|V],
qperm(Z, V).
qdelete(A, [A|L], L).
qdelete(X, [A|Z], [A|R]) :-
qdelete(X, Z, R).
safe([]).
safe([N|L]) :-
nodiag(N, 1, L),
safe(L).
nodiag(_, _, []).
nodiag(B, D, [N|L]) :-
NmB is N - B,
BmN is B - N,
( D = NmB ->
fail
; D = BmN ->
fail
;
true
),
D1 is D + 1,
nodiag(B, D1, L).
:- pred print_list(list(int), io__state, io__state).
:- mode print_list(in, di, uo) is det.
print_list(Xs) -->
(
{ Xs = [] }
->
io__write_string("[]\n")
;
io__write_string("["),
print_list_2(Xs),
io__write_string("]\n")
).
:- pred print_list_2(list(int), io__state, io__state).
:- mode print_list_2(in, di, uo) is det.
print_list_2([]) --> [].
print_list_2([X|Xs]) -->
io__write_int(X),
(
{ Xs = [] }
->
[]
;
io__write_string(", "),
print_list_2(Xs)
).
New File: tests/debugger/runtests
===================================================================
#!/bin/sh
# Test whether the code generated by the Mercury compiler
# is producing the expected output.
# Return a status of 0 (true) if everything is all right, and 1 otherwise.
. ../handle_options
mmake $jfactor clean > /dev/null 2>&1
mmake $jfactor depend || exit 1
eval mmake -k $jfactor $gradeopt $flagsopt $cflagsopt check
checkstatus=$?
cat *.res > .allres
if test ! -s .allres -a "$checkstatus" = 0
then
echo "the tests in the debugger directory succeeded"
rm -f .allres
exit 0
else
echo "the tests in the debugger directory failed"
echo "the differences are:"
cat .allres
exit 1
fi
More information about the developers
mailing list