plsymtab.c

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

/*

Copyright (c) 2000, Red Hat, Inc.

This file is part of Source-Navigator.

Source-Navigator is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2, or (at your option)
any later version.

Source-Navigator is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License along
with Source-Navigator; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.



*/

/* plsymtab.c:

		Routines associated with printing of local symbol table info

    Copyright (C) 1993 by Robert K. Moniot.
    This program is free software.  Permission is granted to
    modify it and/or redistribute it, retaining this notice.
    No guarantees accompany this software.

	Shared functions defined:

		debug_symtabs()	Prints debugging info about symbol tables.
		print_loc_symbols(curmodhash) Prints local symtab info.

	Private functions defined:
		has_nonalnum()	  True if string has non-alphanumeric char
		sort_symbols()	  Sorts the list of names of a given category.
		swap_symptrs()	  Swaps a pair of pointers.
		check_flags()     Outputs messages about used-before-set etc.
		check_mixed_common() checks common for nonportable mixed type
		print_symbols(sym_list,n,do_types) Prints symbol lists.
		print_variables(sym_list,n)  Prints variable symbol table
		find_sixclashes() Finds variables with the same first 6 chars.
		identify_module(mod_name) Prints module name and file name.
*/

#include <stdio.h>
#include <ctype.h>
#include <string.h>

#include <tcl.h>

#include "ftnchek.h"
#define PLSYMTAB
#include "symtab.h"
#include "sn.h"


int get_size(Lsymtab *symt,int type);

#if 0
PRIVATE int
has_nonalnum();

PRIVATE unsigned
find_sixclashes(), print_variables(), print_symbols();
#endif

PRIVATE void
identify_module(),
swap_symptrs(), sort_symbols(), check_flags();
#if 0
PRIVATE void
check_mixed_common();
#endif

static void * SN_calloc (int size1, int size2)
{
	void * p;
	p = (void*)ckalloc (size1*size2);
	memset (p, 0, size1*size2);
	return p;
}

PRIVATE void
sort_symbols(sp,n)      /* sorts a given list */
	Lsymtab *sp[];
	unsigned n;
{
	int i,j,swaps;
	for(i=0;i<n;i++) {
	    swaps = 0;
	    for(j=n-1;j>=i+1;j--) {
		if((strcmp(sp[j-1]->name, sp[j]->name)) > 0) {
		   swap_symptrs(&sp[j-1], &sp[j]);
		   swaps ++;
		}
	    }
	    if(swaps == 0) break;
	}
}


PRIVATE void			/* swaps two pointers */
swap_symptrs(x_ptr,y_ptr)
	Lsymtab **x_ptr,**y_ptr;
{
	Lsymtab *temp = *x_ptr;
	*x_ptr = *y_ptr;
	*y_ptr = temp;
}

/* Routine to print module name and file name just once in standard
   format is shared by print_loc_symbols, check_mixed_common and check_flags*/
PRIVATE int any_warnings;

PRIVATE void
identify_module(mod_name)
     char *mod_name;
{
#ifdef ERROR_MESS
  if(do_symtab) {
    fprintf(list_fd,"\nWarning: ");
  }
  else {
    if(any_warnings++ == 0) { /* 1st message of this module? */
      if(novice_help) {		/* Old-style format */
	fprintf(list_fd,
		"\nWarning in module %s file %s:",
		mod_name,current_filename);
      }
      else {			/* Lint-style format */
	fprintf(list_fd,
		"\n\"%s\" module %s: Warning:",
		current_filename,mod_name);
      }
    }
    fprintf(list_fd,"\n   ");	/* Details go indented on next line */
  }
  ++warning_count;		/* Count these warnings too */
#endif
}


void
print_loc_symbols(curmodhash)
     int curmodhash;		/* hash entry of current module */
{
#ifdef DYNAMIC_TABLES		/* tables will be mallocked at runtime */
    static Lsymtab **sym_list=(Lsymtab **)NULL;
#else
    Lsymtab *sym_list[LOCSYMTABSZ]; /* temp. list of symtab entries to print */
#endif
    int	mod_type,		/* datatype of this module */
	this_is_a_function;	/* flag for treating funcs specially */
    Lsymtab *module;	 	/* entry of current module in symtab */
    char *mod_name;		/* module name */

#ifdef DYNAMIC_TABLES
    if(sym_list == (Lsymtab **)NULL) { /* Initialize if not done before */
      if( (sym_list=(Lsymtab **)SN_calloc(LOCSYMTABSZ,sizeof(Lsymtab *)))
	 == (Lsymtab **)NULL) {
	  oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
		       "Cannot malloc space for local symbol list");
      }
    }
#endif

    any_warnings=0;		/* for identify_module(mod_name); */

			/* Keep track of symbol table and string usage */
    if(loc_symtab_top > max_loc_symtab) {
	max_loc_symtab = loc_symtab_top;
    }
    if(loc_str_top > max_loc_strings) {
	max_loc_strings = loc_str_top;
    }
    if(token_head_space_top > max_tokenlists) {
      max_tokenlists=token_head_space_top;
    }
    if(token_space_top > max_token_space) {
        max_token_space = token_space_top;
    }

			/* Global symbols only increase in number */
    max_glob_symtab = glob_symtab_top;
    max_glob_strings = STRSPACESZ - glob_str_bot;



    		/* Set up name & type, and see what kind of module it is */

	      module = hashtab[curmodhash].loc_symtab;

	      mod_name = module->name;
	      mod_type = get_type(module);

	      if(  mod_type != type_PROGRAM
		&& mod_type != type_SUBROUTINE
		&& mod_type != type_COMMON_BLOCK
		&& mod_type != type_BLOCK_DATA )
			this_is_a_function = TRUE;
	      else
			this_is_a_function = FALSE;

#ifdef rigo
	  			/* Print name & type of the module */
    if(do_symtab) {
      unsigned i;
      for(i=0,numentries=0;i<loc_symtab_top;i++) {
	if(loc_symtab[i].entry_point)
	  sym_list[numentries++] = &loc_symtab[i];
      }

	   if(numentries > 1) {
	      sort_symbols(sym_list,numentries);
	   }

	  fprintf(list_fd,"\n\nModule %s:",mod_name);
	  if( this_is_a_function ) fprintf(list_fd," func:");
	  fprintf(list_fd," %4s",type_name[mod_type]);
			/* Print a * next to non-declared function name */
	  if(datatype_of(module->type) == type_UNDECL ) {
			fprintf(list_fd,"*");
			imps++;
	  }
	  fprintf(list_fd,"\n");


				/* Print Entry Points (skip if only one,
				   since it is same as module name) */
      if(do_symtab && numentries > 1) {
	      fprintf(list_fd,"\nEntry Points\n");
	      (void) print_symbols(list_fd,sym_list,numentries,FALSE);
      }

			/* End of printing module name and entry points */
    }/*if(do_symtab)*/
#endif


#ifdef rigo

				/* Print the externals */

    if(do_symtab) {
        unsigned i,n;
	for(i=0,n=0;i<loc_symtab_top;i++) {
	    if(storage_class_of(loc_symtab[i].type) == class_SUBPROGRAM) {
	      	  sym_list[n++] = &loc_symtab[i];
	    }
	}
	if(n != 0) {
	      sort_symbols(sym_list,n);


	      fprintf(list_fd,"\nExternal subprograms referenced:\n");
	      imps += print_symbols(list_fd,sym_list,n,TRUE);
	}

      }/*if(do_symtab)*/
#endif


#ifdef rigo
				/* Print list of statement functions */
    if(do_symtab) {
           unsigned i,n;

	   for(i=0,n=0;i<loc_symtab_top;i++) {
	       if(storage_class_of(loc_symtab[i].type) == class_STMT_FUNCTION){
	      	  sym_list[n++] = &loc_symtab[i];
	       }
	   }
	   if(n != 0) {
	      sort_symbols(sym_list,n);
	      fprintf(list_fd,"\nStatement functions defined:\n");
	      imps += print_symbols(list_fd,sym_list,n,TRUE);
	    }
    }/*if(do_symtab)*/
#endif


#ifdef rigo
				/* Print the common blocks */
    if(do_symtab || port_check || f77_standard) {
           unsigned i,numblocks;

	   for(i=0,numblocks=0;i<loc_symtab_top;i++) {
	      if(storage_class_of(loc_symtab[i].type) == class_COMMON_BLOCK) {
	      	  sym_list[numblocks++] = &loc_symtab[i];
	      }
	   }

	   if(numblocks != 0) {
	      sort_symbols(sym_list,numblocks);
	      if(do_symtab) {
		  fprintf(list_fd,"\nCommon blocks referenced:\n");
		  (void) print_symbols(list_fd,sym_list,numblocks,FALSE);
	      }
	      if(port_check || f77_standard) {
		    check_mixed_common(list_fd,sym_list,numblocks);
	      }
	   }
     }/*if(do_symtab||port_check)*/
#endif

#ifdef rigo
				/* Print the namelists */
    if(do_symtab) {
           unsigned i,numlists;

	   for(i=0,numlists=0;i<loc_symtab_top;i++) {
	      if(storage_class_of(loc_symtab[i].type) == class_NAMELIST) {
	      	  sym_list[numlists++] = &loc_symtab[i];
	      }
	   }

	   if(numlists != 0) {
	      sort_symbols(sym_list,numlists);
	      if(do_symtab) {
		  fprintf(list_fd,"\nNamelists defined:\n");
		  (void) print_symbols(list_fd,sym_list,numlists,FALSE);
	      }
	    }

    }/* End printing the namelists */
#endif
				/* Process the variables */

/*     if(do_symtab || usage_check) { */
    {
        unsigned i,n;

	for(i=0,n=0;i<loc_symtab_top;i++) {
	       if(storage_class_of(loc_symtab[i].type) == class_VAR
	       && (!loc_symtab[i].entry_point || this_is_a_function)) {
		  sym_list[n++] = &loc_symtab[i];
#ifdef rigo
		  if(loc_symtab[i].argument && loc_symtab[i].set_flag) {
		    if(++args_modified <= 3)
			if(this_is_a_function && pure_functions) {
			    identify_module(mod_name);
			    fprintf(list_fd,
				  "Function %s %s argument %s",
				  mod_name,
				  loc_symtab[i].assigned_flag?
					"modifies":"may modify",
				  loc_symtab[i].name);
			}
		  }
		  if(loc_symtab[i].common_var && loc_symtab[i].set_flag) {
		    if(++com_vars_modified <= 3)
			if(this_is_a_function && pure_functions) {
			    identify_module(mod_name);
			    fprintf(list_fd,
				  "Function %s %s common variable %s",
				  mod_name,
				  loc_symtab[i].assigned_flag?
					"modifies":"may modify",
				  loc_symtab[i].name);
			}
		  }
#endif
	       }
	}
#ifdef rigo
	if(args_modified > 3 || com_vars_modified > 3)
	  if(this_is_a_function && pure_functions)
	    fprintf(list_fd,"\netc...");
#endif

	if(n != 0) {
	   sort_symbols(sym_list,n);

			/* Print the variables */

#ifdef rigo
	   if(do_symtab) {
	      fprintf(list_fd,"\nVariables:\n ");
	      imps += print_variables(sym_list,n);
	   }
#endif
        }
			/* Explain the asterisk on implicitly defined
			   identifiers.  Note that this message will
			   be given also if functions implicitly defined */
#ifdef rigo
	if(do_symtab && imps != 0) {
	     fprintf(list_fd,"\n* Variable not declared.");
	     fprintf(list_fd," Type has been implicitly defined.\n");
	     ++warning_count;
	}
#endif

	check_flags(sym_list,n,0,0,0,
		  "declared but never referenced",mod_name);
/* 	check_flags(sym_list,n,0,1,0, */
/* 		  "set but never used",mod_name); */
/* 	check_flags(sym_list,n,1,0,1, */
/* 		  "used before set",mod_name); */
/* 	check_flags(sym_list,n,1,1,1, */
/* 		  "may be used before set",mod_name); */

#ifdef rigo
	if(do_symtab || do_list)
	  fprintf(list_fd,"\n");
#endif

    }/* end if(do_symtab || usage_check) */

#ifdef rigo
			/* List all undeclared vars & functions */
    if(decls_required || implicit_none) {
        unsigned i,n;

	for(i=0,n=0;i<loc_symtab_top;i++) {
	    if(datatype_of(loc_symtab[i].type) == type_UNDECL
		&& ! loc_symtab[i].intrinsic /* omit intrinsics */
				/* omit subroutines called */
		&& (!loc_symtab[i].external || loc_symtab[i].invoked_as_func)
	       ) {
		sym_list[n++] = &loc_symtab[i];
	    }
	}
	if(n != 0) {
	    sort_symbols(sym_list,n);
	    identify_module(mod_name);
	    fprintf(list_fd,
		    "Identifiers of undeclared type");
	    (void) print_symbols(list_fd,sym_list,n,FALSE);
	}
    }/*if(decls_required || implicit_none)*/

			/* Under -f77, list any nonstandard intrinsics used */
    if(f77_standard) {
      unsigned i,n;
      for(i=0,n=0;i<loc_symtab_top;i++) {
	if(storage_class_of(loc_symtab[i].type) == class_SUBPROGRAM
	   && loc_symtab[i].intrinsic &&
	   (loc_symtab[i].info.intrins_info->intrins_flags & I_NONF77)) {
	  sym_list[n++] = &loc_symtab[i];
	}
      }
      if(n != 0) {
	sort_symbols(sym_list,n);
	identify_module(mod_name);
	fprintf(list_fd,"Nonstandard intrinsic functions referenced:\n");
	(void) print_symbols(list_fd,sym_list,n,FALSE);
      }
    }/*if(f77_standard)*/


		/* issue -f77 warning for identifiers
		   longer than 6 characters
		*/
    if(f77_standard) {
        unsigned i,n;
	for(i=0,n=0;i<loc_symtab_top;i++) {
	       if(strlen(loc_symtab[i].name) > (unsigned)6)
		  sym_list[n++] = &loc_symtab[i];
	}

	if(n != 0) {

	   sort_symbols(sym_list,n);

	   ++warning_count;

	   identify_module(mod_name);
	   fprintf(list_fd,
		   "Names longer than 6 chars (nonstandard):");
	   (void) print_symbols(list_fd,sym_list,n,FALSE);
	}
    }

	/* If -f77 flag given, list names with underscore or dollarsign */

#if ALLOW_UNDERSCORES || ALLOW_DOLLARSIGNS
    if(f77_standard) {
        unsigned i,n;
	for(i=0,n=0;i<loc_symtab_top;i++) {
			/* Find all names with nonstd chars, but
			   exclude internal names like %MAIN */
	       if(has_nonalnum(loc_symtab[i].name) &&
		  loc_symtab[i].name[0] != '%')
		  sym_list[n++] = &loc_symtab[i];
	}

	if(n != 0) {

	   sort_symbols(sym_list,n);

	   ++warning_count;

	   identify_module(mod_name);

	   fprintf(list_fd,
		   "Names containing nonstandard characters");
	   (void) print_symbols(list_fd,sym_list,n,FALSE);
	}
    }/*if(f77_standard)*/
#endif

			/* Print out clashes in first six chars of name */
    if(sixclash) {
	 unsigned n;
	 n = find_sixclashes(sym_list);
	 if(n != 0) {
	    sort_symbols(sym_list,n);
	    identify_module(mod_name);
	    fprintf(list_fd,
		    "Identifiers which are not unique in first six chars");
	    (void) print_symbols(list_fd,sym_list,n,FALSE);
	 }/* end if(n != 0) */
    }/* end if(sixclash) */


		/* If portability flag was given, check equivalence
		   groups for mixed type. */
    if(port_check || local_wordsize==0) {
        unsigned i,j,n;
	unsigned imps=0;
	Lsymtab *equiv;

		/* scan thru table for equivalenced variables */
	for(i=0;i<loc_symtab_top;i++) {
	    if(storage_class_of(loc_symtab[i].type) == class_VAR
	       && loc_symtab[i].equiv_link != (equiv= &loc_symtab[i]) ){
		n=0;
		do {
		    if(equiv < &loc_symtab[i]) { /* skip groups done before */
			n=0;
			break;
		    }
		    sym_list[n++] = equiv;
		    equiv = equiv->equiv_link;
		} while(equiv != &loc_symtab[i]); /* complete the circle */
				/* Check for mixed types */
		if(n != 0) {
		    int mixed_type = FALSE, mixed_size = FALSE,
		        mixed_default_size = FALSE;
		    int t1,t2,s1,s2,defsize1,defsize2;

		    t1 = get_type(sym_list[0]);
		    s1 = get_size(sym_list[0],t1);
		    defsize1 = (s1 == size_DEFAULT);
		    if(s1 == size_DEFAULT) s1 = type_size[t1];
		    for(j=1; j<n; j++) {
		      t2 = get_type(sym_list[j]);
		      s2 = get_size(sym_list[j],t2);
		      defsize2 = (s2 == size_DEFAULT);
		      if(s2 == size_DEFAULT) s2 = type_size[t2];
		      if( t1 == t2 ) {
			if( t1 != type_STRING ){
				/* Same non-char types: size must match */
			  if( s1 != s2 ) {
			    mixed_size = TRUE;
			    break;
			  }
			  else if(defsize1 != defsize2) {
			    mixed_default_size = TRUE;
			    break;
			  }
			}
		      }
		      else {/* Different types */
				/* It is nonportable to equivalence:
				         Real*8 to Double or
					 Complex*16 to DComplex */
			if(type_category[t1] == type_category[t2]) {
			  if( s1 != s2 ) {
			    mixed_size = TRUE;
			    break;
			  }
			  else if(defsize1 != defsize2) {
			    mixed_default_size = TRUE;
			    break;
			  }
			}
				/* It is standard and portable to equivalence: