ftnchek.c

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

	char *env_name, *option_name;
{
    int i,c;

    strcat(strcpy(env_name,ENV_PREFIX),option_name);
    for(i=sizeof(ENV_PREFIX)-1; (c=env_name[i]) != '\0'; i++) {
	if( islower(c) )
	    env_name[i] = toupper(c);
    }
}


	/* set_option processes an option from command line.  Argument s is
	   the option string. First s is compared against boolean switches
	   from list in switchopt[].  If s matches switch string,
	   corresponding flag is set to TRUE.  If no match, then s is compared
	   to the same switches prefixed by "no", and if match is found, then
	   flag is set to FALSE.  Finally, special flags are handled.  If still
	   no match, an error message is generated.
	 */

#if 0
PRIVATE void
set_option(s)
	char *s;
{
	int i;
		/* look for noswitch flags first since otherwise
		   an option starting with no might take precedence */
	if(strncmp(s+1,"no",2) == 0) {
	    for(i=0; i<NUM_SWITCHES; i++) {
		if( strncmp(s+3,switchopt[i].name,OPT_MATCH_LEN) == 0) {
		    *(switchopt[i].switchflag) = FALSE;
		    return;
		}
	    }
	}

		/* -noswitch not found: look for nosetting flag */
	if(strncmp(s+1,"no",2) == 0) {
	    for(i=0; i<NUM_SETTINGS; i++) {
		if( strncmp(s+3,setting[i].name,OPT_MATCH_LEN) == 0) {
		    *(setting[i].setvalue) = setting[i].turnoff;
		    return;
		}
	    }
	}

				/* Next look for switches */
	for(i=0; i<NUM_SWITCHES; i++) {
	    if( strncmp(s+1,switchopt[i].name,OPT_MATCH_LEN) == 0) {
		*(switchopt[i].switchflag) = TRUE;
		return;
	    }
	}

		/* Handle settings of form "-opt=number" */
	for(i=0; i<NUM_SETTINGS; i++)
	    if( strncmp(s+1,setting[i].name,OPT_MATCH_LEN) == 0) {
		char *numstr;

		numstr = s + (OPT_MATCH_LEN + 1);
		while(*numstr != '\0')
		    if(*numstr++ == '=')	/* Find the = sign */
			break;

		if(read_setting(numstr, setting[i].setvalue, setting[i].name,
				setting[i].minlimit, setting[i].maxlimit,
				setting[i].turnoff) != 0)
			fprintf(stderr,"Setting garbled: %s: ignored\n",s);
		return;
	    }


		/* Handle settings of form "-opt=string" */
	for(i=0; i<NUM_STRSETTINGS; i++)
	    if( strncmp(s+1,strsetting[i].name,OPT_MATCH_LEN) == 0) {
		char *strstart;
#ifdef OPTION_PREFIX_SLASH
		int numchars;
#endif
		strstart = s + (OPT_MATCH_LEN + 1);
		while(*strstart != '=' && *strstart != '\0')
			strstart++;	/* Find the = sign */
		if(*strstart == '\0') {
		    fprintf(stderr,"String setting missing: %s: ignored\n",s);
		    return;
		}
		else {
		    *(strsetting[i].strvalue) = ++strstart;
				/* In VMS,MSDOS worlds, user might not leave
				   blank space between options.  If string
				   is followed by '/', must make a properly
				   terminated copy.  */
#ifdef OPTION_PREFIX_SLASH
		    for(numchars=0; strstart[numchars] != '\0'
			&& strstart[numchars] != '/'; numchars++)
		      continue;
		    if(strstart[numchars] != '\0') {
		      strncpy( *(strsetting[i].strvalue)=ckalloc(numchars+1),
			       strstart,numchars);
		    }
#endif

		}
			/* Handle necessary action for  -out=listfile */
		if(strsetting[i].strvalue == &out_fname) {
			must_open_outfile = TRUE;
		}
		return;
	    }


		/* No match found: issue error message */

	fprintf(stderr,"\nUnknown commandline switch: %s\n",s);
}
#endif

	/* Routine to read integer setting from string s and check if valid */

PRIVATE int
read_setting(s, setvalue, name, minlimit, maxlimit, turnoff)
	char *s;
	int *setvalue;
	char *name;
	int minlimit, maxlimit, turnoff;
{
	int given_val;

	if(strcmp(s,"NO")==0) {
	  *(setvalue) = turnoff;
	}
	else if(*s == '\0' || sscanf(s,"%d", &given_val) == 0) {
	    return -1;	/* error return: garbled setting */
	}
	else {		/* If outside limits, set to nearest limit */
	    int Ok=TRUE;
	    if(given_val < minlimit) {
		given_val = minlimit;
		Ok = FALSE;
	    }
	    else if(given_val > maxlimit) {
		given_val = maxlimit;
		Ok = FALSE;
	    }

	    if(! Ok ) {
		fprintf(stderr,"\nSetting: %s",name);
		fprintf(stderr," outside limits %d to %d",
				minlimit,maxlimit);
		fprintf(stderr,": set to %d\n",given_val);
	    }

	    *(setvalue) = given_val;
	}
	return 0;
}

#if 0
PRIVATE void
open_outfile(s)		/* open the output file for listing */
	char *s;
{
	char *fullname;		/* given name plus extension */
	FILE *fd;

	must_open_outfile = FALSE;	/* Turn off the flag */

	if(s == (char *) NULL || *s == '\0') {
		return;		/* No filename: no action  */
	}

	fullname = add_ext(s,DEF_LIST_EXTENSION);
	if( (fd = fopen(fullname,"w")) == NULL) {
		fprintf(stderr,"\nCannot open %s for output\n",fullname);
	}
	else {
		fprintf(stderr,"\nOutput sent to file %s\n",fullname);
		list_fd = fd;
	}
}


PRIVATE void
list_options(fd)/* List all commandline options, strsettings, and settings */
     FILE *fd;
{
	int i;

			/* Print the copyright notice */
	fprintf(fd,"\n%s",COPYRIGHT_DATE);
	fprintf(fd,"\n%s\n",COPYRIGHT_NOTICE);

		/* Note: Headings say "default" but to be accurate they
		   should say "current value".  This would be confusing. */
	fprintf(fd,"\nCommandline options [default]:");
	for(i=0; i<NUM_SWITCHES; i++) {

	  if( !debug_latest &&
	     strncmp(switchopt[i].explanation,"debug",5) == 0)
	    continue;		/* skip debug switches unless debug mode */

	  fprintf(fd,"\n    %c[no]%s",OPT_PREFIX,switchopt[i].name);
	  fprintf(fd," [%s]",*(switchopt[i].switchflag)? "yes": "no");
	  fprintf(fd,": %s",switchopt[i].explanation);
	}
		/* String settings follow switches w/o their own heading */
	for(i=0; i<NUM_STRSETTINGS; i++) {
	  if( !debug_latest &&
	     strncmp(strsetting[i].explanation,"debug",5) == 0)
	    continue;		/* skip debug settings unless debug mode */

	  fprintf(fd,"\n    %c%s=str ",OPT_PREFIX,strsetting[i].name);
	  fprintf(fd,"[%s]",
	  	*(strsetting[i].strvalue)? *(strsetting[i].strvalue): "NONE");
	  fprintf(fd,": %s",strsetting[i].explanation);
	}

	fprintf(fd,"\nSettings (legal range) [default]:");
	for(i=0; i<NUM_SETTINGS; i++) {

	  if( !debug_latest &&
	     strncmp(setting[i].explanation,"debug",5) == 0)
	    continue;		/* skip debug settings unless debug mode */

	  fprintf(fd,"\n    %c%s=dd ",OPT_PREFIX,setting[i].name);
	  fprintf(fd,"(%d to %d) ",setting[i].minlimit,
		  setting[i].maxlimit);
	  fprintf(fd,"[%d]",*(setting[i].setvalue));
	  fprintf(fd,": %s",setting[i].explanation);
	}

    fprintf(fd,
    	"\n(First %d chars of option name significant)\n",OPT_MATCH_LEN);
}


PRIVATE void
wrapup()	/* look at cross references, etc. */
{
	if(debug_hashtab || debug_glob_symtab)
	  debug_symtabs();

	visit_children();	/* Make call tree & check visited status */
	check_com_usage();	/* Look for unused common stuff */
	check_comlists();	/* Look for common block mismatches */
	check_arglists();	/* Look for subprog defn/call mismatches */
}
#endif


#define MODE_DEFAULT_EXT 1
#define MODE_REPLACE_EXT 2
PRIVATE char *
append_extension(s,ext,mode)
     char *s,*ext;
     int mode;
{
		/* MODE_DEFAULT_EXT: Adds extension to file name s if
		   none is present, and returns a pointer to the
		   new name.  If extension was added, space is allocated
		   for the new name.  If not, simply  returns pointer
		   to original name.  MODE_REPLACE_EXT: same, except given
		   extension replaces given one if any.
		*/
	int i,len;
	char *newname;
#ifdef OPTION_PREFIX_SLASH	/* set len=chars to NUL or start of /opt */
	for(len=0; s[len] != '\0' && s[len] != '/'; len++)
	  continue;
#else
	len=(unsigned)strlen(s);
#endif
		/* Search backwards till find the dot, but do not
		   search past directory delimiter
		*/
	for(i=len-1; i>0; i--) {
	    if(s[i] == '.'
#ifdef UNIX
	       || s[i] == '/'
#endif
#ifdef VMS
	       || s[i] == ']' || s[i] == ':'
#endif
#ifdef MSDOS
	       || s[i] == '\\' || s[i] == ':'
#endif
	       )
		break;
	}

	if(mode == MODE_REPLACE_EXT) {
	  if(s[i] == '.')	/* declare length = up to the dot */
	    len = i;
	  newname = (char *) ckalloc( (unsigned)(len+(unsigned)strlen(ext)+1) );
	  (void)strncpy(newname,s,len);
	  (void)strcpy(newname+len,ext);
	}
	else {			/* MODE_DEFAULT_EXT */
#ifdef OPTION_PREFIX_SLASH
		/* create new string if new ext or trailing /option */
	  if(s[i] != '.' || s[len] != '\0') {
	    if(s[i] != '.') {	/* no extension given */
	      newname = (char *) ckalloc( (unsigned)(len+(unsigned)strlen(ext)+1) );
	      (void)strncpy(newname,s,len);
	      (void)strcpy(newname+len,ext);
	    }
	    else {		/* extension given but /option follows */
	      newname = (char *) ckalloc( (unsigned)(len+1) );
	      (void)strncpy(newname,s,len);
	    }
	  }
#else
	  if(s[i] != '.') {
	    newname = (char *) ckalloc( (unsigned)(len+(unsigned)strlen(ext)+1) );
	    (void)strcpy(newname,s);
	    (void)strcat(newname,ext);
	  }
#endif
	  else {
	    newname = s;	/* use as is */
	  }
	}

	return newname;
}

		/* Adds default extension to source file name, replacing
		   any that is present, and returns a pointer to the
		   new name.  Space is allocated for the new name.
		*/
char *
add_ext(s,ext)			/* adds default filename extension to s */
	char *s,*ext;
{
  return append_extension(s,ext,MODE_DEFAULT_EXT);
}

char *
new_ext(s,ext)
	char *s,*ext;
{
  return append_extension(s,ext,MODE_REPLACE_EXT);
}


PRIVATE int
cistrncmp(s1,s2,n)			/* case-insensitive strncmp */
     char *s1,*s2;
     unsigned n;
{
  while( n != 0 &&
      (isupper(*s1)?tolower(*s1):*s1) == (isupper(*s2)?tolower(*s2):*s2) ) {
    if(*s1 == '\0')
      return 0;
    if(*s2 == '\0')
      break;
    ++s1; ++s2; --n;
  }
  return n==0? 0: *s1 - *s2;
}

int
has_extension(name,ext)		/* true if name ends in ext */
  char *name,*ext;
{
  unsigned name_len, ext_len;
  int stem_len;
  ext_len = strlen(ext);

#ifdef VMS	/* shell_glob adds version number: filename.ext;1 */
  if(strrchr(name,';') != NULL) {
    name_len = strrchr(name,';') - name; /* distance to the semicolon */
  }
  else
#endif
    name_len=strlen(name);	/* distance to the null */

  stem_len = (unsigned)(name_len - ext_len); /* distance to the dot */

  if( stem_len >= 0 &&
     (name_len-stem_len) == ext_len &&
     cistrncmp(name+stem_len,ext,ext_len) == 0 )
    return TRUE;
  else
    return FALSE;
}

		/* Add an include directory path to list of paths */
#ifdef ALLOW_INCLUDE
PRIVATE void
append_include_path(new_path)
     char *new_path;
{
  IncludePathNode *new_path_node, *p;
  if((new_path_node=(IncludePathNode *)ckalloc(sizeof(IncludePathNode)))
     ==(IncludePathNode *)NULL)
    fprintf(stderr,"\nmalloc error getting path list");
  else {
    new_path_node->link = (IncludePathNode *)NULL;
    new_path_node->include_path = new_path;
				/* Append the new node at end of list */
    if((p=include_path_list) == (IncludePathNode *)NULL)
      include_path_list = new_path_node;
    else {
      while(p->link != (IncludePathNode *)NULL)
	p = p->link;
      p->link = new_path_node;
    }
  }
}
#endif/*ALLOW_INCLUDE*/

#if 0
PRIVATE void
resource_summary()
{
#ifdef DEVELOPMENT
	    if(debug_latest)
	      print_sizeofs();	/* give sizeof various things */
#endif
	    fprintf(list_fd,
    "\nMax namestring space used = %lu local, %lu global out of %lu chars",
			max_loc_strings,
			max_glob_strings,
			(unsigned long)STRSPACESZ);
	    fprintf(list_fd,
		"\nMax local symbols used =  %lu out of %lu available",
			max_loc_symtab,
			(unsigned long)LOCSYMTABSZ);
	    fprintf(list_fd,
		"\nMax global symbols used = %lu out of %lu available",
			max_glob_symtab,
			(unsigned long)GLOBSYMTABSZ);
	    fprintf(list_fd,
		"\nMax number of tokenlists used = %lu out of %lu available",
			max_tokenlists,
			(unsigned long)TOKENSPACESZ);
	    fprintf(list_fd,
		"\nMax tokenlist space used = %lu out of %lu available",
			max_token_space,
			(unsigned long)TOKENSPACESZ);
	    fprintf(list_fd,
		"\nNumber of subprogram invocations = %lu totaling %lu args",
			arglist_head_used,
			arglist_element_used);
	    fprintf(list_fd,
		"\nNumber of common block decls = %lu totaling %lu variables",
			comlist_head_used,
			comlist_element_used);
	    fprintf(list_fd,
		"\nIdentifier hashtable size = %6lu",
			(unsigned long)HASHSZ);
#ifdef KEY_HASH/* not used any more*/
	    fprintf(list_fd,
		"\nKeyword hashtable size = %6lu",
			(unsigned long)KEYHASHSZ);
#endif
#ifdef COUNT_REHASHES
	    fprintf(list_fd,
		"\nIdentifier rehash count = %6lu",
			rehash_count);
#endif
	    fprintf(list_fd,
		"\nIntrinsic function hashtable size=%6lu, clash count=%lu",
			(unsigned long)INTRINS_HASHSZ,
			intrins_clashes);
	    fprintf(list_fd,"\n\n");
}
#endif