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