path: root/support/ltx2x/l2xistup.c

/* l2xistup  LTX2X interpreter initialisation and start up code */

#include <stdio.h>
#include "getopt.h"
#include "l2xicmon.h"
#include "l2xisymt.h"
#include "l2xiexec.h"
#include "l2xierr.h"        /* need this for MISSING_ENDCODE */
#include "l2xiscan.h"       /* need this for SEMICOLON, etc */
#include "l2xiprse.h"       /* need this for if_token_get_else_error */

#include "l2xiidbg.h"

#ifndef l2xicpr_h
#include "l2xicpr.h"        /* the before/after token lists */
#endif


/* EXTERNALS */

/* extern int exec_line_number; */
/* extern char word_string[]; */
/* extern SYMTAB_NODE_PTR symtab_display[]; */
/* extern int level; */

extern TYPE_STRUCT_PTR integer_typep, real_typep,
                       boolean_typep;
extern int exec_stmt_count;
extern STACK_ITEM *stack;
/* extern SYMTAB_NODE_PTR program(); */
extern SYMTAB_NODE_PTR create_dummy_prog();

extern int DEBUG;           /* defined in l2xlib.c */
extern int cl_debug;        /* defined in l2xlib.c */
extern int cdebug;      /* defined in l2xlib.c */
extern int edebug;      /* defined in l2xlib.c */

extern BOOLEAN executed_return;         /* TRUE iff return statement executed */

/* GLOBALS */

char THE_TITLE[] = "THE INTERPRETER";
char INT_FILE_VERSION[] = "Version 0.1";
char INT_FILE_DATE[] = "January 1997";

/* int DEBUG = 0;    debugging level */
int Dbasic = 1;   /* DEBUG >= Dbasic  -> basic debugging */
int Danalyze = 2; /* DEBUG >= Danalyze -> declaration analysis debugging */
int Dtrace = 3;   /* DEBUG >= Dtrace  -> trace routine call tree */
int Dscan = 4;    /* DEBUG >= Dscan -> source buffer debugging */
int Dtraceall = 5; /* DEBUG >= Dtraceall ->  */
int Dott = 100;   /* Hopefully, too high for all debugging */
extern int SLD_OFF; /* FALSE to enable source level debugger */

ICT *code_buffer;           /*  code buffer */
ICT *code_bufferp;          /*  code buffer ptr */

FILE *ferr;                 /* error o/p */
FILE *fcodeseg;             /* code segment o/p */
FILE *filout;               /* output file */

     /* EXTERNALS */
extern ICT *create_code_segment();
extern TYPE_STRUCT dummy_type;
extern TOKEN_CODE statement_start_list[];
extern TOKEN_CODE token;
extern TOKEN_CODE ctoken;
extern ICT *code_segmentp;
extern FILE *source_file;           /* file the scanner reads */
extern FILE *yyout;                 /* output file for LTX2X */
extern int get_ct_linenum();        /* gets current ct line number */
extern void set_ct_linenum();       /* sets current ct line number */
extern int line_number;             /* interp scanners line number */
extern FILE *filerr;                /* LTX2X's error file */


     /* FORWARDS */
/* SYMTAB_NODE_PTR create_dummy_prog(); */
void start_code();


/***************************************************************************/
/* code_setup(filtabin)  Initialise the scanner, etc then                  */
/*                    call the start_code routine to do the work.          */

SYMTAB_NODE_PTR code_setup(filtabin)
FILE *filtabin;                          /* input file */
{
  char optchar;
  int n, k;
  SYMTAB_NODE_PTR program_idp;
/*  BOOLEAN cdebug = TRUE;              if TRUE enable source Code debug */
/*  BOOLEAN edebug = TRUE;              if TRUE enable Execution debug */

              /* print the banner */
/*
*  fprintf(stdout, "\n    %s", THE_TITLE);
*  fprintf(stdout, "\n    (%s, %s)\n", INT_FILE_VERSION, INT_FILE_DATE);
*/

             /* open output log files */
/*  ferr = fopen("interp.err", "w"); */
  ferr = filerr;    /* set error file to be ltx2x's */
  fcodeseg = fopen("interp.csg", "w");

/*  fprintf(stdout, "\nLog file is interp.err\n"); */
  fprintf(stdout, "Code segment log file is interp.csg\n");

  fprintf(ferr, "Error log file for %s (%s, %s)\n", 
                                    THE_TITLE, INT_FILE_VERSION, INT_FILE_DATE);
  fprintf(ferr, "Author: Peter Wilson (Catholic University and NIST)\n");
  fprintf(ferr, "Email any comments or suggestions to: pwilson@cme.nist.gov\n\n");
  fprintf(ferr, "Code segment log file is interp.csg\n\n");

            /* set the output file */
  filout = yyout;

  
  /* set debug level for source Code */
  if (cdebug) {
    DEBUG = cl_debug;
  }
  else {
    DEBUG = 0;
  }



  /* initialise the scanner */
/*  init_scanner(argv[k]); */
  line_number = get_ct_linenum();     /* set scanner's line number counter */
  init_scanner(filtabin);

  /* initialise code buffer */
  code_buffer = alloc_array(ICT, MAX_CODE_BUFFER_SIZE);
  code_bufferp = code_buffer;
  if (DEBUG >= Dbasic) {
    sprintf(dbuffer, "Initialised: code_buffer = %d, code_bufferp = %d\n",
                      code_buffer, code_bufferp);
    debug_print(dbuffer);
  }

  /* initialise the symbol table */
  init_symtab();
  if (DEBUG >= Dbasic) {
    sprintf(dbuffer, "Initialised the symbol table\n");
    debug_print(dbuffer);
  }

  /* create an artificial program node */
  program_idp = create_dummy_prog();

  /* parse the remainder of the code */
  /* zero or more declarations, followed by zero or more statements */
  start_code(program_idp);

    /* Don't think we want this as everyting from now on is in prog scope */
/*  program_idp->defn.info.routine.local_symtab = exit_scope(); */
  program_idp->defn.info.routine.code_segment = create_code_segment();
  analyze_block(program_idp->defn.info.routine.code_segment);

  /* reset CT line number to the scanner's value */
  set_ct_linenum(line_number);
  return(program_idp);



  /* free the stack */
/*
  free(stack);
  fprintf(filout, "\n\nCompleted. %ld statements executed. \n\n",
                  exec_stmt_count);

  if (DEBUG >= Dbasic) {
    sprintf(dbuffer, "\n\n***That's all for run4\n\n");
    debug_print(dbuffer);
  }
  return(program_idp);
*/
}                                                      /* end CODE_SETUP */
/***************************************************************************/



/***************************************************************************/
/* SYMTAB_NODE_PTR create_dummy_prog()  create an artifical program node   */
/*                 much of this code comes from `program_header'           */

SYMTAB_NODE_PTR old_create_dummy_prog()
{

  SYMTAB_NODE_PTR prog_idp;

  prog_idp = alloc_struct(SYMTAB_NODE);
  /* use dummy program name */
/*  strcpy(word_string, "_PrOgRaM"); */
/*  search_and_enter_local_symtab(prog_idp); */
  prog_idp->defn.key = PROG_DEFN;
  prog_idp->defn.info.routine.key = DECLARED;
  prog_idp->defn.info.routine.parm_count = 0;
  prog_idp->defn.info.routine.total_parm_size = 0;
  prog_idp->defn.info.routine.total_local_size = 0;
  prog_idp->typep = &dummy_type;
  prog_idp->label_index = 0;

  enter_scope(NULL);
  
  prog_idp->defn.info.routine.locals = NULL;
  prog_idp->defn.info.routine.parms = NULL;

  return(prog_idp);
}                                                 /* end CREATE_DUMMY_PROG */
/***************************************************************************/


TOKEN_CODE ltx2x_start_declarations_list[] = {XCONSTANT, XLOCAL, PROCEDURE,
                                             FUNCTION, 0};

/***************************************************************************/
/* start_code(rtn_idp)  Parse the starting code, which consists of         */
/*                      declarations, followed by zero or more statements  */
/*                      ends at token ENDCODE                              */
/*                      ( similar to block in interp )                     */

void start_code(rtn_idp)
SYMTAB_NODE_PTR rtn_idp;        /* id of `program' or routine */
{

  extern BOOLEAN block_flag;

  get_token();
  if (token == ENDCODE) {
    crunch_token();
    crunch_statement_marker();
    return;
  }

  if (token_in(declaration_start_list)) {
    declarations(rtn_idp);
    /* error synchronization: Should be ; */
    synchronize(ltx2x_follow_decls_list, NULL, NULL);
  }
  else {
    skip_declarations(rtn_idp);
  }

  if (token == ENDCODE) {
    crunch_token();
    crunch_statement_marker();
    return;
  }

/*  if (token == BEGIN) {
*    crunch_token(); 
*  }
*/

  block_flag = TRUE;
  
  /* now for possibly empty list of statements */
  statement_block();
/*  if (token_in(statement_start_list)) {
*    crunch_token();
*    statements();
*  }
*/
  block_flag = FALSE;

  return;

}                                                        /* end START_CODE */
/***************************************************************************/



/***************************************************************************/
/* statements()       process a set of statements                          */
/*                  originally based on `compound_statement'               */
/*    at entry, token is (crunched) start of a statement                   */
/*    at exit, token is after closing ; of a statement                     */

statements()
{

  entry_debug("statements");
/*  get_token(); */

  while (token_in(statement_start_list)) {
    statement();
    get_token();
  }

  exit_debug("statements");
  return;

}                                                        /* end STATEMENTS */
/***************************************************************************/



/***************************************************************************/
/* statement_block()    Process a list of statements ended by END_CODE     */
/*          at entry, token is start of a statement or ENDCODE             */
/*          at exit, parsing is complete                                   */

statement_block()
{
  entry_debug("statement_block");

  if (token_in(statement_start_list)) {
    crunch_token();
    statements();
  }

  if (token != ENDCODE) {
    error(MISSING_ENDCODE);
  }
  else {
    crunch_statement_marker();
/*    crunch_token(); */
  }

  exit_debug("statement_block");
  return;
}                                                   /* end STATEMENT_BLOCK */
/***************************************************************************/





/***************************************************************************/
/* code_action(filtabin)       Parsing for CODE:                           */
/*                                                                         */

ICT *code_action(filtabin)
FILE *filtabin;                  /* the input file */
{
  extern BOOLEAN block_flag;
  entry_debug("code_action");

  /* set the file and the line number for the scanner */
  source_file = filtabin;
  line_number = get_ct_linenum();

  get_token();

  if (token == ENDCODE) {
    crunch_token();
    crunch_statement_marker();
    exit_debug("code_action at ENDCODE");
    return(create_code_segment());
  }

/*  if (token == BEGIN) {
*    crunch_token(); 
*  }
*/

  block_flag = TRUE;
  
  /* now for possibly empty list of statements */

  statement_block();
/*  if (token_in(statement_start_list)) {
*    crunch_token();
*    statements();
*  }
*/
  block_flag = FALSE;

  /* reset the CT line number to the scanner's value */
  set_ct_linenum(line_number);

  /* store results in a new code segment, and return it */

  exit_debug("code_action");
  return(create_code_segment());

}                                                       /* end CODE_ACTION */
/***************************************************************************/



/***************************************************************************/
/* exec_startup(prog_idp)    Execute the start up code                     */
/*                           based on `program'                            */

exec_startup(prog_idp)
SYMTAB_NODE_PTR prog_idp;           /* program id */
{
  entry_debug("exec_startup");


  /* set debug level for Execution */
  if (edebug) {
    DEBUG = cl_debug;
  }
  else {
    DEBUG = 0;
  }

  /* Execute the program */
  /* allocate runtime stack and initialise program's stack frame */
  init_stack();
  /* initialise the debugger */
  init_debugger();

  /* allocate locals and point to the code */
  routine_entry(prog_idp);

  /* DO IT */
  get_ctoken();
  while (ctoken != ENDCODE) exec_statement();

  exit_debug("exec_startup");
  return;
}                                                      /* end EXEC_STARTUP */
/***************************************************************************/



/***************************************************************************/
/* exec_statements(code_seg)     Execute set of statements                 */
/*                               based on `execute' and `routine_entry'    */

exec_statements(code_seg)
ICT *code_seg;                   /* the code */
{
  entry_debug("exec_statements");
  if (code_seg == NULL) return;

  /* switch to new code segment */
  code_segmentp = code_seg;

  get_ctoken();
  while (ctoken != ENDCODE) exec_statement();

  exit_debug("exec_statements");
  return;
}                                                   /* end EXEC_STATEMENTS */
/***************************************************************************/



/***************************************************************************/
/* exec_algorithm()        Execute the body of an algorithm                */
/*  This is a rewrite of Pascal execute() in l2xixutl.c                    */
/*   call this from exec_declared_routine_call() in l2xixstm.c             */
/*                     (FUNCTION, PROCEDURE     )                          */
/*            last token is END_OF_STATEMENTS                              */

exec_algorithm(rtn_idp)
SYMTAB_NODE_PTR rtn_idp;                 /* ponter to the routine */
{
  entry_debug("exec_algorithm");
  executed_return = FALSE;

  routine_entry(rtn_idp);

  get_ctoken();
  while (ctoken != END_OF_STATEMENTS && !executed_return) exec_statement();

  routine_exit(rtn_idp);

  exit_debug("exec_algorithm");
  return;
}                                                    /* end EXEC_ALGORITHM */
/***************************************************************************/



/***************************************************************************/