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

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 ; */ /* 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 */ /* or PROCEDURE ( ) */ /* 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 : */ /* or FUNCTION ( ) : */ /* 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 : ; */ /* : ; ... ) */ /* 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; /* */ 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 */ /* or */ /* ( ) */ /* 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 */ /* ( ) */ 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 */ /***************************************************************************/