Initial integration of G77.

Please do a make cleandir before rebuilding gcc!

1 files changed, 548 insertions, 0 deletions

diff --git a/gnu/usr.bin/gcc/f/where.c b/gnu/usr.bin/gcc/f/where.c
new file mode 100644
index 00000000000..f0d189d56b2
--- /dev/null
+++ b/gnu/usr.bin/gcc/f/where.c
@@ -0,0 +1,548 @@
+/* where.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed 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.
+
+   Related Modules:
+
+   Description:
+      Simple data abstraction for Fortran source lines (called card images).
+
+   Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "where.h"
+#include "lex.h"
+#include "malloc.h"
+
+/* Externals defined here. */
+
+struct _ffewhere_line_ ffewhere_unknown_line_
+=
+{NULL, NULL, 0, 0, 0};
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+typedef struct _ffewhere_ll_ *ffewhereLL_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffewhere_ll_
+  {
+    ffewhereLL_ next;
+    ffewhereLL_ previous;
+    ffewhereFile wf;
+    ffewhereLineNumber line_no;	/* ffelex_line_number() at time of creation. */
+    ffewhereLineNumber offset;	/* User-desired offset (usually 1). */
+  };
+
+struct _ffewhere_root_ll_
+  {
+    ffewhereLL_ first;
+    ffewhereLL_ last;
+  };
+
+struct _ffewhere_root_line_
+  {
+    ffewhereLine first;
+    ffewhereLine last;
+    ffewhereLineNumber none;
+  };
+
+/* Static objects accessed by functions in this module. */
+
+static struct _ffewhere_root_ll_ ffewhere_root_ll_;
+static struct _ffewhere_root_line_ ffewhere_root_line_;
+
+/* Static functions (internal). */
+
+static ffewhereLL_ ffewhere_ll_lookup_ (ffewhereLineNumber ln);
+
+/* Internal macros. */
+
+
+/* Look up line-to-line object from absolute line num.  */
+
+static ffewhereLL_
+ffewhere_ll_lookup_ (ffewhereLineNumber ln)
+{
+  ffewhereLL_ ll;
+
+  if (ln == 0)
+    return ffewhere_root_ll_.first;
+
+  for (ll = ffewhere_root_ll_.last;
+       ll != (ffewhereLL_) &ffewhere_root_ll_.first;
+       ll = ll->previous)
+    {
+      if (ll->line_no <= ln)
+	return ll;
+    }
+
+  assert ("no line num" == NULL);
+  return NULL;
+}
+
+/* Kill file object.
+
+   Note that this object must not have been passed in a call
+   to any other ffewhere function except ffewhere_file_name and
+   ffewhere_file_namelen.  */
+
+void
+ffewhere_file_kill (ffewhereFile wf)
+{
+  malloc_kill_ks (ffe_pool_file (), wf,
+		  offsetof (struct _ffewhere_file_, text)
+		  + wf->length + 1);
+}
+
+/* Create file object.  */
+
+ffewhereFile
+ffewhere_file_new (char *name, size_t length)
+{
+  ffewhereFile wf;
+
+  wf = malloc_new_ks (ffe_pool_file (), "ffewhereFile",
+		      offsetof (struct _ffewhere_file_, text)
+		      + length + 1);
+  wf->length = length;
+  memcpy (&wf->text[0], name, length);
+  wf->text[length] = '\0';
+
+  return wf;
+}
+
+/* Set file and first line number.
+
+   Pass FALSE if no line number is specified.  */
+
+void
+ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln)
+{
+  ffewhereLL_ ll;
+
+  ll = malloc_new_kp (ffe_pool_file (), "ffewhereLL_", sizeof (*ll));
+  ll->next = (ffewhereLL_) &ffewhere_root_ll_.first;
+  ll->previous = ffewhere_root_ll_.last;
+  ll->next->previous = ll;
+  ll->previous->next = ll;
+  if (wf == NULL)
+    {
+      if (ll->previous == ll->next)
+	ll->wf = NULL;
+      else
+	ll->wf = ll->previous->wf;
+    }
+  else
+    ll->wf = wf;
+  ll->line_no = ffelex_line_number ();
+  if (have_num)
+    ll->offset = ln;
+  else
+    {
+      if (ll->previous == ll->next)
+	ll->offset = 1;
+      else
+	ll->offset
+	  = ll->line_no - ll->previous->line_no + ll->previous->offset;
+    }
+}
+
+/* Do initializations.  */
+
+void
+ffewhere_init_1 ()
+{
+  ffewhere_root_line_.first = ffewhere_root_line_.last
+  = (ffewhereLine) &ffewhere_root_line_.first;
+  ffewhere_root_line_.none = 0;
+
+  ffewhere_root_ll_.first = ffewhere_root_ll_.last
+    = (ffewhereLL_) &ffewhere_root_ll_.first;
+}
+
+/* Return the textual content of the line.  */
+
+char *
+ffewhere_line_content (ffewhereLine wl)
+{
+  assert (wl != NULL);
+  return wl->content;
+}
+
+/* Look up file object from line object.  */
+
+ffewhereFile
+ffewhere_line_file (ffewhereLine wl)
+{
+  ffewhereLL_ ll;
+
+  assert (wl != NULL);
+  ll = ffewhere_ll_lookup_ (wl->line_num);
+  return ll->wf;
+}
+
+/* Lookup file object from line object, calc line#.  */
+
+ffewhereLineNumber
+ffewhere_line_filelinenum (ffewhereLine wl)
+{
+  ffewhereLL_ ll;
+
+  assert (wl != NULL);
+  ll = ffewhere_ll_lookup_ (wl->line_num);
+  return wl->line_num + ll->offset - ll->line_no;
+}
+
+/* Decrement use count for line, deallocate if no uses left.  */
+
+void
+ffewhere_line_kill (ffewhereLine wl)
+{
+#if 0
+  if (!ffewhere_line_is_unknown (wl))
+    fprintf (dmpout, "; ffewhere_line_kill %" ffewhereLineNumber_f "u, uses=%"
+	     ffewhereUses_f_ "u\n",
+	     wl->line_num, wl->uses);
+#endif
+  assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
+  if (!ffewhere_line_is_unknown (wl) && (--wl->uses == 0))
+    {
+      wl->previous->next = wl->next;
+      wl->next->previous = wl->previous;
+      malloc_kill_ks (ffe_pool_file (), wl,
+		      offsetof (struct _ffewhere_line_, content)
+		      + wl->length + 1);
+    }
+}
+
+/* Make a new line or increment use count of existing one.
+
+   Find out where line object is, if anywhere.	If in lexer, it might also
+   be at the end of the list of lines, else put it on the end of the list.
+   Then, if in the list of lines, increment the use count and return the
+   line object.	 Else, make an empty line object (no line) and return
+   that.  */
+
+ffewhereLine
+ffewhere_line_new (ffewhereLineNumber ln)
+{
+  ffewhereLine wl = ffewhere_root_line_.last;
+
+  /* If this is the lexer's current line, see if it is already at the end of
+     the list, and if not, make it and return it. */
+
+  if (((ln == 0)		/* Presumably asking for EOF pointer. */
+       || (wl->line_num != ln))
+      && (ffelex_line_number () == ln))
+    {
+#if 0
+      fprintf (dmpout,
+	       "; ffewhere_line_new %" ffewhereLineNumber_f "u, lexer\n",
+	       ln);
+#endif
+      wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
+			  offsetof (struct _ffewhere_line_, content)
+			  + ffelex_line_length () + 1);
+      wl->next = (ffewhereLine) &ffewhere_root_line_;
+      wl->previous = ffewhere_root_line_.last;
+      wl->previous->next = wl;
+      wl->next->previous = wl;
+      wl->line_num = ln;
+      wl->uses = 1;
+      wl->length = ffelex_line_length ();
+      strcpy (wl->content, ffelex_line ());
+      return wl;
+    }
+
+  /* See if line is on list already. */
+
+  while (wl->line_num > ln)
+    wl = wl->previous;
+
+  /* If line is there, increment its use count and return. */
+
+  if (wl->line_num == ln)
+    {
+#if 0
+      fprintf (dmpout, "; ffewhere_line_new %" ffewhereLineNumber_f "u, uses=%"
+	       ffewhereUses_f_ "u\n", ln,
+	       wl->uses);
+#endif
+      wl->uses++;
+      return wl;
+    }
+
+  /* Else, make a new one with a blank line (since we've obviously lost it,
+     which should never happen) and return it. */
+
+  fprintf (stderr,
+	   "(Cannot resurrect line %lu for error reporting purposes.)\n",
+	   ln);
+
+  wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
+		      offsetof (struct _ffewhere_line_, content)
+		      + 1);
+  wl->next = (ffewhereLine) &ffewhere_root_line_;
+  wl->previous = ffewhere_root_line_.last;
+  wl->previous->next = wl;
+  wl->next->previous = wl;
+  wl->line_num = ln;
+  wl->uses = 1;
+  wl->length = 0;
+  *(wl->content) = '\0';
+  return wl;
+}
+
+/* Increment use count of line, as in a copy.  */
+
+ffewhereLine
+ffewhere_line_use (ffewhereLine wl)
+{
+#if 0
+  fprintf (dmpout, "; ffewhere_line_use %" ffewhereLineNumber_f "u, uses=%" ffewhereUses_f_
+	   "u\n", wl->line_num, wl->uses);
+#endif
+  assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
+  if (!ffewhere_line_is_unknown (wl))
+    ++wl->uses;
+  return wl;
+}
+
+/* Set an ffewhere object based on a track index.
+
+   Determines the absolute line and column number of a character at a given
+   index into an ffewhereTrack array.  wr* is the reference position, wt is
+   the tracking information, and i is the index desired.  wo* is set to wr*
+   plus the continual offsets described by wt[0...i-1], or unknown if any of
+   the continual offsets are not known.	 */
+
+void
+ffewhere_set_from_track (ffewhereLine *wol, ffewhereColumn *woc,
+			 ffewhereLine wrl, ffewhereColumn wrc,
+			 ffewhereTrack wt, ffewhereIndex i)
+{
+  ffewhereLineNumber ln;
+  ffewhereColumnNumber cn;
+  ffewhereIndex j;
+  ffewhereIndex k;
+
+  if (i == 0)
+    {
+      *wol = ffewhere_line_use (wrl);
+      *woc = ffewhere_column_use (wrc);
+    }
+  else if (i >= FFEWHERE_indexMAX)
+    {
+      assert ("i >= FFEWHERE_indexMAX" == NULL);
+      *wol = ffewhere_line_unknown ();
+      *woc = ffewhere_column_unknown ();
+    }
+  else
+    {
+      ln = ffewhere_line_number (wrl);
+      cn = ffewhere_column_number (wrc);
+      for (j = 0, k = 0; j < i; ++j, k += 2)
+	{
+	  if ((wt[k] == FFEWHERE_indexUNKNOWN)
+	      || (wt[k + 1] == FFEWHERE_indexUNKNOWN))
+	    {
+	      *wol = ffewhere_line_unknown ();
+	      *woc = ffewhere_column_unknown ();
+	      return;
+	    }
+	  if (wt[k] == 0)
+	    cn += wt[k + 1] + 1;
+	  else
+	    {
+	      ln += wt[k];
+	      cn = wt[k + 1] + 1;
+	    }
+	}
+      if (ln == ffewhere_line_number (wrl))
+	{			/* Already have the line object, just use it
+				   directly. */
+	  *wol = ffewhere_line_use (wrl);
+	}
+      else			/* Must search for the line object. */
+	*wol = ffewhere_line_new (ln);
+      *woc = ffewhere_column_new (cn);
+    }
+}
+
+/* Build next tracking index.
+
+   Set wt[i-1] continual offset so that it offsets from w* to (ln,cn).	Update
+   w* to contain (ln,cn).  DO NOT call this routine if i >= FFEWHERE_indexMAX
+   or i == 0.  */
+
+void
+ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt,
+		ffewhereIndex i, ffewhereLineNumber ln,
+		ffewhereColumnNumber cn)
+{
+  unsigned int lo;
+  unsigned int co;
+
+  if ((ffewhere_line_is_unknown (*wl))
+      || (ffewhere_column_is_unknown (*wc))
+      || ((lo = ln - ffewhere_line_number (*wl)) >= FFEWHERE_indexUNKNOWN))
+    {
+      wt[i * 2 - 2] = wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
+      ffewhere_line_kill (*wl);
+      ffewhere_column_kill (*wc);
+      *wl = FFEWHERE_lineUNKNOWN;
+      *wc = FFEWHERE_columnUNKNOWN;
+    }
+  else if (lo == 0)
+    {
+      wt[i * 2 - 2] = 0;
+      if ((co = cn - ffewhere_column_number (*wc)) > FFEWHERE_indexUNKNOWN)
+	{
+	  wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
+	  ffewhere_line_kill (*wl);
+	  ffewhere_column_kill (*wc);
+	  *wl = FFEWHERE_lineUNKNOWN;
+	  *wc = FFEWHERE_columnUNKNOWN;
+	}
+      else
+	{
+	  wt[i * 2 - 1] = co - 1;
+	  ffewhere_column_kill (*wc);
+	  *wc = ffewhere_column_use (ffewhere_column_new (cn));
+	}
+    }
+  else
+    {
+      wt[i * 2 - 2] = lo;
+      if (cn > FFEWHERE_indexUNKNOWN)
+	{
+	  wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
+	  ffewhere_line_kill (*wl);
+	  ffewhere_column_kill (*wc);
+	  *wl = ffewhere_line_unknown ();
+	  *wc = ffewhere_column_unknown ();
+	}
+      else
+	{
+	  wt[i * 2 - 1] = cn - 1;
+	  ffewhere_line_kill (*wl);
+	  ffewhere_column_kill (*wc);
+	  *wl = ffewhere_line_use (ffewhere_line_new (ln));
+	  *wc = ffewhere_column_use (ffewhere_column_new (cn));
+	}
+    }
+}
+
+/* Clear tracking index for internally created track.
+
+   Set the tracking information to indicate that the tracking is at its
+   simplest (no spaces or newlines within the tracking).  This means set
+   everything to zero in the current implementation.  Length is the total
+   length of the token; length must be 2 or greater, since length-1 tracking
+   characters are set.	*/
+
+void
+ffewhere_track_clear (ffewhereTrack wt, ffewhereIndex length)
+{
+  ffewhereIndex i;
+
+  if (length > FFEWHERE_indexMAX)
+    length = FFEWHERE_indexMAX;
+
+  for (i = 1; i < length; ++i)
+    wt[i * 2 - 2] = wt[i * 2 - 1] = 0;
+}
+
+/* Copy tracking index from one place to another.
+
+   Copy tracking information from swt[start] to dwt[0] and so on, presumably
+   after an ffewhere_set_from_track call.  Length is the total
+   length of the token; length must be 2 or greater, since length-1 tracking
+   characters are set.	*/
+
+void
+ffewhere_track_copy (ffewhereTrack dwt, ffewhereTrack swt, ffewhereIndex start,
+		     ffewhereIndex length)
+{
+  ffewhereIndex i;
+  ffewhereIndex copy;
+
+  if (length > FFEWHERE_indexMAX)
+    length = FFEWHERE_indexMAX;
+
+  if (length + start > FFEWHERE_indexMAX)
+    copy = FFEWHERE_indexMAX - start;
+  else
+    copy = length;
+
+  for (i = 1; i < copy; ++i)
+    {
+      dwt[i * 2 - 2] = swt[(i + start) * 2 - 2];
+      dwt[i * 2 - 1] = swt[(i + start) * 2 - 1];
+    }
+
+  for (; i < length; ++i)
+    {
+      dwt[i * 2 - 2] = 0;
+      dwt[i * 2 - 1] = 0;
+    }
+}
+
+/* Kill tracking data.
+
+   Kill all the tracking information by killing incremented lines from the
+   first line number.  */
+
+void
+ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc UNUSED,
+		     ffewhereTrack wt, ffewhereIndex length)
+{
+  ffewhereLineNumber ln;
+  unsigned int lo;
+  ffewhereIndex i;
+
+  ln = ffewhere_line_number (wrl);
+
+  if (length > FFEWHERE_indexMAX)
+    length = FFEWHERE_indexMAX;
+
+  for (i = 0; i < length - 1; ++i)
+    {
+      if ((lo = wt[i * 2]) == FFEWHERE_indexUNKNOWN)
+	break;
+      else if (lo != 0)
+	{
+	  ln += lo;
+	  wrl = ffewhere_line_new (ln);
+	  ffewhere_line_kill (wrl);
+	}
+    }
+}