+++ /dev/null
-/* stt.c -- Implementation File (module.c template V1.0)
- Copyright (C) 1995, 1997 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. */
-\f
-
-/* 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_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_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) (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 = (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) (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 = (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) (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);
- }
-}
projects / msp430-gcc.git / blobdiff