symtab.c

这是一个Linux下的集成开发环境

	    while (h=hnum % HASHSZ, hashtab[h].name != NULL
	       && strcmp(hashtab[h].name,glob_symtab[i].name) != 0 ) {
	       hnum = rehash(hnum);
	    }
	    hashtab[h].name = glob_symtab[i].name;
	    if(storage_class_of(glob_symtab[i].type) == class_COMMON_BLOCK)
		hashtab[h].com_glob_symtab = &(glob_symtab[i]);
	    else
		hashtab[h].glob_symtab = &(glob_symtab[i]);

	}

		      /* Restores implicit typing to default values.
		         Note: 27 is '$', 28 is '_' which are default REAL */
	{
		int c;
		for( c=0; c<28; c++ ) {
	    	    implicit_type[c] = type_REAL;
		    implicit_size[c] = size_DEFAULT;
		}
		for( c='I'-'A'; c <= 'N'-'A'; c++ )
		    implicit_type[c] = type_INTEGER;
	}
}/*init_symtab*/



Gsymtab*
install_global(h,datatype,storage_class)	/* Install a global symbol */
	int h;			/* hash index */
	int datatype,storage_class;
{
	Gsymtab *gsymt = &glob_symtab[glob_symtab_top];

	if(glob_symtab_top == GLOBSYMTABSZ) {
	  oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
#ifdef LARGE_MACHINE
"out of space in global symbol table\n\
Recompile me with larger GLOBSYMTABSZ value\n"
#else
"out of space in global symbol table\n\
Recompile me with LARGE_MACHINE option\n"
#endif
		);
	}
	else {
			/* Store symtab pointer in hash table */
	    if(storage_class == class_COMMON_BLOCK)
		hashtab[h].com_glob_symtab = gsymt;
	    else
		hashtab[h].glob_symtab = gsymt;

	    clear_symtab_entry(gsymt);

	 		/* Duplicate copy of string into global stringspace */
	    gsymt->name = new_global_string(hashtab[h].name);

			/* Set symtab info fields */
	    gsymt->type = type_byte(storage_class,datatype);
	    gsymt->size = type_size[datatype];
	    if(storage_class == class_COMMON_BLOCK)
		gsymt->info.comlist = NULL;
	    else
		gsymt->info.arglist = NULL;

	    gsymt->link.child_list = NULL;

	    ++glob_symtab_top;
	}
	return (gsymt);
}/*install_global*/


Lsymtab*
install_local(id,h,datatype,storage_class)	/* Install a local symbol */
	Token *id;
	int h;			/* hash index */
	int datatype,storage_class;
{
	Lsymtab *symt = &loc_symtab[loc_symtab_top];
	if(loc_symtab_top == LOCSYMTABSZ) {
	  oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
#ifdef LARGE_MACHINE
"out of space in local symbol table\n\
Recompile me with larger LOCSYMTABSZ value\n"
#else
"out of space in local symbol table\n\
Recompile me with LARGE_MACHINE option\n"
#endif
		);
	}
	else {
	    if(storage_class == class_COMMON_BLOCK)
		hashtab[h].com_loc_symtab = symt;
	    else
		hashtab[h].loc_symtab = symt;

	    clear_symtab_entry(symt);
		symt->common_hash = -1;
		symt->common_orig_hash = -1;
		symt->record_hash = -1;
		symt->line_num = id->line_num; /* rigo */
	    symt->name = hashtab[h].name;
	    symt->info.array_dim = 0;

		      /* Set symtab info fields */
	    symt->type = type_byte(storage_class,datatype);
	    symt->size = type_size[datatype];
	    symt->equiv_link = symt;	/* equivalenced only to self */
	    if(incdepth > 0)
	      symt->defined_in_include = TRUE;
	    ++loc_symtab_top;
	}
	return symt;
}/*install_local*/


		/* Get value specified by an integer-expression token.
		   This will be either an identifier, which should be a
		   parameter whose value is in the symbol table, or else
		   an expression token as propagated by exprtype.c
		   routines, with value stored in the token.
		*/
int
int_expr_value(t)
	Token *t;
{
  if(!is_true(EVALUATED_EXPR,t->subclass)) {/* something bogus */
				/* warn if error message not already given */
    if(is_true(PARAMETER_EXPR,t->subclass))
      warning(t->line_num,t->col_num,
	      "Constant not evaluated: value of 0 assumed");
  }
  else {
	if( is_true(ID_EXPR,t->subclass) ) {
		/* Identifier: better be a parameter */
	    int h=t->value.integer;
	    Lsymtab *symt = hashtab[h].loc_symtab;
	    if(symt == NULL || !(symt->parameter) ) {
		syntax_error(t->line_num,t->col_num,
			"symbolic constant required");
	    }
	    else {
		return symt->info.int_value;
	    }
	}
		/* Otherwise, it is a const or expr, use token.value.integer */
	else {
	    return t->value.integer;
	}
  }
				/* Unsuccessful: return value of 0 */
  return 0;
}/*int_expr_value*/


	/* Following routine converts a list of tokens into a list of type-
	   flag pairs. */

PRIVATE ArgListHeader *
make_arg_array(t)
	Token *t;		/* List of tokens */
{
	int i;
	unsigned count;
	Token *s;
	ArgListElement *arglist;
	ArgListHeader *alhead;

	count = arg_count(t);
	if(((alhead=new_arglistheader())
		 		 == (ArgListHeader *) NULL) ||
	  (count != 0 &&
          ((arglist=new_arglistelement(count))
				 == (ArgListElement *) NULL))){
		oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
			   "Out of malloc space for argument list");
	}
	s = t;		          /* List of tokens is in reverse order. */
	for(i=count-1; i>=0; i--){  /* Here we fill array in original order. */

	    arglist[i].type = s->class; /* use evaluated type, not symt */
	    arglist[i].size = s->size;
			/* Keep track of array and external declarations */
	    if( is_true(ID_EXPR,s->subclass) ){
		int h = s->value.integer;
		Lsymtab *symt = hashtab[h].loc_symtab;
		if( (arglist[i].info.array_dim = symt->info.array_dim) == 0)
				/* change scalars to 0 dims, size 1 */
		  arglist[i].info.array_dim = array_dim_info(0,1);
		arglist[i].array_var = symt->array_var;
		arglist[i].declared_external = symt->declared_external;
	    }
	    else {
		arglist[i].info.array_dim = array_dim_info(0,1);
		arglist[i].array_var = FALSE;
		arglist[i].declared_external = FALSE;
	    }

	    arglist[i].array_element =
		arglist[i].array_var && !is_true(ARRAY_ID_EXPR,s->subclass);

	    if( is_true(LVALUE_EXPR,s->subclass) ){
		arglist[i].is_lvalue = TRUE;
			/* is_true(f,x) yields 0 or non-0: convert to 0 or 1 */
		arglist[i].set_flag =
			is_true(SET_FLAG,s->subclass)? TRUE: FALSE;
		arglist[i].assigned_flag =
			is_true(ASSIGNED_FLAG,s->subclass)? TRUE: FALSE;
		arglist[i].used_before_set =
			is_true(USED_BEFORE_SET,s->subclass)? TRUE: FALSE;
	    }
	    else {	/* it is an expression or constant, not an lvalue */
		arglist[i].is_lvalue = FALSE;
		arglist[i].set_flag = TRUE;
		arglist[i].assigned_flag = FALSE;
		arglist[i].used_before_set = FALSE;
	    }
	    s = s->next_token;
	}
	alhead->numargs = count;
	alhead->is_defn = FALSE;
	alhead->is_call = TRUE;
	alhead->external_decl = FALSE;
	alhead->actual_arg = FALSE;

        if (count == 0)
		alhead->arg_array = NULL;
	else
		alhead->arg_array = arglist;
	return(alhead);
}/* make_arg_array */


	/* Following routine converts a list of common block tokens
	    into a list of dimen_info-type pairs. */

PRIVATE ComListHeader *
make_com_array(t)
	Token *t;		/* List of tokens */
{
	Token *s;
	Lsymtab *symt;
	int h, i;
	unsigned count;
	ComListHeader *clhead;
	ComListElement *comlist;

	count = arg_count(t);
	if(((clhead=new_comlistheader())
		 == (ComListHeader *) NULL) ||
	  (count != 0 &&
 	  ((comlist=new_comlistelement(count))
		 == (ComListElement *) NULL))){
		oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
			   "Out of malloc space for common list");
	}
	s = t;
	for(i=count-1; i>=0; i--){
	   h = s->value.integer;
	   symt = hashtab[h].loc_symtab;
	   if( (comlist[i].dimen_info = symt->info.array_dim) == 0)
				/* change scalars to 0 dims, size 1 */
	     comlist[i].dimen_info = array_dim_info(0,1);
       	   comlist[i].type = get_type(symt);
	   comlist[i].size = get_size(symt,(int)comlist[i].type);
	   comlist[i].used = symt->used_flag;
	   comlist[i].set = symt->set_flag;
	   comlist[i].used_before_set = symt->used_before_set;
	   comlist[i].assigned = symt->assigned_flag;
	   if (comlist[i].used)
		clhead->any_used = TRUE;
	   if (comlist[i].set)
		clhead->any_set = TRUE;
	   s = s->next_token;
	}
	clhead->numargs = count;
	if (count == 0)
		clhead->com_list_array = NULL;
	else
		clhead->com_list_array = comlist;
	return(clhead);
} /* make_com_array */


PRIVATE ArgListHeader *
make_dummy_arg_array (t)
	Token *t;		/* List of tokens */
{
	int i;
	unsigned count;
	Token *s;
	ArgListElement *arglist;
	ArgListHeader *alhead;

	count = arg_count(t);
	if(((alhead=new_arglistheader())
			 == (ArgListHeader *) NULL) ||
	  (count != 0 &&
          ((arglist=new_arglistelement(count))
			== (ArgListElement *) NULL))){
		oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
			   "Out of malloc space for dummy argument list");
	}
	s = t;		          /* List of tokens is in reverse order. */
	for(i=count-1; i>=0; i--){  /* Here we fill array in original order. */
	    if( is_true(ID_EXPR,s->subclass) ){
	        int implied_type;
		int h = s->value.integer;
		Lsymtab *symt = hashtab[h].loc_symtab;
		if( (arglist[i].info.array_dim = symt->info.array_dim) == 0)
				/* change scalars to 0 dims, size 1 */
		  arglist[i].info.array_dim = array_dim_info(0,1);
		implied_type = get_type(symt);
		arglist[i].type = type_byte(storage_class_of(symt->type),
						implied_type);
		arglist[i].size = get_size(symt,implied_type);
		arglist[i].is_lvalue = TRUE;
		arglist[i].set_flag = symt->set_flag;
		arglist[i].assigned_flag = symt->assigned_flag;
		arglist[i].used_before_set = symt->used_before_set;
		arglist[i].array_var = symt->array_var;
		arglist[i].array_element = FALSE;
		arglist[i].declared_external = symt->declared_external;
	    }
	    else {	/* It is a label */
		arglist[i].info.array_dim = 0;
		arglist[i].type = s->class;
		arglist[i].size = 0;
		arglist[i].is_lvalue = FALSE;
		arglist[i].set_flag = FALSE;	/* Don't currently do labels */
		arglist[i].assigned_flag = FALSE;
		arglist[i].used_before_set = FALSE;
		arglist[i].array_var = FALSE;
		arglist[i].array_element = FALSE;
		arglist[i].declared_external = FALSE;
	    }
	    s = s->next_token;
	}
	alhead->numargs = count;
	alhead->is_defn = TRUE;
	alhead->is_call = FALSE;
	alhead->external_decl = FALSE;
	alhead->actual_arg = FALSE;

        if (count == 0)
		alhead->arg_array = NULL;
	else
		alhead->arg_array = arglist;
	return(alhead);
}/* make_dummy_arg_array */


	/* This routine makes an empty argument list: used for
	   EXTERNAL declarations of subprograms. */
PRIVATE ArgListHeader *
make_arrayless_alist()
{
	ArgListHeader *alhead;

	if(((alhead=new_arglistheader())
		 		 == (ArgListHeader *) NULL) ) {
		oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
			   "Out of malloc space for external decl");
	}

	alhead->numargs = 0;
	alhead->is_defn = FALSE;
	alhead->is_call = FALSE;
	alhead->arg_array = NULL;

	return(alhead);
}/* make_arrayless_arglist */

PRIVATE TokenListHeader *	/* Initializes a tokenlist header */
make_TL_head(t)
     Token *t;
{
  TokenListHeader *TH_ptr;
  if(token_head_space_top == TOKENSPACESZ) {
		oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
			   "Out of space for token list header");
  }
  TH_ptr= tokheadspace + token_head_space_top++;

	TH_ptr->line_num = t->line_num;
  	TH_ptr->filename = current_filename;
				/* Clear all the flags */
	TH_ptr->external_decl = FALSE;
	TH_ptr->actual_arg = FALSE;
	TH_ptr->tokenlist = NULL;
	TH_ptr->next = NULL;

  return TH_ptr;
}

		/* These routines allocate memory for arglist and comlist
		   headers and arrays.  For Turbo C the calloc calls limit
		   out at about 50KB, so a workaround uses separate modules
		   that allocate space from static arrays.  */
#ifndef T_ALLOC

ArgListElement *
new_arglistelement(count)
     unsigned count;
{
	
  arglist_element_used += count;	/* For -resources */
  return (ArgListElement *) SN_calloc(count,sizeof(ArgListElement));
}

ArgListHeader *
new_arglistheader()
{
  arglist_head_used++;
  return (ArgListHeader *) SN_calloc(1, sizeof(ArgListHeader));
}

ComListElement *
new_comlistelement(count)
     unsigned count;
{
  comlist_element_used += count;
  return SN_calloc(count,sizeof(ComListElement));
}

ComListHeader *
new_comlistheader()
{
  comlist_head_used++;
  return SN_calloc (1, sizeof(ComListHeader));
}

#endif /*T_ALLOC*/

		/* this routine allocates room in global part (top down)
		   of stringspace for string s, and copies it there */
char *
new_global_string(s)
	char *s;
{
	glob_str_bot -= strlen(s) + 1;    /*pre-decrement*/
	if( glob_str_bot < loc_str_top ) {
	  oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
#ifdef LARGE_MACHINE
"out of global stringspace\nRecompile me with larger STRSPACESZ value\n"
#else
"out of global stringspace\nRecompile me with LARGE_MACHINE option\n"
#endif
		);
	}
	return strcpy(strspace+glob_str_bot,s);
}/*new_global_string*/

		/* Allocate space for string s in local (bottom up)
		   string space, and copy it there */
char *
new_local_string(s)
	char *s;
{
	char *start = strspace + loc_str_top;
	loc_str_top += strlen(s) + 1;	/* post-increment */
	if(loc_str_top > glob_str_bot) {
	  oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
#ifdef LARGE_MACHINE
"out of local stringspace\nRecompile me with larger STRSPACESZ value\n"
#else
"out of local stringspace\nRecompile me with LARGE_MACHINE option\n"
#endif
		);
	}

	return strcpy(start,s);
}/* new_local_string */

Token *
new_token()			/* Returns pointer to space for a token */
{
  if(token_space_top == TOKENSPACESZ)
    return (Token *)NULL;
  else
    return tokenspace + token_space_top++;
}

	/* note_filename():  This routine is called by main prog to give
	   symbol table routines access to current input file name, to be
	   stored in function arg list headers and common list headers, for
	   the use in diagnostic messages. Since filenames are from argv,
	   they are permanent, so pointer is copied, not the string.
	*/
void
note_filename(s)
	char *s;
{
	current_filename = s;
	top_filename = s;