/* ftnpp.c:  Fortran Preprocessor.

   This reads in a Fortran source file, interpolating INCLUDE files
   and #include files, and passing the result through CPP (the
   preprocessor defined in config.h).  If no source file specified,
   reads stdin.

*/

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

#include "ftnchek.h"

PROTO(int main, ( int argc, char *argv[] ));
PROTO(PRIVATE FILE *open_infile, ( char *s ));
PROTO(PRIVATE FILE *open_pipeout, ( char *prog, char *args[] ));
PROTO(PRIVATE FILE *open_incfile, ( char *s ));
PROTO(PRIVATE VOID read_srcfile,( FILE *fd ));
PROTO(PRIVATE char *see_include_line, ( char *line ));
PROTO(PRIVATE FILE* find_include, ( char **fname ));
PROTO(PRIVATE FILE * fopen_with_path, ( char *inc_path, char **fname ));
PROTO(PRIVATE VOID append_include_path, ( char *new_path ));

char line[MAXLINE+1];		/* input line buffer */
IncludePathNode *include_path_list; /* header to the include-path list */

FILE *input_fd, *list_fd;

char *current_filename;

int strip_comments = TRUE;	/* turned off by -C flag */
int print_line_nums = TRUE;	/* turned off by -P flag */

			/* Macro to add another element to growing array
			   of char *
			 */
#define add_to_list(NUM,PTR,STR)				\
	    NUM++;						\
	    PTR = (char **)realloc(PTR,NUM*sizeof(char *));	\
	    if(PTR == (char **)NULL) {				\
		fprintf(stderr,"Cannot allocate memory\n");	\
		exit(1);					\
	    }							\
	    PTR[NUM-1] = STR

int
#if HAVE_STDC
main(int argc, char **argv)
#else /* K&R style */
main(argc,argv)
	int argc;
	char *argv[];
#endif /* HAVE_STDC */
{
    int iarg, ifile;
    char **filelist = (char **) NULL;
    char **cpp_arglist = (char **) NULL;
    int num_files=0;
    int num_cpp_args=0;

    char *stdin_filelist[]={ "" }; /* for use when input is stdin */

    include_path_list = (IncludePathNode*) NULL;

    for(iarg=1; iarg<argc; iarg++) {
	int i;
				/* Process any flags.  "-" is a file arg. */
	if(argv[iarg][0] == '-' && argv[iarg][1] != '\0') {
	    switch(argv[iarg][1]) {
				/* -C (keep comments) */
	    case 'C':
		strip_comments = FALSE;
		break;

				/* -I includepath */
	    case 'I':
		i = 2;
		if(argv[iarg][i] == '\0') {/* handle separated args */
		    iarg++;
		    i = 0;
		    if( iarg == argc ) {
			fprintf(stderr,"Missing include file after -I\n");
			break;
		    }
		}
		append_include_path(&argv[iarg][i]);
		break;

				/* -P suppress '#-lines' */
	    case 'P':
		print_line_nums = FALSE;
		break;

	    case 'D':		/* -D and -U recognized but not processed */
	    case 'U':
		if(argv[iarg][2] == '\0') {/* handle separated args */
		    iarg++;
		    if( iarg == argc ) {
			fprintf(stderr,"Missing macro name after %s\n",
				argv[iarg-1]);
		    }
		}
		break;

	    default:		/* Ignore unrecognized flags */
		break;
	    }
	}

				/* Save any file arguments in list */
	else {
	    add_to_list(num_files,filelist,argv[iarg]);
	}
    }

			/* Now go back over args, copying all the ones
			   that we pass to cpp into cpp_arglist.  First,
			   put in argv[0] = name of cpp.
			 */
    add_to_list(num_cpp_args,cpp_arglist,CPP);

    for(iarg=1; iarg<argc; iarg++) {
				/* Process any flags */
	if(argv[iarg][0] == '-' && argv[iarg][1] != '\0') {
				/* Stop copying after seeing -- */
	    if(strcmp(argv[iarg],"--") == 0)
		break;

	    add_to_list(num_cpp_args,cpp_arglist,argv[iarg]);

	    switch(argv[iarg][1]) {
				/* options with arguments */
	    case 'D':
	    case 'I':
	    case 'U':
		if(argv[iarg][2] == '\0') {/* handle separated args */
		    if( ++iarg < argc ) {
			add_to_list(num_cpp_args,cpp_arglist,argv[iarg]);
		    }
		}
		break;

				/* options without arguments */
	    default:
		break;
	    }
	}
    }

				/* Check for proper invocation */
    if( num_files > 2 ) {
	fprintf(stderr,"Usage: ftnpp [options] [infile [outfile]]\n");
	exit(1);
    }
				/* If outfile specified, pass it to cpp,
				   and give cpp the "-" argument for infile
				   to be stdin.
				 */
    if( num_files == 2 ) {
	add_to_list(num_cpp_args,cpp_arglist,"-");
	add_to_list(num_cpp_args,cpp_arglist,filelist[1]);
	num_files = 1;		/* remove outfile from list */
    }

				/* Terminate arg list with a NULL as
				   required by execv().
				 */
    add_to_list(num_cpp_args,cpp_arglist,(char *)NULL);

#ifdef DEBUG_CPP_ARGS
    for(iarg=0; iarg<num_cpp_args; iarg++)
	printf("<%s>\n",cpp_arglist[iarg]);
#endif


				/* If no file args or infile is "-", use
				   stdin for infile.
				 */
    if( num_files == 0 || strcmp(filelist[0],"-") == 0 ) {
	num_files = 1;
	filelist = stdin_filelist;
    }

				/* Read the infile */

    for(ifile=0; ifile<num_files; ifile++) {
	input_fd = open_infile(filelist[ifile]);
	if( input_fd == (FILE *)NULL ) {
	    fprintf(stderr,"\nError opening source file ");
	    perror(filelist[ifile]);
	}
	else {
	    list_fd = open_pipeout(CPP,cpp_arglist);
	    if( list_fd == (FILE *)NULL ) {
		fprintf(stderr,"\nError forking ");
		perror(CPP);
	    }
	    else {
		read_srcfile(input_fd);
		pclose(list_fd);
	    }
	    fclose(input_fd);
	}
    }

    return 0;
}

PRIVATE VOID
#if HAVE_STDC
read_srcfile(FILE *fd)
#else /* K&R style */
read_srcfile(fd)
    FILE *fd;
#endif /* HAVE_STDC */
{
    char *incname;
    FILE *incfd;
    char *parent_filename = current_filename;
    int line_num = 1;

    if(print_line_nums) {
	fprintf(list_fd,"# %d \"%s\"\n",line_num,current_filename);
    }
    while( fgets(line,MAXLINE+1,fd) != NULL ) {
	line_num++;
				/* Suppress f77 comments.  We do not
				   suppress ! comments since they need
				   more context to be sure about them.
				 */
	if( line[0] == 'C' || line[0] == 'c' || line[0] == '*' ) {
	    if( strip_comments )
		fputs("\n",list_fd);
	    else
		fputs(line,list_fd);
	}
				/* If line has an include directive, open
				   the file.  If can't open: just pass it on.
				*/
	else if( ((incname = see_include_line(line)) == (char *)NULL) ||
		 ((incfd = open_incfile(incname)) == (FILE *)NULL) ) {
	    fputs(line,list_fd);
	}
	else {
				/* Read the include file. */
	    read_srcfile(incfd);
	    pclose(incfd);
	    current_filename = parent_filename; /* restore clobbered value */
				/* Print a # line directive to say we're
				   back in the original file.
				*/
	    if(print_line_nums) {
		fprintf(list_fd,"# %d \"%s\"\n",line_num,current_filename);
	    }
	}
    }
}


			/* Open source file, record its name.
			 */
PRIVATE FILE *
#if HAVE_STDC
open_infile(char *infile)
#else /* K&R style */
open_infile(infile)
    char *infile;
#endif /* HAVE_STDC */
{
    FILE *fd;
				/* If file is null string, then it's stdin.
				 */
    if( infile[0] == '\0' ) {
	fd = stdin;
    }
    else {
	fd = fopen(infile,"r");
    }

    if(fd != NULL)
	current_filename = infile;

    return fd;
}

PRIVATE FILE *
#if HAVE_STDC
open_pipeout(char *prog, char *args[])
#else /* K&R style */
open_pipeout(prog, args)
    char *prog;
    char *args[];
#endif /* HAVE_STDC */
{
  int pfd[2];			/* Pipe file descriptors */
  FILE *pipeout=NULL;		/* File pointer to pipe write end */
  pid_t child_pid;


  if( pipe(pfd) != 0 ) {		/* Open the parent -> child pipe */
      perror("pipe open failed in open_pipeout");
      return pipeout;
  }


  if( (child_pid = fork()) != 0 ) { /* Start up a child process */
  
    if( child_pid == -1) {	/* Fork failed */
	perror("fork failed in open_pipeout");
	exit(1);
    }

			/* Child process starts here */

    (void) close(pfd[1]);		/* Close the writing end of pipe */

    if( dup2(pfd[0],0) == -1) {	/* Redirect child's stdin to come from pipe */
	perror("failed to redirect stdin to pipe in open_pipeout");
	exit(1);
    }

    if(execv(prog,args) == -1) {
	fprintf(stderr,"open_pipeout failed to exec ");
	perror(prog);
	exit(1);
    }
  }			/* Child process ends here */

  else {		/* Parent process continues here */
      (void) close(pfd[0]);		/* Close reading end of pipe */
      pipeout = fdopen(pfd[1],"w");	/* Open file ptr to pipe */
  }

  return pipeout;
}


				/* Recognize either Fortran INCLUDE statement
				   or cpp #include line.  Return pointer to
				   the name of the include-file.
				 */
PRIVATE char *
#if HAVE_STDC
see_include_line(char *line)
#else /* K&R style */
see_include_line(line)
	char *line;
#endif /* HAVE_STDC */
{
    char *incfile = (char *)NULL; /* name of include file */

				/* Skip over leading space.  Also skip over
				   any '#' sign of a cpp style include.
				 */
    while( *line != '\0' && (isspace(*line) || (*line == '#')) ) {
	++line;
    }

    if( strncasecmp(line,"include",7) == 0 ) {
	int delim;
	line += 7;		/* skip over "include" */
	while( *line != '\0' && isspace(*line) ) {
	    ++line;		/* skip over following space */
	}
				/* See if next thing is a quote mark */
	if( *line == '\'' || *line == '"' ) {
	    delim = *line;	/* Remember which kind of quote it is */
	    ++line;
	    incfile = malloc(strlen(line));
	    if( incfile != (char *)NULL ) {
				/* Copy up to next quote mark.  If filename
				   has a quote mark, too bad.
				*/
		char *p = incfile;
		while( *line != '\0' && *line != delim ) {
		    *p++ = *line++;
		}
			/* If closing quote not found, back out. */
		if( *line != delim ) {
		    free(incfile);
		    incfile = (char *)NULL;
		}
		else {
		    *p++ = '\0';
		}
	    }
	}
    }

    return incfile;
}


PRIVATE FILE *
#if HAVE_STDC
open_incfile(char *infile)
#else /* K&R style */
open_incfile(infile)
    char *infile;
#endif /* HAVE_STDC */
{
    return find_include(&infile);
}

PRIVATE FILE*
#if HAVE_STDC
find_include(char **fname)	/* looks for file locally or in include dir */
                  		/* If found, fname is returned with full path*/
#else /* K&R style */
find_include(fname)		/* looks for file locally or in include dir */
     char **fname;		/* If found, fname is returned with full path*/
#endif /* HAVE_STDC */
{
  FILE *fp;
  char *env_include_var;
  IncludePathNode *p;
  char *path_end=(char *)NULL;
  int fname_path_absolute=FALSE;

			/* Look first for bare filename.  If it is an
			   absolute path, then it must be found as it is.
			   But if it is not absolute and the current source
			   filename is qualified with a path, evaluate
			   the include filename relative to that path.
			   Note: if OS is not included in the stanzas below,
			   the default behavior is to assume the include
			   file name is not an absolute path, and the
			   current file name is not qualified by a path.
			*/
  /* Still to do:
       ==> Handle MacOS.
   */
#ifdef UNIX
  fname_path_absolute = ((*fname)[0] == '/');
#endif
			/* VMS test is kinda simplistic: it just looks for
			   a colon, as in 'SOME_LOGNAME:INCFILE.H', or else
			   a left bracket not followed by a '-' or '.' which
			   are the two ways I know of to do relative paths.
			   I would appreciate hearing from somebody who knows
			   a way to do this more surely.
			*/
#ifdef VMS
  {
    char *lbracket;
    fname_path_absolute = ( strchr(*fname,':') != NULL
      || ((lbracket=strchr(*fname,'[')) != NULL &&
	  (lbracket[1] != '-' && lbracket[1] != '.') ) );
  }
#endif

			/* MSDOS test looks for forms like A:path or
			   \path or /path (the last since some
			   development environments support / as path
			   separator.)
			*/
#ifdef MSDOS
  fname_path_absolute = ((isalpha((*fname)[0]) && (*fname)[1] == ':')
    || (*fname)[0] == '\\' || (*fname)[0] == '/');
#endif


  if(fname_path_absolute) {	/* include filename is an absolute path */
    return open_infile(*fname);
  }


			/* Now look for a path qualifying source file name */
#ifdef UNIX
  path_end = strrchr(current_filename,'/');
#endif

#ifdef VMS
  path_end = strrchr(current_filename,']');
#endif

#ifdef MSDOS			/* look for either \ or / at end. */
  path_end = strrchr(current_filename,'\\');
  if(path_end == (char *)NULL)
    path_end = strrchr(current_filename,'/');
#endif

  if( path_end == (char *)NULL ) {
    if( (fp=open_infile(*fname)) != (FILE *)NULL) /* Not qualified by a path */
      return fp;
  }
  else				/* Input file name is qualified by a path */
  {
    char *local_path;
#ifdef VMS
    ++path_end;		/* need to retain the ']' */
#endif
				/* Get a copy of the local path */
    if( (local_path=malloc(path_end-current_filename+1))
	 == (char *)NULL ) {
      (void)fprintf(stderr,"Cannot allocate memory for include file path\n");
      return (FILE *)NULL;
    }
    strncpy(local_path,current_filename,path_end-current_filename);
    local_path[path_end-current_filename] = '\0';
    fp = fopen_with_path(local_path,fname);
    (void)free(local_path);
    if( fp != (FILE *)NULL ) {
      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)) != (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)) != (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)) != 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 *
#if HAVE_STDC
fopen_with_path(char *inc_path, char **fname)
#else /* K&R style */
fopen_with_path(inc_path,fname)
     char *inc_path, **fname;
#endif /* HAVE_STDC */
{
    FILE *fp;
    char *tmpname;		/* holds name with path prepended */
    if( (tmpname = malloc(strlen(inc_path)+strlen(*fname)+2))
	== (char *)NULL ) {
      (void)fprintf(stderr,"Cannot allocate memory for include file path\n");
      return (FILE *)NULL;
    }

    (void)strcpy(tmpname,inc_path);
				/* Add "/" or "\" if not provided */
#ifdef UNIX
    if(tmpname[strlen(tmpname)-1] != '/')
      (void)strcat(tmpname,"/");
#endif
#ifdef MSDOS
    if(tmpname[strlen(tmpname)-1] != '\\')
      (void)strcat(tmpname,"\\");
#endif
    (void)strcat(tmpname,*fname);

    if( (fp=open_infile(tmpname)) != (FILE *)NULL) {
			/* Found: save new name in permanent space */
	*fname = tmpname;
    }

    return fp;
}/*fopen_with_path*/

		/* Add an include directory path to list of paths */
PRIVATE VOID
#if HAVE_STDC
append_include_path(char *new_path)
#else /* K&R style */
append_include_path(new_path)
     char *new_path;
#endif /* HAVE_STDC */
{
  IncludePathNode *new_path_node, *p;
  if((new_path_node=(IncludePathNode *)malloc(sizeof(IncludePathNode)))
     ==(IncludePathNode *)NULL) {
    (void)fprintf(stderr,"malloc error getting path list\n");
  }
  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;
    }
  }

}