path: root/gcc/f/g77.c

/* G77 preliminary semantic processing for the compiler driver.
   Copyright (C) 1993-1997 Free Software Foundation, Inc.
   Contributed by Brendan Kehoe (brendan@cygnus.com), with significant
   modifications for GNU Fortran by James Craig Burley (burley@gnu.ai.mit.edu).

This file is part of GNU Fortran.

GNU Fortran 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.

GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
02111-1307, USA.  */

/* This program is a wrapper to the main `gcc' driver.  The generic
   goal of this program is to be basically identical to gcc (in that
   it faithfully passes all of the original arguments to gcc) but,
   unless explicitly overridden by the user in certain ways, ensure
   that the needs of the language supported by this wrapper are met.

   For GNU Fortran (g77), we do the following to the argument list
   before passing it to `gcc':

   1.  Put `-xf77', `-xf77-cpp-input' or `-xratfor' before each list
       of foo.f, foo.F or foo.r source files and put `-xnone' after
       that list, if necessary.  This shouldn't normally be necessary,
       but it is done in case gcc.c normally treats .f/.F files as,
       say, to be compiled by f2c.

   2.  Make sure `-lf2c -lm' is at the end of the list.

   3.  Make sure each time `-lf2c' or `-lm' is seen, it forms
       part of the series `-lf2c -lm'.

   #1 is not done if `-xfoo' is in effect (where foo is not "none").
   #2 and #3 are not done if `-nostdlib' or any option that disables
   the linking phase is present, or if `-xfoo' is in effect.  Note that
   -v by itself disables linking.

   This program was originally made out of gcc/cp/g++.c, but the
   way it builds the new argument list was rewritten so it is much
   easier to maintain, improve the way it decides to add or not add
   extra arguments, etc.  And several improvements were made in the
   handling of arguments, primarily to make it more consistent with
   `gcc' itself.  */

#ifndef LANGUAGE_F77
#define LANGUAGE_F77 1	/* Assume f77 language wanted. */
#endif

#if LANGUAGE_F77 != 1
#include <stdio.h>

int
main (argc, argv)
     int argc;
     char **argv;
{
  fprintf (stderr, "\
g77: `f77' language not included in list of languages\n\
     built with this installation of gcc.\n");
  exit (1);
}

#else	/* LANGUAGE_F77 == 1 */
#include "config.j"
#include "zzz.h"
#include <sys/types.h>
#include <errno.h>

#ifndef _WIN32
#include <sys/file.h>   /* May get R_OK, etc. on some systems.  */
#else
#include <process.h>
#endif

#ifdef __STDC__
#include <stdarg.h>
#else
#include <varargs.h>
#endif
#include <stdio.h>

/* Include multi-lib information.  */
#include "multilib.h"

#ifndef R_OK
#define R_OK 4
#define W_OK 2
#define X_OK 1
#endif

#ifndef WIFSIGNALED
#define WIFSIGNALED(S) (((S) & 0xff) != 0 && ((S) & 0xff) != 0x7f)
#endif
#ifndef WTERMSIG
#define WTERMSIG(S) ((S) & 0x7f)
#endif
#ifndef WIFEXITED
#define WIFEXITED(S) (((S) & 0xff) == 0)
#endif
#ifndef WEXITSTATUS
#define WEXITSTATUS(S) (((S) & 0xff00) >> 8)
#endif

/* Defined to the name of the compiler; if using a cross compiler, the
   Makefile should compile this file with the proper name
   (e.g., "i386-aout-gcc").  */
#ifndef GCC_NAME
#define GCC_NAME "gcc"
#endif

/* On MSDOS, write temp files in current dir
   because there's no place else we can expect to use.  */
#ifdef __MSDOS__
#ifndef P_tmpdir
#define P_tmpdir "."
#endif
#ifndef R_OK
#define R_OK 4
#define W_OK 2
#define X_OK 1
#endif
#endif

/* Add prototype support.  */
#ifndef PROTO
#if defined (USE_PROTOTYPES) ? USE_PROTOTYPES : defined (__STDC__)
#define PROTO(ARGS) ARGS
#else
#define PROTO(ARGS) ()
#endif
#endif

#ifndef VPROTO
#ifdef __STDC__
#define PVPROTO(ARGS)		ARGS
#define VPROTO(ARGS)		ARGS
#define VA_START(va_list,var)	va_start(va_list,var)
#else
#define PVPROTO(ARGS)		()
#define VPROTO(ARGS)		(va_alist) va_dcl
#define VA_START(va_list,var)	va_start(va_list)
#endif
#endif

/* Define a generic NULL if one hasn't already been defined.  */

#ifndef NULL
#define NULL 0
#endif

/* Define O_RDONLY if the system hasn't defined it for us. */
#ifndef O_RDONLY
#define O_RDONLY 0
#endif

#ifndef GENERIC_PTR
#if defined (USE_PROTOTYPES) ? USE_PROTOTYPES : defined (__STDC__)
#define GENERIC_PTR void *
#else
#define GENERIC_PTR char *
#endif
#endif

#ifndef NULL_PTR
#define NULL_PTR ((GENERIC_PTR)0)
#endif

#ifdef USG
#define vfork fork
#endif /* USG */

/* On MSDOS, write temp files in current dir
   because there's no place else we can expect to use.  */
#ifdef __MSDOS__
#ifndef P_tmpdir
#define P_tmpdir "."
#endif
#endif

/* By default there is no special suffix for executables.  */
#ifndef EXECUTABLE_SUFFIX
#define EXECUTABLE_SUFFIX ""
#endif

/* By default, colon separates directories in a path.  */
#ifndef PATH_SEPARATOR
#define PATH_SEPARATOR ':'
#endif

#ifndef DIR_SEPARATOR
#define DIR_SEPARATOR '/'
#endif

static char dir_separator_str[] = {DIR_SEPARATOR, 0};

extern char *getenv ();

#ifndef errno
extern int errno;
#endif

extern int sys_nerr;
#ifndef HAVE_STRERROR
#if defined(bsd4_4)
extern const char *const sys_errlist[];
#else
extern char *sys_errlist[];
#endif
#else
extern char *strerror();
#endif

/* Name with which this program was invoked.  */
static char *programname;

/* argc, argv from main().  */
static int xargc;
static char **xargv;

/* The new argument list will be contained in these, though if identical
   to the original list, these will be == xargc, xargv.  */
static int newargc;
static char **newargv;

/* Options this driver needs to recognize, not just know how to
   skip over.  */
typedef enum
{
  OPTION_b,			/* Aka --prefix. */
  OPTION_B,			/* Aka --target. */
  OPTION_c,			/* Aka --compile. */
  OPTION_driver,		/* Wrapper-specific option. */
  OPTION_E,			/* Aka --preprocess. */
  OPTION_for_linker,		/* Aka `-Xlinker' and `-Wl,'. */
  OPTION_help,			/* --help. */
  OPTION_i,			/* -imacros, -include, -include-*. */
  OPTION_l,
  OPTION_L,			/* Aka --library-directory. */
  OPTION_M,			/* Aka --dependencies. */
  OPTION_MM,			/* Aka --user-dependencies. */
  OPTION_nostdlib,		/* Aka --no-standard-libraries, or
				   -nodefaultlibs. */
  OPTION_o,			/* Aka --output. */
  OPTION_P,			/* Aka --print-*-name. */
  OPTION_S,			/* Aka --assemble. */
  OPTION_syntax_only,		/* -fsyntax-only. */
  OPTION_v,			/* Aka --verbose. */
  OPTION_version,		/* --version. */
  OPTION_V,			/* Aka --use-version. */
  OPTION_x,			/* Aka --language. */
  OPTION_			/* Unrecognized or unimportant. */
} Option;

/* THE FOLLOWING COMES STRAIGHT FROM prerelease gcc-2.8.0/gcc.c:  */

/* This defines which switch letters take arguments.  */

#define DEFAULT_SWITCH_TAKES_ARG(CHAR)      \
  ((CHAR) == 'D' || (CHAR) == 'U' || (CHAR) == 'o' \
   || (CHAR) == 'e' || (CHAR) == 'T' || (CHAR) == 'u' \
   || (CHAR) == 'I' || (CHAR) == 'm' || (CHAR) == 'x' \
   || (CHAR) == 'L' || (CHAR) == 'A')

#ifndef SWITCH_TAKES_ARG
#define SWITCH_TAKES_ARG(CHAR) DEFAULT_SWITCH_TAKES_ARG(CHAR)
#endif

/* This defines which multi-letter switches take arguments.  */

#define DEFAULT_WORD_SWITCH_TAKES_ARG(STR)		\
 (!strcmp (STR, "Tdata") || !strcmp (STR, "Ttext")	\
  || !strcmp (STR, "Tbss") || !strcmp (STR, "include")	\
  || !strcmp (STR, "imacros") || !strcmp (STR, "aux-info") \
  || !strcmp (STR, "idirafter") || !strcmp (STR, "iprefix") \
  || !strcmp (STR, "iwithprefix") || !strcmp (STR, "iwithprefixbefore") \
  || !strcmp (STR, "isystem"))

#ifndef WORD_SWITCH_TAKES_ARG
#define WORD_SWITCH_TAKES_ARG(STR) DEFAULT_WORD_SWITCH_TAKES_ARG (STR)
#endif

/* This is the common prefix we use to make temp file names.
   It is chosen once for each run of this program.
   It is substituted into a spec by %g.
   Thus, all temp file names contain this prefix.
   In practice, all temp file names start with this prefix.

   This prefix comes from the envvar TMPDIR if it is defined;
   otherwise, from the P_tmpdir macro if that is defined;
   otherwise, in /usr/tmp or /tmp.  */

static char *temp_filename;
static char *temp_filename_f;	/* Same with ".f" appended. */

/* Length of the prefix.  */

static int temp_filename_length;

/* The number of errors that have occurred; the link phase will not be
   run if this is non-zero.  */
static int error_count = 0;

/* Number of commands that exited with a signal.  */

static int signal_count = 0;

/* END OF STUFF FROM gcc-2.7.0/gcc.c.  */

char *
my_strerror(e)
     int e;
{

#ifdef HAVE_STRERROR
  return strerror(e);

#else

  static char buffer[30];
  if (!e)
    return "";

  if (e > 0 && e < sys_nerr)
    return sys_errlist[e];

  sprintf (buffer, "Unknown error %d", e);
  return buffer;
#endif
}

#ifdef HAVE_VPRINTF
/* Output an error message and exit */

static void
fatal VPROTO((char *format, ...))
{
#ifndef __STDC__
  char *format;
#endif
  va_list ap;

  VA_START (ap, format);

#ifndef __STDC__
  format = va_arg (ap, char*);
#endif

  fprintf (stderr, "%s: ", programname);
  vfprintf (stderr, format, ap);
  va_end (ap);
  fprintf (stderr, "\n");
#if 0
  /* XXX Not needed for g77 driver.  */
  delete_temp_files ();
#endif
  exit (1);
}

static void
error VPROTO((char *format, ...))
{
#ifndef __STDC__
  char *format;
#endif
  va_list ap;

  VA_START (ap, format);

#ifndef __STDC__
  format = va_arg (ap, char*);
#endif

  fprintf (stderr, "%s: ", programname);
  vfprintf (stderr, format, ap);
  va_end (ap);

  fprintf (stderr, "\n");
}

#else /* not HAVE_VPRINTF */

static void
error (msg, arg1, arg2)
     char *msg, *arg1, *arg2;
{
  fprintf (stderr, "%s: ", programname);
  fprintf (stderr, msg, arg1, arg2);
  fprintf (stderr, "\n");
}

static void
fatal (msg, arg1, arg2)
     char *msg, *arg1, *arg2;
{
  error (msg, arg1, arg2);
#if 0
  /* XXX Not needed for g77 driver.  */
  delete_temp_files ();
#endif
  exit (1);
}

#endif /* not HAVE_VPRINTF */

/* More 'friendly' abort that prints the line and file.
   config.h can #define abort fancy_abort if you like that sort of thing.  */

void
fancy_abort ()
{
  fatal ("Internal g77 abort.");
}

char *
xmalloc (size)
     unsigned size;
{
  register char *value = (char *) malloc (size);
  if (value == 0)
    fatal ("virtual memory exhausted");
  return value;
}

static char *
concat (s1, s2)
     char *s1, *s2;
{
  int len1 = strlen (s1);
  int len2 = strlen (s2);
  char *result = xmalloc (len1 + len2 + 1);

  strcpy (result, s1);
  strcpy (result + len1, s2);
  *(result + len1 + len2) = 0;

  return result;
}

static char *
concat3 (s1, s2, s3)
     char *s1, *s2, *s3;
{
  return concat (concat (s1, s2), s3);
}

static char *
concat4 (s1, s2, s3, s4)
     char *s1, *s2, *s3, *s4;
{
  return concat (concat (s1, s2), concat (s3, s4));
}

static char *
concat6 (s1, s2, s3, s4, s5, s6)
     char *s1, *s2, *s3, *s4, *s5, *s6;
{
  return concat3 (concat (s1, s2), concat (s3, s4), concat (s5, s6));
}

static void
pfatal_with_name (name)
     char *name;
{
  char *s;

  if (errno < sys_nerr)
    s = concat ("%s: ", my_strerror (errno));
  else
    s = "cannot open `%s'";
  fatal (s, name);
}

static void
perror_exec (name)
     char *name;
{
  char *s;

  if (errno < sys_nerr)
    s = concat ("installation problem, cannot exec `%s': ",
		my_strerror (errno));
  else
    s = "installation problem, cannot exec `%s'";
  error (s, name);
}

/* Compute a string to use as the base of all temporary file names.
   It is substituted for %g.  */

static char *
choose_temp_base_try (try, base)
     char *try;
     char *base;
{
  char *rv;
  if (base)
    rv = base;
  else if (try == (char *)0)
    rv = 0;
  else if (access (try, R_OK | W_OK) != 0)
    rv = 0;
  else
    rv = try;
  return rv;
}

static void
choose_temp_base ()
{
  char *base = 0;
  int len;

  base = choose_temp_base_try (getenv ("TMPDIR"), base);
  base = choose_temp_base_try (getenv ("TMP"), base);
  base = choose_temp_base_try (getenv ("TEMP"), base);

#ifdef P_tmpdir
  base = choose_temp_base_try (P_tmpdir, base);
#endif

  base = choose_temp_base_try (concat4 (dir_separator_str, "usr", 
                                        dir_separator_str, "tmp"), 
                                base);
  base = choose_temp_base_try (concat (dir_separator_str, "tmp"), base);
 
  /* If all else fails, use the current directory! */
  if (base == (char *)0)
    base = concat (".", dir_separator_str);

  len = strlen (base);
  temp_filename = xmalloc (len + strlen (concat (dir_separator_str, 
                                                 "gfXXXXXX")) + 1);
  strcpy (temp_filename, base);
  if (len > 0 && temp_filename[len-1] != '/'
      && temp_filename[len-1] != DIR_SEPARATOR)
    temp_filename[len++] = DIR_SEPARATOR;
  strcpy (temp_filename + len, "gfXXXXXX");

  mktemp (temp_filename);
  temp_filename_length = strlen (temp_filename);
  if (temp_filename_length == 0)
    abort ();

  temp_filename_f = xmalloc (temp_filename_length + 2);
  strcpy (temp_filename_f, temp_filename);
  temp_filename_f[temp_filename_length] = '.';
  temp_filename_f[temp_filename_length + 1] = 'f';
  temp_filename_f[temp_filename_length + 2] = '\0';
}

/* This structure describes one mapping.  */
struct option_map
{
  /* The long option's name.  */
  char *name;
  /* The equivalent short option.  */
  char *equivalent;
  /* Argument info.  A string of flag chars; NULL equals no options.
     a => argument required.
     o => argument optional.
     j => join argument to equivalent, making one word.
     * => require other text after NAME as an argument.  */
  char *arg_info;
};

/* This is the table of mappings.  Mappings are tried sequentially
   for each option encountered; the first one that matches, wins.  */

struct option_map option_map[] =
 {
   {"--all-warnings", "-Wall", 0},
   {"--ansi", "-ansi", 0},
   {"--assemble", "-S", 0},
   {"--assert", "-A", "a"},
   {"--comments", "-C", 0},
   {"--compile", "-c", 0},
   {"--debug", "-g", "oj"},
   {"--define-macro", "-D", "a"},
   {"--dependencies", "-M", 0},
   {"--driver", "", 0},		/* Wrapper-specific. */
   {"--dump", "-d", "a"},
   {"--dumpbase", "-dumpbase", "a"},
   {"--entry", "-e", 0},
   {"--extra-warnings", "-W", 0},
   {"--for-assembler", "-Wa", "a"},
   {"--for-linker", "-Xlinker", "a"},
   {"--force-link", "-u", "a"},
   {"--imacros", "-imacros", "a"},
   {"--include", "-include", "a"},
   {"--include-barrier", "-I-", 0},
   {"--include-directory", "-I", "a"},
   {"--include-directory-after", "-idirafter", "a"},
   {"--include-prefix", "-iprefix", "a"},
   {"--include-with-prefix", "-iwithprefix", "a"},
   {"--include-with-prefix-before", "-iwithprefixbefore", "a"},
   {"--include-with-prefix-after", "-iwithprefix", "a"},
   {"--language", "-x", "a"},
   {"--library-directory", "-L", "a"},
   {"--machine", "-m", "aj"},
   {"--machine-", "-m", "*j"},
   {"--no-line-commands", "-P", 0},
   {"--no-precompiled-includes", "-noprecomp", 0},
   {"--no-standard-includes", "-nostdinc", 0},
   {"--no-standard-libraries", "-nostdlib", 0},
   {"--no-warnings", "-w", 0},
   {"--optimize", "-O", "oj"},
   {"--output", "-o", "a"},
   {"--pedantic", "-pedantic", 0},
   {"--pedantic-errors", "-pedantic-errors", 0},
   {"--pipe", "-pipe", 0},
   {"--prefix", "-B", "a"},
   {"--preprocess", "-E", 0},
   {"--print-file-name", "-print-file-name=", "aj"},
   {"--print-libgcc-file-name", "-print-libgcc-file-name", 0},
   {"--print-missing-file-dependencies", "-MG", 0},
   {"--print-multi-lib", "-print-multi-lib", 0},
   {"--print-multi-directory", "-print-multi-directory", 0},
   {"--print-prog-name", "-print-prog-name=", "aj"},
   {"--profile", "-p", 0},
   {"--profile-blocks", "-a", 0},
   {"--quiet", "-q", 0},
   {"--save-temps", "-save-temps", 0},
   {"--shared", "-shared", 0},
   {"--silent", "-q", 0},
   {"--static", "-static", 0},
   {"--symbolic", "-symbolic", 0},
   {"--target", "-b", "a"},
   {"--trace-includes", "-H", 0},
   {"--traditional", "-traditional", 0},
   {"--traditional-cpp", "-traditional-cpp", 0},
   {"--trigraphs", "-trigraphs", 0},
   {"--undefine-macro", "-U", "a"},
   {"--use-version", "-V", "a"},
   {"--user-dependencies", "-MM", 0},
   {"--verbose", "-v", 0},
   {"--version", "-dumpversion", 0},
   {"--warn-", "-W", "*j"},
   {"--write-dependencies", "-MD", 0},
   {"--write-user-dependencies", "-MMD", 0},
   {"--", "-f", "*j"}
 };

/* Compares --options that take one arg.  */

static int
opteq (xskip, xarg, opt, name)
     int *xskip;
     char **xarg;
     char *opt;
     char *name;
{
  int optlen;
  int namelen;
  int complen;
  int i;
  int cmp = strcmp (opt, name);
  int skip = 1;
  char *arg = NULL;

  if (cmp == 0)
    {
      /* Easy, a straight match.  */
      *xskip = skip;
      *xarg = arg;
      return cmp;
    }

  optlen = strlen (opt);

  for (i = 0; i < sizeof (option_map) / sizeof (option_map[0]); ++i)
    {
      char *arginfo;
      int j;

      arginfo = option_map[i].arg_info;
      if (arginfo == NULL)
	arginfo = "";

      namelen = strlen (option_map[i].name);
      complen = optlen > namelen ? namelen : optlen;

      if (strncmp (opt, option_map[i].name, complen) == 0)
	{
	  if (optlen < namelen)
	    {
	      for (j = i + 1;
		   j < sizeof (option_map) / sizeof (option_map[0]);
		   ++j)
		if ((strlen (option_map[j].name) >= optlen)
		    && (strncmp (opt, option_map[j].name, optlen) == 0))
		  fatal ("Ambiguous abbreviation `%s'", opt);
	    }

	  if (optlen > namelen)
	    {
	      if (opt[namelen] == '=')
		{
		  skip = 0;
		  arg = opt + namelen + 1;
		}
	      else if (index (arginfo, '*') != 0)
		;
	      else
		continue;
	    }
	  else if (index (arginfo, '*') != 0)
	    fatal ("Incomplete `%s' option", option_map[i].name);

	  if (strcmp (name, option_map[i].name) != 0)
	    return 1;		/* Not what is being looked for. */

	  *xskip = skip;
	  *xarg = arg;
	  return 0;
	}
    }

  return 1;
}

/* Assumes text[0] == '-'.  Returns number of argv items that belong to
   (and follow) this one, an option id for options important to the
   caller, and a pointer to the first char of the arg, if embedded (else
   returns NULL, meaning no arg or it's the next argv).  */

static void
lookup_option (xopt, xskip, xarg, text)
     Option *xopt;
     int *xskip;
     char **xarg;
     char *text;
{
  Option opt = OPTION_;
  int skip;
  char *arg = NULL;

  if ((skip = SWITCH_TAKES_ARG (text[1])) > (text[2] != '\0'))
    skip -= (text[2] != '\0');	/* Usually one of "DUoeTuImLA". */

  if (text[1] == 'B')
    opt = OPTION_B, skip = (text[2] == '\0'), arg = text + 2;
  else if (text[1] == 'b')
    opt = OPTION_b, skip = (text[2] == '\0'), arg = text + 2;
  else if ((text[1] == 'c') && (text[2] == '\0'))
    opt = OPTION_c, skip = 0;
  else if ((text[1] == 'E') && (text[2] == '\0'))
    opt = OPTION_E, skip = 0;
  else if (text[1] == 'i')
    opt = OPTION_i, skip = 0;
  else if (text[1] == 'l')
    opt = OPTION_l;
  else if (text[1] == 'L')
    opt = OPTION_L, skip = (text[2] == '\0'), arg = text + 2;
  else if (text[1] == 'o')
    opt = OPTION_o;
  else if ((text[1] == 'S') && (text[2] == '\0'))
    opt = OPTION_S, skip = 0;
  else if (text[1] == 'V')
    opt = OPTION_V, skip = (text[2] == '\0');
  else if ((text[1] == 'v') && (text[2] == '\0'))
    opt = OPTION_v, skip = 0;
  else if ((text[1] == 'W') && (text[2] == 'l') && (text[3] == ','))
    opt = OPTION_for_linker, skip = 0;
  else if (text[1] == 'x')
    opt = OPTION_x, skip = (text[2] == '\0'), arg = text + 2;
  else
    {
      if ((skip = WORD_SWITCH_TAKES_ARG (text + 1)) != 0)
	/* Usually one of "Tdata", "Ttext", "Tbss", "include",
	   "imacros", "aux-info", "idirafter", "iprefix",
	   "iwithprefix", "iwithprefixbefore", "isystem".  */
	;

      if (strcmp (text, "--assemble") == 0)
	opt = OPTION_S;
      else if (strcmp (text, "--compile") == 0)
	opt = OPTION_c;
      else if (opteq (&skip, &arg, text, "--driver") == 0)
	opt = OPTION_driver;
      else if (strcmp (text, "--help") == 0)
	opt = OPTION_help;
      else if ((opteq (&skip, &arg, text, "--imacros") == 0)
	       || (opteq (&skip, &arg, text, "--include") == 0)
	       || (opteq (&skip, &arg, text, "--include-directory-after") == 0)
	       || (opteq (&skip, &arg, text, "--include-prefix") == 0)
	       || (opteq (&skip, &arg, text, "--include-with-prefix") == 0)
	       || (opteq (&skip, &arg, text, "--include-with-prefix-before") == 0)
	       || (opteq (&skip, &arg, text, "--include-with-prefix-after") == 0))
	opt = OPTION_i;
      else if (opteq (&skip, &arg, text, "--language") == 0)
	opt = OPTION_x;
      else if (opteq (&skip, &arg, text, "--library-directory") == 0)
	opt = OPTION_L;
      else if ((strcmp (text, "-M") == 0)
	       || (strcmp (text, "--dependencies") == 0))
	opt = OPTION_M;
      else if ((strcmp (text, "-MM") == 0)
	       || (strcmp (text, "--user-dependencies") == 0))
	opt = OPTION_MM;
      else if (strcmp (text, "--output") == 0)
	opt = OPTION_o;
      else if (opteq (&skip, &arg, text, "--prefix") == 0)
	opt = OPTION_B;
      else if (strcmp (text, "--preprocess") == 0)
	opt = OPTION_E;
      else if ((opteq (&skip, &arg, text, "--print-file-name") == 0)
	       || (strcmp (text, "--print-libgcc-file-name") == 0)
	       || (strcmp (text, "--print-multi-lib") == 0)
	       || (strcmp (text, "--print-multi-directory") == 0)
	       || (opteq (&skip, &arg, text, "--print-prog-name") == 0))
	opt = OPTION_P;
      else if ((strcmp (text, "-nostdlib") == 0)
	       || (strcmp (text, "--no-standard-libraries") == 0)
	       || (strcmp (text, "-nodefaultlibs") == 0))
	opt = OPTION_nostdlib;
      else if (strcmp (text, "-fsyntax-only") == 0)
	opt = OPTION_syntax_only;
      else if (opteq (&skip, &arg, text, "--use-version") == 0)
	opt = OPTION_V;
      else if (strcmp (text, "--verbose") == 0)
	opt = OPTION_v;
      else if (strcmp (text, "--version") == 0)
	opt = OPTION_version;
      else if (strcmp (text, "-Xlinker") == 0)
	skip = 1;
      else if ((opteq (&skip, &arg, text, "--assert") == 0)
	       || (opteq (&skip, &arg, text, "--define-macro") == 0)
	       || (opteq (&skip, &arg, text, "--dump") == 0)
	       || (opteq (&skip, &arg, text, "--dumpbase") == 0)
	       || (opteq (&skip, &arg, text, "--for-assembler") == 0)
	       || (opteq (&skip, &arg, text, "--for-linker") == 0)
	       || (opteq (&skip, &arg, text, "--force-link") == 0)
	       || (opteq (&skip, &arg, text, "--machine") == 0)
	       || (opteq (&skip, &arg, text, "--target") == 0)
	       || (opteq (&skip, &arg, text, "--undefine-macro") == 0))
	;
      else
	skip = 0;
    }

  if (xopt != NULL)
    *xopt = opt;
  if (xskip != NULL)
    *xskip = skip;
  if (xarg != NULL)
    {
      if ((arg != NULL)
	  && (arg[0] == '\0'))
	*xarg = NULL;
      else
	*xarg = arg;
    }
}

static void
append_arg (arg)
    char *arg;
{
  static int newargsize;

#if 0
  fprintf (stderr, "`%s'\n", arg);
#endif

  if ((newargv == xargv)
      && (arg == xargv[newargc]))
    {
      ++newargc;
      return;			/* Nothing new here. */
    }

  if (newargv == xargv)
    {				/* Make new arglist. */
      int i;

      newargsize = (xargc << 2) + 20;
      newargv = (char **) malloc (newargsize * sizeof (char *));

      /* Copy what has been done so far.  */
      for (i = 0; i < newargc; ++i)
	newargv[i] = xargv[i];
    }

  if (newargc == newargsize)
    fatal ("overflowed output arg list for `%s'", arg);
  newargv[newargc++] = arg;
}

extern int execv (), execvp ();

/* If a stage of compilation returns an exit status >= 1,
   compilation of that file ceases.  */

#define MIN_FATAL_STATUS 1

/* stdin file number.  */
#define STDIN_FILE_NO 0

/* stdout file number.  */
#define STDOUT_FILE_NO 1

/* value of `pipe': port index for reading.  */
#define READ_PORT 0

/* value of `pipe': port index for writing.  */
#define WRITE_PORT 1

/* Pipe waiting from last process, to be used as input for the next one.
   Value is STDIN_FILE_NO if no pipe is waiting
   (i.e. the next command is the first of a group).  */

static int last_pipe_input;

/* Fork one piped subcommand.  FUNC is the system call to use
   (either execv or execvp).  ARGV is the arg vector to use.
   NOT_LAST is nonzero if this is not the last subcommand
   (i.e. its output should be piped to the next one.)  */

#ifdef __MSDOS__

#include <process.h>
static int
pexecute (search_flag, program, argv, not_last)
     int search_flag;
     char *program;
     char *argv[];
     int not_last;
{
#ifdef __GO32__
  int i = (search_flag ? spawnv : spawnvp) (1, program, argv);
#else
  char *scmd, *rf;
  FILE *argfile;
  int i, el = search_flag ? 0 : 4;

  scmd = (char *)malloc (strlen (program) + strlen (temp_filename) + 6 + el);
  rf = scmd + strlen(program) + 2 + el;
  sprintf (scmd, "%s%s @%s.gp", program,
	   (search_flag ? "" : ".exe"), temp_filename);
  argfile = fopen (rf, "w");
  if (argfile == 0)
    pfatal_with_name (rf);

  for (i=1; argv[i]; i++)
    {
      char *cp;
      for (cp = argv[i]; *cp; cp++)
	{
	  if (*cp == '"' || *cp == '\'' || *cp == '\\' || isspace (*cp))
	    fputc ('\\', argfile);
	  fputc (*cp, argfile);
	}
      fputc ('\n', argfile);
    }
  fclose (argfile);

  i = system (scmd);

  remove (rf);
#endif
  
  if (i == -1)
    {
      perror_exec (program);
      return MIN_FATAL_STATUS << 8;
    }
  return i << 8;
}

#endif

#if !defined(__MSDOS__) && !defined(OS2) && !defined(_WIN32)

static int
pexecute (search_flag, program, argv, not_last)
     int search_flag;
     char *program;
     char *argv[];
     int not_last;
{
  int (*func)() = (search_flag ? execv : execvp);
  int pid;
  int pdes[2];
  int input_desc = last_pipe_input;
  int output_desc = STDOUT_FILE_NO;
  int retries, sleep_interval;

  /* If this isn't the last process, make a pipe for its output,
     and record it as waiting to be the input to the next process.  */

  if (not_last)
    {
      if (pipe (pdes) < 0)
	pfatal_with_name ("pipe");
      output_desc = pdes[WRITE_PORT];
      last_pipe_input = pdes[READ_PORT];
    }
  else
    last_pipe_input = STDIN_FILE_NO;

  /* Fork a subprocess; wait and retry if it fails.  */
  sleep_interval = 1;
  for (retries = 0; retries < 4; retries++)
    {
      pid = vfork ();
      if (pid >= 0)
	break;
      sleep (sleep_interval);
      sleep_interval *= 2;
    }

  switch (pid)
    {
    case -1:
#ifdef vfork
      pfatal_with_name ("fork");
#else
      pfatal_with_name ("vfork");
#endif
      /* NOTREACHED */
      return 0;

    case 0: /* child */
      /* Move the input and output pipes into place, if nec.  */
      if (input_desc != STDIN_FILE_NO)
	{
	  close (STDIN_FILE_NO);
	  dup (input_desc);
	  close (input_desc);
	}
      if (output_desc != STDOUT_FILE_NO)
	{
	  close (STDOUT_FILE_NO);
	  dup (output_desc);
	  close (output_desc);
	}

      /* Close the parent's descs that aren't wanted here.  */
      if (last_pipe_input != STDIN_FILE_NO)
	close (last_pipe_input);

      /* Exec the program.  */
      (*func) (program, argv);
      perror_exec (program);
      exit (-1);
      /* NOTREACHED */
      return 0;

    default:
      /* In the parent, after forking.
	 Close the descriptors that we made for this child.  */
      if (input_desc != STDIN_FILE_NO)
	close (input_desc);
      if (output_desc != STDOUT_FILE_NO)
	close (output_desc);

      /* Return child's process number.  */
      return pid;
    }
}

#endif /* not __MSDOS__ and not OS2 and not _WIN32 */

#if defined(OS2)

static int
pexecute (search_flag, program, argv, not_last)
     int search_flag;
     char *program;
     char *argv[];
     int not_last;
{
  return (search_flag ? spawnv : spawnvp) (1, program, argv);
}
#endif /* OS2 */

#if defined(_WIN32)

static int
pexecute (search_flag, program, argv, not_last)
     int search_flag;
     char *program;
     char *argv[];
     int not_last;
{
  return (search_flag ? __spawnv : __spawnvp) (1, program, argv);
}
#endif /* _WIN32 */

static int
doit (char *program, char **argv)
{
  int pid;
  int status;
  int ret_code = 0;

  pid = pexecute (0, program, argv, 0);

#ifdef __MSDOS__
  status = pid;
#else
#ifdef _WIN32
  pid = cwait (&status, pid, WAIT_CHILD);
#else
  pid = wait (&status);
#endif
#endif
  if (pid < 0)
    abort ();

  if (status != 0)
    {
      if (WIFSIGNALED (status))
	{
	  fatal ("Internal compiler error: program %s got fatal signal %d",
		 program, WTERMSIG (status));
	  signal_count++;
	  ret_code = -1;
	}
      else if (WIFEXITED (status)
	       && WEXITSTATUS (status) >= MIN_FATAL_STATUS)
	ret_code = -1;
    }

  return ret_code;
}

int
main (argc, argv)
     int argc;
     char **argv;
{
  register int i = 0;
  register char *p;
  int verbose = 0;
  Option opt;
  int skip;
  char *arg;
  int n_infiles = 0;
  int n_outfiles = 0;

  /* This will be NULL if we encounter a situation where we should not
     link in libf2c.  */
  char *library = "-lf2c";

  /* This will become 0 if anything other than -v and kin (like -V)
     is seen, meaning the user is trying to accomplish something.
     If it remains nonzero, and the user wants version info, add stuff to
     the command line to make gcc invoke all the appropriate phases
     to get all the version info.  */
  int add_version_magic = 1;

  /* The name of the compiler we will want to run---by default, it
     will be the definition of `GCC_NAME', e.g., `gcc'.  */
  char *gcc = GCC_NAME;

  /* 0 => -xnone in effect on input/output
     1 => -xfoo in effect on input/output
     2 => -xnone in effect on input, -xf77 on output
     3 => -xnone in effect on input, -xf77-cpp-input on output.
     4 => -xnone in effect on input, -xratfor on output.  */
  int saw_speclang = 0;

  /* 0 => initial/reset state
     1 => last arg was -l<library>
     2 => last two args were -l<library> -lm.  */
  int saw_library = 0;

  /* Initialize for append_arg().  */
  xargc = argc;
  newargv = xargv = argv;
  newargc = 0;

  append_arg (argv[0]);

  p = argv[0] + strlen (argv[0]);
  while (p != argv[0] && p[-1] != '/')
    --p;
  programname = p;

  if (argc == 1)
    fatal ("No input files specified.\n");

#ifndef __MSDOS__
  /* We do a little magic to find out where the main gcc executable
     is.  If they ran us as /usr/local/bin/g77, then we will look
     for /usr/local/bin/gcc; similarly, if they just ran us as `g77',
     we'll just look for `gcc'.  */
  if (p != argv[0])
    {
      *--p = '\0';
      gcc = (char *) malloc ((strlen (argv[0]) + 1 + strlen (GCC_NAME) + 1)
			     * sizeof (char));
      sprintf (gcc, "%s/%s", argv[0], GCC_NAME);
    }
#endif

  /* First pass through arglist.

     If -nostdlib or a "turn-off-linking" option is anywhere in the
     command line, don't do any library-option processing (except
     relating to -x).  Also, if -v is specified, but no other options
     that do anything special (allowing -V version, etc.), remember
     to add special stuff to make gcc command actually invoke all
     the different phases of the compilation process so all the version
     numbers can be seen.

     Also, here is where all problems with missing arguments to options
     are caught.  If this loop is exited normally, it means all options
     have the appropriate number of arguments as far as the rest of this
     program is concerned.  */

  for (i = 1; i < argc; ++i)
    {
      if ((argv[i][0] == '+') && (argv[i][1] == 'e'))
	{
	  add_version_magic = 0;
	  continue;
	}
      else if ((argv[i][0] != '-') || (argv[i][1] == 0))
	{
	  ++n_infiles;
	  add_version_magic = 0;
	  continue;
	}

      lookup_option (&opt, &skip, NULL, argv[i]);

      switch (opt)
	{
	case OPTION_nostdlib:
	case OPTION_c:
	case OPTION_S:
	case OPTION_syntax_only:
	case OPTION_E:
	case OPTION_M:
	case OPTION_MM:
	  /* These options disable linking entirely or linking of the
	     standard libraries.  */
	  library = NULL;
	  add_version_magic = 0;
	  break;

	case OPTION_for_linker:
	case OPTION_l:
	  ++n_infiles;
	  add_version_magic = 0;
	  break;

	case OPTION_o:
	  ++n_outfiles;
	  add_version_magic = 0;
	  break;

	case OPTION_v:
	  if (!verbose)
	    fprintf (stderr, "g77 version %s\n", ffezzz_version_string);
	  verbose = 1;
	  break;

	case OPTION_b:
	case OPTION_B:
	case OPTION_L:
	case OPTION_driver:
	case OPTION_i:
	case OPTION_V:
	  /* These options are useful in conjunction with -v to get
	     appropriate version info.  */
	  break;

	case OPTION_version:
	  printf ("\
GNU Fortran %s\n\
Copyright (C) 1997 Free Software Foundation, Inc.\n\
For more version information on components of the GNU Fortran\n\
compilation system, especially useful when reporting bugs,\n\
type the command `g77 --verbose'.\n\
\n\
GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\
You may redistribute copies of GNU Fortran\n\
under the terms of the GNU General Public License.\n\
For more information about these matters, see the file named COPYING\n\
or type the command `info -f g77 Copying'.\n\
", ffezzz_version_string);
	  exit (0);
	  break;

	case OPTION_help:
	  printf ("\
Usage: g77 [OPTION]... FORTRAN-SOURCE...\n\
\n\
Compile and link Fortran source code to produce an executable program,\n\
which by default is named `a.out', and can be invoked with the UNIX\n\
command `./a.out'.\n\
\n\
Options:\n\
--debug                include debugging information in executable.\n\
--driver=COMMAND       specify preprocessor/compiler/linker driver\n\
                         to use instead of the default `gcc'.\n\
--help                 display this help and exit.\n\
--optimize[=LEVEL]     take extra time and memory to make generated\n\
                         executable run faster.  LEVEL is 0 for no\n\
                         optimization, 1 for normal optimization, and\n\
                         increases through 3 for more optimization.\n\
--output=PROGRAM       name the executable PROGRAM instead of a.out;\n\
                         invoke with the command `./PROGRAM'.\n\
--version              display version information and exit.\n\
\n\
Many other options exist to tailor the compilation process, specify\n\
the dialect of the Fortran source code, specify details of the\n\
code-generation methodology, and so on.\n\
\n\
For more information on g77 and gcc, type the commands `info -f g77'\n\
and `info -f gcc' to read the Info documentation on these commands.\n\
\n\
Report bugs to fortran@gnu.ai.mit.edu.\n");
	  exit (0);
	  break;

	default:
	  add_version_magic = 0;
	  break;
	}

      /* This is the one place we check for missing arguments in the
	 program.  */

      if (i + skip < argc)
	i += skip;
      else
	fatal ("argument to `%s' missing\n", argv[i]);
    }

  if ((n_outfiles != 0) && (n_infiles == 0))
    fatal ("No input files; unwilling to write output files");

  /* Second pass through arglist, transforming arguments as appropriate.  */

  for (i = 1; i < argc; ++i)
    {
      if (argv[i][0] == '\0')
	append_arg (argv[i]);	/* Interesting.  Just append as is. */

      else if ((argv[i][0] == '-') && (argv[i][1] != 'l'))
	{
	  /* Not a filename or library. */

	  if (saw_library == 1)	/* -l<library>. */
	    append_arg ("-lm");
	  saw_library = 0;

	  lookup_option (&opt, &skip, &arg, argv[i]);

	  if (argv[i][1] == '\0')
	    append_arg (argv[i]);	/* "-" == Standard input. */

	  else if (opt == OPTION_x)
	    {
	      /* Track input language. */
	      char *lang;

	      if (arg == NULL)
		lang = argv[i+1];
	      else
		lang = arg;

	      saw_speclang = (strcmp (lang, "none") != 0);
	    }
	  else if (opt == OPTION_driver)
	    {
	      if (arg == NULL)
		gcc = argv[i+1];
	      else
		gcc = arg;
	      i += skip;
	      continue;		/* Don't append args to new list. */
	    }
	  append_arg (argv[i]);
	  for (; skip != 0; --skip)
	    append_arg (argv[++i]);
	}
      else
	{			/* A filename/library, not an option. */
	  int len;
	  int want_speclang;

	  /* Here, always append the arg _after_ other stuff, possibly.  */

	  if (saw_speclang == 1)
	    saw_library = 0;	/* -xfoo currently active. */
	  /* Put -xf77 and -xnone around list of filenames ending in
	     .F or .f, but don't include other filenames or libraries
	     in that list.  */
	  else if ((argv[i][0] != '-')	/* Not a library. */
		   && (len = strlen (argv[i])) > 2
		   && ((argv[i][len - 1] == 'F')
		       || (argv[i][len - 1] == 'f')
		       || (argv[i][len - 1] == 'r'))
		   && argv[i][len - 2] == '.')
	    {			/* filename.f or filename.F. or filename.r */
	      if (saw_library == 1)	/* -l<library>. */
		append_arg ("-lm");
	      saw_library = 0;
	      switch (argv[i][len - 1])
		{
		case 'f':
		  want_speclang = 2;
		  break;
		case 'F':
		  want_speclang = 3;
		  break;
		case 'r':
		  want_speclang = 4;
		  break;
		default:
		  break;
		}
	      if (saw_speclang != want_speclang)
		{
		  switch (want_speclang)
		    {
		    case 2:
		      append_arg ("-xf77");
		      break;
		    case 3:
		      append_arg ("-xf77-cpp-input");
		      break;
		    case 4:
		      append_arg ("-xratfor");
		      break;
		    default:
		      break;
		    }
		  saw_speclang = want_speclang;
		}
	    }
	  else
	    {			/* -lfoo or "alien" filename. */
	      if (saw_speclang)
		append_arg ("-xnone");
	      saw_speclang = 0;

	      if (strcmp (argv[i], "-lm") == 0
		  || strcmp (argv[i], "-lmath") == 0)
		{
		  if (saw_library == 1)
		    saw_library = 2;	/* -l<library> -lm. */
		  else if (library)
		    {
		      append_arg (library);
		      saw_library = 2;	/* -l<library> -lm. */
		    }
		}
	      else if ((library != NULL)
		       && (strcmp (argv[i], library) == 0))
		saw_library = 1;	/* -l<library>. */
	      else
		{		/* "Alien" library or filename. */
		  if (saw_library == 1)
		    append_arg ("-lm");
		  saw_library = 0;
		}
	    }
	  append_arg (argv[i]);
	}
    }

  /* Add -lf2c -lm as necessary.  */

  if (!add_version_magic && library)
    {				/* Doing a link and no -nostdlib. */
      if (saw_speclang)
	append_arg ("-xnone");
      switch (saw_library)
	{
	case 0:
	  append_arg (library);
	case 1:
	  append_arg ("-lm");
	default:
	  break;
	}
    }
  else if (add_version_magic && verbose)
    {
      FILE *fsrc;

      choose_temp_base ();

      append_arg ("-fnull-version");
      append_arg ("-o");
      append_arg (temp_filename);
      append_arg ("-xf77-cpp-input");
      append_arg (temp_filename_f);
      append_arg ("-xnone");
      if (library)
	{
	  append_arg (library);
	  append_arg ("-lm");
	}

      fsrc = fopen (temp_filename_f, "w");
      if (fsrc == 0)
	pfatal_with_name (fsrc);
      fputs ("      call g77__fvers;call g77__ivers;call g77__uvers;end\n", fsrc);
      fclose (fsrc);
    }

  append_arg (NULL);
  --newargc;			/* Don't count null arg at end. */

  newargv[0] = gcc;		/* This is safe even if newargv == xargv. */

  if (verbose)
    {
#if 0
      if (newargv == xargv)
	fprintf (stderr, "[Original:]");
#endif

      for (i = 0; i < newargc; i++)
	fprintf (stderr, " %s", newargv[i]);
      fprintf (stderr, "\n");
    }

  if (doit (gcc, newargv) < 0)
    ++error_count;
  else if (add_version_magic && verbose)
    {
      char *outargv[2];

      outargv[0] = temp_filename;
      outargv[1] = 0;

      if (doit (temp_filename, outargv) < 0)
	++error_count;

      remove (temp_filename);
      remove (temp_filename_f);
    }

  exit (error_count > 0 ? (signal_count ? 2 : 1) : 0);
  /* NOTREACHED */
  return 0;
}

#endif	/* LANGUAGE_F77 == 1 */