forlex.c

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

#ifdef VMS_INCLUDE /* for VMS: default extension is .for */
  if(has_extension(fname,"/nolist")) {
    list_option = FALSE;
    fname[strlen(fname)-strlen("/nolist")] = '\0'; /* trim off qualifier */
  }
  else if(has_extension(fname,"/list")) {
    list_option = TRUE;
    fname[strlen(fname)-strlen("/list")] = '\0'; /* trim off qualifier */
  }
  fname = add_ext(fname, DEF_SRC_EXTENSION);
#endif

  if ((fd = find_include(&fname,"r")) == NULL) {
#if 0
    fprintf(list_fd,"\nerror opening include file %s\n",fname);
#endif
    return;
  }

			/* Print the INCLUDE line if do_list */
  if(do_list)
    flush_line_out(prev_line_num);

			/* Report inclusion of file */
  if(verbose || do_list)
    fprintf(list_fd,"\nIncluding file %s:",fname);

		/* Save the current input stream and then open
		   the include file as input stream. */
  if( push_include_file(fname,fd) ) {
#ifdef VMS_INCLUDE
	/* put /[NO]LIST option into effect */
      if(do_list != list_option)
	fprintf(list_fd," (listing %s)", list_option? "on":"off");
      do_list = list_option;
#endif /*VMS_INCLUDE*/
  }
  else
    fclose(fd);
}

PRIVATE FILE*
find_include(fname,mode)	/* looks for file locally or in include dir */
     char **fname,		/* If found, fname is returned with full path*/
     *mode;
{
  FILE *fp;
  char *env_include_var;
  IncludePathNode *p;
  extern char *group;

			/* Look first for bare filename */
  if( (fp=fopen(*fname,mode)) != NULL)
  {
#ifndef NO_DATABASE
	put_file(*fname,group,NULL);
#endif
	return fp;
  }

		      /* If not found, look in directories given
			 by include_path_list from -include options */

  for(p=include_path_list; p!=NULL; p=p->link) {
    if( (fp=fopen_with_path(p->include_path,fname,mode)) != (FILE *)NULL)
    {
	return fp;
    }
  }

		      /* If not found, look in directory given by
			 env variable ENV_INCLUDE_VAR (e.g. set by
			 % setenv INCLUDE ~/myinclude ) */

  if( (env_include_var=getenv(ENV_INCLUDE_VAR)) != NULL) {
    if( (fp=fopen_with_path(env_include_var,fname,mode)) != (FILE *)NULL)
      return fp;
  }

			/* Still not found: look in systemwide
			   default directory */

#ifdef DEFAULT_INCLUDE_DIR
  if( (fp=fopen_with_path(DEFAULT_INCLUDE_DIR,fname,mode)) != NULL)
    return fp;
#endif/* DEFAULT_INCLUDE_DIR */

				/* Not found anywhere: fail */
  return (FILE *)NULL;
}/*find_include*/

		/* Routine to open file with name given by include_path
		   followed by fname.  If successful, fname is replaced
		   by pointer to full name.  */
PRIVATE FILE *
fopen_with_path(include_path,fname,mode)
     char *include_path, **fname, *mode;
{
    extern char *group;
    FILE *fp;
    char tmpname[256];		/* holds name with path prepended */

    strcpy(tmpname,include_path);
				/* Add "/" or "\" if not provided */
    if(tmpname[strlen(tmpname)-1] != '/')
      strcat(tmpname,"/");
    strcat(tmpname,*fname);

    if( (fp=fopen(tmpname,mode)) != (FILE *)NULL) {
			/* Found: save new name in permanent space */
	*fname=ckalloc((strlen(tmpname)+1)*sizeof(char));
	strcpy(*fname,tmpname);

#ifndef NO_DATABASE
	put_file(*fname,group,NULL);
#endif
    }

    return fp;
}/*fopen_with_path*/

#else /* no ALLOW_INCLUDE */
				/* disabled forms of include handlers */
PRIVATE int
push_include_file(fname,fd)
	char *fname;
	FILE *fd;
{return FALSE;}

PRIVATE int
pop_include_file()
{return FALSE;}

void
open_include_file(fname)
     char *fname;
{}

#endif /*ALLOW_INCLUDE*/

void
init_scan()			/* Starts reading a file */
{
	tab_count = 0;
	incdepth = 0;

	line = lineA;		/* Start out reading into buffer A */
	prev_line = lineB;

	init_stream();
}

PRIVATE void
init_stream()		/* Initializes a new input stream */
{
	curr_comment_line = FALSE;
	inside_string = FALSE;
	inside_hollerith = FALSE;
	line_is_printed = TRUE;
	prev_line_is_printed = TRUE;
	noncomment_line_count = 0;

	next_index = -1;	/* Startup as if just read a blank line */
	next_char = EOS;
	curr_index = -1;
	curr_char = EOS;
	next_col_num = 0;
	next_line_num = 0;
	prev_line_num = prev_stmt_line_num = 0;
	sticky_EOF = TRUE;
	contin_count = 0;

	line[0] = '\0';
	advance();		/* put 1st two chars in the pipeline */
	advance();
	advance();		/* gobble the artificial initial EOS */
}


void
finish_scan()
{
		/* clean up if no END statement at EOF */
	check_seq_header((Token *)NULL);
		/* print last line if not already done */
	if(do_list)
	    flush_line_out(line_num);
}

#ifdef INLINE_COMMENT_CHAR
	/* macro is used on next_char: must look at curr_char to avoid
	   being fooled by '!' without messing up on 'xxx'! either.
	   Also don't be fooled by '''!''' which is the string '!'
	   Note that inside_string does not yet reflect curr_char.
	   Test is that inside_string is true but about to become false,
	   or false and not about to become true. Think about it. */

#define inline_comment(c) ( ((c)==INLINE_COMMENT_CHAR) &&\
		(inside_string == (curr_char == '\'')) && (!inside_hollerith) )
#endif

	/* closeup: Advances input stream till next_char is nonspace.  Fudges
	   things so that curr_char remains as it was. */
PRIVATE void
closeup()
{
  int
    save_curr_char = curr_char,
    save_prev_char = prev_char,
    save_line_num = line_num,
    save_col_num = col_num,
    save_curr_index = curr_index;

  while(iswhitespace(next_char))
    advance();

  curr_char = save_curr_char;
  prev_char = save_prev_char;
  line_num = save_line_num;
  col_num = save_col_num;
  curr_index = save_curr_index;
}

LEX_SHARED void
advance()
{
#ifdef EOLSKIP
    int eol_skip = FALSE;
#endif
    prev_char = curr_char;
#ifdef EOLSKIP
    do{
#endif
	while(next_char == EOF) {	  /* Stick at EOF */
		if(curr_char == EOS || curr_char == EOF) {

			 /* Pause to allow parse actions at end of stmt
			    to have correct file context before popping
			    the include file.  Effect is to send an extra
			    EOS to parser at end of file. */
		  if(sticky_EOF) {
		    sticky_EOF = FALSE;
		    return;
		  }
				/* At EOF: close include file if any,
				   otherwise yield an EOF character. */
		  if( ! pop_include_file() ) {
		    curr_char = EOF;
		  }
		  return;
		}
		else {
		  curr_char = EOS;
		  return;
		}
	}

	if(curr_char == EOS)
		initial_flag = TRUE;

#ifdef EOLSKIP
	if(! eol_skip) {
#endif
	    curr_char = next_char;	  /* Step to next char of input */
	    curr_index = next_index;
	    col_num = next_col_num;
	    line_num = next_line_num;

#ifdef EOLSKIP
	}
#endif

	if(next_char == '\t'){	   /* Handle tabs in input */

		next_col_num = nxttab[next_col_num];

		if( ! (inside_string || inside_hollerith) )
		    tab_count++;	/*  for portability warning */
	}
	else {
		next_col_num++;
	}

	next_char = line[++next_index];

			/* If end of line is reached, input a new line.
			 */
	while(next_col_num > max_stmt_col || next_char == '\0'
#ifdef INLINE_COMMENT_CHAR
	|| inline_comment(next_char)
#endif
	){
		do {
			if(( next_col_num > max_stmt_col && next_char != '\0' )
#ifdef INLINE_COMMENT_CHAR
				|| inline_comment(next_char)
#endif
				|| curr_comment_line
			)
			{
			  char c = makeupper(line[curr_index]);
			  if (c == 'C' || c == '*' || (c && line[curr_index + 1] == '!'))
			  {
				int i;
				int index = curr_index;
				char acComment[1000];
				char *comment;
				char *classn;
				char *function;
				extern int current_struct_hash;
				extern int current_module_hash;
				extern	int	comment_database;

			  	if( hig_fp && incdepth == 0)
			  	{
 					fprintf( hig_fp, "%d rem %d.%d %d.%dlineend\n"
						   , PAF_HIGH
						   , next_line_num
						   , next_index - 1
						   , next_line_num
						   , next_index - 1
						   ); 
				}

				if (comment_database)
				{
					for (i = 0, comment = acComment;;)
					{
						c = line[index++];
						if( c == EOL || c == 0 )
							break;
						acComment[i++] = c;
					}
					acComment[i] = 0;

					if (*comment)
						comment++;
					if (*comment == '!')
						comment++;

					if( current_struct_hash != -1 )
					{
						classn = hashtab[current_struct_hash].name;
					}
					else
						classn = NULL;
					if( current_module_hash != -1 && incdepth == 0)
					{
						function = hashtab[current_module_hash].name;
					}
					else
						function = NULL;

					save_comment(current_filename, function, classn,
						next_line_num, next_index,comment);
				}
			  }
			}

			if(do_list) /* print prev line if not printed yet */
			  flush_line_out(prev_line_num);

#ifdef INLINE_COMMENT_CHAR
			if( f77_standard ) {
			  if( !curr_comment_line && inline_comment(next_char)){
			      nonstandard(next_line_num,next_col_num);
			      msg_tail(": inline comment");
			  }
		        }
#endif

			    /* Swap input buffers to get ready for new line.
			       But throw away comment lines if do_list is
			       false, so error messages will work right.
			     */
			if(do_list || ! curr_comment_line) {
			    char *temp=line;
			    line = prev_line;
			    prev_line=temp;
			    if(! curr_comment_line)
			      prev_stmt_line_num = line_num;
			    prev_line_num = next_line_num;
			    prev_line_is_printed = line_is_printed;
			}

			++next_line_num;
			next_col_num = 1;		/* rigo */
			next_index   = 1;		/* rigo */
			curr_index   = 0;		/* rigo */
			line_is_printed = FALSE;
			if( getstrn(line,MAXLINE+1,yyin) == NULL ) {
				next_char = EOF;
				line_is_printed = TRUE;
				return;
			}
#ifdef UNIX_CPP
			else
			  if(line[0] == '#')
			    cpp_handled = take_cpp_line(line);
#endif

			/*  Keep track of prior-comment-line situation */
			prev_comment_line = curr_comment_line;

		} while( (curr_comment_line = is_comment(line)) != FALSE);
		++noncomment_line_count;

			/* Handle continuation lines */
		if( (next_index = is_continuation(line)) != 0) {
				/* It is a continuation */
		    if( hig_fp )
		    {
		  	  if( strcmp( current_filename, top_filename ) == 0 )
			  {
 				  fprintf( hig_fp, "%d cont %d.%d %d.%d\n"
					     , PAF_HIGH
					     , next_line_num
					     , next_index
					     , next_line_num
					     , next_index+1
					     ); 
			  }
		    }
#ifdef EOLSKIP
		    if(eol_is_space) {
#endif
			next_char = EOL;
			next_col_num = 6;
#ifdef EOLSKIP
		    }
		    else {
			next_char = line[++next_index];
			next_col_num = 7;
			eol_skip = TRUE; /* skip continued leading space */
		    }
#endif
				/* Issue warnings if contin in funny places */
			if(noncomment_line_count == 1)
			    warning(next_line_num,(unsigned)6,
		    "Continuation mark found in first statement of file");
			if( pretty_flag && prev_comment_line )
			    ugly_code(next_line_num,(unsigned)6,
		    "Continuation follows comment or blank line");
		        if(contin_count++ == 19)
			  if(f77_standard) {
			    nonstandard(next_line_num,(unsigned)6);
			    msg_tail(": > 19 continuation lines");
			  }
		}
		else {
				/* It is not a continuation */
		    next_char = EOS;
		    next_col_num = 0;
		    next_index = -1;
		    contin_count = 0;
		}
	}/*end while( end of line reached )*/

		/* Avoid letting a '0' in column 6 become a token */
	if(next_col_num == 6 && next_char == '0')
		next_char = ' ';

#ifdef EOLSKIP
			/* elide EOL and following space of continued
			   stmts if requested */
	eol_skip = (eol_skip && isspace(next_char));
   }while(eol_skip);/*end do*/
#endif

}/* end advance */


	/*  Function which returns 0 if line is not a comment, 1 if it is.
	 *  Comment is ANSI standard: C or c or * in column 1, or blank line.
	 */

PRIVATE int
is_comment(s)
	char s[];
{
	int i,c= makeupper(s[0]);
	unsigned col;
	if( c == 'C' || c == '*' )
		return TRUE;

	for(i=0,col=1; s[i] != '\0'; i++)
		if( !isspace(s[i]))
#ifdef INLINE_COMMENT_CHAR
		/* Initial "!" starts a comment, except in col. 6 it
		   must be taken as continuation mark */
			 if(s[i]==INLINE_COMMENT_CHAR && col != 6) {
			     if(f77_standard) {
				 nonstandard(next_line_num,col);
				 msg_tail(": inline comment");
			     }
			     return TRUE;
			  }
			  else
			      return FALSE;
		else
			  if(s[i] == '\t') col = nxttab[col];
			  else		   col++;
#else
			return FALSE;
#endif
	return TRUE;		/* blank line */
}

	/* Here we handle Unix preprocessor lines.  The only ones
	   processed now are those that set the line number and filename.
	     Form 1: # line 10 "filename"
	     Form 2: # 10 "filename"
	   We replace next_filename and next_line_num by the
	   given values.
	 */
#ifdef UNIX_CPP
PRIVATE int
take_cpp_line(s)
     char *s;
{
  int linenum, nchar