diff options
Diffstat (limited to 'support/ltx2x/l2xidecl.c')
| -rw-r--r-- | support/ltx2x/l2xidecl.c | 958 |
1 files changed, 958 insertions, 0 deletions
diff --git a/support/ltx2x/l2xidecl.c b/support/ltx2x/l2xidecl.c new file mode 100644 index 0000000000..8777516b0a --- /dev/null +++ b/support/ltx2x/l2xidecl.c @@ -0,0 +1,958 @@ +/* l2xidecl.c LTX2X interpreter parsing routines for declarations */ +/* 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" +#ifndef l2xicpr_h +#include "l2xicpr.h" +#endif + +#include "listsetc.h" + + +/* EXTERNALS */ + +extern TOKEN_CODE token; +extern char word_string[]; +extern LITERAL literal; +extern SYMTAB_NODE_PTR symtab_display[]; +extern int level; + +extern SYMTAB_NODE_PTR string_idp; + +/* FORWARDS */ + +TYPE_STRUCT_PTR identifier_type(), enumeration_type(), + subrange_type(), array_type(); + +TYPE_STRUCT_PTR get_type(), get_array_type(), get_bound_spec_type(); + +TYPE_STRUCT_PTR an_entity(), a_type(), get_bls_type(); + +TOKEN_CODE express_decl_list[] = {XENTITY, TYPE, XRULE, + FUNCTION, PROCEDURE, 0}; + + +/***************************************************************************/ +/* declarations(rtn_idp) Call routines to process constant definitions, */ +/* type definitions, variable declarations, */ +/* procedure definitions, function definitions. */ +/* at entry, token is one of declaration_start_list bag */ +/* at exit, token is the one following all declarations (e.g., start */ +/* of assignment statement) */ + +declarations(rtn_idp) +SYMTAB_NODE_PTR rtn_idp; /* program or routine id */ +{ + entry_debug("declarations"); + + /* for EXPRESS */ + /* loop for general declarations */ + while (token_in(express_decl_list)) { + switch (token) { + case XENTITY: { + an_entity(); + break; + } + case TYPE: { + a_type(); + break; + } + case XRULE: { + a_rule(); + break; + } + case PROCEDURE: { + a_procedure(); + break; + } + case FUNCTION: { + a_function(); + break; + } + default: { + error(UNIMPLEMENTED_FEATURE); + break; + } + } /* end switch */ + } /* end while over general declarations */ + + if (token == XCONSTANT) { + get_token(); + constant_block(); + } + if (token == XLOCAL) { + get_token(); + local_block(rtn_idp); + } + + exit_debug("declarations"); + return; + +} /* end declarations */ +/***************************************************************************/ + + +/***************************************************************************/ +/* skip_declarations(rtn_idp) Skip declaration parsing */ + +skip_declarations(rtn_idp) +SYMTAB_NODE_PTR rtn_idp; /* program id */ +{ + SYMTAB_NODE_PTR const_idp; /* constant id */ + char tmp_buff[MAX_SOURCE_LINE_LENGTH]; + entry_debug("skip_declarations"); + + strcpy(tmp_buff, word_string); + strcpy(word_string, "_ZeRo"); + + search_and_enter_local_symtab(const_idp); + strcpy(word_string, tmp_buff); + const_idp->defn.key = CONST_DEFN; + + const_idp->defn.info.constant.value.integer = 0; + const_idp->typep = integer_typep; + + analyze_const_defn(const_idp); + + exit_debug("skip_declarations"); + return; +} /* end SKIP_DECLARATIONS */ +/***************************************************************************/ + + +/* EXPRESS CONSTANTS and LOCALS */ + +/***************************************************************************/ +/* constant_block() Process EXPRESS constant block */ +/* CONSTANT { <constant_definition> } END_CONSTANT ; */ +/* at entry, current token is CONSTANT */ +/* at exit, current token is after the semicolon */ + +constant_block() +{ + entry_debug("constant_block"); + + error(UNIMPLEMENTED_FEATURE); + + while (token != XEND_CONSTANT) { + get_token(); + } + + get_token(); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + + exit_debug("constant_block"); + return; +} /* end CONSTANT_BLOCK */ +/***************************************************************************/ + + +/***************************************************************************/ +/* a_constant_definition() Process EXPRESS constant */ +/* <constant_id> : <type> := <expression> ; */ +/* at entry, current token is <constant_id> */ +/* at exit, current token is after closing semicolon */ + +a_constant_definition() +{ + SYMTAB_NODE_PTR type_idp; /* constant id */ + + if (token != IDENTIFIER) { + error(UNEXPECTED_TOKEN); + return; + } + + search_and_enter_local_symtab(type_idp); + type_idp->defn.key = TYPE_DEFN; + + get_token(); + if_token_get_else_error(COLON, MISSING_COLON); + + /* process the type */ + type_idp->typep = get_type(); + if (type_idp->typep->type_idp == NULL) { + type_idp->typep->type_idp = type_idp; + } + + get_token(); + if_token_get_else_error(COLONEQUAL, MISSING_COLONEQUAL); + + /* process the expression */ /* SKIP THIS FOR NOW */ + while (token != SEMICOLON) { + get_token(); + } + get_token(); + + return; + +} /* end A_CONSTANT_DEFINITION */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* local_block(rtn_idp) Process EXPRESS local block */ +/* LOCAL { <local_definition> } END_LOCAL ; */ +/* at entry, current token is the one after LOCAL */ +/* at exit, current token is after closing semicolon */ + +local_block(rtn_idp) +SYMTAB_NODE_PTR rtn_idp; /* id of routine */ +{ + entry_debug("local_block"); + + local_decls(rtn_idp, + STACK_FRAME_HEADER_SIZE + rtn_idp->defn.info.routine.parm_count); + + exit_debug("local_block"); + return; +} /* end LOCAL_BLOCK */ +/***************************************************************************/ + + +/***************************************************************************/ +/* local_decls(rtn_idp, record_tp, offset) Process EXPRESS local variables */ +/* at entry, current token is <var_id> */ +/* at exit, current token is after closing END_LOCAL ; */ + +local_decls(rtn_idp, offset) +SYMTAB_NODE_PTR rtn_idp; +int offset; +{ + SYMTAB_NODE_PTR idp, first_idp, last_idp; /* variable ids */ + SYMTAB_NODE_PTR prev_last_idp = NULL; /* last id of a list */ + TYPE_STRUCT_PTR tp; /* type */ + int size; + int total_size = 0; + + entry_debug("local_decls"); + + /* loop to process sublist, each of a single type */ + while (token == IDENTIFIER) { /* loop over semicolon seperated list */ + first_idp = NULL; + + /* loop to process each var in a list */ + while (token == IDENTIFIER) { /* loop over comma seperated list */ + search_and_enter_local_symtab(idp); + idp->defn.key = VAR_DEFN; + idp->label_index = 0; + + /* link ids into a sublist */ + if (first_idp == NULL) { + first_idp = last_idp = idp; + if (rtn_idp->defn.info.routine.locals == NULL) { + rtn_idp->defn.info.routine.locals = idp; + } + } + else { + last_idp->next = idp; + last_idp = idp; + } + get_token(); + if_token_get(COMMA); + } /* end while over a comma seperated list */ + + /* Process the sublist's type */ + if_token_get_else_error(COLON, MISSING_COLON); + tp = get_type(); + size = tp->size; + + /* Assign the offset and the type to all ids in the list */ + for (idp = first_idp; idp != NULL; idp = idp->next) { + idp->typep = tp; + total_size += size; + idp->defn.info.data.offset = offset++; + analyze_var_decl(idp); + } /* end for */ + + /* link this sublist to previous sublist */ + if (prev_last_idp != NULL) prev_last_idp->next = first_idp; + prev_last_idp = last_idp; + + /* optional expression here SKIP FOR NOW */ + get_token(); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + + } /* end while over semicolon seperated list */ + + if_token_get_else_error(XEND_LOCAL, MISSING_END); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + + rtn_idp->defn.info.routine.total_local_size = total_size; + + exit_debug("local_decls"); + return; +} /* end LOCAL_DECLS */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* an_entity() Process an EXPRESS entity */ +/* ENTITY <entity_body> END_ENTITY ; */ +/* at entry, current token = ENTITY */ +/* at exit, current token is after END_ENTITY ; */ + +TYPE_STRUCT_PTR an_entity() +{ + SYMTAB_NODE_PTR idp; /* entity id */ + TYPE_STRUCT_PTR entity_tp = alloc_struct(TYPE_STRUCT); + entry_debug("an_entity (l2xidecl.c)"); + + entity_tp->form = ENTITY_FORM; + entity_tp->type_idp = NULL; + entity_tp->info.entity.attribute_symtab = NULL; + + get_token(); /* name of the entity */ + if (token != IDENTIFIER) { + error(UNEXPECTED_TOKEN); + } + search_and_enter_local_symtab(idp); + idp->defn.key = TYPE_DEFN; + idp->label_index = 0; + idp->typep = entity_tp; + + get_token(); /* semicolon */ + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + + attribute_declarations(NULL, entity_tp, 0); + + analyze_type_defn(idp); + /* skip to the end */ + while (token != XEND_ENTITY) { + get_token(); + } + + get_token(); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + + exit_debug("an_entity"); + return(entity_tp); +} /* end AN_ENTITY */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* a_type() Process an EXPRESS type */ +/* TYPE <type_body> END_TYPE ; */ +/* at entry, current token = TYPE */ +/* at exit, current token is after END_TYPE ; */ + +TYPE_STRUCT_PTR a_type() +{ + SYMTAB_NODE_PTR type_idp; /* the TYPE id */ + TYPE_STRUCT_PTR tsp; /* type structure pointer */ + entry_debug("a_type (l2xidecl.c)"); + + get_token(); /* the type id */ + if (token != IDENTIFIER) { + error(UNEXPECTED_TOKEN); + exit_debug("a_type"); + return(&dummy_type); + } + search_and_enter_local_symtab(type_idp); + type_idp->defn.key = TYPE_DEFN; + + get_token(); + if_token_get_else_error(EQUAL, MISSING_EQUAL); + + /* process the type */ + if (token == XENUMERATION) { /* an ENUMERATION type */ + get_token(); + if_token_get_else_error(OF, MISSING_OF); + if (token != LPAREN) { + error(MISSING_LPAREN); + } + /* process the enumeration */ + type_idp->typep = enumeration_type(); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + } + else { /* an ordinary type */ + type_idp->typep = get_type(); + get_token(); + if (token != SEMICOLON) error(MISSING_SEMICOLON); + } + if (type_idp->typep->type_idp == NULL) type_idp->typep->type_idp = type_idp; + analyze_type_defn(type_idp); + + /* skip to end of definition */ + while (token != XEND_TYPE) { + get_token(); + } + + get_token(); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + + exit_debug("a_type"); + return(type_idp->typep); +} /* end A_TYPE */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* a_rule() Process an EXPRESS rule */ +/* RULE <rule_body> END_RULE ; */ +/* at entry, current token = RULE */ +/* at exit, current token is after END_RULE ; */ + +a_rule() +{ + + error(UNIMPLEMENTED_FEATURE); + + while (token != XEND_RULE) { + get_token(); + } + + get_token(); + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + + return; +} /* end A_RULE */ +/***************************************************************************/ + + + + + + +/* CONSTANTS */ + + + + + +/* TYPES */ + + +/***************************************************************************/ +/* get_type() Process a type identifier. Call the function to make the */ +/* type structure, and return pointer to it. */ +/* at entry, token is the id */ +/* at exit, token is unaltered */ + +TYPE_STRUCT_PTR get_type() +{ + TYPE_STRUCT_PTR tsp; + entry_debug("get_type"); + + if (token_in(simple_type_list)) { /* predefined simple type */ + switch (token) { + case XINTEGER : { + tsp = integer_typep; + break; + } + case XREAL : { + tsp = real_typep; + break; + } + case XBOOLEAN : { + tsp = boolean_typep; + break; + } + case XLOGICAL : { + tsp = logical_typep; + break; + } + case XSTRING : { + tsp = make_string_typep(0); + break; + } + default : { + error(UNIMPLEMENTED_SIMPLE_TYPE); + tsp = &dummy_type; + break; + } + } /* end switch */ + exit_debug("get_type"); + return(tsp); + } /* end predefined simple types */ + + if (token_in(aggregation_type_list)) { /* predefined aggregation type */ + switch (token) { + case ARRAY : { + return(get_array_type()); + break; + } + case XBAG: + case XLIST: + case SET: { + return(get_bls_type()); + break; + } + default : { + error(UNIMPLEMENTED_AGGREGATION_TYPE); + tsp = &dummy_type; + break; + } + } /* end switch */ + exit_debug("get_type"); + return(tsp); + } /* end predefined aggregation types */ + + + + + switch (token) { + case IDENTIFIER: { + SYMTAB_NODE_PTR idp; + + search_all_symtab(idp); + + if (idp == NULL) { + error(UNDEFINED_IDENTIFIER); + exit_debug("get_type"); + return(&dummy_type); + } + else if (idp->defn.key == TYPE_DEFN) { + exit_debug("get_type"); + return(identifier_type(idp)); + } +/* else if (idp->defn.key == CONST_DEFN) { + exit_debug("get_type"); + return(subrange_type(idp)); + } */ + else { + error(NOT_A_TYPE_IDENTIFIER); + exit_debug("get_type"); + return(&dummy_type); + } + } + + default : { + error(INVALID_TYPE); + exit_debug("get_type"); + return(&dummy_type); + } + } /* end switch */ +} /* end get_type */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* identifier_type(idp) Process an identifier type (the identifier at the */ +/* LHS of an assignment). */ +/* return pointer to the type structure. */ + +TYPE_STRUCT_PTR identifier_type(idp) +SYMTAB_NODE_PTR idp; /* type id */ +{ + TYPE_STRUCT_PTR tp = NULL; + + tp = idp->typep; +/* get_token(); */ + return(tp); +} /* end identifier_type */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* enumeration_type() Process an enumeration type. */ +/* ( <id>, <id>, ... ) */ +/* Make and return a type structure. */ +/* at entry: token is opening ( */ +/* at exit: token is after closing ) */ + +TYPE_STRUCT_PTR enumeration_type() +{ + SYMTAB_NODE_PTR const_idp; /* constant id */ + SYMTAB_NODE_PTR last_idp = NULL; /* last constant id */ + TYPE_STRUCT_PTR tp = alloc_struct(TYPE_STRUCT); + int const_value = -1; /* constant value */ + + tp->form = ENUM_FORM; + tp->size = sizeof(int); + tp->type_idp = NULL; + + get_token(); + + /* loop to process ids */ + while (token == IDENTIFIER) { + search_and_enter_local_symtab(const_idp); + const_idp->defn.key = CONST_DEFN; + const_idp->defn.info.constant.value.integer = ++const_value; + const_idp->typep = tp; + + /* link ids into list */ + if (last_idp == NULL) tp->info.enumeration.const_idp = last_idp = const_idp; + else { + last_idp->next = const_idp; + last_idp = const_idp; + } + get_token(); + if_token_get(COMMA); + } /* end while */ + if_token_get_else_error(RPAREN, MISSING_RPAREN); + + tp->info.enumeration.max = const_value; + return(tp); +} /* end enumeration_type */ +/***************************************************************************/ + + + + +/***************************************************************************/ +/* make_string_typep(length) Make a type structure for a string of the */ +/* given length. */ +/* return a pointer to it. */ +/* rewritten for new structure */ + +TYPE_STRUCT_PTR make_string_typep(length) +int length; /* string length */ +{ + TYPE_STRUCT_PTR string_tp = alloc_struct(TYPE_STRUCT); + entry_debug("make_string_type"); + + if (length > MAX_EXPRESS_STRING) { + error(STRING_TOO_LONG); + } + + string_tp->form = STRING_FORM; + string_tp->size = sizeof(STRING); + string_tp->type_idp = string_idp; +/* string_tp->type_idp = NULL; */ + string_tp->info.string.max_length = MAX_EXPRESS_STRING; + string_tp->info.string.length = length; + + exit_debug("make_string_type"); + return(string_tp); +} /* end make_string_typep */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* calculate_array_size(tp) Return the size in bytes of an EXPRESS */ +/* array by recursively */ +/* calculating the size of each dimension. */ + +int calculate_array_size(tp) +TYPE_STRUCT_PTR tp; /* ptr to array type structure */ +{ + if (tp->info.array.elmt_typep->size == 0) { + tp->info.array.elmt_typep->size = + calculate_array_size(tp->info.array.elmt_typep); + } + + tp->size = tp->info.array.elmt_count * tp->info.array.elmt_typep->size; + return(tp->size); +} /* end array_size */ +/***************************************************************************/ + + +/* VARIABLES */ + + + +/***************************************************************************/ +/* attribute_declarations(rtn_idp, entity_tp, offset) */ +/* Process entity attribute definitions. All ids declared */ +/* with the same type are linked into a sublist, and all the */ +/* sublists are then liked together. */ + +attribute_declarations(rtn_idp, entity_tp, offset) +SYMTAB_NODE_PTR rtn_idp; +TYPE_STRUCT_PTR entity_tp; +int offset; +{ + SYMTAB_NODE_PTR idp, first_idp, last_idp; /* variable or field ids */ + SYMTAB_NODE_PTR prev_last_idp = NULL; /* last id of a list */ + TYPE_STRUCT_PTR tp; /* type */ + int size; + int total_size = 0; + + entry_debug("attribute_declarations (l2xidecl.c)"); + + /* loop to process sublist, each of a single type */ + while (!token_in(follow_attributes_list)) { + first_idp = NULL; + + /* loop to process each attribute in a list */ + while (token == IDENTIFIER) { + search_and_enter_this_symtab(idp, entity_tp->info.entity.attribute_symtab); + idp->defn.key = ATTRIBUTE_DEFN; + idp->label_index = 0; + + /* link ids into a sublist */ + if (first_idp == NULL) { + first_idp = last_idp = idp; + } + else { + last_idp->next = idp; + last_idp = idp; + } + get_token(); + if_token_get(COMMA); + } /* end while */ + + /* Process the sublist's type */ + if_token_get_else_error(COLON, MISSING_COLON); + tp = get_type(); + size = tp->size; + + /* Assign the offset and the type to all ids in the list */ + for (idp = first_idp; idp != NULL; idp = idp->next) { + idp->typep = tp; + idp->defn.info.data.offset = offset; + offset += size; + } /* end for */ + + /* link this sublist to previous sublist */ + if (prev_last_idp != NULL) prev_last_idp->next = first_idp; + prev_last_idp = last_idp; + + get_token(); /* move on from type processing */ + if_token_get_else_error(SEMICOLON, MISSING_SEMICOLON); + + } /* end while */ + + entity_tp->size = offset; + + exit_debug("attribute_declarations"); + return; +} /* end ATTRIBUTE_DECLARATIONS */ +/***************************************************************************/ + + + + + + +/***************************************************************************/ +/* get_array_type() Process an array type */ +/* ARRAY <bound_spec> OF <elmt-type> */ +/* Make a structure and return pointer. */ +/* at entry: token is ARRAY */ +/* at exit: token is */ + +TYPE_STRUCT_PTR get_array_type() +{ + TYPE_STRUCT_PTR tp = alloc_struct(TYPE_STRUCT); + TYPE_STRUCT_PTR index_tp; /* index type */ + TYPE_STRUCT_PTR elmt_tp = tp; /* element type */ + TYPE_STRUCT_PTR bound_tp; /* bound type */ + int min, max, count; + int calculate_array_size(); + entry_debug("get_array_type (l2xidecl.c)"); + + get_token(); + + elmt_tp->form = ARRAY_FORM; + elmt_tp->size = 0; + elmt_tp->type_idp = NULL; + elmt_tp->info.array.index_typep = integer_typep; + + if (token != LBRACKET) error(MISSING_LBRACKET); + + bound_tp = get_bound_spec_type(); + min = bound_tp->info.bound.min; + max = bound_tp->info.bound.max; + if (min == QUERY_CHAR || max == QUERY_CHAR) { + error(INVALID_INDEX_TYPE); + count = 0; + } + else if (min > max) { + error(MIN_GT_MAX); + count = 0; + } + else { + elmt_tp->info.array.min_index = min; + elmt_tp->info.array.max_index = max; + count = (max - min) + 1; + } + elmt_tp->info.array.elmt_count = count; + + + /* sync. Should be OF */ + synchronize(follow_indexes_list, declaration_start_list, statement_start_list); + if_token_get_else_error(OF, MISSING_OF); + + /* element type */ + elmt_tp->info.array.elmt_typep = get_type(); + tp->size = calculate_array_size(tp); /* was array_size(tp); */ + + exit_debug("get_array_type"); + return(tp); +} /* end GET_ARRAY_TYPE */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* get_bls_type() Process a BAG, etc type */ +/* BAG [ <bound_spec> ] OF <elmt-type> */ +/* Make a structure and return pointer. */ +/* at entry: token is BAG */ +/* at exit: token is */ + +TYPE_STRUCT_PTR get_bls_type() +{ + TYPE_STRUCT_PTR tp = alloc_struct(TYPE_STRUCT); + TYPE_STRUCT_PTR index_tp; /* index type */ + TYPE_STRUCT_PTR elmt_tp = tp; /* element type */ + TYPE_STRUCT_PTR bound_tp; /* bound type */ + int min, max, count, size; + entry_debug("get_bls_type (l2xidecl.c)"); + + count = 0; + if (token == XBAG) { + elmt_tp->form = BAG_FORM; + } + else if (token == XLIST) { + elmt_tp->form = LIST_FORM; + } + else if (token == SET) { + elmt_tp->form = SET_FORM; + } + elmt_tp->size = 0; + elmt_tp->type_idp = NULL; + elmt_tp->info.dynagg.index_typep = integer_typep; + + get_token(); + if (token == LBRACKET) { /* a bound spec */ + bound_tp = get_bound_spec_type(); + min = bound_tp->info.bound.min; + max = bound_tp->info.bound.max; + if (min == QUERY_CHAR) { + error(INVALID_INDEX_TYPE); + min = 0; + count = 0; + } + else if (min < 0) { + error(INVALID_INDEX_TYPE); + min = 0; + count = 0; + } + else if (max != QUERY_CHAR) { + if (min > max) { + error(MIN_GT_MAX); + max = min; + count = 0; + } + } + else { +/* count = (max - min) + 1; */ + count = 0; + } + } + else { /* default [0:?] bound spec */ + min = 0; + max = QUERY_CHAR; + count = 0; + } + + /* sync. Should be OF */ + synchronize(follow_indexes_list, declaration_start_list, statement_start_list); + if_token_get_else_error(OF, MISSING_OF); + + if (max == QUERY_CHAR) { + max = MAX_AGG_SIZE; + } + + elmt_tp->info.dynagg.min_index = min; + elmt_tp->info.dynagg.max_index = max; + elmt_tp->info.dynagg.elmt_count = count; + elmt_tp->info.dynagg.elmt_typep = get_type(); + tp->size = sizeof(LBS_PTR); + + exit_debug("get_bls_type"); + return(tp); +} /* end GET_BLS_TYPE */ +/***************************************************************************/ + + + +/***************************************************************************/ +/* get_bound_spec_type() Process a bound spec */ +/* [ <int_expr> : <int_expr> ] */ +/* make a type structure and return a pointer to it */ +/* at entry: token is opening [ */ +/* at exit: token is after closing ] */ + +TYPE_STRUCT_PTR get_bound_spec_type() +{ + TYPE_STRUCT_PTR tp; + entry_debug("get_bound_spec_type (l2xidecl.c)"); + + tp = alloc_struct(TYPE_STRUCT); + + tp->form = BOUND_FORM; + tp->type_idp = NULL; + tp->size = sizeof(int); + tp->info.bound.bound_typep = integer_typep; + + /* lower bound */ + get_token(); + tp->info.bound.min = get_bound_limit(); + + /* sync. should be a : */ + synchronize(follow_min_bound_list, NULL, NULL); + if_token_get(COLON); + else if (token_in(follow_min_bound_list) || + token_in(declaration_start_list) || + token_in(statement_start_list)) error(MISSING_COLON); + + /* upper bound */ + tp->info.bound.max = get_bound_limit(); + + if_token_get_else_error(RBRACKET, MISSING_RBRACKET); + + exit_debug("get_bound_spec_type"); + return(tp); +} /* end GET_BOUND_SPEC_TYPE */ +/***************************************************************************/ + + +/***************************************************************************/ +/* get_bound_limit(minmax_idp, minmaxp, typepp) Process the min or */ +/* max limits of a bound spec */ +/* [ + | - ] INTEGER_LITERAL */ +/* at entry: token is the limit (value) */ +/* at exit: token is after the limit */ + +int get_bound_limit() +{ + TOKEN_CODE sign = PLUS; /* unary + or - sign */ + int result = QUERY_CHAR; /* undef result */ + + /* unary + or - sign */ + if ((token == PLUS) || (token == MINUS)) { + sign = token; + get_token(); + } + + /* numeric limit --- integer only */ + if (token == NUMBER_LITERAL) { + if (literal.type == INTEGER_LIT) { + result = (sign == PLUS) ? literal.value.integer + : -literal.value.integer; + } + else error(INVALID_BOUND_TYPE); + } + else if (token == QUERY_CHAR) { + result = QUERY_CHAR; + } + else { + error(INVALID_BOUND_TYPE); + } + + get_token(); + return(result); +} /* end GET_BOUND_LIMIT */ +/***************************************************************************/ + + + |