home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / g77-0.5.15-src.tgz / tar.out / fsf / g77 / f / stt.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  25KB  |  995 lines
  1. /* stt.c -- Implementation File (module.c template V1.0)
  2.    Copyright (C) 1995 Free Software Foundation, Inc.
  3.    Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
  4.  
  5. This file is part of GNU Fortran.
  6.  
  7. GNU Fortran is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2, or (at your option)
  10. any later version.
  11.  
  12. GNU Fortran is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with GNU Fortran; see the file COPYING.  If not, write to
  19. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.    Related Modules:
  22.       None
  23.  
  24.    Description:
  25.       Manages lists of tokens and related info for parsing.
  26.  
  27.    Modifications:
  28. */
  29.  
  30. /* Include files. */
  31.  
  32. #include "proj.h"
  33. #include "stt.h"
  34. #include "bld.h"
  35. #include "expr.h"
  36. #include "info.h"
  37. #include "lex.h"
  38. #include "malloc.h"
  39. #include "sta.h"
  40. #include "stp.h"
  41.  
  42. /* Externals defined here. */
  43.  
  44.  
  45. /* Simple definitions and enumerations. */
  46.  
  47.  
  48. /* Internal typedefs. */
  49.  
  50.  
  51. /* Private include files. */
  52.  
  53.  
  54. /* Internal structure definitions. */
  55.  
  56.  
  57. /* Static objects accessed by functions in this module. */
  58.  
  59.  
  60. /* Static functions (internal). */
  61.  
  62.  
  63. /* Internal macros. */
  64.  
  65.  
  66. /* ffestt_caselist_append -- Append case to list of cases
  67.  
  68.    ffesttCaseList list;
  69.    ffelexToken t;
  70.    ffestt_caselist_append(list,range,case1,case2,t);
  71.  
  72.    list must have already been created by ffestt_caselist_create.  The
  73.    list is allocated out of the scratch pool.  The token is consumed.  */
  74.  
  75. void
  76. ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1,
  77.             ffebld case2, ffelexToken t)
  78. {
  79.   ffesttCaseList new;
  80.  
  81.   new = (ffesttCaseList) malloc_new_kp (ffesta_scratch_pool,
  82.                     "FFEST case list", sizeof (*new));
  83.   new->next = list->previous->next;
  84.   new->previous = list->previous;
  85.   new->next->previous = new;
  86.   new->previous->next = new;
  87.   new->expr1 = case1;
  88.   new->expr2 = case2;
  89.   new->range = range;
  90.   new->t = t;
  91. }
  92.  
  93. /* ffestt_caselist_create -- Create new list of cases
  94.  
  95.    ffesttCaseList list;
  96.    list = ffestt_caselist_create();
  97.  
  98.    The list is allocated out of the scratch pool.  */
  99.  
  100. ffesttCaseList
  101. ffestt_caselist_create ()
  102. {
  103.   ffesttCaseList new;
  104.  
  105.   new = (ffesttCaseList) malloc_new_kp (ffesta_scratch_pool,
  106.                     "FFEST case list root",
  107.                     sizeof (*new));
  108.   new->next = new->previous = new;
  109.   new->t = NULL;
  110.   new->expr1 = NULL;
  111.   new->expr2 = NULL;
  112.   new->range = FALSE;
  113.   return new;
  114. }
  115.  
  116. /* ffestt_caselist_dump -- Dump list of cases
  117.  
  118.    ffesttCaseList list;
  119.    ffestt_caselist_dump(list);
  120.  
  121.    The cases in the list are dumped with commas separating them.  */
  122.  
  123. void
  124. ffestt_caselist_dump (ffesttCaseList list)
  125. {
  126.   ffesttCaseList next;
  127.  
  128.   for (next = list->next; next != list; next = next->next)
  129.     {
  130.       if (next != list->next)
  131.     fputc (',', stdout);
  132.       if (next->expr1 != NULL)
  133.     ffebld_dump (next->expr1);
  134.       if (next->range)
  135.     {
  136.       fputc (':', stdout);
  137.       if (next->expr2 != NULL)
  138.         ffebld_dump (next->expr2);
  139.     }
  140.     }
  141. }
  142.  
  143. /* ffestt_caselist_kill -- Kill list of cases
  144.  
  145.    ffesttCaseList list;
  146.    ffestt_caselist_kill(list);
  147.  
  148.    The tokens on the list are killed.
  149.  
  150.    02-Mar-90  JCB  1.1
  151.       Don't kill the list itself or change it, since it will be trashed when
  152.       ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
  153.  
  154. void
  155. ffestt_caselist_kill (ffesttCaseList list)
  156. {
  157.   ffesttCaseList next;
  158.  
  159.   for (next = list->next; next != list; next = next->next)
  160.     {
  161.       ffelex_token_kill (next->t);
  162.     }
  163. }
  164.  
  165. /* ffestt_dimlist_append -- Append dim to list of dims
  166.  
  167.    ffesttDimList list;
  168.    ffelexToken t;
  169.    ffestt_dimlist_append(list,lower,upper,t);
  170.  
  171.    list must have already been created by ffestt_dimlist_create.  The
  172.    list is allocated out of the scratch pool.  The token is consumed.  */
  173.  
  174. void
  175. ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper,
  176.                ffelexToken t)
  177. {
  178.   ffesttDimList new;
  179.  
  180.   new = (ffesttDimList) malloc_new_kp (ffesta_scratch_pool,
  181.                        "FFEST dim list", sizeof (*new));
  182.   new->next = list->previous->next;
  183.   new->previous = list->previous;
  184.   new->next->previous = new;
  185.   new->previous->next = new;
  186.   new->lower = lower;
  187.   new->upper = upper;
  188.   new->t = t;
  189. }
  190.  
  191. /* ffestt_dimlist_as_expr -- Convert list of dims into ffebld format
  192.  
  193.    ffesttDimList list;
  194.    ffeinfoRank rank;
  195.    ffebld array_size;
  196.    ffebld extents;
  197.    ffestt_dimlist_as_expr (list, &rank, &array_size, &extents);
  198.  
  199.    The dims in the list are converted to a list of ITEMs; the rank of the
  200.    array, an expression representing the array size, a list of extent
  201.    expressions, and the list of ITEMs are returned.  */
  202.  
  203. ffebld
  204. ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank,
  205.             ffebld *array_size, ffebld *extents)
  206. {
  207.   ffesttDimList next;
  208.   ffebld expr;
  209.   ffebld as;
  210.   ffebld ex;            /* List of extents. */
  211.   ffebld ext;            /* Extent of a given dimension. */
  212.   ffebldListBottom bottom;
  213.   ffeinfoRank r;
  214.   ffeinfoKindtype nkt;
  215.   ffetargetIntegerDefault low;
  216.   bool zero = FALSE;        /* Zero-size array. */
  217.   bool any = FALSE;
  218.   bool star = FALSE;        /* Adjustable array. */
  219.  
  220.   assert (list != NULL);
  221.  
  222.   r = 0;
  223.   ffebld_init_list (&expr, &bottom);
  224.   for (next = list->next; next != list; next = next->next)
  225.     {
  226.       ++r;
  227.       if (((next->lower == NULL)
  228.        || (ffebld_op (next->lower) == FFEBLD_opCONTER))
  229.       && (ffebld_op (next->upper) == FFEBLD_opCONTER))
  230.     {
  231.       if (next->lower == NULL)
  232.         low = 1;
  233.       else
  234.         low = ffebld_constant_integerdefault (ffebld_conter (next->lower));
  235.       if (low
  236.           > ffebld_constant_integerdefault (ffebld_conter (next->upper)))
  237.         zero = TRUE;
  238.     }
  239.       else if (((next->lower != NULL)
  240.         && (ffebld_op (next->lower) == FFEBLD_opANY))
  241.            || (ffebld_op (next->upper) == FFEBLD_opANY))
  242.     any = TRUE;
  243.       else if (ffebld_op (next->upper) == FFEBLD_opSTAR)
  244.     star = TRUE;
  245.       ffebld_append_item (&bottom,
  246.               ffebld_new_bounds (next->lower, next->upper));
  247.     }
  248.   ffebld_end_list (&bottom);
  249.  
  250.   if (zero)
  251.     {
  252.       as = ffebld_new_conter (ffebld_constant_new_integerdefault_val (0));
  253.       ffebld_set_info (as, ffeinfo_new
  254.                (FFEINFO_basictypeINTEGER,
  255.             FFEINFO_kindtypeINTEGERDEFAULT,
  256.             0,
  257.             FFEINFO_kindENTITY,
  258.             FFEINFO_whereCONSTANT,
  259.             FFETARGET_charactersizeNONE));
  260.       ex = NULL;
  261.     }
  262.   else if (any)
  263.     {
  264.       as = ffebld_new_any ();
  265.       ffebld_set_info (as, ffeinfo_new_any ());
  266.       ex = ffebld_copy (as);
  267.     }
  268.   else if (star)
  269.     {
  270.       as = ffebld_new_star ();
  271.       ex = ffebld_new_star ();    /* ~~Should really be list as below. */
  272.     }
  273.   else
  274.     {
  275.       as = NULL;
  276.       ffebld_init_list (&ex, &bottom);
  277.       for (next = list->next; next != list; next = next->next)
  278.     {
  279.       if ((next->lower == NULL)
  280.           || ((ffebld_op (next->lower) == FFEBLD_opCONTER)
  281.           && (ffebld_constant_integerdefault (ffebld_conter
  282.                               (next->lower)) == 1)))
  283.         ext = ffebld_copy (next->upper);
  284.       else
  285.         {
  286.           ext = ffebld_new_subtract (next->upper, next->lower);
  287.           nkt
  288.         = ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
  289.                     ffeinfo_kindtype (ffebld_info
  290.                               (next->lower)),
  291.                     ffeinfo_kindtype (ffebld_info
  292.                               (next->upper)));
  293.           ffebld_set_info (ext,
  294.                    ffeinfo_new (FFEINFO_basictypeINTEGER,
  295.                         nkt,
  296.                         0,
  297.                         FFEINFO_kindENTITY,
  298.                         ((ffebld_op (ffebld_left (ext))
  299.                           == FFEBLD_opCONTER)
  300.                          && (ffebld_op (ffebld_right
  301.                                 (ext))
  302.                          == FFEBLD_opCONTER))
  303.                         ? FFEINFO_whereCONSTANT
  304.                         : FFEINFO_whereFLEETING,
  305.                         FFETARGET_charactersizeNONE));
  306.           ffebld_set_left (ext,
  307.                    ffeexpr_convert_expr (ffebld_left (ext),
  308.                              next->t, ext, next->t,
  309.                              FFEEXPR_contextLET));
  310.           ffebld_set_right (ext,
  311.                 ffeexpr_convert_expr (ffebld_right (ext),
  312.                               next->t, ext,
  313.                               next->t,
  314.                               FFEEXPR_contextLET));
  315.           ext = ffeexpr_collapse_subtract (ext, next->t);
  316.  
  317.           nkt
  318.         = ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
  319.                     ffeinfo_kindtype (ffebld_info (ext)),
  320.                     FFEINFO_kindtypeINTEGERDEFAULT);
  321.           ext
  322.         = ffebld_new_add (ext,
  323.                   ffebld_new_conter
  324.                   (ffebld_constant_new_integerdefault_val
  325.                    (1)));
  326.           ffebld_set_info (ffebld_right (ext), ffeinfo_new
  327.                    (FFEINFO_basictypeINTEGER,
  328.                 FFEINFO_kindtypeINTEGERDEFAULT,
  329.                 0,
  330.                 FFEINFO_kindENTITY,
  331.                 FFEINFO_whereCONSTANT,
  332.                 FFETARGET_charactersizeNONE));
  333.           ffebld_set_info (ext,
  334.                    ffeinfo_new (FFEINFO_basictypeINTEGER,
  335.                         nkt, 0, FFEINFO_kindENTITY,
  336.                         (ffebld_op (ffebld_left (ext))
  337.                          == FFEBLD_opCONTER)
  338.                         ? FFEINFO_whereCONSTANT
  339.                         : FFEINFO_whereFLEETING,
  340.                         FFETARGET_charactersizeNONE));
  341.           ffebld_set_left (ext,
  342.                    ffeexpr_convert_expr (ffebld_left (ext),
  343.                              next->t, ext,
  344.                              next->t,
  345.                              FFEEXPR_contextLET));
  346.           ffebld_set_right (ext,
  347.                 ffeexpr_convert_expr (ffebld_right (ext),
  348.                               next->t, ext,
  349.                               next->t,
  350.                               FFEEXPR_contextLET));
  351.           ext = ffeexpr_collapse_add (ext, next->t);
  352.         }
  353.       ffebld_append_item (&bottom, ext);
  354.       if (as == NULL)
  355.         as = ext;
  356.       else
  357.         {
  358.           nkt
  359.         = ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
  360.                     ffeinfo_kindtype (ffebld_info (as)),
  361.                       ffeinfo_kindtype (ffebld_info (ext)));
  362.           as = ffebld_new_multiply (as, ext);
  363.           ffebld_set_info (as,
  364.                    ffeinfo_new (FFEINFO_basictypeINTEGER,
  365.                         nkt, 0, FFEINFO_kindENTITY,
  366.                         ((ffebld_op (ffebld_left (as))
  367.                           == FFEBLD_opCONTER)
  368.                          && (ffebld_op (ffebld_right
  369.                                 (as))
  370.                          == FFEBLD_opCONTER))
  371.                         ? FFEINFO_whereCONSTANT
  372.                         : FFEINFO_whereFLEETING,
  373.                         FFETARGET_charactersizeNONE));
  374.           ffebld_set_left (as,
  375.                    ffeexpr_convert_expr (ffebld_left (as),
  376.                              next->t, as, next->t,
  377.                              FFEEXPR_contextLET));
  378.           ffebld_set_right (as,
  379.                 ffeexpr_convert_expr (ffebld_right (as),
  380.                               next->t, as,
  381.                               next->t,
  382.                               FFEEXPR_contextLET));
  383.           as = ffeexpr_collapse_multiply (as, next->t);
  384.         }
  385.     }
  386.       ffebld_end_list (&bottom);
  387.       as = ffeexpr_convert (as, list->next->t, NULL,
  388.                 FFEINFO_basictypeINTEGER,
  389.                 FFEINFO_kindtypeINTEGERDEFAULT, 0,
  390.                 FFETARGET_charactersizeNONE,
  391.                 FFEEXPR_contextLET);
  392.     }
  393.  
  394.   *rank = r;
  395.   *array_size = as;
  396.   *extents = ex;
  397.   return expr;
  398. }
  399.  
  400. /* ffestt_dimlist_create -- Create new list of dims
  401.  
  402.    ffesttDimList list;
  403.    list = ffestt_dimlist_create();
  404.  
  405.    The list is allocated out of the scratch pool.  */
  406.  
  407. ffesttDimList
  408. ffestt_dimlist_create ()
  409. {
  410.   ffesttDimList new;
  411.  
  412.   new = (ffesttDimList) malloc_new_kp (ffesta_scratch_pool,
  413.                        "FFEST dim list root", sizeof (*new));
  414.   new->next = new->previous = new;
  415.   new->t = NULL;
  416.   new->lower = NULL;
  417.   new->upper = NULL;
  418.   return new;
  419. }
  420.  
  421. /* ffestt_dimlist_dump -- Dump list of dims
  422.  
  423.    ffesttDimList list;
  424.    ffestt_dimlist_dump(list);
  425.  
  426.    The dims in the list are dumped with commas separating them.     */
  427.  
  428. void
  429. ffestt_dimlist_dump (ffesttDimList list)
  430. {
  431.   ffesttDimList next;
  432.  
  433.   for (next = list->next; next != list; next = next->next)
  434.     {
  435.       if (next != list->next)
  436.     fputc (',', stdout);
  437.       if (next->lower != NULL)
  438.     ffebld_dump (next->lower);
  439.       fputc (':', stdout);
  440.       if (next->upper != NULL)
  441.     ffebld_dump (next->upper);
  442.     }
  443. }
  444.  
  445. /* ffestt_dimlist_kill -- Kill list of dims
  446.  
  447.    ffesttDimList list;
  448.    ffestt_dimlist_kill(list);
  449.  
  450.    The tokens on the list are killed.  */
  451.  
  452. void
  453. ffestt_dimlist_kill (ffesttDimList list)
  454. {
  455.   ffesttDimList next;
  456.  
  457.   for (next = list->next; next != list; next = next->next)
  458.     {
  459.       ffelex_token_kill (next->t);
  460.     }
  461. }
  462.  
  463. /* ffestt_dimlist_type -- Determine type of list of dims
  464.  
  465.    ffesttDimList list;
  466.    ffestpDimtype type;
  467.    type = ffestt_dimlist_type(list);
  468.  
  469.    The dims in the list are dumped with commas separating them.     */
  470.  
  471. ffestpDimtype
  472. ffestt_dimlist_type (ffesttDimList list)
  473. {
  474.   ffesttDimList next;
  475.   ffestpDimtype type;
  476.  
  477.   if (list == NULL)
  478.     return FFESTP_dimtypeNONE;
  479.  
  480.   type = FFESTP_dimtypeKNOWN;
  481.   for (next = list->next; next != list; next = next->next)
  482.     {
  483.       if (next->lower != NULL)
  484.     {
  485.       if (ffebld_op (next->lower) != FFEBLD_opCONTER)
  486.         type = FFESTP_dimtypeADJUSTABLE;
  487.     }
  488.       if (next->upper != NULL)
  489.     {
  490.       if (ffebld_op (next->upper) == FFEBLD_opSTAR)
  491.         if (type == FFESTP_dimtypeKNOWN)
  492.           type = FFESTP_dimtypeASSUMED;
  493.         else
  494.           type = FFESTP_dimtypeADJUSTABLEASSUMED;
  495.       else if (ffebld_op (next->upper) != FFEBLD_opCONTER)
  496.         type = FFESTP_dimtypeADJUSTABLE;
  497.     }
  498.     }
  499.  
  500.   return type;
  501. }
  502.  
  503. /* ffestt_exprlist_append -- Append expr to list of exprs
  504.  
  505.    ffesttExprList list;
  506.    ffelexToken t;
  507.    ffestt_exprlist_append(list,expr,t);
  508.  
  509.    list must have already been created by ffestt_exprlist_create.  The
  510.    list is allocated out of the scratch pool.  The token is consumed.  */
  511.  
  512. void
  513. ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t)
  514. {
  515.   ffesttExprList new;
  516.  
  517.   new = (ffesttExprList) malloc_new_kp (ffesta_scratch_pool,
  518.                     "FFEST expr list", sizeof (*new));
  519.   new->next = list->previous->next;
  520.   new->previous = list->previous;
  521.   new->next->previous = new;
  522.   new->previous->next = new;
  523.   new->expr = expr;
  524.   new->t = t;
  525. }
  526.  
  527. /* ffestt_exprlist_create -- Create new list of exprs
  528.  
  529.    ffesttExprList list;
  530.    list = ffestt_exprlist_create();
  531.  
  532.    The list is allocated out of the scratch pool.  */
  533.  
  534. ffesttExprList
  535. ffestt_exprlist_create ()
  536. {
  537.   ffesttExprList new;
  538.  
  539.   new = (ffesttExprList) malloc_new_kp (ffesta_scratch_pool,
  540.                      "FFEST expr list root", sizeof (*new));
  541.   new->next = new->previous = new;
  542.   new->expr = NULL;
  543.   new->t = NULL;
  544.   return new;
  545. }
  546.  
  547. /* ffestt_exprlist_drive -- Drive list of token pairs into function
  548.  
  549.    ffesttExprList list;
  550.    void fn(ffebld expr,ffelexToken t);
  551.    ffestt_exprlist_drive(list,fn);
  552.  
  553.    The expr/token pairs in the list are passed to the function one pair
  554.    at a time.  */
  555.  
  556. void
  557. ffestt_exprlist_drive (ffesttExprList list, void (*fn) ())
  558. {
  559.   ffesttExprList next;
  560.  
  561.   if (list == NULL)
  562.     return;
  563.  
  564.   for (next = list->next; next != list; next = next->next)
  565.     {
  566.       (*fn) (next->expr, next->t);
  567.     }
  568. }
  569.  
  570. /* ffestt_exprlist_dump -- Dump list of exprs
  571.  
  572.    ffesttExprList list;
  573.    ffestt_exprlist_dump(list);
  574.  
  575.    The exprs in the list are dumped with commas separating them.  */
  576.  
  577. void
  578. ffestt_exprlist_dump (ffesttExprList list)
  579. {
  580.   ffesttExprList next;
  581.  
  582.   for (next = list->next; next != list; next = next->next)
  583.     {
  584.       if (next != list->next)
  585.     fputc (',', stdout);
  586.       ffebld_dump (next->expr);
  587.     }
  588. }
  589.  
  590. /* ffestt_exprlist_kill -- Kill list of exprs
  591.  
  592.    ffesttExprList list;
  593.    ffestt_exprlist_kill(list);
  594.  
  595.    The tokens on the list are killed.
  596.  
  597.    02-Mar-90  JCB  1.1
  598.       Don't kill the list itself or change it, since it will be trashed when
  599.       ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
  600.  
  601. void
  602. ffestt_exprlist_kill (ffesttExprList list)
  603. {
  604.   ffesttExprList next;
  605.  
  606.   for (next = list->next; next != list; next = next->next)
  607.     {
  608.       ffelex_token_kill (next->t);
  609.     }
  610. }
  611.  
  612. /* ffestt_formatlist_append -- Append null format to list of formats
  613.  
  614.    ffesttFormatList list, new;
  615.    new = ffestt_formatlist_append(list);
  616.  
  617.    list must have already been created by ffestt_formatlist_create.  The
  618.    new item is allocated out of the scratch pool.  The caller must initialize
  619.    it appropriately.  */
  620.  
  621. ffesttFormatList
  622. ffestt_formatlist_append (ffesttFormatList list)
  623. {
  624.   ffesttFormatList new;
  625.  
  626.   new = (ffesttFormatList) malloc_new_kp (ffesta_scratch_pool,
  627.                     "FFEST format list", sizeof (*new));
  628.   new->next = list->previous->next;
  629.   new->previous = list->previous;
  630.   new->next->previous = new;
  631.   new->previous->next = new;
  632.   return new;
  633. }
  634.  
  635. /* ffestt_formatlist_create -- Create new list of formats
  636.  
  637.    ffesttFormatList list;
  638.    list = ffestt_formatlist_create(NULL);
  639.  
  640.    The list is allocated out of the scratch pool.  */
  641.  
  642. ffesttFormatList
  643. ffestt_formatlist_create (ffesttFormatList parent, ffelexToken t)
  644. {
  645.   ffesttFormatList new;
  646.  
  647.   new = (ffesttFormatList) malloc_new_kp (ffesta_scratch_pool,
  648.                    "FFEST format list root", sizeof (*new));
  649.   new->next = new->previous = new;
  650.   new->type = FFESTP_formattypeNone;
  651.   new->t = t;
  652.   new->u.root.parent = parent;
  653.   return new;
  654. }
  655.  
  656. /* ffestt_formatlist_kill -- Kill tokens on list of formats
  657.  
  658.    ffesttFormatList list;
  659.    ffestt_formatlist_kill(list);
  660.  
  661.    The tokens on the list are killed.  */
  662.  
  663. void
  664. ffestt_formatlist_kill (ffesttFormatList list)
  665. {
  666.   ffesttFormatList next;
  667.  
  668.   /* Always kill from the very top on down. */
  669.  
  670.   while (list->u.root.parent != NULL)
  671.     list = list->u.root.parent->next;
  672.  
  673.   /* Kill first token for this list. */
  674.  
  675.   if (list->t != NULL)
  676.     ffelex_token_kill (list->t);
  677.  
  678.   /* Kill each item in this list. */
  679.  
  680.   for (next = list->next; next != list; next = next->next)
  681.     {
  682.       ffelex_token_kill (next->t);
  683.       switch (next->type)
  684.     {
  685.     case FFESTP_formattypeI:
  686.     case FFESTP_formattypeB:
  687.     case FFESTP_formattypeO:
  688.     case FFESTP_formattypeZ:
  689.     case FFESTP_formattypeF:
  690.     case FFESTP_formattypeE:
  691.     case FFESTP_formattypeEN:
  692.     case FFESTP_formattypeG:
  693.     case FFESTP_formattypeL:
  694.     case FFESTP_formattypeA:
  695.     case FFESTP_formattypeD:
  696.       if (next->u.R1005.R1004.t != NULL)
  697.         ffelex_token_kill (next->u.R1005.R1004.t);
  698.       if (next->u.R1005.R1006.t != NULL)
  699.         ffelex_token_kill (next->u.R1005.R1006.t);
  700.       if (next->u.R1005.R1007_or_R1008.t != NULL)
  701.         ffelex_token_kill (next->u.R1005.R1007_or_R1008.t);
  702.       if (next->u.R1005.R1009.t != NULL)
  703.         ffelex_token_kill (next->u.R1005.R1009.t);
  704.       break;
  705.  
  706.     case FFESTP_formattypeQ:
  707.     case FFESTP_formattypeDOLLAR:
  708.     case FFESTP_formattypeP:
  709.     case FFESTP_formattypeT:
  710.     case FFESTP_formattypeTL:
  711.     case FFESTP_formattypeTR:
  712.     case FFESTP_formattypeX:
  713.     case FFESTP_formattypeS:
  714.     case FFESTP_formattypeSP:
  715.     case FFESTP_formattypeSS:
  716.     case FFESTP_formattypeBN:
  717.     case FFESTP_formattypeBZ:
  718.     case FFESTP_formattypeSLASH:
  719.     case FFESTP_formattypeCOLON:
  720.       if (next->u.R1010.val.t != NULL)
  721.         ffelex_token_kill (next->u.R1010.val.t);
  722.       break;
  723.  
  724.     case FFESTP_formattypeR1016:
  725.       break;        /* Nothing more to do. */
  726.  
  727.     case FFESTP_formattypeFORMAT:
  728.       if (next->u.R1003D.R1004.t != NULL)
  729.         ffelex_token_kill (next->u.R1003D.R1004.t);
  730.       next->u.R1003D.format->u.root.parent = NULL;    /* Parent already dying. */
  731.       ffestt_formatlist_kill (next->u.R1003D.format);
  732.       break;
  733.  
  734.     default:
  735.       assert (FALSE);
  736.     }
  737.     }
  738. }
  739.  
  740. /* ffestt_implist_append -- Append token pair to list of token pairs
  741.  
  742.    ffesttImpList list;
  743.    ffelexToken t;
  744.    ffestt_implist_append(list,start_token,end_token);
  745.  
  746.    list must have already been created by ffestt_implist_create.  The
  747.    list is allocated out of the scratch pool.  The tokens are consumed.     */
  748.  
  749. void
  750. ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last)
  751. {
  752.   ffesttImpList new;
  753.  
  754.   new = (ffesttImpList) malloc_new_kp (ffesta_scratch_pool,
  755.                        "FFEST token list", sizeof (*new));
  756.   new->next = list->previous->next;
  757.   new->previous = list->previous;
  758.   new->next->previous = new;
  759.   new->previous->next = new;
  760.   new->first = first;
  761.   new->last = last;
  762. }
  763.  
  764. /* ffestt_implist_create -- Create new list of token pairs
  765.  
  766.    ffesttImpList list;
  767.    list = ffestt_implist_create();
  768.  
  769.    The list is allocated out of the scratch pool.  */
  770.  
  771. ffesttImpList
  772. ffestt_implist_create ()
  773. {
  774.   ffesttImpList new;
  775.  
  776.   new = (ffesttImpList) malloc_new_kp (ffesta_scratch_pool,
  777.                        "FFEST token list root",
  778.                        sizeof (*new));
  779.   new->next = new->previous = new;
  780.   new->first = NULL;
  781.   new->last = NULL;
  782.   return new;
  783. }
  784.  
  785. /* ffestt_implist_drive -- Drive list of token pairs into function
  786.  
  787.    ffesttImpList list;
  788.    void fn(ffelexToken first,ffelexToken last);
  789.    ffestt_implist_drive(list,fn);
  790.  
  791.    The token pairs in the list are passed to the function one pair at a time.  */
  792.  
  793. void
  794. ffestt_implist_drive (ffesttImpList list, void (*fn) ())
  795. {
  796.   ffesttImpList next;
  797.  
  798.   if (list == NULL)
  799.     return;
  800.  
  801.   for (next = list->next; next != list; next = next->next)
  802.     {
  803.       (*fn) (next->first, next->last);
  804.     }
  805. }
  806.  
  807. /* ffestt_implist_dump -- Dump list of token pairs
  808.  
  809.    ffesttImpList list;
  810.    ffestt_implist_dump(list);
  811.  
  812.    The token pairs in the list are dumped with commas separating them.    */
  813.  
  814. void
  815. ffestt_implist_dump (ffesttImpList list)
  816. {
  817.   ffesttImpList next;
  818.  
  819.   for (next = list->next; next != list; next = next->next)
  820.     {
  821.       if (next != list->next)
  822.     fputc (',', stdout);
  823.       assert (ffelex_token_type (next->first) == FFELEX_typeNAME);
  824.       fputs (ffelex_token_text (next->first), stdout);
  825.       if (next->last != NULL)
  826.     {
  827.       fputc ('-', stdout);
  828.       assert (ffelex_token_type (next->last) == FFELEX_typeNAME);
  829.       fputs (ffelex_token_text (next->last), stdout);
  830.     }
  831.     }
  832. }
  833.  
  834. /* ffestt_implist_kill -- Kill list of token pairs
  835.  
  836.    ffesttImpList list;
  837.    ffestt_implist_kill(list);
  838.  
  839.    The tokens on the list are killed.  */
  840.  
  841. void
  842. ffestt_implist_kill (ffesttImpList list)
  843. {
  844.   ffesttImpList next;
  845.  
  846.   for (next = list->next; next != list; next = next->next)
  847.     {
  848.       ffelex_token_kill (next->first);
  849.       if (next->last != NULL)
  850.     ffelex_token_kill (next->last);
  851.     }
  852. }
  853.  
  854. /* ffestt_tokenlist_append -- Append token to list of tokens
  855.  
  856.    ffesttTokenList tl;
  857.    ffelexToken t;
  858.    ffestt_tokenlist_append(tl,t);
  859.  
  860.    tl must have already been created by ffestt_tokenlist_create.  The
  861.    list is allocated out of the scratch pool.  The token is consumed.  */
  862.  
  863. void
  864. ffestt_tokenlist_append (ffesttTokenList tl, ffelexToken t)
  865. {
  866.   ffesttTokenItem ti;
  867.  
  868.   ti = (ffesttTokenItem) malloc_new_kp (ffesta_scratch_pool,
  869.                     "FFEST token item", sizeof (*ti));
  870.   ti->next = (ffesttTokenItem) &tl->first;
  871.   ti->previous = tl->last;
  872.   ti->next->previous = ti;
  873.   ti->previous->next = ti;
  874.   ti->t = t;
  875.   ++tl->count;
  876. }
  877.  
  878. /* ffestt_tokenlist_create -- Create new list of tokens
  879.  
  880.    ffesttTokenList tl;
  881.    tl = ffestt_tokenlist_create();
  882.  
  883.    The list is allocated out of the scratch pool.  */
  884.  
  885. ffesttTokenList
  886. ffestt_tokenlist_create ()
  887. {
  888.   ffesttTokenList tl;
  889.  
  890.   tl = (ffesttTokenList) malloc_new_kp (ffesta_scratch_pool,
  891.                     "FFEST token list", sizeof (*tl));
  892.   tl->first = tl->last = (ffesttTokenItem) &tl->first;
  893.   tl->count = 0;
  894.   return tl;
  895. }
  896.  
  897. /* ffestt_tokenlist_drive -- Dump list of tokens
  898.  
  899.    ffesttTokenList tl;
  900.    void fn(ffelexToken t);
  901.    ffestt_tokenlist_drive(tl,fn);
  902.  
  903.    The tokens in the list are passed to the given function.  */
  904.  
  905. void
  906. ffestt_tokenlist_drive (ffesttTokenList tl, void (*fn) ())
  907. {
  908.   ffesttTokenItem ti;
  909.  
  910.   if (tl == NULL)
  911.     return;
  912.  
  913.   for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
  914.     {
  915.       (*fn) (ti->t);
  916.     }
  917. }
  918.  
  919. /* ffestt_tokenlist_dump -- Dump list of tokens
  920.  
  921.    ffesttTokenList tl;
  922.    ffestt_tokenlist_dump(tl);
  923.  
  924.    The tokens in the list are dumped with commas separating them.  */
  925.  
  926. void
  927. ffestt_tokenlist_dump (ffesttTokenList tl)
  928. {
  929.   ffesttTokenItem ti;
  930.  
  931.   for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
  932.     {
  933.       if (ti != tl->first)
  934.     fputc (',', stdout);
  935.       switch (ffelex_token_type (ti->t))
  936.     {
  937.     case FFELEX_typeNUMBER:
  938.     case FFELEX_typeNAME:
  939.     case FFELEX_typeNAMES:
  940.       fputs (ffelex_token_text (ti->t), stdout);
  941.       break;
  942.  
  943.     case FFELEX_typeASTERISK:
  944.       fputc ('*', stdout);
  945.       break;
  946.  
  947.     default:
  948.       assert (FALSE);
  949.       fputc ('?', stdout);
  950.       break;
  951.     }
  952.     }
  953. }
  954.  
  955. /* ffestt_tokenlist_handle -- Handle list of tokens
  956.  
  957.    ffesttTokenList tl;
  958.    ffelexHandler handler;
  959.    handler = ffestt_tokenlist_handle(tl,handler);
  960.  
  961.    The tokens in the list are passed to the handler(s).     */
  962.  
  963. ffelexHandler
  964. ffestt_tokenlist_handle (ffesttTokenList tl, ffelexHandler handler)
  965. {
  966.   ffesttTokenItem ti;
  967.  
  968.   for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
  969.     handler = (ffelexHandler) (*handler) (ti->t);
  970.  
  971.   return (ffelexHandler) handler;
  972. }
  973.  
  974. /* ffestt_tokenlist_kill -- Kill list of tokens
  975.  
  976.    ffesttTokenList tl;
  977.    ffestt_tokenlist_kill(tl);
  978.  
  979.    The tokens on the list are killed.
  980.  
  981.    02-Mar-90  JCB  1.1
  982.       Don't kill the list itself or change it, since it will be trashed when
  983.       ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
  984.  
  985. void
  986. ffestt_tokenlist_kill (ffesttTokenList tl)
  987. {
  988.   ffesttTokenItem ti;
  989.  
  990.   for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
  991.     {
  992.       ffelex_token_kill (ti->t);
  993.     }
  994. }
  995.