/* 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 */
/***************************************************************************/
/***************************************************************************/