| /* 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. */ |
| |
| |
| /* 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); |
| } |
| } |