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