diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /support/ltx2x/l2xirtne.c |
Initial commit
Diffstat (limited to 'support/ltx2x/l2xirtne.c')
-rw-r--r-- | support/ltx2x/l2xirtne.c | 651 |
1 files changed, 651 insertions, 0 deletions
diff --git a/support/ltx2x/l2xirtne.c b/support/ltx2x/l2xirtne.c new file mode 100644 index 0000000000..c7dc7b8675 --- /dev/null +++ b/support/ltx2x/l2xirtne.c @@ -0,0 +1,651 @@ +/* l2xirtne.c LTX2X interpreter Routine parser */ +/* parse programs and declared procedures and functions */ +/* 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 "l2xiprse.h" +#include "l2xiidbg.h" +#include "l2xiexec.h" +#ifndef l2xicpr_h +#include "l2xicpr.h" /* extern token code lists */ +#endif + +/* EXTERNALS */ + +extern int line_number;; +extern long exec_stmt_count; + +extern TOKEN_CODE token; +extern char word_string[]; +extern SYMTAB_NODE_PTR symtab_display[]; +extern int level; + +extern ICT *code_buffer; +extern ICT *code_bufferp; + +extern STACK_ITEM *stack; +extern STACK_ITEM_PTR tos; +extern STACK_ITEM_PTR stack_frame_basep; +extern STACK_ITEM_PTR maxtos; +extern TYPE_STRUCT_PTR get_type(); + +/* GLOBALS */ + +char buffer[MAX_PRINT_LINE_LENGTH]; + +/* FORWARDS */ + +SYMTAB_NODE_PTR formal_parm_list(); +SYMTAB_NODE_PTR procedure_header(); +SYMTAB_NODE_PTR function_header(); +ICT *create_code_segment(); + + + +/***************************************************************************/ +/* init_stack initialise the runtime stack */ + +init_stack() +{ + + entry_debug("init_stack"); + + /* allocate runtime stack */ + stack = alloc_array(STACK_ITEM, MAX_STACK_SIZE); + stack_frame_basep = tos = stack; + stack_frame_debug(); + + maxtos = tos; /* current max top of stack */ + /* initialise the program's stack frame */ + level = 1; + stack_frame_basep = tos + 1; + stack_frame_debug(); + push_integer(0); /* function return value */ + push_address(NULL); /* static link */ + push_address(NULL); /* dynamic link */ + push_address(NULL); /* return address */ + + + exit_debug("init_stack"); + return; +} /* end init_stack */ +/***************************************************************************/ + + +/***************************************************************************/ +/* create_dummy_prog() create a dummy program symbol table node */ +/* Based on program and program_header */ +/* Must be called BEFORE any scanning or parsing */ +/* returns pointer to program id node */ + +SYMTAB_NODE_PTR create_dummy_prog() +{ + SYMTAB_NODE_PTR program_idp; /* program id */ + entry_debug("creat_dummy_prog"); + + /* make up fake program name */ + strcpy(word_string, "_PrOgRaM"); + search_and_enter_local_symtab(program_idp); + program_idp->defn.key = PROG_DEFN; + program_idp->defn.info.routine.key = DECLARED; + program_idp->defn.info.routine.parm_count = 0; + program_idp->defn.info.routine.total_parm_size = 0; + program_idp->defn.info.routine.total_local_size = 0; + program_idp->typep = &dummy_type; + program_idp->label_index = 0; + + enter_scope(NULL); + + /* no program parameters */ + + program_idp->defn.info.routine.locals = NULL; + program_idp->defn.info.routine.parms = NULL; + + exit_debug("create_dummy_prog"); + return(program_idp); +} /* end create_dummy_prog */ +/***************************************************************************/ + + + + + +/***************************************************************************/ +/* a_function Process an EXPRESS function */ +/* FUNCTION <header> <body> END_FUNCTION ; */ +/* at entry, token is FUNCTION */ +/* at exit, token is after END_FUNCTION ; */ + +a_function() +{ + SYMTAB_NODE_PTR rtn_idp; /* routine id */ + entry_debug("a_function"); + + rtn_idp = function_header(); + + /* sync. Should be ; */ + synchronize(follow_header_list, declaration_start_list, statement_start_list); + if_token_get(SEMICOLON); + else if (token_in(declaration_start_list) || token_in(statement_start_list)) + error(MISSING_SEMICOLON); + + /* block or forward */ + if (strcmp(word_string, "forward") != 0) { + rtn_idp->defn.info.routine.key = DECLARED; + analyze_routine_header(rtn_idp); + rtn_idp->defn.info.routine.locals = NULL; + function_body(rtn_idp); + + rtn_idp->defn.info.routine.code_segment = create_code_segment(); + analyze_block(rtn_idp->defn.info.routine.code_segment); + if_token_get_else_error(XEND_FUNCTION, MISSING_END_FUNCTION); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + } + else { + get_token(); + rtn_idp->defn.info.routine.key = FORWARD; + analyze_routine_header(rtn_idp); + } + + rtn_idp->defn.info.routine.local_symtab = exit_scope(); + + exit_debug("a_function"); + return; + +} /* end A_FUNCTION */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* function_body(rtn_idp) Process body of a function */ +/* at entry, token is after ; ending the header */ +/* at exit, token is after a ; and should be END_FUNCTION */ + +function_body(rtn_idp) +SYMTAB_NODE_PTR rtn_idp; /* routine id */ +{ + extern BOOLEAN block_flag; + entry_debug("function_body"); + + if (token_in(declaration_start_list)) { + declarations(rtn_idp); +/* synchronize(follow_decls_list, NULL, NULL); */ + } + /* possibly need an else skip_declarations(rtn_idp); here */ + + block_flag = TRUE; + /* possibly empty list of statements */ + if (token_in(statement_start_list)) { + crunch_token(); + statements(); + crunch_statement_marker(); + change_crunched_token(END_OF_STATEMENTS); + } + block_flag = FALSE; + +/* if_token_get_else_error(XEND_FUNCTION, MISSING_END_FUNCTION); +* if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); +*/ + + exit_debug("function_body"); + return; +} /* end FUNCTION_BODY */ +/***************************************************************************/ + + + + +/***************************************************************************/ +/* a_procedure() Process EXPRESS procedure */ +/* FUN/PROC <routine_header> ; <block> */ +/* at entry, token is PROCEDURE */ +/* at exit, token is past final ; */ + +a_procedure() +{ + SYMTAB_NODE_PTR rtn_idp; /* routine id */ + entry_debug("a_procedure"); + + rtn_idp = procedure_header(); + + /* sync. Should be ; */ + synchronize(follow_header_list, declaration_start_list, statement_start_list); + if_token_get(SEMICOLON); + else if (token_in(declaration_start_list) || token_in(statement_start_list)) + error(MISSING_SEMICOLON); + + /* block or forward */ + if (strcmp(word_string, "forward") != 0) { + rtn_idp->defn.info.routine.key = DECLARED; + analyze_routine_header(rtn_idp); + rtn_idp->defn.info.routine.locals = NULL; + function_body(rtn_idp); + + rtn_idp->defn.info.routine.code_segment = create_code_segment(); + analyze_block(rtn_idp->defn.info.routine.code_segment); + if_token_get_else_error(XEND_PROCEDURE, MISSING_END_PROCEDURE); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + } + else { + get_token(); + rtn_idp->defn.info.routine.key = FORWARD; + analyze_routine_header(rtn_idp); + } + + rtn_idp->defn.info.routine.local_symtab = exit_scope(); + + exit_debug("a_procedure"); + return; +} /* end A_PROCEDURE */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* procedure_header() Process a procedure header */ +/* PROCEDURE <id> */ +/* or PROCEDURE <id> ( <parm-list> ) */ +/* returns pointer to the procedure id node. */ + +SYMTAB_NODE_PTR procedure_header() +{ + SYMTAB_NODE_PTR proc_idp; /* procedure id */ + SYMTAB_NODE_PTR parm_listp; /* formal param list */ + int parm_count; + int total_parm_size; + BOOLEAN forward_flag = FALSE; /* TRUE iff forward */ + entry_debug("procedure_header"); + + get_token(); + + /* if proc id has already been declared in this scope, */ + /* it must be a forward */ + if (token == IDENTIFIER) { + search_local_symtab(proc_idp); + if (proc_idp == NULL) { + enter_local_symtab(proc_idp); + proc_idp->defn.key = PROC_DEFN; + proc_idp->defn.info.routine.total_local_size = 0; + proc_idp->typep = &dummy_type; + proc_idp->label_index = 0; + } + else if ((proc_idp->defn.key == PROC_DEFN) && + (proc_idp->defn.info.routine.key == FORWARD)) + forward_flag = TRUE; + else error(REDEFINED_IDENTIFIER); + + get_token(); + } + else error(MISSING_IDENTIFIER); + + /* sync. Should be ( or ; */ + synchronize(follow_proc_id_list, declaration_start_list, statement_start_list); + enter_scope(NULL); + + /* optional formal parameters, if FORWARD shouldn't be any, but parse */ + /* for error recovery */ + if (token == LPAREN) { + parm_listp = formal_parm_list(&parm_count, &total_parm_size); + if (forward_flag) error(ALREADY_FORWARDED); + else { + proc_idp->defn.info.routine.parm_count = parm_count; + proc_idp->defn.info.routine.total_parm_size = total_parm_size; + proc_idp->defn.info.routine.parms = parm_listp; + } + } + else if (!forward_flag) { + proc_idp->defn.info.routine.parm_count = 0; + proc_idp->defn.info.routine.total_parm_size = 0; + proc_idp->defn.info.routine.parms = NULL; + } + + proc_idp->typep = NULL; + exit_debug("procedure_header"); + return(proc_idp); +} /* end procedure_header */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* function_header() Process a function header */ +/* FUNCTION <id> : <type-id> */ +/* or FUNCTION <id> ( <parm-list> ) : <type-id> */ +/* returns pointer to the function id node. */ + +SYMTAB_NODE_PTR function_header() +{ + SYMTAB_NODE_PTR func_idp, type_idp; /* function and type id */ + SYMTAB_NODE_PTR parm_listp; /* formal param list */ + int parm_count; + int total_parm_size; + BOOLEAN forward_flag = FALSE; /* TRUE iff forward */ + entry_debug("function_header"); + + get_token(); + + /* if func id has already been declared in this scope, */ + /* it must be a forward */ + if (token == IDENTIFIER) { + search_local_symtab(func_idp); + if (func_idp == NULL) { + enter_local_symtab(func_idp); + func_idp->defn.key = FUNC_DEFN; + func_idp->defn.info.routine.total_local_size = 0; + func_idp->typep = &dummy_type; + func_idp->label_index = 0; + } + else if ((func_idp->defn.key == FUNC_DEFN) && + (func_idp->defn.info.routine.key == FORWARD)) + forward_flag = TRUE; + else error(REDEFINED_IDENTIFIER); + + get_token(); + } + else error(MISSING_IDENTIFIER); + + /* sync. Should be ( or : or ; */ + synchronize(follow_func_id_list, declaration_start_list, statement_start_list); + enter_scope(NULL); + + /* optional formal parameters, if FORWARD shouldn't be any, but parse */ + /* for error recovery */ + if (token == LPAREN) { + parm_listp = formal_parm_list(&parm_count, &total_parm_size); + if (forward_flag) error(ALREADY_FORWARDED); + else { + func_idp->defn.info.routine.parm_count = parm_count; + func_idp->defn.info.routine.total_parm_size = total_parm_size; + func_idp->defn.info.routine.parms = parm_listp; + } + } + else if (!forward_flag) { + func_idp->defn.info.routine.parm_count = 0; + func_idp->defn.info.routine.total_parm_size = 0; + func_idp->defn.info.routine.parms = NULL; + } + + /* for a forward, should not be a type, but parse anyway */ + if (!forward_flag || (token == COLON)) { + if_token_get_else_error(COLON, MISSING_COLON); + +/* changed for EXPRESS + if (token == IDENTIFIER) { + search_and_find_all_symtab(type_idp); + if (type_idp->defn.key != TYPE_DEFN) error(INVALID_TYPE); + if (!forward_flag) func_idp->typep = type_idp->typep; + get_token(); + } + else { + error(MISSING_IDENTIFIER); + func_idp->typep = &dummy_type; + } +*/ + if (!forward_flag) func_idp->typep = get_type(); + get_token(); + if (forward_flag) error(ALREADY_FORWARDED); + } + + exit_debug("function_header"); + return(func_idp); +} /* end function_header */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* formal_parm_list(countp, total_size) Process formal parameter list */ +/* ( VAR <id-list> : <type> ; */ +/* <id-list> : <type> ; ... ) */ +/* return a pointer to the head of the parameter id list */ + +SYMTAB_NODE_PTR formal_parm_list(countp, total_sizep) +int *countp; /* ptr to count of parameters */ +int *total_sizep; /* ptr to total byte size of parameters */ +{ + SYMTAB_NODE_PTR parm_idp, first_idp, last_idp; /* parm ids */ + SYMTAB_NODE_PTR prev_last_idp = NULL; /* last id of list */ + SYMTAB_NODE_PTR parm_listp = NULL; /* parm list */ + SYMTAB_NODE_PTR type_idp; /* type id */ + TYPE_STRUCT_PTR parm_tp; /* parm type */ + DEFN_KEY parm_defn; /* parm definition */ + int parm_count = 0; /* count of parms */ + int parm_offset = STACK_FRAME_HEADER_SIZE; + entry_debug("formal_parm_list"); + + get_token(); + + /* loop to process declarations seperated by ; */ + while ((token == IDENTIFIER) || (token == VAR)) { + first_idp = NULL; + /* VAR parm? */ + if (token == VAR) { + parm_defn = VARPARM_DEFN; + get_token(); + } + else parm_defn = VALPARM_DEFN; + + /* <id list> */ + while (token == IDENTIFIER) { + search_and_enter_local_symtab(parm_idp); + parm_idp->defn.key = parm_defn; + parm_idp->label_index = 0; + ++parm_count; + + if (parm_listp == NULL) parm_listp = parm_idp; + + /* link parms together */ + if (first_idp == NULL) first_idp = last_idp = parm_idp; + else { + last_idp->next = parm_idp; + last_idp = parm_idp; + } + get_token(); + if_token_get(COMMA); + } + + if_token_get_else_error(COLON, MISSING_COLON); + +/* changed following for EXPRESS + if (token == IDENTIFIER) { + search_and_find_all_symtab(type_idp); + if (type_idp->defn.key != TYPE_DEFN) error(INVALID_TYPE); + parm_tp = type_idp->typep; + get_token(); + } + else { + error(MISSING_IDENTIFIER); + parm_tp = &dummy_type; + } +*/ + parm_tp = get_type(); + get_token(); + + /* assign the offset and the type to all parm ids in the sublist */ + for (parm_idp = first_idp; parm_idp != NULL; parm_idp = parm_idp->next) { + parm_idp->typep = parm_tp; + parm_idp->defn.info.data.offset = parm_offset++; + } + + /* link this sublist to the list of all parm ids */ + if (prev_last_idp != NULL) prev_last_idp->next = first_idp; + prev_last_idp = last_idp; + + /* sync: Should be ; or ) */ + synchronize(follow_parms_list, NULL, NULL); + if_token_get(SEMICOLON); + } /* end while */ + + if_token_get_else_error(RPAREN, MISSING_RPAREN); + *countp = parm_count; + *total_sizep = parm_offset - STACK_FRAME_HEADER_SIZE; + + exit_debug("formal_parm_list"); + return(parm_listp); +} /* end formal_parm_list */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* routine_call(rtn_idp, parm_check_flag) Process a call to a procedure */ +/* or function */ +/* return pointer to the type structure of the call */ + +TYPE_STRUCT_PTR routine_call(rtn_idp, parm_check_flag) +SYMTAB_NODE_PTR rtn_idp; /* routine id */ +BOOLEAN parm_check_flag; /* if TRUE then check parms */ +{ + TYPE_STRUCT_PTR declared_routine_call(), standard_routine_call(); + entry_debug("routine_call"); + + if ((rtn_idp->defn.info.routine.key == DECLARED) || + (rtn_idp->defn.info.routine.key == FORWARD) || + (!parm_check_flag)) { + exit_debug("routine_call"); + return(declared_routine_call(rtn_idp, parm_check_flag)); + } + else { + exit_debug("routine_call"); + return(standard_routine_call(rtn_idp)); + } +} /* end routine_call */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* declared_routine_call(rtn_idp, parm_check_flag) Process a call to a */ +/* declared function or procedure */ +/* <id> or */ +/* <id> ( <parm-list> ) */ +/* The actual params are checked against the */ +/* formal params for type and number. */ +/* return pointer to type structure of the call */ + +TYPE_STRUCT_PTR declared_routine_call(rtn_idp, parm_check_flag) +SYMTAB_NODE_PTR rtn_idp; /* routine id */ +BOOLEAN parm_check_flag; /* if TRUE then check parms */ +{ + entry_debug("declared_routine_call"); + + actual_parm_list(rtn_idp, parm_check_flag); + + exit_debug("declared_routine_call"); + return(rtn_idp->defn.key == PROC_DEFN ? NULL : rtn_idp->typep); +} /* end declared_routine_call */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* actual_parm_list(rtn_idp, parm_check_flag) Process actual param list */ +/* ( <expr-list> ) */ + +actual_parm_list(rtn_idp, parm_check_flag) +SYMTAB_NODE_PTR rtn_idp; /* routine id */ +BOOLEAN parm_check_flag; /* if TRUE then check parms */ +{ + SYMTAB_NODE_PTR formal_parm_idp; + DEFN_KEY formal_parm_defn; + TYPE_STRUCT_PTR formal_parm_tp, actual_parm_tp; + entry_debug("actual_parm_list"); + + if (parm_check_flag) formal_parm_idp = rtn_idp->defn.info.routine.parms; + + if (token == LPAREN) { + /* loop to process actual param expressions */ + do { + /* get info on corresponding formal params */ + if (parm_check_flag && (formal_parm_idp != NULL)) { + formal_parm_defn = formal_parm_idp->defn.key; + formal_parm_tp = formal_parm_idp->typep; + } + + get_token(); + + /* Actual and formal parms must be consistent. */ + /* Actual parm may be an expression */ + if ((formal_parm_idp == NULL) || + (formal_parm_defn == VALPARM_DEFN) || + (!parm_check_flag)) { + actual_parm_tp = expression(); + if (parm_check_flag && + (formal_parm_idp != NULL) && + (!is_assign_type_compatible(formal_parm_tp, actual_parm_tp))) + error(INCOMPATIBLE_TYPES); + } + + /* Now the same for VAR params */ + else { + if (token == IDENTIFIER) { + SYMTAB_NODE_PTR idp; + + search_and_find_all_symtab(idp); + actual_parm_tp = variable(idp, VARPARM_USE); + + if (formal_parm_tp != actual_parm_tp) error(INCOMPATIBLE_TYPES); + } + else { /* not a variable, but parse anyway */ + actual_parm_tp = expression(); + error(INVALID_VAR_PARM); + } + } + + /* check if there are more actuals than formals */ + if (parm_check_flag) { + if (formal_parm_idp == NULL) error(WRONG_NUMBER_OF_PARMS); + else formal_parm_idp = formal_parm_idp->next; + } + + /* sync. Should be , or ) */ + synchronize(follow_parm_list, statement_end_list, NULL); + + } while (token == COMMA); /* end do */ + if_token_get_else_error(RPAREN, MISSING_RPAREN); + } + + /* check for fewer actuals than formals */ + if (parm_check_flag && (formal_parm_idp != NULL)) error(WRONG_NUMBER_OF_PARMS); + + exit_debug("actual_parm_list"); + return; +} /* end actual_parm_list */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* block(rtn_idp) Process a block, which consists of declarations */ +/* followed by a compound statement */ + +old_block(rtn_idp) +SYMTAB_NODE_PTR rtn_idp; +{ + extern BOOLEAN block_flag; + entry_debug("block"); + + declarations(rtn_idp); + + /* sync. Should be ; */ + synchronize(follow_decls_list, NULL, NULL); + if (token != BEGIN) error(MISSING_BEGIN); + + crunch_token(); + + block_flag = TRUE; + compound_statement(); + block_flag = FALSE; + + exit_debug("block"); + return; +} /* end block */ +/***************************************************************************/ + |