/*************************************************************************
*  PDSS (PIMOS Development Support System)  Version 2.52		 *
*  (C) Copyright 1988,1989,1990,1992.					 *
*  Institute for New Generation Computer Technology (ICOT), Japan.	 *
*  Read "../COPYRIGHT" for detailed information.			 *
*************************************************************************/

#include "pdss.h"
#include "memory.h"
#include "io.h"
#include "klb.h"
#include "instr.h"
#include "ctype.h"
#include "tracer.h"

/*** Trace Status ***/
int trace_status    = STEP_TRACE;
int trace_intr_flag = NO;
static int trace_count = 0;

/*** Gate Switch ***/
#define NO_DISPLAY		0
#define DISPLAY_BUT_NO_STOP	1
#define DISPLAY_AND_STOP	2
static int trace_call = DISPLAY_AND_STOP;
static int trace_susp = DISPLAY_AND_STOP;
static int trace_resu = DISPLAY_AND_STOP;
static int trace_swap = DISPLAY_AND_STOP;
static int trace_fail = DISPLAY_AND_STOP;

/*** Print Format ***/
static int trace_pr_length  = PRINT_LENGTH;
static int trace_pr_depth   = PRINT_DEPTH;
static int trace_pr_length0 = PRINT_LENGTH;
static int trace_pr_depth0  = PRINT_DEPTH;


static int trace_last_priority = -1;
static OBJ *tracer_pcode;


/*************************************************************************
*   Initialize Tracer.							 *
*************************************************************************/

initialize_tracer()
{
    initialize_tracer_command_table();
    initialize_tracer_command_table2();
    initialize_tracer_command_table3();
    trace_status = STEP_TRACE;
    trace_count = 0;
    set_print_var_mode(option_print_var_mode);
}


/*************************************************************************
*   Command Table							 *
*************************************************************************/

struct tracer_command_table{
    int	 size;
    CHAR **name;
    CHAR **help;
};

static int scan_command_name(table, string)
    struct tracer_command_table *table;
    CHAR *string;
{
    register CHAR *p, *q;
    register int i;
    for(i = 0; i < table->size; i++){
	p = string;
	q = table->name[i];
	while(*p == *q){
	    p++; q++;
	    if(*p == 0) return(i);
	}
    }
    return(-1);
}

static display_command_help(table)
    struct tracer_command_table *table;
{
    register int i;
    for(i = 0; i < table->size; i++){
	if(table->help[i]) printf("  %s\n", table->help[i]);
    }
}

/**** Top Level Command ***/
#define TC_HELP			  0
#define TC_NO_TRACE		  1
#define TC_NO_TRACE_GOAL	  2
#define TC_STEP			  3
#define TC_STEP_TO_SPIED_P_OR_G	  4
#define TC_STEP_TO_SPIED_P_AND_G  5
#define TC_STEP_TO_SPIED_PRED	  6
#define TC_STEP_TO_SPIED_GOAL	  7
#define TC_NEXT_SPIED_P_OR_G	  8
#define TC_NEXT_SPIED_P_AND_G	  9
#define TC_NEXT_SPIED_PRED	 10
#define TC_NEXT_SPIED_GOAL	 11
#define TC_SET_DEBUG_MODE	 12
#define TC_SET_PRED_SPY		 13
#define TC_SET_GOAL_SPY		 14
#define TC_RESET_DEBUG_MODE	 15
#define TC_RESET_PRED_SPY	 16
#define TC_RESET_GOAL_SPY	 17
#define TC_ENQUEUE_TO_HEAD	 18
#define TC_ENQUEUE_TO_TAIL	 19
#define TC_DEPTH_FIRST		 20
#define TC_BREADTH_FIRST	 21
#define TC_RANDOM_ENQUEUE	 22
#define TC_REWRITE		 23
#define TC_WHERE		 24
#define TC_MONITOR_STREAM	 25
#define TC_INSPECT_READY_Q	 26
#define TC_INSPECT_VARIABLE	 27
#define TC_INSPECT_SHOEN_TREE	 28
#define TC_TRACE_SHOEN_TREE	 29
#define TC_SET_VARIABLE		 30
#define TC_INSTR_TRACE		 31
#define TC_REPORT_RAISE		 32
#define TC_SET_GC_HEAP		 33
#define TC_SET_GC_CODE		 34
#define TC_ABORT_TASK		 35
#define TC_EXIT_PDSS		 36

static struct tracer_command_table command_table;
static CHAR *ct_name[37];
static CHAR *ct_help[37];

#define DC(ID, NAME, HELP){\
    command_table.name[ID] = (CHAR *)NAME;\
    command_table.help[ID] = (CHAR *)HELP;\
}

static initialize_tracer_command_table()
{
    command_table.size = 37;
    command_table.name = ct_name;
    command_table.help = ct_help;
    DC(TC_HELP,			"?", NULL);
    DC(TC_NO_TRACE,		"X",
       "X  ..................... No trace");
    DC(TC_NO_TRACE_GOAL,	"x",
       "x  ..................... No trace goal");
    DC(TC_STEP,			"step",
       "s  [COUNT] ............. Step");
    DC(TC_STEP_TO_SPIED_P_OR_G, "ss",
  "ss (ns) [COUNT] ........ Step (Skip) to next spied point (pred or goal)");
    DC(TC_STEP_TO_SPIED_P_AND_G,"SS",
  "SS (NS) [COUNT] ........ Step (Skip) to next spied point (pred and goal)");
    DC(TC_STEP_TO_SPIED_PRED,	"sp",
       "sp (np) [COUNT] ........ Step (Skip) to next spied predicate");
    DC(TC_STEP_TO_SPIED_GOAL,	"sg",
       "sg (ng) [COUNT] ........ Step (Skip) to next spied goal");
    DC(TC_NEXT_SPIED_P_OR_G,	"ns", NULL);
    DC(TC_NEXT_SPIED_P_AND_G,	"NS", NULL);
    DC(TC_NEXT_SPIED_PRED,	"np", NULL);
    DC(TC_NEXT_SPIED_GOAL,	"ng", NULL);
    DC(TC_SET_DEBUG_MODE,	"debug",
       "d (D) MODULE ........... Set (Reset) module debug mode");
    DC(TC_SET_PRED_SPY,		"predicate",
       "p (P) MODULE:PRED ...... Set (Reset) predicate spy");
    DC(TC_SET_GOAL_SPY,		"goal",
       "g (G) .................. Set (Reset) goal spy");
    DC(TC_RESET_DEBUG_MODE,	"Debug",     NULL);
    DC(TC_RESET_PRED_SPY,	"Predicate", NULL);
    DC(TC_RESET_GOAL_SPY,	"Goal",	     NULL);
#if TWO_WAY_READY_GOAL_POOL
    DC(TC_ENQUEUE_TO_HEAD,	"<",
       "< (>) .................. Enqueue to head (tail) of ready queue");
    DC(TC_ENQUEUE_TO_TAIL,	">",  NULL);
    DC(TC_DEPTH_FIRST,		"<<",
       "<< (>>) [DEPTH]  ....... Depth (Breadth) first scheduling");
    DC(TC_BREADTH_FIRST,	">>", NULL);
    DC(TC_RANDOM_ENQUEUE,	"><",
       ">< [RATE][SEED][DEPTH] . Random enqueue scheduling");
#else
    DC(TC_ENQUEUE_TO_HEAD,	"", NULL);
    DC(TC_ENQUEUE_TO_TAIL,	"", NULL);
    DC(TC_DEPTH_FIRST,		"", NULL);
    DC(TC_BREADTH_FIRST,	"", NULL);
    DC(TC_RANDOM_ENQUEUE,	"", NULL);
#endif
    DC(TC_REWRITE,		"write",
       "w  LENGTH [DEPTH] ...... Rewrite goal record");
    DC(TC_WHERE,		"where",
       "wh ..................... Where D-code is called from");
    DC(TC_MONITOR_STREAM,	"monitor",
       "m  VAR [NAME] [COUNT] .. Monitor stream");
    DC(TC_INSPECT_READY_Q,	"iready",
       "ir [PRIORITY] .......... Inspect Ready queue");
    DC(TC_INSPECT_VARIABLE,	"ivariable",
       "iv ..................... Inspect Variable");
    DC(TC_INSPECT_SHOEN_TREE,	"ishoen",
       "is (ts) ................ Inspect (Trace) Shoen tree");
    DC(TC_TRACE_SHOEN_TREE,	"tshoen", NULL);
    DC(TC_SET_VARIABLE,		"set",
       "set VARIABLE [VALUE] ... Set tracer variable");
    DC(TC_INSTR_TRACE,		"ITRACE",	NULL);
    DC(TC_REPORT_RAISE,		"raise",	NULL);
    DC(TC_SET_GC_HEAP,		"GC",
       "GC (GCC) ............... GC heap (heap & code)");
    DC(TC_SET_GC_CODE,		"GCC", NULL);
    DC(TC_ABORT_TASK,		"ABORT",
       "ABORT .................. Abort Task");
    DC(TC_EXIT_PDSS,		"EXIT",
       "EXIT ................... Exit PDSS");
};

/**** Inspect Variable Command ****/
#define TV_HELP		  0
#define TV_PRINT_VAR_MODE 1
#define TV_PRINT_LENGTH	  2
#define TV_PRINT_DEPTH	  3
#define TV_GATE		  4
#define TV_GATE_CALL	  5
#define TV_GATE_SUSP	  6
#define TV_GATE_RESU	  7
#define TV_GATE_SWAP	  8
#define TV_GATE_FAIL	  9

static struct tracer_command_table variable_command_table;
static CHAR *vt_name[10];
static CHAR *vt_help[10];

#define DV(ID, NAME, HELP){\
    variable_command_table.name[ID] = (CHAR *)NAME;\
    variable_command_table.help[ID] = (CHAR *)HELP;\
}

static initialize_tracer_command_table2()
{
    variable_command_table.size = 10;
    variable_command_table.name = vt_name;
    variable_command_table.help = vt_help;
    DV(TV_HELP,			"?",
       "? ...................... Help");
    DV(TV_PRINT_VAR_MODE,	"pv",
       "pv {n|a}................ Print variable mode");
    DV(TV_PRINT_LENGTH,		"pl",
       "pl NNN ................. Print length");
    DV(TV_PRINT_DEPTH,		"pd",
       "pd NNN ................. Print depth");
    DV(TV_GATE,			"gate",
       "g  CSRWF ............... Switch for trace gate");
    DV(TV_GATE_CALL,		"call",
       "c  {n|t|s} ............. Switch for cell gate");
    DV(TV_GATE_SUSP,		"suspend",
       "s  {n|t|s} ............. Switch for suspend gate");
    DV(TV_GATE_RESU,		"resume",
       "r  {n|t|s} ............. Switch for resume gate");
    DV(TV_GATE_SWAP,		"wap",
       "w  {n|t|s} ............. Switch for swap gate");
    DV(TV_GATE_FAIL,		"fail",
       "f  {n|t|s} ............. Switch for fail gate");
};

/**** Stream Monitor Command ****/
#define MC_HELP		      0
#define MC_NO_MONITOR	      1
#define MC_STEP		      2
#define MC_REWRITE	      3
#define MC_MONITOR_STREAM     4
#define MC_INSPECT_READY_Q    5
#define MC_INSPECT_VARIABLE   6
#define MC_INSPECT_SHOEN_TREE 7

static struct tracer_command_table monitor_command_table;
static CHAR *mt_name[10];
static CHAR *mt_help[10];

#define DM(ID, NAME, HELP){\
    monitor_command_table.name[ID] = (CHAR *)NAME;\
    monitor_command_table.help[ID] = (CHAR *)HELP;\
}

static initialize_tracer_command_table3()
{
    monitor_command_table.size = 8;
    monitor_command_table.name = mt_name;
    monitor_command_table.help = mt_help;
    DM(MC_HELP,			"?",
       "?  ..................... Help");
    DM(MC_NO_MONITOR,		"x",
       "x  ..................... No monitor");
    DM(MC_STEP,			"step",
       "s  [COUNT] ............. Step");
    DM(MC_REWRITE,		"write",
       "w  LENGTH [DEPTH] ...... Rewrite goal record");
    DM(MC_MONITOR_STREAM,	"monitor",
       "m  VAR [NAME] [LIMIT] .. Monitor stream");
    DM(MC_INSPECT_READY_Q,	"iready",
       "ir [PRIORITY] .......... Inspect Ready queue");
    DM(MC_INSPECT_VARIABLE,	"ivariable",
       "iv ..................... Inspect Variable");
    DM(MC_INSPECT_SHOEN_TREE,	"ishoen",
       "is ..................... Inspect Shoen tree");
};


/*************************************************************************
*   Check Trace Gate Switch.						 *
*************************************************************************/

static int trace_on(mode, code, grec)
    int	 mode;
    OBJ *code;
    GOAL_RECORD *grec;
{
    int m_t_mode, p_t_mode, g_t_mode;
    switch(mode&GATE_MASK){
      case GATE_CALL:
	if (trace_call == NO_DISPLAY) return(NO);
	break;
      case GATE_SUSP:
	if (trace_susp == NO_DISPLAY) return(NO);
	break;
      case GATE_RESU:
	if (trace_resu == NO_DISPLAY) return(NO);
	break;
      case GATE_SWAP:
	if (trace_swap == NO_DISPLAY) return(NO);
	break;
      case GATE_FAIL:
	if (trace_fail == NO_DISPLAY) return(NO);
	break;
    }
    p_t_mode = GetPredicateDebug(code);	    /* See klb.h */
    m_t_mode = GetModuleDebug(GetModuleTop(code));
    if(m_t_mode == 0) return(NO);
    if(mode&(GATE_CALL|GATE_FAIL)){
	g_t_mode = goal_debug_status;
    }else{
	g_t_mode = grec->debug;
    }
    switch(trace_status){
      case STEP_TRACE:
      case STEP_TO_SPIED_P_OR_G:
      case STEP_TO_SPIED_P_AND_G:
      case STEP_TO_SPIED_PRED:
      case STEP_TO_SPIED_GOAL:
	return(YES);
      case NEXT_SPIED_P_OR_G:
	if((p_t_mode&PREDICATE_SPY_ON) || (g_t_mode&SPIED_GOAL)) return(YES);
	break;
      case NEXT_SPIED_P_AND_G:
	if((p_t_mode&PREDICATE_SPY_ON) && (g_t_mode&SPIED_GOAL)) return(YES);
	break;
      case NEXT_SPIED_PRED:
	if(p_t_mode&PREDICATE_SPY_ON) return(YES);
	break;
      case NEXT_SPIED_GOAL:
	if(g_t_mode&SPIED_GOAL) return(YES);
	break;
    }
    return(NO);
}

static int trace_stop(mode, code, grec)
    int	 mode;
    CHAR *code;
    GOAL_RECORD *grec;
{
    int p_t_mode, g_t_mode;
    switch(mode&GATE_MASK){
      case GATE_CALL:
	if (trace_call == DISPLAY_BUT_NO_STOP) return(NO);
	break;
      case GATE_SUSP:
	if (trace_susp == DISPLAY_BUT_NO_STOP) return(NO);
	break;
      case GATE_RESU:
	if (trace_resu == DISPLAY_BUT_NO_STOP) return(NO);
	break;
      case GATE_SWAP:
	if (trace_swap == DISPLAY_BUT_NO_STOP) return(NO);
	break;
      case GATE_FAIL:
	if (trace_fail == DISPLAY_BUT_NO_STOP) return(NO);
	break;
    }
    p_t_mode = GetPredicateDebug(code);	    /* See klb.h */
    if(mode&(GATE_CALL|GATE_FAIL)){
	g_t_mode = goal_debug_status;
    }else{
	g_t_mode = grec->debug;
    }
    switch(trace_status){
      case STEP_TO_SPIED_P_OR_G:
	if(!(p_t_mode&PREDICATE_SPY_ON) && !(g_t_mode&SPIED_GOAL)) return(NO);
	break;
      case STEP_TO_SPIED_P_AND_G:
	if(!((p_t_mode&PREDICATE_SPY_ON) && (g_t_mode&SPIED_GOAL))) return(NO);
	break;
      case STEP_TO_SPIED_PRED:
	if(!(p_t_mode&PREDICATE_SPY_ON)) return(NO);
	break;
      case STEP_TO_SPIED_GOAL:
	if(!(g_t_mode&SPIED_GOAL)) return(NO);
	break;
    }
    return(YES);
}


/*************************************************************************
*   Set Tracer Status.							 *
*************************************************************************/

set_trace_status(status)
    int	 status;
{
    trace_status = status;
    trace_count	 = 0;
    trace_last_priority = -1;
}

trace_call_switch(status)
    int	 status;
{
    trace_call = status;
}

trace_susp_switch(status)
    int	 status;
{
    trace_susp = status;
}

trace_resu_switch(status)
    int	 status;
{
    trace_resu = status;
}

trace_fail_switch(status)
    int	 status;
{
    trace_fail = status;
}

trace_swap_switch(status)
    int	 status;
{
    trace_swap = status;
}

trace_interrupt()
{
    trace_intr_flag = YES;
}


/*************************************************************************
*   Tracer Top Level.							 *
*************************************************************************/

trace(code, an, as, mode, grec, prec)
    OBJ *code;
    int an;
    int mode;
    CELL *as;
    GOAL_RECORD *grec;
    PARENT_RECORD *prec;
{
    int	  cid, argn;
    CHAR  buffer[80], *argv[10];
    CHAR  *p;
    static int	default_command = TC_STEP;

    if(trace_intr_flag){
	trace_intr_flag = NO;
	SelectWindow(CONSOLE);
	set_print_file(stdout);
	initialize_print_routine();
    }else{
	if(!trace_on(mode, code, grec)) return;
	SelectWindow(CONSOLE);
	set_print_file(stdout);
	initialize_print_routine();
	if(!trace_stop(mode, code, grec)){
	    write_priority();
	    write_mode(mode, code, grec);
	    write_goal(code, an, as, prec, trace_pr_length0, trace_pr_depth0); 
	    putchar('\n');
	    return;
	}
	if(trace_count > 1){
	    trace_count--;
	    write_priority();
	    write_mode(mode, code, grec);
	    write_goal(code, an, as, prec, trace_pr_length0, trace_pr_depth0); 
	    putchar('\n');
	    return;
	}
    }
    if(grec){
	tracer_pcode = grec->pcode;
    }else{
	tracer_pcode = current_predicate2;
    }
    if(tracer_pcode == NULL){
	tracer_pcode = current_predicate;
    }
    write_priority();
    for(;;){
	write_mode(mode, code, grec);
	write_goal(code, an, as, prec, trace_pr_length0, trace_pr_depth0);
	trace_pr_length0 = trace_pr_length;
	trace_pr_depth0	 = trace_pr_depth;
	sprintf(buffer, "  [%s]%% ", command_table.name[default_command]);
	if(read_console(buffer, buffer, 80) < 0) exit_pdss(1);
	p = buffer;
	for(argn = -1; argn < 9;){
	    while(IsBlank(*p)) p++;
	    if(*p == 0) break;
	    argv[++argn] = p;
	    while(!IsBlank(*p)) if(*p++ == 0) goto scan_args_done;
	    *p++ = 0;
	}
      scan_args_done:
	if(argn >= 0){
	    if((cid = scan_command_name(&command_table, argv[0])) < 0){
		printf("!!! unknown command\n");
		continue;
	    }
	}else{
	    cid = default_command;
	    argn = 0;
	}
	switch (cid){
	  case TC_HELP:
	    display_command_help(&command_table);
	    continue;
	  case TC_NO_TRACE:
	    trace_status = NO_TRACE;
	    return;
	  case TC_NO_TRACE_GOAL:
	    if(mode&(GATE_CALL|GATE_FAIL)){
		goal_debug_status |= NO_TRACE_GOAL;
	    }else{
		grec->debug |= NO_TRACE_GOAL;
	    }
	    return;
	  case TC_STEP:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = STEP_TRACE;
	    default_command = TC_STEP;
	    return;
	  case TC_STEP_TO_SPIED_P_OR_G:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = STEP_TO_SPIED_P_OR_G;
	    default_command = TC_STEP_TO_SPIED_P_OR_G;
	    return;
	  case TC_STEP_TO_SPIED_P_AND_G:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = STEP_TO_SPIED_P_AND_G;
	    default_command = TC_STEP_TO_SPIED_P_AND_G;
	    return;
	  case TC_STEP_TO_SPIED_PRED:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = STEP_TO_SPIED_PRED;
	    default_command = TC_STEP_TO_SPIED_PRED;
	    return;
	  case TC_STEP_TO_SPIED_GOAL:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = STEP_TO_SPIED_GOAL;
	    default_command = TC_STEP_TO_SPIED_GOAL;
	    return;
	  case TC_NEXT_SPIED_P_OR_G:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = NEXT_SPIED_P_OR_G;
	    default_command = TC_NEXT_SPIED_P_OR_G;
	    return;
	  case TC_NEXT_SPIED_P_AND_G:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = NEXT_SPIED_P_AND_G;
	    default_command = TC_NEXT_SPIED_P_AND_G;
	    return;
	  case TC_NEXT_SPIED_PRED:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = NEXT_SPIED_PRED;
	    default_command = TC_NEXT_SPIED_PRED;
	    return;
	  case TC_NEXT_SPIED_GOAL:
	    if(!trace_set_count(argn, &argv[1])) continue;
	    trace_status = NEXT_SPIED_GOAL;
	    default_command = TC_NEXT_SPIED_GOAL;
	    return;
	  case TC_SET_DEBUG_MODE:
	    trace_set_debug_flag(argn, &argv[1], YES);
	    continue;
	  case TC_SET_PRED_SPY:
	    trace_set_predicate_spy(argn, &argv[1], YES);
	    continue;
	  case TC_SET_GOAL_SPY:
	    trace_set_goal_spy(mode, grec, YES);
	    continue;
	  case TC_RESET_DEBUG_MODE:
	    trace_set_debug_flag(argn, &argv[1], NO);
	    continue;
	  case TC_RESET_PRED_SPY:
	    trace_set_predicate_spy(argn, &argv[1], NO);
	    continue;
	  case TC_RESET_GOAL_SPY:
	    trace_set_goal_spy(mode, grec, NO);
	    continue;
#if TWO_WAY_READY_GOAL_POOL
	  case TC_ENQUEUE_TO_HEAD:
	    if(mode&(GATE_SUSP|GATE_FAIL)){
		printf("!!! cannot use this command, now.\n");
		continue;
	    }
	    enqueue_special_flag = 1;
	    trace_status = STEP_TRACE;
	    default_command = TC_STEP;
	    trace_count = 1;
	    return;
	  case TC_ENQUEUE_TO_TAIL:
	    if(mode&(GATE_SUSP|GATE_FAIL)){
		printf("!!! cannot use this command, now.\n");
		continue;
	    }
	    enqueue_special_flag = 2;
	    trace_status = STEP_TRACE;
	    default_command = TC_STEP;
	    trace_count = 1;
	    return;
	  case TC_DEPTH_FIRST:
	    trace_depth_first(argn, &argv[1]);
	    continue;
	  case TC_BREADTH_FIRST:
	    trace_breadth_first(argn, &argv[1]);
	    continue;
	  case TC_RANDOM_ENQUEUE:
	    trace_random_enqueue(argn, &argv[1]);
	    continue;
#endif
	  case TC_REWRITE:
	    trace_set_rewrite_status(argn, &argv[1]);
	    continue;
	  case TC_WHERE:
	    trace_where_called_from(argn, &argv[1]);
	    continue;
	  case TC_MONITOR_STREAM:
	    trace_monitor_stream(argn, &argv[1]);
	    continue;
	  case TC_INSPECT_READY_Q:
	    trace_inspect_ready_queue(argn, &argv[1]);
	    continue;
	  case TC_INSPECT_VARIABLE:
	    trace_inspect_variable(argn, &argv[1]);
	    continue;
	  case TC_INSPECT_SHOEN_TREE:
	    inspect_shoen_tree();
	    continue;
	  case TC_TRACE_SHOEN_TREE:
	    if(shoen_tree_trace_flag){
		shoen_tree_trace_flag = NO;
		printf(">>> shoen tree trace is OFF.\n");
	    }else{
		shoen_tree_trace_flag = YES;
		printf(">>> shoen tree trace is ON.\n");
	    }
	    continue;
	  case TC_SET_VARIABLE:
	    trace_set_variable(argn, &argv[1]);
	    continue;
#if INSTRUCTION_TRACE
	  case TC_INSTR_TRACE:
	    if(instruction_trace_flag){
		instruction_trace_flag = NO;
		printf(">>> instruction trace is OFF.\n");
	    }else{
		instruction_trace_flag = YES;
		printf(">>> instruction trace is ON.\n");
	    }
	    continue;
#endif
	  case TC_REPORT_RAISE:
	    if(report_raise_flag){
		report_raise_flag = NO;
		printf(">>> report raise OFF.\n");
	    }else{
		report_raise_flag = YES;
		printf(">>> report raise ON.\n");
	    }
	    continue;
	  case TC_SET_GC_HEAP:
	    SetHeapGcFlag();
	    continue;
	  case TC_SET_GC_CODE:
	    SetCodeGcFlag();
	    continue;
	  case TC_ABORT_TASK:
	    trace_status = NO_TRACE;
	    io_table[1].int_code = 1;
	    SetKeyIntFlag();
	    return;
	  case TC_EXIT_PDSS:
	    if(strcmp(argv[0], "EXIT") == 0) exit_pdss(0);
	    continue;
	}
    }
}


/*************************************************************************
*   Tracer Command (1)							 *
*************************************************************************/

static int trace_set_count(argn, argv)
    int	 argn;
    CHAR **argv;
{
    int	 x;
    if(argn > 0){
	x = trace_scan_integer(argv[0]);
	if(x < 0) return(NO);
	trace_count = x;
    }else{
	trace_count = 1;
    }
    return(YES);
}

#if TWO_WAY_READY_GOAL_POOL

static trace_depth_first(argn, argv)
    int	 argn;
    CHAR **argv;
{
    int	 x;
    if(argn > 0){
	x = trace_scan_integer(argv[0]);
	if(x < 0) return(NO);
	execute_limit = x;
    }else{
	execute_limit = 0;
    }
    breadth_first_flag = NO;
    random_enqueue_flag = NO;
    printf(">>> depth first scheduling.");
    if(execute_limit) printf(" (execute depth: %s)", execute_limit);
    putchar('\n');
    return(YES);
}

static trace_breadth_first(argn, argv)
    int	 argn;
    CHAR **argv;
{
    int	 x;
    if(argn > 0){
	x = trace_scan_integer(argv[0]);
	if(x < 0) return(NO);
	execute_limit = x;
    }else{
	execute_limit = 100;
    }
    breadth_first_flag = YES;
    random_enqueue_flag = NO;
    printf(">>> breadth first scheduling.");
    if(execute_limit) printf(" (execute depth: %s)", execute_limit);
    putchar('\n');
    return(YES);
}

static trace_random_enqueue(argn, argv)
    int	 argn;
    CHAR **argv;
{
    int	 x;
    if(argn > 0){
	x = trace_scan_integer(argv[0]);
	if(x < 0 || x > 100) return(NO);
	random_rate = x;
    }else{
	random_rate = 5;
    }
    if(argn > 1){
	x = trace_scan_integer(argv[1]);
	if(x < 0) return(NO);
	random_seed = x;
    }else{
	random_seed = 0;
    }
    if(argn > 2){
	x = trace_scan_integer(argv[2]);
	if(x < 0) return(NO);
	execute_limit = x;
    }else{
	execute_limit = 0;
    }
    random_enqueue_flag = YES;
    printf(">>> random enqueue scheduling.");
    if(execute_limit) printf(" (execute depth: %s)", execute_limit);
    putchar('\n');
    return(YES);
}

#endif

static trace_set_rewrite_status(argn, argv)
    int	 argn;
    CHAR **argv;
{
    int	 x;
    if(argn > 0){
	if((x = trace_scan_integer(argv[0])) > PRINT_LENGTH){
	    trace_pr_length0 = x;
	}
	if(argn > 1){
	    if((x = trace_scan_integer(argv[1])) > PRINT_DEPTH){
		trace_pr_depth0 = x;
	    }
	}
    }
}

static trace_set_debug_flag(argn, argv, flag)
    int	 argn;
    CHAR **argv;
    int	 flag;
{
    int	 i;
    for(i = 0; i < argn; i++){
	switch(set_module_trace_flag(intern_atom(argv[i]), flag)){
	  case MODMAN_SUCCESS:
	    printf(">>> module %s is debug %s\n",
		   argv[i], flag ? "on" : "off");
	    continue;
	  case MODMAN_MODULE_NOT_FOUND:
	    printf("!!! module %s is not found.\n", argv[i]);
	    continue;
	}
    }
}

static trace_set_predicate_spy(argn, argv, flag)
    int	 argn;
    CHAR **argv;
    int	 flag;
{
    int	 module, pred, arity, i;
    for(i = 0; i < argn; i++){
	if(!scan_module_and_predicate(argv[i], &module, &pred, &arity)){
	    printf("!!! bad predicate name %s.\n", argv[i]);
	    continue;
	}
	switch(set_predicate_spy_flag(module, pred, arity, flag)){
	  case MODMAN_SUCCESS:
	    printf(">>> predicate %s is %s\n",
		   argv[i], flag ? "spied" : "not spied");
	    continue;
	  case MODMAN_MODULE_NOT_FOUND:
	    printf("!!! module %s is not found.\n", argv[i]);
	    continue;
	  case MODMAN_PREDICATE_NOT_FOUND:
	    printf("!!! predicate %s is not found.\n", argv[i]);
	    continue;
	}
    }
}

static trace_set_goal_spy(mode, grec, flag)
    int	 mode;
    GOAL_RECORD *grec;
    int	 flag;
{
    if(mode&(GATE_CALL|GATE_FAIL)){
	if(flag){
	    goal_debug_status |= SPIED_GOAL;
	}else{
	    goal_debug_status &= ~SPIED_GOAL;
	}
    }else{
	if(flag){
	    grec->debug |= SPIED_GOAL;
	}else{
	    grec->debug &= ~SPIED_GOAL;
	}
    }
    printf(">>> this goal is %s\n", flag ? "spied" : "not spied");
}

static trace_where_called_from(argn, argv)
    int	 argn;
    CHAR **argv;
{
    if(IsNativeCode(tracer_pcode)){
	unsigned int mod, pred, arity;
	function_to_mod_pred_arity(tracer_pcode, &mod, &pred, &arity);
	printf(">>> called from %s:%s/%d.\n",
	       atom_name(mod), atom_name(pred), arity);
    }else{
	printf(">>> called from %s:%s/%d.\n",
	       atom_name(GetModuleName(GetModuleTop(tracer_pcode))),
	       atom_name(GetPredicateName(tracer_pcode)),
	       GetPredicateArity(tracer_pcode));
    }
}

static int trace_inspect_ready_queue(argn, argv)
    int	 argn;
    CHAR **argv;
{
    int	 pri;
    if(argn > 0){
	if((pri = trace_scan_integer(argv[0])) < 0){
	    return(NO);
	}
	printf(">>> ready queue (priority = %d):\n", pri);
    }else{
	pri = -1;
	printf(">>> ready queue:\n");
    }
    if(!display_ready_queues(pri)) printf("  empty.\n");
    return(YES);
}

static int trace_inspect_variable(argn, argv)
    int	 argn;
    CHAR **argv;
{
    CELL *c;
    int n;
    if(argn < 1){
	printf("!!! not enough arguments\n");
	return(NO);
    }
    if(argv[0][0] == 'i' && argv[0][1] == 'n'){
	n = trace_scan_integer(&(argv[0][2]));
	if(n < 1 || n >= MAX_OF_WINDOW){
	    printf("!!! bad io number %s\n", *argv);
	    return(NO);
	}
	Dereference2(io_table[n].inp_hook, c);
    }else if(argv[0][0] == 'i' && argv[0][1] == 't'){
	n = trace_scan_integer(&(argv[0][2]));
	if(n < 1 || n >= MAX_OF_WINDOW){
	    printf("!!! bad io number %s\n", *argv);
	    return(NO);
	}
	Dereference2(io_table[n].int_hook, c);
    }else{
	if((c = lookup_var(*argv)) == NULL){
	    printf("!!! unknown variable %s\n", *argv);
	    return(NO);
	}
	Dereference2(Objectof(c), c);
    }
    switch(Typeof(c)){
      case UNDEF:
	printf("Variable is UNDEF.\n");
	break;
      case HOOK:
	printf(">>> variable is HOOK.  Suspension queue:\n");
	display_suspended_goals(c);
	break;
      case MHOOK:
	printf(">>> variable is MHOOK.  Suspension queue:\n");
	display_suspended_goals(c);
	break;
      case MGHOK:
	printf(">>> variable is MGHOK.  Merge tree:\n");
	display_merge_tree(c);
	break;
    }
    return(YES);
}


/*************************************************************************
*   Tracer Command (2) -- Set Tracer Variable.				 *
*************************************************************************/

static int trace_set_variable(argn, argv)
    int	 argn;
    CHAR **argv;
{
    int	 cid, x;
    static CHAR *gate_mode[]=
	{(CHAR *)"No Trace",(CHAR *)"Trace (No Stop)",(CHAR *)"Trace (Stop)"};

    if(argn < 1){
	printf("!!! not enough arguments\n");
	return(NO);
    }
    if((cid = scan_command_name(&variable_command_table, *argv++)) < 0){
	printf("!!! unknown variable\n");
	return(NO);
    }
    switch (cid) {
      case TV_HELP:
	display_command_help(&variable_command_table);
	return(YES);
      case TV_PRINT_VAR_MODE:
	if(argn < 2){
	    printf(">>> print variable mode is %s.\n",
		   (get_print_var_mode() == PRINT_VAR_MODE_ABC)
					  ? "Name" : "Address");
	}else{
	    switch(**argv){
	      case 'n': case 'N':
		set_print_var_mode(PRINT_VAR_MODE_ABC);
		break;
	      case 'a': case 'A':
		set_print_var_mode(PRINT_VAR_MODE_ADR);
		break;
	      default:
		printf("!!! unknown flag %s.\n", *argv);
		return(NO);
	    }
	}
	break;
      case TV_PRINT_LENGTH:
	if(argn < 2){
	    printf(">>> print length is %d.\n", trace_pr_length);
	}else{
	    if((x = trace_scan_integer(*argv)) < 0) return(NO);
	    trace_pr_length = (x > PRINT_LENGTH) ? x : PRINT_LENGTH;
	}
	break;
      case TV_PRINT_DEPTH:
	if(argn < 2){
	    printf(">>> print depth is %d.\n", trace_pr_depth);
	}else{
	    if((x = trace_scan_integer(*argv)) < 0) return(NO);
	    trace_pr_depth = (x > PRINT_DEPTH) ? x : PRINT_DEPTH;
	}
	break;
      case TV_GATE:
	if(argn < 2){
	    printf(">>> gate CALL is %s.\n", gate_mode[trace_call]);
	    printf("         SUSP is %s.\n", gate_mode[trace_susp]);
	    printf("         RESU is %s.\n", gate_mode[trace_resu]);
	    printf("         SWAP is %s.\n", gate_mode[trace_swap]);
	    printf("         FAIL is %s.\n", gate_mode[trace_fail]);
	}else{
	    trace_set_gate_switch(argv[0][0], &trace_call);
	    if(argv[0][1]){
		trace_set_gate_switch(argv[0][1], &trace_susp);
		if(argv[0][2]){
		    trace_set_gate_switch(argv[0][2], &trace_resu);
		    if(argv[0][3]){
			trace_set_gate_switch(argv[0][3], &trace_swap);
			if(argv[0][4]){
			    trace_set_gate_switch(argv[0][4], &trace_fail);
			}
		    }
		}
	    }
	}
	break;
      case TV_GATE_CALL:
	if(argn < 2){
	    printf(">>> gate CALL is %s.\n", gate_mode[trace_call]);
	}else{
	    trace_set_gate_switch(**argv, &trace_call);
	}
	break;
      case TV_GATE_SUSP:
	if(argn < 2){
	    printf(">>> gate SUSP is %s.\n", gate_mode[trace_susp]);
	}else{
	    trace_set_gate_switch(**argv, &trace_susp);
	}
	break;
      case TV_GATE_RESU:
	if(argn < 2){
	    printf(">>> gate RESU is %s.\n", gate_mode[trace_resu]);
	}else{
	    trace_set_gate_switch(**argv, &trace_resu);
	}
	break;
      case TV_GATE_SWAP:
	if(argn < 2){
	    printf(">>> gate SWAP is %s.\n", gate_mode[trace_swap]);
	}else{
	    trace_set_gate_switch(**argv, &trace_swap);
	}
	break;
      case TV_GATE_FAIL:
	if(argn < 2){
	    printf(">>> gate FAIL is %s.\n", gate_mode[trace_fail]);
	}else{
	    trace_set_gate_switch(**argv, &trace_fail);
	}
	break;
    }
    return(YES);
}

static trace_set_gate_switch(chr, flag)
    int	 chr, *flag;
{
    switch(chr){
      case 'n':	 case 'N':
	*flag = NO_DISPLAY;
	break;
      case 't':	 case 'T':
	*flag = DISPLAY_BUT_NO_STOP;
	break;
      case 's':	 case 'S':
	*flag = DISPLAY_AND_STOP;
	break;
      case '.':
	break;
      default:
	printf("!!! unknown flag %c.\n", chr);
    }
}


/*************************************************************************
*   Tracer Command (3) -- Monitor Stream.				 *
*************************************************************************/

DCODE dc_debug_monitor_stream()
{
    blt_b_debug_monitor_stream(&R0, &R1, &R2);
    return(NC_PROCEED);
}

static int trace_monitor_stream(argn, argv)
    int	 argn;
    CHAR **argv;
{
    CELL  *ref, *name;
    GOAL_RECORD *grec, *create_monitor_stream_goal();
    int	 counter;
    if(argn < 1){
	printf("!!! not enough arguments\n");
	return(NO);
    }
    if((ref = lookup_var(*argv)) == NULL) {
	printf("!!! unknown variable %s\n", *argv);
	return(NO);
    }
    if(argn > 1 && !(IsDigit(argv[1][0]))){
	argn--; argv++;
    }
    name = convert_to_kl1_string(*argv);
    argn--; argv++;
    if(argn > 0){
	if((counter = trace_scan_integer(*argv)) < 0){
	    return(NO);
	}
    }else{
	counter = 1;
    }
    /*** Create Monitor Stream Goal ***/
    GetGoalRecord(grec, 3);
    number_of_children++;
    grec->parent = parent;
    grec->code	 = (OBJ *)dc_debug_monitor_stream;
    grec->argn	 = 3;
    SetMrbof(ref, MRBON);
    grec->args[0] = *ref;
    SetAll(&(grec->args[1]), STRING, name,    MRBOFF);
    SetAll(&(grec->args[2]), INT,    counter, MRBOFF);
    SetGoalPriority(grec, INT, MAX_PRIORITY<<PRIORITY_SIFT_WIDTH);
    grec->debug	 = NO_TRACE_GOAL;
    grec->pcode	 = NULL;
    enqueue_with_priority(grec);
    return(YES);
}

blt_b_debug_monitor_stream(x, name, count)
    CELL *x, *name, *count;
{
    CELL *var;
    int	 counter, cid, argn, fstr;
    CHAR buffer[80], *argv[10];
    CHAR *p;

    Dereference(x);
    if(IsRef(x)){
	body_builtin_suspend(dc_debug_monitor_stream, x,
			     III, x, name, count);
	return;
    }
    if(Typeof(x) == LIST){
	var = Carof(x);
	Dereference(var);
	if(Mrbof(x) == MRBON) SetMrbof(var, MRBON);
	if(IsRef(var)){
	    body_builtin_suspend(dc_debug_monitor_stream, var,
				 III, x, name, count);
	    return;
	}
	fstr = YES;
    }else{
	var = x;
	fstr = NO;
    }
    Dereference(name);
    if(Typeof(name) != STRING){
	if(IsRef(name)){
	    body_builtin_suspend(dc_debug_monitor_stream, name,
				 III, x, name, count);
	    return;
	}else{
      exception:
	    body_builtin_exception(ILLEGAL_INPUT_TYPE, 2,
				   KL1B_B_DEBUG_MONITOR_STREAM, III,
				   x, name, count);
	    return;
	}
    }
    if((StringTypeof(name)&0xE7) != 0x03) goto exception;
    Dereference(count);
    if(Typeof(count) != INT){
	if(IsRef(count)){
	    body_builtin_suspend(dc_debug_monitor_stream, count,
				 III, x, name, count);
	    return;
	}else{
	    body_builtin_exception(ILLEGAL_INPUT_TYPE, 3,
				   KL1B_B_DEBUG_MONITOR_STREAM, III,
				   x, name, count);
	    return;
	}
    }
    counter = Valueof(count)-1;
    SelectWindow(CONSOLE);
    set_print_file(stdout);
    initialize_print_routine();
    for(;;){
	printf("mon#");
	print_string(name);
	if(fstr){
	    printf(" => ");
	}else{
	    printf(" == ");
	    
	}
	print_term2(var, trace_pr_length0, trace_pr_depth0);
	trace_pr_length0 = trace_pr_length;
	trace_pr_depth0	 = trace_pr_depth;
	if(counter > 0){
	    printf("\n");
	    break;
	}
	if(read_console("  %% ", buffer, 80) < 0) exit_pdss(1);
	p = buffer;
	for(argn = -1; argn < 9;){
	    while(IsBlank(*p)) p++;
	    if(*p == 0) break;
	    argv[++argn] = p;
	    while(!IsBlank(*p)) if(*p++ == 0) goto scan_args_done;
	    *p++ = 0;
	}
      scan_args_done:
	if(argn >= 0){
	    if((cid = scan_command_name(&monitor_command_table, argv[0])) < 0){
		printf("!!! unknown command\n");
		continue;
	    }
	}else{
	    cid = MC_STEP;
	    argn = 0;
	}
	switch (cid){
	  case MC_HELP:
	    display_command_help(&monitor_command_table);
	    continue;
	  case MC_NO_MONITOR:
	    goto quit_monitor;
	  case MC_STEP:
	    if(argn > 0){
		if((counter = trace_scan_integer(argv[1])) < 0) continue;
	    }else{
		counter = 1;
	    }
	    goto exit_monitor;
	  case MC_REWRITE:
	    trace_set_rewrite_status(argn, &argv[1]);
	    continue;
	  case MC_MONITOR_STREAM:
	    trace_monitor_stream(argn, &argv[1]);
	    continue;
	  case MC_INSPECT_READY_Q:
	    trace_inspect_ready_queue(argn, &argv[1]);
	    continue;
	  case MC_INSPECT_VARIABLE:
	    trace_inspect_variable(argn, &argv[1]);
	    continue;
	  case MC_INSPECT_SHOEN_TREE:
	    inspect_shoen_tree();
	    continue;
	}
    }
  exit_monitor:
    if(fstr){
	GOAL_RECORD *grec;
	var = Cdrof(x);
	Dereference(var);
	if(Mrbof(x) == MRBON) SetMrbof(var, MRBON);
	GetGoalRecord(grec, 3);
	number_of_children++;
	grec->parent = parent;
	grec->code   = (OBJ *)dc_debug_monitor_stream;
	grec->argn   = 3;
	grec->args[0] = *var;
	grec->args[1] = *name;
	SetAll(&(grec->args[2]), INT, counter, MRBOFF);
	SetGoalPriority(grec, INT, (MAX_PRIORITY<<PRIORITY_SIFT_WIDTH));
	grec->debug  = NO_TRACE_GOAL;
	grec->pcode  = NULL;
	enqueue_with_priority(grec);
    }else{
      quit_monitor:
	if(Mrbof(name) == MRBOFF){
	    FreeString(Objectof(name), StringLengthof(name));
	    mrbgc_statistics_collect_in_builtin(StringLengthof(name)+1);
	}
    }
}


/*************************************************************************
*   Subroutines.							 *
*************************************************************************/

static int trace_scan_integer(str)
    CHAR *str;
{
    int	 x;
    CHAR *p;
    x = 0;
    p = str;
    while(*p >= '0' && *p <= '9') x = x*10+(*p++)-'0';
    if(*p == 0){
	return(x);
    }else{
	printf("!!! bad number %s.\n", str);
	return(-1);
    }
}

static int scan_module_and_predicate(str, module, pred, arity)
    CHAR *str;
    unsigned int *module, *pred, *arity;
{
    CHAR *s;
    unsigned int make_module_predicate_atom();
    if(IsAlpha(*str)){
	s = str;
	while(IsAlNum(*str)) str++;
	*module = make_module_predicate_atom(s, str);
    }else if(*str == '\''){
	s = ++str;
	while(*str != '\'') str++;
	*module = make_module_predicate_atom(s, str++);
    }else{
	return(NO);
    }
    if(*str++ != ':') return(NO);
    if(IsAlpha(*str)){
	s = str;
	while(IsAlNum(*str)) str++;
	*pred = make_module_predicate_atom(s, str);
    }else if(*str == '\''){
	s = ++str;
	while(*str != '\'') str++;
	*pred = make_module_predicate_atom(s, str++);
    }else{
	return(NO);
    }
    if(*str == 0){
	*arity = -1;
	return(YES);
    }
    if(*str++ != '/') return(NO);
    if(IsDigit(*str)){
	*arity = (*str++)-'0';
	while(IsDigit(*str)) *arity = *arity*10+(*str++)-'0';
    }else{
	return(NO);
    }
    if(*str == 0) return(YES);
    return(NO);
}

static unsigned int make_module_predicate_atom(s, p)
    CHAR *s, *p;
{
    int	 atom, x;
    x = *p; *p = 0;
    atom = intern_atom(s);
    *p = x;
    return(atom);
}


/*************************************************************************
*   Write Goal.								 *
*************************************************************************/

static write_priority()
{
    if(priority != trace_last_priority){
	printf(">>>>> Priority: %d <<<<<\n", priority);
	trace_last_priority = priority;
    }
}

static write_mode(mode, code, grec)
    int mode;
    OBJ *code;
    GOAL_RECORD *grec;
{
    int	 p_t_mode, g_t_mode;
    switch(mode){
      case GATE_EXEC:  printf("Call"); break;
      case GATE_DEQU:  printf("CALL"); break;
      case GATE_SUSP:  printf("SUSP"); break;
      case GATE_SPRI:  printf("Susp"); break;
      case GATE_RESU:  printf("RESU"); break;
      case GATE_SWAP:  printf("SWAP"); break;
      case GATE_FAIL:  printf("FAIL"); break;
    }
    p_t_mode = GetPredicateDebug(code);	    /* See klb.h */
    if(p_t_mode&PREDICATE_SPY_ON){
	putchar('*');
    }else{
	putchar(' ');
    }
    if(mode&(GATE_CALL|GATE_FAIL)){
	g_t_mode = goal_debug_status;
    }else{
	g_t_mode = grec->debug;
    }
    if(g_t_mode&SPIED_GOAL){
	putchar('$');
    }else{
	putchar(' ');
    }
    printf(": ");
}

write_goal_record(goal)
    GOAL_RECORD *goal;
{
    write_goal(goal->code, goal->argn, goal->args, goal->parent,
	       PRINT_LENGTH, PRINT_DEPTH);
    putchar('\n');
}

write_goal(code, an, as, prec, pl, pd)
    OBJ *code;
    int an , pl , pd;
    CELL *as;
    PARENT_RECORD *prec;
{
    int i;

    printf("[%04d]", prec->id);
    if(IsNativeCode(code)){
	unsigned int mod, pred, arity;
	function_to_mod_pred_arity(code, &mod, &pred, &arity);
	printf("%s:%s", atom_name(mod), atom_name(pred));
    }else{
	printf("%s:%s", atom_name(GetModuleName(GetModuleTop(code))),
			atom_name(GetPredicateName(code)));
    }
    if(an != 0) putchar('(');
    for(i=0; i<an; i++){
	print_term2(as++, pl,pd);
	if(i!=(an-1)) putchar(',');
    }
    if(an != 0) putchar(')');
    putchar('.');
    fflush(stdout);
}


/*************************************************************************
*   Write Queue.							 *
*************************************************************************/

#define DisplayGoal(grec, count) {\
    CELL  *c;\
    if((count = display_queue_more(count)) < 0) return(YES);\
    Dereference2(&(grec->priority), c);\
    if(Typeof(c) == INT){\
	printf("  %3d: ", ((unsigned)Valueof(c))>>PRIORITY_SIFT_WIDTH);\
    }else{\
	printf("   ??: ");\
    }\
    write_goal_record(grec);\
}
	       
static int display_ready_queues(priority)
    int	 priority;
{
    READY_QUEUE_BACKET *r_queue;
    GOAL_RECORD	 *grec;
    int	 f, count;
    f = NO;
    count = 0;
    if(priority >= 0 && priority < MAX_PRIORITY){
	grec = ready_queue_array[priority].head;
	while(grec != NULL){
	    DisplayGoal(grec, count);
	    grec = GoalQueuePt(grec);
	    f = YES;
	}
    }else if(priority < 0){
	r_queue = highest;
	while(r_queue != NULL){
	    grec = r_queue->head;
	    while(grec != NULL){
		DisplayGoal(grec, count);
		grec = GoalQueuePt(grec);
		f = YES;
	    }
	    r_queue = r_queue->lower;
	}
    }
    return(f);
}

int display_suspended_goals(mmm)
    CELL *mmm;
{
    GOAL_RECORD *hgr;
    SUSPENSION_RECORD *sr;
    int count;
    count = 0;
    for(;;){
	switch(Typeof(mmm)){
	  case HOOK:
	    hgr = Goalof(mmm);
	    DisplayGoal(hgr, count);
	    mmm = &(hgr->pt);
	    break;
	  case MHOOK:
	    sr = Suspof(mmm);
	    DisplayGoal(sr->suspended, count);
	    mmm = &(sr->forward);
	    break;
	  default:
	    return(YES);
	}
    }
}

static display_merge_tree(mmm)
    CELL *mmm;
{
    CELL *out;
    int ctr, count;
    count = 0;
    for(;;){
	if((count = display_queue_more(count)) < 0) break;
	out = MergerTailof(mmm);
	ctr = Mergerof(mmm)->count;
	printf("COUNT: %d    OUTPUT: ", ctr);
	print_term2(out, PRINT_LENGTH, PRINT_DEPTH);
	printf("\n");
	Dereference2(out, mmm);
	if(Typeof(mmm) != MGHOK) break;
    }
}

static int display_queue_more(count)
    int	 count;
{
    CHAR buf[2];
    if(++count <= 10) return(count);
    if(read_console("    more?:", buf, 2) < 0) exit_pdss(1);
    if(*buf == 0 || *buf == 'y' || *buf == 'Y') return(1);
    return(-1);
}
