initial commit

1 files changed, 1044 insertions, 0 deletions

diff --git a/gcc/f/stt.c b/gcc/f/stt.c
new file mode 100755
index 0000000..d2db379
--- /dev/null
+++ b/gcc/f/stt.c
@@ -0,0 +1,1044 @@
+/* stt.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley (burley@gnu.org).
+
+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:
+      None
+
+   Description:
+      Manages lists of tokens and related info for parsing.
+
+   Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "stt.h"
+#include "bld.h"
+#include "expr.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "sta.h"
+#include "stp.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffestt_caselist_append -- Append case to list of cases
+
+   ffesttCaseList list;
+   ffelexToken t;
+   ffestt_caselist_append(list,range,case1,case2,t);
+
+   list must have already been created by ffestt_caselist_create.  The
+   list is allocated out of the scratch pool.  The token is consumed.  */
+
+void
+ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1,
+			ffebld case2, ffelexToken t)
+{
+  ffesttCaseList new;
+
+  new = (ffesttCaseList) malloc_new_kp (ffesta_scratch_pool,
+					"FFEST case list", sizeof (*new));
+  new->next = list->previous->next;
+  new->previous = list->previous;
+  new->next->previous = new;
+  new->previous->next = new;
+  new->expr1 = case1;
+  new->expr2 = case2;
+  new->range = range;
+  new->t = t;
+}
+
+/* ffestt_caselist_create -- Create new list of cases
+
+   ffesttCaseList list;
+   list = ffestt_caselist_create();
+
+   The list is allocated out of the scratch pool.  */
+
+ffesttCaseList
+ffestt_caselist_create ()
+{
+  ffesttCaseList new;
+
+  new = (ffesttCaseList) malloc_new_kp (ffesta_scratch_pool,
+					"FFEST case list root",
+					sizeof (*new));
+  new->next = new->previous = new;
+  new->t = NULL;
+  new->expr1 = NULL;
+  new->expr2 = NULL;
+  new->range = FALSE;
+  return new;
+}
+
+/* ffestt_caselist_dump -- Dump list of cases
+
+   ffesttCaseList list;
+   ffestt_caselist_dump(list);
+
+   The cases in the list are dumped with commas separating them.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+void
+ffestt_caselist_dump (ffesttCaseList list)
+{
+  ffesttCaseList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      if (next != list->next)
+	fputc (',', dmpout);
+      if (next->expr1 != NULL)
+	ffebld_dump (next->expr1);
+      if (next->range)
+	{
+	  fputc (':', dmpout);
+	  if (next->expr2 != NULL)
+	    ffebld_dump (next->expr2);
+	}
+    }
+}
+#endif
+
+/* ffestt_caselist_kill -- Kill list of cases
+
+   ffesttCaseList list;
+   ffestt_caselist_kill(list);
+
+   The tokens on the list are killed.
+
+   02-Mar-90  JCB  1.1
+      Don't kill the list itself or change it, since it will be trashed when
+      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
+
+void
+ffestt_caselist_kill (ffesttCaseList list)
+{
+  ffesttCaseList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      ffelex_token_kill (next->t);
+    }
+}
+
+/* ffestt_dimlist_append -- Append dim to list of dims
+
+   ffesttDimList list;
+   ffelexToken t;
+   ffestt_dimlist_append(list,lower,upper,t);
+
+   list must have already been created by ffestt_dimlist_create.  The
+   list is allocated out of the scratch pool.  The token is consumed.  */
+
+void
+ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper,
+		       ffelexToken t)
+{
+  ffesttDimList new;
+
+  new = (ffesttDimList) malloc_new_kp (ffesta_scratch_pool,
+				       "FFEST dim list", sizeof (*new));
+  new->next = list->previous->next;
+  new->previous = list->previous;
+  new->next->previous = new;
+  new->previous->next = new;
+  new->lower = lower;
+  new->upper = upper;
+  new->t = t;
+}
+
+/* Convert list of dims into ffebld format.
+
+   ffesttDimList list;
+   ffeinfoRank rank;
+   ffebld array_size;
+   ffebld extents;
+   ffestt_dimlist_as_expr (list, &rank, &array_size, &extents);
+
+   The dims in the list are converted to a list of ITEMs; the rank of the
+   array, an expression representing the array size, a list of extent
+   expressions, and the list of ITEMs are returned.
+
+   If is_ugly_assumed, treat a final dimension with no lower bound
+   and an upper bound of 1 as a * bound.  */
+
+ffebld
+ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank,
+			ffebld *array_size, ffebld *extents,
+			bool is_ugly_assumed)
+{
+  ffesttDimList next;
+  ffebld expr;
+  ffebld as;
+  ffebld ex;			/* List of extents. */
+  ffebld ext;			/* Extent of a given dimension. */
+  ffebldListBottom bottom;
+  ffeinfoRank r;
+  ffeinfoKindtype nkt;
+  ffetargetIntegerDefault low;
+  ffetargetIntegerDefault high;
+  bool zero = FALSE;		/* Zero-size array. */
+  bool any = FALSE;
+  bool star = FALSE;		/* Adjustable array. */
+
+  assert (list != NULL);
+
+  r = 0;
+  ffebld_init_list (&expr, &bottom);
+  for (next = list->next; next != list; next = next->next)
+    {
+      ++r;
+      if (((next->lower == NULL)
+	   || (ffebld_op (next->lower) == FFEBLD_opCONTER))
+	  && (ffebld_op (next->upper) == FFEBLD_opCONTER))
+	{
+	  if (next->lower == NULL)
+	    low = 1;
+	  else
+	    low = ffebld_constant_integerdefault (ffebld_conter (next->lower));
+	  high = ffebld_constant_integerdefault (ffebld_conter (next->upper));
+	  if (low
+	      > high)
+	    zero = TRUE;
+	  if ((next->next == list)
+	      && is_ugly_assumed
+	      && (next->lower == NULL)
+	      && (high == 1)
+	      && (ffebld_conter_orig (next->upper) == NULL))
+	    {
+	      star = TRUE;
+	      ffebld_append_item (&bottom,
+				  ffebld_new_bounds (NULL, ffebld_new_star ()));
+	      continue;
+	    }
+	}
+      else if (((next->lower != NULL)
+		&& (ffebld_op (next->lower) == FFEBLD_opANY))
+	       || (ffebld_op (next->upper) == FFEBLD_opANY))
+	any = TRUE;
+      else if (ffebld_op (next->upper) == FFEBLD_opSTAR)
+	star = TRUE;
+      ffebld_append_item (&bottom,
+			  ffebld_new_bounds (next->lower, next->upper));
+    }
+  ffebld_end_list (&bottom);
+
+  if (zero)
+    {
+      as = ffebld_new_conter (ffebld_constant_new_integerdefault_val (0));
+      ffebld_set_info (as, ffeinfo_new
+		       (FFEINFO_basictypeINTEGER,
+			FFEINFO_kindtypeINTEGERDEFAULT,
+			0,
+			FFEINFO_kindENTITY,
+			FFEINFO_whereCONSTANT,
+			FFETARGET_charactersizeNONE));
+      ex = NULL;
+    }
+  else if (any)
+    {
+      as = ffebld_new_any ();
+      ffebld_set_info (as, ffeinfo_new_any ());
+      ex = ffebld_copy (as);
+    }
+  else if (star)
+    {
+      as = ffebld_new_star ();
+      ex = ffebld_new_star ();	/* ~~Should really be list as below. */
+    }
+  else
+    {
+      as = NULL;
+      ffebld_init_list (&ex, &bottom);
+      for (next = list->next; next != list; next = next->next)
+	{
+	  if ((next->lower == NULL)
+	      || ((ffebld_op (next->lower) == FFEBLD_opCONTER)
+		  && (ffebld_constant_integerdefault (ffebld_conter
+						      (next->lower)) == 1)))
+	    ext = ffebld_copy (next->upper);
+	  else
+	    {
+	      ext = ffebld_new_subtract (next->upper, next->lower);
+	      nkt
+		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
+					ffeinfo_kindtype (ffebld_info
+							  (next->lower)),
+					ffeinfo_kindtype (ffebld_info
+							  (next->upper)));
+	      ffebld_set_info (ext,
+			       ffeinfo_new (FFEINFO_basictypeINTEGER,
+					    nkt,
+					    0,
+					    FFEINFO_kindENTITY,
+					    ((ffebld_op (ffebld_left (ext))
+					      == FFEBLD_opCONTER)
+					     && (ffebld_op (ffebld_right
+							    (ext))
+						 == FFEBLD_opCONTER))
+					    ? FFEINFO_whereCONSTANT
+					    : FFEINFO_whereFLEETING,
+					    FFETARGET_charactersizeNONE));
+	      ffebld_set_left (ext,
+			       ffeexpr_convert_expr (ffebld_left (ext),
+						     next->t, ext, next->t,
+						     FFEEXPR_contextLET));
+	      ffebld_set_right (ext,
+				ffeexpr_convert_expr (ffebld_right (ext),
+						      next->t, ext,
+						      next->t,
+						      FFEEXPR_contextLET));
+	      ext = ffeexpr_collapse_subtract (ext, next->t);
+
+	      nkt
+		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
+					ffeinfo_kindtype (ffebld_info (ext)),
+					FFEINFO_kindtypeINTEGERDEFAULT);
+	      ext
+		= ffebld_new_add (ext,
+				  ffebld_new_conter
+				  (ffebld_constant_new_integerdefault_val
+				   (1)));
+	      ffebld_set_info (ffebld_right (ext), ffeinfo_new
+			       (FFEINFO_basictypeINTEGER,
+				FFEINFO_kindtypeINTEGERDEFAULT,
+				0,
+				FFEINFO_kindENTITY,
+				FFEINFO_whereCONSTANT,
+				FFETARGET_charactersizeNONE));
+	      ffebld_set_info (ext,
+			       ffeinfo_new (FFEINFO_basictypeINTEGER,
+					    nkt, 0, FFEINFO_kindENTITY,
+					    (ffebld_op (ffebld_left (ext))
+					     == FFEBLD_opCONTER)
+					    ? FFEINFO_whereCONSTANT
+					    : FFEINFO_whereFLEETING,
+					    FFETARGET_charactersizeNONE));
+	      ffebld_set_left (ext,
+			       ffeexpr_convert_expr (ffebld_left (ext),
+						     next->t, ext,
+						     next->t,
+						     FFEEXPR_contextLET));
+	      ffebld_set_right (ext,
+				ffeexpr_convert_expr (ffebld_right (ext),
+						      next->t, ext,
+						      next->t,
+						      FFEEXPR_contextLET));
+	      ext = ffeexpr_collapse_add (ext, next->t);
+	    }
+	  ffebld_append_item (&bottom, ext);
+	  if (as == NULL)
+	    as = ext;
+	  else
+	    {
+	      nkt
+		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
+					ffeinfo_kindtype (ffebld_info (as)),
+				      ffeinfo_kindtype (ffebld_info (ext)));
+	      as = ffebld_new_multiply (as, ext);
+	      ffebld_set_info (as,
+			       ffeinfo_new (FFEINFO_basictypeINTEGER,
+					    nkt, 0, FFEINFO_kindENTITY,
+					    ((ffebld_op (ffebld_left (as))
+					      == FFEBLD_opCONTER)
+					     && (ffebld_op (ffebld_right
+							    (as))
+						 == FFEBLD_opCONTER))
+					    ? FFEINFO_whereCONSTANT
+					    : FFEINFO_whereFLEETING,
+					    FFETARGET_charactersizeNONE));
+	      ffebld_set_left (as,
+			       ffeexpr_convert_expr (ffebld_left (as),
+						     next->t, as, next->t,
+						     FFEEXPR_contextLET));
+	      ffebld_set_right (as,
+				ffeexpr_convert_expr (ffebld_right (as),
+						      next->t, as,
+						      next->t,
+						      FFEEXPR_contextLET));
+	      as = ffeexpr_collapse_multiply (as, next->t);
+	    }
+	}
+      ffebld_end_list (&bottom);
+      as = ffeexpr_convert (as, list->next->t, NULL,
+			    FFEINFO_basictypeINTEGER,
+			    FFEINFO_kindtypeINTEGERDEFAULT, 0,
+			    FFETARGET_charactersizeNONE,
+			    FFEEXPR_contextLET);
+    }
+
+  *rank = r;
+  *array_size = as;
+  *extents = ex;
+  return expr;
+}
+
+/* ffestt_dimlist_create -- Create new list of dims
+
+   ffesttDimList list;
+   list = ffestt_dimlist_create();
+
+   The list is allocated out of the scratch pool.  */
+
+ffesttDimList
+ffestt_dimlist_create ()
+{
+  ffesttDimList new;
+
+  new = (ffesttDimList) malloc_new_kp (ffesta_scratch_pool,
+				       "FFEST dim list root", sizeof (*new));
+  new->next = new->previous = new;
+  new->t = NULL;
+  new->lower = NULL;
+  new->upper = NULL;
+  return new;
+}
+
+/* ffestt_dimlist_dump -- Dump list of dims
+
+   ffesttDimList list;
+   ffestt_dimlist_dump(list);
+
+   The dims in the list are dumped with commas separating them.	 */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+void
+ffestt_dimlist_dump (ffesttDimList list)
+{
+  ffesttDimList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      if (next != list->next)
+	fputc (',', dmpout);
+      if (next->lower != NULL)
+	ffebld_dump (next->lower);
+      fputc (':', dmpout);
+      if (next->upper != NULL)
+	ffebld_dump (next->upper);
+    }
+}
+#endif
+
+/* ffestt_dimlist_kill -- Kill list of dims
+
+   ffesttDimList list;
+   ffestt_dimlist_kill(list);
+
+   The tokens on the list are killed.  */
+
+void
+ffestt_dimlist_kill (ffesttDimList list)
+{
+  ffesttDimList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      ffelex_token_kill (next->t);
+    }
+}
+
+/* Determine type of list of dimensions.
+
+   Return KNOWN for all-constant bounds, ADJUSTABLE for constant
+   and variable but no * bounds, ASSUMED for constant and * but
+   not variable bounds, ADJUSTABLEASSUMED for constant and variable
+   and * bounds.
+
+   If is_ugly_assumed, treat a final dimension with no lower bound
+   and an upper bound of 1 as a * bound.  */
+
+ffestpDimtype
+ffestt_dimlist_type (ffesttDimList list, bool is_ugly_assumed)
+{
+  ffesttDimList next;
+  ffestpDimtype type;
+
+  if (list == NULL)
+    return FFESTP_dimtypeNONE;
+
+  type = FFESTP_dimtypeKNOWN;
+  for (next = list->next; next != list; next = next->next)
+    {
+      bool ugly_assumed = FALSE;
+
+      if ((next->next == list)
+	  && is_ugly_assumed
+	  && (next->lower == NULL)
+	  && (next->upper != NULL)
+	  && (ffebld_op (next->upper) == FFEBLD_opCONTER)
+	  && (ffebld_constant_integerdefault (ffebld_conter (next->upper))
+	      == 1)
+	  && (ffebld_conter_orig (next->upper) == NULL))
+	ugly_assumed = TRUE;
+
+      if (next->lower != NULL)
+	{
+	  if (ffebld_op (next->lower) != FFEBLD_opCONTER)
+	    {
+	      if (type == FFESTP_dimtypeASSUMED)
+		type = FFESTP_dimtypeADJUSTABLEASSUMED;
+	      else
+		type = FFESTP_dimtypeADJUSTABLE;
+	    }
+	}
+      if (next->upper != NULL)
+	{
+	  if (ugly_assumed
+	      || (ffebld_op (next->upper) == FFEBLD_opSTAR))
+	    {
+	      if (type == FFESTP_dimtypeADJUSTABLE)
+		type = FFESTP_dimtypeADJUSTABLEASSUMED;
+	      else
+		type = FFESTP_dimtypeASSUMED;
+	    }
+	  else if (ffebld_op (next->upper) != FFEBLD_opCONTER)
+	    type = FFESTP_dimtypeADJUSTABLE;
+	}
+    }
+
+  return type;
+}
+
+/* ffestt_exprlist_append -- Append expr to list of exprs
+
+   ffesttExprList list;
+   ffelexToken t;
+   ffestt_exprlist_append(list,expr,t);
+
+   list must have already been created by ffestt_exprlist_create.  The
+   list is allocated out of the scratch pool.  The token is consumed.  */
+
+void
+ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t)
+{
+  ffesttExprList new;
+
+  new = (ffesttExprList) malloc_new_kp (ffesta_scratch_pool,
+					"FFEST expr list", sizeof (*new));
+  new->next = list->previous->next;
+  new->previous = list->previous;
+  new->next->previous = new;
+  new->previous->next = new;
+  new->expr = expr;
+  new->t = t;
+}
+
+/* ffestt_exprlist_create -- Create new list of exprs
+
+   ffesttExprList list;
+   list = ffestt_exprlist_create();
+
+   The list is allocated out of the scratch pool.  */
+
+ffesttExprList
+ffestt_exprlist_create ()
+{
+  ffesttExprList new;
+
+  new = (ffesttExprList) malloc_new_kp (ffesta_scratch_pool,
+				     "FFEST expr list root", sizeof (*new));
+  new->next = new->previous = new;
+  new->expr = NULL;
+  new->t = NULL;
+  return new;
+}
+
+/* ffestt_exprlist_drive -- Drive list of token pairs into function
+
+   ffesttExprList list;
+   void fn(ffebld expr,ffelexToken t);
+   ffestt_exprlist_drive(list,fn);
+
+   The expr/token pairs in the list are passed to the function one pair
+   at a time.  */
+
+void
+ffestt_exprlist_drive (ffesttExprList list, void (*fn) ())
+{
+  ffesttExprList next;
+
+  if (list == NULL)
+    return;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      (*fn) (next->expr, next->t);
+    }
+}
+
+/* ffestt_exprlist_dump -- Dump list of exprs
+
+   ffesttExprList list;
+   ffestt_exprlist_dump(list);
+
+   The exprs in the list are dumped with commas separating them.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+void
+ffestt_exprlist_dump (ffesttExprList list)
+{
+  ffesttExprList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      if (next != list->next)
+	fputc (',', dmpout);
+      ffebld_dump (next->expr);
+    }
+}
+#endif
+
+/* ffestt_exprlist_kill -- Kill list of exprs
+
+   ffesttExprList list;
+   ffestt_exprlist_kill(list);
+
+   The tokens on the list are killed.
+
+   02-Mar-90  JCB  1.1
+      Don't kill the list itself or change it, since it will be trashed when
+      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
+
+void
+ffestt_exprlist_kill (ffesttExprList list)
+{
+  ffesttExprList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      ffelex_token_kill (next->t);
+    }
+}
+
+/* ffestt_formatlist_append -- Append null format to list of formats
+
+   ffesttFormatList list, new;
+   new = ffestt_formatlist_append(list);
+
+   list must have already been created by ffestt_formatlist_create.  The
+   new item is allocated out of the scratch pool.  The caller must initialize
+   it appropriately.  */
+
+ffesttFormatList
+ffestt_formatlist_append (ffesttFormatList list)
+{
+  ffesttFormatList new;
+
+  new = (ffesttFormatList) malloc_new_kp (ffesta_scratch_pool,
+					"FFEST format list", sizeof (*new));
+  new->next = list->previous->next;
+  new->previous = list->previous;
+  new->next->previous = new;
+  new->previous->next = new;
+  return new;
+}
+
+/* ffestt_formatlist_create -- Create new list of formats
+
+   ffesttFormatList list;
+   list = ffestt_formatlist_create(NULL);
+
+   The list is allocated out of the scratch pool.  */
+
+ffesttFormatList
+ffestt_formatlist_create (ffesttFormatList parent, ffelexToken t)
+{
+  ffesttFormatList new;
+
+  new = (ffesttFormatList) malloc_new_kp (ffesta_scratch_pool,
+				   "FFEST format list root", sizeof (*new));
+  new->next = new->previous = new;
+  new->type = FFESTP_formattypeNone;
+  new->t = t;
+  new->u.root.parent = parent;
+  return new;
+}
+
+/* ffestt_formatlist_kill -- Kill tokens on list of formats
+
+   ffesttFormatList list;
+   ffestt_formatlist_kill(list);
+
+   The tokens on the list are killed.  */
+
+void
+ffestt_formatlist_kill (ffesttFormatList list)
+{
+  ffesttFormatList next;
+
+  /* Always kill from the very top on down. */
+
+  while (list->u.root.parent != NULL)
+    list = list->u.root.parent->next;
+
+  /* Kill first token for this list. */
+
+  if (list->t != NULL)
+    ffelex_token_kill (list->t);
+
+  /* Kill each item in this list. */
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      ffelex_token_kill (next->t);
+      switch (next->type)
+	{
+	case FFESTP_formattypeI:
+	case FFESTP_formattypeB:
+	case FFESTP_formattypeO:
+	case FFESTP_formattypeZ:
+	case FFESTP_formattypeF:
+	case FFESTP_formattypeE:
+	case FFESTP_formattypeEN:
+	case FFESTP_formattypeG:
+	case FFESTP_formattypeL:
+	case FFESTP_formattypeA:
+	case FFESTP_formattypeD:
+	  if (next->u.R1005.R1004.t != NULL)
+	    ffelex_token_kill (next->u.R1005.R1004.t);
+	  if (next->u.R1005.R1006.t != NULL)
+	    ffelex_token_kill (next->u.R1005.R1006.t);
+	  if (next->u.R1005.R1007_or_R1008.t != NULL)
+	    ffelex_token_kill (next->u.R1005.R1007_or_R1008.t);
+	  if (next->u.R1005.R1009.t != NULL)
+	    ffelex_token_kill (next->u.R1005.R1009.t);
+	  break;
+
+	case FFESTP_formattypeQ:
+	case FFESTP_formattypeDOLLAR:
+	case FFESTP_formattypeP:
+	case FFESTP_formattypeT:
+	case FFESTP_formattypeTL:
+	case FFESTP_formattypeTR:
+	case FFESTP_formattypeX:
+	case FFESTP_formattypeS:
+	case FFESTP_formattypeSP:
+	case FFESTP_formattypeSS:
+	case FFESTP_formattypeBN:
+	case FFESTP_formattypeBZ:
+	case FFESTP_formattypeSLASH:
+	case FFESTP_formattypeCOLON:
+	  if (next->u.R1010.val.t != NULL)
+	    ffelex_token_kill (next->u.R1010.val.t);
+	  break;
+
+	case FFESTP_formattypeR1016:
+	  break;		/* Nothing more to do. */
+
+	case FFESTP_formattypeFORMAT:
+	  if (next->u.R1003D.R1004.t != NULL)
+	    ffelex_token_kill (next->u.R1003D.R1004.t);
+	  next->u.R1003D.format->u.root.parent = NULL;	/* Parent already dying. */
+	  ffestt_formatlist_kill (next->u.R1003D.format);
+	  break;
+
+	default:
+	  assert (FALSE);
+	}
+    }
+}
+
+/* ffestt_implist_append -- Append token pair to list of token pairs
+
+   ffesttImpList list;
+   ffelexToken t;
+   ffestt_implist_append(list,start_token,end_token);
+
+   list must have already been created by ffestt_implist_create.  The
+   list is allocated out of the scratch pool.  The tokens are consumed.	 */
+
+void
+ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last)
+{
+  ffesttImpList new;
+
+  new = (ffesttImpList) malloc_new_kp (ffesta_scratch_pool,
+				       "FFEST token list", sizeof (*new));
+  new->next = list->previous->next;
+  new->previous = list->previous;
+  new->next->previous = new;
+  new->previous->next = new;
+  new->first = first;
+  new->last = last;
+}
+
+/* ffestt_implist_create -- Create new list of token pairs
+
+   ffesttImpList list;
+   list = ffestt_implist_create();
+
+   The list is allocated out of the scratch pool.  */
+
+ffesttImpList
+ffestt_implist_create ()
+{
+  ffesttImpList new;
+
+  new = (ffesttImpList) malloc_new_kp (ffesta_scratch_pool,
+				       "FFEST token list root",
+				       sizeof (*new));
+  new->next = new->previous = new;
+  new->first = NULL;
+  new->last = NULL;
+  return new;
+}
+
+/* ffestt_implist_drive -- Drive list of token pairs into function
+
+   ffesttImpList list;
+   void fn(ffelexToken first,ffelexToken last);
+   ffestt_implist_drive(list,fn);
+
+   The token pairs in the list are passed to the function one pair at a time.  */
+
+void
+ffestt_implist_drive (ffesttImpList list, void (*fn) ())
+{
+  ffesttImpList next;
+
+  if (list == NULL)
+    return;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      (*fn) (next->first, next->last);
+    }
+}
+
+/* ffestt_implist_dump -- Dump list of token pairs
+
+   ffesttImpList list;
+   ffestt_implist_dump(list);
+
+   The token pairs in the list are dumped with commas separating them.	*/
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+void
+ffestt_implist_dump (ffesttImpList list)
+{
+  ffesttImpList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      if (next != list->next)
+	fputc (',', dmpout);
+      assert (ffelex_token_type (next->first) == FFELEX_typeNAME);
+      fputs (ffelex_token_text (next->first), dmpout);
+      if (next->last != NULL)
+	{
+	  fputc ('-', dmpout);
+	  assert (ffelex_token_type (next->last) == FFELEX_typeNAME);
+	  fputs (ffelex_token_text (next->last), dmpout);
+	}
+    }
+}
+#endif
+
+/* ffestt_implist_kill -- Kill list of token pairs
+
+   ffesttImpList list;
+   ffestt_implist_kill(list);
+
+   The tokens on the list are killed.  */
+
+void
+ffestt_implist_kill (ffesttImpList list)
+{
+  ffesttImpList next;
+
+  for (next = list->next; next != list; next = next->next)
+    {
+      ffelex_token_kill (next->first);
+      if (next->last != NULL)
+	ffelex_token_kill (next->last);
+    }
+}
+
+/* ffestt_tokenlist_append -- Append token to list of tokens
+
+   ffesttTokenList tl;
+   ffelexToken t;
+   ffestt_tokenlist_append(tl,t);
+
+   tl must have already been created by ffestt_tokenlist_create.  The
+   list is allocated out of the scratch pool.  The token is consumed.  */
+
+void
+ffestt_tokenlist_append (ffesttTokenList tl, ffelexToken t)
+{
+  ffesttTokenItem ti;
+
+  ti = (ffesttTokenItem) malloc_new_kp (ffesta_scratch_pool,
+					"FFEST token item", sizeof (*ti));
+  ti->next = (ffesttTokenItem) &tl->first;
+  ti->previous = tl->last;
+  ti->next->previous = ti;
+  ti->previous->next = ti;
+  ti->t = t;
+  ++tl->count;
+}
+
+/* ffestt_tokenlist_create -- Create new list of tokens
+
+   ffesttTokenList tl;
+   tl = ffestt_tokenlist_create();
+
+   The list is allocated out of the scratch pool.  */
+
+ffesttTokenList
+ffestt_tokenlist_create ()
+{
+  ffesttTokenList tl;
+
+  tl = (ffesttTokenList) malloc_new_kp (ffesta_scratch_pool,
+					"FFEST token list", sizeof (*tl));
+  tl->first = tl->last = (ffesttTokenItem) &tl->first;
+  tl->count = 0;
+  return tl;
+}
+
+/* ffestt_tokenlist_drive -- Drive list of tokens
+
+   ffesttTokenList tl;
+   void fn(ffelexToken t);
+   ffestt_tokenlist_drive(tl,fn);
+
+   The tokens in the list are passed to the given function.  */
+
+void
+ffestt_tokenlist_drive (ffesttTokenList tl, void (*fn) ())
+{
+  ffesttTokenItem ti;
+
+  if (tl == NULL)
+    return;
+
+  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+    {
+      (*fn) (ti->t);
+    }
+}
+
+/* ffestt_tokenlist_dump -- Dump list of tokens
+
+   ffesttTokenList tl;
+   ffestt_tokenlist_dump(tl);
+
+   The tokens in the list are dumped with commas separating them.  */
+
+#if FFECOM_targetCURRENT == FFECOM_targetFFE
+void
+ffestt_tokenlist_dump (ffesttTokenList tl)
+{
+  ffesttTokenItem ti;
+
+  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+    {
+      if (ti != tl->first)
+	fputc (',', dmpout);
+      switch (ffelex_token_type (ti->t))
+	{
+	case FFELEX_typeNUMBER:
+	case FFELEX_typeNAME:
+	case FFELEX_typeNAMES:
+	  fputs (ffelex_token_text (ti->t), dmpout);
+	  break;
+
+	case FFELEX_typeASTERISK:
+	  fputc ('*', dmpout);
+	  break;
+
+	default:
+	  assert (FALSE);
+	  fputc ('?', dmpout);
+	  break;
+	}
+    }
+}
+#endif
+
+/* ffestt_tokenlist_handle -- Handle list of tokens
+
+   ffesttTokenList tl;
+   ffelexHandler handler;
+   handler = ffestt_tokenlist_handle(tl,handler);
+
+   The tokens in the list are passed to the handler(s).	 */
+
+ffelexHandler
+ffestt_tokenlist_handle (ffesttTokenList tl, ffelexHandler handler)
+{
+  ffesttTokenItem ti;
+
+  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+    handler = (ffelexHandler) (*handler) (ti->t);
+
+  return (ffelexHandler) handler;
+}
+
+/* ffestt_tokenlist_kill -- Kill list of tokens
+
+   ffesttTokenList tl;
+   ffestt_tokenlist_kill(tl);
+
+   The tokens on the list are killed.
+
+   02-Mar-90  JCB  1.1
+      Don't kill the list itself or change it, since it will be trashed when
+      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
+
+void
+ffestt_tokenlist_kill (ffesttTokenList tl)
+{
+  ffesttTokenItem ti;
+
+  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
+    {
+      ffelex_token_kill (ti->t);
+    }
+}