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 Netfuture.ch.