/* l2xidbug.c Interactive SLD debugging routines for LTX2X interpreter */
/*  Written by: Peter Wilson, CUA  pwilson@cme.nist.gov                */
/*  This code is partly based on algorithms presented by Ronald Mak in */
/*  "Writing Compilers & Interpreters", John Wiley & Sons, 1991        */

#include <stdio.h>
#include "l2xicmon.h"
#include "l2xierr.h"
#include "l2xiscan.h"
#include "l2xisymt.h"
#include "l2xiexec.h"
#include "l2xiidbg.h"

#define MAX_BREAKS 16
#define MAX_WATCHES 16
#define COMMAND_QUERY "Command? "

/* EXTERNALS */

extern int level;
extern SYMTAB_NODE_PTR symtab_display[];
extern STACK_ITEM_PTR tos;

extern int line_number;
extern int buffer_offset;
extern BOOLEAN print_flag;

extern ICT *code_segmentp;
extern ICT *statement_startp;
extern int ctoken;
extern int exec_line_number;
extern int isynt_error_count;

extern char *bufferp;
extern int ch;
extern char source_buffer[];
extern char word_string[];
extern int token;
extern LITERAL literal;
extern BOOLEAN block_flag;

extern ICT *code_buffer;
extern ICT *code_bufferp;
extern ICT *code_segmentp;

extern BOOLEAN is_value_undef();

/* GLOBALS */

FILE *console;

BOOLEAN debugger_command_flag,    /* TRUE during debug command */
        halt_flag,                /* TRUE to pause for debug command */
        trace_flag,               /* TRUE to trace statement */
        step_flag,                /* TRUE to single-step */
        entry_flag,               /* TRUE to trace routine entry */
        exit_flag,                /* TRUE to trace routine exit */
        traceall_flag,            /* TRUE to trace everything */
        stack_flag;               /* TRUE to watch the stack */

int break_count;                  /* count of breakpoints */
int break_list[MAX_BREAKS];       /* list of breakpoints */

int watch_count;                  /* count of watches */
SYMTAB_NODE_PTR watch_list[MAX_WATCHES];  /* list of watches */

typedef struct {                  /* watch structure */
  SYMTAB_NODE_PTR watch_idp;      /* id node watched variable */
  BOOLEAN         store_flag;     /* TRUE to trace stores */
  BOOLEAN         fetch_flag;     /* TRUE to trace fetches */
} WATCH_STRUCT, *WATCH_STRUCT_PTR;

/* char *symbol_strings[EOTC]; */
/* array of the strings which form tokens */
char *symbol_strings[] = {
#define sctc(a, b, c) c,
#include "l2xisctc.h"
#undef sctc
};

/* array of strings which corresponding to form types */
char *form2str[] = {
#define fotc(a, b, c, d) d,
#define sotc(a, b, c, d)
#define sftc(a, b, c, d) d,
#include "l2xisftc.h"
#undef fotc
#undef sotc
#undef sftc
};

/* array of strings which corresponding to stack types */
char *stack2str[] = {
#define fotc(a, b, c, d)
#define sotc(a, b, c, d) b,
#define sftc(a, b, c, d) b,
#include "l2xisftc.h"
#undef fotc
#undef sotc
#undef sftc
};

/********************************************************************/
/* init_debugger()    Initialise interactive debugger               */

init_debugger()
{
  int i;

  if (SLD_OFF) return;

  /* initialise the globals */
/*  console = fopen("CON", "r"); */
  console = stdin;
  /* init_symbol_strings(); */
 /*  code_buffer = alloc_bytes(MAX_SOURCE_LINE_LENGTH + 1); */

   print_flag = FALSE;
   halt_flag = block_flag = TRUE;
   debugger_command_flag = trace_flag = step_flag
			 = entry_flag = exit_flag
			 = FALSE;
   traceall_flag = stack_flag = FALSE;

   break_count = 0;
   for (i = 0; i <MAX_BREAKS; i++) break_list[i] = 0;

   watch_count = 0;
   for (i = 0; i <MAX_WATCHES; i++) watch_list[i] = NULL;

 }                                              /* end init_debugger */
 /********************************************************************/



 /********************************************************************/
 /* read_debugger_command() Read and process a user's debug command  */

 read_debugger_command()
 {
   BOOLEAN done = FALSE;
   entry_debug("read_debugger_command");

   do {
     printf("\n%s", COMMAND_QUERY);

     /* read in comand and replace final \nEOS with ;;EOS */
     bufferp = fgets(source_buffer, MAX_SOURCE_LINE_LENGTH, console);
     strcpy(&source_buffer[strlen(source_buffer) - 1], ";;\0");

     buffer_offset = 0;
     ch = *bufferp++;
     buffer_offset++;
     code_bufferp = code_buffer;
     isynt_error_count = 0;

     get_token();

     /* process the command */
     switch (token) {
       case SEMICOLON: {
	 done = TRUE;
	 break;
       }
       case IDENTIFIER: {
	 execute_debugger_command();
	 break;
       }
     }
     if (token != SEMICOLON) {
       error(UNEXPECTED_TOKEN);
     }
   } while (!done); /* end do */

   debugger_command_flag = FALSE;
   exit_debug("read_debugger_command");

 }                                      /* end read_debugger_command */
 /********************************************************************/



 /********************************************************************/
 /* execute_debugger_command()  Execute a debugger command           */

 execute_debugger_command()
 {
   WATCH_STRUCT_PTR wp;
   WATCH_STRUCT_PTR allocate_watch();

   if (strcmp(word_string, "trace") == 0) {
     trace_flag = TRUE;
     step_flag = FALSE;
     get_token();
   }
   else if (strcmp(word_string, "untrace") == 0) {
     trace_flag = FALSE;
     get_token();
   }
   else if (strcmp(word_string, "step") == 0) {
     step_flag = TRUE;
     trace_flag = FALSE;
     get_token();
   }
   else if (strcmp(word_string, "unstep") == 0) {
     step_flag = FALSE;
     get_token();
   }
   else if (strcmp(word_string, "break") == 0) {
     set_breakpoint();
   }
   else if (strcmp(word_string, "unbreak") == 0) {
     remove_breakpoint();
   }
   else if (strcmp(word_string, "entry") == 0) {
     entry_flag = TRUE;
     get_token();
   }
   else if (strcmp(word_string, "unentry") == 0) {
     entry_flag = FALSE;
     get_token();
   }
   else if (strcmp(word_string, "exit") == 0) {
     exit_flag = TRUE;
     get_token();
   }
   else if (strcmp(word_string, "unexit") == 0) {
     exit_flag = FALSE;
     get_token();
   }
   else if (strcmp(word_string, "watch") == 0) {
     wp = allocate_watch();
     if (wp != NULL) {
       wp->store_flag = TRUE;
       wp->fetch_flag = TRUE;
     }
   }
   else if (strcmp(word_string, "unwatch") == 0) {
     remove_watch();
   }
   else if (strcmp(word_string, "store") == 0) {
     wp = allocate_watch();
     if (wp != NULL) {
       wp->store_flag = TRUE;
     }
   }
   else if (strcmp(word_string, "fetch") == 0) {
     wp = allocate_watch();
     if (wp != NULL) {
       wp->fetch_flag = TRUE;
     }
   }
   else if (strcmp(word_string, "show") == 0) {
     show_value();
   }
   else if (strcmp(word_string, "assign") == 0) {
     assign_variable();
   }
   else if (strcmp(word_string, "where") == 0) {
     print_statement();
     get_token();
   }
   else if (strcmp(word_string, "kill") == 0) {
     printf("Program killed.\n");
     exit(0);
   }

   else if (strcmp(word_string, "traceall") == 0) {
     traceall_flag = TRUE;
     get_token();
   }
   else if (strcmp(word_string, "untraceall") == 0) {
     traceall_flag = FALSE;
     get_token();
   }
   else if (strcmp(word_string, "stack") == 0) {
     stack_flag = TRUE;
     stack_debug();
     get_token();
   }
   else if (strcmp(word_string, "unstack") == 0) {
     stack_flag = FALSE;
     get_token();
   }
   return;
 }                                   /* end execute_debugger_command */
 /********************************************************************/


 /* TRACING ROUTINES */



 /********************************************************************/
 /* trace_statement_execution() Called just before the execution     */
 /*                             of each statement                    */

 trace_statement_execution()
 {
   if (SLD_OFF) return;

   if (traceall_flag) {
     sprintf(dbuffer, ">>  Stmt %d\n", exec_line_number);
     log_print(dbuffer);
   }

   if (break_count > 0) {
     int i;

     /* check if this statement is a breakpoint */
     for (i = 0; i < break_count; i++) {
       if (exec_line_number == break_list[i]) {
	 printf("\nBreakpoint");
	 print_statement();
	 halt_flag = TRUE;
	 break;
       }
     }
   }

   /* pause to read debugger command */
   if (halt_flag) {
     read_debugger_command();
     halt_flag = step_flag;
   }

   /* if single stepping, print the current statement */
   /* if tracing, print the current line number */
   if (step_flag) print_statement();
   if (trace_flag && !traceall_flag) print_line_number();

 }                                  /* end trace_statement_execution */
 /********************************************************************/



 /********************************************************************/
 /* trace_routine_entry(idp)  Called at entry to a routine           */

 trace_routine_entry(idp)
 SYMTAB_NODE_PTR idp;                       /* routine id */
 {
   if (SLD_OFF) return;

   if (traceall_flag) {
     sprintf(dbuffer, ">> Entering routine %s\n", idp->name);
     log_print(dbuffer);
   }
   else if (entry_flag) {
     printf("\nEntering %s\n", idp->name);
   }

 }                                        /* end trace_routine_entry */
 /********************************************************************/



 /********************************************************************/
 /* trace_routine_exit(idp)  Called at exit from a routine           */

 trace_routine_exit(idp)
 SYMTAB_NODE_PTR idp;                       /* routine id */
 {
   if (SLD_OFF) return;

   if (traceall_flag) {
     sprintf(dbuffer, ">> Exiting routine %s\n", idp->name);
     log_print(dbuffer);
   }
   else if (exit_flag) {
     printf("\nExiting %s\n", idp->name);
   }

 }                                         /* end trace_routine_exit */
 /********************************************************************/



 /********************************************************************/
 /* trace_data_store(idp, idp_tp, targetp, target_tp)  Called just   */
 /*            before storing data in a variable                     */

 trace_data_store(idp, idp_tp, targetp, target_tp)
 SYMTAB_NODE_PTR idp;                /* id of target variable */
 TYPE_STRUCT_PTR idp_tp;             /* ptr to idp's type */
 STACK_ITEM_PTR targetp;             /* ptr to target location */
 TYPE_STRUCT_PTR target_tp;          /* ptr to target's type */
 {
   if (SLD_OFF) return;

   if (traceall_flag) {
     sprintf(dbuffer, ">>  %s", idp->name);
     log_print(dbuffer);
     if (idp_tp->form == ARRAY_FORM ||
         idp_tp->form == BAG_FORM ||
         idp_tp->form == LIST_FORM ||
         idp_tp->form == SET_FORM ) {
       log_print("[*]");
     }
     else if (idp_tp->form == ENTITY_FORM) {
       log_print(".*");
     }
     print_data_value_debug(targetp, target_tp, ":=");
   }

   /* check if variable is being watched for stores */
   else if ((idp->info != NULL) && ((WATCH_STRUCT_PTR) idp->info)->store_flag) {
     printf("\nAt %d: Store %s", exec_line_number, idp->name);
     if (idp_tp->form == ARRAY_FORM ||
         idp_tp->form == BAG_FORM ||
         idp_tp->form == LIST_FORM ||
         idp_tp->form == SET_FORM ) {
       printf("[*]");
     }
     else if (idp_tp->form == ENTITY_FORM) {
       printf(".*");
     }
     print_data_value(targetp, target_tp, ":=");
   }

  return;
 }                                           /* end trace_data_store */
 /********************************************************************/



 /********************************************************************/
 /* trace_data_fetch(idp, tp, datap)     Called just                 */
 /*            before fetching data from a variable                  */

 trace_data_fetch(idp, tp, datap)
 SYMTAB_NODE_PTR idp;                /* id of target variable */
 TYPE_STRUCT_PTR tp;                 /* ptr to idp's type */
 STACK_ITEM_PTR datap;               /* ptr to data */
 {
   TYPE_STRUCT_PTR idp_tp = idp->typep;

   if (SLD_OFF) return;


   if (traceall_flag) {
     sprintf(dbuffer, ">>  %s", idp->name);
     log_print(dbuffer);
     if (idp_tp->form == ARRAY_FORM ||
         idp_tp->form == BAG_FORM ||
         idp_tp->form == LIST_FORM ||
         idp_tp->form == SET_FORM ) {
       log_print("[*]");
     }
     else if (idp_tp->form == ENTITY_FORM) {
       log_print(".*");
     }
     print_data_value_debug(datap, tp, "=");
   }

   /* check if variable is being watched for fetches */
   else if ((idp->info != NULL) && ((WATCH_STRUCT_PTR) idp->info)->fetch_flag) {
     printf("\nAt %d: Fetch %s", exec_line_number, idp->name);
     if (idp_tp->form == ARRAY_FORM ||
         idp_tp->form == BAG_FORM ||
         idp_tp->form == LIST_FORM ||
         idp_tp->form == SET_FORM ) {
       printf("[*]");
     }
     else if (idp_tp->form == ENTITY_FORM) {
       printf(".*");
     }
     print_data_value(datap, tp, "=");
   }

  return;
 }                                           /* end trace_data_fetch */
 /********************************************************************/


 /* PRINTING ROUTINES */


 /********************************************************************/
 /* print_statement()  Uncrunch and print a statement                */

 print_statement()
 {
   int tk;                           /* token code */
   BOOLEAN done = FALSE;
   ICT *csp = statement_startp;
/*   entry_debug("print_statement"); */

   printf("\nAt %3d:", exec_line_number);

   do {
     switch (tk = *csp++) {
       case SEMICOLON:
       case END:
       case ELSE:
       case THEN:
       case UNTIL:
       case BEGIN:
       case OF:
       case STATEMENT_MARKER: {
	 done = TRUE;
	 break;
       }
       default: {
	 done = FALSE;
	 switch(tk) {
	   case ADDRESS_MARKER: {
	     csp++;
	     break;
	   }
	   case IDENTIFIER:
	   case NUMBER_LITERAL:
	   case STRING_LITERAL: {
	     SYMTAB_NODE_PTR np = *((SYMTAB_NODE_PTR *) csp);
	     printf(" %s", np->name);
	     csp++;
	     break;
	   }
	   default: {
	     printf(" %s", symbol_strings[tk]);
	     break;
	   }
	 } /* end switch */
       }
     } /* end switch */
   } while (!done); /* end do */

   printf("\n");
/*   exit_debug("print_statement"); */

 }                                            /* end print_statement */
 /********************************************************************/



 /********************************************************************/
 /* print_line_number()   Print the current line number              */

 print_line_number()
 {

   printf("<%d>", exec_line_number);

 }                                          /* end print_line_number */
 /********************************************************************/



 /********************************************************************/
 /* print_data_value(datap, tp, str)  Print a data value             */

 print_data_value(datap, tp, str)
 STACK_ITEM_PTR datap;             /* ptr to data value */
 TYPE_STRUCT_PTR tp;               /* ptr to type of stack item */
 char *str;                        /* " = "  or  " := " */
 {
    STACK_TYPE stype;
    LOGICAL_REP log;
    TYPE_FORM form;

    form = tp->form;

    if (form == ARRAY_FORM ||
        form == BAG_FORM ||
        form == LIST_FORM ||
        form == SET_FORM ||
        form == ENTITY_FORM ) {
      printf(" %s <%s>\n", str, form2str[form]);
      return;
    }

    stype = get_stackval_type(datap);

   if (stype == STKUDF) {
     printf(" %s %c\n", str, get_undef(datap));
   }
 
   else if (stype == STKINT) {
     printf(" %s %d\n", str, get_integer(datap));
   }
   else if (stype == STKREA) {
     printf(" %s %0.6g\n", str, get_real(datap));
   }
   else if (stype == STKLOG) {  
    log = get_logical(datap);
    if (log == TRUE_REP) {
       printf(" %s %s\n", str, "TRUE");
    }
    else if (log == FALSE_REP) {
       printf(" %s %s\n", str, "FALSE");
    }
    else {
       printf(" %s %s\n", str, "UNKNOWN");
    }
  }
  else if (stype == STKSTR) {
    printf(" %s %s\n", str, get_stacked_string(datap));
  }

  return;


 }                                           /* end print_data_value */
 /********************************************************************/


 /********************************************************************/
 /* print_data_value_debug(datap, tp, str)  Print a data value       */

 print_data_value_debug(datap, tp, str)
 STACK_ITEM_PTR datap;             /* ptr to data value */
 TYPE_STRUCT_PTR tp;               /* ptr to type of stack item */
 char *str;                        /* " = "  or  " := " */
 {
    STACK_TYPE stype;
    LOGICAL_REP log;
    TYPE_FORM form;

    form = tp->form;

    if (form == ARRAY_FORM ||
        form == BAG_FORM ||
        form == LIST_FORM ||
        form == SET_FORM ||
        form == ENTITY_FORM ) {
      sprintf(dbuffer, " %s <%s>\n", str, form2str[form]);
      log_print(dbuffer);
      return;
    }

    stype = get_stackval_type(datap);

   if (stype == STKUDF) {
     sprintf(dbuffer, " %s %c\n", str, get_undef(datap));
     log_print(dbuffer);
   }
 
   else if (stype == STKINT) {
     sprintf(dbuffer, " %s %d\n", str, get_integer(datap));
     log_print(dbuffer);
   }
   else if (stype == STKREA) {
     sprintf(dbuffer, " %s %0.6g\n", str, get_real(datap));
     log_print(dbuffer);
   }
   else if (stype == STKLOG) {  
    log = get_logical(datap);
    if (log == TRUE_REP) {
       sprintf(dbuffer, " %s %s\n", str, "TRUE");
    }
    else if (log == FALSE_REP) {
       sprintf(dbuffer, " %s %s\n", str, "FALSE");
    }
    else {
       sprintf(dbuffer, " %s %s\n", str, "UNKNOWN");
    }
    log_print(dbuffer);
  }
  else if (stype == STKSTR) {
    sprintf(dbuffer, " %s %s\n", str, get_stacked_string(datap));
    log_print(dbuffer);
  }

  return;

 }                                     /* end print_data_value_debug */
 /********************************************************************/


 /* BREAKPOINTS AND WATCHES */


 /********************************************************************/
 /* set_breakpoint()  Set a breakpoint, or print all breakpoints in  */
 /*                   the break list                                 */

 set_breakpoint()
 {
   int i, number;

   get_token();

   switch (token) {
     case SEMICOLON: {  /* no line number --- list all breakpoints */

       printf("Statement breakpoints at:\n");
       for (i = 0; i < break_count; i++) {
	 printf("%5d\n", break_list[i]);
       }
       break;
     }

     case NUMBER_LITERAL: {    /* set breakpoint by appending to list */

       if (literal.type == INTEGER_LIT) {
	 number = literal.value.integer;
	 if ((number > 0) && (number <= line_number)) {
	   if (break_count < MAX_BREAKS) {
	     break_list[break_count] = number;
	     ++break_count;
	   }
	   else {
	     printf("Break list is full.\n");
	   }
	 }
	 else {
	   error(VALUE_OUT_OF_RANGE);
	 }
       }
       else {
	 error(UNEXPECTED_TOKEN);
       }
       get_token();
       break;
     }
   } /* end switch */

 }                                             /* end set_breakpoint */
 /********************************************************************/



 /********************************************************************/
 /* remove_breakpoint()  Remove a specified breakpoint, or all       */

 remove_breakpoint()
 {
   int i, j, number;

   get_token();

   switch (token) {
     case SEMICOLON: {  /* no line number --- remove all breakpoints */

       for (i = 0; i < break_count; i++) {
	 break_list[i] = 0;
       }
       break_count = 0;
       break;
     }

     case NUMBER_LITERAL: {    /* remove breakpoint from list, and move others up */

       if (literal.type == INTEGER_LIT) {
	 number = literal.value.integer;
	 if (number > 0) {
	   for (i = 0; i < break_count; i++) {
	     if (break_list[i] == number) {
	       break_list[i] = 0;
	       --break_count;

	       for (j = i; j < break_count; j++) {
		 break_list[j] = break_list[j+1];
	       }
	     }
	   }
	 }
       }
       else {
	 error(VALUE_OUT_OF_RANGE);
       }
       get_token();
       break;
     }
   } /* end switch */

 }                                          /* end remove_breakpoint */
 /********************************************************************/



 /********************************************************************/
 /* allocate_watch()  Return a pointer to a watch structure,         */
 /*                   or print all variables being watched           */

 WATCH_STRUCT_PTR allocate_watch()
 {
   int i;
   SYMTAB_NODE_PTR idp;
   WATCH_STRUCT_PTR wp;

   get_token();

   switch (token) {
     case SEMICOLON: {    /* no variable, print them all */
       printf("Variables being watched:\n");

       for (i = 0; i < watch_count; i++) {
	 idp = watch_list[i];
	 if (idp != NULL) {
	   wp = (WATCH_STRUCT_PTR) idp->info;
	   printf("%16s  ", idp->name);
	   if (wp->store_flag) printf(" (store)");
	   if (wp->fetch_flag) printf(" (fetch)");
	   printf("\n");
	 }
       }
       return(NULL);
     }

     case IDENTIFIER: {
       search_and_find_all_symtab(idp);
       get_token();

       switch (idp->defn.key) {
	 case UNDEFINED: {
	   return(NULL);
	 }
	 case CONST_DEFN:
	 case VAR_DEFN:
	 case ATTRIBUTE_DEFN:
	 case VALPARM_DEFN:
	 case VARPARM_DEFN: {
	   if (idp->info != NULL) {  /* being watched, return ptr to structure */
	     return((WATCH_STRUCT_PTR) idp->info);
	   }
	   else if (watch_count < MAX_WATCHES)  {     /* a new structure */
	     wp = alloc_struct(WATCH_STRUCT);
	     wp->store_flag = FALSE;
	     wp->fetch_flag = FALSE;

	     idp->info = (char *) wp;
	     watch_list[watch_count] = idp;
	     watch_count++;
	     return(wp);
	   }
	   else {
	     printf("Watch list is full.\n");
	     return(NULL);
	   }
	 }
	 default: {
	   error(INVALID_IDENTIFIER_USAGE);
	   return(NULL);
	 }
       } /* end switch */
       break;
     }
   } /* end switch */

 }                                             /* end allocate_watch */
 /********************************************************************/



 /********************************************************************/
 /* remove_watch()    Remove a variable from the watch list,         */
 /*                   or remove all variables being watched          */

 remove_watch()
 {
   int i, j;
   SYMTAB_NODE_PTR idp;
   WATCH_STRUCT_PTR wp;

   get_token();

   switch (token) {
     case SEMICOLON: {    /* no variable, remove them all */

       for (i = 0; i < watch_count; i++) {
	 if ((idp = watch_list[i]) != NULL) {
	   wp = (WATCH_STRUCT_PTR) idp->info;
	   watch_list[i] = NULL;
	   idp->info = NULL;
	   free(wp);
	 }
       }
       watch_count = 0;
       break;
     }

     case IDENTIFIER: {    /* remove it from the list and move other up */
       search_and_find_all_symtab(idp);
       get_token();

       if ((idp != NULL) && (idp->info != NULL)) {
	 wp = (WATCH_STRUCT_PTR) idp->info;
	 for (i = 0; i < watch_count; i++) {
	   if (watch_list[i] == idp) {
	     watch_list[i] = NULL;
	     idp->info = NULL;
	     free(wp);
	     --watch_count;
	     for (j = i; j < watch_count; j++) {
	       watch_list[j] = watch_list[j + 1];
	     }
	     break;
	   }
	 }
       }
       break;
     }
   } /* end switch */

 }                                               /* end remove_watch */
 /********************************************************************/


 /* SHOW and ASSIGN */


 /********************************************************************/
 /* show-value()   Print the value of an expression                  */

 show_value()
 {

   get_token();

   switch (token) {
     case SEMICOLON: {
       error(INVALID_EXPRESSION);
       break;
     }  
     default: {   /* parse and execute expression from code buffer */
       TYPE_STRUCT_PTR expression();
       TYPE_STRUCT_PTR tp = expression();    /* parse */
       ICT *save_code_segmentp = code_segmentp;
       int save_ctoken = ctoken;

       if (isynt_error_count > 0) break;

       /* switch to the code buffer */
       code_segmentp = code_buffer + 1;
       get_ctoken();
       exec_expression();                  /* execute */

       /* print and then pop the value */
       if ((tp->form == ARRAY_FORM) || 
           (tp->form == BAG_FORM) || 
           (tp->form == LIST_FORM) || 
           (tp->form == SET_FORM) || 
           (tp->form == ENTITY_FORM)) {
	 print_data_value(get_address(tos), tp, " ");
       }
       else {
	 print_data_value(tos, tp, " ");
       }
       pop();

       /* resume the code segment */
       code_segmentp = save_code_segmentp;
       ctoken = save_ctoken;
       break;
     }
   } /* end switch */

 }                                                 /* end show_value */
 /********************************************************************/



 /********************************************************************/
 /* assign_variable()  Exexcute an assignment statement              */

 assign_variable()
 {

   get_token();

   switch (token) {
     case SEMICOLON: {
       error(MISSING_VARIABLE);
       break; 
     }
     case IDENTIFIER : {  /* parse and execute the assignment statement from code buffer */
       SYMTAB_NODE_PTR idp;
       ICT *save_code_segmentp = code_segmentp;
       int save_ctoken = ctoken;

       search_and_find_all_symtab(idp);

       assignment_statement(idp);  /* parse */
       if (isynt_error_count > 0) break;

       /* switch to the code buffer */
       code_segmentp = code_buffer + 1;
       get_ctoken();
       idp = get_symtab_cptr();
       exec_assignment_statement(idp);     /* execute */

       /* resume the code segment */

       code_segmentp = save_code_segmentp;
       ctoken = save_ctoken;
       break;
     }
   } /* end switch */

 }                                            /* end assign_variable */
 /********************************************************************/


 /* STACK */


 /********************************************************************/
 /* stack_debug()  Print runtime stack                               */

 extern STACK_ITEM *stack;                 /* runtime stack */
 extern STACK_ITEM_PTR tos;                /* top of stack */
 extern STACK_ITEM_PTR stack_frame_basep;  /* ptr to stack frame base */
 extern STACK_ITEM_PTR maxtos;             /* current max top of stack */

 stack_debug()
 {
   STACK_ITEM_PTR basep = stack;           /* base of stack */
   STACK_ITEM_PTR i;

   if (!stack_flag) return;

   log_print("\n  The runtime stack with: ");
   stack_frame_debug();
   for (i = basep; i <= tos; i++) {
     stack_item_debug(i);
   }

   return;
 }                                                /* end stack_debug */
 /********************************************************************/



 /********************************************************************/
 /* tos_debug()  Print top of runtime stack                          */

 tos_debug()
 {

   if (!stack_flag) return;

   log_print("  Top of runtime stack.");
   stack_item_debug(tos);
   return;
 }                                                  /* end tos_debug */
 /********************************************************************/


 /********************************************************************/
 /* stack_access_debug(s, sptr)  Print stack access kind             */

 stack_access_debug(s, sptr)
 char s[];               /* access kind */
 STACK_ITEM_PTR sptr;    /* stack position */
 {

   if (!stack_flag) return;

   sprintf(dbuffer, "    %-7s ==>", s);
   log_print(dbuffer);
   stack_item_debug(sptr);

   if (sptr > maxtos) {     /* probably looking at data area */
     log_print("  Accessed data area:\n");
     data_item_debug(sptr);
   }

   return;
 }                                         /* end stack_access_debug */
 /********************************************************************/



 /********************************************************************/
 /* stack_item_debug(sptr)  Print a runtime stack item               */

 stack_item_debug(sptr)
 STACK_ITEM_PTR sptr;             /* ptr to stack item */
 {
    STACK_TYPE stype;
   if (!stack_flag) return;

   if ((sptr < stack) || (sptr > maxtos)) { /* out of stack range */
     runtime_warning(INVALID_STACK_ACCESS);
   }

   stype = sptr->type;
   switch (stype) {
     case STKINT: {
       sprintf(dbuffer, "  (Entry %d : %s is %d)\n",
		       sptr, stack2str[stype], sptr->value.integer);
       log_print(dbuffer);
       break;
     }
     case STKREA: {
       sprintf(dbuffer, "  (Entry %d : %s is    %f)\n",
		       sptr, stack2str[stype], sptr->value.real);
       log_print(dbuffer);
       break;
     }
     case STKLOG: {
       sprintf(dbuffer, "  (Entry %d : %s is ",
		       sptr, stack2str[stype]);
       log_print(dbuffer);
       if (sptr->value.integer == FALSE_REP) sprintf(dbuffer, "FALSE)\n");
       else if (sptr->value.integer == TRUE_REP) sprintf(dbuffer, "TRUE)\n");
       else sprintf(dbuffer, "UNKNOWN)\n");
       log_print(dbuffer);
       break;
     }
     case STKSTR: {
       sprintf(dbuffer, "  (Entry %d : %s is %d)\n",
		       sptr, stack2str[stype], sptr->value.string);
       log_print(dbuffer);
       break;
     }
     case STKARY: 
     case STKADD: {
       sprintf(dbuffer, "  (Entry %d : %s is %d)\n",
		       sptr, stack2str[stype], sptr->value.address);
       log_print(dbuffer);
       break;
     }
     case STKUDF: {            /* undefined */
       sprintf(dbuffer, "  (Entry %d : %s is '%c')\n",
		       sptr, stack2str[stype], sptr->value.integer);
       log_print(dbuffer);
       break;
     }
     case STKBAG: 
     case STKLST:
     case STKSET: {
       sprintf(dbuffer, "  (Entry %d : %s is %d)\n",
		       sptr, stack2str[stype], sptr->value.head);
       log_print(dbuffer);
       break;
     }
     case STKENT: {
       sprintf(dbuffer, "  (Entry %d : %s is %d)\n",
		       sptr, stack2str[stype], sptr->value.address);
       log_print(dbuffer);
       break;
     }
     default: {
       sprintf(dbuffer, "  (Entry %d : unknown type (%d))\n",
		       sptr, sptr->type);
       log_print(dbuffer);
       break;
     }
   }
   return;
 }                                           /* end stack_item_debug */
 /********************************************************************/



 /********************************************************************/
 /* data_item_debug(sptr)  Print data of array/entity item           */

 data_item_debug(sptr)
 STACK_ITEM_PTR sptr;             /* ptr to 'start' of data item */
 {
   STACK_TYPE kind;
   STACK_ITEM_PTR aptr = sptr;
   int n = 1;
   int maxn = 20;               /* max number of elements to be printed */

   if (!stack_flag) return;

   kind = aptr->type;
   while ( (kind >= STKINT) && (kind <= STKADD) && (n <= maxn)  ) {
     stack_item_debug(aptr);
     aptr++;
     n++;
     kind = aptr->type;
   }

   return;
 }                                            /* end data_item_debug */
 /********************************************************************/



 /********************************************************************/
 /* stack_frame_debug()  print the stack frame base pointer          */

 stack_frame_debug()
 {

   if (!stack_flag) return;

   sprintf(dbuffer, "  (Stack frame base at %d)\n", stack_frame_basep);
   log_print(dbuffer);
   return;
 }                                          /* end stack_frame_debug */
 /********************************************************************/



 /********************************************************************/
 /* expression_type_debug(tptr)  print type of type                  */

 extern TYPE_STRUCT_PTR integer_typep, real_typep,
			boolean_typep;
 extern TYPE_STRUCT_PTR logical_typep, string_typep, binary_typep,
			generic_typep, any_typep;

 expression_type_debug(tptr)
 TYPE_STRUCT_PTR tptr;            /* pointer to type structure */
 {


   if (!stack_flag) return;

   if (tptr == integer_typep) {
     log_print("    Type is: INTEGER TYPE\n");
     return;
   }
   else if (tptr == real_typep) {
     log_print("    Type is: REAL TYPE\n");
     return;
   }
   else if (tptr == boolean_typep) {
     log_print("    Type is: BOOLEAN TYPE\n");
     return;
   }
   else if (tptr == logical_typep) {
     log_print("    Type is: LOGICAL TYPE\n");
     return;
   }
   else if (tptr == string_typep) {
     log_print("    Type is: STRING TYPE\n");
     return;
   }
   else if (tptr == binary_typep) {
     log_print("    Type is: BINARY TYPE\n");
     return;
   }
   else if (tptr == generic_typep) {
     log_print("    Type is: GENERIC TYPE\n");
     return;
   }
   else if (tptr == any_typep) {
     log_print("    Type is: INDETERMINATE TYPE\n");
     return;
   }

   switch (tptr->form) {
     case NO_FORM: {
       log_print("    Type is: NO FORM\n");
       return;
     }
     case SCALAR_FORM: {
       log_print("    Type is: SCALAR FORM\n");
       return;
     }
     case ENUM_FORM: {
       log_print("    Type is: ENUM FORM\n");
       return;
     }
     case SUBRANGE_FORM: {
       log_print("    Type is: SUBRANGE FORM\n");
       return;
     }
     case ARRAY_FORM: {
       log_print("    Type is: ARRAY of ");
       expression_type_debug(tptr->info.array.elmt_typep);
       return;
     }
     case BAG_FORM: {
       log_print("    Type is: BAG of ");
       expression_type_debug(tptr->info.dynagg.elmt_typep);
       return;
     }
     case LIST_FORM: {
       log_print("    Type is: LIST of ");
       expression_type_debug(tptr->info.dynagg.elmt_typep);
       return;
     }
     case SET_FORM: {
       log_print("    Type is: SET of ");
       expression_type_debug(tptr->info.dynagg.elmt_typep);
       return;
     }
     case ENTITY_FORM: {
       log_print("    Type is: ENTITY FORM\n");
       return;
     }
     case STRING_FORM: {
       log_print("    Type is: STRING FORM\n");
       return;
     }
     default: {
       log_print("    Type is: UNKNOWN\n");
       return;
     }


   } /* end switch */

 }                                      /* end expression_type_debug */
 /********************************************************************/