/* l2xidbug.c Interactive SLD debugging routines for LTX2X interpreter */
/*  Written by: Peter Wilson, CUA  [email protected]                */
/*  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 */
/********************************************************************/

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.