ftp.nice.ch/pub/next/unix/developer/pcn.2.0.s.tar.gz#/src/runtime/pdb.c

This is pdb.c in view mode; [Download] [Up]

/*
 * PCN Abstract Machine Emulator
 * Authors:     Steve Tuecke and Ian Foster
 *              Argonne National Laboratory
 *
 * Please see the DISCLAIMER file in the top level directory of the
 * distribution regarding the provisions under which this software
 * is distributed.
 *
 * pdb.c - The code for PDB -- the PCN debugger
 */

#ifdef PDB

#include "pcn.h"

#define not_yet_implemented(str) \
    fprintf(_p_stdout, "%s: Not yet implemented\n", str);


#ifdef PDB_HOST

#define PDB_INPUT_MAX_LENGTH 4096

typedef struct pt_node {
    int token;
    struct pt_node *next;	/* List of all allocated pt_nodes so that */
				/*   they can be freed when parse fails    */
    struct pt_node *ptr1;
    struct pt_node *ptr2;
    int i1;
    int i2;
} pt_node_t;

static char		yyp_parse_inputline[PDB_INPUT_MAX_LENGTH];
static int		yyp_parse_nextchar;
static pt_node_t *	yyp_parse_tree;
static bool_t		yyp_start_new_command;
static pt_node_t *	yyp_first_pt_node;

/* y.tab.c contains the lex/yacc parser for PDB input */
#include "y.tab.c"

typedef struct summary_element_struct {
    int		active;
    int		pending;
    int		varsusp;
    int		globsusp;
    char	*module_name;
    char	*proc_name;
    struct summary_element_struct *	next;
} summary_element_t;
static summary_element_t *summary_list;

static bool_t	in_pdb = FALSE;
static int	next_break_num = 1;


/*
 * Definitions for all of the PDB command execution routines.  They are
 * grouped by command, where the command are in alphabetical order.
 */
static int			execute_command();
static void			free_parse_tree();

static void			execute_assign_var();
static void			assign_integer_var();
static void			assign_boolean_var();

static void			execute_break();
static void			execute_delete();
static void			execute_disable();
static void			execute_enable();
static bool_t			in_integer_list();

static void			execute_debug_or_nodebug();

static void			execute_help();
static void			help_print_show_queue();
static void			help_print_show_process();
static void			help_print_block_spec();

static void			execute_load();

static void			execute_modules();

static void			execute_move_or_switch();
static void			mark_selected_procs();
static proc_record_t *		find_dest_proc();
static void			extract_selected_procs();
static void			insert_selected_procs();

static void			execute_print();
static void			print_var_module();
static void			print_var_procedure();
static void			print_var_args();
static void			print_var_instance();
static void			print_var_reduction();

static void			execute_procedures();

static int			execute_quit();

static void			execute_show();
static bool_t			weed_out_processes();
static bool_t			compare_wildcard();
static void			show_queue();
static void			print_process();
static void			print_process_args();
static cell_t *			find_suspension();
static cell_t *			find_suspension_in_term();
static bool_t			find_undef_in_process();
static bool_t			find_undef_in_term();
static summary_element_t *	alloc_summary_element();
static void			summary_add_process();
static void			summary_print_and_free();
static void			clear_queue_marks();

static void			execute_source();
static int			read_line();

static void			execute_status();
static bool_t			compare_block_spec_list();

static void			execute_vars();

#ifdef FIND_QUEUE_FOR_PROCESS
static int			find_queue_for_process();
#endif
static int			prompt_and_read_line();
static bool_t			parse_inputline();
static void			load_pdbrc();

#define PDB_PROMPT "PDB> "
#define PDB_CONTINUE_QUERY_PROMPT "\nPress 'q' to quit, or <return> to continue in PDB: "
#define PDB_BREAK_QUERY_PROMPT "\nPress 'q' to quit, or <return> to break into PDB: "
#define PDB_ABORT_QUERY_PROMPT "Abort from PCN? (y or n): "
#define PDB_QUIT_QUERY_PROMPT "Quit from this PDB session? (y or n): "
#define PDB_DELETE_ALL_BREAKPOINTS_PROMPT "Delete all breakpoints? (y or n): "
#define PDB_Y_OR_N_ERROR "Please answer y or n.\n"
#define PDB_Q_OR_RETURN_ERROR "Please answer q or <return>.\n"

#define PDB_FIND_SUSP_RECURSE_DEPTH 10
#define PDB_FIND_UNDEF_RECURSE_DEPTH 10

#define ABS(Num) ((Num) >= 0 ? (Num) : -(Num))


/*
 * execute_command()
 *
 * Execute the command that is represented by the passed parse tree.
 *
 * Return	0 : tells calling routine to continue in PDB command loop
 *		1 : tells calling routine to break out of PDB command loop
 *		2 : tells calling routine to break out of PDB command loop,
 *			after printing a feedback message to the user
 */
static int execute_command(parse_tree)
pt_node_t *parse_tree;
{
    char buf[16];
    char *s;
    int rc = 0;
    int rc1;
    
    switch (parse_tree->token)
    {
    case PDBT_COMMAND_BRANCH:
	rc = execute_command((pt_node_t *) parse_tree->ptr1);
	if ((rc1 = execute_command((pt_node_t *) parse_tree->ptr2))!=0)
	    rc = rc1;
	break;

    case PDBT_ABORT:
	while (1)
	{
	    rc1 = prompt_and_read_line(PDB_ABORT_QUERY_PROMPT, buf, 16);
	    if (strcmp(buf, "y") == 0)
	    {
		_p_fatal_error("Aborting from PDB");
		break;
	    }
	    else if (strcmp(buf, "n") == 0)
	    {
		break;
	    }
	    else
	    {
		if (rc1 == -1)
		    fprintf(_p_stdout, "\n");
		fprintf(_p_stdout, PDB_Y_OR_N_ERROR);
	    }
	}
	break;

    case PDBT_ASSIGN_VAR:
	execute_assign_var(parse_tree);
	break;
	
    case PDBT_BREAK:
	execute_break(parse_tree);
	break;
	
    case PDBT_DELETE:
	execute_delete(parse_tree);
	break;
	
    case PDBT_DISABLE:
	execute_disable(parse_tree);
	break;
	
    case PDBT_ENABLE:
	execute_enable(parse_tree);
	break;
	
    case PDBT_CONTINUE:
	rc = 2;
	break;

    case PDBT_DEBUG:
	execute_debug_or_nodebug(parse_tree, TRUE);
	break;
	
    case PDBT_HELP:
	execute_help(parse_tree);
	break;

    case PDBT_LOAD:
	s = (char *) parse_tree->ptr1->ptr1;
	execute_load(s);
	break;
	
    case PDBT_MODULES:
	execute_modules();
	break;
	
    case PDBT_MOVE:
	execute_move_or_switch(parse_tree);
	break;
	
    case PDBT_NEXT:
	_pdb_breakout = TRUE;
	rc = 1;
	break;
	
    case PDBT_NODEBUG:
	execute_debug_or_nodebug(parse_tree, FALSE);
	break;
	
    case PDBT_PRINT:
	execute_print((pt_node_t *) parse_tree->ptr1);
	fprintf(_p_stdout, "\n");
	fflush(_p_stdout);
	break;
	
    case PDBT_PROCEDURES:
	execute_procedures(parse_tree);
	break;
	
    case PDBT_QUIT:
	rc = execute_quit();
	break;

    case PDBT_LIST:
    case PDBT_SHOW:
    case PDBT_SUMMARY:
	execute_show(parse_tree);
	break;

    case PDBT_SOURCE:
	s = (char *) parse_tree->ptr1->ptr1;
	if (access(s,4) == -1)
	{
	    fprintf(_p_stdout,
		    "PDB Error: Cannot source \"%s\" -- it does not exist or is not readable\n",
		    s);
	}
	else
	{
	    execute_source(s);
	}
	break;
	
    case PDBT_SWITCH:
	execute_move_or_switch(parse_tree);
	break;
	
    case PDBT_STATUS:
	execute_status(parse_tree);
	break;
	
    case PDBT_VARS:
	execute_vars();
	break;
	
    default:
	fprintf(_p_stdout,
		"PDB Internal Error: execute_command(): Invalid command token\n");
	break;
    }
    
    return (rc);
} /* execute_command() */


/*
 * free_parse_tree()
 *
 * Free the passed parse tree.
 */
static void free_parse_tree(parse_tree)
pt_node_t *parse_tree;
{
    if (   parse_tree->token == PDBT_DOUBLE
	|| parse_tree->token == PDBT_STRING
	|| parse_tree->token == PDBT_VARIABLE
	|| parse_tree->token == PDBT_WILDCARD
	|| parse_tree->token == PDBT_WILDCARD_WRAP
	|| parse_tree->token == PDBT_TOKEN    )
    {
	free(parse_tree->ptr1);
    }
    else
    {
	if (parse_tree->ptr1 != (pt_node_t *) NULL)
	    free_parse_tree(parse_tree->ptr1);
	if (parse_tree->ptr2 != (pt_node_t *) NULL)
	    free_parse_tree(parse_tree->ptr2);
    }
    free (parse_tree);
} /* free_parse_tree() */


/*************************************************************************
 *
 * execute_assign_var()
 *
 * Execute the assign variable command, based on the info in the
 * passed parse tree.
 *
 * parse_tree->ptr1 contains a pointer to the pt_node with the variable.
 * parse_tree->ptr2 contains a pointer to the pt_node with the value.
 */
static void execute_assign_var(parse_tree)
pt_node_t *parse_tree;
{
    pt_node_t *var_node = (pt_node_t *) parse_tree->ptr1;
    pt_node_t *val_node = (pt_node_t *) parse_tree->ptr2;

    switch (var_node->i1)
    {
    case PDBT_VAR_PRINT_ARRAY_SIZE:
    case PDBT_VAR_PRINT_TUPLE_DEPTH:
    case PDBT_VAR_PRINT_TUPLE_WIDTH:
    case PDBT_VAR_GLOBAL_DL:
    case PDBT_VAR_EMULATOR_DL:
    case PDBT_VAR_GC_DL:
    case PDBT_VAR_PARALLEL_DL:
    case PDBT_VAR_REDUCTION_BREAK:
	assign_integer_var((char *) var_node->ptr1, (int *) var_node->ptr2,
			   val_node);
	break;
	
    case PDBT_VAR_EMPTY_QUEUE_BREAK:
    case PDBT_VAR_PRINT_ORPHANED:
	assign_boolean_var((char *) var_node->ptr1, (bool_t *) var_node->ptr2,
			   val_node);
	break;
	
    case PDBT_VAR_UNKNOWN:
	fprintf(_p_stdout, "PDB Error: Unknown variable: $%s\n",
		(char *) var_node->ptr1);
	break;
	
    default:	/* This case covers all read-only variables. */
	fprintf(_p_stdout, "PDB Error: %s is a read-only variable.\n",
		(char *) var_node->ptr1);
	break;
    }
    fflush(_p_stdout);
	
} /* execute_assign_var() */


/*
 * assign_integer_var()
 *
 * Assign the integer held in 'val_node' to 'dest'.  The name of this
 * variable (for error reporting or feedback) is pointed to by 'var_name'.
 *
 * Support routine for: execute_assign_var()
 */
static void assign_integer_var(var_name, dest, val_node)
char *var_name;
int *dest;
pt_node_t *val_node;
{
    if (val_node->token != PDBT_INTEGER || val_node->i1 < 0)
    {
	fprintf(_p_stdout,
		"PDB Error: %s must be set to an integer >= 0\n",
		var_name);
    }
    else
    {
	*dest = val_node->i1;
	fprintf(_p_stdout, "Setting: $%s = %d\n", var_name, *dest);
    }
} /* assign_integer_var() */


/*
 * assign_boolean_var()
 *
 * Assign the boolean value held in 'val_node' to 'dest'.  The name of this
 * variable (for error reporting or feedback) is pointed to by 'var_name'.
 *
 * Support routine for: execute_assign_var()
 */
static void assign_boolean_var(var_name, dest, val_node)
char *var_name;
bool_t *dest;
pt_node_t *val_node;
{
    char *s;
    
    if (val_node->token == PDBT_INTEGER)
    {
	if (val_node->i1 == 0)
	    *dest = FALSE;
	else
	    *dest = TRUE;
    }
    else if (val_node->token == PDBT_STRING || val_node->token == PDBT_TOKEN)
    {
	s = (char *) val_node->ptr1;
	if (   (strcmp(s, "true") == 0)
	    || (strcmp(s, "t") == 0)
	    || (strcmp(s, "yes") == 0)
	    || (strcmp(s, "y") == 0))
	    *dest = TRUE;
	else if (   (strcmp(s, "false") == 0)
		 || (strcmp(s, "f") == 0)
		 || (strcmp(s, "no") == 0)
		 || (strcmp(s, "n") == 0))
	    *dest = FALSE;
	else
	    goto assign_boolean_var_error;
    }
    else
    {
	goto assign_boolean_var_error;
    }
    
    fprintf(_p_stdout, "Setting: $%s = %s\n", var_name,
	    (*dest ? "true" : "false"));
    return;

 assign_boolean_var_error:
    fprintf(_p_stdout,
	    "PDB Error: %s must be set to a boolean value:\n",
	    var_name);
    fprintf(_p_stdout, "           true    (t,yes,y,1)\n");
    fprintf(_p_stdout, "           false   (f,no,n,0)\n");
    return;
    
} /* assign_integer_var() */


/*************************************************************************
 *	Breakpoint handling routines
 */

/*
 * execute_break()
 */
static void execute_break(parse_tree)
pt_node_t *parse_tree;
{
    pt_node_t *block_spec_list = (pt_node_t *) parse_tree->ptr1;
    int i, j;
    proc_header_t *proc_header;
    char *module_name, *proc_name;

    if (block_spec_list == (pt_node_t *) NULL)
    {
	/* List the breakpoints */
	fprintf(_p_stdout, "Breakpoints:\n");
	fprintf(_p_stdout, "  Number  Enabled  Procedure\n");
	fprintf(_p_stdout, "  ------  -------  ---------\n");
	for (j = 1; j < next_break_num; j++)
	{
	    for (i = 0; i <= _p_exported_table_size; i++)
	    {
		for (proc_header = _p_exported_table[i];
		     proc_header != (proc_header_t *) NULL;
		     proc_header = proc_header->next)
		{
		    if (ABS(proc_header->break_num) == j)
		    {
			fprintf(_p_stdout,
				"   %3ld       %1s     %s:%s\n",
				(long) ABS(proc_header->break_num),
				(proc_header->break_num > 0 ? "y" : "n"),
				proc_header->module_name,
				proc_header->proc_name);
		    }
		}
	    }
	}
    }
    else
    {
	bool_t got_block_spec_match = FALSE;
	
	/* Set breakpoints based on a block spec list */
	for (i = 0; i <= _p_exported_table_size; i++)
	{
	    for (proc_header = _p_exported_table[i];
		 proc_header != (proc_header_t *) NULL;
		 proc_header = proc_header->next)
	    {
		module_name = proc_header->module_name;
		proc_name = proc_header->proc_name;
		if (compare_block_spec_list(block_spec_list,
					    module_name, proc_name,
					    FALSE))
		{
		    /* We have a match */
		    got_block_spec_match = TRUE;
		    proc_header->break_num = next_break_num++;
		    proc_header->debug = TRUE;
		    fprintf(_p_stdout, "Breakpoint %ld set at %s:%s\n",
			    (long) proc_header->break_num,
			    module_name, proc_name);
		}
	    }
	}

	if (!got_block_spec_match)
	{
	    fprintf(_p_stdout, "No such procedure(s) exists\n");
	}
    }
} /* execute_break() */


/*
 * execute_delete()
 *
 * Delete the breakpoints specified in the 'parse_tree'.
 *
 * parse_tree->ptr1 is either an integer list, or NULL.  If NULL,
 * then delete all breakpoints after prompting the user.
 */
static void execute_delete(parse_tree)
pt_node_t *parse_tree;
{
    pt_node_t *integer_list = (pt_node_t *) parse_tree->ptr1;
    int i;
    proc_header_t *proc_header;
    char buf[16];
    int rc;

    if (integer_list == (pt_node_t *) NULL)
    {
	/* Delete all breakpoints */
	while (1)
	{
	    rc = prompt_and_read_line(PDB_DELETE_ALL_BREAKPOINTS_PROMPT,
				      buf,16);
	    if (strcmp(buf, "y") == 0)
	    {
		for (i = 0; i <= _p_exported_table_size; i++)
		{
		    for (proc_header = _p_exported_table[i];
			 proc_header != (proc_header_t *) NULL;
			 proc_header = proc_header->next)
		    {
			proc_header->break_num = 0;
		    }
		}
		break;
	    }
	    else if (strcmp(buf, "n") == 0)
	    {
		break;
	    }
	    else
	    {
		if (rc == -1)
		    fprintf(_p_stdout, "\n");
		fprintf(_p_stdout, PDB_Y_OR_N_ERROR);
	    }
	}
    }
    else
    {
	/* Delete listed breakpoints */
	for (i = 0; i <= _p_exported_table_size; i++)
	{
	    for (proc_header = _p_exported_table[i];
		 proc_header != (proc_header_t *) NULL;
		 proc_header = proc_header->next)
	    {
		if (proc_header->break_num != 0
		    && in_integer_list(ABS(proc_header->break_num),
				       integer_list))
		{
		    proc_header->break_num = 0;
		}
	    }
	}
    }
} /* execute_delete() */


/*
 * execute_disable()
 *
 * Disable the breakpoints specified in the 'parse_tree'.
 *
 * parse_tree->ptr1 is either an integer list, or NULL.  If NULL,
 * then disable all breakpoints.
 */
static void execute_disable(parse_tree)
pt_node_t *parse_tree;
{
    pt_node_t *integer_list = (pt_node_t *) parse_tree->ptr1;
    int i;
    proc_header_t *proc_header;

    if (integer_list == (pt_node_t *) NULL)
    {
	/* Disable all breakpoints */
	for (i = 0; i <= _p_exported_table_size; i++)
	{
	    for (proc_header = _p_exported_table[i];
		 proc_header != (proc_header_t *) NULL;
		 proc_header = proc_header->next)
	    {
		if (proc_header->break_num > 0)
		    proc_header->break_num = -(proc_header->break_num);
	    }
	}
    }
    else
    {
	/* Disable listed breakpoints */
	for (i = 0; i <= _p_exported_table_size; i++)
	{
	    for (proc_header = _p_exported_table[i];
		 proc_header != (proc_header_t *) NULL;
		 proc_header = proc_header->next)
	    {
		if (proc_header->break_num > 0
		    && in_integer_list(proc_header->break_num, integer_list))
		{
		    proc_header->break_num = -(proc_header->break_num);
		}
	    }
	}
    }
} /* execute_disable() */


/*
 * execute_enable()
 *
 * Enable the breakpoints specified in the 'parse_tree'.
 *
 * parse_tree->ptr1 is either an integer list, or NULL.  If NULL,
 * then inform user that they must specify breakpoint numbers.
 */
static void execute_enable(parse_tree)
pt_node_t *parse_tree;
{
    pt_node_t *integer_list = (pt_node_t *) parse_tree->ptr1;
    int i;
    proc_header_t *proc_header;

    if (integer_list == (pt_node_t *) NULL)
    {
	fprintf(_p_stdout,
		"Argument required (one or more breakpoint numbers).\n");
    }
    else
    {
	/* Enable listed breakpoints */
	for (i = 0; i <= _p_exported_table_size; i++)
	{
	    for (proc_header = _p_exported_table[i];
		 proc_header != (proc_header_t *) NULL;
		 proc_header = proc_header->next)
	    {
		if (proc_header->break_num < 0
		    && in_integer_list(ABS(proc_header->break_num),
				       integer_list))
		{
		    proc_header->break_num = -(proc_header->break_num);
		}
	    }
	}
    }
} /* execute_enable() */


/*
 * in_integer_list()
 *
 * Search the 'integer_list' parse tree to see if 'test_int' is
 * in the list.
 *
 * Return:	TRUE if 'test_int' is in the 'integer_list'
 *		FALSE otherwise
 */
static bool_t in_integer_list(test_int, integer_list)
int_t test_int;
pt_node_t *integer_list;
{
    if (integer_list == (pt_node_t *) NULL)
	return (FALSE);
    
    if (integer_list->token == PDBT_INTEGER)
    {
	if (integer_list->i1 == test_int)
	{
	    return (TRUE);
	}
	else
	{
	    return (FALSE);
	}
    }
    else if (integer_list->token  == PDBT_INTEGER_LIST)
    {
	if (in_integer_list(test_int, integer_list->ptr1))
	{
	    return (TRUE);
	}
	else if (in_integer_list(test_int, integer_list->ptr2))
	{
	    return (TRUE);
	}
	else
	{
	    return (FALSE);
	}
    }
    else
    {
	fprintf(_p_stdout, "PDB Internal Error: in_integer_list(): Illegal integer list parse tree\n");
	return (FALSE);
    }
} /* in_integer_list() */


/*************************************************************************
 *
 * execute_debug_or_nodebug()
 *
 * Execute the debug command (if which==TRUE) or the nodebug
 * command (if which==FALSE), based on the info in the passed parse tree.
 * Look through the module_list for a module name that matches the
 * token in parse_tree.  If it is found, then mark the debug field in
 * that list element.
 *
 * parse_tree->ptr1 contains a pointer to a general token
 */
static void execute_debug_or_nodebug(parse_tree, which)
pt_node_t *parse_tree;
bool_t which;
{
    pt_node_t *block_spec_list = (pt_node_t *) parse_tree->ptr1;
    int i;
    proc_header_t *proc_header;
    char *module_name, *proc_name;

    for (i = 0; i <= _p_exported_table_size; i++)
    {
	for (proc_header = _p_exported_table[i];
	     proc_header != (proc_header_t *) NULL;
	     proc_header = proc_header->next)
	{
	    module_name = proc_header->module_name;
	    proc_name = proc_header->proc_name;
	    if (compare_block_spec_list(block_spec_list, module_name,
					proc_name, FALSE))
	    {
		/* We have a match */
		proc_header->debug = which;
	    }
	}
    }
} /* execute_debug_or_nodebug() */


/*************************************************************************
 *
 * execute_help()
 *
 * Execute the help command, based on the info in the passed parse tree.
 */
static void execute_help(parse_tree)
pt_node_t *parse_tree;
{
    switch (parse_tree->i1)
    {
    case PDBT_UNKNOWN_HELP:
	fprintf(_p_stdout, "Help is not available on \"%s\" this topic.\n",
		(char *) parse_tree->ptr1->ptr1);
	fprintf(_p_stdout, "Type \"help\" for a list of available topics.\n");
	break;
	
    case PDBT_GENERAL_HELP:
    case PDBT_HELP:
	fprintf(_p_stdout, "Help\n\n");
	fprintf(_p_stdout, "To get help on a particular command type:\n\n");
	fprintf(_p_stdout, "\thelp <command>\n\n");
	fprintf(_p_stdout, "The command for which help is available are:\n\n");
	fprintf(_p_stdout, "\tCommand       Shortest Abbreviation\n");
	fprintf(_p_stdout, "\t-------       ---------------------\n");
	fprintf(_p_stdout, "\t=\n");
	fprintf(_p_stdout, "\tabort          a\n");
	fprintf(_p_stdout, "\tbreak          b\n");
	fprintf(_p_stdout, "\tcontinue       c\n");
	fprintf(_p_stdout, "\tdebug          deb\n");
	fprintf(_p_stdout, "\tdelete         del\n");
	fprintf(_p_stdout, "\tdisable        dis\n");
	fprintf(_p_stdout, "\tenable         e\n");
	fprintf(_p_stdout, "\thelp           h\n");
	fprintf(_p_stdout, "\tlist           l\n");
	fprintf(_p_stdout, "\tload           lo\n");
	fprintf(_p_stdout, "\tmodules        mod\n");
	fprintf(_p_stdout, "\tmove           mov\n");
	fprintf(_p_stdout, "\tnext           n\n");
	fprintf(_p_stdout, "\tnodebug        no\n");
	fprintf(_p_stdout, "\tprint          pri\n");
	fprintf(_p_stdout, "\tprocedures     pro\n");
	fprintf(_p_stdout, "\tquit           q\n");
	fprintf(_p_stdout, "\tshow           s\n");
	fprintf(_p_stdout, "\tsource         so\n");
	fprintf(_p_stdout, "\tstatus         st\n");
	fprintf(_p_stdout, "\tsummary        su\n");
	fprintf(_p_stdout, "\tswitch         sw\n");
	fprintf(_p_stdout, "\tvars           v\n");
	break;
	
    case PDBT_ABORT:
	fprintf(_p_stdout, "Help for command: abort\n\n");
	fprintf(_p_stdout, "Abort from the emulator with a fatal error.\n\n");
	fprintf(_p_stdout, "Syntax: abort\n");
	break;
	
    case PDBT_ASSIGN_VAR:
	fprintf(_p_stdout, "Help for command: = (variable assignment)\n\n");
	fprintf(_p_stdout, "Assign a value to a variable.\n\n");
	fprintf(_p_stdout, "Syntax: <variable> = <value>\n\n");
	fprintf(_p_stdout, "    <variable> : The variable to assign.  All variables start with a $.\n");
	fprintf(_p_stdout, "    <value>    : The value to assign.  It should be an integer, double,\n");
	fprintf(_p_stdout, "                 or string, depending on the variable.\n");
	fprintf(_p_stdout, "\n");
	fprintf(_p_stdout, "The following variables can be assigned integer values:\n");
	fprintf(_p_stdout, "    $print_array_size  ($pas) : Maximum array elements printed by print.\n");
	fprintf(_p_stdout, "    $print_tuple_depth ($ptd) : Maximum depth of tuples printed by print.\n");
	fprintf(_p_stdout, "    $print_tuple_width ($ptw) : Maximum width of tuples printed by print.\n");
	fprintf(_p_stdout, "    $global_dl         ($gdl) : Global debug level.\n");
	fprintf(_p_stdout, "    $emulator_dl       ($edl) : Emulator debug level.\n");
	fprintf(_p_stdout, "    $gc_dl             ($gcdl): Garbage collector debug level.\n");
	fprintf(_p_stdout, "    $parallel_dl       ($pdl) : Parallel debug level.\n");
	fprintf(_p_stdout, "    $reduction_break   ($rb)  : Next reduction at which to break to PDB.\n");
	fprintf(_p_stdout, "\nThe following variables can be assigned boolean values:\n");
	fprintf(_p_stdout, "        They can take the values:\n");
	fprintf(_p_stdout, "            true,  t, yes, y, 1  : for TRUE\n");
	fprintf(_p_stdout, "            false, f, no,  n, 0  : for FALSE\n");
	fprintf(_p_stdout, "    $empty_queue_break ($eqb) : Break to PDB if queues are empty?\n");
	fprintf(_p_stdout, "                                (i.e. There are no schedulable processes.)\n");
	fprintf(_p_stdout, "    $print_orphaned    ($po)  : Print orphaned process warnings\n");
	fprintf(_p_stdout, "                                during garbage collection.\n");
	fprintf(_p_stdout, "                                (i.e. Processes that are suspended on)\n");
	fprintf(_p_stdout, "                                      variables that will never be defined.)\n");
	fprintf(_p_stdout, "\n");
	fprintf(_p_stdout, "Read-only variables (they cannot be assigned a value):\n");
	fprintf(_p_stdout, "    $module            ($m)   : The name of the current module (the first\n");
	fprintf(_p_stdout, "                                process on the active queue)\n");
	fprintf(_p_stdout, "    $procedure         ($p)   : The name of the current procedure (the first\n");
	fprintf(_p_stdout, "                                process on the active queue)\n");
	fprintf(_p_stdout, "    $args              ($a)   : The arguments of the current process.\n");
	fprintf(_p_stdout, "                                This is only defined at the entry to the block\n");
	fprintf(_p_stdout, "    $instance          ($i)   : The instance number of the current process.\n");
	fprintf(_p_stdout, "    $reduction         ($r)   : The reduction during which the current\n");
	fprintf(_p_stdout, "                                process was created.\n");
	fprintf(_p_stdout, "    $current_reduction ($cr)  : The current reduction number.\n");
	break;
	
    case PDBT_BREAK:
	fprintf(_p_stdout, "Help for command: break\n\n");
	fprintf(_p_stdout, "Set a break point on a PCN procedure, or show breakpoint information.\n\n");
	fprintf(_p_stdout, "Syntax: break [<module>:<procedure> ...]\n\n");
	help_print_block_spec();
	fprintf(_p_stdout, "If no <module>:<procedure> arguments are given, then all\n");
	fprintf(_p_stdout, "breakpoints are listed.\n\n");
	fprintf(_p_stdout, "Related commands: delete, enable, disable, status, procedures\n");
	break;
	
    case PDBT_CONTINUE:
	fprintf(_p_stdout, "Help for command: continue\n\n");
	fprintf(_p_stdout, "Continue execution in the emulator.\n\n");
	fprintf(_p_stdout, "Syntax: continue\n\n");
	break;
	
    case PDBT_DEBUG:
	fprintf(_p_stdout, "Help for command: debug\n\n");
	fprintf(_p_stdout, "Enable debugging on a PCN procedure.\n\n");
	fprintf(_p_stdout, "Syntax: debug <module>:<procedure> ...\n\n");
	help_print_block_spec();
	fprintf(_p_stdout, "Related commands: nodebug, procedures\n");
	break;

    case PDBT_NODEBUG:
	fprintf(_p_stdout, "Help for command: nodebug\n\n");
	fprintf(_p_stdout, "Disable debugging on a PCN procedure.\n\n");
	fprintf(_p_stdout, "Syntax: nodebug <module>:<procedure> ...\n\n");
	help_print_block_spec();
	fprintf(_p_stdout, "Related commands: debug, procedures\n");
	break;
	
    case PDBT_DELETE:
	fprintf(_p_stdout, "Help for command: delete\n\n");
	fprintf(_p_stdout, "Delete a break point on a PCN procedure.\n\n");
	fprintf(_p_stdout, "Syntax: delete <breakpoint_number> ...\n\n");
	fprintf(_p_stdout, "The <breakpoint_number> can be found by using the break command.\n");
	fprintf(_p_stdout, "Related commands: break, enable, disable, status, procedures\n");
	break;
	
    case PDBT_DISABLE:
	fprintf(_p_stdout, "Help for command: disable\n\n");
	fprintf(_p_stdout, "Disable a previously enabled break point on a PCN procedure.\n\n");
	fprintf(_p_stdout, "Syntax: disable <breakpoint_number> ...\n\n");
	fprintf(_p_stdout, "The <breakpoint_number> can be found by using the break command.\n");
	fprintf(_p_stdout, "Related commands: break, delete, enable, status, procedures\n");
	break;
	
    case PDBT_ENABLE:
	fprintf(_p_stdout, "Help for command: enable\n\n");
	fprintf(_p_stdout, "Enable a previously disabled break point on a PCN procedure.\n\n");
	fprintf(_p_stdout, "Syntax: enable <breakpoint_number> ...\n\n");
	fprintf(_p_stdout, "The <breakpoint_number> can be found by using the break command.\n");
	fprintf(_p_stdout, "Related commands: break, delete, disable, status, procedures\n");
	break;
	
    case PDBT_LIST:
	fprintf(_p_stdout, "Help for command: list\n\n");
	fprintf(_p_stdout, "List information in a short form about processes on the various process queues.\n\n");
	fprintf(_p_stdout, "This is just a stripped down version of the show command.\n");
	fprintf(_p_stdout, "It does not print the arguments to the processes that it lists.\n\n");
	fprintf(_p_stdout, "Syntax: list [<queue>] [<process>]\n\n");
	help_print_show_queue();
	help_print_show_process();
	fprintf(_p_stdout, "\n");
	fprintf(_p_stdout, "Format of listed process:\n");
	fprintf(_p_stdout, "(<index>,#<instance>,^<reduction>,<queue>) <module>:<block>()\n");
	fprintf(_p_stdout, "\n");
	fprintf(_p_stdout, "    <index>     : Unique index into the queue\n");
	fprintf(_p_stdout, "    <instance>  : Unique process instance\n");
	fprintf(_p_stdout, "    <reduction> : Reduction during which this process was created\n");
	fprintf(_p_stdout, "    <queue>     : The queue it is on\n");
	fprintf(_p_stdout, "        A           : Active queue\n");
	fprintf(_p_stdout, "        P           : PDB pending queue\n");
	fprintf(_p_stdout, "        GS          : Global suspension queue\n");
	fprintf(_p_stdout, "        VS          : Suspended on a variable\n");
	fprintf(_p_stdout, "    <module>    : The name of this process' module\n");
	fprintf(_p_stdout, "    <block>     : The block name (procedure name) of this process\n");
	break;
	
    case PDBT_LOAD:
	fprintf(_p_stdout, "Help for command: load\n\n");
	fprintf(_p_stdout, "Load a .pam file into the runtime system.\n\n");
	fprintf(_p_stdout, "Syntax: load <filename>\n\n");
	fprintf(_p_stdout, "    <filename> : The name of the file to load.\n\n");
	fprintf(_p_stdout, "If the file name contains special characters, it might have to be put in\n");
	fprintf(_p_stdout, "double quotes.\n");
	fprintf(_p_stdout, "This command will load the contents of the .pam into the runtime system.\n");
	fprintf(_p_stdout, "If the module(s) defined in this .pam file is already loaded,\n");
	fprintf(_p_stdout, "then this new module from the file will be loaded over the existing one.\n");
	fprintf(_p_stdout, "This command is equivalent to the -load <filename> runtime system\n");
	fprintf(_p_stdout, "command line argument.\n");
	break;
	
    case PDBT_MODULES:
	fprintf(_p_stdout, "Help for command: modules\n\n");
	fprintf(_p_stdout, "List all modules that are loaded into the system.\n\n");
	fprintf(_p_stdout, "Syntax: modules\n\n");
	break;
	
    case PDBT_MOVE:
	fprintf(_p_stdout, "Help for command: move\n\n");
	fprintf(_p_stdout, "Move processes within either the active or pending queue.\n\n");
	fprintf(_p_stdout, "Syntax: move <queue> <process> [<where>]\n\n");
	fprintf(_p_stdout, "    <queue> : The queue within which processes are moved:\n");
	goto CONTINUE_HELP_FOR_MOVE;
    case PDBT_SWITCH:
	fprintf(_p_stdout, "Help for command: switch\n\n");
	fprintf(_p_stdout, "Switch processes between the active and pending queues.\n\n");
	fprintf(_p_stdout, "Syntax: switch <queue> <process> [<where>]\n\n");
	fprintf(_p_stdout, "    <queue> : The queue from which processes are switched:\n");
    CONTINUE_HELP_FOR_MOVE:
	fprintf(_p_stdout, "        active     (a)  : Active queue\n");
	fprintf(_p_stdout, "        pending    (p)  : PDB pending queue\n");
	help_print_show_process();
	fprintf(_p_stdout, "    <where> : An integer representing the destination of the process in\n");
	fprintf(_p_stdout, "              the queue.  Processes are placed immediately before this\n");
	fprintf(_p_stdout, "              position.  The default is to place them at the end of\n");
	fprintf(_p_stdout, "              the queue.\n");
	break;
	
    case PDBT_NEXT:
	fprintf(_p_stdout, "Help for command: move\n\n");
	fprintf(_p_stdout, "Execute the first process on the active queue, and return to PDB\n");
	fprintf(_p_stdout, "after executing this one process.\n\n");
	fprintf(_p_stdout, "Syntax: next\n");
	break;
	
    case PDBT_PRINT:
	fprintf(_p_stdout, "Help for command: print\n\n");
	fprintf(_p_stdout, "Print data to the screen.\n\n");
	fprintf(_p_stdout, "Syntax: print <arg>\n");
	fprintf(_p_stdout, "    or: print (<arg>,<arg>,...,<arg>)\n\n");
	fprintf(_p_stdout, "    <arg> : The thing to print, which is one of:\n");
	fprintf(_p_stdout, "        - an integer constant, such as 42\n");
	fprintf(_p_stdout, "        - a floating point constant, such as 3.2\n");
	fprintf(_p_stdout, "        - a string constant, such as \"a string\"\n");
	fprintf(_p_stdout, "        - a variable, such as $instance\n");
	fprintf(_p_stdout, "\nA newline is automatically printed after all of the arguments are printed.\n");
	break;
	
    case PDBT_PROCEDURES:
	fprintf(_p_stdout, "Help for command: procedures\n\n");
	fprintf(_p_stdout, "Print information about the specified procedures.\n\n");
	fprintf(_p_stdout, "Syntax: procedures [<module>:<procedure> ...]\n\n");
	help_print_block_spec();
	fprintf(_p_stdout, "The fields that are printed are:\n");
	fprintf(_p_stdout, "    Deb            : Is debugging on this procedure enabled?\n");
	fprintf(_p_stdout, "                     (see debug command)\n");
	fprintf(_p_stdout, "    Comp Deb       : Was this procedure compiled with debugging?\n");
	fprintf(_p_stdout, "    Exp            : Is this procedure exported?\n");
	fprintf(_p_stdout, "    Breakpoint Num : The breakpoint number on this procedure.\n");
	fprintf(_p_stdout, "    Breakpoint Ena : Is the breakpoint on this procedure enabled?\n");
	fprintf(_p_stdout, "    Procedure Name : The procedure's name.\n");
	break;
	
    case PDBT_QUIT:
	fprintf(_p_stdout, "Help for command: quit\n\n");
	fprintf(_p_stdout, "Clean up and exit from PDB.\n\n");
	fprintf(_p_stdout, "Syntax: quit\n\n");
	fprintf(_p_stdout, "The clean up that is done is:\n");
	fprintf(_p_stdout, "    Disable debugging on all procedures.\n");
	fprintf(_p_stdout, "    Delete all breakpoints.\n");
	break;
	
    case PDBT_SHOW:
	fprintf(_p_stdout, "Help for command: show\n\n");
	fprintf(_p_stdout, "Show detailed information about processes on the various process queues.\n\n");
	fprintf(_p_stdout, "Syntax: show [<queue>] [<process>]\n\n");
	help_print_show_queue();
	help_print_show_process();
	fprintf(_p_stdout, "\n");
	fprintf(_p_stdout, "Format of shown process:\n");
	fprintf(_p_stdout, "(<index>,#<instance>,^<reduction>,<queue>) <module>:<block>(<args>,...)\n");
	fprintf(_p_stdout, "\n");
	fprintf(_p_stdout, "    <index>     : Unique index into the queue\n");
	fprintf(_p_stdout, "    <instance>  : Unique process instance\n");
	fprintf(_p_stdout, "    <reduction> : Reduction during which this process was created\n");
	fprintf(_p_stdout, "    <queue>     : The queue it is on\n");
	fprintf(_p_stdout, "        A           : Active queue\n");
	fprintf(_p_stdout, "        P           : PDB pending queue\n");
	fprintf(_p_stdout, "        GS          : Global suspension queue\n");
	fprintf(_p_stdout, "        VS-><var>   : Suspended on variable <var>\n");
	fprintf(_p_stdout, "    <module>    : The name of this process' module\n");
	fprintf(_p_stdout, "    <block>     : The block name (procedure name) of this process\n");
	fprintf(_p_stdout, "    <args>      : The process' arguments\n");
	break;
	
    case PDBT_SOURCE:
	fprintf(_p_stdout, "Help for command: source\n\n");
	fprintf(_p_stdout, "Read PDB commands from a file.\n\n");
	fprintf(_p_stdout, "Syntax: source <filename>\n\n");
	fprintf(_p_stdout, "    <filename> : The name of the file to source.\n\n");
	fprintf(_p_stdout, "If the file name contains special characters, it might have to be put in\n");
	fprintf(_p_stdout, "double quotes.\n");
	fprintf(_p_stdout, "When the system is started, PDB will automatically try to source PDB commands\n");
	fprintf(_p_stdout, "from the file ./.pdbrc.  If this file does not exist, then it will try to\n");
	fprintf(_p_stdout, "source from ~/.pdbrc.  These files should contain PDB commands that you always\n");
	fprintf(_p_stdout, "want to have run when PDB is started.\n");
	break;
	
    case PDBT_STATUS:
	fprintf(_p_stdout, "Help for command: status\n\n");
	fprintf(_p_stdout, "Print breakpoint status information about the specified procedures.\n\n");
	fprintf(_p_stdout, "Syntax: status [<module>:<procedure> ...]\n\n");
	help_print_block_spec();
	break;
	
    case PDBT_SUMMARY:
	fprintf(_p_stdout, "Help for command: summary\n\n");
	fprintf(_p_stdout, "Summary of the processes on the various process queues.\n\n");
	fprintf(_p_stdout, "Syntax: summary [<queue>] [<process>]\n\n");
	help_print_show_queue();
	help_print_show_process();
	fprintf(_p_stdout, "\n");
	fprintf(_p_stdout, "Format of shown process:\n");
	fprintf(_p_stdout, "\t<count> (<A>,<P>,<GS>,<VS>)  <module> : <block>\n");
	fprintf(_p_stdout, "\n");
	fprintf(_p_stdout, "    <count>     : Total number of occurences of this block\n");
	fprintf(_p_stdout, "    <A>         : Number of occurences of this block in the active queue\n");
	fprintf(_p_stdout, "    <P>         : Number of occurences of this block in the pending queue\n");
	fprintf(_p_stdout, "    <GS>        : Number of occurences of this block in the globsusp queue\n");
	fprintf(_p_stdout, "    <VS>        : Number of occurences of this block in the varsusp queue\n");
	fprintf(_p_stdout, "    <module>    : The name of this process' module\n");
	fprintf(_p_stdout, "    <block>     : The block name (procedure name) of this process\n");
	break;

    case PDBT_VARS:
	fprintf(_p_stdout, "Help for command: vars\n\n");
	fprintf(_p_stdout, "Show values for all of the PDB variables.\n");
	fprintf(_p_stdout, "For a list of all variables, type \"help =\".\n");
	break;
	
    case PDBT_VARIABLE:
	fprintf(_p_stdout, "Help for variable: $%s\n\n",
		(char *) parse_tree->ptr1->ptr1);
	fprintf(_p_stdout, "Variable specific help not available.  Use \"help =\".\n");
	break;
	
    default:
	fprintf(_p_stdout, "PDB Internal Error: execute_help(): No help for an item there should be help on\n");
	break;
    }
    fprintf(_p_stdout, "\n");
} /* execute_help() */


/*
 * help_print_show_queue()
 *
 * Support routine for: execute_help().
 */
static void help_print_show_queue()
{
    fprintf(_p_stdout, "    <queue> : The queue to show (optional):\n");
    fprintf(_p_stdout, "        active     (a)  : Active queue\n");
    fprintf(_p_stdout, "        pending    (p)  : PDB pending queue\n");
    fprintf(_p_stdout, "        varsusp    (vs) : Variable suspensions\n");
    fprintf(_p_stdout, "        globsusp   (gs) : Global suspension queue\n");
    fprintf(_p_stdout, "        suspension (s)  : All suspensions (varsusp and globsusp)\n");
    fprintf(_p_stdout, "        all             : All queues (the default)\n");
} /* help_print_show_queue() */


/*
 * help_print_show_process()
 *
 * Support routine for: execute_help().
 */
static void help_print_show_process()
{
    fprintf(_p_stdout, "    <process> : Which processes are acted upon (optional):\n");
    fprintf(_p_stdout, "        <n>             : Process with queue index <n>\n");
    fprintf(_p_stdout, "        <m>-<n>         : Process with queue indeces between <m> and <n>\n");
    fprintf(_p_stdout, "        #<n>            : Process with instance number <n>\n");
    fprintf(_p_stdout, "        ^<n>            : Processes created during reduction number <n>\n");
    fprintf(_p_stdout, "        <mod>:<block>   : Processes with module name <mod> and \n");
    fprintf(_p_stdout, "                          block name <block>.  <block> can be full block\n");
    fprintf(_p_stdout, "                          name, or a wildcard (partial name followed by *).\n");
    fprintf(_p_stdout, "        all        (a)  : All processes (the default)\n");
} /* help_print_show_process() */


/*
 * help_print_block_spec()
 *
 * Print help information about a block spec
 */
static void help_print_block_spec()
{
    fprintf(_p_stdout, "Where:\n");
    fprintf(_p_stdout, "    <module>    : The name of the the module.\n");
    fprintf(_p_stdout, "                  This can be a complete name or a wildcard (partial\n");
    fprintf(_p_stdout, "                  module name followed by a *).\n");
    fprintf(_p_stdout, "    <procedure> : The name of the the module.\n");
    fprintf(_p_stdout, "                  This can be a complete name or a wildcard (partial\n");
    fprintf(_p_stdout, "                  procedure name followed by a *).\n");
} /* help_print_block_spec() */


/*************************************************************************
 *
 * execute_load()
 *
 * Load the passed .pam file into the emulator.
 */
static void execute_load(file)
char *file;
{
    char_t *rc;
    if ((rc = _p_load_pam_file(file)) != (char_t *) NULL)
    {
	fprintf(_p_stdout,
		"PDB Error: Cannot load \"%s\": %s\n",
		file, rc);
    }
} /* execute_load() */


/*************************************************************************
 *
 * execute_modules()
 *
 * Execute the modules command.  Print out all the modules loaded in
 * the emulator.
 */
static void execute_modules()
{
    int_t i;
    list_t *module_list, *module, *last_module, *tmp_module;
    int order;
    bool_t found;
    proc_header_t *proc_header;

    module_list = (list_t *) NULL;
    
    for (i = 0; i <= _p_exported_table_size; i++)
    {
	for (proc_header = _p_exported_table[i];
	     proc_header != (proc_header_t *) NULL;
	     proc_header = proc_header->next)
	{
	    found = FALSE;
	    for (module = module_list, last_module = (list_t *) NULL;
		 module != (list_t *) NULL;
		 last_module = module, module = module->next)
	    {
		order = strcmp(proc_header->module_name,
			       (char *) module->value);
		if (order == 0)
		{
		    /* This module name is already on the list */
		    found = TRUE;
		    break;
		}
		else if (order < 0)
		{
		    break;
		}
	    }
	    if (!found)
	    {
		/* Put this module name right after 'last_module' */
		tmp_module = (list_t *) malloc (sizeof(list_t));
		if (tmp_module == (list_t *) NULL)
		    _p_malloc_error();
		tmp_module->value = (void *) proc_header->module_name;
		if (last_module == (list_t *) NULL)
		{
		    /* At front of list */
		    tmp_module->next = module_list;
		    module_list = tmp_module;
		}
		else
		{
		    /* In middle or end of list */
		    tmp_module->next = last_module->next;
		    last_module->next = tmp_module;
		}
	    }
	}
    }
    
    for (module = module_list; module != (list_t *) NULL; )
    {
	fprintf(_p_stdout, "    %s\n", (char *) module->value);
	tmp_module = module->next;
	free(module);
	module = tmp_module;
    }
} /* execute_modules() */


/*************************************************************************
 *
 * execute_move_or_switch()
 *
 * Execute the move or switch command, based on the information in the passed
 * parse tree.  The only difference between these two commands is the
 * destination queue.  The move command uses the same queue as the source
 * and destination, which the switch command uses different queues.
 *
 * The parse tree contains the following info:
 *   parse_tree->i1	: Which queue to move processes from (source) :
 *     PDBT_ACTIVE
 *     PDBT_PENDING
 *   parse_tree->i2	: Where in the new queue to place the processes on
 *			  the destination queue.  A -1 means to put them at
 *			  the end of the other queue.
 *   parse_tree->ptr1	: The parse tree of the process range.  This is
 *			  the same as for the show command (execute_show()).
 */
static void execute_move_or_switch(parse_tree)
pt_node_t *parse_tree;
{
    proc_record_t **sqf, **sqb;	/* Source queue front and back */
    proc_record_t **dqf, **dqb;	/* Destiniation queue front and back */
    proc_record_t *dest_proc;	/* Destination process after which selected
				 * processes are placed */
    proc_record_t *eqf, *eqb;	/* Queue (front and back) for extracted
				 * processes */
    int pi = 1;
    int first_dest_index;
    int marked = 0;

    eqf = eqb = (proc_record_t *) NULL;
    
    /* Set the source queue */
    if (parse_tree->i1 == PDBT_ACTIVE)
    {
	sqf = &_p_active_qf;
	sqb = &_p_active_qb;
    }
    else
    {
	sqf = &_pdb_pending_qf;
	sqb = &_pdb_pending_qb;
    }

    /* Set the destination queue */
    if (parse_tree->token == PDBT_MOVE)
    {
	dqf = sqf;
	dqb = sqb;
    }
    else	/* parse_tree->token == PDBT_SWITCH */
    {
	if (*sqf == _p_active_qf)
	{
	    dqf = &_pdb_pending_qf;
	    dqb = &_pdb_pending_qb;
	}
	else
	{
	    dqf = &_p_active_qf;
	    dqb = &_p_active_qb;
	}
    }

    clear_queue_marks();
    mark_selected_procs(_p_active_qf, parse_tree, &pi, &marked, PDBT_ACTIVE);
    first_dest_index = (*dqf == _p_active_qf ? 1 : pi);
    mark_selected_procs(_pdb_pending_qf, parse_tree, &pi, &marked,
			PDBT_PENDING);
    dest_proc = find_dest_proc(dqf, dqb, first_dest_index, parse_tree->i2);
    extract_selected_procs(&eqf, &eqb, sqf, sqb);
    insert_selected_procs(&eqf, &eqb, dqf, dqb, dest_proc);

    if (parse_tree->token == PDBT_SWITCH)
	fprintf(_p_stdout, "%ld process%s switched from %s queue\n",
		(long) marked,
		(marked == 1 ? "" : "es"),
		(parse_tree->i1 == PDBT_ACTIVE ? "active to pending"
		 : "pending to active"));
    else
	fprintf(_p_stdout, "%ld process%s moved within %s queue\n",
		(long) marked,
		(marked == 1 ? "" : "es"),
		(parse_tree->i1 == PDBT_ACTIVE ? "active"
		 : "pending"));
} /* execute_move_or_switch() */


/*
 * mark_selected_procs()
 *
 * Mark the processes in the passed process queue (proc_queue).  Weed
 * out the processes based on the info in parse_tree (see the
 * execute_show() header for more info on the contents of the parse_tree).
 * 'pq' designates which queue this is.  Maintain 'pi' as an index of
 * ALL the processes in the system (whether they are marked or not), and
 * 'marked' is the number of the processes that are actually marked.
 *
 * Support routine for:	execute_move_or_switch()
 */
static void mark_selected_procs(proc_queue, parse_tree, pi, marked, pq)
proc_record_t *proc_queue;
pt_node_t *parse_tree;
int *pi, *marked;
int pq;
{
    proc_record_t *next_proc;

    for (next_proc = proc_queue;
	 next_proc != (proc_record_t *) NULL;
	 next_proc = next_proc->next, (*pi)++)
    {
	if (weed_out_processes(next_proc, parse_tree, *pi, pq))
	{
	    (*marked)++;
	    next_proc->header.mark = 1;
	}
    }
} /* mark_selected_procs() */


/*
 * find_dest_proc()
 *
 * Find and return the proc_record in the passed queue (dqf,dqb) that:
 *	1) is unmarked
 *	2) has the biggest index < dest_index
 *
 * The first element in this queue has index 'first_dest_index'.
 *
 * If dest_index == -1, then return the last unmarked proc_record
 * in the queue.
 *
 * Return:	pointer to proc_record satisfying above conditions
 *		else, NULL if none can be found
 *
 * Support routine for:	execute_move_or_switch()
 */
static proc_record_t *find_dest_proc(dqf, dqb, first_dest_index, dest_index)
proc_record_t **dqf, **dqb;
int first_dest_index, dest_index;
{
    proc_record_t *next_proc;
    proc_record_t *last_unmarked_proc = (proc_record_t *) NULL;
    int i;

    if (dest_index == -1)
	dest_index = MAX_PROC_QUEUE_SIZE;
    
    for (next_proc = *dqf, i = first_dest_index;
	 next_proc != (proc_record_t *) NULL && i < dest_index;
	 next_proc = next_proc->next, i++)
    {
	if (!(next_proc->header.mark))
	    last_unmarked_proc = next_proc;
    }

    return (last_unmarked_proc);
} /* find_dest_proc() */


/*
 * extract_selected_procs()
 *
 * Go through the source queue (sqf,sqb) and remove move all marked entries
 * to the extract queue (eqf,eqb).
 *
 * Support routine for:	execute_move_or_switch()
 */
static void extract_selected_procs(eqf, eqb, sqf, sqb)
proc_record_t **eqf, **eqb;
proc_record_t **sqf, **sqb;
{
    proc_record_t *next_proc;
    proc_record_t *last_proc = (proc_record_t *) NULL;
    proc_record_t *tmp_proc;

    next_proc = *sqf;
    while (next_proc != (proc_record_t *) NULL)
    {
	if (next_proc->header.mark)
	{
	    /* Dequeue the process from the source queue */
	    tmp_proc = next_proc->next;
	    if (last_proc == (proc_record_t *) NULL) /* at front of queue */
	    {
		*sqf = tmp_proc;
	    }
	    else					/* not at front */
	    {
		last_proc->next = tmp_proc;
	    }
	    
	    /* Enqueue the process onto the end of the extract queue */
	    next_proc->next = (proc_record_t *) NULL;
	    if (*eqf == (proc_record_t *) NULL)	/* empty queue */
	    {
		*eqf = *eqb = next_proc;
	    }
	    else				/* non-empty queue */
	    {
		(*eqb)->next = next_proc;
		*eqb = next_proc;
	    }
	    next_proc = tmp_proc;
	}
	else
	{
	    last_proc = next_proc;
	    next_proc = next_proc->next;
	}
    }

    /* Clean up the tail pointer of the source queue */
    if (*sqf == (proc_record_t *) NULL)
	*sqb = *sqf;
    else
	*sqb = last_proc;
} /* extract_selected_procs() */


/*
 * insert_selected_procs()
 *
 * Insert the extract queue (eqf,eqb) into the destination queue (dqf,dqb)
 * immediately after dest_proc.  If dest_proc == NULL then insert the
 * extract queue at the head of the destination queue.
 *
 * Support routine for:	execute_move_or_switch()
 */
static void insert_selected_procs(eqf, eqb, dqf, dqb, dest_proc)
proc_record_t **eqf, **eqb;
proc_record_t **dqf, **dqb;
proc_record_t *dest_proc;
{
    if (*eqf == (proc_record_t *) NULL)
	return;
    
    if (dest_proc == (proc_record_t *) NULL)	/* insert at head of queue */
    {
	(*eqb)->next = *dqf;
	*dqf = *eqf;
	if (*dqb == (proc_record_t *) NULL)
	    *dqb = *eqb;
    }
    else					/* insert after dest_proc */
    {
	if (*dqf == (proc_record_t *) NULL || *dqb == (proc_record_t *) NULL)
	    fprintf(_p_stdout, "PDB Internal Error: insert_selected_procs(): destination queue front and/or back is NULL\n");

	(*eqb)->next = dest_proc->next;
	dest_proc->next = *eqf;
	if (*dqb == dest_proc)
	    *dqb = *eqb;
    }
} /* insert_selected_procs() */


/*************************************************************************
 *
 * execute_print()
 *
 * Execute the print command, based on the info in the passed parse tree.
 */
static void execute_print(parse_tree)
pt_node_t *parse_tree;
{
    char *next_char;
    char c;
    int i;
    
    switch(parse_tree->token)
    {
    case PDBT_PRINT_EXPR_BRANCH:
	execute_print(parse_tree->ptr1);
	execute_print(parse_tree->ptr2);
	break;

    case PDBT_INTEGER:
	fprintf(_p_stdout, "%d", parse_tree->i1);
	break;
	
    case PDBT_DOUBLE:
	fprintf(_p_stdout, "%.16f", *((double *) (parse_tree->ptr1)));
	break;
	
    case PDBT_STRING:
	next_char = (char *) parse_tree->ptr1;
	while (*next_char != '\0')
	{
	    if (*next_char == '\\')
	    {
		switch (*++next_char)
		{
		case 'n':
		    c = '\n';
		    break;
		case 't':
		    c = '\t';
		    break;
		case 'b':
		    c = '\b';
		    break;
		case 'r':
		    c = '\r';
		    break;
		case 'f':
		    c = '\f';
		    break;
		case '\\':
		    c = '\\';
		    break;
		case '\'':
		    c = '\'';
		    break;
		case '\"':
		    c = '\"';
		    break;
		case 0:
		    break;
		default:
		    if (*next_char >= '0' && *next_char <= '9')
		    {
			c = 0;
			for (i = 3; i > 0; i--)
			{
			    if (*next_char >= '0' && *next_char <= '9')
				c = (c*8) + (*next_char++ - '0');
			    else
				break;
			}
			next_char--;
		    }
		    else
		    {
			fprintf(_p_stdout, "\nError: Invalid string\n");
			fflush(_p_stdout);
			return;
		    }
		    break;
		}
		fprintf(_p_stdout, "%c", c);
		next_char++;
	    }
	    else
		fprintf(_p_stdout, "%c", *next_char++);
	}
	break;
	
    case PDBT_VARIABLE:
	switch (parse_tree->i1)
	{
	case PDBT_VAR_PRINT_ARRAY_SIZE:
	case PDBT_VAR_PRINT_TUPLE_DEPTH:
	case PDBT_VAR_PRINT_TUPLE_WIDTH:
	case PDBT_VAR_GLOBAL_DL:
	case PDBT_VAR_EMULATOR_DL:
	case PDBT_VAR_GC_DL:
	case PDBT_VAR_PARALLEL_DL:
	case PDBT_VAR_REDUCTION_BREAK:
	case PDBT_VAR_CURRENT_REDUCTION:
	    /* Print the integer value */
	    fprintf(_p_stdout, "%d", *((int *) parse_tree->ptr2));
	    break;
	    
	case PDBT_VAR_EMPTY_QUEUE_BREAK:
	case PDBT_VAR_PRINT_ORPHANED:
	    /* Print the boolean value */
	    fprintf(_p_stdout, "%s",
		    (*((int *) parse_tree->ptr2) ? "true" : "false"));
	    break;
	    
	case PDBT_VAR_MODULE:
	    print_var_module();
	    break;
	    
	case PDBT_VAR_PROCEDURE:
	    print_var_procedure();
	    break;
	    
	case PDBT_VAR_ARGS:
	    print_var_args();
	    break;
	    
	case PDBT_VAR_INSTANCE:
	    print_var_instance();
	    break;
	    
	case PDBT_VAR_REDUCTION:
	    print_var_reduction();
	    break;
	    
	case PDBT_VAR_UNKNOWN:
	    fprintf(_p_stdout, "***Unknown Variable=$%s***",
		    ((char *) (parse_tree->ptr1)));
	    break;
	    
	default:
	    fprintf(_p_stdout, "\nPDB Internal Error: execute_print(): Unknown variable token.\n");
	    break;
	}
	break;
	
    default:
	fprintf(_p_stdout, "PDB Internal Error: execute_print(): Invalid token found in parse tree\n");
	break;
    }
    fflush(_p_stdout);
} /* execute_print() */


/*
 * print_var_module()
 *
 * Print the $module variable.
 *
 * Support routine for:	execute_print()
 *			execute_vars()
 */
static void print_var_module()
{
    proc_record_t *proc_record;
    if ((proc_record = _p_active_qf) != (proc_record_t *) NULL)
	fprintf(_p_stdout, "%s", proc_record->proc->module_name);
    else
	fprintf(_p_stdout, "***No Current Process***");
} /* print_var_module() */


/*
 * print_var_procedure()
 *
 * Print the $procedure variable.
 *
 * Support routine for:	execute_print()
 *			execute_vars()
 */
static void print_var_procedure()
{
    proc_record_t *proc_record;
    if ((proc_record = _p_active_qf) != (proc_record_t *) NULL)
	fprintf(_p_stdout, "%s", proc_record->proc->proc_name);
    else
	fprintf(_p_stdout, "***No Current Process***");
} /* print_var_procedure() */


/*
 * print_var_args()
 *
 * Print the $args variable.
 *
 * Support routine for:	execute_print()
 *			execute_vars()
 */
static void print_var_args()
{
    proc_record_t *proc_record;
    if ((proc_record = _p_active_qf) != (proc_record_t *) NULL)
	print_process_args(proc_record);
    else
	fprintf(_p_stdout, "***No Current Process***");
} /* print_var_args() */


/*
 * print_var_instance()
 *
 * Print the $instance variable.
 *
 * Support routine for:	execute_print()
 *			execute_vars()
 */
static void print_var_instance()
{
    proc_record_t *proc_record;
    if ((proc_record = _p_active_qf) != (proc_record_t *) NULL)
	fprintf(_p_stdout, "%lu", (unsigned long) proc_record->instance);
    else
	fprintf(_p_stdout, "***No Current Process***");
} /* print_var_instance() */


/*
 * print_var_reduction()
 *
 * Print the $reduction variable.
 *
 * Support routine for:	execute_print()
 *			execute_vars()
 */
static void print_var_reduction()
{
    proc_record_t *proc_record;
    if ((proc_record = _p_active_qf) != (proc_record_t *) NULL)
	fprintf(_p_stdout, "%lu", (unsigned long) proc_record->reduction);
    else
	fprintf(_p_stdout, "***No Current Process***");
} /* print_var_reduction() */


/*************************************************************************
 *
 * execute_procedures()
 *
 * Execute the procs command, based on the info in the passed parse tree.
 * This command prints out information on all procedures that match
 * the given block specification, or all procedures if there is
 * no block spec given.  The debug field (whether this procedure is
 * currently being debugged or not) is ignored
 *
 * parse_tree->ptr1 contains a pointer to a block spec,
 * or a NULL indicating that all blocks (procedures) should be printed.
 */
static void execute_procedures(parse_tree)
pt_node_t *parse_tree;
{
    char break_num_string[8];
    int break_num;
    pt_node_t *block_spec_list = (pt_node_t *) parse_tree->ptr1;
    int i;
    proc_header_t *proc_header;
    char *module_name, *proc_name;

    fprintf(_p_stdout, "       Comp      Breakpoint\n");
    fprintf(_p_stdout, "  Deb  Deb   Exp  Num  Ena  Procedure Name\n");
    fprintf(_p_stdout, "  ---  ----  ---  ---  ---  --------------\n");
    for (i = 0; i <= _p_exported_table_size; i++)
    {
	for (proc_header = _p_exported_table[i];
	     proc_header != (proc_header_t *) NULL;
	     proc_header = proc_header->next)
	{
	    module_name = proc_header->module_name;
	    proc_name = proc_header->proc_name;
	    if (compare_block_spec_list(block_spec_list,
					module_name, proc_name,
					TRUE))
	    {
		/* We have a match */
		break_num = proc_header->break_num;
		if (break_num != 0)
		    sprintf(break_num_string, "%3ld", (long) ABS(break_num));
		else
		    strcpy(break_num_string, " - ");
		fprintf(_p_stdout,
			"   %1s    %1s     %1s   %3s   %s   %s:%s\n",
			(proc_header->debug ? "y" : "n"),
			(proc_header->debugable ? "y" : "n"),
			(proc_header->exported ? "y" : "n"),
			break_num_string,
			(break_num > 0 ? "y" : (break_num < 0 ? "n" : "-")),
			module_name, proc_name);
	    }
	}
    }
} /* execute_procedures() */


/*************************************************************************
 *
 * execute_quit()
 *
 * Execute the quit command.  Prompt user for verification, and then
 * clean up the emulator in preperation for quitting this debug session.
 *
 * Clean up the following:
 *	- disable debugging on all procedures
 *	- free up all breakpoints
 *
 * Return	0 : user did not quit (answered n to query)
 *		2 : user did quit
 */
static int execute_quit()
{
    char buf[16];
    int i;
    proc_header_t *proc_header;
    int rc;
    
    while (1)
    {
	rc = prompt_and_read_line(PDB_QUIT_QUERY_PROMPT, buf, 16);
	if (strcmp(buf, "y") == 0)
	{
	    for (i = 0; i <= _p_exported_table_size; i++)
	    {
		for (proc_header = _p_exported_table[i];
		     proc_header != (proc_header_t *) NULL;
		     proc_header = proc_header->next)
		{
		    proc_header->debug = FALSE;
		    proc_header->break_num = 0;
		    next_break_num = 1;
		}
	    }
	    return (2);
	}
	else if (strcmp(buf, "n") == 0)
	{
	    return (0);
	}
	else
	{
	    if (rc == -1)
		fprintf(_p_stdout, "\n");
	    fprintf(_p_stdout, PDB_Y_OR_N_ERROR);
	}
    }
} /* execute_quit() */


/*************************************************************************
 *
 * execute_show()
 *
 * Execute the show or summary command, based on the info in the
 * passed parse tree.
 *
 * parse_tree->token contains the command type:
 *	PDBT_SHOW		- Do a show command of all processes
 *	PDBT_SUMMARY		- Print a summary of the processes
 *	PDBT_LIST		- Do a list command of all processes
 *				  (List is just a stripped down show)
 *
 * parse_tree->i1 contains the queue to show/summarize:
 *	PDBT_ALL		- all queues
 *	PDBT_ACTIVE		- active queue
 *	PDBT_PENDING		- PDB pending queue
 *	PDBT_VARSUSP		- variable suspensions
 *	PDBT_GLOBSUSP		- global suspension queue
 *	PDBT_SUSPENSION		- all suspension (variable and global)
 *
 * parse_tree->ptr1 contains the parse tree of the process range
 * to show/summarize.  parse_tree->ptr1->token can be one of:
 *	PDBT_PROCESS_RANGE	- all processes in specified range
 *	PDBT_INSTANCE		- process with specified instance
 *	PDBT_REDUCTION		- processes with specified reduction number
 *	PDBT_BLOCK_SPEC		- a block spec (module:block_or_wildcard)
 *	PDBT_UNDEF		- an undefined variable
 */
static void execute_show(parse_tree)
pt_node_t *parse_tree;
{
    proc_record_t *next_proc;
    int pi = 1;
    int shown = 0;

    clear_queue_marks();
    
    show_queue(_p_active_qf, parse_tree, &pi, &shown, PDBT_ACTIVE);
    show_queue(_pdb_pending_qf, parse_tree, &pi, &shown, PDBT_PENDING);
    show_queue(_p_globsusp_qf, parse_tree, &pi, &shown, PDBT_GLOBSUSP);

    /*
     * Now show the variable suspendion processes.  We know it is a variable
     * suspension if the 'mark' in the proc_record has not be set.
     */
    for (next_proc = _pdb_all_qf;
	 next_proc != (proc_record_t *) NULL;
	 next_proc = next_proc->pdb_next)
    {
	if (!next_proc->header.mark)
	{
	    if (weed_out_processes(next_proc, parse_tree, pi, PDBT_VARSUSP))
	    {
		shown++;
		if (parse_tree->token == PDBT_SUMMARY)
		    summary_add_process(next_proc, PDBT_VARSUSP);
		else
		    print_process(next_proc, pi, PDBT_VARSUSP,
				  parse_tree->token);
	    }
	    pi++;
	}
    }
    
    if (parse_tree->token == PDBT_SUMMARY)
	summary_print_and_free();

    fprintf(_p_stdout, "%d out of %d processes %s\n", shown, pi - 1,
	    (parse_tree->token == PDBT_SUMMARY ? "summarized"
	     : (parse_tree->token == PDBT_SHOW ? "shown" : "listed")) );
} /* execute_show() */


/*
 * weed_out_processes()
 *
 * Given a process 'proc_record', that is on the queue 'pq', use
 * the information in the 'parse_tree' to decide if this
 * process fits description of which processes to show.
 * The contents of 'parse_tree' is described in
 * the header for the execute_show() command.
 *
 * Return:  TRUE if the process has not been weeded out -- that is, it
 *		should be printed
 *	    FALSE otherwise
 *
 * Support routine for: execute_show()
 */ 
static bool_t weed_out_processes(proc_record, parse_tree, pi, pq)
proc_record_t *proc_record;
pt_node_t *parse_tree;
int pi, pq;
{
    pt_node_t *sp_node = parse_tree->ptr1;
    proc_header_t *proc_header = proc_record->proc;

    if (!proc_header->debug)
	return (FALSE);
    
    /*
     * Weed out based on a process range, process instance number,
     * or process reduction number.
     */
    if (   (sp_node->token == PDBT_PROCESS_RANGE
	    && (pi < sp_node->i1 || pi > sp_node->i2))
	|| (sp_node->token == PDBT_INSTANCE
	    && sp_node->i1 != proc_record->instance)
	|| (sp_node->token == PDBT_REDUCTION
	    && sp_node->i1 != proc_record->reduction)
	)
    {
	return (FALSE);
    }
    
    /*
     * Weed out based on module and program names
     */
    if (sp_node->token == PDBT_BLOCK_SPEC)
    {
	/*
	 * Compare the module name with the block spec
	 */
	if (!compare_wildcard(sp_node->ptr1, proc_header->module_name))
	    return (FALSE);
	
	/*
	 * Compare the block name with the block spec
	 */
	if (!compare_wildcard(sp_node->ptr2, proc_header->proc_name))
	    return (FALSE);
    }
    
    /*
     * Weed out based on whether it contains the undef or not
     */
    if (sp_node->token == PDBT_UNDEF)
    {
	if (!find_undef_in_process((cell_t *) sp_node->i1, proc_record))
	    return (FALSE);
    }
    
    if (parse_tree->i1 != PDBT_ALL)
    {
	/* Weed out based on which queue it is on */
	if (   (parse_tree->i1 == PDBT_ACTIVE
		&& pq != PDBT_ACTIVE)
	    || (parse_tree->i1 == PDBT_PENDING
		&& pq != PDBT_PENDING)
	    || (parse_tree->i1 == PDBT_VARSUSP
		&& pq != PDBT_VARSUSP)
	    || (parse_tree->i1 == PDBT_GLOBSUSP
		&& pq != PDBT_GLOBSUSP)
	    || (parse_tree->i1 == PDBT_SUSPENSION
		&& pq != PDBT_VARSUSP && pq != PDBT_GLOBSUSP)
	    )
	{
	    return (FALSE);
	}
    }
    
    return (TRUE);
} /* weed_out_processes() */


/*
 * compare_wildcard()
 *
 * Compare the wildcard held in the parse tree node, 'wildcard_node',
 * to the string in 'item'.
 *
 * If wildcard_node == NULL, then the wildcard is simply a "*".
 *
 * Otherwise, wildcard_node->token can be one of:
 *	PDBT_TOKEN		: "something"
 *	PDBT_WILDCARD		: "something*"
 *	PDBT_WILDCARD_WRAP	: "something*.wrap"
 *
 * Return:	TRUE if the wildcard matches the item
 *		FALSE otherwise
 *
 * Support routine for: weed_out_processes()
 *			compare_block_spec_list()
 */
static bool_t compare_wildcard(wildcard_node, item)
pt_node_t *wildcard_node;
char *item;
{
    bool_t ret_val = FALSE;
    char *wildcard_str, *s;
    
    if (wildcard_node == (pt_node_t *) NULL)
    {
	/* A "*" wildcard */
	ret_val = TRUE;
    }
    else
    {
	wildcard_str = (char *) wildcard_node->ptr1;
	if (wildcard_node->token == PDBT_TOKEN)
	{
	    if (strcmp(wildcard_str, item) == 0)
		ret_val = TRUE;
	}
	else if (wildcard_node->token == PDBT_WILDCARD)
	{
	    if (strncmp(wildcard_str, item, strlen(wildcard_str)) == 0)
		ret_val = TRUE;
	}
	else if (wildcard_node->token == PDBT_WILDCARD_WRAP)
	{
	    if ((s = strrchr(item, '.')) != (char *) NULL)
		if (strcmp(s, ".wrap") == 0)
		    if (strncmp(wildcard_str, item, strlen(wildcard_str)) == 0)
			ret_val = TRUE;
	}
	else
	{
	    fprintf(_p_stdout, "PDB Internal Error: compare_wildcard(): Illegal wildcard token\n");
	}
    }
    return (ret_val);
} /* compare_wildcard() */


/*
 * show_queue()
 *
 * Show the processes in the passed process queue (proc_queue).  Weed
 * out the processes based on the info in parse_tree (see the
 * execute_show() header for more info on the contents of the parse_tree).
 * 'pq' designates which queue this is.  Maintain 'pi' as an index of
 * ALL the processes in the system (whether they are shown or not), and
 * 'shown' is the number of the processes that are actually shown.
 *
 * Support routine for: execute_show()
 */
static void show_queue(proc_queue, parse_tree, pi, shown, pq)
proc_record_t *proc_queue;
pt_node_t *parse_tree;
int *pi, *shown;
int pq;
{
    proc_record_t *next_proc;

    for (next_proc = proc_queue;
	 next_proc != (proc_record_t *) NULL;
	 next_proc = next_proc->next, (*pi)++)
    {
	next_proc->header.mark = 1;
	if (weed_out_processes(next_proc, parse_tree, *pi, pq))
	{
	    (*shown)++;
	    if (parse_tree->token == PDBT_SUMMARY)
		summary_add_process(next_proc, pq);
	    else
		print_process(next_proc, *pi, pq, parse_tree->token);
	}
    }
} /* show_queue() */


/*
 * print_process()
 *
 * Print all relevant information about a process.  The format is:
 *
 * (<index>,#<instance>,^<reduction>,<queue>) <module>:<name>(<args>,...)
 *
 * <index> is the 'pi' argument
 * <queue> is the 'pq' argument
 *
 * If show_or_list == PDBT_LIST, then print a shortened version of the info.
 *
 * Support routine for: execute_show()
 */
static void print_process(proc_record, pi, pq, show_or_list)
proc_record_t *proc_record;
int pi;
int pq;
int show_or_list;
{
    proc_header_t *proc_header;
    char q[4];

    if (proc_record == (proc_record_t *) NULL)
    {
	fprintf(_p_stdout, "PDB Internal Error: print_process(): NULL pointer passed for process\n");
	return;
    }

    proc_header = proc_record->proc;

    if (pq == PDBT_ACTIVE)
	strcpy(q,"A");
    else if (pq == PDBT_PENDING)
	strcpy(q, "P");
    else if (pq == PDBT_VARSUSP)
	strcpy(q, "VS");
    else if (pq == PDBT_GLOBSUSP)
	strcpy(q, "GS");
    else
    {
	fprintf(_p_stdout, "PDB Internal Error: print_process(): Invalid queue designation for following process\n");
	strcpy(q, "  ");
    }
	
    fprintf(_p_stdout, "(%d:#%lu:^%lu:%s", pi,
	    (unsigned long) proc_record->instance,
	    (unsigned long) proc_record->reduction, q);
    fflush(_p_stdout);

    if (show_or_list != PDBT_LIST)
    {
	if (pq == PDBT_VARSUSP)
	{
	    cell_t *susp_var = find_suspension(proc_record);
	    if (susp_var != (cell_t *) NULL)
	    {
		fprintf(_p_stdout, "->");
		_p_print_term(_p_stdout, susp_var);
		fflush(_p_stdout);
	    }
	}
    }
    
    fprintf(_p_stdout, ") %s : %s(",
	    proc_header->module_name, proc_header->proc_name);
    fflush(_p_stdout);

    if (show_or_list != PDBT_LIST)
	print_process_args(proc_record);
    
    fprintf(_p_stdout, ")\n");
    fflush(_p_stdout);
} /* print_process() */


/*
 * print_process_args()
 *
 * Print the arguments of the process 'proc_record'.
 *
 * Support routine for: print_process()
 * 			execute_print()
 */
static void print_process_args(proc_record)
proc_record_t *proc_record;
{
    int arity, i;
    cell_t *arg;

    arity = proc_record->proc->arity;
    arg = (cell_t *) proc_record->args;
    for (i = 0 ; i < arity; i++)
    {
	/*
	 * Once we have a debugging compiler that saves all of the
	 * procedure's argument names into the PCN-O file,
	 * then print the argument name here.
	 */
	_p_print_term(_p_stdout, arg++);
	if (i != arity - 1)
	    fprintf(_p_stdout, ", ");
	fflush(_p_stdout);
    }
    fflush(_p_stdout);
} /* print_process_args() */


/*
 * find_suspension()
 *
 * Given the passed process, find the undefined variable that this
 * process is suspended on.  The variable must be somewhere under the
 * one of the arguments.  So do a depth first search (up to a depth of
 * PDB_FIND_SUSP_RECURSE_DEPTH) of the argument list.  Whenever an
 * undefined variable with suspensions is found, scan that suspension list
 * for the process.
 *
 * Return:	- pointer to the undefined variable if it is found
 *		- otherwise, NULL
 *
 * Support routine for: print_process()
 */
static cell_t *find_suspension(proc_record)
proc_record_t *proc_record;
{
    int arity, i;
    cell_t *arg;
    cell_t *ret;

    if (proc_record == (proc_record_t *) NULL)
    {
	fprintf(_p_stdout, "PDB Internal Error: find_suspension(): NULL pointer passed for process\n");
	return (NULL);
    }

    arity = proc_record->proc->arity;
    arg = (cell_t *) proc_record->args;
    
    for (i = 0 ; i < arity; i++)
    {
	if ((ret = find_suspension_in_term(proc_record, arg++, 0))
	    != (cell_t *) NULL)
	{
	    return (ret);
	}
    }
    
    return ((cell_t *) NULL);
} /* find_suspension() */


/*
 * find_suspension_in_term()
 *
 * Search for 'proc_record' in 'term'.  We are at depth, 'depth', i
 * n a term when this call is made.
 *
 * Return:	- pointer to the undefined variable that 'proc_record' is
 *			suspended on it
 *		- otherwise, NULL
 *
 * Support routine for: find_suspension()
 */
static cell_t *find_suspension_in_term(proc_record, term, depth)
proc_record_t *proc_record;
cell_t *term;
int depth;
{
    data_header_t *dh;
    int i;
    cell_t *ret, *arg;
    proc_record_t *first, *next;

    if (term == (cell_t *) NULL)
    {
	fprintf(_p_stdout, "PDB Internal Error: find_suspension_in_term(): NULL pointer passed for term\n");
	return (NULL);
    }

    Dereference((data_header_t *), term, dh);
    
    switch(dh->tag)
    {
    case TUPLE_TAG:
	if (depth > PDB_FIND_SUSP_RECURSE_DEPTH)
	    break;
	arg = ((cell_t *) dh) + 1;
	for (i = dh->size; i > 0; i--)
	{
	    if ((ret = find_suspension_in_term(proc_record, arg++, depth+1))
		!= (cell_t *) NULL)
	    {
		return ((cell_t *) ret);
	    }
	}
	break;
	
    case UNDEF_TAG:
	if (SuspensionsAt(dh))
	{
	    first  = SuspendedProcs(dh);
	    if (first == proc_record)
		return ((cell_t *) dh);
	    for (next = first->next; next != first; next = next->next)
	    {
		if (next == proc_record)
		    return ((cell_t *) dh);
	    }
	}
	break;
    }
    return ((cell_t *) NULL);
} /* find_suspension_in_term() */


/*
 * find_undef_in_process()
 *
 * Given the passed process record 'proc_record', find the undefined
 * variable 'undef', in its arguments.  Do a depth first
 * search (up to a depth of PDB_FIND_UNDEF_RECURSE_DEPTH) of the
 * argument list.
 *
 * Return:	TRUE if this undef is found in the proc_record
 *		FALSE, otherwise
 *
 * Support routine for: weed_out_process()
 */
static bool_t find_undef_in_process(undef, proc_record)
cell_t *undef;
proc_record_t *proc_record;
{
    int arity, i;
    cell_t *arg;
    
    if (proc_record == (proc_record_t *) NULL)
    {
	fprintf(_p_stdout, "PDB Internal Error: find_undef_in_process(): NULL pointer passed for process\n");
	return (FALSE);
    }

    arity = proc_record->proc->arity;
    arg = (cell_t *) proc_record->args;
    
    for (i = 0 ; i < arity; i++)
    {
	if (find_undef_in_term(undef, arg++, 0))
	    return (TRUE);
    }
    return (FALSE);
} /* find_undef_in_process() */


/*
 * find_undef_in_term()
 *
 * Search for 'undef' in 'term'.  We are at 'depth' when this call is made.
 *
 * Return:	TRUE if this undef is found in the term
 *		FALSE, otherwise
 *
 * Support routine for: find_undef_in_process()
 */
static bool_t find_undef_in_term(undef, term, depth)
cell_t *undef;
cell_t *term;
int depth;
{
    data_header_t *dh;
    int i;
    cell_t *arg;

    if (term == (cell_t *) NULL)
    {
	fprintf(_p_stdout, "PDB Internal Error: find_undef_in_term(): NULL pointer passed for term\n");
	return (FALSE);
    }

    Dereference((data_header_t *), term, dh);
    
    switch(dh->tag)
    {
    case TUPLE_TAG:
	if (depth > PDB_FIND_UNDEF_RECURSE_DEPTH)
	    break;
	arg = ((cell_t *) dh) + 1;
	for (i = dh->size; i > 0; i--)
	{
	    if (find_undef_in_term(undef, arg++, depth+1))
		return (TRUE);
	}
	break;
	
    case UNDEF_TAG:
	if (undef == (cell_t *) dh)
	    return (TRUE);
	break;
    }
    return (FALSE);
} /* find_undef_in_term() */


/*
 * alloc_summary_element()
 *
 * Allocate a summery list element with the given module_name and
 * proc_name.
 *
 * Support routine for: summary_add_process()
 */
static summary_element_t *alloc_summary_element(module_name, proc_name)
char *module_name;
char *proc_name;
{
    summary_element_t *s;

    s = (summary_element_t *) malloc (sizeof(summary_element_t));
    if (s == (summary_element_t *) NULL)
	_p_malloc_error();

    s->active = s->pending = s->varsusp = s->globsusp = 0;
    
    s->module_name = module_name;
    s->proc_name = proc_name;

    return (s);
} /* alloc_summary_element() */


/*
 * summary_add_process()
 *
 * Add this process (proc_record) to the process summary.  Basically,
 * maintain a linked list which contains an entry for each unique
 * <module_name,proc_name> pair that is added to the summary.  If
 * a process is already represented in the list, then just bump up the
 * appropriate counter in that list element.
 *
 * When adding entries, this subroutine maintains the list in sorted
 * order.  The sort is based first on the module_name and then on the
 * procedure name.
 *
 * A counter is mainained in the list elements for each of
 * the queues (active, pending, varsusp, and globsusp).  The
 * 'proc_queue' argument tells which of these queues
 * this process is on.  This subroutine will maintain the list
 * element counters as appropriate.
 */
static void summary_add_process(proc_record, proc_queue)
proc_record_t *proc_record;
int proc_queue;
{
    char *module_name = proc_record->proc->module_name;
    char *proc_name = proc_record->proc->proc_name;
    int order;
    summary_element_t *el, *last_el, *new_el;

    for (last_el = (summary_element_t *) NULL, el = summary_list;
	 el != (summary_element_t *) NULL;
	 last_el = el, el = el->next)
    {
	/* First compare the module name */
	order = strcmp(module_name, el->module_name);
	if (order > 0)
	    continue;
	else if (order < 0)
	    break;
	else /* order == 0 */
	{
	    /* Then compare the procedure name */
	    order = strcmp(proc_name, el->proc_name);
	    if (order > 0)
		continue;
	    else /* order >= 0 */
		break;
	}
    }
    
    if (el == (summary_element_t *) NULL)
    {
	/* We hit the end of the list */
	if (last_el == (summary_element_t *) NULL)
	{
	    /* Actually, its an empty list */
	    new_el = summary_list = alloc_summary_element(module_name,
							  proc_name);
	    summary_list->next = (summary_element_t *) NULL;
	}
	else
	{
	    new_el = alloc_summary_element(module_name, proc_name);
	    new_el->next = (summary_element_t *) NULL;
	    last_el->next = new_el;
	}
    }
    else
    {
	if (order == 0)		/* We found and exact match */
	    new_el = el;
	else /* order < 0 */	/* We've gone past this proc_record's sorted
				 * location, so insert it into the list */
	{
	    if (last_el == (summary_element_t *) NULL)
	    {
		/* Must go at front of list */
		new_el = summary_list = alloc_summary_element(module_name,
							      proc_name);
		summary_list->next = el;
	    }
	    else
	    {
		new_el = alloc_summary_element(module_name, proc_name);
		new_el->next = last_el->next;
		last_el->next = new_el;
	    }
	}
    }

    /* Now bump up the appropriate queue counter */
    if (proc_queue == PDBT_ACTIVE)
	(new_el->active)++;
    else if (proc_queue == PDBT_PENDING)
	(new_el->pending)++;
    else if (proc_queue == PDBT_VARSUSP)
	(new_el->varsusp)++;
    else if (proc_queue == PDBT_GLOBSUSP)
	(new_el->globsusp)++;
    else
	fprintf(_p_stdout, "PDBT Internal Error: summary_add_process(): Invalid process queue argument.\n");
    
} /* summary_add_process() */


/*
 * summary_print_and_free()
 *
 * Print out the summary_list that is built up by summary_add_process().
 */
static void summary_print_and_free()
{
    summary_element_t *el, *next_el;
    int active_sum, pending_sum, globsusp_sum, varsusp_sum;
    
    active_sum = pending_sum = globsusp_sum = varsusp_sum = 0;

    fprintf(_p_stdout, "Summary:\n");
    fprintf(_p_stdout, "  Count (  A,  P, GS, VS)  Procedure_Name\n\n");

    el = summary_list;
    while (el != (summary_element_t *) NULL)
    {
	/* Print out the element */
	fprintf(_p_stdout, "   %4d (%3d,%3d,%3d,%3d)  %s : %s\n",
		(el->active + el->pending + el->globsusp + el->varsusp),
		el->active, el->pending, el->globsusp, el->varsusp,
		el->module_name, el->proc_name);
	fflush(_p_stdout);

	/* Add in counts to sums */
	active_sum   += el->active;
	pending_sum  += el->pending;
	globsusp_sum += el->globsusp;
	varsusp_sum  += el->varsusp;
	
	/* Now free up this element */
	next_el = el->next;
	free(el);
	el = next_el;
    }
    fprintf(_p_stdout, "   ----------------------\n");
    fprintf(_p_stdout, "   %4d (%3d,%3d,%3d,%3d)\n\n",
	    (active_sum + pending_sum + globsusp_sum + varsusp_sum),
	    active_sum, pending_sum, globsusp_sum, varsusp_sum);
    fflush(_p_stdout);
    
    summary_list = (summary_element_t *) NULL;
} /* summary_print_and_free() */


/*
 * clear_queue_marks()
 *
 * Clear (set to 0) the 'mark' structure entry in every process
 * record in the system.
 */
static void clear_queue_marks()
{
    proc_record_t *next_proc;
    
    for (next_proc = _pdb_all_qf;
	 next_proc != (proc_record_t *) NULL;
	 next_proc = next_proc->pdb_next)
    {
	next_proc->header.mark = 0;
    }
}
    

/*************************************************************************
 *
 * execute_source()
 *
 * Execute the PDB commands in the passed file.  This
 * file should be known to be readable (can be checked
 * by using access()) before this procedure is called
 * if you don't want error messages to appear.
 */
static void execute_source(file)
char *file;
{
    pt_node_t *saved_parse_tree = yyp_parse_tree;
    int line_length;
    int line_number = 0;
    int rc;
    FILE *fp;

    if ((fp = fopen(file, "r")) != (FILE *) NULL)
    {
	fprintf(_p_stdout, "Loading: %s\n", file);
	while (1)
	{
	    yyp_parse_inputline[0] = '\0';
	    yyp_parse_nextchar = 0;
	    line_number++;
	    line_length  = read_line(fp, file, line_number,
				     yyp_parse_inputline, 
				     PDB_INPUT_MAX_LENGTH);
	    if (line_length == -1)
		break;
	    else if (line_length == 0)
		continue;
	    
	    if (!parse_inputline())
	    {
		fprintf(_p_stdout,"PDB Error: Line %d in \"%s\" is invalid\n",
			line_number, file);
		break;
	    }
	    else
	    {
		rc = execute_command(yyp_parse_tree);
		free_parse_tree(yyp_parse_tree);
	    }
	}
	fclose(fp);
    }
    else
    {
	fprintf(_p_stdout,
		"PDB Error: Cannot load \"%s\" -- it does not exist or is not readable\n",
		file);
    }
    yyp_parse_tree = saved_parse_tree;
} /* execute_source() */


/*
 * read_line()
 *
 * Read one line of input from the passed file pointer ('fp') and
 * put it in 'buf, with a maximum length of 'buf_length' characters
 * (including the Null termination).
 * Leave the carraige return off of the line that is put in 'buf'.
 * Null terminate the string in buf.
 *
 * 'file' is the file that is currently be read from, and 'line_number'
 * is the current line number in that file.
 *
 * If the line is too long, then report an error and return -1 (EOF).
 *
 * buf_length must be >= 1
 *
 * Return:	Number of characters read (not including Null terminaion),
 *			or -1 on EOF.
 */
static int read_line(fp, file, line_number, buf, buf_length)
FILE *fp;
char *file;
int line_number;
char buf[];
int buf_length;
{
    int len;
    
    if (fgets(buf, buf_length, fp)  == (char *) NULL)
    {
	buf[0] = '\0';
	len = -1;
    }
    else
    {
	len = strlen(buf);
	if (len == buf_length - 1 && buf[len - 1] != '\n')
	{
	    /* Line too long -- report it and return EOF */
	    fprintf(_p_stdout,
		    "PDB Error: Line %d in \"%s\" is to long!  Maximum length = %d characters\n",
		    line_number, file, buf_length - 1);
	    fflush(_p_stdout);
	    buf[0] = '\0';
	    len = -1;
	}
	else
	{
	    if (buf[len - 1] == '\n')	/* Line ending in \n, not EOF */
	    {
		len--;
		buf[len] = '\0';
	    }
	}
    }
    return (len);
} /* read_line() */


/*************************************************************************
 *
 * execute_status()
 *
 * Execute the status command, based on the info in the passed parse tree.
 * This command prints out information on all procedures that match
 * the given block specification, or all procedures if there is
 * no block spec given.  The debug field (whether this procedure is
 * currently being debugged or not) is taken into account -- if the
 * procedure is not being debugged, then it will not show up in the
 * status listing.
 *
 * parse_tree->ptr1 contains a pointer to a block spec,
 * or a NULL indicating that all blocks (procedures) should be printed.
 */
static void execute_status(parse_tree)
pt_node_t *parse_tree;
{
    char break_num_string[8];
    int break_num;
    pt_node_t *block_spec_list = (pt_node_t *) parse_tree->ptr1;
    int i;
    proc_header_t *proc_header;
    char *module_name, *proc_name;

    fprintf(_p_stdout, "    Breakpoint\n");
    fprintf(_p_stdout, "  Number  Enabled  Procedure Name\n");
    fprintf(_p_stdout, "  ------  -------  --------------\n");
    for (i = 0; i <= _p_exported_table_size; i++)
    {
	for (proc_header = _p_exported_table[i];
	     proc_header != (proc_header_t *) NULL;
	     proc_header = proc_header->next)
	{
	    module_name = proc_header->module_name;
	    proc_name = proc_header->proc_name;
	    if (proc_header->debug
		&& compare_block_spec_list(block_spec_list,
					   module_name, proc_name, TRUE))
	    {
		/* We have a match */
		break_num = proc_header->break_num;
		if (break_num != 0)
		    sprintf(break_num_string, "%3d", ABS(break_num));
		else
		    strcpy(break_num_string, "  -");
		fprintf(_p_stdout,
			"   %3s       %s     %s:%s\n",
			break_num_string,
			(break_num > 0 ? "y" : (break_num < 0 ? "n" : "-")),
			module_name, proc_name);
	    }
	}
    }
} /* execute_status() */


/*
 * compare_block_spec_list()
 *
 * Compare 'module_name':'proc_name' against the block spec list
 * in 'block_spec_list'.
 *
 * Return:	'return_on_empty' if 'block_spec_list' is NULL
 *		TRUE if this procedure matches one of the block specs
 *			in the block spec list
 *		FALSE otherwise
 */
static bool_t compare_block_spec_list(block_spec_list, module_name, proc_name,
				     return_on_empty)
pt_node_t *block_spec_list;
char *module_name;
char *proc_name;
bool_t return_on_empty;
{
    if (block_spec_list == (pt_node_t *) NULL)
	return (return_on_empty);
    
    if (block_spec_list->token == PDBT_BLOCK_SPEC)
    {
	if (compare_wildcard(block_spec_list->ptr1, module_name)
	     && compare_wildcard(block_spec_list->ptr2, proc_name))
	{
	    return (TRUE);
	}
	else
	{
	    return (FALSE);
	}
    }
    else if (block_spec_list->token  == PDBT_BLOCK_SPEC_LIST)
    {
	if (compare_block_spec_list(block_spec_list->ptr1,
				    module_name, proc_name, FALSE))
	{
	    return (TRUE);
	}
	else if (compare_block_spec_list(block_spec_list->ptr2,
					 module_name, proc_name, FALSE))
	{
	    return (TRUE);
	}
	else
	{
	    return (FALSE);
	}
    }
    else
    {
	fprintf(_p_stdout, "PDB Internal Error: compare_block_spec_list(): Illegal block spec list parse tree\n");
	return (FALSE);
    }
} /* compare_block_spec_list() */


/*************************************************************************
 *
 * execute_vars()
 *
 * Execute the vars command.  Print out all the PDB variables along
 * with their values.
 */
static void execute_vars()
{
    /* Print the integer valued variables */
    fprintf(_p_stdout, "     $print_array_size = %d\n", _p_print_array_size);
    fprintf(_p_stdout, "    $print_tuple_depth = %d\n", _p_print_tuple_depth);
    fprintf(_p_stdout, "    $print_tuple_width = %d\n", _p_print_tuple_width);
    fprintf(_p_stdout, "            $global_dl = %ld\n", (long) _p_global_dl);
    fprintf(_p_stdout, "          $emulator_dl = %ld\n", (long) _p_em_dl);
    fprintf(_p_stdout, "                $gc_dl = %ld\n", (long) _p_gc_dl);
    fprintf(_p_stdout, "          $parallel_dl = %ld\n", (long) _p_par_dl);
    fprintf(_p_stdout, "      $reduction_break = %lu\n",
	    (unsigned long) _pdb_reduction_break);
    fprintf(_p_stdout, "    $empty_queue_break = %s\n",
	    _pdb_empty_queue_break ? "true" : "false");
    fprintf(_p_stdout, "       $print_orphaned = %s\n",
	    _pdb_print_orphaned ? "true" : "false");
    fprintf(_p_stdout, "               $module = ");
    print_var_module();
    fprintf(_p_stdout, "\n");
    fprintf(_p_stdout, "            $procedure = ");
    print_var_procedure();
    fprintf(_p_stdout, "\n");
    fprintf(_p_stdout, "                 $args\n");
    fprintf(_p_stdout, "             $instance = ");
    print_var_instance();
    fprintf(_p_stdout, "\n");
    fprintf(_p_stdout, "            $reduction = ");
    print_var_reduction();
    fprintf(_p_stdout, "\n");
    fprintf(_p_stdout, "    $current_reduction = %lu\n",
	    (unsigned long) _p_reduction);
	    
    /* Print the boolean valued variables */
}


/*************************************************************************
 *
 * From here on are subroutines that don't directory implement any
 * PDB commands.
 *
 ************************************************************************/


#ifdef FIND_QUEUE_FOR_PROCESS
/*
 * find_queue_for_process()
 *
 * Figure out which queue the passed process is on.  Just scan the various
 * queues until it is found.  If it is not found, then assume it is
 * a variable suspension.
 *
 * Return:	PDBT_ACTIVE	- active queue
 * 		PDBT_PENDING	- PDB pending queue
 * 		PDBT_VARSUSP	- variable suspensions
 * 		PDBT_GLOBSUSP	- global suspension queue
 */
static int find_queue_for_process(proc_record)
proc_record_t *proc_record;
{
    proc_record_t *next_proc;

    for (next_proc = _p_active_qf;
	 next_proc != (proc_record_t *) NULL;
	 next_proc = next_proc->next)
    {
	if (next_proc == proc_record)
	    return (PDBT_ACTIVE);
    }
    
    for (next_proc = _p_globsusp_qf;
	 next_proc != (proc_record_t *) NULL;
	 next_proc = next_proc->next)
    {
	if (next_proc == proc_record)
	    return (PDBT_GLOBSUSP);
    }
    
    for (next_proc = _pdb_pending_qf;
	 next_proc != (proc_record_t *) NULL;
	 next_proc = next_proc->next)
    {
	if (next_proc == proc_record)
	    return (PDBT_PENDING);
    }
    
    return (PDBT_VARSUSP);
} /* find_queue_for_process() */
#endif /* FIND_QUEUE_FOR_PROCESS */


/*
 * _pdb_enter()
 *
 * This is the main PDB entry point, to go into command mode.
 * 'at_breakpoint' is true is this PDB entry is due to a breakpoint.
 */
void _pdb_enter(at_breakpoint)
bool_t at_breakpoint;
{
    static bool_t first_entry = TRUE;
    int line_length;
    int rc = 0;

    _pdb_breakout = FALSE;

    if (!_p_host)
	return;
    
    in_pdb = TRUE;

    if (first_entry)
    {
	/*
	 * Print PDB banner...
	 */
	_p_print_banner();
	first_entry = FALSE;
    }

    if (_p_reduction > 0)
    {
	/*
	 * Print the first process in the active queue if there is one.  This
	 * is the next process that is to be scheduled.
	 */
	fprintf(_p_stdout, "\nReduction %lu:  Breaking to PDB.  ",
		(unsigned long) _p_reduction);
	if (_p_active_qf == NULL)
	{
	    fprintf(_p_stdout, "\n\nActive queue is empty.  No processes ready to be scheduled.\n");
	}
	else
	{
	    if (at_breakpoint)
		fprintf(_p_stdout, "Breakpoint %ld:\n\n",
			(long) _p_active_qf->proc->break_num);
	    else
		fprintf(_p_stdout, "Next process to be scheduled:\n\n");
	    print_process(_p_active_qf, 1, PDBT_ACTIVE, PDBT_SHOW);
	}
	fprintf(_p_stdout, "\n");
    }
    
    while (!rc)
    {
	yyp_parse_inputline[0] = '\0';
	yyp_parse_nextchar = 0;
	line_length  = prompt_and_read_line(PDB_PROMPT, yyp_parse_inputline, 
					    PDB_INPUT_MAX_LENGTH);
	if (line_length == -1)
	{
	    rc = 2;
	    continue;
	}
	else if (line_length == 0)
	{
	    continue;
	}

	if (!parse_inputline())
	{
	    printf("Invalid input\n");
	}
	else
	{
	    rc = execute_command(yyp_parse_tree);
	    free_parse_tree(yyp_parse_tree);
	}
    }
    
    in_pdb = FALSE;
} /* _pdb_enter() */


/*
 * prompt_and_read_line()
 *
 * Prompt the user by printing out 'prompt', and then 
 * read one line of text from the keyboard and put it in 'buf',
 * with a maximum length of 'buf_length' (including the Null
 * termination).  Block until we have an entire line.
 * Leave the carraige return off of the line that is put in 'buf'.
 * Null terminate the string in buf.
 *
 * If a line is entered that is too long (> buf_length) then report
 * an error, print the prompt, and try reading a new line.
 *
 * If prompt == NULL then do not print the prompt.
 *
 * buf_length must be >= 1
 *
 * Return:	Number of characters read (not including Null terminaion),
 */
static int prompt_and_read_line(prompt, buf, buf_length)
char *prompt;
char buf[];
int buf_length;
{
    int len;
    
    if (prompt != (char *) NULL)
    {
	fprintf(_p_stdout, "%s", prompt);
	fflush(_p_stdout);
    }
    
    while (1)
    {
	if (_p_fgets(buf, buf_length)  == (char *) NULL)
	{
	    /* eof */
	    buf[0] = '\0';
	    len = -1;
	    break;
	}
	len = strlen(buf);
	if (len == buf_length - 1 && buf[len - 1] != '\n')
	{
	    /*
	     * Line to long -- flush rest of line, report it, 
	     * and start again
	     */
	    while (1)
	    {
		if ((_p_fgets(buf, buf_length) == (char *) NULL)
		    || (buf[strlen(buf) - 1] == '\n') )
		{
		    fprintf(_p_stdout,
			    "PDB Error: Line to long!  Maximum length = %d characters\n",
			    buf_length - 1);
		    if (prompt != (char *) NULL)
		    {
			fprintf(_p_stdout, "%s", prompt);
		    }
		    fflush(_p_stdout);
		    break;
		}
	    }
	}
	else
	{
	    if (buf[len - 1] == '\n')	/* Line ending in \n, not EOF */
	    {
		len--;
		buf[len] = '\0';
	    }
	    break;
	}
    }

    return (len);
} /* prompt_and_read_line() */


/*
 * parse_inputline()
 *
 * Parse the yyp_parse_inputline string.
 *
 * Return:	TRUE if a successful parse is done
 *		FALSE otherwise
 */
static bool_t parse_inputline()
{
    yyp_parse_tree = (pt_node_t *) NULL;
    yyp_start_new_command = TRUE;
    yyp_first_pt_node = (pt_node_t *) NULL;
    if ((yyparse() != 0) || (yyp_parse_tree == (pt_node_t *) NULL))
	return(FALSE);
    else
	return(TRUE);
}


/*
 * _pdb_query_to_abort()
 *
 * This is called from the interrupt handler in md_*.c when an
 * interrupt signal is caught.
 * It queries the user whether to drop into the debugger at the next
 * reduction or to abort from the emulator, or continue in
 * the debugger if we're already in it.
 *
 * Return:	FALSE : if we should NOT abort the emulator
 *		TRUE  : if we should abort the emulator
 */
bool_t _pdb_query_to_abort()
{
    char buf[1024];
    bool_t rc;
    int rc1;

    if (!_p_host)
	return (FALSE);

    while (1)
    {
	rc1 = prompt_and_read_line((in_pdb ? PDB_CONTINUE_QUERY_PROMPT
				    : PDB_BREAK_QUERY_PROMPT), buf, 1024);
	if (rc1 == 0)
	{
	    if (!in_pdb)
		_pdb_breakout = TRUE;
	    
	    rc = FALSE;
	    break;
	}
	else if (strcmp(buf, "q") == 0)
	{
	    rc = TRUE;
	    break;
	}
	else
	{
	    if (rc1 == -1)
		fprintf(_p_stdout, "\n");
	    fprintf(_p_stdout, PDB_Q_OR_RETURN_ERROR);
	}
    }
    
    return (rc);
} /* _pdb_query_to_abort() */


#endif /* PDB_HOST */


/*
 * _pdb_orphaned_process()
 *
 * This subroutine is called if the garbage collector picks up an orphaned
 * process.  It should print some sort of warning, possibly break into
 * the debugger, and definitely dequeue passed process from the PDB queue.
 */
void _pdb_orphaned_proc_record(proc_record)
proc_record_t *proc_record;
{
    if (_pdb_print_orphaned)
    {
	/*
	_p_print_proc_record("PDB Warning: Orphaned process: ", proc_record);
	*/
	fprintf(_p_stdout, "(%lu,%lu) PDB Warning: Orphaned process:\n\t",
		(unsigned long) _p_my_id, (unsigned long) _p_reduction);
	print_process(proc_record, 0, PDBT_VARSUSP, PDBT_SHOW);
    }
} /* _pdb_orphaned_proc_record() */


/*
 * _pdb_orphaned_value_note()
 *
 * This subroutine is called if the garbage collector picks up an orphaned
 * value note.  It should print some sort of warning, and possibly break into
 * the debugger.
 */
void _pdb_orphaned_value_note(value_note)
value_note_t *value_note;
{
    if (_pdb_print_orphaned)
	_p_print_proc_record("PDB Warning: Orphaned value note: ",
			     (proc_record_t *) value_note);
} /* _pdb_orphaned_value_note() */


/*
 * _pdb_get_next_instance()
 *
 * Return the next unique process instance number.
 */
u_int_t _pdb_get_next_instance()
{
    static u_int_t next_instance = 0;
    
    return (next_instance++);
} /* _pdb_get_next_instance() */


/*
 * _pdb_enqueue_process()
 *
 * Enqueue the passed process onto the PDB process queue.
 */
void _pdb_enqueue_process(proc_record)
proc_record_t *proc_record;
{
    if (_pdb_all_qf == (proc_record_t *) NULL)	/* Empty queue */
    {
	_pdb_all_qf = _pdb_all_qb = proc_record;
	proc_record->pdb_prev = proc_record->pdb_next = (proc_record_t *) NULL;
    }
    else			/* Not an empty queue -- so queue at end */
    {
	_pdb_all_qb->pdb_next = proc_record;
	proc_record->pdb_prev = _pdb_all_qb;
	proc_record->pdb_next = (proc_record_t *) NULL;
	_pdb_all_qb = proc_record;
    }
} /* _pdb_enqueue_process() */


/*
 * _pdb_dequeue_process()
 *
 * Dequeue the passed process from the PDB process queue.
 */
void _pdb_dequeue_process(proc_record)
proc_record_t *proc_record;
{
    /* Adjust forward pointer of previous member in queue */
    if (proc_record->pdb_prev == (proc_record_t *) NULL)
    {
	/* At front of queue*/
	_pdb_all_qf = proc_record->pdb_next;
    }
    else
    {
	/* Not at front of queue */
	proc_record->pdb_prev->pdb_next = proc_record->pdb_next;
    }

    /* Adjust backward pointer of next member in queue */
    if (proc_record->pdb_next == (proc_record_t *) NULL)
    {
	/* At back of queue */
	_pdb_all_qb = proc_record->pdb_prev;
    }
    else
    {
	/* Not at back of queue */
	proc_record->pdb_next->pdb_prev = proc_record->pdb_prev;
    }
} /* _pdb_dequeue_process() */


/*
 * print_all_processes_on_queue()
 */
static void print_all_processes_on_queue(queue, pi, pq)
proc_record_t *queue;
int *pi;
int pq;
{
    proc_record_t *proc_record;
    
    for (proc_record = queue;
	 proc_record != (proc_record_t *) NULL;
	 proc_record = proc_record->next)
    {
	print_process(proc_record, (*pi)++, pq, PDBT_SHOW);
	proc_record->header.mark = 1;
    }
} /* print_all_processes_on_queue() */


/*
 * _pdb_print_all_processes()
 */
void _pdb_print_all_processes()
{
    int pi = 1;
    proc_record_t *proc_record;

    print_all_processes_on_queue(_p_active_qf, &pi, PDBT_ACTIVE);
    print_all_processes_on_queue(_pdb_pending_qf, &pi, PDBT_PENDING);
    print_all_processes_on_queue(_p_globsusp_qf, &pi, PDBT_GLOBSUSP);

    for (proc_record = _pdb_all_qf;
	 proc_record != (proc_record_t *) NULL;
	 proc_record = proc_record->pdb_next)
    {
	if (proc_record->header.mark)
	    proc_record->header.mark = 0;
	else
	    print_process(proc_record, pi++, PDBT_VARSUSP);
    }
} /* _pdb_print_all_processes() */


/*
 * _pdb_init()
 *
 * Do all initialization for PDB.
 */
void _pdb_init()
{
    int i;
    proc_header_t *proc_header;

    _pdb_all_qf = _pdb_all_qb = _pdb_pending_qf = _pdb_pending_qb
	= (proc_record_t *) NULL;

    _pdb_breakout = FALSE;
    
    _pdb_reduction_break = 0;
    _pdb_empty_queue_break = 0;
    _pdb_print_orphaned = 1;
    summary_list = (summary_element_t *) NULL;

    /*
     * Initialize the PDB variables in the proc_headers
     */
    for (i = 0; i <= _p_exported_table_size; i++)
    {
	for (proc_header = _p_exported_table[i];
	     proc_header != (proc_header_t *) NULL;
	     proc_header = proc_header->next)
	{
	    proc_header->debugable = TRUE;
	    proc_header->debug = TRUE;
	    proc_header->break_num = 0;
	}
    }
    
    load_pdbrc();

} /* _pdb_init() */


/*
 * load_pdbrc()
 *
 * First try to load ./.pdbrc
 * If it doesn't exist, then load ~/.pdbrc if it exists.
 */
static void load_pdbrc()
{
    extern char *getenv();
    char file[MAX_PATH_LENGTH];
    char *s;
    
    strcpy(file, "./.pdbrc");
    if (access(file, 4) >= 0)
    {
	execute_source(file);
    }
    else
    {
	if ((s = getenv("HOME")) != (char *) NULL)
	{
	    sprintf(file, "%s/.pdbrc", s);
	    if (access(file, 4) >= 0)
	    {
		execute_source(file);
	    }
	}
    }
    
}

#endif /* PDB */

These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Marcel Waldvogel and Netfuture.ch.