893 lines
22 KiB
C
893 lines
22 KiB
C
/* stt.c -- Implementation File (module.c template V1.0)
|
||
Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
|
||
Contributed by James Craig Burley.
|
||
|
||
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 = 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 (void)
|
||
{
|
||
ffesttCaseList new;
|
||
|
||
new = 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_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 = 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 (void)
|
||
{
|
||
ffesttDimList new;
|
||
|
||
new = 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_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 = 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 (void)
|
||
{
|
||
ffesttExprList new;
|
||
|
||
new = 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) (ffebld, ffelexToken))
|
||
{
|
||
ffesttExprList next;
|
||
|
||
if (list == NULL)
|
||
return;
|
||
|
||
for (next = list->next; next != list; next = next->next)
|
||
{
|
||
(*fn) (next->expr, next->t);
|
||
}
|
||
}
|
||
|
||
/* 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 = 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 = 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 = 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 (void)
|
||
{
|
||
ffesttImpList new;
|
||
|
||
new = 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) (ffelexToken, ffelexToken))
|
||
{
|
||
ffesttImpList next;
|
||
|
||
if (list == NULL)
|
||
return;
|
||
|
||
for (next = list->next; next != list; next = next->next)
|
||
{
|
||
(*fn) (next->first, next->last);
|
||
}
|
||
}
|
||
|
||
/* 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 = 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 (void)
|
||
{
|
||
ffesttTokenList tl;
|
||
|
||
tl = 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) (ffelexToken))
|
||
{
|
||
ffesttTokenItem ti;
|
||
|
||
if (tl == NULL)
|
||
return;
|
||
|
||
for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
|
||
{
|
||
(*fn) (ti->t);
|
||
}
|
||
}
|
||
|
||
/* 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);
|
||
}
|
||
}
|