pgsymtab.c

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

			      "\nCommon block %s: array dimen/size mismatch",
			      name);
			fprintf(list_fd, "\nat position %d:", i+1);

			fprintf(list_fd,
				"\n    Has %ld dimension%s",
				d1,pluralize(d1));
			com_error_locate(c1);

			fprintf(list_fd,
				"\n    Has %ld dimension%s",
				d2,pluralize(d2));
			com_error_locate(c2);
		}/*end if(num dims mismatch)*/

		if((s1=array_size(a1[i].dimen_info)) !=
			(s2=array_size(a2[i].dimen_info))){

				/* stop after limit: probably a cascade */
			if(++dimerr > CMP_ERR_LIMIT) {
				fprintf(list_fd,"\n etc...");
				break;
			}
			if(dimerr == 1)
			  fprintf(list_fd,
			      "\nCommon block %s: array dimen/size mismatch",
				  name);
			fprintf(list_fd,
				"\nat position %d:", i+1);

			fprintf(list_fd,
				"\n    Has size %ld",
				s1);
			com_error_locate(c1);

			fprintf(list_fd,
				"\n    Has size %ld",
				s2);
			com_error_locate(c2);

		}/*end if(array size mismatch)*/
	}/*end for(i=0; i<n; i++)*/

}/*com_cmp_strict*/


/**  Common block and common variable usage checks.  Implemented
 **  by John Quinn, Jan-May 1993.  Some modifications made by RKM.
 **/

void
check_com_usage()
{
#ifdef DYNAMIC_TABLES		/* tables will be mallocked at runtime */
    Gsymtab  **gsymlist;
#else
    Gsymtab  *gsymlist[GLOBSYMTABSZ];
#endif
    int  i,numentries,numblocks;
    ComListHeader  *cmlist;

#ifdef DYNAMIC_TABLES
      if( (gsymlist=(Gsymtab **)SN_calloc(glob_symtab_top,sizeof(Gsymtab *)))
	 == (Gsymtab **)NULL) {
	  oops_message(OOPS_FATAL,NO_LINE_NUM,NO_COL_NUM,
		       "Cannot malloc space for common block list");
      }
#endif

				/* Print cross-reference list */
    if(print_xref_list) {
	for(i=numblocks=0;i<glob_symtab_top;i++){ /* loop thru global table */
	   if (storage_class_of(glob_symtab[i].type) == class_COMMON_BLOCK){

	     cmlist = glob_symtab[i].info.comlist;
	     numentries=0;

#ifdef DEBUG_COM_USAGE
	     fprintf(list_fd, "\n Common Block %s:\n",glob_symtab[i].name );
#endif

	     while (cmlist != NULL){ /* loop thru declarations */

	         if(! irrelevant(cmlist)  &&
		    (cmlist->any_used || cmlist->any_set))
		   gsymlist[numentries++] = cmlist->module;
#ifdef DEBUG_COM_USAGE
		 print_comvar_usage(cmlist);
#endif
		 cmlist = cmlist->next;

	      }  /* end of while */

	     if (numentries >0){ /* print modules that declare this block*/

	       if(numblocks++ == 0)
		 fprintf(list_fd,
		       "\n        Common block cross-reference list:\n");

	       fprintf(list_fd, "\nCommon Block %s used in:\n" ,
			glob_symtab[i].name );

	       sort_gsymbols(gsymlist,numentries);

	       print_modules(numentries,gsymlist);

	     }  /* end of if */


	   } /* end of if */

	} /* end of for */

	if(numblocks > 0)
	  fprintf(list_fd,"\n");

    }/* end if print_xref_list */

				/* Print out usage info */
    if(usage_check > 0) {
	for(i=0;i<glob_symtab_top;i++){ /* loop thru global table */
	   if (storage_class_of(glob_symtab[i].type) == class_COMMON_BLOCK){

	       com_block_usage(glob_symtab[i].name,
				 glob_symtab[i].info.comlist );
	   }
	}
    }
#ifdef DYNAMIC_TABLES
    (void) cfree(gsymlist);
#endif
}

PRIVATE void
print_modules(n,list)    /* formatting of module names */
	Gsymtab *list[];
	unsigned n;
{
	unsigned col=0,len,j;

        for (j=0;j<n;j++){
		 len=strlen(list[j]->name);
		 col+= len= (len<=10? 10:len) +3;
		 if (col >78){
			fprintf(list_fd, "\n");
			col = len;
		 } /* end of if */

		 fprintf(list_fd,"   %10s",list[j]->name);



	 } /* end of for */
}



#ifdef DEBUG_COM_USAGE

print_comvar_usage(comlist)

	ComListHeader *comlist;
{
        int i, count;
  	ComListElement *c;

  	count = comlist->numargs;
  	c = comlist->com_list_array;

/* prints out caller module and any_used, any_set flags in CLhead */

	fprintf(list_fd, "\nModule %s  any_used %u any_set %u\n",
                comlist->module->name, comlist->any_used, comlist->any_set);

        if((comlist->any_used || comlist-> any_set||1) ){
           for (i=0; i<count; i++){

/* prints out all four flags for each element in array */

              fprintf(list_fd,
		      "\n Element %d used %u set %u used bf set %u asgnd %u\n"
		      , i+1
		      , c[i].used
		      , c[i].set
		      , c[i].used_before_set
		      , c[i].assigned);
	   } /* end of for */

        } /* end of if */
}
#endif

	/* Check used, set status of common block.  First it looks for
	   whether the block is totally unused, and if so prints a warning
	   and returns.  Otherwise, if block is unused by some modules,
	   it says which ones.  Meanwhile, it finds the declaration with
	   the most elements to use as reference.  If common strictness
	   is 3 (variable by variable) then it OR's the usage flags of
	   each block variable among different declarations, saving the
	   result in reference list.  Passes off to com_element_usage
	   to print usage of individual common variables.
	   */
PRIVATE int any_com_warning;
#define IDENTIFY_COMBLOCK if(any_com_warning++ == 0) \
		fprintf(list_fd,"\nCommon block %s:",name)

PRIVATE void
com_block_usage(name,cl1)
     char *name;
     ComListHeader *cl1;
{
     ComListHeader *ref_cl,	/* reference decl: has most elements */
     	*cur_cl;		/* running cursor thru decls  */
     int j,n,ref_n;
     int block_any_used, block_any_set;
     int block_unused_somewhere;
     ComListElement *ref_list, *c;

	any_com_warning = 0; /* used to print block name once only */

        block_any_used = block_any_set = FALSE;
	block_unused_somewhere = FALSE;
	ref_n = cl1->numargs;
        ref_cl= cl1;
	cur_cl = cl1;
	while (cur_cl!=NULL){  /* traverses CLheads */
	  if(! irrelevant(cur_cl) ) {

            if (cur_cl->any_used){  /* stores TRUE if any are TRUE */
		block_any_used = TRUE;
            }
	    if (cur_cl->any_set){   /* stores TRUE if any are TRUE */
		block_any_set = TRUE;
	    }
	    if( ! (cur_cl->any_used || cur_cl->any_set) &&
		! cur_cl->module->defined_in_include ) {
	      block_unused_somewhere = TRUE;
	    }
   /* if any_set and any_used false after this loop block never used */

	    if (cur_cl->numargs > ref_n){ /* find largest array */
		ref_cl = cur_cl;
		ref_n = cur_cl->numargs;
            } /* end of if */
	  }/* end if not irrelevant */
	  cur_cl = cur_cl->next;
	}

        if(irrelevant(ref_cl))	/* Block not declared by modules in calltree */
	  return;

     if(! (block_any_used || block_any_set) ) {	/* Totally unused */
       if(check_unused) {
	 IDENTIFY_COMBLOCK;
	 fprintf(list_fd," unused %s.",name);
       }
     }
     else {
				/* If block used somewhere but not everywhere,
				   report it. */
        if(block_unused_somewhere && check_unused) {
	  IDENTIFY_COMBLOCK;
	  fprintf(list_fd," unused %s",name);
	  cur_cl = cl1;
	  while (cur_cl!=NULL){  /* traverses CLheads */
	    if(! irrelevant(cur_cl) ) {
	      if( ! (cur_cl->any_used || cur_cl->any_set) &&
		  ! cur_cl->module->defined_in_include ) {
		fprintf(list_fd,"\n  ");
		com_error_locate(cur_cl);
	      }
	    }
	    cur_cl = cur_cl->next;
	  }
	}/* end if block_unused_somewhere */

	if(! check_com_byname) {
				/* If not variablewise checking, just
				   give general warnings. */
	  if (!block_any_set){
	    if(check_set_used) {
	      IDENTIFY_COMBLOCK;
	      fprintf (list_fd," No elements are set, but some are used.");
	    }
	  }
	  if (!block_any_used){
	    if(check_set_used) {
	      IDENTIFY_COMBLOCK;
	      fprintf (list_fd," No elements are used, but some are set.");
	    }
	  }
        }
	else {	/* strictness == 3 */
				/* Now go thru the details for each element */
	  ref_list = ref_cl->com_list_array;
	  ref_cl->any_used = block_any_used;
	  ref_cl->any_set = block_any_set;

/* traversing elements in arrays and storing OR'd values in largest array*/

	  cur_cl = cl1;
	  while (cur_cl!=NULL){
	    if(! irrelevant(cur_cl) ) {
	      c = cur_cl->com_list_array;
	      n = cur_cl->numargs;
	      for (j=0; j<n; j++){
		if (c[j].used) {
		  ref_list[j].used = TRUE;
		}
		if (c[j].set){
		  ref_list[j].set = TRUE;
		}
		if (c[j].used_before_set){
		  ref_list[j].used_before_set = TRUE;
		}
		if (c[j].assigned){
		  ref_list[j].assigned = TRUE;
		}
	      }
	    }
	    cur_cl = cur_cl->next;
	  }
	  com_element_usage(name, ref_cl, ref_list, ref_n);
	}
     }
}


PRIVATE void
com_element_usage(name,  r_cl, r_list, r_num)

	char *name;
	ComListHeader *r_cl;
        ComListElement  *r_list;
	int r_num;

{
	int i,col, warnings;

 	if (r_cl->any_used || r_cl->any_set){  /* if false block not used */

	    if(check_set_used) {
	      warnings = 0;
	      for (i=0; i<r_num; i++){ /* Count used-not-set cases */
		if (r_list[i].used && !r_list[i].set){
		  warnings++;
		}
	      }
	      if(warnings > 0) {
		IDENTIFY_COMBLOCK;
		fprintf (list_fd,
			 "\n  Elements used but never set:");
		if(warnings == r_num) {
		  fprintf(list_fd," all");
		}
		else {
		  for (i=0,col=30; i<r_num; i++){
		    if (r_list[i].used && !r_list[i].set){
		      if( (col += 6) > 78 ) {
			fprintf(list_fd,"\n");
			col = 6;
		      }
		      fprintf(list_fd, " %5d", i+1);
		    }
		  }
	        }
	      }
	    }

	    if(check_unused) {
	      warnings = 0;
	      for (i=0; i<r_num; i++){ /* Count set-not-used cases */
		if (r_list[i].set && !r_list[i].used){
		  warnings++;
		}
	      }
	      if(warnings > 0) {
		IDENTIFY_COMBLOCK;
		fprintf (list_fd,
			 "\n  Elements set but never used:");
		if(warnings == r_num) {
		  fprintf(list_fd," all");
		}
		else {
		  for (i=0,col=30; i<r_num; i++){
		    if (r_list[i].set && !r_list[i].used){
		      if( (col += 6) > 78 ) {
			fprintf(list_fd,"\n");
			col = 6;
		      }
		      fprintf (list_fd, " %5d", i+1);
		    }
	          }
	        }
	      }
	    }

	    warnings = 0;
	    for (i=0,col=30; i<r_num; i++){
	      if(!r_list[i].set && !r_list[i].used &&
		 !r_list[i].used_before_set){
		    if(check_unused) {
		      IDENTIFY_COMBLOCK;
		      if (warnings++ == 0 ){
			fprintf (list_fd,
				 "\n  Elements never used, never set:");
		      }
		      if( (col += 6) > 78 ) {
			fprintf(list_fd,"\n");
			col = 6;
		      }
		      fprintf (list_fd, " %5d", i+1);
		    }
		}
	    }
	}
	else{	/* This cannot be reached if called only when block is used */
	  if(check_unused) {
	    IDENTIFY_COMBLOCK;
	    fprintf (list_fd," not used.");
	  }
	}            /* any_used and any_set are both false */



}
/** End of common block and variable usage checks **/

				/* Things used for common undef check */
PRIVATE int com_tree_error;
PRIVATE int block_is_volatile();
PRIVATE ComListHeader *com_tree_check(), *com_declared_by();
PRIVATE int numvisited;

void
visit_children()
{
  int i,
	num_mains,		/* number of main programs */
	num_roots;		/* number of uncalled nonlibrary modules */
  Gsymtab* main_module;

  num_roots =  0;
  for(i=0; i<glob_symtab_top; i++) {
    if(storage_class_of(glob_symtab[i].type) == class_SUBPROGRAM
       && ! glob_symtab[i].internal_entry) {
      sort_child_list(glob_symtab[i].link.child_list);
			/* Count uncalled non-library modules for use later */
      if(!glob_symtab[i].used_flag && !glob_symtab[i].library_module)
	  ++num_roots;	/* Count tree roots for use if no mains */
    }
  }

  if(print_ref_list)
    fprintf(list_fd,"\nList of subprogram references:");
  else if(print_call_tree)
    fprintf(list_fd,"\nTree of subprogram calls:");

				/* Visit children of all main progs */
  for(i=0,num_mains=0; i<glob_symtab_top; i++) {
    if(glob_symtab[i].type == type_byte(class_SUBPROGRAM,type_PROGRAM)) {
      main_module = &glob_symtab[i];
      if(print_ref_list)
	visit_child_reflist(main_module);
      else
	visit_child(main_module,0);
      ++num_mains;
    }
  }
				/* If no main program found, give
				   warning unless -noextern was set */
  if(num_mains == 0) {
    if(print_call_tree || print_ref_list) {
      fprintf(list_fd,"\n  (no main program found)");
    }
    else if(ext_def_check) {
      fprintf(list_fd,
	"\nNo main program found");
    }
		/* If no main, visit trees rooted at uncalled
		   nonlibrary routines, as the next best thing.
		   If there are no uncalled nonlib modules, use
		   uncalled library routines.  If there are no uncalled
		   routines, then there is a cycle!
		 */
    for(i=0; i<glob_symtab_top; i++) {
      if(storage_class_of(glob_symtab[i].type) == class_SUBPROGRAM
	&& !glob_symtab[i].used_flag &&
	 (num_roots == 0 || !glob_symtab[i].library_module) ) {
	if(print_ref_list)
	  visit_child_reflist(&glob_symtab[i]);
	else
	  visit_child(&glob_symtab[i],1); /* indent all trees one level */
      }
    }
  }
  if(print_call_tree || print_ref_list)
    fprintf(list_fd,"\n");

			/* Print list of callers of all visited
			   or non-library modules, if -crossref
			   flag given. */
  if(print_xref_list) {
    print_crossrefs();
  }

			/* Print linkage-order list of modules. */
  if( print_topo_sort ) {
    (void) toposort(glob_symtab,glob_symtab_top);
  }

			/* Check that common blocks retain definition
			   status between uses. */
  if(check_com_tree || check_volatile_com){
    if(num_mains != 1) {
      if(check_com_tree)
	fprintf(list_fd,
		"\nCommon definition check requires single main program");
      if(check_volatile_com)
	fprintf(list_fd,
		"\nCommon volatility check requires single main program");
    }
    else {
      numvisited = 0;		/* need headcount in case of cycle */
      for(i=0; i<glob_symtab_top; i++) {
	if(glob_symtab[i].visited_somewhere)
	  numvisited++;
      }
      for(i=0; i<glob_symtab_top; i++) {
	if(storage_class_of(glob_symtab[i].type) == class_COMMON_BLOCK) {
	  if( block_is_volatile(glob_symtab[i].info.comlist,main_module) ) {
	    if(check_volatile_com) {
	      fprintf(list_fd,
		   "\nCommon block %s is volatile",
		   glob_symtab[i].name);
	    }
	    if(check_com_tree) {
	      com_tree_error=0;
	      com_tree_check(&glob_symtab[i],main_module,0);
	    }
	  }