1 /* $Id: symtab.h,v 1.43 2003/08/07 19:28:50 moniot Exp $ 2 3 Shared declarations for symbol-table routines. Note: uses 4 declarations in ftnchek.h. 5 6 Copyright (c) 1999 by Robert K. Moniot. 7 8 Permission is hereby granted, free of charge, to any person obtaining a 9 copy of this software and associated documentation files (the "Software"), 10 to deal in the Software without restriction, including without limitation 11 the rights to use, copy, modify, merge, publish, distribute, sublicense, 12 and/or sell copies of the Software, and to permit persons to whom the 13 Software is furnished to do so, subject to the following conditions: 14 15 The above copyright notice and this permission notice shall be included in 16 all copies or substantial portions of the Software. 17 18 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 19 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 21 ROBERT K. MONIOT OR FORDHAM UNIVERSITY BE LIABLE FOR ANY CLAIM, DAMAGES OR 22 OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 23 ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 24 OTHER DEALINGS IN THE SOFTWARE. 25 26 Except as contained in this notice, the name of ftnchek shall not be used 27 in advertising or otherwise to promote the sale, use or other dealings in 28 this Software without prior written authorization from the author. 29 30 31 */ 32 33 #define SYMTAB_H /* for intrins.h */ 34 35 #ifdef SYMTAB /* "home" for variables is symtab.c */ 36 #define SYM_SHARED 37 #else 38 #define SYM_SHARED extern 39 #endif 40 41 #ifdef DYNAMIC_TABLES 42 #ifdef __TURBOC__ /* Turbo C has only one free() */ 43 #define cfree free 44 #endif 45 #endif 46 47 /* Statement sequence info for fortran.y 48 and to give hints to forlex.c */ 49 #define SEQ_HEADER 1 50 #define SEQ_IMPLICIT 2 51 #define SEQ_SPECIF 3 52 #define SEQ_STMT_FUN 4 53 #define SEQ_EXEC 5 54 #define SEQ_END 6 55 56 /* Separate sequence defs to allow checking 57 f90 sequence requirements. */ 58 #define F90_SEQ_HEADER 1 59 #define F90_SEQ_USE 2 60 #define F90_SEQ_IMPLICIT_NONE 3 61 #define F90_SEQ_IMPLICIT 4 62 #define F90_SEQ_SPECIF 5 63 #define F90_SEQ_EXEC 6 64 #define F90_SEQ_CONTAINS 7 65 #define F90_SEQ_INTERNAL 8 66 #define F90_SEQ_END 9 67 68 /* Definitions of symbol table information */ 69 70 /* Token subclasses (classes are in tokdefs.h) 71 */ 72 73 #define relop_EQ 0 74 #define relop_NE 1 75 #define relop_LE 2 76 #define relop_LT 3 77 #define relop_GE 4 78 #define relop_GT 5 79 80 81 82 /* Storage Class types for variables, consts, and externals */ 83 #define class_VAR 0 84 #define class_SUBPROGRAM 1 85 #define class_COMMON_BLOCK 2 86 #define class_STMT_FUNCTION 3 87 #define class_LABEL 4 88 #define class_NAMELIST 5 89 90 91 /* Data types for variables, consts, and externals */ 92 /* N.B. 0 thru 7 are wired into lookup tables in exprtype.c */ 93 #define type_UNDECL 0 94 #define type_ERROR 0 /* for result of erroneous operation */ 95 #define type_INTEGER 1 96 #define type_REAL 2 97 #define type_DP 3 98 #define type_COMPLEX 4 99 #define type_DCOMPLEX 5 100 #define type_LOGICAL 6 101 #define type_STRING 7 102 #define type_HOLLERITH 8 103 #define type_GENERIC 9 104 #define type_SUBROUTINE 10 105 #define type_COMMON_BLOCK 11 106 #define type_PROGRAM 12 107 #define type_BLOCK_DATA 13 108 #define type_LABEL 14 109 #define type_NAMELIST 15 110 111 #define size_DEFAULT (0L) /* code for standard numeric sizes */ 112 #define size_ADJUSTABLE (-1L) /* codes for special char string lengths */ 113 #define size_UNKNOWN (-2L) 114 115 /* Defns for support of quad precision. It is 116 implemented as REAL*4n, not a genuine type of 117 its own, since no QUAD type declaration exists. 118 Here n = BpW or whatever wordsize is set at runtime. 119 */ 120 #define type_QUAD type_REAL 121 #define size_QUAD (4*type_size[type_REAL]) 122 #define type_CQUAD type_COMPLEX 123 #define size_CQUAD (8*type_size[type_REAL]) 124 125 /* test for types usable in exprs */ 126 #define is_computational_type(t) ((unsigned)(t) <= (unsigned)type_HOLLERITH) 127 /* test for numeric types */ 128 #define is_numeric_type(t) ((unsigned)(t) <= (unsigned)type_DCOMPLEX) 129 /* test for arith, char, or logical type */ 130 #define is_const_type(t) (((unsigned)(t)>(unsigned)0) && ((unsigned)(t)<=(unsigned)type_STRING)) 131 /* test for numeric or logical type */ 132 #define is_num_log_type(t) ((unsigned)(t) <= type_LOGICAL) 133 /* test for real/d.p./complex/d.complx type */ 134 #define is_float_type(t) ((unsigned)(t)>=type_REAL && (unsigned)(t)<=type_DCOMPLEX) 135 136 /* Type categories equate DoubleP to Real, Double Complex 137 to Complex, and Hollerith to Int to simplify expression 138 type propagation and argument checking. Computational 139 types only, except that since subroutine can be passed 140 as an argument, table goes up that high. */ 141 SYM_SHARED 142 unsigned char type_category[] 143 #ifdef SYMTAB 144 ={ type_UNDECL, 145 type_INTEGER, 146 type_REAL, 147 type_REAL, 148 type_COMPLEX, 149 type_COMPLEX, 150 type_LOGICAL, 151 type_STRING, 152 type_INTEGER, 153 type_GENERIC, 154 type_SUBROUTINE, 155 } 156 #endif 157 ; 158 /* Equivalence types equate Real, DoubleP, Complex and Double 159 Complex, for use in checking mixed equivalence and mixed 160 common, since it is standard and portable to interpret complex 161 as a pair of real values: real part and imag part */ 162 SYM_SHARED 163 unsigned char equiv_type[] 164 #ifdef SYMTAB 165 ={ type_UNDECL, 166 type_INTEGER, 167 type_REAL, 168 type_REAL, 169 type_REAL, 170 type_REAL, 171 type_LOGICAL, 172 type_STRING, 173 type_INTEGER} 174 #endif 175 ; 176 177 /* 178 * statement types referencing labels 179 */ 180 181 #define LAB_NO_TYPE 0 /* label never defined */ 182 #define LAB_SPECIFICATION 1 183 #define LAB_FORMAT 2 184 #define LAB_EXECUTABLE 3 185 #define LAB_GOTO 4 186 #define LAB_ASSIGN 5 187 #define LAB_DO 6 188 #define LAB_IO 7 189 #define LAB_CALL 8 190 SYM_SHARED 191 char *lab_type_name[] 192 #ifdef SYMTAB 193 = { 194 "undef", 195 "specif", 196 "format", 197 "exec", 198 "goto", 199 "assign", 200 "do", 201 "I/O", 202 "arg", 203 } 204 #endif 205 ; 206 207 typedef unsigned char BYTE; 208 209 /* Array of class and type name translations */ 210 SYM_SHARED 211 char *class_name[] 212 #ifdef SYMTAB 213 = { 214 "", 215 "subprog", 216 "common", 217 "stmt fun", 218 "label", 219 "namelist", 220 } 221 #endif 222 ; 223 SYM_SHARED 224 char *type_name[] /* Type names as used in warnings etc. */ 225 #ifdef SYMTAB 226 = { 227 "undf", 228 "intg", 229 "real", 230 "dble", 231 "cplx", 232 "dcpx", 233 "logl", 234 "char", 235 "holl", 236 "genr", 237 "subr", 238 "comm", 239 "prog", 240 "data", 241 "labl", 242 "naml", 243 } 244 #endif 245 ; 246 247 SYM_SHARED 248 char *type_table[] /* Names as used in FORTRAN statements */ 249 #ifdef SYMTAB 250 = { 251 "??ERROR??", 252 "INTEGER", 253 "REAL", 254 "DOUBLE PRECISION", 255 "COMPLEX", 256 "DOUBLE COMPLEX", /* could be "COMPLEX*16" too */ 257 "LOGICAL", 258 "CHARACTER", 259 /* The rest do not appear in actual use, here for completeness only */ 260 "HOLLERITH", 261 "GENERIC", 262 "SUBROUTINE", 263 "COMMON", 264 "PROGRAM", 265 "BLOCK DATA", 266 "LABEL", 267 "NAMELIST", 268 } 269 #endif 270 ; 271 272 273 /* Here declare typical sizes of objects of each data type, for use in 274 checking argument and common block size matchups. BpW (bytes per word) 275 is defined in ftnchek.h */ 276 277 278 SYM_SHARED 279 BYTE type_size[] 280 #ifdef SYMTAB 281 ={ 282 0, /*undf*/ 283 BpW, /*intg*/ 284 BpW, /*real*/ 285 2*BpW, /*dble*/ 286 2*BpW, /*cplx*/ 287 4*BpW, /*dcpx*/ 288 BpW, /*logl*/ 289 1, /*char*/ 290 BpW, /*holl*/ 291 0, /*genr*/ 292 0, /*subr*/ 293 0, /*comm*/ 294 0, /*prog*/ 295 0, /*data*/ 296 0, /*labl*/ 297 0, /*naml*/ 298 } 299 #endif 300 ; 301 302 303 304 /* implicit and default typing lookup table. Two extra spots 305 provided to accommodate '$' and '_' too. The size defns 306 should accommodate EBCDIC as well as ASCII. */ 307 SYM_SHARED 308 int implicit_type[('Z'-'A'+1)+2], /* indexed by [char - 'A'] */ 309 implicit_size[('Z'-'A'+1)+2]; 310 SYM_SHARED 311 char *implicit_len_text[('Z'-'A'+1)+2]; 312 313 314 /* Declaration of Token data structure. N.B. do not change without 315 consulting preamble of fortran.y for uses with nonterminals. 316 */ 317 318 /* temporary equivs for future separate fields */ 319 /* these are for array-bounds tokens */ 320 #define TOK_dims tclass 321 #define TOK_elts tsubclass 322 323 #define TOK_start tclass 324 #define TOK_end tsubclass 325 326 327 struct tokstruct { 328 union { 329 long integer; 330 DBLVAL dbl; 331 char *string; 332 } value; /* Value of constant */ 333 struct tokstruct 334 *left_token, /* Left child in expr tree */ 335 *next_token; /* Right child or next in linked list */ 336 char *src_text; /* Original text string of token */ 337 long tclass,tsubclass; /* Token category and subcategory */ 338 long size; /* sizeof(datatype) */ 339 long TOK_type; /* Storage class & data type of identifier */ 340 unsigned TOK_flags:32; /* Exprtype flags (see defns below) */ 341 LINENO_t line_num; /* Line where token occurred */ 342 COLNO_t col_num; /* Column where token occurred */ 343 unsigned size_is_adjustable : 1; 344 unsigned size_is_expression : 1; 345 }; 346 347 typedef struct tokstruct Token; 348 349 #ifdef YYSTYPE 350 #undef YYSTYPE 351 #endif 352 #define YYSTYPE Token /* Type defn for yylval and Yacc stack */ 353 354 355 356 SYM_SHARED 357 long loc_symtab_top, /* Next avail spot in local symbol table */ 358 glob_symtab_top; /* Ditto global */ 359 360 SYM_SHARED 361 unsigned long loc_str_top; /* Top of local stringspace */ 362 363 SYM_SHARED 364 unsigned long srctextspace_top; /* Top of token src text space */ 365 366 SYM_SHARED 367 unsigned long ptrspace_top; /* Top of pointer space */ 368 369 SYM_SHARED 370 unsigned long param_info_space_top; /* Top of parameter info space */ 371 372 SYM_SHARED 373 unsigned long token_space_top, /* Top of token space */ 374 token_head_space_top; /* Top of TL_head space */ 375 376 /* Counts of extra items dynamically allocated, for -resource */ 377 SYM_SHARED 378 int extra_locstrspace, 379 extra_paraminfospace, 380 extra_srctextspace, 381 extra_tokheadspace, 382 extra_tokspace, 383 extra_ptrspace; 384 385 SYM_SHARED 386 LINENO_t top_file_line_num; 387 388 SYM_SHARED 389 int global_save; /* module contains SAVE with no list */ 390 391 /* Define names for anonymous things */ 392 #ifdef SYMTAB 393 char blank_com_name[] = "%BLANK", /* id for blank common entry in symtab */ 394 unnamed_prog[]="%MAIN", /* id for unnamed program module */ 395 unnamed_block_data[]="%DAT00"; /* id for unnamed block data module */ 396 int block_data_number=0; /* count of multiple anonymous block data */ 397 #else 398 extern char blank_com_name[], 399 unnamed_prog[], 400 unnamed_block_data[]; 401 extern int block_data_number; 402 #endif 403 404 typedef int LABEL_t; /* a label (0-99999) */ 405 406 #define NO_LABEL ((LABEL_t)-1) /* label never used/defined */ 407 408 /* Symbol table argument list declarations */ 409 410 typedef union { /* InfoUnion: misc info about symtab entry */ 411 unsigned long array_dim; /* array size and no. of dims */ 412 struct ALHead *arglist; /* ptr to func/subr argument list */ 413 struct CMHead *comlist; /* ptr to common block list */ 414 struct TLHead *toklist; /* ptr to token list */ 415 struct IInfo *intrins_info;/* ptr to intrinsic func info */ 416 struct PInfo *param; /* parameter information field */ 417 } InfoUnion; 418 419 typedef struct { /* ArgListElement: holds subprog argument data */ 420 char *name; /* name of dummy arg or text of actual arg */ 421 InfoUnion info; 422 struct gSymtEntry *common_block; /* block it belongs to if any */ 423 long common_index; /* index in block */ 424 long size; 425 BYTE type; 426 short same_as; /* index if two actual arguments the same */ 427 unsigned is_lvalue: 1, 428 set_flag: 1, 429 assigned_flag: 1, 430 used_before_set: 1, 431 array_var: 1, 432 array_element: 1, 433 declared_external: 1, 434 active_do_var: 1; 435 } ArgListElement; 436 437 438 typedef struct ALHead { /* ArgListHeader: head node of argument list */ 439 long size; 440 BYTE type; 441 short numargs; 442 ArgListElement *arg_array; 443 struct gSymtEntry *module; 444 char *filename,*topfile; 445 LINENO_t line_num,top_line_num; 446 unsigned 447 is_defn: 1, 448 is_call: 1, 449 external_decl: 1, /* EXTERNAL decl, not arg list */ 450 actual_arg: 1; /* subprog passed as arg */ 451 struct ALHead *next; 452 } ArgListHeader; 453 454 /* Symbol table common block list declarations */ 455 456 typedef struct { /* ComListElement: holds common var data */ 457 char *name; /* name of common variable */ 458 unsigned long dimen_info; 459 long size; 460 BYTE type; 461 unsigned /* copies of flags from symtab */ 462 used:1, 463 set:1, 464 used_before_set:1, 465 assigned:1, 466 marked:1; /* for listing of offenders */ 467 } ComListElement; 468 469 typedef struct CMHead { /* ComListHeader: head node of common var list */ 470 short numargs; 471 LINENO_t line_num,top_line_num; 472 ComListElement *com_list_array; 473 struct gSymtEntry *module; 474 char *filename,*topfile; 475 struct CMHead *next; 476 unsigned 477 any_used:1, /* any of its variables accessed */ 478 any_set:1, /* any of its variables set */ 479 saved:1; /* declared in SAVE statement */ 480 } ComListHeader; 481 482 483 typedef struct TLHead { /* TokenListHeader: head node of token list */ 484 Token *tokenlist; 485 struct TLHead *next; 486 char *filename; 487 LINENO_t line_num, top_line_num; 488 unsigned 489 external_decl:1, 490 actual_arg:1; 491 } TokenListHeader; 492 493 494 /* Structure for intrinsic-function info */ 495 496 /* Define special num_args values for intrinsics that have 497 variable numbers of arguments. */ 498 #define I_1or2 (-1) /* 1 or 2 arguments */ 499 #define I_2up (-2) /* 2 or more arguments */ 500 #define I_0or1 (-3) /* 0 or 1 argument */ 501 502 /* for intrins_flags field */ 503 504 /* Integer-valued intrinsics that are evaluated if args const */ 505 #define I_ABS 0x1 506 #define I_SIGN 0x2 507 #define I_DIM 0x3 508 #define I_MOD 0x4 509 #define I_MAX 0x5 510 #define I_MIN 0x6 511 #define I_ICHAR 0x7 512 #define I_LEN 0x8 513 #define I_INDEX 0x9 514 #define I_EVALUATED 0xf /* any bit of digit set */ 515 516 /* Various properties of intrinsics*/ 517 #define I_F77 0x00 /* Standard intrinsic (no flag: placeholder) */ 518 #define I_NONF77 0x10 /* Nonstandard */ 519 #define I_MIXED_ARGS 0x20 /* Has mixed arg types */ 520 #define I_NONPURE 0x40 /* Arg need not be set when called */ 521 #define I_C_TO_R 0x80 /* Complex -> real in generic form */ 522 #define I_NOTARG 0x100 /* Not allowed as actual argument */ 523 #define I_SP_R 0x200 /* special for REAL function */ 524 #define I_CHAR 0x400 /* special handling for CHAR function */ 525 #define I_QARG 0x800 /* Arg type is R*16 or X*32 */ 526 #define I_QUAD 0x1000 /* Result type is R*16 or X*32 */ 527 #define I_EXTRA 0x2000 /* commonly found extra intrinsics */ 528 #define I_VMS 0x4000 /* VMS systems only */ 529 #define I_UNIX 0x8000 /* Unix systems only */ 530 #define I_NONF90 0x10000 /* Not in F90 standard */ 531 532 /* Define flag type big enough for 17 bits */ 533 #if (SIZEOF_SHORT > 2) 534 typedef unsigned short intrins_flags_t; 535 #else 536 #if (SIZEOF_INT > 2) 537 typedef unsigned int intrins_flags_t; 538 #else 539 #if (SIZEOF_LONG > 2) 540 typedef unsigned long intrins_flags_t; 541 #endif 542 #endif 543 #endif 544 typedef struct IInfo{ 545 char *name; 546 short num_args, 547 arg_type, 548 result_type; 549 intrins_flags_t 550 intrins_flags; /* nonstandard, mixed arg types */ 551 } IntrinsInfo; 552 553 /* Structure for parameter info */ 554 typedef struct PInfo{ 555 char *src_text; /* source text of parameter value */ 556 union { 557 long integer; /* integer value */ 558 DBLVAL dbl; /* float value */ 559 char *string; /* character string value */ 560 } value; 561 int seq_num; /* position in parameter definitions */ 562 } ParamInfo; 563 564 565 /* Structure for call-tree child list */ 566 typedef struct childlist { 567 struct gSymtEntry *child; /* Pointer to child's symtab entry */ 568 struct childlist *next;/* Pointer to next child on list */ 569 } ChildList; 570 571 /* Identifier symbol table declaration */ 572 573 574 typedef struct lSymtEntry{ 575 char *name; /* Identifier name in stringspace */ 576 InfoUnion info; 577 union{ 578 char *text; /* Source text string */ 579 char **textvec; /* List of source text strings */ 580 TokenListHeader *toklist; /* for namelist & common block makedecls */ 581 } src; 582 struct lSymtEntry *equiv_link; /* Link for equivalence lists */ 583 /* common_block is a ptr to block if this is a common 584 variable, and common_index is its position (starting 585 from 1). For block, common_index is the count of 586 variables in it. */ 587 struct gSymtEntry *common_block; 588 long common_index; 589 long size; /* Size of object in bytes */ 590 /* Object can be referenced in an include file. Next fields 591 are line numbers within file where object is referred 592 to, then come indexes into include-file list. */ 593 LINENO_t line_declared, line_set, line_used; 594 short file_declared, file_set, file_used; 595 BYTE type; /* Type & storage class: see macros below */ 596 /* Flags */ 597 unsigned 598 used_flag: 1, /* value is accessed (read from variable) */ 599 set_flag: 1, /* variable is set or passed as subr arg */ 600 assigned_flag: 1, /* value is really set (by assignment stmt) */ 601 used_before_set: 1,/* set_flag is not set when used_flag is set */ 602 is_current_module: 1, /* this symtab entry is the main module */ 603 library_module: 1, /* module was processed in -library mode */ 604 active_do_var: 1, /* variable is an active DO index */ 605 array_var: 1, /* variable is dimensioned */ 606 common_var: 1, /* variable is in common */ 607 entry_point: 1, /* name of an entry point */ 608 parameter: 1, /* name of a parameter */ 609 argument: 1, /* dummy argument */ 610 external: 1, /* function or subr called by this routine */ 611 intrinsic: 1, /* intrinsic function */ 612 saved: 1, /* named in SAVE statement */ 613 allocatable: 1, /* has ALLOCATABLE attribute */ 614 pointer: 1, /* has POINTER attribute */ 615 target: 1, /* has TARGET attribute */ 616 invoked_as_func: 1, /* usage as f(x) was seen */ 617 defined_in_include: 1, /* to suppress some warnings if unused */ 618 declared_external: 1, /* explicitly declared external */ 619 declared_intrinsic: 1; /* explicitly declared intrinsic */ 620 unsigned size_is_adjustable : 1; /* CHARACTER*(*) declaration */ 621 unsigned size_is_expression : 1; /* CHARACTER*(expr) declaration */ 622 } Lsymtab; 623 624 typedef struct gSymtEntry{ /* Global symbol table element */ 625 char *name; /* Identifier name in stringspace */ 626 InfoUnion info; 627 union { 628 struct childlist *child_list; /* List of callees (for module) */ 629 struct gSymtEntry *module; /* Module (for interior entry) */ 630 } link; 631 long size; 632 BYTE type; /* Type & storage class: see macros below */ 633 /* Flags. See remarks above */ 634 unsigned 635 used_flag: 1, 636 set_flag: 1, 637 assigned_flag: 1, 638 recursive: 1, 639 library_module: 1, 640 internal_entry: 1, /* entry point other than at the top */ 641 invoked_as_func: 1, 642 visited: 1, /* this entry point is in call tree */ 643 visited_somewhere: 1, /* some entry point of module is in call tree */ 644 defined: 1, /* is defined somewhere */ 645 defined_in_include: 1, 646 declared_external: 1, 647 /* The following flags are for project-file use. 648 They get reset when a file is opened and accumulate 649 values as file is read. */ 650 used_this_file: 1, 651 set_this_file: 1, 652 invoked_as_func_this_file: 1, 653 declared_external_this_file: 1; 654 } Gsymtab; 655 656 657 /* Identifier hashtable declaration */ 658 659 typedef struct hashEntry { 660 char *name; /* Identifier name in stringspace */ 661 Lsymtab *loc_symtab, /* Local symtab entry for vars etc. */ 662 *com_loc_symtab;/* Local symtab entry for common blocks */ 663 Gsymtab *glob_symtab, /* Global symtab entry for vars etc. */ 664 *com_glob_symtab;/* Global symtab entry for common blocks */ 665 } HashTable; 666 667 SYM_SHARED 668 int current_module_hash /* hashtable index of current module name */ 669 #ifdef SYMTAB 670 = -1 671 #endif 672 ; 673 674 /* Symbolic names for I/O access modes */ 675 typedef enum { 676 IO_ACCESS_DEFAULT, IO_ACCESS_DIRECT, IO_ACCESS_SEQUENTIAL 677 } IO_ACCESS_TYPE; 678 679 /* Symbolic names for I/O forms */ 680 typedef enum { 681 IO_FORM_DEFAULT, IO_FORM_UNFORMATTED, IO_FORM_FORMATTED 682 } IO_FORM_TYPE; 683 684 #define IO_UNIT_UNKNOWN -1 685 #define IO_UNIT_DEFAULT -2 /* For unit=* */ 686 /* Struct for I/O unit usage */ 687 typedef struct { 688 int line_num; /* location of I/O usage */ 689 int unit_no; /* unit number if known, else UNKNOWN */ 690 int unit_id; /* hash num of unit if variable, else UNKNOWN or DEFAULT */ 691 IO_ACCESS_TYPE io_access; /* access mode of file */ 692 IO_FORM_TYPE io_form; /* form specified for file */ 693 int io_operation; /* input, output, open, close, etc. */ 694 } IO_Unit_Info; 695 696 SYM_SHARED 697 IO_Unit_Info* io_unit_info /* Array of I/O usage instances */ 698 #ifdef SYMTAB 699 = (IO_Unit_Info*)NULL 700 #endif 701 ; 702 703 SYM_SHARED 704 int max_io_unit_usages /* current size of I/O usage array */ 705 #ifdef SYMTAB 706 = 0 707 #endif 708 ; 709 710 SYM_SHARED 711 int num_io_unit_usages /* number of I/O usage instances in list */ 712 #ifdef SYMTAB 713 = 0 714 #endif 715 ; 716 /* Struct for include-file list */ 717 typedef struct { 718 char *fname; /* name of include file */ 719 LINENO_t line; /* line of topfile where included */ 720 short footnote; /* footnote number--for printing 721 labels */ 722 } IncFile; 723 724 SYM_SHARED 725 IncFile* incfile_list 726 #ifdef SYMTAB 727 = (IncFile*)NULL 728 #endif 729 ; 730 731 SYM_SHARED 732 int num_incfiles /* number of include-files in list */ 733 #ifdef SYMTAB 734 = 0 735 #endif 736 ; 737 738 SYM_SHARED 739 short inctable_index; /* index of current include-file in list */ 740 741 /* Struct for chunks of string space */ 742 typedef struct STSpace { 743 struct STSpace *next; 744 char strspace[STRSPACESZ]; 745 } StrSpace; 746 747 /* Struct for providing chunks of space 748 for parameter info. */ 749 typedef struct PISpace { 750 struct PISpace *next; 751 ParamInfo paraminfospace[PARAMINFOSPACESZ]; 752 } ParamInfoSpace; 753 754 /* Struct for providing chunks of space 755 for token list headers for arg lists etc. */ 756 typedef struct THSpace { 757 struct THSpace *next; 758 TokenListHeader tokheadspace[TOKHEADSPACESZ]; 759 } TokHeadSpace; 760 761 762 /* Struct for providing chunks of space 763 for tokens for arg lists etc. */ 764 typedef struct TSpace { 765 struct TSpace *next; 766 Token tokenspace[TOKENSPACESZ]; 767 } TokenSpace; 768 769 /* Struct for providing chunks of space 770 for pointers to array & param text */ 771 typedef struct PSpace { 772 struct PSpace *next; 773 char * ptrspace[PTRSPACESZ]; 774 } PtrSpace; 775 776 777 /* Macro to zero out symbol table entry */ 778 779 #define clear_symtab_entry(S) {register unsigned i;\ 780 for(i=0;i<sizeof(*S);i++)((char*)S)[i]=0;} 781 782 783 /* These macros pack and unpack datatype and storage class in type 784 field of symbol table entry. Datatype is least 4 bits. */ 785 786 #define datatype_of(TYPE) ((unsigned)((TYPE) & 0xF)) 787 #define storage_class_of(TYPE) ((unsigned)((TYPE) >> 4)) 788 #define type_byte(SCLASS,DTYPE) ((unsigned)(((SCLASS)<<4) + (DTYPE))) 789 790 791 /* This macro is for pattern matching in flag checking */ 792 793 #define flag_combo(A,B,C) (((A)<<2) | ((B)<<1) | (C)) 794 795 796 /* These macros are for dimensions & sizes of arrays */ 797 798 #define array_dims(dim_info) ((dim_info)&0xF) 799 #define array_size(dim_info) ((dim_info)>>4) 800 #define array_dim_info(dim,size) (((long)(size)<<4)+(dim)) 801 802 803 804 /* Defns used by expression type propagation mechanisms 805 in fortran.y and exprtype.c The flags go in token.TOK_flags 806 Make sure size of TOK_flags declared above suffices for 807 largest item in the list below. 808 */ 809 810 #define make_true(flag,x) ((x) |= ((unsigned)flag)) /* x.flag <-- true */ 811 #define make_false(flag,x) ((x) &= ~((unsigned)flag)) /* x.flag <-- false */ 812 #define is_true(flag,x) ((x) & (flag)) /* x.flag == true? */ 813 #define copy_flag(flag,x,y) ((x) |= ((y)&((unsigned)flag))) /* x.flag <-- y.flag */ 814 815 #define ID_EXPR 0x1 /* a variable */ 816 #define LVALUE_EXPR 0x2 /* assignable */ 817 #define CONST_EXPR 0x4 /* compile-time constant per std 6.7*/ 818 #define LIT_CONST 0x8 /* a number or string literal */ 819 #define ARRAY_ID_EXPR 0x10 /* an array or array element */ 820 #define ARRAY_ELEMENT_EXPR 0x20 /* an array element */ 821 #define INT_QUOTIENT_EXPR 0x40 /* contains INT/INT */ 822 #define STMT_FUNCTION_EXPR 0x80 823 #define PARAMETER_EXPR 0x100/* == CONST_EXPR || intrinsic || **real */ 824 #define EVALUATED_EXPR 0x200 /* token.value has value of expr */ 825 #define SET_FLAG 0x400 /* id may be set */ 826 #define ASSIGNED_FLAG 0x800 /* id is set in assignment stmt */ 827 #define USED_BEFORE_SET 0x1000 /* id used beforre set */ 828 #define COMPLEX_FLAG 0x2000 /* remembers complex_const_allowed */ 829 #define CHAR_ID_EXPR 0x4000 /* char var or array elt not substr */ 830 #define DIM_BOUND_EXPR 0x8000 /* no array or func ref (5.1.1.1) */ 831 #define IN_ASSIGN 0x10000 /* for tracking assgn stmt lhs */ 832 #define COMMA_FLAG 0x20000/* keeps track of extra or missing 833 commas in exprlists (obsolete) */ 834 #define NONSTD_USAGE_FLAG 0x40000 /* concentrator for -f77 warnings */ 835 #define NOT_DO_TERMINAL_STMT 0x80000 /* stmt illegal as end of DO loop */ 836 #define DO_VARIABLE 0x100000 /* id is active DO index variable */ 837 #define SYNTAX_ERROR_FLAG 0x200000/* concentrator for syntax errors */ 838 839 #ifdef DYNAMIC_TABLES /* tables will be mallocked at runtime */ 840 SYM_SHARED 841 Lsymtab *loc_symtab 842 #ifdef SYMTAB 843 =(Lsymtab *)NULL 844 #endif 845 ; 846 SYM_SHARED 847 Gsymtab *glob_symtab 848 #ifdef SYMTAB 849 =(Gsymtab *)NULL 850 #endif 851 ; 852 SYM_SHARED 853 HashTable *hashtab 854 #ifdef SYMTAB 855 =(HashTable *)NULL 856 #endif 857 ; 858 859 #else /* static tables declared at compile time */ 860 /* Each major table is housed in a separate file so that 861 on IBM PC architecture with huge memory model 862 each will be in its own 64K segment not all in one. */ 863 #ifndef PLSYMTAB 864 extern 865 #endif 866 Lsymtab loc_symtab[LOCSYMTABSZ]; /* Local identifiers */ 867 #ifndef PGSYMTAB 868 extern 869 #endif 870 Gsymtab glob_symtab[GLOBSYMTABSZ]; /* Global identifiers: subrs and com blks */ 871 #ifndef EXPRTYPE 872 extern 873 #endif 874 HashTable hashtab[HASHSZ]; /* Hash table for identifier lookup */ 875 876 #endif/* end static tables */ 877 878 /* The following tables start life as statically declared 879 tables, but when add'l space is needed, new structs of same 880 kind will be allocated and linked via next field of struct. 881 Because they are dynamically extended, they are not in 882 the DYNAMIC_TABLES section or its complement above. Note 883 that as global variables they start off at 0, so next field 884 of each is implicitly initialized to NULL. */ 885 886 #ifndef FORLEX 887 extern 888 #endif 889 TokenSpace tokspace; /* Tokens for arg lists etc */ 890 891 #ifndef PROJECT 892 extern 893 #endif 894 TokHeadSpace tokheadspace;/* Tokenlist headers */ 895 896 #ifndef PROJECT 897 extern 898 #endif 899 ParamInfoSpace paraminfospace;/* Parameter info structs */ 900 901 #ifndef PROJECT 902 extern 903 #endif 904 PtrSpace ptrspace; /* Space for storing arrays of pointers */ 905 906 #ifndef SYMTAB 907 extern 908 #endif 909 StrSpace lstrspace; /* String space for local identifiers */ 910 911 #ifndef SYMTAB 912 extern 913 #endif 914 StrSpace srctextspace;/* String space for token source text */ 915 916 917 /* Shared routines */ 918 919 920 /* in exprtype.c */ 921 PROTO(void assignment_stmt_type,( Token *term1, Token *equals, Token *term2 )); 922 PROTO(void binexpr_type,( Token *term1, Token *op, Token *term2, Token 923 *result )); 924 PROTO(void check_initializer_type, ( Token *assignee_list, Token *equals, Token *expr_list)); 925 PROTO(void func_ref_expr,( Token *id, Token *args, Token *result )); 926 PROTO(void primary_id_expr,( Token *id, Token *primary )); 927 PROTO(void stmt_fun_arg_cmp,( const Lsymtab *symt, const Token *d_arg, const Token *a_arg )); 928 PROTO(int substring_size,( Token *id, Token *limits )); 929 PROTO(void unexpr_type,( Token *term1, Token *op, Token *result )); 930 PROTO(int intrins_arg_cmp,( IntrinsInfo *defn, Token *t)); 931 932 /* in advance.c */ 933 PROTO(int see_double_colon,( void )); 934 PROTO(void mark_module_srcline,( LINENO_t line_num )); 935 936 /* in forlex.c */ 937 PROTO(void implied_id_token,( Token *t, char *s )); 938 PROTO(int yylex,( void )); 939 940 /* in keywords.c */ 941 PROTO(char *keytok_name,(int tclass)); 942 943 /* in fortran.y/fortran.c */ 944 PROTO(void check_seq_header,( Token *t )); 945 946 /* in prlocsym.c */ 947 PROTO(void print_loc_symbols,( void )); 948 949 /* in makehtml.c */ 950 PROTO(void make_html,(Lsymtab **sym_list, char *mod_name, Lsymtab *module )); 951 952 /* in makedcls.c */ 953 PROTO(void make_declarations,( Lsymtab *sym_list[], char *mod_name )); 954 955 /* in symtab.c */ 956 PROTO(void apply_attr,( Token *id, int attr )); 957 PROTO(void call_func,( Token *id, Token *arg )); 958 PROTO(void call_subr,( Token *id, Token *arg )); 959 PROTO(char * char_expr_value,( Token *t )); 960 PROTO(void check_loose_ends,( int curmodhash )); 961 PROTO(void declare_type,( Token *id, int datatype, long size, char *size_text )); 962 PROTO(void def_arg_name,( Token *id )); 963 PROTO(void def_array_dim,( Token *id, Token *arg )); 964 PROTO(void def_com_block,( Token *id, Token *comlist )); 965 PROTO(void def_com_variable,( Token *id )); 966 PROTO(int def_curr_module,( Token *id )); 967 PROTO(void def_do_variable,( Token *id )); 968 PROTO(void def_equiv_name,( Token *id )); 969 PROTO(void def_ext_name,( Token *id )); 970 PROTO(void def_function,( int datatype, long size, char *size_text, Token 971 *id, Token *args )); 972 PROTO(void def_intrins_name,( Token *id )); 973 PROTO(void def_namelist,( Token *id, Token *list )); 974 PROTO(void def_namelist_item,( Token *id )); 975 PROTO(void def_parameter,( Token *id, Token *val, int noparen )); 976 PROTO(void def_stmt_function,( Token *id, Token *args )); 977 PROTO(void do_ASSIGN,( Token *id )); 978 PROTO(void do_assigned_GOTO,( Token *id )); 979 PROTO(void do_ENTRY,( Token *id, Token *args, int hashno )); 980 PROTO(int do_RETURN,( int hashno, Token *keyword )); 981 PROTO(void equivalence,( Token *id1, Token *id2 )); 982 PROTO(DBLVAL float_expr_value,( Token *t )); 983 PROTO(int get_size,( const Lsymtab *symt, int type )); 984 PROTO(char * get_size_text,( const Lsymtab *symt, int type )); 985 PROTO(int get_type,( const Lsymtab *symt )); 986 PROTO(unsigned hash_lookup,( char *s )); 987 PROTO(Gsymtab* install_global,( int h, int datatype, int storage_class )); 988 PROTO(int int_expr_value,( Token *t )); 989 PROTO(char * new_global_string,( char *s )); 990 PROTO(void free_textvec,( char **p )); 991 PROTO(char * new_src_text,( const char *s, int len )); 992 PROTO(char * new_src_text_alloc,( int size )); 993 PROTO(char * new_tree_text,( Token *t )); 994 PROTO(char ** new_textvec,( int n )); 995 PROTO(Token * new_token,( void )); 996 PROTO(void msg_expr_tree, (const Token *t)); 997 #ifdef DEBUG_EXPRTREES 998 PROTO(void print_src_text,( Token *t )); 999 PROTO(void print_expr_tree,( Token *t )); 1000 PROTO(void print_expr_list,( Token *t )); 1001 #endif 1002 PROTO(void process_lists,( int curmodhash )); 1003 PROTO(void record_io_unit_id, (Token *id)); 1004 PROTO(void record_io_usage, (Token *stmt)); 1005 PROTO(void ref_array,( Token *id, Token *subscrs )); 1006 PROTO(void ref_namelist,( Token *id, int stmt_class )); 1007 PROTO(void ref_identifier,( Token *id )); 1008 PROTO(void ref_variable,( Token *id )); 1009 PROTO(void save_com_block,( Token *id )); 1010 PROTO(void set_implicit_type,( int type, long size, char *len_text, int c1, int c2 )); 1011 PROTO(void stmt_function_stmt,( Token *id )); 1012 PROTO(char * token_name,( Token *t )); 1013 PROTO(void undef_do_variable,( int h )); 1014 PROTO(void use_actual_arg,( Token *id )); 1015 PROTO(void use_implied_do_index,( Token *id )); 1016 PROTO(void use_io_keyword,( Token *keyword, Token *value, int stmt_class )); 1017 PROTO(void use_special_open_keywd,( Token *id )); 1018 PROTO(void use_lvalue,( Token *id )); 1019 PROTO(void use_parameter,( Token *id )); 1020 PROTO(void use_variable,( Token *id )); 1021 1022 PROTO(char* typespec, ( int t, int has_size, long size, 1023 int has_len, long len)); 1024 /* The following size is conservative, 1025 to make sure no buffer overruns occur. 1026 */ 1027 /* Maximum length of a typespec() result. */ 1028 #define MAX_TYPESPEC (4+4+6*sizeof(long)) 1029 1030 /* in symtab.c (formerly hash.c) */ 1031 PROTO(unsigned long hash,( const char *s )); 1032 PROTO(unsigned long rehash,( unsigned long hnum )); 1033 1034 1035 /* To stop printing errors after limit is reached, 1036 unless limit is 0. Increment error count 1037 even if don't print. 1038 */ 1039 #define CASCADE_LIMIT(ERROR_COUNT) (++(ERROR_COUNT) > error_cascade_limit \ 1040 && error_cascade_limit > 0) 1041 1042 1043 /* prototypes of label routines */ 1044 void init_labtable(void); 1045 void print_labels(void); 1046 void print_label_refs(void); 1047 void check_labels(char *mod_name); 1048 void sort_labtable(void); 1049 int def_label(Token *t, int type); 1050 void def_do_label(Token *t); 1051 void ref_label(Token *t, int type); 1052 void update_label_resources(void); 1053