1/* Process declarations and variables for GNU CHILL compiler. 2 Copyright (C) 1992, 93, 1994, 1998, 1999 Free Software Foundation, Inc. 3 4 This file is part of GNU CC. 5 6 GNU CC is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 2, or (at your option) 9 any later version. 10 11 GNU CC is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with GNU CC; see the file COPYING. If not, write to 18 the Free Software Foundation, 59 Temple Place - Suite 330, 19Boston, MA 02111-1307, USA. */ 20 21 22/* Process declarations and symbol lookup for CHILL front end. 23 Also constructs types; the standard scalar types at initialization, 24 and structure, union, array and enum types when they are declared. */ 25 26/* NOTES on Chill name resolution 27 28 Chill allows one to refer to an identifier that is declared later in 29 the same Group. Hence, a single pass over the code (as in C) is 30 insufficient. 31 32 This implementation uses two complete passes over the source code, 33 plus some extra passes over internal data structures. 34 35 Loosely, during pass 1, a 'scope' object is created for each Chill 36 reach. Each scope object contains a list of 'decl' objects, 37 one for each 'defining occurrence' in the reach. (This list 38 is in the 'remembered_decls' field of each scope.) 39 The scopes and their decls are replayed in pass 2: As each reach 40 is entered, the decls saved from pass 1 are made visible. 41 42 There are some exceptions. Declarations that cannot be referenced 43 before their declaration (i.e. whose defining occurrence precede 44 their reach), can be deferred to pass 2. These include formal 45 parameter declarations, and names defined in a DO action. 46 47 During pass 2, as each scope is entered, we must make visible all 48 the declarations defined in the scope, before we generate any code. 49 We must also simplify the declarations from pass 1: For example 50 a VAR_DECL may have a array type whose bounds are expressions; 51 these need to be folded. But of course the expressions may contain 52 identifiers that may be defined later in the scope - or even in 53 a different module. 54 55 The "satisfy" process has two main phases: 56 57 1: Binding. Each identifier *referenced* in a declaration (i.e. in 58 a mode or the RHS of a synonum declaration) must be bound to its 59 defining occurrence. This may need to be linking via 60 grants and/or seizes (which are represented by ALIAS_DECLs). 61 A further complication is handling implied name strings. 62 63 2: Layout. Each CONST_DECL or TYPE_DECL *referenced* in a declaration 64 must than be replaced by its value (or type). Constants must be 65 folded. Types and declarstions must be laid out. DECL_RTL must be set. 66 While doing this, we must watch out for circular dependencies. 67 68 If a scope contains nested modulions, then the Binding phase must be 69 done for each nested module (recursively) before the Layout phase 70 can start for that scope. As an example of why this is needed, consider: 71 72 M1: MODULE 73 DCL a ARRAY [1:y] int; -- This should have 7 elements. 74 SYN x = 5; 75 SEIZE y; 76 END M1; 77 M2: MODULE 78 SYN x = 2; 79 SYN y = x + 5; 80 GRANT y; 81 END M2; 82 83 Here, the 'x' in "x + 5" must be Bound to the 'x' in module M2. 84 This must be done before we can Layout a. 85 The reason this is an issue is that we do *not* have a lookup 86 (or hash) table per scope (or module). Instead we have a single 87 global table we we keep adding and removing bindings from. 88 (This is both for speed, and because of gcc history.) 89 90 Note that a SEIZE generates a declaration in the current scope, 91 linked to something in the surrounding scope. Determining (binding) 92 the link must be done in pass 2. On the other hand, a GRANT 93 generates a declaration in the surrounding scope, linked to 94 something in the current scope. This linkage is Bound in pass 1. 95 96 The sequence for the above example is: 97 - Enter the declarations of M1 (i.e. {a, x, y}) into the hash table. 98 - For each of {a, x, y}, examine dependent expression (the 99 rhs of x, the bounds of a), and Bind any identifiers to 100 the current declarations (as found in the hash table). Specifically, 101 the 'y' in the array bounds of 'a' is bound to the 'y' declared by 102 the SEIZE declaration. Also, 'y' is Bound to the implicit 103 declaration in the global scope (generated from the GRANT in M2). 104 - Remove the bindings for M1 (i.e. {a, x, y}) from the hash table. 105 - Enter the declarations of M2 (i.e. {x, y}) into the hash table. 106 - For each of {x, y} examine the dependent expressions (the rhs of 107 x and y), and Bind any identifiers to their current declarartions 108 (in this case the 'x' in "x + 5" is bound to the 'x' that is 2. 109 - Remove the bindings for M2 (i.e. {x, y}) from the hash table. 110 - Perform Layout for M1: This requires the size of a, which 111 requires the value of y. The 'y' is Bound to the implicit 112 declaration in the global scope, which is Bound to the declaration 113 of y in M2. We now require the value of this 'y', which is "x + 5" 114 where x is bound to the x in M2 (thanks to our previous Binding 115 phase). So we get that the value of y is 7. 116 - Perform layout of M2. This implies calculating (constant folding) 117 the value of y - but we already did that, so we're done. 118 119 An example illustating the problem with implied names: 120 121 M1: MODULE 122 SEIZE y; 123 use(e); -- e is implied by y. 124 END M1; 125 M2: MODULE 126 GRANT y; 127 SYNMODE y = x; 128 SEIZE x; 129 END M2; 130 M3: MODULE 131 GRANT x; 132 SYNMODE x = SET (e); 133 END M3; 134 135 This implies that determining the implied name e in M1 136 must be done after Binding of y to x in M2. 137 138 Yet another nasty: 139 M1: MODULE 140 SEIZE v; 141 DCL a ARRAY(v:v) int; 142 END M1; 143 M2: MODULE 144 GRANT v; 145 SEIZE x; 146 SYN v x = e; 147 END M2; 148 M3: MODULE 149 GRANT x; 150 SYNMODE x = SET(e); 151 END M3; 152 153 This one implies that determining the implied name e in M2, 154 must be done before Layout of a in M1. 155 156 These two examples togother indicate the determining implieed 157 names requries yet another phase. 158 - Bind strong names in M1. 159 - Bind strong names in M2. 160 - Bind strong names in M3. 161 - Determine weak names implied by SEIZEs in M1. 162 - Bind the weak names in M1. 163 - Determine weak names implied by SEIZEs in M2. 164 - Bind the weak names in M2. 165 - Determine weak names implied by SEIZEs in M3. 166 - Bind the weak names in M3. 167 - Layout M1. 168 - Layout M2. 169 - Layout M3. 170 171 We must bind the strong names in every module before we can determine 172 weak names in any module (because of seized/granted synmode/newmodes). 173 We must bind the weak names in every module before we can do Layout 174 in any module. 175 176 Sigh. 177 178 */ 179 180/* ??? not all decl nodes are given the most useful possible 181 line numbers. For example, the CONST_DECLs for enum values. */ 182 183#include "config.h" 184#include "system.h" 185#include "tree.h" 186#include "flags.h" 187#include "ch-tree.h" 188#include "lex.h" 189#include "obstack.h" 190#include "input.h" 191#include "rtl.h" 192#include "toplev.h" 193 194#define IS_UNKNOWN_TYPE(type) (TYPE_SIZE(type)==0) 195#define BUILTIN_NESTING_LEVEL (-1) 196 197/* For backward compatibility, we define Chill INT to be the same 198 as SHORT (i.e. 16 bits), at least if C INT is the same as LONG. 199 This is a lose. */ 200#define CHILL_INT_IS_SHORT (INT_TYPE_SIZE==LONG_TYPE_SIZE) 201 202extern int ignore_case; 203extern tree process_type; 204extern struct obstack *saveable_obstack; 205extern tree signal_code; 206extern int special_UC; 207 208static tree get_next_decl PROTO((void)); 209static tree lookup_name_for_seizing PROTO((tree)); 210#if 0 211static tree lookup_name_current_level PROTO((tree)); 212#endif 213static void save_decl PROTO((tree)); 214 215extern struct obstack permanent_obstack; 216extern int in_pseudo_module; 217 218struct module *current_module = NULL; 219struct module *first_module = NULL; 220struct module **next_module = &first_module; 221 222extern int in_pseudo_module; 223 224int module_number = 0; 225 226/* This is only used internally (by signed_type). */ 227 228tree signed_boolean_type_node; 229 230tree global_function_decl = NULL_TREE; 231 232/* This is a temportary used by RESULT to store its value. 233 Note we cannot directly use DECL_RESULT for two reasons: 234 a) If DECL_RESULT is a register, it may get clobbered by a 235 subsequent function call; and 236 b) if the function returns a struct, we might (visibly) modify the 237 destination before we're supposed to. */ 238tree chill_result_decl; 239 240int result_never_set; 241 242/* forward declarations */ 243static void pushdecllist PROTO((tree, int)); 244static int init_nonvalue_struct PROTO((tree)); 245static int init_nonvalue_array PROTO((tree)); 246 247int current_nesting_level = BUILTIN_NESTING_LEVEL; 248int current_module_nesting_level = 0; 249 250/* Lots of declarations copied from c-decl.c. */ 251/* ??? not all decl nodes are given the most useful possible 252 line numbers. For example, the CONST_DECLs for enum values. */ 253 254#if 0 255/* In grokdeclarator, distinguish syntactic contexts of declarators. */ 256enum decl_context 257{ NORMAL, /* Ordinary declaration */ 258 FUNCDEF, /* Function definition */ 259 PARM, /* Declaration of parm before function body */ 260 FIELD, /* Declaration inside struct or union */ 261 BITFIELD, /* Likewise but with specified width */ 262 TYPENAME}; /* Typename (inside cast or sizeof) */ 263#endif 264 265#ifndef CHAR_TYPE_SIZE 266#define CHAR_TYPE_SIZE BITS_PER_UNIT 267#endif 268 269#ifndef SHORT_TYPE_SIZE 270#define SHORT_TYPE_SIZE (BITS_PER_UNIT * MIN ((UNITS_PER_WORD + 1) / 2, 2)) 271#endif 272 273#ifndef INT_TYPE_SIZE 274#define INT_TYPE_SIZE BITS_PER_WORD 275#endif 276 277#ifndef LONG_TYPE_SIZE 278#define LONG_TYPE_SIZE BITS_PER_WORD 279#endif 280 281#ifndef LONG_LONG_TYPE_SIZE 282#define LONG_LONG_TYPE_SIZE (BITS_PER_WORD * 2) 283#endif 284 285#ifndef WCHAR_UNSIGNED 286#define WCHAR_UNSIGNED 0 287#endif 288 289#ifndef FLOAT_TYPE_SIZE 290#define FLOAT_TYPE_SIZE BITS_PER_WORD 291#endif 292 293#ifndef DOUBLE_TYPE_SIZE 294#define DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2) 295#endif 296 297#ifndef LONG_DOUBLE_TYPE_SIZE 298#define LONG_DOUBLE_TYPE_SIZE (BITS_PER_WORD * 2) 299#endif 300 301/* We let tm.h override the types used here, to handle trivial differences 302 such as the choice of unsigned int or long unsigned int for size_t. 303 When machines start needing nontrivial differences in the size type, 304 it would be best to do something here to figure out automatically 305 from other information what type to use. */ 306 307#ifndef PTRDIFF_TYPE 308#define PTRDIFF_TYPE "long int" 309#endif 310 311#ifndef WCHAR_TYPE 312#define WCHAR_TYPE "int" 313#endif 314 315/* a node which has tree code ERROR_MARK, and whose type is itself. 316 All erroneous expressions are replaced with this node. All functions 317 that accept nodes as arguments should avoid generating error messages 318 if this node is one of the arguments, since it is undesirable to get 319 multiple error messages from one error in the input. */ 320 321tree error_mark_node; 322 323/* INTEGER_TYPE and REAL_TYPE nodes for the standard data types */ 324 325tree short_integer_type_node; 326tree integer_type_node; 327tree long_integer_type_node; 328tree long_long_integer_type_node; 329 330tree short_unsigned_type_node; 331tree unsigned_type_node; 332tree long_unsigned_type_node; 333tree long_long_unsigned_type_node; 334 335tree ptrdiff_type_node; 336 337tree unsigned_char_type_node; 338tree signed_char_type_node; 339tree char_type_node; 340tree wchar_type_node; 341tree signed_wchar_type_node; 342tree unsigned_wchar_type_node; 343 344tree float_type_node; 345tree double_type_node; 346tree long_double_type_node; 347 348tree complex_integer_type_node; 349tree complex_float_type_node; 350tree complex_double_type_node; 351tree complex_long_double_type_node; 352 353tree intQI_type_node; 354tree intHI_type_node; 355tree intSI_type_node; 356tree intDI_type_node; 357#if HOST_BITS_PER_WIDE_INT >= 64 358tree intTI_type_node; 359#endif 360 361tree unsigned_intQI_type_node; 362tree unsigned_intHI_type_node; 363tree unsigned_intSI_type_node; 364tree unsigned_intDI_type_node; 365#if HOST_BITS_PER_WIDE_INT >= 64 366tree unsigned_intTI_type_node; 367#endif 368 369/* a VOID_TYPE node. */ 370 371tree void_type_node; 372tree void_list_node; 373 374/* Nodes for types `void *' and `const void *'. */ 375tree ptr_type_node, const_ptr_type_node; 376 377/* type of initializer structure, which points to 378 a module's module-level code, and to the next 379 such structure. */ 380tree initializer_type; 381 382/* type of a CHILL predefined value builtin routine */ 383tree chill_predefined_function_type; 384 385/* type `int ()' -- used for implicit declaration of functions. */ 386 387tree default_function_type; 388 389#if 0 390/* function types `double (double)' and `double (double, double)', etc. */ 391 392tree double_ftype_double, double_ftype_double_double; 393tree int_ftype_int, long_ftype_long; 394 395/* Function type `void (void *, void *, int)' and similar ones */ 396 397tree void_ftype_ptr_ptr_int, int_ftype_ptr_ptr_int, void_ftype_ptr_int_int; 398 399/* Function type `char *(char *, char *)' and similar ones */ 400tree string_ftype_ptr_ptr, int_ftype_string_string; 401 402/* Function type `int (const void *, const void *, size_t)' */ 403tree int_ftype_cptr_cptr_sizet; 404#endif 405 406char **boolean_code_name; 407 408/* Two expressions that are constants with value zero. 409 The first is of type `int', the second of type `void *'. */ 410 411tree integer_zero_node; 412tree null_pointer_node; 413 414/* A node for the integer constant 1. */ 415tree integer_one_node; 416 417/* A node for the integer constant -1. */ 418tree integer_minus_one_node; 419 420/* Nodes for boolean constants TRUE and FALSE. */ 421tree boolean_true_node, boolean_false_node; 422 423tree string_one_type_node; /* The type of CHARS(1). */ 424tree bitstring_one_type_node; /* The type of BOOLS(1). */ 425tree bit_zero_node; /* B'0' */ 426tree bit_one_node; /* B'1' */ 427 428/* Nonzero if we have seen an invalid cross reference 429 to a struct, union, or enum, but not yet printed the message. */ 430 431tree pending_invalid_xref; 432/* File and line to appear in the eventual error message. */ 433char *pending_invalid_xref_file; 434int pending_invalid_xref_line; 435 436/* After parsing the declarator that starts a function definition, 437 `start_function' puts here the list of parameter names or chain of decls. 438 `store_parm_decls' finds it here. */ 439 440static tree current_function_parms; 441 442/* Nonzero when store_parm_decls is called indicates a varargs function. 443 Value not meaningful after store_parm_decls. */ 444 445static int c_function_varargs; 446 447/* The FUNCTION_DECL for the function currently being compiled, 448 or 0 if between functions. */ 449tree current_function_decl; 450 451/* These are irrelevant for Chill, but are referenced from from c-typeck.c. */ 452int warn_format; 453int warn_traditional; 454int warn_bad_function_cast; 455 456/* Identifiers that hold VAR_LENGTH and VAR_DATA. */ 457tree var_length_id, var_data_id; 458 459tree case_else_node; 460 461/* For each binding contour we allocate a scope structure 462 * which records the names defined in that contour. 463 * Contours include: 464 * 0) the global one 465 * 1) one for each function definition, 466 * where internal declarations of the parameters appear. 467 * 2) one for each compound statement, 468 * to record its declarations. 469 * 470 * The current meaning of a name can be found by searching the levels from 471 * the current one out to the global one. 472 */ 473 474/* To communicate between pass 1 and 2, we maintain a list of "scopes". 475 Each scope corrresponds to a nested source scope/block that contain 476 that can contain declarations. The TREE_VALUE of the scope points 477 to the list of declarations declared in that scope. 478 The TREE_PURPOSE of the scope points to the surrounding scope. 479 (We may need to handle nested modules later. FIXME) 480 The TREE_CHAIN field contains a list of scope as they are seen 481 in chronological order. (Reverse order during first pass, 482 but it is reverse before pass 2.) */ 483 484struct scope 485{ 486 /* The enclosing scope. */ 487 struct scope *enclosing; 488 489 /* The next scope, in chronlogical order. */ 490 struct scope *next; 491 492 /* A chain of DECLs constructed using save_decl during pass 1. */ 493 tree remembered_decls; 494 495 /* A chain of _DECL nodes for all variables, constants, functions, 496 and typedef types belong to this scope. */ 497 tree decls; 498 499 /* List of declarations that have been granted into this scope. */ 500 tree granted_decls; 501 502 /* List of implied (weak) names. */ 503 tree weak_decls; 504 505 /* For each level, a list of shadowed outer-level local definitions 506 to be restored when this level is popped. 507 Each link is a TREE_LIST whose TREE_PURPOSE is an identifier and 508 whose TREE_VALUE is its old definition (a kind of ..._DECL node). */ 509 tree shadowed; 510 511 /* For each level (except not the global one), 512 a chain of BLOCK nodes for all the levels 513 that were entered and exited one level down. */ 514 tree blocks; 515 516 /* The BLOCK node for this level, if one has been preallocated. 517 If 0, the BLOCK is allocated (if needed) when the level is popped. */ 518 tree this_block; 519 520 /* The binding level which this one is contained in (inherits from). */ 521 struct scope *level_chain; 522 523 /* Nonzero for a level that corresponds to a module. */ 524 char module_flag; 525 526 /* Zero means called from backend code. */ 527 char two_pass; 528 529 /* The modules that are directly enclosed by this scope 530 are chained together. */ 531 struct scope* first_child_module; 532 struct scope** tail_child_module; 533 struct scope* next_sibling_module; 534}; 535 536/* The outermost binding level, for pre-defined (builtin) names. */ 537 538static struct scope builtin_scope = { 539 NULL, NULL, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, 540 NULL_TREE, NULL_TREE, NULL, 0, 0, NULL, NULL, NULL}; 541 542struct scope *global_scope; 543 544/* The binding level currently in effect. */ 545 546static struct scope *current_scope = &builtin_scope; 547 548/* The most recently seen scope. */ 549struct scope *last_scope = &builtin_scope; 550 551/* Binding level structures are initialized by copying this one. */ 552 553static struct scope clear_scope = { 554 NULL, NULL, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, 555 NULL_TREE, NULL_TREE, NULL, 0, 0, NULL, NULL, NULL}; 556 557/* Chain of decls accessible through IDENTIFIER_OUTER_VALUE. 558 Decls with the same DECL_NAME are adjacent in the chain. */ 559 560static tree outer_decls = NULL_TREE; 561 562/* C-specific option variables. */ 563 564/* Nonzero means allow type mismatches in conditional expressions; 565 just make their values `void'. */ 566 567int flag_cond_mismatch; 568 569/* Nonzero means give `double' the same size as `float'. */ 570 571int flag_short_double; 572 573/* Nonzero means don't recognize the keyword `asm'. */ 574 575int flag_no_asm; 576 577/* Nonzero means don't recognize any builtin functions. */ 578 579int flag_no_builtin; 580 581/* Nonzero means don't recognize the non-ANSI builtin functions. 582 -ansi sets this. */ 583 584int flag_no_nonansi_builtin; 585 586/* Nonzero means do some things the same way PCC does. */ 587 588int flag_traditional; 589 590/* Nonzero means to allow single precision math even if we're generally 591 being traditional. */ 592int flag_allow_single_precision = 0; 593 594/* Nonzero means to treat bitfields as signed unless they say `unsigned'. */ 595 596int flag_signed_bitfields = 1; 597int explicit_flag_signed_bitfields = 0; 598 599/* Nonzero means warn about implicit declarations. */ 600 601int warn_implicit; 602 603/* Nonzero means give string constants the type `const char *' 604 to get extra warnings from them. These warnings will be too numerous 605 to be useful, except in thoroughly ANSIfied programs. */ 606 607int warn_write_strings; 608 609/* Nonzero means warn about pointer casts that can drop a type qualifier 610 from the pointer target type. */ 611 612int warn_cast_qual; 613 614/* Nonzero means warn about sizeof(function) or addition/subtraction 615 of function pointers. */ 616 617int warn_pointer_arith; 618 619/* Nonzero means warn for non-prototype function decls 620 or non-prototyped defs without previous prototype. */ 621 622int warn_strict_prototypes; 623 624/* Nonzero means warn for any global function def 625 without separate previous prototype decl. */ 626 627int warn_missing_prototypes; 628 629/* Nonzero means warn about multiple (redundant) decls for the same single 630 variable or function. */ 631 632int warn_redundant_decls = 0; 633 634/* Nonzero means warn about extern declarations of objects not at 635 file-scope level and about *all* declarations of functions (whether 636 extern or static) not at file-scope level. Note that we exclude 637 implicit function declarations. To get warnings about those, use 638 -Wimplicit. */ 639 640int warn_nested_externs = 0; 641 642/* Warn about a subscript that has type char. */ 643 644int warn_char_subscripts = 0; 645 646/* Warn if a type conversion is done that might have confusing results. */ 647 648int warn_conversion; 649 650/* Warn if adding () is suggested. */ 651 652int warn_parentheses; 653 654/* Warn if initializer is not completely bracketed. */ 655 656int warn_missing_braces; 657 658/* Define the special tree codes that we use. */ 659 660/* Table indexed by tree code giving a string containing a character 661 classifying the tree code. Possibilities are 662 t, d, s, c, r, <, 1 and 2. See ch-tree.def for details. */ 663 664#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE, 665 666 char chill_tree_code_type[] = { 667 'x', 668#include "ch-tree.def" 669 }; 670#undef DEFTREECODE 671 672/* Table indexed by tree code giving number of expression 673 operands beyond the fixed part of the node structure. 674 Not used for types or decls. */ 675 676#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH, 677 678int chill_tree_code_length[] = { 679 0, 680#include "ch-tree.def" 681 }; 682#undef DEFTREECODE 683 684 685/* Names of tree components. 686 Used for printing out the tree and error messages. */ 687#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME, 688 689char *chill_tree_code_name[] = { 690 "@@dummy", 691#include "ch-tree.def" 692 }; 693#undef DEFTREECODE 694 695/* Nonzero means `$' can be in an identifier. 696 See cccp.c for reasons why this breaks some obscure ANSI C programs. */ 697 698#ifndef DOLLARS_IN_IDENTIFIERS 699#define DOLLARS_IN_IDENTIFIERS 0 700#endif 701int dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1; 702 703/* An identifier that is used internally to indicate 704 an "ALL" prefix for granting or seizing. 705 We use "*" rather than the external name "ALL", partly for convenience, 706 and partly to avoid case senstivity problems. */ 707 708tree ALL_POSTFIX; 709 710void 711allocate_lang_decl (t) 712 tree t ATTRIBUTE_UNUSED; 713{ 714 /* Nothing needed */ 715} 716 717void 718copy_lang_decl (node) 719 tree node ATTRIBUTE_UNUSED; 720{ 721 /* Nothing needed */ 722} 723 724tree 725build_lang_decl (code, name, type) 726 enum chill_tree_code code; 727 tree name; 728 tree type; 729{ 730 return build_decl (code, name, type); 731} 732 733/* Decode the string P as a language-specific option for C. 734 Return the number of strings consumed for a valid option. 735 Return 0 for an invalid option. */ 736 737int 738c_decode_option (argc, argv) 739 int argc ATTRIBUTE_UNUSED; 740 char **argv; 741{ 742 char *p = argv[0]; 743 if (!strcmp (p, "-ftraditional") || !strcmp (p, "-traditional")) 744 { 745 flag_traditional = 1; 746 flag_writable_strings = 1; 747#if DOLLARS_IN_IDENTIFIERS > 0 748 dollars_in_ident = 1; 749#endif 750 } 751 else if (!strcmp (p, "-fnotraditional") || !strcmp (p, "-fno-traditional")) 752 { 753 flag_traditional = 0; 754 flag_writable_strings = 0; 755 dollars_in_ident = DOLLARS_IN_IDENTIFIERS > 1; 756 } 757 else if (!strcmp (p, "-fsigned-char")) 758 flag_signed_char = 1; 759 else if (!strcmp (p, "-funsigned-char")) 760 flag_signed_char = 0; 761 else if (!strcmp (p, "-fno-signed-char")) 762 flag_signed_char = 0; 763 else if (!strcmp (p, "-fno-unsigned-char")) 764 flag_signed_char = 1; 765 else if (!strcmp (p, "-fsigned-bitfields") 766 || !strcmp (p, "-fno-unsigned-bitfields")) 767 { 768 flag_signed_bitfields = 1; 769 explicit_flag_signed_bitfields = 1; 770 } 771 else if (!strcmp (p, "-funsigned-bitfields") 772 || !strcmp (p, "-fno-signed-bitfields")) 773 { 774 flag_signed_bitfields = 0; 775 explicit_flag_signed_bitfields = 1; 776 } 777 else if (!strcmp (p, "-fshort-enums")) 778 flag_short_enums = 1; 779 else if (!strcmp (p, "-fno-short-enums")) 780 flag_short_enums = 0; 781 else if (!strcmp (p, "-fcond-mismatch")) 782 flag_cond_mismatch = 1; 783 else if (!strcmp (p, "-fno-cond-mismatch")) 784 flag_cond_mismatch = 0; 785 else if (!strcmp (p, "-fshort-double")) 786 flag_short_double = 1; 787 else if (!strcmp (p, "-fno-short-double")) 788 flag_short_double = 0; 789 else if (!strcmp (p, "-fasm")) 790 flag_no_asm = 0; 791 else if (!strcmp (p, "-fno-asm")) 792 flag_no_asm = 1; 793 else if (!strcmp (p, "-fbuiltin")) 794 flag_no_builtin = 0; 795 else if (!strcmp (p, "-fno-builtin")) 796 flag_no_builtin = 1; 797 else if (!strcmp (p, "-ansi")) 798 flag_no_asm = 1, flag_no_nonansi_builtin = 1, dollars_in_ident = 0; 799 else if (!strcmp (p, "-Wimplicit")) 800 warn_implicit = 1; 801 else if (!strcmp (p, "-Wno-implicit")) 802 warn_implicit = 0; 803 else if (!strcmp (p, "-Wwrite-strings")) 804 warn_write_strings = 1; 805 else if (!strcmp (p, "-Wno-write-strings")) 806 warn_write_strings = 0; 807 else if (!strcmp (p, "-Wcast-qual")) 808 warn_cast_qual = 1; 809 else if (!strcmp (p, "-Wno-cast-qual")) 810 warn_cast_qual = 0; 811 else if (!strcmp (p, "-Wpointer-arith")) 812 warn_pointer_arith = 1; 813 else if (!strcmp (p, "-Wno-pointer-arith")) 814 warn_pointer_arith = 0; 815 else if (!strcmp (p, "-Wstrict-prototypes")) 816 warn_strict_prototypes = 1; 817 else if (!strcmp (p, "-Wno-strict-prototypes")) 818 warn_strict_prototypes = 0; 819 else if (!strcmp (p, "-Wmissing-prototypes")) 820 warn_missing_prototypes = 1; 821 else if (!strcmp (p, "-Wno-missing-prototypes")) 822 warn_missing_prototypes = 0; 823 else if (!strcmp (p, "-Wredundant-decls")) 824 warn_redundant_decls = 1; 825 else if (!strcmp (p, "-Wno-redundant-decls")) 826 warn_redundant_decls = 0; 827 else if (!strcmp (p, "-Wnested-externs")) 828 warn_nested_externs = 1; 829 else if (!strcmp (p, "-Wno-nested-externs")) 830 warn_nested_externs = 0; 831 else if (!strcmp (p, "-Wchar-subscripts")) 832 warn_char_subscripts = 1; 833 else if (!strcmp (p, "-Wno-char-subscripts")) 834 warn_char_subscripts = 0; 835 else if (!strcmp (p, "-Wconversion")) 836 warn_conversion = 1; 837 else if (!strcmp (p, "-Wno-conversion")) 838 warn_conversion = 0; 839 else if (!strcmp (p, "-Wparentheses")) 840 warn_parentheses = 1; 841 else if (!strcmp (p, "-Wno-parentheses")) 842 warn_parentheses = 0; 843 else if (!strcmp (p, "-Wreturn-type")) 844 warn_return_type = 1; 845 else if (!strcmp (p, "-Wno-return-type")) 846 warn_return_type = 0; 847 else if (!strcmp (p, "-Wcomment")) 848 ; /* cpp handles this one. */ 849 else if (!strcmp (p, "-Wno-comment")) 850 ; /* cpp handles this one. */ 851 else if (!strcmp (p, "-Wcomments")) 852 ; /* cpp handles this one. */ 853 else if (!strcmp (p, "-Wno-comments")) 854 ; /* cpp handles this one. */ 855 else if (!strcmp (p, "-Wtrigraphs")) 856 ; /* cpp handles this one. */ 857 else if (!strcmp (p, "-Wno-trigraphs")) 858 ; /* cpp handles this one. */ 859 else if (!strcmp (p, "-Wimport")) 860 ; /* cpp handles this one. */ 861 else if (!strcmp (p, "-Wno-import")) 862 ; /* cpp handles this one. */ 863 else if (!strcmp (p, "-Wmissing-braces")) 864 warn_missing_braces = 1; 865 else if (!strcmp (p, "-Wno-missing-braces")) 866 warn_missing_braces = 0; 867 else if (!strcmp (p, "-Wall")) 868 { 869 extra_warnings = 1; 870 /* We save the value of warn_uninitialized, since if they put 871 -Wuninitialized on the command line, we need to generate a 872 warning about not using it without also specifying -O. */ 873 if (warn_uninitialized != 1) 874 warn_uninitialized = 2; 875 warn_implicit = 1; 876 warn_return_type = 1; 877 warn_unused = 1; 878 warn_char_subscripts = 1; 879 warn_parentheses = 1; 880 warn_missing_braces = 1; 881 } 882 else 883 return 0; 884 885 return 1; 886} 887 888/* Hooks for print_node. */ 889 890void 891print_lang_decl (file, node, indent) 892 FILE *file; 893 tree node; 894 int indent; 895{ 896 indent_to (file, indent + 3); 897 fputs ("nesting_level ", file); 898 fprintf (file, HOST_WIDE_INT_PRINT_DEC, DECL_NESTING_LEVEL (node)); 899 fputs (" ", file); 900 if (DECL_WEAK_NAME (node)) 901 fprintf (file, "weak_name "); 902 if (CH_DECL_SIGNAL (node)) 903 fprintf (file, "decl_signal "); 904 print_node (file, "tasking_code", 905 (tree)DECL_TASKING_CODE_DECL (node), indent + 4); 906} 907 908 909void 910print_lang_type (file, node, indent) 911 FILE *file; 912 tree node; 913 int indent; 914{ 915 tree temp; 916 917 indent_to (file, indent + 3); 918 if (CH_IS_BUFFER_MODE (node)) 919 fprintf (file, "buffer_mode "); 920 if (CH_IS_EVENT_MODE (node)) 921 fprintf (file, "event_mode "); 922 923 if (CH_IS_EVENT_MODE (node) || CH_IS_BUFFER_MODE (node)) 924 { 925 temp = max_queue_size (node); 926 if (temp) 927 print_node_brief (file, "qsize", temp, indent + 4); 928 } 929} 930 931void 932print_lang_identifier (file, node, indent) 933 FILE *file; 934 tree node; 935 int indent; 936{ 937 print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4); 938 print_node (file, "outer", IDENTIFIER_OUTER_VALUE (node), indent + 4); 939 print_node (file, "implicit", IDENTIFIER_IMPLICIT_DECL (node), indent + 4); 940 print_node (file, "error locus", IDENTIFIER_ERROR_LOCUS (node), indent + 4); 941 print_node (file, "signal_dest", IDENTIFIER_SIGNAL_DEST (node), indent + 4); 942 indent_to (file, indent + 3); 943 if (IDENTIFIER_SIGNAL_DATA(node)) 944 fprintf (file, "signal_data "); 945} 946 947/* initialise non-value struct */ 948 949static int 950init_nonvalue_struct (expr) 951 tree expr; 952{ 953 tree type = TREE_TYPE (expr); 954 tree field; 955 int res = 0; 956 957 if (CH_IS_BUFFER_MODE (type)) 958 { 959 expand_expr_stmt ( 960 build_chill_modify_expr ( 961 build_component_ref (expr, get_identifier ("__buffer_data")), 962 null_pointer_node)); 963 return 1; 964 } 965 else if (CH_IS_EVENT_MODE (type)) 966 { 967 expand_expr_stmt ( 968 build_chill_modify_expr ( 969 build_component_ref (expr, get_identifier ("__event_data")), 970 null_pointer_node)); 971 return 1; 972 } 973 else if (CH_IS_ASSOCIATION_MODE (type)) 974 { 975 expand_expr_stmt ( 976 build_chill_modify_expr (expr, 977 chill_convert_for_assignment (type, association_init_value, 978 "association"))); 979 return 1; 980 } 981 else if (CH_IS_ACCESS_MODE (type)) 982 { 983 init_access_location (expr, type); 984 return 1; 985 } 986 else if (CH_IS_TEXT_MODE (type)) 987 { 988 init_text_location (expr, type); 989 return 1; 990 } 991 992 for (field = TYPE_FIELDS (type); field != NULL_TREE; field = TREE_CHAIN (field)) 993 { 994 type = TREE_TYPE (field); 995 if (CH_TYPE_NONVALUE_P (type)) 996 { 997 tree exp = build_component_ref (expr, DECL_NAME (field)); 998 if (TREE_CODE (type) == RECORD_TYPE) 999 res |= init_nonvalue_struct (exp); 1000 else if (TREE_CODE (type) == ARRAY_TYPE) 1001 res |= init_nonvalue_array (exp); 1002 } 1003 } 1004 return res; 1005} 1006 1007/* initialize non-value array */ 1008/* do it with DO FOR unique-id IN expr; ... OD; */ 1009static int 1010init_nonvalue_array (expr) 1011 tree expr; 1012{ 1013 tree tmpvar = get_unique_identifier ("NONVALINIT"); 1014 tree type; 1015 int res = 0; 1016 1017 push_loop_block (); 1018 build_loop_iterator (tmpvar, expr, NULL_TREE, NULL_TREE, 0, 1, 0); 1019 nonvalue_begin_loop_scope (); 1020 build_loop_start (NULL_TREE); 1021 tmpvar = lookup_name (tmpvar); 1022 type = TREE_TYPE (tmpvar); 1023 if (CH_TYPE_NONVALUE_P (type)) 1024 { 1025 if (TREE_CODE (type) == RECORD_TYPE) 1026 res |= init_nonvalue_struct (tmpvar); 1027 else if (TREE_CODE (type) == ARRAY_TYPE) 1028 res |= init_nonvalue_array (tmpvar); 1029 } 1030 build_loop_end (); 1031 nonvalue_end_loop_scope (); 1032 pop_loop_block (); 1033 return res; 1034} 1035 1036/* This excessive piece of code sets DECL_NESTING_LEVEL (DECL) to LEVEL. */ 1037 1038void 1039set_nesting_level (decl, level) 1040 tree decl; 1041 int level; 1042{ 1043 static tree *small_ints = NULL; 1044 static int max_small_ints = 0; 1045 1046 if (level < 0) 1047 decl->decl.vindex = NULL_TREE; 1048 else 1049 { 1050 if (level >= max_small_ints) 1051 { 1052 int new_max = level + 20; 1053 if (small_ints == NULL) 1054 small_ints = (tree*)xmalloc (new_max * sizeof(tree)); 1055 else 1056 small_ints = (tree*)xrealloc (small_ints, new_max * sizeof(tree)); 1057 while (max_small_ints < new_max) 1058 small_ints[max_small_ints++] = NULL_TREE; 1059 } 1060 if (small_ints[level] == NULL_TREE) 1061 { 1062 push_obstacks (&permanent_obstack, &permanent_obstack); 1063 small_ints[level] = build_int_2 (level, 0); 1064 pop_obstacks (); 1065 } 1066 /* set DECL_NESTING_LEVEL */ 1067 decl->decl.vindex = small_ints[level]; 1068 } 1069} 1070 1071/* OPT_EXTERNAL is non-zero when the declaration is at module level. 1072 * OPT_EXTERNAL == 2 means implicitly grant it. 1073 */ 1074void 1075do_decls (names, type, opt_static, lifetime_bound, opt_init, opt_external) 1076 tree names; 1077 tree type; 1078 int opt_static; 1079 int lifetime_bound; 1080 tree opt_init; 1081 int opt_external; 1082{ 1083 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST) 1084 { 1085 for (; names != NULL_TREE; names = TREE_CHAIN (names)) 1086 do_decl (TREE_VALUE (names), type, opt_static, lifetime_bound, 1087 opt_init, opt_external); 1088 } 1089 else if (TREE_CODE (names) != ERROR_MARK) 1090 do_decl (names, type, opt_static, lifetime_bound, opt_init, opt_external); 1091} 1092 1093tree 1094do_decl (name, type, is_static, lifetime_bound, opt_init, opt_external) 1095 tree name, type; 1096 int is_static; 1097 int lifetime_bound; 1098 tree opt_init; 1099 int opt_external; 1100{ 1101 tree decl; 1102 1103 if (current_function_decl == global_function_decl 1104 && ! lifetime_bound /*&& opt_init != NULL_TREE*/) 1105 seen_action = 1; 1106 1107 if (pass < 2) 1108 { 1109 push_obstacks (&permanent_obstack, &permanent_obstack); 1110 decl = make_node (VAR_DECL); 1111 DECL_NAME (decl) = name; 1112 TREE_TYPE (decl) = type; 1113 DECL_ASSEMBLER_NAME (decl) = name; 1114 1115 /* Try to put things in common when possible. 1116 Tasking variables must go into common. */ 1117 DECL_COMMON (decl) = 1; 1118 DECL_EXTERNAL (decl) = opt_external > 0; 1119 TREE_PUBLIC (decl) = opt_external > 0; 1120 TREE_STATIC (decl) = is_static; 1121 1122 if (pass == 0) 1123 { 1124 /* We have to set this here, since we build the decl w/o 1125 calling `build_decl'. */ 1126 DECL_INITIAL (decl) = opt_init; 1127 pushdecl (decl); 1128 finish_decl (decl); 1129 } 1130 else 1131 { 1132 save_decl (decl); 1133 pop_obstacks (); 1134 } 1135 DECL_INITIAL (decl) = opt_init; 1136 if (opt_external > 1 || in_pseudo_module) 1137 push_granted (DECL_NAME (decl), decl); 1138 } 1139 else /* pass == 2 */ 1140 { 1141 tree temp = NULL_TREE; 1142 int init_it = 0; 1143 1144 decl = get_next_decl (); 1145 1146 if (name != DECL_NAME (decl)) 1147 abort (); 1148 1149 type = TREE_TYPE (decl); 1150 1151 push_obstacks_nochange (); 1152 if (TYPE_READONLY_PROPERTY (type)) 1153 { 1154 if (CH_TYPE_NONVALUE_P (type)) 1155 { 1156 error_with_decl (decl, "`%s' must not be declared readonly"); 1157 opt_init = NULL_TREE; /* prevent subsequent errors */ 1158 } 1159 else if (opt_init == NULL_TREE && !opt_external) 1160 error("declaration of readonly variable without initialization"); 1161 } 1162 TREE_READONLY (decl) = TYPE_READONLY (type); 1163 1164 if (!opt_init && chill_varying_type_p (type)) 1165 { 1166 tree fixed_part_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))); 1167 if (fixed_part_type != NULL_TREE && TREE_CODE (fixed_part_type) != ERROR_MARK) 1168 { 1169 if (CH_CHARS_TYPE_P (fixed_part_type)) 1170 opt_init = build_chill_string (0, ""); 1171 else 1172 opt_init = build_nt (CONSTRUCTOR, NULL_TREE, NULL_TREE); 1173 lifetime_bound = 1; 1174 } 1175 } 1176 1177 if (opt_init) 1178 { 1179 if (CH_TYPE_NONVALUE_P (type)) 1180 { 1181 error_with_decl (decl, 1182 "no initialisation allowed for `%s'"); 1183 temp = NULL_TREE; 1184 } 1185 else if (TREE_CODE (type) == REFERENCE_TYPE) 1186 { /* A loc-identity declaration */ 1187 if (! CH_LOCATION_P (opt_init)) 1188 { 1189 error_with_decl (decl, 1190 "value for loc-identity `%s' is not a location"); 1191 temp = NULL_TREE; 1192 } 1193 else if (! CH_READ_COMPATIBLE (TREE_TYPE (type), 1194 TREE_TYPE (opt_init))) 1195 { 1196 error_with_decl (decl, 1197 "location for `%s' not read-compatible"); 1198 temp = NULL_TREE; 1199 } 1200 else 1201 temp = convert (type, opt_init); 1202 } 1203 else 1204 { /* Normal location declaration */ 1205 char place[80]; 1206 sprintf (place, "`%.60s' initializer", 1207 IDENTIFIER_POINTER (DECL_NAME (decl))); 1208 temp = chill_convert_for_assignment (type, opt_init, place); 1209 } 1210 } 1211 else if (CH_TYPE_NONVALUE_P (type)) 1212 { 1213 temp = NULL_TREE; 1214 init_it = 1; 1215 } 1216 DECL_INITIAL (decl) = NULL_TREE; 1217 1218 if (temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK) 1219 { 1220 /* The same for stack variables (assuming no nested modules). */ 1221 if (lifetime_bound || !is_static) 1222 { 1223 if (is_static && ! TREE_CONSTANT (temp)) 1224 error_with_decl (decl, "nonconstant initializer for `%s'"); 1225 else 1226 DECL_INITIAL (decl) = temp; 1227 } 1228 } 1229 finish_decl (decl); 1230 /* Initialize the variable unless initialized statically. */ 1231 if ((!is_static || ! lifetime_bound) && 1232 temp != NULL_TREE && TREE_CODE (temp) != ERROR_MARK) 1233 { 1234 int was_used = TREE_USED (decl); 1235 emit_line_note (input_filename, lineno); 1236 expand_expr_stmt (build_chill_modify_expr (decl, temp)); 1237 /* Don't let the initialization count as "using" the variable. */ 1238 TREE_USED (decl) = was_used; 1239 if (current_function_decl == global_function_decl) 1240 build_constructor = 1; 1241 } 1242 else if (init_it && TREE_CODE (type) != ERROR_MARK) 1243 { 1244 /* Initialize variables with non-value type */ 1245 int was_used = TREE_USED (decl); 1246 int something_initialised = 0; 1247 1248 emit_line_note (input_filename, lineno); 1249 if (TREE_CODE (type) == RECORD_TYPE) 1250 something_initialised = init_nonvalue_struct (decl); 1251 else if (TREE_CODE (type) == ARRAY_TYPE) 1252 something_initialised = init_nonvalue_array (decl); 1253 if (! something_initialised) 1254 { 1255 error ("do_decl: internal error: don't know what to initialize"); 1256 abort (); 1257 } 1258 /* Don't let the initialization count as "using" the variable. */ 1259 TREE_USED (decl) = was_used; 1260 if (current_function_decl == global_function_decl) 1261 build_constructor = 1; 1262 } 1263 } 1264 return decl; 1265} 1266 1267/* 1268 * ARGTYPES is a tree_list of formal argument types. TREE_VALUE 1269 * is the type tree for each argument, while the attribute is in 1270 * TREE_PURPOSE. 1271 */ 1272tree 1273build_chill_function_type (return_type, argtypes, exceptions, recurse_p) 1274 tree return_type, argtypes, exceptions, recurse_p; 1275{ 1276 tree ftype, arg; 1277 1278 if (exceptions != NULL_TREE) 1279 { 1280 /* if we have exceptions we add 2 arguments, callers filename 1281 and linenumber. These arguments will be added automatically 1282 when calling a function which may raise exceptions. */ 1283 argtypes = chainon (argtypes, 1284 build_tree_list (NULL_TREE, ridpointers[(int) RID_PTR])); 1285 argtypes = chainon (argtypes, 1286 build_tree_list (NULL_TREE, ridpointers[(int) RID_LONG])); 1287} 1288 1289 /* Indicate the argument list is complete. */ 1290 argtypes = chainon (argtypes, 1291 build_tree_list (NULL_TREE, void_type_node)); 1292 1293 /* INOUT and OUT parameters must be a REFERENCE_TYPE since 1294 we'll be passing a temporary's address at call time. */ 1295 for (arg = argtypes; arg; arg = TREE_CHAIN (arg)) 1296 if (TREE_PURPOSE (arg) == ridpointers[(int) RID_LOC] 1297 || TREE_PURPOSE (arg) == ridpointers[(int) RID_OUT] 1298 || TREE_PURPOSE (arg) == ridpointers[(int) RID_INOUT] 1299 ) 1300 TREE_VALUE (arg) = 1301 build_chill_reference_type (TREE_VALUE (arg)); 1302 1303 /* Cannot use build_function_type, because if does hash-canonlicalization. */ 1304 ftype = make_node (FUNCTION_TYPE); 1305 TREE_TYPE (ftype) = return_type ? return_type : void_type_node ; 1306 TYPE_ARG_TYPES (ftype) = argtypes; 1307 1308 if (exceptions) 1309 ftype = build_exception_variant (ftype, exceptions); 1310 1311 if (recurse_p) 1312 sorry ("RECURSIVE PROCs"); 1313 1314 return ftype; 1315} 1316 1317/* 1318 * ARGTYPES is a tree_list of formal argument types. 1319 */ 1320tree 1321push_extern_function (name, typespec, argtypes, exceptions, granting) 1322 tree name, typespec, argtypes, exceptions; 1323 int granting ATTRIBUTE_UNUSED;/*If 0 do pushdecl(); if 1 do push_granted()*/ 1324{ 1325 tree ftype, fndecl; 1326 1327 push_obstacks_nochange (); 1328 end_temporary_allocation (); 1329 1330 if (pass < 2) 1331 { 1332 ftype = build_chill_function_type (typespec, argtypes, 1333 exceptions, NULL_TREE); 1334 1335 fndecl = build_decl (FUNCTION_DECL, name, ftype); 1336 1337 DECL_EXTERNAL(fndecl) = 1; 1338 TREE_STATIC (fndecl) = 1; 1339 TREE_PUBLIC (fndecl) = 1; 1340 if (pass == 0) 1341 { 1342 pushdecl (fndecl); 1343 finish_decl (fndecl); 1344 } 1345 else 1346 { 1347 save_decl (fndecl); 1348 pop_obstacks (); 1349 } 1350 make_function_rtl (fndecl); 1351 } 1352 else 1353 { 1354 fndecl = get_next_decl (); 1355 finish_decl (fndecl); 1356 } 1357#if 0 1358 1359 if (granting) 1360 push_granted (name, decl); 1361 else 1362 pushdecl(decl); 1363#endif 1364 return fndecl; 1365} 1366 1367 1368 1369void 1370push_extern_process (name, argtypes, exceptions, granting) 1371 tree name, argtypes, exceptions; 1372 int granting; 1373{ 1374 tree decl, func, arglist; 1375 1376 push_obstacks_nochange (); 1377 end_temporary_allocation (); 1378 1379 if (pass < 2) 1380 { 1381 tree proc_struct = make_process_struct (name, argtypes); 1382 arglist = (argtypes == NULL_TREE) ? NULL_TREE : 1383 tree_cons (NULL_TREE, 1384 build_chill_pointer_type (proc_struct), NULL_TREE); 1385 } 1386 else 1387 arglist = NULL_TREE; 1388 1389 func = push_extern_function (name, NULL_TREE, arglist, 1390 exceptions, granting); 1391 1392 /* declare the code variable */ 1393 decl = generate_tasking_code_variable (name, &process_type, 1); 1394 CH_DECL_PROCESS (func) = 1; 1395 /* remember the code variable in the function decl */ 1396 DECL_TASKING_CODE_DECL (func) = (struct lang_decl *)decl; 1397 1398 add_taskstuff_to_list (decl, "_TT_Process", NULL_TREE, func, NULL_TREE); 1399} 1400 1401void 1402push_extern_signal (signame, sigmodelist, optsigdest) 1403 tree signame, sigmodelist, optsigdest; 1404{ 1405 tree decl, sigtype; 1406 1407 push_obstacks_nochange (); 1408 end_temporary_allocation (); 1409 1410 sigtype = 1411 build_signal_struct_type (signame, sigmodelist, optsigdest); 1412 1413 /* declare the code variable outside the process */ 1414 decl = generate_tasking_code_variable (signame, &signal_code, 1); 1415 add_taskstuff_to_list (decl, "_TT_Signal", NULL_TREE, sigtype, NULL_TREE); 1416} 1417 1418void 1419print_mode (mode) 1420 tree mode; 1421{ 1422 while (mode != NULL_TREE) 1423 { 1424 switch (TREE_CODE (mode)) 1425 { 1426 case POINTER_TYPE: 1427 printf (" REF "); 1428 mode = TREE_TYPE (mode); 1429 break; 1430 case INTEGER_TYPE: 1431 case REAL_TYPE: 1432 printf (" %s ", IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (mode)))); 1433 mode = NULL_TREE; 1434 break; 1435 case ARRAY_TYPE: 1436 { 1437 tree itype = TYPE_DOMAIN (mode); 1438 if (CH_STRING_TYPE_P (mode)) 1439 { 1440 fputs (" STRING (", stdout); 1441 printf (HOST_WIDE_INT_PRINT_DEC, 1442 TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype))); 1443 fputs (") OF ", stdout); 1444 } 1445 else 1446 { 1447 fputs (" ARRAY (", stdout); 1448 printf (HOST_WIDE_INT_PRINT_DEC, 1449 TREE_INT_CST_LOW (TYPE_MIN_VALUE (itype))); 1450 fputs (":", stdout); 1451 printf (HOST_WIDE_INT_PRINT_DEC, 1452 TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype))); 1453 fputs (") OF ", stdout); 1454 } 1455 mode = TREE_TYPE (mode); 1456 break; 1457 } 1458 case RECORD_TYPE: 1459 { 1460 tree fields = TYPE_FIELDS (mode); 1461 printf (" RECORD ("); 1462 while (fields != NULL_TREE) 1463 { 1464 printf (" %s:", IDENTIFIER_POINTER (DECL_NAME (fields))); 1465 print_mode (TREE_TYPE (fields)); 1466 if (TREE_CHAIN (fields)) 1467 printf (","); 1468 fields = TREE_CHAIN (fields); 1469 } 1470 printf (")"); 1471 mode = NULL_TREE; 1472 break; 1473 } 1474 default: 1475 abort (); 1476 } 1477 } 1478} 1479 1480tree 1481chill_munge_params (nodes, type, attr) 1482 tree nodes, type, attr; 1483{ 1484 tree node; 1485 if (pass == 1) 1486 { 1487 /* Convert the list of identifiers to a list of types. */ 1488 for (node = nodes; node != NULL_TREE; node = TREE_CHAIN (node)) 1489 { 1490 TREE_VALUE (node) = type; /* this was the identifier node */ 1491 TREE_PURPOSE (node) = attr; 1492 } 1493 } 1494 return nodes; 1495} 1496 1497/* Push the declarations described by SYN_DEFS into the current scope. */ 1498void 1499push_syndecl (name, mode, value) 1500 tree name, mode, value; 1501{ 1502 if (pass == 1) 1503 { 1504 tree decl = make_node (CONST_DECL); 1505 DECL_NAME (decl) = name; 1506 DECL_ASSEMBLER_NAME (decl) = name; 1507 TREE_TYPE (decl) = mode; 1508 DECL_INITIAL (decl) = value; 1509 TREE_READONLY (decl) = 1; 1510 save_decl (decl); 1511 if (in_pseudo_module) 1512 push_granted (DECL_NAME (decl), decl); 1513 } 1514 else /* pass == 2 */ 1515 get_next_decl (); 1516} 1517 1518 1519 1520/* Push the declarations described by (MODENAME,MODE) into the current scope. 1521 MAKE_NEWMODE is 1 for NEWMODE, 0 for SYNMODE, and 1522 -1 for internal use (in which case the mode does not need to be copied). */ 1523 1524tree 1525push_modedef (modename, mode, make_newmode) 1526 tree modename; 1527 tree mode; /* ignored if pass==2. */ 1528 int make_newmode; 1529{ 1530 tree newdecl, newmode; 1531 1532 if (pass == 1) 1533 { 1534 /* FIXME: need to check here for SYNMODE fred fred; */ 1535 push_obstacks (&permanent_obstack, &permanent_obstack); 1536 1537 newdecl = build_lang_decl (TYPE_DECL, modename, mode); 1538 1539 if (make_newmode >= 0) 1540 { 1541 newmode = make_node (LANG_TYPE); 1542 TREE_TYPE (newmode) = mode; 1543 TREE_TYPE (newdecl) = newmode; 1544 TYPE_NAME (newmode) = newdecl; 1545 if (make_newmode > 0) 1546 CH_NOVELTY (newmode) = newdecl; 1547 } 1548 1549 save_decl (newdecl); 1550 pop_obstacks (); 1551 1552 } 1553 else /* pass == 2 */ 1554 { 1555 /* FIXME: need to check here for SYNMODE fred fred; */ 1556 newdecl = get_next_decl (); 1557 if (DECL_NAME (newdecl) != modename) 1558 abort (); 1559 if (TREE_CODE (TREE_TYPE (newdecl)) != ERROR_MARK) 1560 { 1561 /* ASSOCIATION, ACCESS, TEXT, BUFFER, and EVENT must not be READOnly */ 1562 if (TREE_READONLY (TREE_TYPE (newdecl)) && 1563 (CH_IS_ASSOCIATION_MODE (TREE_TYPE (newdecl)) || 1564 CH_IS_ACCESS_MODE (TREE_TYPE (newdecl)) || 1565 CH_IS_TEXT_MODE (TREE_TYPE (newdecl)) || 1566 CH_IS_BUFFER_MODE (TREE_TYPE (newdecl)) || 1567 CH_IS_EVENT_MODE (TREE_TYPE (newdecl)))) 1568 error_with_decl (newdecl, "`%s' must not be READonly"); 1569 rest_of_decl_compilation (newdecl, NULL_PTR, 1570 global_bindings_p (), 0); 1571 } 1572 } 1573 return newdecl; 1574} 1575 1576/* Return a chain of FIELD_DECLs for the names in NAMELIST. All of 1577 of type TYPE. When NAMELIST is passed in from the parser, it is 1578 in reverse order. 1579 LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list), 1580 meaning (default, pack, nopack, POS (...) ). */ 1581 1582tree 1583grok_chill_fixedfields (namelist, type, layout) 1584 tree namelist, type; 1585 tree layout; 1586{ 1587 tree decls = NULL_TREE; 1588 1589 if (layout != NULL_TREE && TREE_CHAIN (namelist) != NULL_TREE) 1590 { 1591 if (layout != integer_one_node && layout != integer_zero_node) 1592 { 1593 layout = NULL_TREE; 1594 error ("POS may not be specified for a list of field declarations"); 1595 } 1596 } 1597 1598 /* we build the chain of FIELD_DECLs backwards, effectively 1599 unreversing the reversed names in NAMELIST. */ 1600 for (; namelist; namelist = TREE_CHAIN (namelist)) 1601 { 1602 tree decl = build_decl (FIELD_DECL, 1603 TREE_VALUE (namelist), type); 1604 DECL_INITIAL (decl) = layout; 1605 TREE_CHAIN (decl) = decls; 1606 decls = decl; 1607 } 1608 1609 return decls; 1610} 1611 1612struct tree_pair 1613{ 1614 tree value; 1615 tree decl; 1616}; 1617 1618 1619/* Function to help qsort sort variant labels by value order. */ 1620static int 1621label_value_cmp (x, y) 1622 struct tree_pair *x, *y; 1623{ 1624 return TREE_INT_CST_LOW (x->value) - TREE_INT_CST_LOW (y->value); 1625} 1626 1627tree 1628make_chill_variants (tagfields, body, variantelse) 1629 tree tagfields; 1630 tree body; 1631 tree variantelse; 1632{ 1633 tree utype; 1634 tree first = NULL_TREE; 1635 for (; body; body = TREE_CHAIN (body)) 1636 { 1637 tree decls = TREE_VALUE (body); 1638 tree labellist = TREE_PURPOSE (body); 1639 1640 if (labellist != NULL_TREE 1641 && TREE_CODE (TREE_VALUE (labellist)) == TREE_LIST 1642 && TREE_VALUE (TREE_VALUE (labellist)) == case_else_node 1643 && TREE_CHAIN (labellist) == NULL_TREE) 1644 { 1645 if (variantelse) 1646 error ("(ELSE) case label as well as ELSE variant"); 1647 variantelse = decls; 1648 } 1649 else 1650 { 1651 tree rtype = start_struct (RECORD_TYPE, NULL_TREE); 1652 rtype = finish_struct (rtype, decls); 1653 1654 first = chainon (first, build_decl (FIELD_DECL, NULL_TREE, rtype)); 1655 1656 TYPE_TAG_VALUES (rtype) = labellist; 1657 } 1658 } 1659 1660 if (variantelse != NULL_TREE) 1661 { 1662 tree rtype = start_struct (RECORD_TYPE, NULL_TREE); 1663 rtype = finish_struct (rtype, variantelse); 1664 first = chainon (first, 1665 build_decl (FIELD_DECL, 1666 ELSE_VARIANT_NAME, rtype)); 1667 } 1668 1669 utype = start_struct (UNION_TYPE, NULL_TREE); 1670 utype = finish_struct (utype, first); 1671 TYPE_TAGFIELDS (utype) = tagfields; 1672 return utype; 1673} 1674 1675tree 1676layout_chill_variants (utype) 1677 tree utype; 1678{ 1679 tree first = TYPE_FIELDS (utype); 1680 int nlabels, label_index = 0; 1681 struct tree_pair *label_value_array; 1682 tree decl; 1683 extern int errorcount; 1684 1685 if (TYPE_SIZE (utype)) 1686 return utype; 1687 1688 for (decl = first; decl; decl = TREE_CHAIN (decl)) 1689 { 1690 tree tagfields = TYPE_TAGFIELDS (utype); 1691 tree t = TREE_TYPE (decl); 1692 tree taglist = TYPE_TAG_VALUES (t); 1693 if (DECL_NAME (decl) == ELSE_VARIANT_NAME) 1694 continue; 1695 if (tagfields == NULL_TREE) 1696 continue; 1697 for ( ; tagfields != NULL_TREE && taglist != NULL_TREE; 1698 tagfields = TREE_CHAIN (tagfields), taglist = TREE_CHAIN (taglist)) 1699 { 1700 tree labellist = TREE_VALUE (taglist); 1701 for (; labellist; labellist = TREE_CHAIN (labellist)) 1702 { 1703 int compat_error = 0; 1704 tree label_value = TREE_VALUE (labellist); 1705 if (TREE_CODE (label_value) == RANGE_EXPR) 1706 { 1707 if (TREE_OPERAND (label_value, 0) != NULL_TREE) 1708 { 1709 if (!CH_COMPATIBLE (TREE_OPERAND (label_value, 0), 1710 TREE_TYPE (TREE_VALUE (tagfields))) 1711 || !CH_COMPATIBLE (TREE_OPERAND (label_value, 1), 1712 TREE_TYPE (TREE_VALUE (tagfields)))) 1713 compat_error = 1; 1714 } 1715 } 1716 else if (TREE_CODE (label_value) == TYPE_DECL) 1717 { 1718 if (!CH_COMPATIBLE (label_value, 1719 TREE_TYPE (TREE_VALUE (tagfields)))) 1720 compat_error = 1; 1721 } 1722 else if (TREE_CODE (label_value) == INTEGER_CST) 1723 { 1724 if (!CH_COMPATIBLE (label_value, 1725 TREE_TYPE (TREE_VALUE (tagfields)))) 1726 compat_error = 1; 1727 } 1728 if (compat_error) 1729 { 1730 if (TYPE_FIELDS (t) == NULL_TREE) 1731 error ("inconsistent modes between labels and tag field"); 1732 else 1733 error_with_decl (TYPE_FIELDS (t), 1734 "inconsistent modes between labels and tag field"); 1735 } 1736 } 1737 } 1738 if (tagfields != NULL_TREE) 1739 error ("too few tag labels"); 1740 if (taglist != NULL_TREE) 1741 error ("too many tag labels"); 1742 } 1743 1744 /* Compute the number of labels to be checked for duplicates. */ 1745 nlabels = 0; 1746 for (decl = first; decl; decl = TREE_CHAIN (decl)) 1747 { 1748 tree t = TREE_TYPE (decl); 1749 /* Only one tag (first case_label_list) supported, for now. */ 1750 tree labellist = TYPE_TAG_VALUES (t); 1751 if (labellist) 1752 labellist = TREE_VALUE (labellist); 1753 1754 for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist)) 1755 if (TREE_CODE (TREE_VALUE (labellist)) == INTEGER_CST) 1756 nlabels++; 1757 } 1758 1759 /* Check for duplicate label values. */ 1760 label_value_array = (struct tree_pair *)alloca (nlabels * sizeof (struct tree_pair)); 1761 for (decl = first; decl; decl = TREE_CHAIN (decl)) 1762 { 1763 tree t = TREE_TYPE (decl); 1764 /* Only one tag (first case_label_list) supported, for now. */ 1765 tree labellist = TYPE_TAG_VALUES (t); 1766 if (labellist) 1767 labellist = TREE_VALUE (labellist); 1768 1769 for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist)) 1770 { 1771 struct tree_pair p; 1772 1773 tree x = TREE_VALUE (labellist); 1774 if (TREE_CODE (x) == RANGE_EXPR) 1775 { 1776 if (TREE_OPERAND (x, 0) != NULL_TREE) 1777 { 1778 if (TREE_CODE (TREE_OPERAND (x, 0)) != INTEGER_CST) 1779 error ("case label lower limit is not a discrete constant expression"); 1780 if (TREE_CODE (TREE_OPERAND (x, 1)) != INTEGER_CST) 1781 error ("case label upper limit is not a discrete constant expression"); 1782 } 1783 continue; 1784 } 1785 else if (TREE_CODE (x) == TYPE_DECL) 1786 continue; 1787 else if (TREE_CODE (x) == ERROR_MARK) 1788 continue; 1789 else if (TREE_CODE (x) != INTEGER_CST) /* <-- FIXME: what about CONST_DECLs? */ 1790 { 1791 error ("case label must be a discrete constant expression"); 1792 continue; 1793 } 1794 1795 if (TREE_CODE (x) == CONST_DECL) 1796 x = DECL_INITIAL (x); 1797 if (TREE_CODE (x) != INTEGER_CST) abort (); 1798 p.value = x; 1799 p.decl = decl; 1800 if (p.decl == NULL_TREE) 1801 p.decl = TREE_VALUE (labellist); 1802 label_value_array[label_index++] = p; 1803 } 1804 } 1805 if (errorcount == 0) 1806 { 1807 int limit; 1808 qsort (label_value_array, 1809 label_index, sizeof (struct tree_pair), label_value_cmp); 1810 limit = label_index - 1; 1811 for (label_index = 0; label_index < limit; label_index++) 1812 { 1813 if (tree_int_cst_equal (label_value_array[label_index].value, 1814 label_value_array[label_index+1].value)) 1815 { 1816 error_with_decl (label_value_array[label_index].decl, 1817 "variant label declared here..."); 1818 error_with_decl (label_value_array[label_index+1].decl, 1819 "...is duplicated here"); 1820 } 1821 } 1822 } 1823 layout_type (utype); 1824 return utype; 1825} 1826 1827/* Convert a TREE_LIST of tag field names into a list of 1828 field decls, found from FIXED_FIELDS, re-using the input list. */ 1829 1830tree 1831lookup_tag_fields (tag_field_names, fixed_fields) 1832 tree tag_field_names; 1833 tree fixed_fields; 1834{ 1835 tree list; 1836 for (list = tag_field_names; list != NULL_TREE; list = TREE_CHAIN (list)) 1837 { 1838 tree decl = fixed_fields; 1839 for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl)) 1840 { 1841 if (DECL_NAME (decl) == TREE_VALUE (list)) 1842 { 1843 TREE_VALUE (list) = decl; 1844 break; 1845 } 1846 } 1847 if (decl == NULL_TREE) 1848 { 1849 error ("no field (yet) for tag %s", 1850 IDENTIFIER_POINTER (TREE_VALUE (list))); 1851 TREE_VALUE (list) = error_mark_node; 1852 } 1853 } 1854 return tag_field_names; 1855} 1856 1857/* If non-NULL, TAGFIELDS is the tag fields for this variant record. 1858 BODY is a TREE_LIST of (optlabels, fixed fields). 1859 If non-null, VARIANTELSE is a fixed field for the else part of the 1860 variant record. */ 1861 1862tree 1863grok_chill_variantdefs (tagfields, body, variantelse) 1864 tree tagfields, body, variantelse; 1865{ 1866 tree t; 1867 1868 t = make_chill_variants (tagfields, body, variantelse); 1869 if (pass != 1) 1870 t = layout_chill_variants (t); 1871 return build_decl (FIELD_DECL, NULL_TREE, t); 1872} 1873 1874/* 1875 In pass 1, PARMS is a list of types (with attributes). 1876 In pass 2, PARMS is a chain of PARM_DECLs. 1877 */ 1878 1879int 1880start_chill_function (label, rtype, parms, exceptlist, attrs) 1881 tree label, rtype, parms, exceptlist, attrs; 1882{ 1883 tree decl, fndecl, type, result_type, func_type; 1884 int nested = current_function_decl != 0; 1885 if (pass == 1) 1886 { 1887 func_type 1888 = build_chill_function_type (rtype, parms, exceptlist, 0); 1889 fndecl = build_decl (FUNCTION_DECL, label, func_type); 1890 1891 save_decl (fndecl); 1892 1893 /* Make the init_value nonzero so pushdecl knows this is not tentative. 1894 error_mark_node is replaced below (in poplevel) with the BLOCK. */ 1895 DECL_INITIAL (fndecl) = error_mark_node; 1896 1897 DECL_EXTERNAL (fndecl) = 0; 1898 1899 /* This function exists in static storage. 1900 (This does not mean `static' in the C sense!) */ 1901 TREE_STATIC (fndecl) = 1; 1902 1903 for (; attrs != NULL_TREE; attrs = TREE_CHAIN (attrs)) 1904 { 1905 if (TREE_VALUE (attrs) == ridpointers[RID_GENERAL]) 1906 CH_DECL_GENERAL (fndecl) = 1; 1907 else if (TREE_VALUE (attrs) == ridpointers[RID_SIMPLE]) 1908 CH_DECL_SIMPLE (fndecl) = 1; 1909 else if (TREE_VALUE (attrs) == ridpointers[RID_RECURSIVE]) 1910 CH_DECL_RECURSIVE (fndecl) = 1; 1911 else if (TREE_VALUE (attrs) == ridpointers[RID_INLINE]) 1912 DECL_INLINE (fndecl) = 1; 1913 else 1914 abort (); 1915 } 1916 } 1917 else /* pass == 2 */ 1918 { 1919 fndecl = get_next_decl (); 1920 if (DECL_NAME (fndecl) != label) 1921 abort (); /* outta sync - got wrong decl */ 1922 func_type = TREE_TYPE (fndecl); 1923 if (TYPE_RAISES_EXCEPTIONS (func_type) != NULL_TREE) 1924 { 1925 /* In this case we have to add 2 parameters. 1926 See build_chill_function_type (pass == 1). */ 1927 tree arg; 1928 1929 arg = make_node (PARM_DECL); 1930 DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_FILE); 1931 DECL_IGNORED_P (arg) = 1; 1932 parms = chainon (parms, arg); 1933 1934 arg = make_node (PARM_DECL); 1935 DECL_ASSEMBLER_NAME (arg) = DECL_NAME (arg) = get_identifier (CALLER_LINE); 1936 DECL_IGNORED_P (arg) = 1; 1937 parms = chainon (parms, arg); 1938 } 1939 } 1940 1941 current_function_decl = fndecl; 1942 result_type = TREE_TYPE (func_type); 1943 if (CH_TYPE_NONVALUE_P (result_type)) 1944 error ("non-value mode may only returned by LOC"); 1945 1946 pushlevel (1); /* Push parameters. */ 1947 1948 if (pass == 2) 1949 { 1950 DECL_ARGUMENTS (fndecl) = parms; 1951 for (decl = DECL_ARGUMENTS (fndecl), type = TYPE_ARG_TYPES (func_type); 1952 decl != NULL_TREE; 1953 decl = TREE_CHAIN (decl), type = TREE_CHAIN (type)) 1954 { 1955 /* check here that modes with the non-value property (like 1956 BUFFER's, EVENT's, ASSOCIATION's, ACCESS's, or TEXT's) only 1957 gets passed by LOC */ 1958 tree argtype = TREE_VALUE (type); 1959 tree argattr = TREE_PURPOSE (type); 1960 1961 if (TREE_CODE (argtype) == REFERENCE_TYPE) 1962 argtype = TREE_TYPE (argtype); 1963 1964 if (TREE_CODE (argtype) != ERROR_MARK && 1965 TREE_CODE_CLASS (TREE_CODE (argtype)) != 't') 1966 { 1967 error_with_decl (decl, "mode of `%s' is not a mode"); 1968 TREE_VALUE (type) = error_mark_node; 1969 } 1970 1971 if (CH_TYPE_NONVALUE_P (argtype) && 1972 argattr != ridpointers[(int) RID_LOC]) 1973 error_with_decl (decl, "`%s' may only be passed by LOC"); 1974 TREE_TYPE (decl) = TREE_VALUE (type); 1975 DECL_ARG_TYPE (decl) = TREE_TYPE (decl); 1976 DECL_CONTEXT (decl) = fndecl; 1977 TREE_READONLY (decl) = TYPE_READONLY (argtype); 1978 layout_decl (decl, 0); 1979 } 1980 1981 pushdecllist (DECL_ARGUMENTS (fndecl), 0); 1982 1983 DECL_RESULT (current_function_decl) 1984 = build_decl (RESULT_DECL, NULL_TREE, result_type); 1985 1986#if 0 1987 /* Write a record describing this function definition to the prototypes 1988 file (if requested). */ 1989 gen_aux_info_record (fndecl, 1, 0, prototype); 1990#endif 1991 1992 if (fndecl != global_function_decl || seen_action) 1993 { 1994 /* Initialize the RTL code for the function. */ 1995 init_function_start (fndecl, input_filename, lineno); 1996 1997 /* Set up parameters and prepare for return, for the function. */ 1998 expand_function_start (fndecl, 0); 1999 } 2000 2001 if (!nested) 2002 /* Allocate further tree nodes temporarily during compilation 2003 of this function only. */ 2004 temporary_allocation (); 2005 2006 /* If this fcn was already referenced via a block-scope `extern' decl (or 2007 an implicit decl), propagate certain information about the usage. */ 2008 if (TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (current_function_decl))) 2009 TREE_ADDRESSABLE (current_function_decl) = 1; 2010 } 2011 2012 /* Z.200 requires that formal parameter names be defined in 2013 the same block as the procedure body. 2014 We could do this by keeping boths sets of DECLs in the same 2015 scope, but we would have to be careful to not merge the 2016 two chains (e.g. DECL_ARGUEMENTS musr not contains locals). 2017 Instead, we just make sure they have the same nesting_level. */ 2018 current_nesting_level--; 2019 pushlevel (1); /* Push local variables. */ 2020 2021 if (pass == 2 && (fndecl != global_function_decl || seen_action)) 2022 { 2023 /* generate label for possible 'exit' */ 2024 expand_start_bindings (1); 2025 2026 result_never_set = 1; 2027 } 2028 2029 if (TREE_CODE (result_type) == VOID_TYPE) 2030 chill_result_decl = NULL_TREE; 2031 else 2032 { 2033 /* We use the same name as the keyword. 2034 This makes it easy to print and change the RESULT from gdb. */ 2035 char *result_str = (ignore_case || ! special_UC) ? "result" : "RESULT"; 2036 if (pass == 2 && TREE_CODE (result_type) == ERROR_MARK) 2037 TREE_TYPE (current_scope->remembered_decls) = result_type; 2038 chill_result_decl = do_decl (get_identifier (result_str), 2039 result_type, 0, 0, 0, 0); 2040 DECL_CONTEXT (chill_result_decl) = fndecl; 2041 } 2042 2043 return 1; 2044} 2045 2046/* For checking purpose added pname as new argument 2047 MW Wed Oct 14 14:22:10 1992 */ 2048void 2049finish_chill_function () 2050{ 2051 register tree fndecl = current_function_decl; 2052 tree outer_function = decl_function_context (fndecl); 2053 int nested; 2054 if (outer_function == NULL_TREE && fndecl != global_function_decl) 2055 outer_function = global_function_decl; 2056 nested = current_function_decl != global_function_decl; 2057 if (pass == 2 && (fndecl != global_function_decl || seen_action)) 2058 expand_end_bindings (getdecls (), 1, 0); 2059 2060 /* pop out of function */ 2061 poplevel (1, 1, 0); 2062 current_nesting_level++; 2063 /* pop out of its parameters */ 2064 poplevel (1, 0, 1); 2065 2066 if (pass == 2) 2067 { 2068 /* TREE_READONLY (fndecl) = 1; 2069 This caused &foo to be of type ptr-to-const-function which 2070 then got a warning when stored in a ptr-to-function variable. */ 2071 2072 BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl; 2073 2074 /* Must mark the RESULT_DECL as being in this function. */ 2075 2076 DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl; 2077 2078 if (fndecl != global_function_decl || seen_action) 2079 { 2080 /* Generate rtl for function exit. */ 2081 expand_function_end (input_filename, lineno, 0); 2082 2083 /* So we can tell if jump_optimize sets it to 1. */ 2084 can_reach_end = 0; 2085 2086 /* Run the optimizers and output assembler code for this function. */ 2087 rest_of_compilation (fndecl); 2088 } 2089 2090 if (DECL_SAVED_INSNS (fndecl) == 0 && ! nested) 2091 { 2092 /* Stop pointing to the local nodes about to be freed. */ 2093 /* But DECL_INITIAL must remain nonzero so we know this 2094 was an actual function definition. */ 2095 /* For a nested function, this is done in pop_chill_function_context. */ 2096 DECL_INITIAL (fndecl) = error_mark_node; 2097 DECL_ARGUMENTS (fndecl) = 0; 2098 } 2099 } 2100 current_function_decl = outer_function; 2101} 2102 2103/* process SEIZE */ 2104 2105/* Points to the head of the _DECLs read from seize files. */ 2106#if 0 2107static tree seized_decls; 2108 2109static tree processed_seize_files = 0; 2110#endif 2111 2112void 2113chill_seize (old_prefix, new_prefix, postfix) 2114 tree old_prefix, new_prefix, postfix; 2115{ 2116 if (pass == 1) 2117 { 2118 tree decl = build_alias_decl (old_prefix, new_prefix, postfix); 2119 DECL_SEIZEFILE(decl) = use_seizefile_name; 2120 save_decl (decl); 2121 } 2122 else /* pass == 2 */ 2123 { 2124 /* Do nothing - get_next_decl automatically ignores ALIAS_DECLs */ 2125 } 2126} 2127#if 0 2128 2129/* 2130 * output a debug dump of a scope structure 2131 */ 2132void 2133debug_scope (sp) 2134 struct scope *sp; 2135{ 2136 if (sp == (struct scope *)NULL) 2137 { 2138 fprintf (stderr, "null scope ptr\n"); 2139 return; 2140 } 2141 fprintf (stderr, "enclosing 0x%x ", sp->enclosing); 2142 fprintf (stderr, "next 0x%x ", sp->next); 2143 fprintf (stderr, "remembered_decls 0x%x ", sp->remembered_decls); 2144 fprintf (stderr, "decls 0x%x\n", sp->decls); 2145 fprintf (stderr, "shadowed 0x%x ", sp->shadowed); 2146 fprintf (stderr, "blocks 0x%x ", sp->blocks); 2147 fprintf (stderr, "this_block 0x%x ", sp->this_block); 2148 fprintf (stderr, "level_chain 0x%x\n", sp->level_chain); 2149 fprintf (stderr, "module_flag %c ", sp->module_flag ? 'T' : 'F'); 2150 fprintf (stderr, "first_child_module 0x%x ", sp->first_child_module); 2151 fprintf (stderr, "next_sibling_module 0x%x\n", sp->next_sibling_module); 2152 if (sp->remembered_decls != NULL_TREE) 2153 { 2154 tree temp; 2155 fprintf (stderr, "remembered_decl chain:\n"); 2156 for (temp = sp->remembered_decls; temp; temp = TREE_CHAIN (temp)) 2157 debug_tree (temp); 2158 } 2159} 2160#endif 2161 2162static void 2163save_decl (decl) 2164 tree decl; 2165{ 2166 if (current_function_decl != global_function_decl) 2167 DECL_CONTEXT (decl) = current_function_decl; 2168 2169 TREE_CHAIN (decl) = current_scope->remembered_decls; 2170 current_scope->remembered_decls = decl; 2171#if 0 2172 fprintf (stderr, "\n\nsave_decl 0x%x\n", decl); 2173 debug_scope (current_scope); /* ************* */ 2174#endif 2175 set_nesting_level (decl, current_nesting_level); 2176} 2177 2178static tree 2179get_next_decl () 2180{ 2181 tree decl; 2182 do 2183 { 2184 decl = current_scope->remembered_decls; 2185 current_scope->remembered_decls = TREE_CHAIN (decl); 2186 /* We ignore ALIAS_DECLs, because push_scope_decls 2187 can convert a single ALIAS_DECL representing 'SEIZE ALL' 2188 into one ALIAS_DECL for each seizeable name. 2189 This means we lose the nice one-to-one mapping 2190 between pass 1 decls and pass 2 decls. 2191 (Perhaps ALIAS_DECLs should not be on the remembered_decls list.) */ 2192 } while (decl && TREE_CODE (decl) == ALIAS_DECL); 2193 return decl; 2194} 2195 2196/* At the end of pass 1, we reverse the chronological chain of scopes. */ 2197 2198void 2199switch_to_pass_2 () 2200{ 2201#if 0 2202 extern int errorcount, sorrycount; 2203#endif 2204 if (current_scope != &builtin_scope) 2205 abort (); 2206 last_scope = &builtin_scope; 2207 builtin_scope.remembered_decls = nreverse (builtin_scope.remembered_decls); 2208 write_grant_file (); 2209 2210#if 0 2211 if (errorcount || sorrycount) 2212 exit (FATAL_EXIT_CODE); 2213 else 2214#endif 2215 if (grant_only_flag) 2216 exit (SUCCESS_EXIT_CODE); 2217 2218 pass = 2; 2219 module_number = 0; 2220 next_module = &first_module; 2221} 2222 2223/* 2224 * Called during pass 2, when we're processing actions, to 2225 * generate a temporary variable. These don't need satisfying 2226 * because they're compiler-generated and always declared 2227 * before they're used. 2228 */ 2229tree 2230decl_temp1 (name, type, opt_static, opt_init, 2231 opt_external, opt_public) 2232 tree name, type; 2233 int opt_static; 2234 tree opt_init; 2235 int opt_external, opt_public; 2236{ 2237 int orig_pass = pass; /* be cautious */ 2238 tree mydecl; 2239 2240 pass = 1; 2241 mydecl = do_decl (name, type, opt_static, opt_static, 2242 opt_init, opt_external); 2243 2244 if (opt_public) 2245 TREE_PUBLIC (mydecl) = 1; 2246 pass = 2; 2247 do_decl (name, type, opt_static, opt_static, opt_init, opt_external); 2248 2249 pass = orig_pass; 2250 return mydecl; 2251} 2252 2253/* True if we're reading a seizefile, but we haven't seen a SPEC MODULE yet. 2254 For backwards compatibility, we treat declarations in such a context 2255 as implicity granted. */ 2256 2257tree 2258set_module_name (name) 2259 tree name; 2260{ 2261 module_number++; 2262 if (name == NULL_TREE) 2263 { 2264 /* NOTE: build_prefix_clause assumes a generated 2265 module starts with a '_'. */ 2266 char buf[20]; 2267 sprintf (buf, "_MODULE_%d", module_number); 2268 name = get_identifier (buf); 2269 } 2270 return name; 2271} 2272 2273tree 2274push_module (name, is_spec_module) 2275 tree name; 2276 int is_spec_module; 2277{ 2278 struct module *new_module; 2279 if (pass == 1) 2280 { 2281 new_module = (struct module*) permalloc (sizeof (struct module)); 2282 new_module->prev_module = current_module; 2283 2284 *next_module = new_module; 2285 } 2286 else 2287 { 2288 new_module = *next_module; 2289 } 2290 next_module = &new_module->next_module; 2291 2292 new_module->procedure_seen = 0; 2293 new_module->is_spec_module = is_spec_module; 2294 new_module->name = name; 2295 if (current_module) 2296 new_module->prefix_name 2297 = get_identifier3 (IDENTIFIER_POINTER (current_module->prefix_name), 2298 "__", IDENTIFIER_POINTER (name)); 2299 else 2300 new_module->prefix_name = name; 2301 2302 new_module->granted_decls = NULL_TREE; 2303 new_module->nesting_level = current_nesting_level + 1; 2304 2305 current_module = new_module; 2306 current_module_nesting_level = new_module->nesting_level; 2307 in_pseudo_module = name ? 0 : 1; 2308 2309 pushlevel (1); 2310 2311 current_scope->module_flag = 1; 2312 2313 *current_scope->enclosing->tail_child_module = current_scope; 2314 current_scope->enclosing->tail_child_module 2315 = ¤t_scope->next_sibling_module; 2316 2317 /* Rename the global function to have the same name as 2318 the first named non-spec module. */ 2319 if (!is_spec_module 2320 && IDENTIFIER_POINTER (name)[0] != '_' 2321 && IDENTIFIER_POINTER (DECL_NAME (global_function_decl))[0] == '_') 2322 { 2323 tree fname = get_identifier3 ("", IDENTIFIER_POINTER (name), "_"); 2324 DECL_NAME (global_function_decl) = fname; 2325 DECL_ASSEMBLER_NAME (global_function_decl) = fname; 2326 } 2327 2328 return name; /* may have generated a name */ 2329} 2330/* Make a copy of the identifier NAME, replacing each '!' by '__'. */ 2331tree 2332fix_identifier (name) 2333 tree name; 2334{ 2335 char *buf = (char*)alloca (2 * IDENTIFIER_LENGTH (name) + 1); 2336 int fixed = 0; 2337 register char *dptr = buf; 2338 register char *sptr = IDENTIFIER_POINTER (name); 2339 for (; *sptr; sptr++) 2340 { 2341 if (*sptr == '!') 2342 { 2343 *dptr++ = '_'; 2344 *dptr++ = '_'; 2345 fixed++; 2346 } 2347 else 2348 *dptr++ = *sptr; 2349 } 2350 *dptr = '\0'; 2351 return fixed ? get_identifier (buf) : name; 2352} 2353 2354void 2355find_granted_decls () 2356{ 2357 if (pass == 1) 2358 { 2359 /* Match each granted name to a granted decl. */ 2360 2361 tree alias = current_module->granted_decls; 2362 tree next_alias, decl; 2363 /* This is an O(M*N) algorithm. FIXME! */ 2364 for (; alias; alias = next_alias) 2365 { 2366 int found = 0; 2367 next_alias = TREE_CHAIN (alias); 2368 for (decl = current_scope->remembered_decls; 2369 decl; decl = TREE_CHAIN (decl)) 2370 { 2371 tree new_name = (! DECL_NAME (decl)) ? NULL_TREE : 2372 decl_check_rename (alias, 2373 DECL_NAME (decl)); 2374 2375 if (!new_name) 2376 continue; 2377 /* A Seized declaration is not grantable. */ 2378 if (TREE_CODE (decl) == ALIAS_DECL && !CH_DECL_GRANTED (decl)) 2379 continue; 2380 found = 1; 2381 if (global_bindings_p ()) 2382 TREE_PUBLIC (decl) = 1; 2383 if (DECL_ASSEMBLER_NAME (decl) == NULL_TREE) 2384 DECL_ASSEMBLER_NAME (decl) = fix_identifier (new_name); 2385 if (DECL_POSTFIX_ALL (alias)) 2386 { 2387 tree new_alias 2388 = build_alias_decl (NULL_TREE, NULL_TREE, new_name); 2389 TREE_CHAIN (new_alias) = TREE_CHAIN (alias); 2390 TREE_CHAIN (alias) = new_alias; 2391 DECL_ABSTRACT_ORIGIN (new_alias) = decl; 2392 DECL_SOURCE_LINE (new_alias) = 0; 2393 DECL_SEIZEFILE (new_alias) = DECL_SEIZEFILE (alias); 2394 } 2395 else 2396 { 2397 DECL_ABSTRACT_ORIGIN (alias) = decl; 2398 break; 2399 } 2400 } 2401 if (!found) 2402 { 2403 error_with_decl (alias, "Nothing named `%s' to grant."); 2404 DECL_ABSTRACT_ORIGIN (alias) = error_mark_node; 2405 } 2406 } 2407 } 2408} 2409 2410void 2411pop_module () 2412{ 2413 tree decl; 2414 struct scope *module_scope = current_scope; 2415 2416 poplevel (0, 0, 0); 2417 2418 if (pass == 1) 2419 { 2420 /* Write out the grant file. */ 2421 if (!current_module->is_spec_module) 2422 { 2423 /* After reversal, TREE_CHAIN (last_old_decl) is the oldest 2424 decl of the current module. */ 2425 write_spec_module (module_scope->remembered_decls, 2426 current_module->granted_decls); 2427 } 2428 2429 /* Move the granted decls into the enclosing scope. */ 2430 if (current_scope == global_scope) 2431 { 2432 tree next_decl; 2433 for (decl = current_module->granted_decls; decl; decl = next_decl) 2434 { 2435 tree name = DECL_NAME (decl); 2436 next_decl = TREE_CHAIN (decl); 2437 if (name != NULL_TREE) 2438 { 2439 tree old_decl = IDENTIFIER_OUTER_VALUE (name); 2440 set_nesting_level (decl, current_nesting_level); 2441 if (old_decl != NULL_TREE) 2442 { 2443 pedwarn_with_decl (decl, "duplicate grant for `%s'"); 2444 pedwarn_with_decl (old_decl, "previous grant for `%s'"); 2445 TREE_CHAIN (decl) = TREE_CHAIN (old_decl); 2446 TREE_CHAIN (old_decl) = decl; 2447 } 2448 else 2449 { 2450 TREE_CHAIN (decl) = outer_decls; 2451 outer_decls = decl; 2452 IDENTIFIER_OUTER_VALUE (name) = decl; 2453 } 2454 } 2455 } 2456 } 2457 else 2458 current_scope->granted_decls = chainon (current_module->granted_decls, 2459 current_scope->granted_decls); 2460 } 2461 2462 chill_check_no_handlers (); /* Sanity test */ 2463 current_module = current_module->prev_module; 2464 current_module_nesting_level = current_module ? 2465 current_module->nesting_level : 0; 2466 in_pseudo_module = 0; 2467} 2468 2469/* Nonzero if we are currently in the global binding level. */ 2470 2471int 2472global_bindings_p () 2473{ 2474 /* We return -1 here for the sake of variable_size() in ../stor-layout.c. */ 2475 return (current_function_decl == NULL_TREE 2476 || current_function_decl == global_function_decl) ? -1 : 0; 2477} 2478 2479/* Nonzero if the current level needs to have a BLOCK made. */ 2480 2481int 2482kept_level_p () 2483{ 2484 return current_scope->decls != 0; 2485} 2486 2487/* Make DECL visible. 2488 Save any existing definition. 2489 Check redefinitions at the same level. 2490 Suppress error messages if QUIET is true. */ 2491 2492void 2493proclaim_decl (decl, quiet) 2494 tree decl; 2495 int quiet; 2496{ 2497 tree name = DECL_NAME (decl); 2498 if (name) 2499 { 2500 tree old_decl = IDENTIFIER_LOCAL_VALUE (name); 2501 if (old_decl == NULL) ; /* No duplication */ 2502 else if (DECL_NESTING_LEVEL (old_decl) != current_nesting_level) 2503 { 2504 /* Record for restoration when this binding level ends. */ 2505 current_scope->shadowed 2506 = tree_cons (name, old_decl, current_scope->shadowed); 2507 } 2508 else if (DECL_WEAK_NAME (decl)) 2509 return; 2510 else if (!DECL_WEAK_NAME (old_decl)) 2511 { 2512 tree base_decl = decl, base_old_decl = old_decl; 2513 while (TREE_CODE (base_decl) == ALIAS_DECL) 2514 base_decl = DECL_ABSTRACT_ORIGIN (base_decl); 2515 while (TREE_CODE (base_old_decl) == ALIAS_DECL) 2516 base_old_decl = DECL_ABSTRACT_ORIGIN (base_old_decl); 2517 /* Note that duplicate definitions are allowed for set elements 2518 of similar set modes. See Z200 (1988) 12.2.2. 2519 However, if the types are identical, we are defining the 2520 same name multiple times in the same SET, which is naughty. */ 2521 if (!quiet && base_decl != base_old_decl) 2522 { 2523 if (TREE_CODE (base_decl) != CONST_DECL 2524 || TREE_CODE (base_old_decl) != CONST_DECL 2525 || !CH_DECL_ENUM (base_decl) 2526 || !CH_DECL_ENUM (base_old_decl) 2527 || TREE_TYPE (base_decl) == TREE_TYPE (base_old_decl) 2528 || !CH_SIMILAR (TREE_TYPE (base_decl), 2529 TREE_TYPE(base_old_decl))) 2530 { 2531 error_with_decl (decl, "duplicate definition `%s'"); 2532 error_with_decl (old_decl, "previous definition of `%s'"); 2533 } 2534 } 2535 } 2536 IDENTIFIER_LOCAL_VALUE (name) = decl; 2537 } 2538 /* Should be redundant most of the time ... */ 2539 set_nesting_level (decl, current_nesting_level); 2540} 2541 2542/* Return tree_cons (NULL_TREE, ELEMENT, LIST) unless ELEMENT 2543 is already in LIST, in which case return LIST. */ 2544 2545static tree 2546maybe_acons (element, list) 2547 tree element, list; 2548{ 2549 tree pair; 2550 for (pair = list; pair; pair = TREE_CHAIN (pair)) 2551 if (element == TREE_VALUE (pair)) 2552 return list; 2553 return tree_cons (NULL_TREE, element, list); 2554} 2555 2556struct path 2557{ 2558 struct path *prev; 2559 tree node; 2560}; 2561 2562/* Look for implied types (enumeral types) implied by TYPE (a decl or type). 2563 Add these to list. 2564 Use old_path to guard against cycles. */ 2565 2566tree 2567find_implied_types (type, old_path, list) 2568 tree type; 2569 struct path *old_path; 2570 tree list; 2571{ 2572 struct path path[1], *link; 2573 if (type == NULL_TREE) 2574 return list; 2575 path[0].prev = old_path; 2576 path[0].node = type; 2577 2578 /* Check for a cycle. Something more clever might be appropriate. FIXME? */ 2579 for (link = old_path; link; link = link->prev) 2580 if (link->node == type) 2581 return list; 2582 2583 switch (TREE_CODE (type)) 2584 { 2585 case ENUMERAL_TYPE: 2586 return maybe_acons (type, list); 2587 case LANG_TYPE: 2588 case POINTER_TYPE: 2589 case REFERENCE_TYPE: 2590 case INTEGER_TYPE: 2591 return find_implied_types (TREE_TYPE (type), path, list); 2592 case SET_TYPE: 2593 return find_implied_types (TYPE_DOMAIN (type), path, list); 2594 case FUNCTION_TYPE: 2595#if 0 2596 case PROCESS_TYPE: 2597#endif 2598 { tree t; 2599 list = find_implied_types (TREE_TYPE (type), path, list); 2600 for (t = TYPE_ARG_TYPES (type); t != NULL_TREE; t = TREE_CHAIN (t)) 2601 list = find_implied_types (TREE_VALUE (t), path, list); 2602 return list; 2603 } 2604 case ARRAY_TYPE: 2605 list = find_implied_types (TYPE_DOMAIN (type), path, list); 2606 return find_implied_types (TREE_TYPE (type), path, list); 2607 case RECORD_TYPE: 2608 case UNION_TYPE: 2609 { tree fields; 2610 for (fields = TYPE_FIELDS (type); fields != NULL_TREE; 2611 fields = TREE_CHAIN (fields)) 2612 list = find_implied_types (TREE_TYPE (fields), path, list); 2613 return list; 2614 } 2615 2616 case IDENTIFIER_NODE: 2617 return find_implied_types (lookup_name (type), path, list); 2618 break; 2619 case ALIAS_DECL: 2620 return find_implied_types (DECL_ABSTRACT_ORIGIN (type), path, list); 2621 case VAR_DECL: 2622 case FUNCTION_DECL: 2623 case TYPE_DECL: 2624 return find_implied_types (TREE_TYPE (type), path, list); 2625 default: 2626 return list; 2627 } 2628} 2629 2630/* Make declarations in current scope visible. 2631 Also, expand SEIZEs, and make correspondong ALIAS_DECLs visible. */ 2632 2633static void 2634push_scope_decls (quiet) 2635 int quiet; /* If 1, we're pre-scanning, so suppress errors. */ 2636{ 2637 tree decl; 2638 2639 /* First make everything except 'SEIZE ALL' names visible, before 2640 handling 'SEIZE ALL'. (This makes it easier to check 'seizable'). */ 2641 for (decl = current_scope->remembered_decls; decl; decl = TREE_CHAIN (decl)) 2642 { 2643 if (TREE_CODE (decl) == ALIAS_DECL) 2644 { 2645 if (DECL_POSTFIX_ALL (decl)) 2646 continue; 2647 if (DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE) 2648 { 2649 tree val = lookup_name_for_seizing (decl); 2650 if (val == NULL_TREE) 2651 { 2652 error_with_file_and_line 2653 (DECL_SOURCE_FILE (decl), DECL_SOURCE_LINE (decl), 2654 "cannot SEIZE `%s'", 2655 IDENTIFIER_POINTER (DECL_OLD_NAME (decl))); 2656 val = error_mark_node; 2657 } 2658 DECL_ABSTRACT_ORIGIN (decl) = val; 2659 } 2660 } 2661 proclaim_decl (decl, quiet); 2662 } 2663 2664 pushdecllist (current_scope->granted_decls, quiet); 2665 2666 /* Now handle SEIZE ALLs. */ 2667 for (decl = current_scope->remembered_decls; decl; ) 2668 { 2669 tree next_decl = TREE_CHAIN (decl); 2670 if (TREE_CODE (decl) == ALIAS_DECL 2671 && DECL_ABSTRACT_ORIGIN (decl) == NULL_TREE 2672 && DECL_POSTFIX_ALL (decl)) 2673 { 2674 /* We saw a "SEIZE ALL". Replace it be a SEIZE for each 2675 declaration visible in the surrounding scope. 2676 Note that this complicates get_next_decl(). */ 2677 tree candidate; 2678 tree last_new_alias = decl; 2679 DECL_ABSTRACT_ORIGIN (decl) = error_mark_node; 2680 if (current_scope->enclosing == global_scope) 2681 candidate = outer_decls; 2682 else 2683 candidate = current_scope->enclosing->decls; 2684 for ( ; candidate; candidate = TREE_CHAIN (candidate)) 2685 { 2686 tree seizename = DECL_NAME (candidate); 2687 tree new_name; 2688 tree new_alias; 2689 if (!seizename) 2690 continue; 2691 new_name = decl_check_rename (decl, seizename); 2692 if (!new_name) 2693 continue; 2694 2695 /* Check if candidate is seizable. */ 2696 if (lookup_name (new_name) != NULL_TREE) 2697 continue; 2698 2699 new_alias = build_alias_decl (NULL_TREE,NULL_TREE, new_name); 2700 TREE_CHAIN (new_alias) = TREE_CHAIN (last_new_alias); 2701 TREE_CHAIN (last_new_alias) = new_alias; 2702 last_new_alias = new_alias; 2703 DECL_ABSTRACT_ORIGIN (new_alias) = candidate; 2704 DECL_SOURCE_LINE (new_alias) = 0; 2705 2706 proclaim_decl (new_alias, quiet); 2707 } 2708 } 2709 decl = next_decl; 2710 } 2711 2712 /* Link current_scope->remembered_decls at the head of the 2713 current_scope->decls list (just like pushdecllist, but 2714 without calling proclaim_decl, since we've already done that). */ 2715 if ((decl = current_scope->remembered_decls) != NULL_TREE) 2716 { 2717 while (TREE_CHAIN (decl) != NULL_TREE) 2718 decl = TREE_CHAIN (decl); 2719 TREE_CHAIN (decl) = current_scope->decls; 2720 current_scope->decls = current_scope->remembered_decls; 2721 } 2722} 2723 2724static void 2725pop_scope_decls (decls_limit, shadowed_limit) 2726 tree decls_limit, shadowed_limit; 2727{ 2728 /* Remove the temporary bindings we made. */ 2729 tree link = current_scope->shadowed; 2730 tree decl = current_scope->decls; 2731 if (decl != decls_limit) 2732 { 2733 while (decl != decls_limit) 2734 { 2735 tree next = TREE_CHAIN (decl); 2736 if (DECL_NAME (decl)) 2737 { 2738 /* If the ident. was used or addressed via a local extern decl, 2739 don't forget that fact. */ 2740 if (DECL_EXTERNAL (decl)) 2741 { 2742 if (TREE_USED (decl)) 2743 TREE_USED (DECL_NAME (decl)) = 1; 2744 if (TREE_ADDRESSABLE (decl)) 2745 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (decl)) = 1; 2746 } 2747 IDENTIFIER_LOCAL_VALUE (DECL_NAME (decl)) = 0; 2748 } 2749 if (next == decls_limit) 2750 { 2751 TREE_CHAIN (decl) = NULL_TREE; 2752 break; 2753 } 2754 decl = next; 2755 } 2756 current_scope->decls = decls_limit; 2757 } 2758 2759 /* Restore all name-meanings of the outer levels 2760 that were shadowed by this level. */ 2761 for ( ; link != shadowed_limit; link = TREE_CHAIN (link)) 2762 IDENTIFIER_LOCAL_VALUE (TREE_PURPOSE (link)) = TREE_VALUE (link); 2763 current_scope->shadowed = shadowed_limit; 2764} 2765 2766/* Return list of weak names (as ALIAS_DECLs) implied by IMPLIED_TYPES. */ 2767 2768static tree 2769build_implied_names (implied_types) 2770 tree implied_types; 2771{ 2772 tree aliases = NULL_TREE; 2773 2774 for ( ; implied_types; implied_types = TREE_CHAIN (implied_types)) 2775 { 2776 tree enum_type = TREE_VALUE (implied_types); 2777 tree link = TYPE_VALUES (enum_type); 2778 if (TREE_CODE (enum_type) != ENUMERAL_TYPE) 2779 abort (); 2780 2781 for ( ; link; link = TREE_CHAIN (link)) 2782 { 2783 /* We don't handle renaming/prefixes (Blue Book p 163) FIXME */ 2784 /* Note that before enum_type is laid out, TREE_VALUE (link) 2785 is a CONST_DECL, while after it is laid out, 2786 TREE_VALUE (link) is an INTEGER_CST. Either works. */ 2787 tree alias 2788 = build_alias_decl (NULL_TREE, NULL_TREE, TREE_PURPOSE (link)); 2789 DECL_ABSTRACT_ORIGIN (alias) = TREE_VALUE (link); 2790 DECL_WEAK_NAME (alias) = 1; 2791 TREE_CHAIN (alias) = aliases; 2792 aliases = alias; 2793 /* Strictlt speaking, we should have a pointer from the alias 2794 to the decl, so we can make sure that the alias is only 2795 visible when the decl is. FIXME */ 2796 } 2797 } 2798 return aliases; 2799} 2800 2801static void 2802bind_sub_modules (do_weak) 2803 int do_weak; 2804{ 2805 tree decl; 2806 int save_module_nesting_level = current_module_nesting_level; 2807 struct scope *saved_scope = current_scope; 2808 struct scope *nested_module = current_scope->first_child_module; 2809 2810 while (nested_module != NULL) 2811 { 2812 tree saved_shadowed = nested_module->shadowed; 2813 tree saved_decls = nested_module->decls; 2814 current_nesting_level++; 2815 current_scope = nested_module; 2816 current_module_nesting_level = current_nesting_level; 2817 if (do_weak == 0) 2818 push_scope_decls (1); 2819 else 2820 { 2821 tree implied_types = NULL_TREE; 2822 /* Push weak names implied by decls in current_scope. */ 2823 for (decl = current_scope->remembered_decls; 2824 decl; decl = TREE_CHAIN (decl)) 2825 if (TREE_CODE (decl) == ALIAS_DECL) 2826 implied_types = find_implied_types (decl, NULL, implied_types); 2827 for (decl = current_scope->granted_decls; 2828 decl; decl = TREE_CHAIN (decl)) 2829 implied_types = find_implied_types (decl, NULL, implied_types); 2830 current_scope->weak_decls = build_implied_names (implied_types); 2831 pushdecllist (current_scope->weak_decls, 1); 2832 } 2833 2834 bind_sub_modules (do_weak); 2835 for (decl = current_scope->remembered_decls; 2836 decl; decl = TREE_CHAIN (decl)) 2837 satisfy_decl (decl, 1); 2838 pop_scope_decls (saved_decls, saved_shadowed); 2839 current_nesting_level--; 2840 nested_module = nested_module->next_sibling_module; 2841 } 2842 2843 current_scope = saved_scope; 2844 current_module_nesting_level = save_module_nesting_level; 2845} 2846 2847/* Enter a new binding level. 2848 If two_pass==0, assume we are called from non-Chill-specific parts 2849 of the compiler. These parts assume a single pass. 2850 If two_pass==1, we're called from Chill parts of the compiler. 2851*/ 2852 2853void 2854pushlevel (two_pass) 2855 int two_pass; 2856{ 2857 register struct scope *newlevel; 2858 2859 current_nesting_level++; 2860 if (!two_pass) 2861 { 2862 newlevel = (struct scope *)xmalloc (sizeof(struct scope)); 2863 *newlevel = clear_scope; 2864 newlevel->enclosing = current_scope; 2865 current_scope = newlevel; 2866 } 2867 else if (pass < 2) 2868 { 2869 newlevel = (struct scope *)permalloc (sizeof(struct scope)); 2870 *newlevel = clear_scope; 2871 newlevel->tail_child_module = &newlevel->first_child_module; 2872 newlevel->enclosing = current_scope; 2873 current_scope = newlevel; 2874 last_scope->next = newlevel; 2875 last_scope = newlevel; 2876 } 2877 else /* pass == 2 */ 2878 { 2879 tree decl; 2880 newlevel = current_scope = last_scope = last_scope->next; 2881 2882 push_scope_decls (0); 2883 pushdecllist (current_scope->weak_decls, 0); 2884 2885 /* If this is not a module scope, scan ahead for locally nested 2886 modules. (If this is a module, that's already done.) */ 2887 if (!current_scope->module_flag) 2888 { 2889 bind_sub_modules (0); 2890 bind_sub_modules (1); 2891 } 2892 2893 for (decl = current_scope->remembered_decls; 2894 decl; decl = TREE_CHAIN (decl)) 2895 satisfy_decl (decl, 0); 2896 } 2897 2898 /* Add this level to the front of the chain (stack) of levels that 2899 are active. */ 2900 2901 newlevel->level_chain = current_scope; 2902 current_scope = newlevel; 2903 2904 newlevel->two_pass = two_pass; 2905} 2906 2907/* Exit a binding level. 2908 Pop the level off, and restore the state of the identifier-decl mappings 2909 that were in effect when this level was entered. 2910 2911 If KEEP is nonzero, this level had explicit declarations, so 2912 and create a "block" (a BLOCK node) for the level 2913 to record its declarations and subblocks for symbol table output. 2914 2915 If FUNCTIONBODY is nonzero, this level is the body of a function, 2916 so create a block as if KEEP were set and also clear out all 2917 label names. 2918 2919 If REVERSE is nonzero, reverse the order of decls before putting 2920 them into the BLOCK. */ 2921 2922tree 2923poplevel (keep, reverse, functionbody) 2924 int keep; 2925 int reverse; 2926 int functionbody; 2927{ 2928 register tree link; 2929 /* The chain of decls was accumulated in reverse order. 2930 Put it into forward order, just for cleanliness. */ 2931 tree decls; 2932 tree subblocks; 2933 tree block = 0; 2934 tree decl; 2935 int block_previously_created = 0; 2936 2937 if (current_scope == NULL) 2938 return error_mark_node; 2939 2940 subblocks = current_scope->blocks; 2941 2942 /* Get the decls in the order they were written. 2943 Usually current_scope->decls is in reverse order. 2944 But parameter decls were previously put in forward order. */ 2945 2946 if (reverse) 2947 current_scope->decls 2948 = decls = nreverse (current_scope->decls); 2949 else 2950 decls = current_scope->decls; 2951 2952 if (pass == 2) 2953 { 2954 /* Output any nested inline functions within this block 2955 if they weren't already output. */ 2956 2957 for (decl = decls; decl; decl = TREE_CHAIN (decl)) 2958 if (TREE_CODE (decl) == FUNCTION_DECL 2959 && ! TREE_ASM_WRITTEN (decl) 2960 && DECL_INITIAL (decl) != 0 2961 && TREE_ADDRESSABLE (decl)) 2962 { 2963 /* If this decl was copied from a file-scope decl 2964 on account of a block-scope extern decl, 2965 propagate TREE_ADDRESSABLE to the file-scope decl. */ 2966 if (DECL_ABSTRACT_ORIGIN (decl) != 0) 2967 TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1; 2968 else 2969 { 2970 push_function_context (); 2971 output_inline_function (decl); 2972 pop_function_context (); 2973 } 2974 } 2975 2976 /* Clear out the meanings of the local variables of this level. */ 2977 pop_scope_decls (NULL_TREE, NULL_TREE); 2978 2979 /* If there were any declarations or structure tags in that level, 2980 or if this level is a function body, 2981 create a BLOCK to record them for the life of this function. */ 2982 2983 block = 0; 2984 block_previously_created = (current_scope->this_block != 0); 2985 if (block_previously_created) 2986 block = current_scope->this_block; 2987 else if (keep || functionbody) 2988 block = make_node (BLOCK); 2989 if (block != 0) 2990 { 2991 tree *ptr; 2992 BLOCK_VARS (block) = decls; 2993 2994 /* Splice out ALIAS_DECL and LABEL_DECLs, 2995 since instantiate_decls can't handle them. */ 2996 for (ptr = &BLOCK_VARS (block); *ptr; ) 2997 { 2998 decl = *ptr; 2999 if (TREE_CODE (decl) == ALIAS_DECL 3000 || TREE_CODE (decl) == LABEL_DECL) 3001 *ptr = TREE_CHAIN (decl); 3002 else 3003 ptr = &TREE_CHAIN(*ptr); 3004 } 3005 3006 BLOCK_SUBBLOCKS (block) = subblocks; 3007 remember_end_note (block); 3008 } 3009 3010 /* In each subblock, record that this is its superior. */ 3011 3012 for (link = subblocks; link; link = TREE_CHAIN (link)) 3013 BLOCK_SUPERCONTEXT (link) = block; 3014 3015 } 3016 3017 /* If the level being exited is the top level of a function, 3018 check over all the labels, and clear out the current 3019 (function local) meanings of their names. */ 3020 3021 if (pass == 2 && functionbody) 3022 { 3023 /* If this is the top level block of a function, 3024 the vars are the function's parameters. 3025 Don't leave them in the BLOCK because they are 3026 found in the FUNCTION_DECL instead. */ 3027 3028 BLOCK_VARS (block) = 0; 3029 3030#if 0 3031 /* Clear out the definitions of all label names, 3032 since their scopes end here, 3033 and add them to BLOCK_VARS. */ 3034 3035 for (link = named_labels; link; link = TREE_CHAIN (link)) 3036 { 3037 register tree label = TREE_VALUE (link); 3038 3039 if (DECL_INITIAL (label) == 0) 3040 { 3041 error_with_decl (label, "label `%s' used but not defined"); 3042 /* Avoid crashing later. */ 3043 define_label (input_filename, lineno, 3044 DECL_NAME (label)); 3045 } 3046 else if (warn_unused && !TREE_USED (label)) 3047 warning_with_decl (label, "label `%s' defined but not used"); 3048 IDENTIFIER_LABEL_VALUE (DECL_NAME (label)) = 0; 3049 3050 /* Put the labels into the "variables" of the 3051 top-level block, so debugger can see them. */ 3052 TREE_CHAIN (label) = BLOCK_VARS (block); 3053 BLOCK_VARS (block) = label; 3054 } 3055#endif 3056 } 3057 3058 if (pass < 2) 3059 { 3060 current_scope->remembered_decls 3061 = nreverse (current_scope->remembered_decls); 3062 current_scope->granted_decls = nreverse (current_scope->granted_decls); 3063 } 3064 3065 current_scope = current_scope->enclosing; 3066 current_nesting_level--; 3067 3068 if (pass < 2) 3069 { 3070 return NULL_TREE; 3071 } 3072 3073 /* Dispose of the block that we just made inside some higher level. */ 3074 if (functionbody) 3075 DECL_INITIAL (current_function_decl) = block; 3076 else if (block) 3077 { 3078 if (!block_previously_created) 3079 current_scope->blocks 3080 = chainon (current_scope->blocks, block); 3081 } 3082 /* If we did not make a block for the level just exited, 3083 any blocks made for inner levels 3084 (since they cannot be recorded as subblocks in that level) 3085 must be carried forward so they will later become subblocks 3086 of something else. */ 3087 else if (subblocks) 3088 current_scope->blocks 3089 = chainon (current_scope->blocks, subblocks); 3090 3091 if (block) 3092 TREE_USED (block) = 1; 3093 return block; 3094} 3095 3096/* Delete the node BLOCK from the current binding level. 3097 This is used for the block inside a stmt expr ({...}) 3098 so that the block can be reinserted where appropriate. */ 3099 3100void 3101delete_block (block) 3102 tree block; 3103{ 3104 tree t; 3105 if (current_scope->blocks == block) 3106 current_scope->blocks = TREE_CHAIN (block); 3107 for (t = current_scope->blocks; t;) 3108 { 3109 if (TREE_CHAIN (t) == block) 3110 TREE_CHAIN (t) = TREE_CHAIN (block); 3111 else 3112 t = TREE_CHAIN (t); 3113 } 3114 TREE_CHAIN (block) = NULL; 3115 /* Clear TREE_USED which is always set by poplevel. 3116 The flag is set again if insert_block is called. */ 3117 TREE_USED (block) = 0; 3118} 3119 3120/* Insert BLOCK at the end of the list of subblocks of the 3121 current binding level. This is used when a BIND_EXPR is expanded, 3122 to handle the BLOCK node inside teh BIND_EXPR. */ 3123 3124void 3125insert_block (block) 3126 tree block; 3127{ 3128 TREE_USED (block) = 1; 3129 current_scope->blocks 3130 = chainon (current_scope->blocks, block); 3131} 3132 3133/* Set the BLOCK node for the innermost scope 3134 (the one we are currently in). */ 3135 3136void 3137set_block (block) 3138 register tree block; 3139{ 3140 current_scope->this_block = block; 3141} 3142 3143/* Record a decl-node X as belonging to the current lexical scope. 3144 Check for errors (such as an incompatible declaration for the same 3145 name already seen in the same scope). 3146 3147 Returns either X or an old decl for the same name. 3148 If an old decl is returned, it may have been smashed 3149 to agree with what X says. */ 3150 3151tree 3152pushdecl (x) 3153 tree x; 3154{ 3155 register tree name = DECL_NAME (x); 3156 register struct scope *b = current_scope; 3157 3158 DECL_CONTEXT (x) = current_function_decl; 3159 /* A local extern declaration for a function doesn't constitute nesting. 3160 A local auto declaration does, since it's a forward decl 3161 for a nested function coming later. */ 3162 if (TREE_CODE (x) == FUNCTION_DECL && DECL_INITIAL (x) == 0 3163 && DECL_EXTERNAL (x)) 3164 DECL_CONTEXT (x) = 0; 3165 3166 if (name) 3167 proclaim_decl (x, 0); 3168 3169 if (TREE_CODE (x) == TYPE_DECL && DECL_SOURCE_LINE (x) == 0 3170 && TYPE_NAME (TREE_TYPE (x)) == 0) 3171 TYPE_NAME (TREE_TYPE (x)) = x; 3172 3173 /* Put decls on list in reverse order. 3174 We will reverse them later if necessary. */ 3175 TREE_CHAIN (x) = b->decls; 3176 b->decls = x; 3177 3178 return x; 3179} 3180 3181/* Make DECLS (a chain of decls) visible in the current_scope. */ 3182 3183static void 3184pushdecllist (decls, quiet) 3185 tree decls; 3186 int quiet; 3187{ 3188 tree last = NULL_TREE, decl; 3189 3190 for (decl = decls; decl != NULL_TREE; 3191 last = decl, decl = TREE_CHAIN (decl)) 3192 { 3193 proclaim_decl (decl, quiet); 3194 } 3195 3196 if (last) 3197 { 3198 TREE_CHAIN (last) = current_scope->decls; 3199 current_scope->decls = decls; 3200 } 3201} 3202 3203/* Like pushdecl, only it places X in GLOBAL_SCOPE, if appropriate. */ 3204 3205tree 3206pushdecl_top_level (x) 3207 tree x; 3208{ 3209 register tree t; 3210 register struct scope *b = current_scope; 3211 3212 current_scope = global_scope; 3213 t = pushdecl (x); 3214 current_scope = b; 3215 return t; 3216} 3217 3218/* Define a label, specifying the location in the source file. 3219 Return the LABEL_DECL node for the label, if the definition is valid. 3220 Otherwise return 0. */ 3221 3222tree 3223define_label (filename, line, name) 3224 char *filename; 3225 int line; 3226 tree name; 3227{ 3228 tree decl; 3229 3230 if (pass == 1) 3231 { 3232 decl = build_decl (LABEL_DECL, name, void_type_node); 3233 3234 /* A label not explicitly declared must be local to where it's ref'd. */ 3235 DECL_CONTEXT (decl) = current_function_decl; 3236 3237 DECL_MODE (decl) = VOIDmode; 3238 3239 /* Say where one reference is to the label, 3240 for the sake of the error if it is not defined. */ 3241 DECL_SOURCE_LINE (decl) = line; 3242 DECL_SOURCE_FILE (decl) = filename; 3243 3244 /* Mark label as having been defined. */ 3245 DECL_INITIAL (decl) = error_mark_node; 3246 3247 DECL_ACTION_NESTING_LEVEL (decl) = action_nesting_level; 3248 3249 save_decl (decl); 3250 } 3251 else 3252 { 3253 decl = get_next_decl (); 3254 /* Make sure every label has an rtx. */ 3255 3256 label_rtx (decl); 3257 expand_label (decl); 3258 } 3259 return decl; 3260} 3261 3262/* Return the list of declarations of the current level. 3263 Note that this list is in reverse order unless/until 3264 you nreverse it; and when you do nreverse it, you must 3265 store the result back using `storedecls' or you will lose. */ 3266 3267tree 3268getdecls () 3269{ 3270 /* This is a kludge, so that dbxout_init can get the predefined types, 3271 which are in the builtin_scope, though when it is called, 3272 the current_scope is the global_scope.. */ 3273 if (current_scope == global_scope) 3274 return builtin_scope.decls; 3275 return current_scope->decls; 3276} 3277 3278#if 0 3279/* Store the list of declarations of the current level. 3280 This is done for the parameter declarations of a function being defined, 3281 after they are modified in the light of any missing parameters. */ 3282 3283static void 3284storedecls (decls) 3285 tree decls; 3286{ 3287 current_scope->decls = decls; 3288} 3289#endif 3290 3291/* Look up NAME in the current binding level and its superiors 3292 in the namespace of variables, functions and typedefs. 3293 Return a ..._DECL node of some kind representing its definition, 3294 or return 0 if it is undefined. */ 3295 3296tree 3297lookup_name (name) 3298 tree name; 3299{ 3300 register tree val = IDENTIFIER_LOCAL_VALUE (name); 3301 3302 if (val == NULL_TREE) 3303 return NULL_TREE; 3304 if (TREE_CODE_CLASS (TREE_CODE (val)) == 'c') 3305 return val; 3306 if (DECL_NESTING_LEVEL (val) > BUILTIN_NESTING_LEVEL 3307 && DECL_NESTING_LEVEL (val) < current_module_nesting_level) 3308 { 3309 return NULL_TREE; 3310 } 3311 while (TREE_CODE (val) == ALIAS_DECL) 3312 { 3313 val = DECL_ABSTRACT_ORIGIN (val); 3314 if (TREE_CODE (val) == ERROR_MARK) 3315 return NULL_TREE; 3316 } 3317 if (TREE_CODE (val) == BASED_DECL) 3318 { 3319 return build_chill_indirect_ref (DECL_ABSTRACT_ORIGIN (val), 3320 TREE_TYPE (val), 1); 3321 } 3322 if (TREE_CODE (val) == WITH_DECL) 3323 return build_component_ref (DECL_ABSTRACT_ORIGIN (val), DECL_NAME (val)); 3324 return val; 3325} 3326 3327#if 0 3328/* Similar to `lookup_name' but look only at current binding level. */ 3329 3330static tree 3331lookup_name_current_level (name) 3332 tree name; 3333{ 3334 register tree val = IDENTIFIER_LOCAL_VALUE (name); 3335 if (val && DECL_NESTING_LEVEL (val) == current_nesting_level) 3336 return val; 3337 return NULL_TREE; 3338} 3339#endif 3340 3341static tree 3342lookup_name_for_seizing (seize_decl) 3343 tree seize_decl; 3344{ 3345 tree name = DECL_OLD_NAME (seize_decl); 3346 register tree val; 3347 val = IDENTIFIER_LOCAL_VALUE (name); 3348 if (val == NULL_TREE || DECL_NESTING_LEVEL (val) == BUILTIN_NESTING_LEVEL) 3349 { 3350 val = IDENTIFIER_OUTER_VALUE (name); 3351 if (val == NULL_TREE) 3352 return NULL_TREE; 3353 if (TREE_CHAIN (val) && DECL_NAME (TREE_CHAIN (val)) == name) 3354 { /* More than one decl with the same name has been granted 3355 into the same global scope. Pick the one (we hope) that 3356 came from a seizefile the matches the most recent 3357 seizefile (as given by DECL_SEIZEFILE (seize_decl).) */ 3358 tree d, best = NULL_TREE; 3359 for (d = val; d != NULL_TREE && DECL_NAME (d) == name; 3360 d = TREE_CHAIN (d)) 3361 if (DECL_SEIZEFILE (d) == DECL_SEIZEFILE (seize_decl)) 3362 { 3363 if (best) 3364 { 3365 error_with_decl (seize_decl, 3366 "ambiguous choice for seize `%s' -"); 3367 error_with_decl (best, " - can seize this `%s' -"); 3368 error_with_decl (d, " - or this granted decl `%s'"); 3369 return NULL_TREE; 3370 } 3371 best = d; 3372 } 3373 if (best == NULL_TREE) 3374 { 3375 error_with_decl (seize_decl, 3376 "ambiguous choice for seize `%s' -"); 3377 error_with_decl (val, " - can seize this `%s' -"); 3378 error_with_decl (TREE_CHAIN (val), 3379 " - or this granted decl `%s'"); 3380 return NULL_TREE; 3381 } 3382 val = best; 3383 } 3384 } 3385#if 0 3386 /* We don't need to handle this, as long as we 3387 resolve the seize targets before pushing them. */ 3388 if (DECL_NESTING_LEVEL (val) >= current_module_nesting_level) 3389 { 3390 /* VAL was declared inside current module. We need something 3391 from the scope *enclosing* the current module, so search 3392 through the shadowed declarations. */ 3393 /* TODO - FIXME */ 3394 } 3395#endif 3396 if (current_module && current_module->prev_module 3397 && DECL_NESTING_LEVEL (val) 3398 < current_module->prev_module->nesting_level) 3399 { 3400 3401 /* It's declared in a scope enclosing the module enclosing 3402 the current module. Hence it's not visible. */ 3403 return NULL_TREE; 3404 } 3405 while (TREE_CODE (val) == ALIAS_DECL) 3406 { 3407 val = DECL_ABSTRACT_ORIGIN (val); 3408 if (TREE_CODE (val) == ERROR_MARK) 3409 return NULL_TREE; 3410 } 3411 return val; 3412} 3413 3414/* Create the predefined scalar types of C, 3415 and some nodes representing standard constants (0, 1, (void *)0). 3416 Initialize the global binding level. 3417 Make definitions for built-in primitive functions. */ 3418 3419void 3420init_decl_processing () 3421{ 3422 int wchar_type_size; 3423 tree bool_ftype_int_ptr_int; 3424 tree bool_ftype_int_ptr_int_int; 3425 tree bool_ftype_luns_ptr_luns_long; 3426 tree bool_ftype_luns_ptr_luns_long_ptr_int; 3427 tree bool_ftype_ptr_int_ptr_int; 3428 tree bool_ftype_ptr_int_ptr_int_int; 3429 tree find_bit_ftype; 3430 tree bool_ftype_ptr_ptr_int; 3431 tree bool_ftype_ptr_ptr_luns; 3432 tree bool_ftype_ptr_ptr_ptr_luns; 3433 tree endlink; 3434 tree int_ftype_int; 3435 tree int_ftype_int_int; 3436 tree int_ftype_int_ptr_int; 3437 tree int_ftype_ptr; 3438 tree int_ftype_ptr_int; 3439 tree int_ftype_ptr_int_int_ptr_int; 3440 tree int_ftype_ptr_luns_long_ptr_int; 3441 tree int_ftype_ptr_ptr_int; 3442 tree int_ftype_ptr_ptr_luns; 3443 tree long_ftype_ptr_luns; 3444 tree memcpy_ftype; 3445 tree memcmp_ftype; 3446 tree ptr_ftype_ptr_int_int; 3447 tree ptr_ftype_ptr_ptr_int; 3448 tree ptr_ftype_ptr_ptr_int_ptr_int; 3449 tree real_ftype_real; 3450 tree temp; 3451 tree void_ftype_cptr_cptr_int; 3452 tree void_ftype_long_int_ptr_int_ptr_int; 3453 tree void_ftype_ptr; 3454 tree void_ftype_ptr_int_int_int_int; 3455 tree void_ftype_ptr_int_ptr_int_int_int; 3456 tree void_ftype_ptr_int_ptr_int_ptr_int; 3457 tree void_ftype_ptr_luns_long_long_bool_ptr_int; 3458 tree void_ftype_ptr_luns_ptr_luns_luns_luns; 3459 tree void_ftype_ptr_ptr_ptr_int; 3460 tree void_ftype_ptr_ptr_ptr_luns; 3461 tree void_ftype_refptr_int_ptr_int; 3462 tree void_ftype_void; 3463 tree void_ftype_ptr_ptr_int; 3464 tree void_ftype_ptr_luns_luns_cptr_luns_luns_luns; 3465 tree ptr_ftype_luns_ptr_int; 3466 tree double_ftype_double; 3467 3468 extern int set_alignment; 3469 3470 /* allow 0-255 enums to occupy only a byte */ 3471 flag_short_enums = 1; 3472 3473 current_function_decl = NULL; 3474 3475 set_alignment = BITS_PER_UNIT; 3476 3477 ALL_POSTFIX = get_identifier ("*"); 3478 string_index_type_dummy = get_identifier("%string-index%"); 3479 3480 var_length_id = get_identifier (VAR_LENGTH); 3481 var_data_id = get_identifier (VAR_DATA); 3482 3483 /* This is the *C* int type. */ 3484 integer_type_node = make_signed_type (INT_TYPE_SIZE); 3485 3486 if (CHILL_INT_IS_SHORT) 3487 long_integer_type_node = integer_type_node; 3488 else 3489 long_integer_type_node = make_signed_type (LONG_TYPE_SIZE); 3490 3491 unsigned_type_node = make_unsigned_type (INT_TYPE_SIZE); 3492 long_unsigned_type_node = make_unsigned_type (LONG_TYPE_SIZE); 3493 long_long_integer_type_node = make_signed_type (LONG_LONG_TYPE_SIZE); 3494 long_long_unsigned_type_node = make_unsigned_type (LONG_LONG_TYPE_SIZE); 3495 3496 /* `unsigned long' is the standard type for sizeof. 3497 Note that stddef.h uses `unsigned long', 3498 and this must agree, even of long and int are the same size. */ 3499#ifndef SIZE_TYPE 3500 sizetype = long_unsigned_type_node; 3501#else 3502 { 3503 char *size_type_c_name = SIZE_TYPE; 3504 if (strncmp (size_type_c_name, "long long ", 10) == 0) 3505 sizetype = long_long_unsigned_type_node; 3506 else if (strncmp (size_type_c_name, "long ", 5) == 0) 3507 sizetype = long_unsigned_type_node; 3508 else 3509 sizetype = unsigned_type_node; 3510 } 3511#endif 3512 3513 TREE_TYPE (TYPE_SIZE (integer_type_node)) = sizetype; 3514 TREE_TYPE (TYPE_SIZE (unsigned_type_node)) = sizetype; 3515 TREE_TYPE (TYPE_SIZE (long_unsigned_type_node)) = sizetype; 3516 TREE_TYPE (TYPE_SIZE (long_integer_type_node)) = sizetype; 3517 TREE_TYPE (TYPE_SIZE (long_long_integer_type_node)) = sizetype; 3518 TREE_TYPE (TYPE_SIZE (long_long_unsigned_type_node)) = sizetype; 3519 3520 error_mark_node = make_node (ERROR_MARK); 3521 TREE_TYPE (error_mark_node) = error_mark_node; 3522 3523 short_integer_type_node = make_signed_type (SHORT_TYPE_SIZE); 3524 short_unsigned_type_node = make_unsigned_type (SHORT_TYPE_SIZE); 3525 signed_char_type_node = make_signed_type (CHAR_TYPE_SIZE); 3526 unsigned_char_type_node = make_unsigned_type (CHAR_TYPE_SIZE); 3527 intQI_type_node = make_signed_type (GET_MODE_BITSIZE (QImode)); 3528 intHI_type_node = make_signed_type (GET_MODE_BITSIZE (HImode)); 3529 intSI_type_node = make_signed_type (GET_MODE_BITSIZE (SImode)); 3530 intDI_type_node = make_signed_type (GET_MODE_BITSIZE (DImode)); 3531#if HOST_BITS_PER_WIDE_INT >= 64 3532 intTI_type_node = make_signed_type (GET_MODE_BITSIZE (TImode)); 3533#endif 3534 unsigned_intQI_type_node = make_unsigned_type (GET_MODE_BITSIZE (QImode)); 3535 unsigned_intHI_type_node = make_unsigned_type (GET_MODE_BITSIZE (HImode)); 3536 unsigned_intSI_type_node = make_unsigned_type (GET_MODE_BITSIZE (SImode)); 3537 unsigned_intDI_type_node = make_unsigned_type (GET_MODE_BITSIZE (DImode)); 3538#if HOST_BITS_PER_WIDE_INT >= 64 3539 unsigned_intTI_type_node = make_unsigned_type (GET_MODE_BITSIZE (TImode)); 3540#endif 3541 3542 float_type_node = make_node (REAL_TYPE); 3543 TYPE_PRECISION (float_type_node) = FLOAT_TYPE_SIZE; 3544 pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_FLOAT], 3545 float_type_node)); 3546 layout_type (float_type_node); 3547 3548 double_type_node = make_node (REAL_TYPE); 3549 if (flag_short_double) 3550 TYPE_PRECISION (double_type_node) = FLOAT_TYPE_SIZE; 3551 else 3552 TYPE_PRECISION (double_type_node) = DOUBLE_TYPE_SIZE; 3553 pushdecl (build_decl (TYPE_DECL, ridpointers[(int) RID_DOUBLE], 3554 double_type_node)); 3555 layout_type (double_type_node); 3556 3557 long_double_type_node = make_node (REAL_TYPE); 3558 TYPE_PRECISION (long_double_type_node) = LONG_DOUBLE_TYPE_SIZE; 3559 layout_type (long_double_type_node); 3560 3561 complex_integer_type_node = make_node (COMPLEX_TYPE); 3562 TREE_TYPE (complex_integer_type_node) = integer_type_node; 3563 layout_type (complex_integer_type_node); 3564 3565 complex_float_type_node = make_node (COMPLEX_TYPE); 3566 TREE_TYPE (complex_float_type_node) = float_type_node; 3567 layout_type (complex_float_type_node); 3568 3569 complex_double_type_node = make_node (COMPLEX_TYPE); 3570 TREE_TYPE (complex_double_type_node) = double_type_node; 3571 layout_type (complex_double_type_node); 3572 3573 complex_long_double_type_node = make_node (COMPLEX_TYPE); 3574 TREE_TYPE (complex_long_double_type_node) = long_double_type_node; 3575 layout_type (complex_long_double_type_node); 3576 3577 integer_zero_node = build_int_2 (0, 0); 3578 TREE_TYPE (integer_zero_node) = integer_type_node; 3579 integer_one_node = build_int_2 (1, 0); 3580 TREE_TYPE (integer_one_node) = integer_type_node; 3581 integer_minus_one_node = build_int_2 (-1, -1); 3582 TREE_TYPE (integer_minus_one_node) = integer_type_node; 3583 3584 size_zero_node = build_int_2 (0, 0); 3585 TREE_TYPE (size_zero_node) = sizetype; 3586 size_one_node = build_int_2 (1, 0); 3587 TREE_TYPE (size_one_node) = sizetype; 3588 3589 void_type_node = make_node (VOID_TYPE); 3590 pushdecl (build_decl (TYPE_DECL, 3591 ridpointers[(int) RID_VOID], void_type_node)); 3592 layout_type (void_type_node); /* Uses integer_zero_node */ 3593 /* We are not going to have real types in C with less than byte alignment, 3594 so we might as well not have any types that claim to have it. */ 3595 TYPE_ALIGN (void_type_node) = BITS_PER_UNIT; 3596 3597 null_pointer_node = build_int_2 (0, 0); 3598 TREE_TYPE (null_pointer_node) = build_pointer_type (void_type_node); 3599 layout_type (TREE_TYPE (null_pointer_node)); 3600 3601 /* This is for wide string constants. */ 3602 wchar_type_node = short_unsigned_type_node; 3603 wchar_type_size = TYPE_PRECISION (wchar_type_node); 3604 signed_wchar_type_node = type_for_size (wchar_type_size, 0); 3605 unsigned_wchar_type_node = type_for_size (wchar_type_size, 1); 3606 3607 default_function_type 3608 = build_function_type (integer_type_node, NULL_TREE); 3609 3610 ptr_type_node = build_pointer_type (void_type_node); 3611 const_ptr_type_node 3612 = build_pointer_type (build_type_variant (void_type_node, 1, 0)); 3613 3614 void_list_node = build_tree_list (NULL_TREE, void_type_node); 3615 3616 boolean_type_node = make_node (BOOLEAN_TYPE); 3617 TYPE_PRECISION (boolean_type_node) = 1; 3618 fixup_unsigned_type (boolean_type_node); 3619 boolean_false_node = TYPE_MIN_VALUE (boolean_type_node); 3620 boolean_true_node = TYPE_MAX_VALUE (boolean_type_node); 3621 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BOOL], 3622 boolean_type_node)); 3623 3624 /* TRUE and FALSE have the BOOL derived class */ 3625 CH_DERIVED_FLAG (boolean_true_node) = 1; 3626 CH_DERIVED_FLAG (boolean_false_node) = 1; 3627 3628 signed_boolean_type_node = make_node (BOOLEAN_TYPE); 3629 temp = build_int_2 (-1, -1); 3630 TREE_TYPE (temp) = signed_boolean_type_node; 3631 TYPE_MIN_VALUE (signed_boolean_type_node) = temp; 3632 temp = build_int_2 (0, 0); 3633 TREE_TYPE (temp) = signed_boolean_type_node; 3634 TYPE_MAX_VALUE (signed_boolean_type_node) = temp; 3635 layout_type (signed_boolean_type_node); 3636 3637 3638 bitstring_one_type_node = build_bitstring_type (integer_one_node); 3639 bit_zero_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE, 3640 NULL_TREE); 3641 bit_one_node = build (CONSTRUCTOR, bitstring_one_type_node, NULL_TREE, 3642 build_tree_list (NULL_TREE, integer_zero_node)); 3643 3644 char_type_node = make_node (CHAR_TYPE); 3645 TYPE_PRECISION (char_type_node) = CHAR_TYPE_SIZE; 3646 fixup_unsigned_type (char_type_node); 3647 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_CHAR], 3648 char_type_node)); 3649 3650 if (CHILL_INT_IS_SHORT) 3651 { 3652 chill_integer_type_node = short_integer_type_node; 3653 chill_unsigned_type_node = short_unsigned_type_node; 3654 } 3655 else 3656 { 3657 chill_integer_type_node = integer_type_node; 3658 chill_unsigned_type_node = unsigned_type_node; 3659 } 3660 3661 string_one_type_node = build_string_type (char_type_node, integer_one_node); 3662 3663 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_BYTE], 3664 signed_char_type_node)); 3665 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UBYTE], 3666 unsigned_char_type_node)); 3667 3668 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_INT], 3669 chill_integer_type_node)); 3670 3671 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_UINT], 3672 chill_unsigned_type_node)); 3673 3674 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG], 3675 long_integer_type_node)); 3676 3677 sizetype = long_integer_type_node; 3678#if 0 3679 ptrdiff_type_node 3680 = TREE_TYPE (IDENTIFIER_LOCAL_VALUE (get_identifier (PTRDIFF_TYPE))); 3681#endif 3682 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_ULONG], 3683 long_unsigned_type_node)); 3684 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_REAL], 3685 float_type_node)); 3686 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_LONG_REAL], 3687 double_type_node)); 3688 pushdecl (build_decl (TYPE_DECL, ridpointers[(int)RID_PTR], 3689 ptr_type_node)); 3690 3691 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_TRUE]) = 3692 boolean_true_node; 3693 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_FALSE]) = 3694 boolean_false_node; 3695 IDENTIFIER_LOCAL_VALUE (ridpointers[(int)RID_NULL]) = 3696 null_pointer_node; 3697 3698 /* The second operand is set to non-NULL to distinguish 3699 (ELSE) from (*). Used when writing grant files. */ 3700 case_else_node = build (RANGE_EXPR, 3701 NULL_TREE, NULL_TREE, boolean_false_node); 3702 3703 pushdecl (temp = build_decl (TYPE_DECL, 3704 get_identifier ("__tmp_initializer"), 3705 build_init_struct ())); 3706 DECL_SOURCE_LINE (temp) = 0; 3707 initializer_type = TREE_TYPE (temp); 3708 3709 bcopy (chill_tree_code_type, 3710 tree_code_type + (int) LAST_AND_UNUSED_TREE_CODE, 3711 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE) 3712 * sizeof (char))); 3713 bcopy ((char *) chill_tree_code_length, 3714 (char *) (tree_code_length + (int) LAST_AND_UNUSED_TREE_CODE), 3715 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE) 3716 * sizeof (int))); 3717 bcopy ((char *) chill_tree_code_name, 3718 (char *) (tree_code_name + (int) LAST_AND_UNUSED_TREE_CODE), 3719 (((int) LAST_CHILL_TREE_CODE - (int) LAST_AND_UNUSED_TREE_CODE) 3720 * sizeof (char *))); 3721 boolean_code_name = (char **) xmalloc (sizeof (char *) * (int) LAST_CHILL_TREE_CODE); 3722 bzero ((char *) boolean_code_name, sizeof (char *) * (int) LAST_CHILL_TREE_CODE); 3723 3724 boolean_code_name[EQ_EXPR] = "="; 3725 boolean_code_name[NE_EXPR] = "/="; 3726 boolean_code_name[LT_EXPR] = "<"; 3727 boolean_code_name[GT_EXPR] = ">"; 3728 boolean_code_name[LE_EXPR] = "<="; 3729 boolean_code_name[GE_EXPR] = ">="; 3730 boolean_code_name[SET_IN_EXPR] = "in"; 3731 boolean_code_name[TRUTH_ANDIF_EXPR] = "andif"; 3732 boolean_code_name[TRUTH_ORIF_EXPR] = "orif"; 3733 boolean_code_name[TRUTH_AND_EXPR] = "and"; 3734 boolean_code_name[TRUTH_OR_EXPR] = "or"; 3735 boolean_code_name[BIT_AND_EXPR] = "and"; 3736 boolean_code_name[BIT_IOR_EXPR] = "or"; 3737 boolean_code_name[BIT_XOR_EXPR] = "xor"; 3738 3739 endlink = void_list_node; 3740 3741 chill_predefined_function_type 3742 = build_function_type (integer_type_node, 3743 tree_cons (NULL_TREE, integer_type_node, 3744 endlink)); 3745 3746 bool_ftype_int_ptr_int 3747 = build_function_type (boolean_type_node, 3748 tree_cons (NULL_TREE, integer_type_node, 3749 tree_cons (NULL_TREE, ptr_type_node, 3750 tree_cons (NULL_TREE, integer_type_node, 3751 endlink)))); 3752 bool_ftype_int_ptr_int 3753 = build_function_type (boolean_type_node, 3754 tree_cons (NULL_TREE, integer_type_node, 3755 tree_cons (NULL_TREE, ptr_type_node, 3756 tree_cons (NULL_TREE, integer_type_node, 3757 tree_cons (NULL_TREE, integer_type_node, 3758 endlink))))); 3759 bool_ftype_int_ptr_int_int 3760 = build_function_type (boolean_type_node, 3761 tree_cons (NULL_TREE, integer_type_node, 3762 tree_cons (NULL_TREE, ptr_type_node, 3763 tree_cons (NULL_TREE, integer_type_node, 3764 tree_cons (NULL_TREE, integer_type_node, 3765 endlink))))); 3766 bool_ftype_luns_ptr_luns_long 3767 = build_function_type (boolean_type_node, 3768 tree_cons (NULL_TREE, long_unsigned_type_node, 3769 tree_cons (NULL_TREE, ptr_type_node, 3770 tree_cons (NULL_TREE, long_unsigned_type_node, 3771 tree_cons (NULL_TREE, long_integer_type_node, 3772 endlink))))); 3773 bool_ftype_luns_ptr_luns_long_ptr_int 3774 = build_function_type (boolean_type_node, 3775 tree_cons (NULL_TREE, long_unsigned_type_node, 3776 tree_cons (NULL_TREE, ptr_type_node, 3777 tree_cons (NULL_TREE, long_unsigned_type_node, 3778 tree_cons (NULL_TREE, long_integer_type_node, 3779 tree_cons (NULL_TREE, ptr_type_node, 3780 tree_cons (NULL_TREE, integer_type_node, 3781 endlink))))))); 3782 bool_ftype_ptr_ptr_int 3783 = build_function_type (boolean_type_node, 3784 tree_cons (NULL_TREE, ptr_type_node, 3785 tree_cons (NULL_TREE, ptr_type_node, 3786 tree_cons (NULL_TREE, integer_type_node, 3787 endlink)))); 3788 bool_ftype_ptr_ptr_luns 3789 = build_function_type (boolean_type_node, 3790 tree_cons (NULL_TREE, ptr_type_node, 3791 tree_cons (NULL_TREE, ptr_type_node, 3792 tree_cons (NULL_TREE, long_unsigned_type_node, 3793 endlink)))); 3794 bool_ftype_ptr_ptr_ptr_luns 3795 = build_function_type (boolean_type_node, 3796 tree_cons (NULL_TREE, ptr_type_node, 3797 tree_cons (NULL_TREE, ptr_type_node, 3798 tree_cons (NULL_TREE, ptr_type_node, 3799 tree_cons (NULL_TREE, long_unsigned_type_node, 3800 endlink))))); 3801 bool_ftype_ptr_int_ptr_int 3802 = build_function_type (boolean_type_node, 3803 tree_cons (NULL_TREE, ptr_type_node, 3804 tree_cons (NULL_TREE, integer_type_node, 3805 tree_cons (NULL_TREE, ptr_type_node, 3806 tree_cons (NULL_TREE, integer_type_node, 3807 endlink))))); 3808 bool_ftype_ptr_int_ptr_int_int 3809 = build_function_type (boolean_type_node, 3810 tree_cons (NULL_TREE, ptr_type_node, 3811 tree_cons (NULL_TREE, integer_type_node, 3812 tree_cons (NULL_TREE, ptr_type_node, 3813 tree_cons (NULL_TREE, integer_type_node, 3814 tree_cons (NULL_TREE, integer_type_node, 3815 endlink)))))); 3816 find_bit_ftype 3817 = build_function_type (integer_type_node, 3818 tree_cons (NULL_TREE, ptr_type_node, 3819 tree_cons (NULL_TREE, long_unsigned_type_node, 3820 tree_cons (NULL_TREE, integer_type_node, 3821 endlink)))); 3822 int_ftype_int 3823 = build_function_type (integer_type_node, 3824 tree_cons (NULL_TREE, integer_type_node, 3825 endlink)); 3826 int_ftype_int_int 3827 = build_function_type (integer_type_node, 3828 tree_cons (NULL_TREE, integer_type_node, 3829 tree_cons (NULL_TREE, integer_type_node, 3830 endlink))); 3831 int_ftype_int_ptr_int 3832 = build_function_type (integer_type_node, 3833 tree_cons (NULL_TREE, integer_type_node, 3834 tree_cons (NULL_TREE, ptr_type_node, 3835 tree_cons (NULL_TREE, integer_type_node, 3836 endlink)))); 3837 int_ftype_ptr 3838 = build_function_type (integer_type_node, 3839 tree_cons (NULL_TREE, ptr_type_node, 3840 endlink)); 3841 int_ftype_ptr_int 3842 = build_function_type (integer_type_node, 3843 tree_cons (NULL_TREE, ptr_type_node, 3844 tree_cons (NULL_TREE, integer_type_node, 3845 endlink))); 3846 3847 long_ftype_ptr_luns 3848 = build_function_type (long_integer_type_node, 3849 tree_cons (NULL_TREE, ptr_type_node, 3850 tree_cons (NULL_TREE, long_unsigned_type_node, 3851 endlink))); 3852 3853 int_ftype_ptr_int_int_ptr_int 3854 = build_function_type (integer_type_node, 3855 tree_cons (NULL_TREE, ptr_type_node, 3856 tree_cons (NULL_TREE, integer_type_node, 3857 tree_cons (NULL_TREE, integer_type_node, 3858 tree_cons (NULL_TREE, ptr_type_node, 3859 tree_cons (NULL_TREE, integer_type_node, 3860 endlink)))))); 3861 3862 int_ftype_ptr_luns_long_ptr_int 3863 = build_function_type (integer_type_node, 3864 tree_cons (NULL_TREE, ptr_type_node, 3865 tree_cons (NULL_TREE, long_unsigned_type_node, 3866 tree_cons (NULL_TREE, long_integer_type_node, 3867 tree_cons (NULL_TREE, ptr_type_node, 3868 tree_cons (NULL_TREE, integer_type_node, 3869 endlink)))))); 3870 3871 int_ftype_ptr_ptr_int 3872 = build_function_type (integer_type_node, 3873 tree_cons (NULL_TREE, ptr_type_node, 3874 tree_cons (NULL_TREE, ptr_type_node, 3875 tree_cons (NULL_TREE, integer_type_node, 3876 endlink)))); 3877 int_ftype_ptr_ptr_luns 3878 = build_function_type (integer_type_node, 3879 tree_cons (NULL_TREE, ptr_type_node, 3880 tree_cons (NULL_TREE, ptr_type_node, 3881 tree_cons (NULL_TREE, long_unsigned_type_node, 3882 endlink)))); 3883 memcpy_ftype /* memcpy/memmove prototype */ 3884 = build_function_type (ptr_type_node, 3885 tree_cons (NULL_TREE, ptr_type_node, 3886 tree_cons (NULL_TREE, const_ptr_type_node, 3887 tree_cons (NULL_TREE, sizetype, 3888 endlink)))); 3889 memcmp_ftype /* memcmp prototype */ 3890 = build_function_type (integer_type_node, 3891 tree_cons (NULL_TREE, ptr_type_node, 3892 tree_cons (NULL_TREE, ptr_type_node, 3893 tree_cons (NULL_TREE, sizetype, 3894 endlink)))); 3895 3896 ptr_ftype_ptr_int_int 3897 = build_function_type (ptr_type_node, 3898 tree_cons (NULL_TREE, ptr_type_node, 3899 tree_cons (NULL_TREE, integer_type_node, 3900 tree_cons (NULL_TREE, integer_type_node, 3901 endlink)))); 3902 ptr_ftype_ptr_ptr_int 3903 = build_function_type (ptr_type_node, 3904 tree_cons (NULL_TREE, ptr_type_node, 3905 tree_cons (NULL_TREE, ptr_type_node, 3906 tree_cons (NULL_TREE, integer_type_node, 3907 endlink)))); 3908 ptr_ftype_ptr_ptr_int_ptr_int 3909 = build_function_type (void_type_node, 3910 tree_cons (NULL_TREE, ptr_type_node, 3911 tree_cons (NULL_TREE, ptr_type_node, 3912 tree_cons (NULL_TREE, integer_type_node, 3913 tree_cons (NULL_TREE, ptr_type_node, 3914 tree_cons (NULL_TREE, integer_type_node, 3915 endlink)))))); 3916 real_ftype_real 3917 = build_function_type (float_type_node, 3918 tree_cons (NULL_TREE, float_type_node, 3919 endlink)); 3920 3921 void_ftype_ptr 3922 = build_function_type (void_type_node, 3923 tree_cons (NULL_TREE, ptr_type_node, endlink)); 3924 3925 void_ftype_cptr_cptr_int 3926 = build_function_type (void_type_node, 3927 tree_cons (NULL_TREE, const_ptr_type_node, 3928 tree_cons (NULL_TREE, const_ptr_type_node, 3929 tree_cons (NULL_TREE, integer_type_node, 3930 endlink)))); 3931 3932 void_ftype_refptr_int_ptr_int 3933 = build_function_type (void_type_node, 3934 tree_cons (NULL_TREE, build_reference_type(ptr_type_node), 3935 tree_cons (NULL_TREE, integer_type_node, 3936 tree_cons (NULL_TREE, ptr_type_node, 3937 tree_cons (NULL_TREE, integer_type_node, 3938 endlink))))); 3939 3940 void_ftype_ptr_ptr_ptr_int 3941 = build_function_type (void_type_node, 3942 tree_cons (NULL_TREE, ptr_type_node, 3943 tree_cons (NULL_TREE, ptr_type_node, 3944 tree_cons (NULL_TREE, ptr_type_node, 3945 tree_cons (NULL_TREE, integer_type_node, 3946 endlink))))); 3947 void_ftype_ptr_ptr_ptr_luns 3948 = build_function_type (void_type_node, 3949 tree_cons (NULL_TREE, ptr_type_node, 3950 tree_cons (NULL_TREE, ptr_type_node, 3951 tree_cons (NULL_TREE, ptr_type_node, 3952 tree_cons (NULL_TREE, long_unsigned_type_node, 3953 endlink))))); 3954 void_ftype_ptr_int_int_int_int 3955 = build_function_type (void_type_node, 3956 tree_cons (NULL_TREE, ptr_type_node, 3957 tree_cons (NULL_TREE, integer_type_node, 3958 tree_cons (NULL_TREE, integer_type_node, 3959 tree_cons (NULL_TREE, integer_type_node, 3960 tree_cons (NULL_TREE, integer_type_node, 3961 endlink)))))); 3962 void_ftype_ptr_luns_long_long_bool_ptr_int 3963 = build_function_type (void_type_node, 3964 tree_cons (NULL_TREE, ptr_type_node, 3965 tree_cons (NULL_TREE, long_unsigned_type_node, 3966 tree_cons (NULL_TREE, long_integer_type_node, 3967 tree_cons (NULL_TREE, long_integer_type_node, 3968 tree_cons (NULL_TREE, boolean_type_node, 3969 tree_cons (NULL_TREE, ptr_type_node, 3970 tree_cons (NULL_TREE, integer_type_node, 3971 endlink)))))))); 3972 void_ftype_ptr_int_ptr_int_int_int 3973 = build_function_type (void_type_node, 3974 tree_cons (NULL_TREE, ptr_type_node, 3975 tree_cons (NULL_TREE, integer_type_node, 3976 tree_cons (NULL_TREE, ptr_type_node, 3977 tree_cons (NULL_TREE, integer_type_node, 3978 tree_cons (NULL_TREE, integer_type_node, 3979 tree_cons (NULL_TREE, integer_type_node, 3980 endlink))))))); 3981 void_ftype_ptr_luns_ptr_luns_luns_luns 3982 = build_function_type (void_type_node, 3983 tree_cons (NULL_TREE, ptr_type_node, 3984 tree_cons (NULL_TREE, long_unsigned_type_node, 3985 tree_cons (NULL_TREE, ptr_type_node, 3986 tree_cons (NULL_TREE, long_unsigned_type_node, 3987 tree_cons (NULL_TREE, long_unsigned_type_node, 3988 tree_cons (NULL_TREE, long_unsigned_type_node, 3989 endlink))))))); 3990 void_ftype_ptr_int_ptr_int_ptr_int 3991 = build_function_type (void_type_node, 3992 tree_cons (NULL_TREE, ptr_type_node, 3993 tree_cons (NULL_TREE, integer_type_node, 3994 tree_cons (NULL_TREE, ptr_type_node, 3995 tree_cons (NULL_TREE, integer_type_node, 3996 tree_cons (NULL_TREE, ptr_type_node, 3997 tree_cons (NULL_TREE, integer_type_node, 3998 endlink))))))); 3999 void_ftype_long_int_ptr_int_ptr_int 4000 = build_function_type (void_type_node, 4001 tree_cons (NULL_TREE, long_integer_type_node, 4002 tree_cons (NULL_TREE, integer_type_node, 4003 tree_cons (NULL_TREE, ptr_type_node, 4004 tree_cons (NULL_TREE, integer_type_node, 4005 tree_cons (NULL_TREE, ptr_type_node, 4006 tree_cons (NULL_TREE, integer_type_node, 4007 endlink))))))); 4008 void_ftype_void 4009 = build_function_type (void_type_node, 4010 tree_cons (NULL_TREE, void_type_node, 4011 endlink)); 4012 4013 void_ftype_ptr_ptr_int 4014 = build_function_type (void_type_node, 4015 tree_cons (NULL_TREE, ptr_type_node, 4016 tree_cons (NULL_TREE, ptr_type_node, 4017 tree_cons (NULL_TREE, integer_type_node, 4018 endlink)))); 4019 4020 void_ftype_ptr_luns_luns_cptr_luns_luns_luns 4021 = build_function_type (void_type_node, 4022 tree_cons (NULL_TREE, ptr_type_node, 4023 tree_cons (NULL_TREE, long_unsigned_type_node, 4024 tree_cons (NULL_TREE, long_unsigned_type_node, 4025 tree_cons (NULL_TREE, const_ptr_type_node, 4026 tree_cons (NULL_TREE, long_unsigned_type_node, 4027 tree_cons (NULL_TREE, long_unsigned_type_node, 4028 tree_cons (NULL_TREE, long_unsigned_type_node, 4029 endlink)))))))); 4030 4031 ptr_ftype_luns_ptr_int 4032 = build_function_type (ptr_type_node, 4033 tree_cons (NULL_TREE, long_unsigned_type_node, 4034 tree_cons (NULL_TREE, ptr_type_node, 4035 tree_cons (NULL_TREE, integer_type_node, 4036 endlink)))); 4037 4038 double_ftype_double 4039 = build_function_type (double_type_node, 4040 tree_cons (NULL_TREE, double_type_node, 4041 endlink)); 4042 4043/* These are compiler-internal function calls, not intended 4044 to be directly called by user code */ 4045 builtin_function ("__allocate", ptr_ftype_luns_ptr_int, 4046 NOT_BUILT_IN, NULL_PTR); 4047 builtin_function ("_allocate_global_memory", void_ftype_refptr_int_ptr_int, 4048 NOT_BUILT_IN, NULL_PTR); 4049 builtin_function ("_allocate_memory", void_ftype_refptr_int_ptr_int, 4050 NOT_BUILT_IN, NULL_PTR); 4051 builtin_function ("__andpowerset", bool_ftype_ptr_ptr_ptr_luns, 4052 NOT_BUILT_IN, NULL_PTR); 4053 builtin_function ("__bitsetpowerset", void_ftype_ptr_int_int_int_int, 4054 NOT_BUILT_IN, NULL_PTR); 4055 builtin_function ("__cardpowerset", long_ftype_ptr_luns, 4056 NOT_BUILT_IN, NULL_PTR); 4057 builtin_function ("__cause_ex1", void_ftype_cptr_cptr_int, 4058 NOT_BUILT_IN, NULL_PTR); 4059 builtin_function ("__concatstring", ptr_ftype_ptr_ptr_int_ptr_int, 4060 NOT_BUILT_IN, NULL_PTR); 4061 builtin_function ("__continue", void_ftype_ptr_ptr_int, 4062 NOT_BUILT_IN, NULL_PTR); 4063 builtin_function ("__diffpowerset", void_ftype_ptr_ptr_ptr_luns, 4064 NOT_BUILT_IN, NULL_PTR); 4065 builtin_function ("__eqpowerset", bool_ftype_ptr_ptr_luns, 4066 NOT_BUILT_IN, NULL_PTR); 4067 builtin_function ("__ffsetclrpowerset", find_bit_ftype, 4068 NOT_BUILT_IN, NULL_PTR); 4069 builtin_function ("__flsetclrpowerset", find_bit_ftype, 4070 NOT_BUILT_IN, NULL_PTR); 4071 builtin_function ("__flsetpowerset", int_ftype_ptr_luns_long_ptr_int, 4072 NOT_BUILT_IN, NULL_PTR); 4073 builtin_function ("__ffsetpowerset", int_ftype_ptr_luns_long_ptr_int, 4074 NOT_BUILT_IN, NULL_PTR); 4075 builtin_function ("__inbitstring", bool_ftype_luns_ptr_luns_long_ptr_int, 4076 NOT_BUILT_IN, NULL_PTR); 4077 builtin_function ("__inpowerset", bool_ftype_luns_ptr_luns_long, 4078 NOT_BUILT_IN, NULL_PTR); 4079 builtin_function ("__lepowerset", bool_ftype_ptr_ptr_luns, 4080 NOT_BUILT_IN, NULL_PTR); 4081 builtin_function ("__ltpowerset", bool_ftype_ptr_ptr_luns, 4082 NOT_BUILT_IN, NULL_PTR); 4083 /* Currently under experimentation. */ 4084 builtin_function ("memmove", memcpy_ftype, 4085 NOT_BUILT_IN, NULL_PTR); 4086 builtin_function ("memcmp", memcmp_ftype, 4087 NOT_BUILT_IN, NULL_PTR); 4088 4089 /* this comes from c-decl.c (init_decl_processing) */ 4090 builtin_function ("__builtin_alloca", 4091 build_function_type (ptr_type_node, 4092 tree_cons (NULL_TREE, 4093 sizetype, 4094 endlink)), 4095 BUILT_IN_ALLOCA, "alloca"); 4096 4097 builtin_function ("memset", ptr_ftype_ptr_int_int, 4098 NOT_BUILT_IN, NULL_PTR); 4099 builtin_function ("__notpowerset", bool_ftype_ptr_ptr_luns, 4100 NOT_BUILT_IN, NULL_PTR); 4101 builtin_function ("__orpowerset", bool_ftype_ptr_ptr_ptr_luns, 4102 NOT_BUILT_IN, NULL_PTR); 4103 builtin_function ("__psslice", void_ftype_ptr_int_ptr_int_int_int, 4104 NOT_BUILT_IN, NULL_PTR); 4105 builtin_function ("__pscpy", void_ftype_ptr_luns_luns_cptr_luns_luns_luns, 4106 NOT_BUILT_IN, NULL_PTR); 4107 builtin_function ("_return_memory", void_ftype_ptr_ptr_int, 4108 NOT_BUILT_IN, NULL_PTR); 4109 builtin_function ("__setbitpowerset", void_ftype_ptr_luns_long_long_bool_ptr_int, 4110 NOT_BUILT_IN, NULL_PTR); 4111 builtin_function ("__terminate", void_ftype_ptr_ptr_int, 4112 NOT_BUILT_IN, NULL_PTR); 4113 builtin_function ("__unhandled_ex", void_ftype_cptr_cptr_int, 4114 NOT_BUILT_IN, NULL_PTR); 4115 builtin_function ("__xorpowerset", bool_ftype_ptr_ptr_ptr_luns, 4116 NOT_BUILT_IN, NULL_PTR); 4117 4118 /* declare floating point functions */ 4119 builtin_function ("__sin", double_ftype_double, NOT_BUILT_IN, "sin"); 4120 builtin_function ("__cos", double_ftype_double, NOT_BUILT_IN, "cos"); 4121 builtin_function ("__tan", double_ftype_double, NOT_BUILT_IN, "tan"); 4122 builtin_function ("__asin", double_ftype_double, NOT_BUILT_IN, "asin"); 4123 builtin_function ("__acos", double_ftype_double, NOT_BUILT_IN, "acos"); 4124 builtin_function ("__atan", double_ftype_double, NOT_BUILT_IN, "atan"); 4125 builtin_function ("__exp", double_ftype_double, NOT_BUILT_IN, "exp"); 4126 builtin_function ("__log", double_ftype_double, NOT_BUILT_IN, "log"); 4127 builtin_function ("__log10", double_ftype_double, NOT_BUILT_IN, "log10"); 4128 builtin_function ("__sqrt", double_ftype_double, NOT_BUILT_IN, "sqrt"); 4129 4130 tasking_init (); 4131 timing_init (); 4132 inout_init (); 4133 4134 /* These are predefined value builtin routine calls, built 4135 by the compiler, but over-ridable by user procedures of 4136 the same names. Note the lack of a leading underscore. */ 4137 builtin_function ((ignore_case || ! special_UC) ? "abs" : "ABS", 4138 chill_predefined_function_type, 4139 BUILT_IN_CH_ABS, NULL_PTR); 4140 builtin_function ((ignore_case || ! special_UC) ? "abstime" : "ABSTIME", 4141 chill_predefined_function_type, 4142 BUILT_IN_ABSTIME, NULL_PTR); 4143 builtin_function ((ignore_case || ! special_UC) ? "allocate" : "ALLOCATE", 4144 chill_predefined_function_type, 4145 BUILT_IN_ALLOCATE, NULL_PTR); 4146 builtin_function ((ignore_case || ! special_UC) ? "allocate_memory" : "ALLOCATE_MEMORY", 4147 chill_predefined_function_type, 4148 BUILT_IN_ALLOCATE_MEMORY, NULL_PTR); 4149 builtin_function ((ignore_case || ! special_UC) ? "addr" : "ADDR", 4150 chill_predefined_function_type, 4151 BUILT_IN_ADDR, NULL_PTR); 4152 builtin_function ((ignore_case || ! special_UC) ? "allocate_global_memory" : "ALLOCATE_GLOBAL_MEMORY", 4153 chill_predefined_function_type, 4154 BUILT_IN_ALLOCATE_GLOBAL_MEMORY, NULL_PTR); 4155 builtin_function ((ignore_case || ! special_UC) ? "arccos" : "ARCCOS", 4156 chill_predefined_function_type, 4157 BUILT_IN_ARCCOS, NULL_PTR); 4158 builtin_function ((ignore_case || ! special_UC) ? "arcsin" : "ARCSIN", 4159 chill_predefined_function_type, 4160 BUILT_IN_ARCSIN, NULL_PTR); 4161 builtin_function ((ignore_case || ! special_UC) ? "arctan" : "ARCTAN", 4162 chill_predefined_function_type, 4163 BUILT_IN_ARCTAN, NULL_PTR); 4164 builtin_function ((ignore_case || ! special_UC) ? "card" : "CARD", 4165 chill_predefined_function_type, 4166 BUILT_IN_CARD, NULL_PTR); 4167 builtin_function ((ignore_case || ! special_UC) ? "cos" : "COS", 4168 chill_predefined_function_type, 4169 BUILT_IN_CH_COS, NULL_PTR); 4170 builtin_function ((ignore_case || ! special_UC) ? "days" : "DAYS", 4171 chill_predefined_function_type, 4172 BUILT_IN_DAYS, NULL_PTR); 4173 builtin_function ((ignore_case || ! special_UC) ? "descr" : "DESCR", 4174 chill_predefined_function_type, 4175 BUILT_IN_DESCR, NULL_PTR); 4176 builtin_function ((ignore_case || ! special_UC) ? "getstack" : "GETSTACK", 4177 chill_predefined_function_type, 4178 BUILT_IN_GETSTACK, NULL_PTR); 4179 builtin_function ((ignore_case || ! special_UC) ? "exp" : "EXP", 4180 chill_predefined_function_type, 4181 BUILT_IN_EXP, NULL_PTR); 4182 builtin_function ((ignore_case || ! special_UC) ? "hours" : "HOURS", 4183 chill_predefined_function_type, 4184 BUILT_IN_HOURS, NULL_PTR); 4185 builtin_function ((ignore_case || ! special_UC) ? "inttime" : "INTTIME", 4186 chill_predefined_function_type, 4187 BUILT_IN_INTTIME, NULL_PTR); 4188 builtin_function ((ignore_case || ! special_UC) ? "length" : "LENGTH", 4189 chill_predefined_function_type, 4190 BUILT_IN_LENGTH, NULL_PTR); 4191 builtin_function ((ignore_case || ! special_UC) ? "log" : "LOG", 4192 chill_predefined_function_type, 4193 BUILT_IN_LOG, NULL_PTR); 4194 builtin_function ((ignore_case || ! special_UC) ? "lower" : "LOWER", 4195 chill_predefined_function_type, 4196 BUILT_IN_LOWER, NULL_PTR); 4197 builtin_function ((ignore_case || ! special_UC) ? "ln" : "LN", 4198 chill_predefined_function_type, 4199 BUILT_IN_LN, NULL_PTR); 4200 /* Note: these are *not* the C integer MAX and MIN. They're 4201 for powerset arguments. */ 4202 builtin_function ((ignore_case || ! special_UC) ? "max" : "MAX", 4203 chill_predefined_function_type, 4204 BUILT_IN_MAX, NULL_PTR); 4205 builtin_function ((ignore_case || ! special_UC) ? "millisecs" : "MILLISECS", 4206 chill_predefined_function_type, 4207 BUILT_IN_MILLISECS, NULL_PTR); 4208 builtin_function ((ignore_case || ! special_UC) ? "min" : "MIN", 4209 chill_predefined_function_type, 4210 BUILT_IN_MIN, NULL_PTR); 4211 builtin_function ((ignore_case || ! special_UC) ? "minutes" : "MINUTES", 4212 chill_predefined_function_type, 4213 BUILT_IN_MINUTES, NULL_PTR); 4214 builtin_function ((ignore_case || ! special_UC) ? "num" : "NUM", 4215 chill_predefined_function_type, 4216 BUILT_IN_NUM, NULL_PTR); 4217 builtin_function ((ignore_case || ! special_UC) ? "pred" : "PRED", 4218 chill_predefined_function_type, 4219 BUILT_IN_PRED, NULL_PTR); 4220 builtin_function ((ignore_case || ! special_UC) ? "return_memory" : "RETURN_MEMORY", 4221 chill_predefined_function_type, 4222 BUILT_IN_RETURN_MEMORY, NULL_PTR); 4223 builtin_function ((ignore_case || ! special_UC) ? "secs" : "SECS", 4224 chill_predefined_function_type, 4225 BUILT_IN_SECS, NULL_PTR); 4226 builtin_function ((ignore_case || ! special_UC) ? "sin" : "SIN", 4227 chill_predefined_function_type, 4228 BUILT_IN_CH_SIN, NULL_PTR); 4229 builtin_function ((ignore_case || ! special_UC) ? "size" : "SIZE", 4230 chill_predefined_function_type, 4231 BUILT_IN_SIZE, NULL_PTR); 4232 builtin_function ((ignore_case || ! special_UC) ? "sqrt" : "SQRT", 4233 chill_predefined_function_type, 4234 BUILT_IN_SQRT, NULL_PTR); 4235 builtin_function ((ignore_case || ! special_UC) ? "succ" : "SUCC", 4236 chill_predefined_function_type, 4237 BUILT_IN_SUCC, NULL_PTR); 4238 builtin_function ((ignore_case || ! special_UC) ? "tan" : "TAN", 4239 chill_predefined_function_type, 4240 BUILT_IN_TAN, NULL_PTR); 4241 builtin_function ((ignore_case || ! special_UC) ? "terminate" : "TERMINATE", 4242 chill_predefined_function_type, 4243 BUILT_IN_TERMINATE, NULL_PTR); 4244 builtin_function ((ignore_case || ! special_UC) ? "upper" : "UPPER", 4245 chill_predefined_function_type, 4246 BUILT_IN_UPPER, NULL_PTR); 4247 4248 build_chill_descr_type (); 4249 build_chill_inttime_type (); 4250 4251 endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE); 4252 4253 start_identifier_warnings (); 4254 4255 pass = 1; 4256} 4257 4258/* Return a definition for a builtin function named NAME and whose data type 4259 is TYPE. TYPE should be a function type with argument types. 4260 FUNCTION_CODE tells later passes how to compile calls to this function. 4261 See tree.h for its possible values. 4262 4263 If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME, 4264 the name to be called if we can't opencode the function. */ 4265 4266tree 4267builtin_function (name, type, function_code, library_name) 4268 char *name; 4269 tree type; 4270 enum built_in_function function_code; 4271 char *library_name; 4272{ 4273 tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type); 4274 DECL_EXTERNAL (decl) = 1; 4275 TREE_PUBLIC (decl) = 1; 4276 /* If -traditional, permit redefining a builtin function any way you like. 4277 (Though really, if the program redefines these functions, 4278 it probably won't work right unless compiled with -fno-builtin.) */ 4279 if (flag_traditional && name[0] != '_') 4280 DECL_BUILT_IN_NONANSI (decl) = 1; 4281 if (library_name) 4282 DECL_ASSEMBLER_NAME (decl) = get_identifier (library_name); 4283 make_decl_rtl (decl, NULL_PTR, 1); 4284 pushdecl (decl); 4285 if (function_code != NOT_BUILT_IN) 4286 { 4287 DECL_BUILT_IN (decl) = 1; 4288 DECL_SET_FUNCTION_CODE (decl, function_code); 4289 } 4290 4291 return decl; 4292} 4293 4294/* Print a warning if a constant expression had overflow in folding. 4295 Invoke this function on every expression that the language 4296 requires to be a constant expression. */ 4297 4298void 4299constant_expression_warning (value) 4300 tree value; 4301{ 4302 if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST 4303 || TREE_CODE (value) == COMPLEX_CST) 4304 && TREE_CONSTANT_OVERFLOW (value) && pedantic) 4305 pedwarn ("overflow in constant expression"); 4306} 4307 4308 4309/* Finish processing of a declaration; 4310 If the length of an array type is not known before, 4311 it must be determined now, from the initial value, or it is an error. */ 4312 4313void 4314finish_decl (decl) 4315 tree decl; 4316{ 4317 int was_incomplete = (DECL_SIZE (decl) == 0); 4318 int temporary = allocation_temporary_p (); 4319 4320 /* Pop back to the obstack that is current for this binding level. 4321 This is because MAXINDEX, rtl, etc. to be made below 4322 must go in the permanent obstack. But don't discard the 4323 temporary data yet. */ 4324 pop_obstacks (); 4325#if 0 /* pop_obstacks was near the end; this is what was here. */ 4326 if (current_scope == global_scope && temporary) 4327 end_temporary_allocation (); 4328#endif 4329 4330 if (TREE_CODE (decl) == VAR_DECL) 4331 { 4332 if (DECL_SIZE (decl) == 0 4333 && TYPE_SIZE (TREE_TYPE (decl)) != 0) 4334 layout_decl (decl, 0); 4335 4336 if (DECL_SIZE (decl) == 0 && TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK) 4337 { 4338 error_with_decl (decl, "storage size of `%s' isn't known"); 4339 TREE_TYPE (decl) = error_mark_node; 4340 } 4341 4342 if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl)) 4343 && DECL_SIZE (decl) != 0) 4344 { 4345 if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST) 4346 constant_expression_warning (DECL_SIZE (decl)); 4347 } 4348 } 4349 4350 /* Output the assembler code and/or RTL code for variables and functions, 4351 unless the type is an undefined structure or union. 4352 If not, it will get done when the type is completed. */ 4353 4354 if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL) 4355 { 4356 /* The last argument (at_end) is set to 1 as a kludge to force 4357 assemble_variable to be called. */ 4358 if (TREE_CODE (TREE_TYPE (decl)) != ERROR_MARK) 4359 rest_of_decl_compilation (decl, (char*) 0, global_bindings_p (), 1); 4360 4361 /* Compute the RTL of a decl if not yet set. 4362 (For normal user variables, satisfy_decl sets it.) */ 4363 if (! TREE_STATIC (decl) && ! DECL_EXTERNAL (decl)) 4364 { 4365 if (was_incomplete) 4366 { 4367 /* If we used it already as memory, it must stay in memory. */ 4368 TREE_ADDRESSABLE (decl) = TREE_USED (decl); 4369 /* If it's still incomplete now, no init will save it. */ 4370 if (DECL_SIZE (decl) == 0) 4371 DECL_INITIAL (decl) = 0; 4372 expand_decl (decl); 4373 } 4374 } 4375 } 4376 4377 if (TREE_CODE (decl) == TYPE_DECL) 4378 { 4379 rest_of_decl_compilation (decl, NULL_PTR, 4380 global_bindings_p (), 0); 4381 } 4382 4383 /* ??? After 2.3, test (init != 0) instead of TREE_CODE. */ 4384 if (!(TREE_CODE (decl) == FUNCTION_DECL && DECL_INLINE (decl)) 4385 && temporary && TREE_PERMANENT (decl)) 4386 { 4387 /* We need to remember that this array HAD an initialization, 4388 but discard the actual temporary nodes, 4389 since we can't have a permanent node keep pointing to them. */ 4390 /* We make an exception for inline functions, since it's 4391 normal for a local extern redeclaration of an inline function 4392 to have a copy of the top-level decl's DECL_INLINE. */ 4393 if (DECL_INITIAL (decl) != 0) 4394 DECL_INITIAL (decl) = error_mark_node; 4395 } 4396 4397#if 0 4398 /* Resume permanent allocation, if not within a function. */ 4399 /* The corresponding push_obstacks_nochange is in start_decl, 4400 and in push_parm_decl and in grokfield. */ 4401 pop_obstacks (); 4402#endif 4403 4404 /* If we have gone back from temporary to permanent allocation, 4405 actually free the temporary space that we no longer need. */ 4406 if (temporary && !allocation_temporary_p ()) 4407 permanent_allocation (0); 4408 4409 /* At the end of a declaration, throw away any variable type sizes 4410 of types defined inside that declaration. There is no use 4411 computing them in the following function definition. */ 4412 if (current_scope == global_scope) 4413 get_pending_sizes (); 4414} 4415 4416/* If DECL has a cleanup, build and return that cleanup here. 4417 This is a callback called by expand_expr. */ 4418 4419tree 4420maybe_build_cleanup (decl) 4421 tree decl ATTRIBUTE_UNUSED; 4422{ 4423 /* There are no cleanups in C. */ 4424 return NULL_TREE; 4425} 4426 4427/* Make TYPE a complete type based on INITIAL_VALUE. 4428 Return 0 if successful, 1 if INITIAL_VALUE can't be deciphered, 4429 2 if there was no information (in which case assume 1 if DO_DEFAULT). */ 4430 4431int 4432complete_array_type (type, initial_value, do_default) 4433 tree type ATTRIBUTE_UNUSED, initial_value ATTRIBUTE_UNUSED; 4434 int do_default ATTRIBUTE_UNUSED; 4435{ 4436 /* Only needed so we can link with ../c-typeck.c. */ 4437 abort (); 4438} 4439 4440/* Make sure that the tag NAME is defined *in the current binding level* 4441 at least as a forward reference. 4442 CODE says which kind of tag NAME ought to be. 4443 4444 We also do a push_obstacks_nochange 4445 whose matching pop is in finish_struct. */ 4446 4447tree 4448start_struct (code, name) 4449 enum chill_tree_code code; 4450 tree name ATTRIBUTE_UNUSED; 4451{ 4452 /* If there is already a tag defined at this binding level 4453 (as a forward reference), just return it. */ 4454 4455 register tree ref = 0; 4456 4457 push_obstacks_nochange (); 4458 if (current_scope == global_scope) 4459 end_temporary_allocation (); 4460 4461 /* Otherwise create a forward-reference just so the tag is in scope. */ 4462 4463 ref = make_node (code); 4464/* pushtag (name, ref); */ 4465 return ref; 4466} 4467 4468#if 0 4469/* Function to help qsort sort FIELD_DECLs by name order. */ 4470 4471static int 4472field_decl_cmp (x, y) 4473 tree *x, *y; 4474{ 4475 return (long)DECL_NAME (*x) - (long)DECL_NAME (*y); 4476} 4477#endif 4478/* Fill in the fields of a RECORD_TYPE or UNION_TYPE node, T. 4479 FIELDLIST is a chain of FIELD_DECL nodes for the fields. 4480 4481 We also do a pop_obstacks to match the push in start_struct. */ 4482 4483tree 4484finish_struct (t, fieldlist) 4485 register tree t, fieldlist; 4486{ 4487 register tree x; 4488 4489 /* Install struct as DECL_CONTEXT of each field decl. 4490 Also process specified field sizes. 4491 Set DECL_FIELD_SIZE to the specified size, or 0 if none specified. 4492 The specified size is found in the DECL_INITIAL. 4493 Store 0 there, except for ": 0" fields (so we can find them 4494 and delete them, below). */ 4495 4496 for (x = fieldlist; x; x = TREE_CHAIN (x)) 4497 { 4498 DECL_CONTEXT (x) = t; 4499 DECL_FIELD_SIZE (x) = 0; 4500 } 4501 4502 TYPE_FIELDS (t) = fieldlist; 4503 4504 if (pass != 1) 4505 t = layout_chill_struct_type (t); 4506 4507 /* The matching push is in start_struct. */ 4508 pop_obstacks (); 4509 4510 return t; 4511} 4512 4513/* Lay out the type T, and its element type, and so on. */ 4514 4515static void 4516layout_array_type (t) 4517 tree t; 4518{ 4519 if (TYPE_SIZE (t) != 0) 4520 return; 4521 if (TREE_CODE (TREE_TYPE (t)) == ARRAY_TYPE) 4522 layout_array_type (TREE_TYPE (t)); 4523 layout_type (t); 4524} 4525 4526/* Begin compiling the definition of an enumeration type. 4527 NAME is its name (or null if anonymous). 4528 Returns the type object, as yet incomplete. 4529 Also records info about it so that build_enumerator 4530 may be used to declare the individual values as they are read. */ 4531 4532tree 4533start_enum (name) 4534 tree name ATTRIBUTE_UNUSED; 4535{ 4536 register tree enumtype; 4537 4538 /* If this is the real definition for a previous forward reference, 4539 fill in the contents in the same object that used to be the 4540 forward reference. */ 4541 4542#if 0 4543 /* The corresponding pop_obstacks is in finish_enum. */ 4544 push_obstacks_nochange (); 4545 /* If these symbols and types are global, make them permanent. */ 4546 if (current_scope == global_scope) 4547 end_temporary_allocation (); 4548#endif 4549 4550 enumtype = make_node (ENUMERAL_TYPE); 4551/* pushtag (name, enumtype); */ 4552 return enumtype; 4553} 4554 4555/* Determine the precision this type needs. */ 4556unsigned 4557get_type_precision (minnode, maxnode) 4558 tree minnode, maxnode; 4559{ 4560 unsigned precision = 0; 4561 4562 if (TREE_INT_CST_HIGH (minnode) >= 0 4563 ? tree_int_cst_lt (TYPE_MAX_VALUE (unsigned_type_node), maxnode) 4564 : (tree_int_cst_lt (minnode, TYPE_MIN_VALUE (integer_type_node)) 4565 || tree_int_cst_lt (TYPE_MAX_VALUE (integer_type_node), maxnode))) 4566 precision = TYPE_PRECISION (long_long_integer_type_node); 4567 else 4568 { 4569 HOST_WIDE_INT maxvalue = TREE_INT_CST_LOW (maxnode); 4570 HOST_WIDE_INT minvalue = TREE_INT_CST_LOW (minnode); 4571 4572 if (maxvalue > 0) 4573 precision = floor_log2 (maxvalue) + 1; 4574 if (minvalue < 0) 4575 { 4576 /* Compute number of bits to represent magnitude of a negative value. 4577 Add one to MINVALUE since range of negative numbers 4578 includes the power of two. */ 4579 unsigned negprecision = floor_log2 (-minvalue - 1) + 1; 4580 if (negprecision > precision) 4581 precision = negprecision; 4582 precision += 1; /* room for sign bit */ 4583 } 4584 4585 if (!precision) 4586 precision = 1; 4587 } 4588 return precision; 4589} 4590 4591void 4592layout_enum (enumtype) 4593 tree enumtype; 4594{ 4595 register tree pair, tem; 4596 tree minnode = 0, maxnode = 0; 4597 unsigned precision = 0; 4598 4599 /* Do arithmetic using double integers, but don't use fold/build. */ 4600 union tree_node enum_next_node; 4601 /* This is 1 plus the last enumerator constant value. */ 4602 tree enum_next_value = &enum_next_node; 4603 4604 /* Nonzero means that there was overflow computing enum_next_value. */ 4605 int enum_overflow = 0; 4606 4607 tree values = TYPE_VALUES (enumtype); 4608 4609 if (TYPE_SIZE (enumtype) != NULL_TREE) 4610 return; 4611 4612 /* Initialize enum_next_value to zero. */ 4613 TREE_TYPE (enum_next_value) = integer_type_node; 4614 TREE_INT_CST_LOW (enum_next_value) = TREE_INT_CST_LOW (integer_zero_node); 4615 TREE_INT_CST_HIGH (enum_next_value) = TREE_INT_CST_HIGH (integer_zero_node); 4616 4617 /* After processing and defining all the values of an enumeration type, 4618 install their decls in the enumeration type and finish it off. 4619 4620 TYPE_VALUES currently contains a list of (purpose: NAME, value: DECL). 4621 This gets converted to a list of (purpose: NAME, value: VALUE). */ 4622 4623 4624 /* For each enumerator, calculate values, if defaulted. 4625 Convert to correct type (the enumtype). 4626 Also, calculate the minimum and maximum values. */ 4627 4628 for (pair = values; pair; pair = TREE_CHAIN (pair)) 4629 { 4630 tree decl = TREE_VALUE (pair); 4631 tree value = DECL_INITIAL (decl); 4632 4633 /* Remove no-op casts from the value. */ 4634 if (value != NULL_TREE) 4635 STRIP_TYPE_NOPS (value); 4636 4637 if (value != NULL_TREE) 4638 { 4639 if (TREE_CODE (value) == INTEGER_CST) 4640 { 4641 constant_expression_warning (value); 4642 if (tree_int_cst_lt (value, integer_zero_node)) 4643 { 4644 error ("enumerator value for `%s' is less then 0", 4645 IDENTIFIER_POINTER (DECL_NAME (decl))); 4646 value = error_mark_node; 4647 } 4648 } 4649 else 4650 { 4651 error ("enumerator value for `%s' not integer constant", 4652 IDENTIFIER_POINTER (DECL_NAME (decl))); 4653 value = error_mark_node; 4654 } 4655 } 4656 4657 if (value != error_mark_node) 4658 { 4659 if (value == NULL_TREE) /* Default based on previous value. */ 4660 { 4661 value = enum_next_value; 4662 if (enum_overflow) 4663 error ("overflow in enumeration values"); 4664 } 4665 value = build_int_2 (TREE_INT_CST_LOW (value), 4666 TREE_INT_CST_HIGH (value)); 4667 TREE_TYPE (value) = enumtype; 4668 DECL_INITIAL (decl) = value; 4669 CH_DERIVED_FLAG (value) = 1; 4670 4671 if (pair == values) 4672 minnode = maxnode = value; 4673 else 4674 { 4675 if (tree_int_cst_lt (maxnode, value)) 4676 maxnode = value; 4677 if (tree_int_cst_lt (value, minnode)) 4678 minnode = value; 4679 } 4680 4681 /* Set basis for default for next value. */ 4682 add_double (TREE_INT_CST_LOW (value), TREE_INT_CST_HIGH (value), 1, 0, 4683 &TREE_INT_CST_LOW (enum_next_value), 4684 &TREE_INT_CST_HIGH (enum_next_value)); 4685 enum_overflow = tree_int_cst_lt (enum_next_value, value); 4686 } 4687 else 4688 DECL_INITIAL (decl) = value; /* error_mark_node */ 4689 } 4690 4691 /* Fix all error_mark_nodes in enum. Increment maxnode and assign value. 4692 This is neccessary to make a duplicate value check in the enum */ 4693 for (pair = values; pair; pair = TREE_CHAIN (pair)) 4694 { 4695 tree decl = TREE_VALUE (pair); 4696 if (DECL_INITIAL (decl) == error_mark_node) 4697 { 4698 tree value; 4699 add_double (TREE_INT_CST_LOW (maxnode), TREE_INT_CST_HIGH (maxnode), 1, 0, 4700 &TREE_INT_CST_LOW (enum_next_value), 4701 &TREE_INT_CST_HIGH (enum_next_value)); 4702 value = build_int_2 (TREE_INT_CST_LOW (enum_next_value), 4703 TREE_INT_CST_HIGH (enum_next_value)); 4704 TREE_TYPE (value) = enumtype; 4705 CH_DERIVED_FLAG (value) = 1; 4706 DECL_INITIAL (decl) = value; 4707 4708 maxnode = value; 4709 } 4710 } 4711 4712 /* Now check if we have duplicate values within the enum */ 4713 for (pair = values; pair; pair = TREE_CHAIN (pair)) 4714 { 4715 tree succ; 4716 tree decl1 = TREE_VALUE (pair); 4717 tree val1 = DECL_INITIAL (decl1); 4718 4719 for (succ = TREE_CHAIN (pair); succ; succ = TREE_CHAIN (succ)) 4720 { 4721 if (pair != succ) 4722 { 4723 tree decl2 = TREE_VALUE (succ); 4724 tree val2 = DECL_INITIAL (decl2); 4725 if (tree_int_cst_equal (val1, val2)) 4726 error ("enumerators `%s' and `%s' have equal values", 4727 IDENTIFIER_POINTER (DECL_NAME (decl1)), 4728 IDENTIFIER_POINTER (DECL_NAME (decl2))); 4729 } 4730 } 4731 } 4732 4733 TYPE_MIN_VALUE (enumtype) = minnode; 4734 TYPE_MAX_VALUE (enumtype) = maxnode; 4735 4736 precision = get_type_precision (minnode, maxnode); 4737 4738 if (flag_short_enums || precision > TYPE_PRECISION (integer_type_node)) 4739 /* Use the width of the narrowest normal C type which is wide enough. */ 4740 TYPE_PRECISION (enumtype) = TYPE_PRECISION (type_for_size (precision, 1)); 4741 else 4742 TYPE_PRECISION (enumtype) = TYPE_PRECISION (integer_type_node); 4743 4744 layout_type (enumtype); 4745 4746#if 0 4747 /* An enum can have some negative values; then it is signed. */ 4748 TREE_UNSIGNED (enumtype) = ! tree_int_cst_lt (minnode, integer_zero_node); 4749#else 4750 /* Z200/1988 page 19 says: 4751 For each pair of integer literal expression e1, e2 in the set list NUM (e1) 4752 and NUM (e2) must deliver different non-negative results */ 4753 TREE_UNSIGNED (enumtype) = 1; 4754#endif 4755 4756 for (pair = values; pair; pair = TREE_CHAIN (pair)) 4757 { 4758 tree decl = TREE_VALUE (pair); 4759 DECL_SIZE (decl) = TYPE_SIZE (enumtype); 4760 DECL_ALIGN (decl) = TYPE_ALIGN (enumtype); 4761 4762 /* Set the TREE_VALUE to the name, rather than the decl, 4763 since that is what the rest of the compiler expects. */ 4764 TREE_VALUE (pair) = DECL_INITIAL (decl); 4765 } 4766 4767 /* Fix up all variant types of this enum type. */ 4768 for (tem = TYPE_MAIN_VARIANT (enumtype); tem; tem = TYPE_NEXT_VARIANT (tem)) 4769 { 4770 TYPE_VALUES (tem) = TYPE_VALUES (enumtype); 4771 TYPE_MIN_VALUE (tem) = TYPE_MIN_VALUE (enumtype); 4772 TYPE_MAX_VALUE (tem) = TYPE_MAX_VALUE (enumtype); 4773 TYPE_SIZE (tem) = TYPE_SIZE (enumtype); 4774 TYPE_MODE (tem) = TYPE_MODE (enumtype); 4775 TYPE_PRECISION (tem) = TYPE_PRECISION (enumtype); 4776 TYPE_ALIGN (tem) = TYPE_ALIGN (enumtype); 4777 TREE_UNSIGNED (tem) = TREE_UNSIGNED (enumtype); 4778 } 4779 4780#if 0 4781 /* This matches a push in start_enum. */ 4782 pop_obstacks (); 4783#endif 4784} 4785 4786tree 4787finish_enum (enumtype, values) 4788 register tree enumtype, values; 4789{ 4790 TYPE_VALUES (enumtype) = values = nreverse (values); 4791 4792 /* If satisfy_decl is called on one of the enum CONST_DECLs, 4793 this will make sure that the enumtype gets laid out then. */ 4794 for ( ; values; values = TREE_CHAIN (values)) 4795 TREE_TYPE (TREE_VALUE (values)) = enumtype; 4796 4797 return enumtype; 4798} 4799 4800 4801/* Build and install a CONST_DECL for one value of the 4802 current enumeration type (one that was begun with start_enum). 4803 Return a tree-list containing the CONST_DECL and its value. 4804 Assignment of sequential values by default is handled here. */ 4805 4806tree 4807build_enumerator (name, value) 4808 tree name, value; 4809{ 4810 register tree decl; 4811 int named = name != NULL_TREE; 4812 4813 if (pass == 2) 4814 { 4815 if (name) 4816 (void) get_next_decl (); 4817 return NULL_TREE; 4818 } 4819 4820 if (name == NULL_TREE) 4821 { 4822 static int unnamed_value_warned = 0; 4823 static int next_dummy_enum_value = 0; 4824 char buf[20]; 4825 if (!unnamed_value_warned) 4826 { 4827 unnamed_value_warned = 1; 4828 warning ("undefined value in SET mode is obsolete and deprecated."); 4829 } 4830 sprintf (buf, "__star_%d", next_dummy_enum_value++); 4831 name = get_identifier (buf); 4832 } 4833 4834 decl = build_decl (CONST_DECL, name, integer_type_node); 4835 CH_DECL_ENUM (decl) = 1; 4836 DECL_INITIAL (decl) = value; 4837 if (named) 4838 { 4839 if (pass == 0) 4840 { 4841 push_obstacks_nochange (); 4842 pushdecl (decl); 4843 finish_decl (decl); 4844 } 4845 else 4846 save_decl (decl); 4847 } 4848 return build_tree_list (name, decl); 4849 4850#if 0 4851 tree old_value = lookup_name_current_level (name); 4852 4853 if (old_value != NULL_TREE 4854 && TREE_CODE (old_value)=!= CONST_DECL 4855 && (value == NULL_TREE || operand_equal_p (value, old_value, 1))) 4856 { 4857 if (value == NULL_TREE) 4858 { 4859 if (TREE_CODE (old_value) == CONST_DECL) 4860 value = DECL_INITIAL (old_value); 4861 else 4862 abort (); 4863 } 4864 return saveable_tree_cons (old_value, value, NULL_TREE); 4865 } 4866#endif 4867} 4868 4869/* Record that this function is going to be a varargs function. 4870 This is called before store_parm_decls, which is too early 4871 to call mark_varargs directly. */ 4872 4873void 4874c_mark_varargs () 4875{ 4876 c_function_varargs = 1; 4877} 4878 4879/* Function needed for CHILL interface. */ 4880tree 4881get_parm_decls () 4882{ 4883 return current_function_parms; 4884} 4885 4886/* Save and restore the variables in this file and elsewhere 4887 that keep track of the progress of compilation of the current function. 4888 Used for nested functions. */ 4889 4890struct c_function 4891{ 4892 struct c_function *next; 4893 struct scope *scope; 4894 tree chill_result_decl; 4895 int result_never_set; 4896}; 4897 4898struct c_function *c_function_chain; 4899 4900/* Save and reinitialize the variables 4901 used during compilation of a C function. */ 4902 4903void 4904push_chill_function_context () 4905{ 4906 struct c_function *p 4907 = (struct c_function *) xmalloc (sizeof (struct c_function)); 4908 4909 push_function_context (); 4910 4911 p->next = c_function_chain; 4912 c_function_chain = p; 4913 4914 p->scope = current_scope; 4915 p->chill_result_decl = chill_result_decl; 4916 p->result_never_set = result_never_set; 4917} 4918 4919/* Restore the variables used during compilation of a C function. */ 4920 4921void 4922pop_chill_function_context () 4923{ 4924 struct c_function *p = c_function_chain; 4925#if 0 4926 tree link; 4927 /* Bring back all the labels that were shadowed. */ 4928 for (link = shadowed_labels; link; link = TREE_CHAIN (link)) 4929 if (DECL_NAME (TREE_VALUE (link)) != 0) 4930 IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link))) 4931 = TREE_VALUE (link); 4932#endif 4933 4934 pop_function_context (); 4935 4936 c_function_chain = p->next; 4937 4938 current_scope = p->scope; 4939 chill_result_decl = p->chill_result_decl; 4940 result_never_set = p->result_never_set; 4941 4942 free (p); 4943} 4944 4945/* Following from Jukka Virtanen's GNU Pascal */ 4946/* To implement WITH statement: 4947 4948 1) Call shadow_record_fields for each record_type element in the WITH 4949 element list. Each call creates a new binding level. 4950 4951 2) construct a component_ref for EACH field in the record, 4952 and store it to the IDENTIFIER_LOCAL_VALUE after adding 4953 the old value to the shadow list 4954 4955 3) let lookup_name do the rest 4956 4957 4) pop all of the binding levels after the WITH statement ends. 4958 (restoring old local values) You have to keep track of the number 4959 of times you called it. 4960*/ 4961 4962/* 4963 * Save an arbitrary tree-expression as the IDENTIFIER_LOCAL_VALUE 4964 * of a name. Save the name's previous value. Check for name 4965 * collisions with another value under the same name at the same 4966 * nesting level. This is used to implement the DO WITH construct 4967 * and the temporary for the location iteration loop. 4968 */ 4969void 4970save_expr_under_name (name, expr) 4971 tree name, expr; 4972{ 4973 tree alias = build_alias_decl (NULL_TREE, NULL_TREE, name); 4974 4975 DECL_ABSTRACT_ORIGIN (alias) = expr; 4976 TREE_CHAIN (alias) = NULL_TREE; 4977 pushdecllist (alias, 0); 4978} 4979 4980void 4981do_based_decl (name, mode, base_var) 4982 tree name, mode, base_var; 4983{ 4984 tree decl; 4985 if (pass == 1) 4986 { 4987 push_obstacks (&permanent_obstack, &permanent_obstack); 4988 decl = make_node (BASED_DECL); 4989 DECL_NAME (decl) = name; 4990 TREE_TYPE (decl) = mode; 4991 DECL_ABSTRACT_ORIGIN (decl) = base_var; 4992 save_decl (decl); 4993 pop_obstacks (); 4994 } 4995 else 4996 { 4997 tree base_decl; 4998 decl = get_next_decl (); 4999 if (name != DECL_NAME (decl)) 5000 abort(); 5001 /* FIXME: This isn't a complete test */ 5002 base_decl = lookup_name (base_var); 5003 if (base_decl == NULL_TREE) 5004 error ("BASE variable never declared"); 5005 else if (TREE_CODE (base_decl) == FUNCTION_DECL) 5006 error ("cannot BASE a variable on a PROC/PROCESS name"); 5007 } 5008} 5009 5010void 5011do_based_decls (names, mode, base_var) 5012 tree names, mode, base_var; 5013{ 5014 if (names == NULL_TREE || TREE_CODE (names) == TREE_LIST) 5015 { 5016 for (; names != NULL_TREE; names = TREE_CHAIN (names)) 5017 do_based_decl (names, mode, base_var); 5018 } 5019 else if (TREE_CODE (names) != ERROR_MARK) 5020 do_based_decl (names, mode, base_var); 5021} 5022 5023/* 5024 * Declare the fields so that lookup_name() will find them as 5025 * component refs for Pascal WITH or CHILL DO WITH. 5026 * 5027 * Proceeds to the inner layers of Pascal/CHILL variant record 5028 * 5029 * Internal routine of shadow_record_fields () 5030 */ 5031static void 5032handle_one_level (parent, fields) 5033 tree parent, fields; 5034{ 5035 tree field, name; 5036 5037 switch (TREE_CODE (TREE_TYPE (parent))) 5038 { 5039 case RECORD_TYPE: 5040 case UNION_TYPE: 5041 for (field = fields; field; field = TREE_CHAIN (field)) { 5042 name = DECL_NAME (field); 5043 if (name == NULL_TREE || name == ELSE_VARIANT_NAME) 5044 /* proceed through variant part */ 5045 handle_one_level (parent, TYPE_FIELDS (TREE_TYPE (field))); 5046 else 5047 { 5048 tree field_alias = make_node (WITH_DECL); 5049 DECL_NAME (field_alias) = name; 5050 TREE_TYPE (field_alias) = TREE_TYPE (field); 5051 DECL_ABSTRACT_ORIGIN (field_alias) = parent; 5052 TREE_CHAIN (field_alias) = NULL_TREE; 5053 pushdecllist (field_alias, 0); 5054 } 5055 } 5056 break; 5057 default: 5058 error ("INTERNAL ERROR: handle_one_level is broken"); 5059 } 5060} 5061 5062/* 5063 * For each FIELD_DECL node in a RECORD_TYPE, we have to declare 5064 * a name so that lookup_name will find a COMPONENT_REF node 5065 * when the name is referenced. This happens in Pascal WITH statement. 5066 */ 5067void 5068shadow_record_fields (struct_val) 5069 tree struct_val; 5070{ 5071 if (pass == 1 || struct_val == NULL_TREE) 5072 return; 5073 5074 handle_one_level (struct_val, TYPE_FIELDS (TREE_TYPE (struct_val))); 5075} 5076 5077static char exception_prefix [] = "__Ex_"; 5078 5079tree 5080build_chill_exception_decl (name) 5081 char *name; 5082{ 5083 tree decl, ex_name, ex_init, ex_type; 5084 int name_len = strlen (name); 5085 char *ex_string = (char *) 5086 alloca (strlen (exception_prefix) + name_len + 1); 5087 5088 sprintf(ex_string, "%s%s", exception_prefix, name); 5089 ex_name = get_identifier (ex_string); 5090 decl = IDENTIFIER_LOCAL_VALUE (ex_name); 5091 if (decl) 5092 return decl; 5093 5094 /* finish_decl is too eager about switching back to the 5095 ambient context. This decl's rtl must live in the permanent_obstack. */ 5096 push_obstacks (&permanent_obstack, &permanent_obstack); 5097 push_obstacks_nochange (); 5098 ex_type = build_array_type (char_type_node, 5099 build_index_2_type (integer_zero_node, 5100 build_int_2 (name_len, 0))); 5101 decl = build_lang_decl (VAR_DECL, ex_name, ex_type); 5102 ex_init = build_string (name_len, name); 5103 TREE_TYPE (ex_init) = ex_type; 5104 DECL_INITIAL (decl) = ex_init; 5105 TREE_READONLY (decl) = 1; 5106 TREE_STATIC (decl) = 1; 5107 pushdecl_top_level (decl); 5108 finish_decl (decl); 5109 pop_obstacks (); /* Return to the ambient context. */ 5110 return decl; 5111} 5112 5113extern tree module_init_list; 5114 5115/* 5116 * This function is called from the parser to preface the entire 5117 * compilation. It contains module-level actions and reach-bound 5118 * initialization. 5119 */ 5120void 5121start_outer_function () 5122{ 5123 start_chill_function (pass < 2 ? get_identifier ("_GLOBAL_") 5124 : DECL_NAME (global_function_decl), 5125 void_type_node, NULL_TREE, NULL_TREE, NULL_TREE); 5126 global_function_decl = current_function_decl; 5127 global_scope = current_scope; 5128 chill_at_module_level = 1; 5129} 5130 5131/* This function finishes the global_function_decl, and if it is non-empty 5132 * (as indiacted by seen_action), adds it to module_init_list. 5133 */ 5134void 5135finish_outer_function () 5136{ 5137 /* If there was module-level code in this module (not just function 5138 declarations), we allocate space for this module's init list entry, 5139 and fill in the module's function's address. */ 5140 5141 extern tree initializer_type; 5142 char *fname_str = IDENTIFIER_POINTER (DECL_NAME (current_function_decl)); 5143 char *init_entry_name = (char *)xmalloc ((unsigned)(strlen (fname_str) + 20)); 5144 tree init_entry_id; 5145 tree init_entry_decl; 5146 tree initializer; 5147 5148 finish_chill_function (); 5149 5150 chill_at_module_level = 0; 5151 5152 5153 if (!seen_action) 5154 return; 5155 5156 sprintf (init_entry_name, "__tmp_%s_init_entry", fname_str); 5157 init_entry_id = get_identifier (init_entry_name); 5158 5159 init_entry_decl = build1 (ADDR_EXPR, 5160 TREE_TYPE (TYPE_FIELDS (initializer_type)), 5161 global_function_decl); 5162 TREE_CONSTANT (init_entry_decl) = 1; 5163 initializer = build (CONSTRUCTOR, initializer_type, NULL_TREE, 5164 tree_cons (NULL_TREE, init_entry_decl, 5165 build_tree_list (NULL_TREE, 5166 null_pointer_node))); 5167 TREE_CONSTANT (initializer) = 1; 5168 init_entry_decl 5169 = do_decl (init_entry_id, initializer_type, 1, 1, initializer, 0); 5170 DECL_SOURCE_LINE (init_entry_decl) = 0; 5171 if (pass == 1) 5172 /* tell chill_finish_compile that there's 5173 module-level code to be processed. */ 5174 module_init_list = integer_one_node; 5175 else if (build_constructor) 5176 module_init_list = tree_cons (global_function_decl, 5177 init_entry_decl, 5178 module_init_list); 5179 5180 make_decl_rtl (global_function_decl, NULL, 0); 5181} 5182