gcc/ch/grant.c

   1 /* Implement grant-file output & seize-file input for CHILL.
   2    Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001
   3    Free Software Foundation, Inc.
   4
   5 This file is part of GNU CC.
   6
   7 GNU CC is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU CC is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU CC; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 #include "config.h"
  23 #include "system.h"
  24 #include "tree.h"
  25 #include "ch-tree.h"
  26 #include "lex.h"
  27 #include "flags.h"
  28 #include "actions.h"
  29 #include "input.h"
  30 #include "rtl.h"
  31 #include "tasking.h"
  32 #include "toplev.h"
  33 #include "output.h"
  34 #include "target.h"
  35
  36 #define APPEND(X,Y) X = append (X, Y)
  37 #define PREPEND(X,Y) X = prepend (X, Y);
  38 #define FREE(x) strfree (x)
  39 #define ALLOCAMOUNT     10000
  40 /* may be we can handle this in a more exciting way,
  41    but this also should work for the moment */
  42 #define MAYBE_NEWLINE(X)                       \
  43 do                                             \
  44 {                                              \
  45   if (X->len && X->str[X->len - 1] != '\n')    \
  46     APPEND (X, ";\n");                         \
  47 } while (0)
  48
  49 extern tree process_type;
  50 extern char *asm_file_name;
  51 extern char *dump_base_name;
  52
  53 /* forward declarations */
  54
  55 /* variable indicates compilation at module level */
  56 int chill_at_module_level = 0;
  57
  58
  59 /* mark that a SPEC MODULE was generated */
  60 static int spec_module_generated = 0;
  61
  62 /* define a faster string handling */
  63 typedef struct
  64 {
  65   char  *str;
  66   int           len;
  67   int           allocated;
  68 } MYSTRING;
  69
  70 /* structure used for handling multiple grant files */
  71 char    *grant_file_name;
  72 MYSTRING        *gstring = NULL;
  73 MYSTRING        *selective_gstring = NULL;
  74
  75 static MYSTRING *decode_decl                PARAMS ((tree));
  76 static MYSTRING *decode_constant            PARAMS ((tree));
  77 static void      grant_one_decl             PARAMS ((tree));
  78 static MYSTRING *get_type                   PARAMS ((tree));
  79 static MYSTRING *decode_mode                PARAMS ((tree));
  80 static MYSTRING *decode_prefix_rename       PARAMS ((tree));
  81 static MYSTRING *decode_constant_selective  PARAMS ((tree, tree));
  82 static MYSTRING *decode_mode_selective      PARAMS ((tree, tree));
  83 static MYSTRING *get_type_selective         PARAMS ((tree, tree));
  84 static MYSTRING *decode_decl_selective      PARAMS ((tree, tree));
  85 static MYSTRING *newstring                  PARAMS ((const char *));
  86 static void strfree                         PARAMS ((MYSTRING *));
  87 static MYSTRING *append                     PARAMS ((MYSTRING *, const char *));
  88 static MYSTRING *prepend                    PARAMS ((MYSTRING *, const char *));
  89 static void grant_use_seizefile             PARAMS ((const char *));
  90 static MYSTRING *decode_layout              PARAMS ((tree));
  91 static MYSTRING *grant_array_type           PARAMS ((tree));
  92 static MYSTRING *grant_array_type_selective PARAMS ((tree, tree));
  93 static MYSTRING *get_tag_value              PARAMS ((tree));
  94 static MYSTRING *get_tag_value_selective    PARAMS ((tree, tree));
  95 static MYSTRING *print_enumeral             PARAMS ((tree));
  96 static MYSTRING *print_enumeral_selective   PARAMS ((tree, tree));
  97 static MYSTRING *print_integer_type         PARAMS ((tree));
  98 static tree find_enum_parent                PARAMS ((tree, tree));
  99 static MYSTRING *print_integer_selective    PARAMS ((tree, tree));
 100 static MYSTRING *print_struct               PARAMS ((tree));
 101 static MYSTRING *print_struct_selective     PARAMS ((tree, tree));
 102 static MYSTRING *print_proc_exceptions      PARAMS ((tree));
 103 static MYSTRING *print_proc_tail            PARAMS ((tree, tree, int));
 104 static MYSTRING *print_proc_tail_selective  PARAMS ((tree, tree, tree));
 105 static tree find_in_decls                   PARAMS ((tree, tree));
 106 static int in_ridpointers                   PARAMS ((tree));
 107 static void grant_seized_identifier         PARAMS ((tree));
 108 static void globalize_decl                  PARAMS ((tree));
 109 static void grant_one_decl_selective        PARAMS ((tree, tree));
 110 static int compare_memory_file              PARAMS ((const char *, const char *));
 111 static int search_in_list                   PARAMS ((tree, tree));
 112 static int really_grant_this                PARAMS ((tree, tree));
 113
 114 /* list of the VAR_DECLs of the module initializer entries */
 115 tree      module_init_list = NULL_TREE;
 116
 117 /* handle different USE_SEIZE_FILE's in case of selective granting */
 118 typedef struct SEIZEFILELIST
 119 {
 120   struct SEIZEFILELIST *next;
 121   tree filename;
 122   MYSTRING *seizes;
 123 } seizefile_list;
 124
 125 static seizefile_list *selective_seizes = 0;
 126
 127 \f
 128 static MYSTRING *
 129 newstring (str)
 130     const char  *str;
 131 {
 132     MYSTRING    *tmp = (MYSTRING *) xmalloc (sizeof (MYSTRING));
 133     unsigned    len = strlen (str);
 134
 135     tmp->allocated = len + ALLOCAMOUNT;
 136     tmp->str = xmalloc ((unsigned)tmp->allocated);
 137     strcpy (tmp->str, str);
 138     tmp->len = len;
 139     return (tmp);
 140 }
 141
 142 static void
 143 strfree (str)
 144     MYSTRING    *str;
 145 {
 146     free (str->str);
 147     free (str);
 148 }
 149
 150 static MYSTRING *
 151 append (inout, in)
 152     MYSTRING    *inout;
 153     const char  *in;
 154 {
 155     int inlen = strlen (in);
 156     int amount = ALLOCAMOUNT;
 157
 158     if (inlen >= amount)
 159       amount += inlen;
 160     if ((inout->len + inlen) >= inout->allocated)
 161         inout->str = xrealloc (inout->str, inout->allocated += amount);
 162     strcpy (inout->str + inout->len, in);
 163     inout->len += inlen;
 164     return (inout);
 165 }
 166
 167 static MYSTRING *
 168 prepend (inout, in)
 169     MYSTRING    *inout;
 170     const char  *in;
 171 {
 172   MYSTRING *res = inout;
 173   if (strlen (in))
 174     {
 175       res = newstring (in);
 176       res = APPEND (res, inout->str);
 177       FREE (inout);
 178     }
 179   return res;
 180 }
 181 \f
 182 static void
 183 grant_use_seizefile (seize_filename)
 184      const char *seize_filename;
 185 {
 186   APPEND (gstring, "<> USE_SEIZE_FILE \"");
 187   APPEND (gstring, seize_filename);
 188   APPEND (gstring, "\" <>\n");
 189 }
 190
 191 static MYSTRING *
 192 decode_layout (layout)
 193     tree layout;
 194 {
 195   tree temp;
 196   tree stepsize = NULL_TREE;
 197   int  was_step = 0;
 198   MYSTRING *result = newstring ("");
 199   MYSTRING *work;
 200
 201   if (layout == integer_zero_node) /* NOPACK */
 202     {
 203       APPEND (result, " NOPACK");
 204       return result;
 205     }
 206
 207   if (layout == integer_one_node) /* PACK */
 208     {
 209       APPEND (result, " PACK");
 210       return result;
 211     }
 212
 213   APPEND (result, " ");
 214   temp = layout;
 215   if (TREE_PURPOSE (temp) == NULL_TREE)
 216     {
 217       APPEND (result, "STEP(");
 218       was_step = 1;
 219       temp = TREE_VALUE (temp);
 220       stepsize = TREE_VALUE (temp);
 221     }
 222   APPEND (result, "POS(");
 223
 224   /* Get the starting word */
 225   temp = TREE_PURPOSE (temp);
 226   work = decode_constant (TREE_PURPOSE (temp));
 227   APPEND (result, work->str);
 228   FREE (work);
 229
 230   temp = TREE_VALUE (temp);
 231   if (temp != NULL_TREE)
 232     {
 233       /* Get the starting bit */
 234       APPEND (result, ", ");
 235       work = decode_constant (TREE_PURPOSE (temp));
 236       APPEND (result, work->str);
 237       FREE (work);
 238
 239       temp = TREE_VALUE (temp);
 240       if (temp != NULL_TREE)
 241         {
 242           /* Get the length or the ending bit */
 243           tree what = TREE_PURPOSE (temp);
 244           if (what == integer_zero_node) /* length */
 245             {
 246               APPEND (result, ", ");
 247             }
 248           else
 249             {
 250               APPEND (result, ":");
 251             }
 252           work = decode_constant (TREE_VALUE (temp));
 253           APPEND (result, work->str);
 254           FREE (work);
 255         }
 256     }
 257   APPEND (result, ")");
 258
 259   if (was_step)
 260     {
 261       if (stepsize != NULL_TREE)
 262         {
 263           APPEND (result, ", ");
 264           work = decode_constant (stepsize);
 265           APPEND (result, work->str);
 266           FREE (work);
 267         }
 268       APPEND (result, ")");
 269     }
 270
 271   return result;
 272 }
 273
 274 static MYSTRING *
 275 grant_array_type (type)
 276      tree type;
 277 {
 278   MYSTRING      *result = newstring ("");
 279   MYSTRING      *mode_string;
 280   tree           layout;
 281   int            varying = 0;
 282
 283   if (chill_varying_type_p (type))
 284     {
 285       varying = 1;
 286       type = CH_VARYING_ARRAY_TYPE (type);
 287     }
 288   if (CH_STRING_TYPE_P (type))
 289     {
 290       tree fields = TYPE_DOMAIN (type);
 291       tree maxval = TYPE_MAX_VALUE (fields);
 292
 293       if (TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
 294         APPEND (result, "CHARS (");
 295       else
 296         APPEND (result, "BOOLS (");
 297       if (TREE_CODE (maxval) == INTEGER_CST)
 298         {
 299           char  wrk[20];
 300           sprintf (wrk, HOST_WIDE_INT_PRINT_DEC,
 301                    TREE_INT_CST_LOW (maxval) + 1);
 302           APPEND (result, wrk);
 303         }
 304       else if (TREE_CODE (maxval) == MINUS_EXPR
 305                && TREE_OPERAND (maxval, 1) == integer_one_node)
 306         {
 307           mode_string = decode_constant (TREE_OPERAND (maxval, 0));
 308           APPEND (result, mode_string->str);
 309           FREE (mode_string);
 310         }
 311       else
 312         {
 313           mode_string = decode_constant (maxval);
 314           APPEND (result, mode_string->str);
 315           FREE (mode_string);
 316           APPEND (result, "+1");
 317         }
 318       APPEND (result, ")");
 319       if (varying)
 320         APPEND (result, " VARYING");
 321       return result;
 322     }
 323
 324   APPEND (result, "ARRAY (");
 325   if (TREE_CODE (TYPE_DOMAIN (type)) == INTEGER_TYPE
 326      && TREE_TYPE (TYPE_DOMAIN (type)) == ridpointers[(int) RID_RANGE])
 327     {
 328       mode_string = decode_constant (TYPE_MIN_VALUE (TYPE_DOMAIN (type)));
 329       APPEND (result, mode_string->str);
 330       FREE (mode_string);
 331
 332       APPEND (result, ":");
 333       mode_string = decode_constant (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
 334       APPEND (result, mode_string->str);
 335       FREE (mode_string);
 336     }
 337   else
 338     {
 339       mode_string = decode_mode (TYPE_DOMAIN (type));
 340       APPEND (result, mode_string->str);
 341       FREE (mode_string);
 342     }
 343   APPEND (result, ") ");
 344   if (varying)
 345     APPEND (result, "VARYING ");
 346
 347   mode_string = get_type (TREE_TYPE (type));
 348   APPEND (result, mode_string->str);
 349   FREE (mode_string);
 350
 351   layout = TYPE_ATTRIBUTES (type);
 352   if (layout != NULL_TREE)
 353     {
 354       mode_string = decode_layout (layout);
 355       APPEND (result, mode_string->str);
 356       FREE (mode_string);
 357     }
 358
 359   return result;
 360 }
 361
 362 static MYSTRING *
 363 grant_array_type_selective (type, all_decls)
 364      tree type;
 365      tree all_decls;
 366 {
 367   MYSTRING      *result = newstring ("");
 368   MYSTRING      *mode_string;
 369   int            varying = 0;
 370
 371   if (chill_varying_type_p (type))
 372     {
 373       varying = 1;
 374       type = CH_VARYING_ARRAY_TYPE (type);
 375     }
 376   if (CH_STRING_TYPE_P (type))
 377     {
 378       tree fields = TYPE_DOMAIN (type);
 379       tree maxval = TYPE_MAX_VALUE (fields);
 380
 381       if (TREE_CODE (maxval) != INTEGER_CST)
 382         {
 383           if (TREE_CODE (maxval) == MINUS_EXPR
 384               && TREE_OPERAND (maxval, 1) == integer_one_node)
 385             {
 386               mode_string = decode_constant_selective (TREE_OPERAND (maxval, 0), all_decls);
 387               if (mode_string->len)
 388                 APPEND (result, mode_string->str);
 389               FREE (mode_string);
 390             }
 391           else
 392             {
 393               mode_string = decode_constant_selective (maxval, all_decls);
 394               if (mode_string->len)
 395                 APPEND (result, mode_string->str);
 396               FREE (mode_string);
 397             }
 398         }
 399       return result;
 400     }
 401
 402   if (TREE_CODE (TYPE_DOMAIN (type)) == INTEGER_TYPE
 403      && TREE_TYPE (TYPE_DOMAIN (type)) == ridpointers[(int) RID_RANGE])
 404     {
 405       mode_string = decode_constant_selective (TYPE_MIN_VALUE (TYPE_DOMAIN (type)), all_decls);
 406       if (mode_string->len)
 407         APPEND (result, mode_string->str);
 408       FREE (mode_string);
 409
 410       mode_string = decode_constant_selective (TYPE_MAX_VALUE (TYPE_DOMAIN (type)), all_decls);
 411       if (mode_string->len)
 412         {
 413           MAYBE_NEWLINE (result);
 414           APPEND (result, mode_string->str);
 415         }
 416       FREE (mode_string);
 417     }
 418   else
 419     {
 420       mode_string = decode_mode_selective (TYPE_DOMAIN (type), all_decls);
 421       if (mode_string->len)
 422         APPEND (result, mode_string->str);
 423       FREE (mode_string);
 424     }
 425
 426   mode_string = get_type_selective (TREE_TYPE (type),  all_decls);
 427   if (mode_string->len)
 428     {
 429       MAYBE_NEWLINE (result);
 430       APPEND (result, mode_string->str);
 431     }
 432   FREE (mode_string);
 433
 434   return result;
 435 }
 436 \f
 437 static MYSTRING *
 438 get_tag_value (val)
 439     tree        val;
 440 {
 441   MYSTRING      *result;
 442
 443   if (TREE_CODE (val) == CONST_DECL && DECL_NAME (val))
 444     {
 445       result = newstring (IDENTIFIER_POINTER (DECL_NAME (val)));
 446     }
 447   else if (TREE_CODE (val) == CONST_DECL)
 448     {
 449       /* it's a synonym -- get the value */
 450       result = decode_constant (DECL_INITIAL (val));
 451     }
 452   else
 453     {
 454       result = decode_constant (val);
 455     }
 456   return (result);
 457 }
 458
 459 static MYSTRING *
 460 get_tag_value_selective (val, all_decls)
 461     tree        val;
 462     tree        all_decls;
 463 {
 464   MYSTRING      *result;
 465
 466   if (TREE_CODE (val) == CONST_DECL && DECL_NAME (val))
 467       result = newstring ("");
 468   else if (TREE_CODE (val) == CONST_DECL)
 469     {
 470       /* it's a synonym -- get the value */
 471       result = decode_constant_selective (DECL_INITIAL (val), all_decls);
 472     }
 473   else
 474     {
 475       result = decode_constant_selective (val, all_decls);
 476     }
 477   return (result);
 478 }
 479 \f
 480 static MYSTRING *
 481 print_enumeral (type)
 482      tree type;
 483 {
 484   MYSTRING      *result = newstring ("");
 485   tree  fields;
 486
 487 #if 0
 488   if (TYPE_LANG_SPECIFIC (type) == NULL)
 489 #endif
 490     {
 491
 492       APPEND (result, "SET (");
 493       for (fields = TYPE_VALUES (type);
 494            fields != NULL_TREE;
 495            fields = TREE_CHAIN (fields))
 496         {
 497           if (TREE_PURPOSE (fields) == NULL_TREE)
 498             APPEND (result, "*");
 499           else
 500             {
 501               tree decl = TREE_VALUE (fields);
 502               APPEND (result, IDENTIFIER_POINTER (TREE_PURPOSE (fields)));
 503               if (TREE_CODE (decl) == CONST_DECL && DECL_INITIAL (decl))
 504                 {
 505                   MYSTRING *val_string = decode_constant (DECL_INITIAL (decl));
 506                   APPEND (result, " = ");
 507                   APPEND (result, val_string->str);
 508                   FREE (val_string);
 509                 }
 510             }
 511           if (TREE_CHAIN (fields) != NULL_TREE)
 512             APPEND (result, ",\n     ");
 513         }
 514       APPEND (result, ")");
 515     }
 516   return result;
 517 }
 518
 519 static MYSTRING *
 520 print_enumeral_selective (type, all_decls)
 521      tree type;
 522      tree all_decls;
 523 {
 524   MYSTRING      *result = newstring ("");
 525   tree  fields;
 526
 527   for (fields = TYPE_VALUES (type);
 528        fields != NULL_TREE;
 529        fields = TREE_CHAIN (fields))
 530     {
 531       if (TREE_PURPOSE (fields) != NULL_TREE)
 532         {
 533           tree decl = TREE_VALUE (fields);
 534           if (TREE_CODE (decl) == CONST_DECL && DECL_INITIAL (decl))
 535             {
 536               MYSTRING *val_string = decode_constant_selective (DECL_INITIAL (decl), all_decls);
 537               if (val_string->len)
 538                 APPEND (result, val_string->str);
 539               FREE (val_string);
 540             }
 541         }
 542     }
 543   return result;
 544 }
 545 \f
 546 static MYSTRING *
 547 print_integer_type (type)
 548      tree type;
 549 {
 550   MYSTRING *result = newstring ("");
 551   MYSTRING *mode_string;
 552   const char *name_ptr;
 553   tree      base_type;
 554
 555   if (TREE_TYPE (type))
 556     {
 557       mode_string = decode_mode (TREE_TYPE (type));
 558       APPEND (result, mode_string->str);
 559       FREE (mode_string);
 560
 561       APPEND (result, "(");
 562       mode_string = decode_constant (TYPE_MIN_VALUE (type));
 563       APPEND (result, mode_string->str);
 564       FREE (mode_string);
 565
 566       if (TREE_TYPE (type) != ridpointers[(int) RID_BIN])
 567         {
 568           APPEND (result, ":");
 569           mode_string = decode_constant (TYPE_MAX_VALUE (type));
 570           APPEND (result, mode_string->str);
 571           FREE (mode_string);
 572         }
 573
 574       APPEND (result, ")");
 575       return result;
 576     }
 577   /* We test TYPE_MAIN_VARIANT because pushdecl often builds
 578      a copy of a built-in type node, which is logically id-
 579      entical but has a different address, and the same
 580      TYPE_MAIN_VARIANT. */
 581   /* FIXME this should not be needed! */
 582
 583   base_type = TREE_TYPE (type) ? TREE_TYPE (type) : type;
 584
 585   if (TREE_UNSIGNED (base_type))
 586     {
 587       if (base_type == chill_unsigned_type_node
 588           || TYPE_MAIN_VARIANT(base_type) ==
 589              TYPE_MAIN_VARIANT (chill_unsigned_type_node))
 590         name_ptr = "UINT";
 591       else if (base_type == long_integer_type_node
 592                || TYPE_MAIN_VARIANT(base_type) ==
 593                   TYPE_MAIN_VARIANT (long_unsigned_type_node))
 594         name_ptr = "ULONG";
 595       else if (type == unsigned_char_type_node
 596                || TYPE_MAIN_VARIANT(base_type) ==
 597                   TYPE_MAIN_VARIANT (unsigned_char_type_node))
 598         name_ptr = "UBYTE";
 599       else if (type == duration_timing_type_node
 600                || TYPE_MAIN_VARIANT (base_type) ==
 601                   TYPE_MAIN_VARIANT (duration_timing_type_node))
 602         name_ptr = "DURATION";
 603       else if (type == abs_timing_type_node
 604                || TYPE_MAIN_VARIANT (base_type) ==
 605                   TYPE_MAIN_VARIANT (abs_timing_type_node))
 606         name_ptr = "TIME";
 607       else
 608         name_ptr = "UINT";
 609     }
 610   else
 611     {
 612       if (base_type == chill_integer_type_node
 613           || TYPE_MAIN_VARIANT (base_type) ==
 614              TYPE_MAIN_VARIANT (chill_integer_type_node))
 615         name_ptr = "INT";
 616       else if (base_type == long_integer_type_node
 617                || TYPE_MAIN_VARIANT (base_type) ==
 618                   TYPE_MAIN_VARIANT (long_integer_type_node))
 619         name_ptr = "LONG";
 620       else if (type == signed_char_type_node
 621                || TYPE_MAIN_VARIANT (base_type) ==
 622                   TYPE_MAIN_VARIANT (signed_char_type_node))
 623         name_ptr = "BYTE";
 624       else
 625         name_ptr = "INT";
 626     }
 627
 628   APPEND (result, name_ptr);
 629
 630   /* see if we have a range */
 631   if (TREE_TYPE (type) != NULL)
 632     {
 633       mode_string = decode_constant (TYPE_MIN_VALUE (type));
 634       APPEND (result, mode_string->str);
 635       FREE (mode_string);
 636       APPEND (result, ":");
 637       mode_string = decode_constant (TYPE_MAX_VALUE (type));
 638       APPEND (result, mode_string->str);
 639       FREE (mode_string);
 640     }
 641
 642   return result;
 643 }
 644
 645 static tree
 646 find_enum_parent (enumname, all_decls)
 647      tree enumname;
 648      tree all_decls;
 649 {
 650   tree wrk;
 651
 652   for (wrk = all_decls; wrk != NULL_TREE; wrk = TREE_CHAIN (wrk))
 653     {
 654       if (TREE_TYPE (wrk) != NULL_TREE && TREE_CODE (wrk) != CONST_DECL &&
 655           TREE_CODE (TREE_TYPE (wrk)) == ENUMERAL_TYPE)
 656         {
 657           tree list;
 658           for (list = TYPE_VALUES (TREE_TYPE (wrk)); list != NULL_TREE; list = TREE_CHAIN (list))
 659             {
 660               if (DECL_NAME (TREE_VALUE (list)) == enumname)
 661                 return wrk;
 662             }
 663         }
 664     }
 665   return NULL_TREE;
 666 }
 667
 668 static MYSTRING *
 669 print_integer_selective (type, all_decls)
 670      tree type;
 671      tree all_decls;
 672 {
 673   MYSTRING *result = newstring ("");
 674   MYSTRING *mode_string;
 675
 676   if (TREE_TYPE (type))
 677     {
 678       mode_string = decode_mode_selective (TREE_TYPE (type), all_decls);
 679       if (mode_string->len)
 680         APPEND (result, mode_string->str);
 681       FREE (mode_string);
 682
 683       if (TREE_TYPE (type) == ridpointers[(int)RID_RANGE] &&
 684           TREE_CODE (TYPE_MIN_VALUE (type)) == IDENTIFIER_NODE &&
 685           TREE_CODE (TYPE_MAX_VALUE (type)) == IDENTIFIER_NODE)
 686         {
 687           /* we have a range of a set. Find parant mode and write it
 688              to SPEC MODULE. This will loose if the parent mode was SEIZED from
 689              another file.*/
 690           tree minparent = find_enum_parent (TYPE_MIN_VALUE (type), all_decls);
 691           tree maxparent = find_enum_parent (TYPE_MAX_VALUE (type), all_decls);
 692
 693           if (minparent != NULL_TREE)
 694             {
 695               if (! CH_ALREADY_GRANTED (minparent))
 696                 {
 697                   mode_string = decode_decl (minparent);
 698                   if (mode_string->len)
 699                     APPEND (result, mode_string->str);
 700                   FREE (mode_string);
 701                   CH_ALREADY_GRANTED (minparent) = 1;
 702                 }
 703             }
 704           if (minparent != maxparent && maxparent != NULL_TREE)
 705             {
 706               if (!CH_ALREADY_GRANTED (maxparent))
 707                 {
 708                   mode_string = decode_decl (maxparent);
 709                   if (mode_string->len)
 710                     {
 711                       MAYBE_NEWLINE (result);
 712                       APPEND (result, mode_string->str);
 713                     }
 714                   FREE (mode_string);
 715                   CH_ALREADY_GRANTED (maxparent) = 1;
 716                 }
 717             }
 718         }
 719       else
 720         {
 721           mode_string = decode_constant_selective (TYPE_MIN_VALUE (type), all_decls);
 722           if (mode_string->len)
 723             {
 724               MAYBE_NEWLINE (result);
 725               APPEND (result, mode_string->str);
 726             }
 727           FREE (mode_string);
 728
 729           mode_string = decode_constant_selective (TYPE_MAX_VALUE (type), all_decls);
 730           if (mode_string->len)
 731             {
 732               MAYBE_NEWLINE (result);
 733               APPEND (result, mode_string->str);
 734             }
 735           FREE (mode_string);
 736         }
 737       return result;
 738     }
 739
 740   /* see if we have a range */
 741   if (TREE_TYPE (type) != NULL)
 742     {
 743       mode_string = decode_constant_selective (TYPE_MIN_VALUE (type), all_decls);
 744       if (mode_string->len)
 745         APPEND (result, mode_string->str);
 746       FREE (mode_string);
 747
 748       mode_string = decode_constant_selective (TYPE_MAX_VALUE (type), all_decls);
 749       if (mode_string->len)
 750         {
 751           MAYBE_NEWLINE (result);
 752           APPEND (result, mode_string->str);
 753         }
 754       FREE (mode_string);
 755     }
 756
 757   return result;
 758 }
 759 \f
 760 static MYSTRING *
 761 print_struct (type)
 762      tree type;
 763 {
 764   MYSTRING      *result = newstring ("");
 765   MYSTRING      *mode_string;
 766   tree  fields;
 767
 768   if (chill_varying_type_p (type))
 769     {
 770       mode_string = grant_array_type (type);
 771       APPEND (result, mode_string->str);
 772       FREE (mode_string);
 773     }
 774   else
 775     {
 776       fields = TYPE_FIELDS (type);
 777
 778       APPEND (result, "STRUCT (");
 779       while (fields != NULL_TREE)
 780         {
 781           if (TREE_CODE (TREE_TYPE (fields)) == UNION_TYPE)
 782             {
 783               tree variants;
 784               /* Format a tagged variant record type.  */
 785               APPEND (result, " CASE ");
 786               if (TYPE_TAGFIELDS (TREE_TYPE (fields)) != NULL_TREE)
 787                 {
 788                   tree tag_list = TYPE_TAGFIELDS (TREE_TYPE (fields));
 789                   for (;;)
 790                     {
 791                       tree tag_name = DECL_NAME (TREE_VALUE (tag_list));
 792                       APPEND (result, IDENTIFIER_POINTER (tag_name));
 793                       tag_list = TREE_CHAIN (tag_list);
 794                       if (tag_list == NULL_TREE)
 795                         break;
 796                       APPEND (result, ", ");
 797                     }
 798                 }
 799               APPEND (result, " OF\n");
 800               variants = TYPE_FIELDS (TREE_TYPE (fields));
 801
 802               /* Each variant is a FIELD_DECL whose type is an anonymous
 803                  struct within the anonymous union.  */
 804               while (variants != NULL_TREE)
 805                 {
 806                   tree tag_list = TYPE_TAG_VALUES (TREE_TYPE (variants));
 807                   tree struct_elts = TYPE_FIELDS (TREE_TYPE (variants));
 808
 809                   while (tag_list != NULL_TREE)
 810                     {
 811                       tree tag_values = TREE_VALUE (tag_list);
 812                       APPEND (result, "   (");
 813                       while (tag_values != NULL_TREE)
 814                         {
 815                           mode_string = get_tag_value (TREE_VALUE (tag_values));
 816                           APPEND (result, mode_string->str);
 817                           FREE (mode_string);
 818                           if (TREE_CHAIN (tag_values) != NULL_TREE)
 819                             {
 820                               APPEND (result, ",\n    ");
 821                               tag_values = TREE_CHAIN (tag_values);
 822                             }
 823                           else break;
 824                         }
 825                       APPEND (result, ")");
 826                       tag_list = TREE_CHAIN (tag_list);
 827                       if (tag_list)
 828                         APPEND (result, ",");
 829                       else
 830                         break;
 831                     }
 832                   APPEND (result, " : ");
 833
 834                   while (struct_elts != NULL_TREE)
 835                     {
 836                       mode_string = decode_decl (struct_elts);
 837                       APPEND (result, mode_string->str);
 838                       FREE (mode_string);
 839
 840                       if (TREE_CHAIN (struct_elts) != NULL_TREE)
 841                         APPEND (result, ",\n     ");
 842                       struct_elts = TREE_CHAIN (struct_elts);
 843                     }
 844
 845                   variants = TREE_CHAIN (variants);
 846                   if (variants != NULL_TREE
 847                       && TREE_CHAIN (variants) == NULL_TREE
 848                       && DECL_NAME (variants) == ELSE_VARIANT_NAME)
 849                     {
 850                       tree else_elts = TYPE_FIELDS (TREE_TYPE (variants));
 851                       APPEND (result, "\n   ELSE ");
 852                       while (else_elts != NULL_TREE)
 853                         {
 854                           mode_string = decode_decl (else_elts);
 855                           APPEND (result, mode_string->str);
 856                           FREE (mode_string);
 857                           if (TREE_CHAIN (else_elts) != NULL_TREE)
 858                             APPEND (result, ",\n     ");
 859                           else_elts = TREE_CHAIN (else_elts);
 860                         }
 861                       break;
 862                     }
 863                   if (variants != NULL_TREE)
 864                     APPEND (result, ",\n");
 865                 }
 866
 867               APPEND (result, "\n   ESAC");
 868             }
 869           else
 870             {
 871               mode_string = decode_decl (fields);
 872               APPEND (result, mode_string->str);
 873               FREE (mode_string);
 874             }
 875
 876           fields = TREE_CHAIN (fields);
 877           if (fields != NULL_TREE)
 878             APPEND (result, ",\n    ");
 879         }
 880       APPEND (result, ")");
 881     }
 882   return result;
 883 }
 884
 885 static MYSTRING *
 886 print_struct_selective (type, all_decls)
 887      tree type;
 888      tree all_decls;
 889 {
 890   MYSTRING      *result = newstring ("");
 891   MYSTRING      *mode_string;
 892   tree  fields;
 893
 894   if (chill_varying_type_p (type))
 895     {
 896       mode_string = grant_array_type_selective (type, all_decls);
 897       if (mode_string->len)
 898         APPEND (result, mode_string->str);
 899       FREE (mode_string);
 900     }
 901   else
 902     {
 903       fields = TYPE_FIELDS (type);
 904
 905       while (fields != NULL_TREE)
 906         {
 907           if (TREE_CODE (TREE_TYPE (fields)) == UNION_TYPE)
 908             {
 909               tree variants;
 910               /* Format a tagged variant record type.  */
 911
 912               variants = TYPE_FIELDS (TREE_TYPE (fields));
 913
 914               /* Each variant is a FIELD_DECL whose type is an anonymous
 915                  struct within the anonymous union.  */
 916               while (variants != NULL_TREE)
 917                 {
 918                   tree tag_list = TYPE_TAG_VALUES (TREE_TYPE (variants));
 919                   tree struct_elts = TYPE_FIELDS (TREE_TYPE (variants));
 920
 921                   while (tag_list != NULL_TREE)
 922                     {
 923                       tree tag_values = TREE_VALUE (tag_list);
 924                       while (tag_values != NULL_TREE)
 925                         {
 926                           mode_string = get_tag_value_selective (TREE_VALUE (tag_values),
 927                                                                  all_decls);
 928                           if (mode_string->len)
 929                             {
 930                               MAYBE_NEWLINE (result);
 931                               APPEND (result, mode_string->str);
 932                             }
 933                           FREE (mode_string);
 934                           if (TREE_CHAIN (tag_values) != NULL_TREE)
 935                               tag_values = TREE_CHAIN (tag_values);
 936                           else break;
 937                         }
 938                       tag_list = TREE_CHAIN (tag_list);
 939                       if (!tag_list)
 940                         break;
 941                     }
 942
 943                   while (struct_elts != NULL_TREE)
 944                     {
 945                       mode_string = decode_decl_selective (struct_elts, all_decls);
 946                       if (mode_string->len)
 947                         {
 948                           MAYBE_NEWLINE (result);
 949                           APPEND (result, mode_string->str);
 950                         }
 951                       FREE (mode_string);
 952
 953                       struct_elts = TREE_CHAIN (struct_elts);
 954                     }
 955
 956                   variants = TREE_CHAIN (variants);
 957                   if (variants != NULL_TREE
 958                       && TREE_CHAIN (variants) == NULL_TREE
 959                       && DECL_NAME (variants) == ELSE_VARIANT_NAME)
 960                     {
 961                       tree else_elts = TYPE_FIELDS (TREE_TYPE (variants));
 962                       while (else_elts != NULL_TREE)
 963                         {
 964                           mode_string = decode_decl_selective (else_elts, all_decls);
 965                           if (mode_string->len)
 966                             {
 967                               MAYBE_NEWLINE (result);
 968                               APPEND (result, mode_string->str);
 969                             }
 970                           FREE (mode_string);
 971                           else_elts = TREE_CHAIN (else_elts);
 972                         }
 973                       break;
 974                     }
 975                 }
 976             }
 977           else
 978             {
 979               mode_string = decode_decl_selective (fields, all_decls);
 980               APPEND (result, mode_string->str);
 981               FREE (mode_string);
 982             }
 983
 984           fields = TREE_CHAIN (fields);
 985         }
 986     }
 987   return result;
 988 }
 989 \f
 990 static MYSTRING *
 991 print_proc_exceptions (ex)
 992      tree ex;
 993 {
 994   MYSTRING      *result = newstring ("");
 995
 996   if (ex != NULL_TREE)
 997     {
 998       APPEND (result, "\n  EXCEPTIONS (");
 999       for ( ; ex != NULL_TREE; ex = TREE_CHAIN (ex))
1000         {
1001           APPEND (result, IDENTIFIER_POINTER (TREE_VALUE (ex)));
1002           if (TREE_CHAIN (ex) != NULL_TREE)
1003             APPEND (result, ",\n    ");
1004         }
1005       APPEND (result, ")");
1006     }
1007   return result;
1008 }
1009
1010 static MYSTRING *
1011 print_proc_tail (type, args, print_argnames)
1012      tree type;
1013      tree args;
1014      int print_argnames;
1015 {
1016   MYSTRING      *result = newstring ("");
1017   MYSTRING      *mode_string;
1018   int count = 0;
1019   int stopat = list_length (args) - 3;
1020
1021   /* do the argument modes */
1022   for ( ; args != NULL_TREE;
1023        args = TREE_CHAIN (args), count++)
1024     {
1025       char buf[20];
1026       tree argmode = TREE_VALUE (args);
1027       tree attribute = TREE_PURPOSE (args);
1028
1029       if (argmode == void_type_node)
1030         continue;
1031
1032       /* if we have exceptions don't print last 2 arguments */
1033       if (TYPE_RAISES_EXCEPTIONS (type) && count == stopat)
1034         break;
1035
1036       if (count)
1037         APPEND (result, ",\n       ");
1038       if (print_argnames)
1039         {
1040           sprintf(buf, "arg%d ", count);
1041           APPEND (result, buf);
1042         }
1043
1044       if (attribute == ridpointers[(int) RID_LOC])
1045         argmode = TREE_TYPE (argmode);
1046       mode_string = get_type (argmode);
1047       APPEND (result, mode_string->str);
1048       FREE (mode_string);
1049
1050       if (attribute != NULL_TREE)
1051         {
1052           sprintf (buf, " %s", IDENTIFIER_POINTER (attribute));
1053           APPEND (result, buf);
1054         }
1055     }
1056   APPEND (result, ")");
1057
1058   /* return type */
1059   {
1060     tree retn_type = TREE_TYPE (type);
1061
1062     if (retn_type != NULL_TREE
1063         && TREE_CODE (retn_type) != VOID_TYPE)
1064       {
1065         mode_string = get_type (retn_type);
1066         APPEND (result, "\n  RETURNS (");
1067         APPEND (result, mode_string->str);
1068         FREE (mode_string);
1069         if (TREE_CODE (retn_type) == REFERENCE_TYPE)
1070           APPEND (result, " LOC");
1071         APPEND (result, ")");
1072       }
1073   }
1074
1075   mode_string = print_proc_exceptions (TYPE_RAISES_EXCEPTIONS (type));
1076   APPEND (result, mode_string->str);
1077   FREE (mode_string);
1078
1079   return result;
1080 }
1081
1082 static MYSTRING *
1083 print_proc_tail_selective (type, args, all_decls)
1084      tree type;
1085      tree args;
1086      tree all_decls;
1087 {
1088   MYSTRING      *result = newstring ("");
1089   MYSTRING      *mode_string;
1090   int count = 0;
1091   int stopat = list_length (args) - 3;
1092
1093   /* do the argument modes */
1094   for ( ; args != NULL_TREE;
1095        args = TREE_CHAIN (args), count++)
1096     {
1097       tree argmode = TREE_VALUE (args);
1098       tree attribute = TREE_PURPOSE (args);
1099
1100       if (argmode == void_type_node)
1101         continue;
1102
1103       /* if we have exceptions don't process last 2 arguments */
1104       if (TYPE_RAISES_EXCEPTIONS (type) && count == stopat)
1105         break;
1106
1107       if (attribute == ridpointers[(int) RID_LOC])
1108         argmode = TREE_TYPE (argmode);
1109       mode_string = get_type_selective (argmode, all_decls);
1110       if (mode_string->len)
1111         {
1112           MAYBE_NEWLINE (result);
1113           APPEND (result, mode_string->str);
1114         }
1115       FREE (mode_string);
1116     }
1117
1118   /* return type */
1119   {
1120     tree retn_type = TREE_TYPE (type);
1121
1122     if (retn_type != NULL_TREE
1123         && TREE_CODE (retn_type) != VOID_TYPE)
1124       {
1125         mode_string = get_type_selective (retn_type, all_decls);
1126         if (mode_string->len)
1127           {
1128             MAYBE_NEWLINE (result);
1129             APPEND (result, mode_string->str);
1130           }
1131         FREE (mode_string);
1132       }
1133   }
1134
1135   return result;
1136 }
1137 \f
1138 /* output a mode (or type). */
1139
1140 static MYSTRING *
1141 decode_mode (type)
1142     tree type;
1143 {
1144   MYSTRING      *result = newstring ("");
1145   MYSTRING      *mode_string;
1146
1147   switch ((enum chill_tree_code)TREE_CODE (type))
1148     {
1149     case TYPE_DECL:
1150       if (DECL_NAME (type))
1151         {
1152           APPEND (result, IDENTIFIER_POINTER (DECL_NAME (type)));
1153           return result;
1154         }
1155       type = TREE_TYPE (type);
1156       break;
1157
1158     case IDENTIFIER_NODE:
1159       APPEND (result, IDENTIFIER_POINTER (type));
1160       return result;
1161
1162     case LANG_TYPE:
1163       /* LANG_TYPE are only used until satisfy is done,
1164          as place-holders for 'READ T', NEWMODE/SYNMODE modes,
1165          parameterised modes, and old-fashioned CHAR(N). */
1166       if (TYPE_READONLY (type))
1167         APPEND (result, "READ ");
1168
1169       mode_string = get_type (TREE_TYPE (type));
1170       APPEND (result, mode_string->str);
1171       if (TYPE_DOMAIN (type) != NULL_TREE)
1172         {
1173           /* Parameterized mode,
1174              or old-fashioned CHAR(N) string declaration.. */
1175           APPEND (result, "(");
1176           mode_string = decode_constant (TYPE_DOMAIN (type));
1177           APPEND (result, mode_string->str);
1178           APPEND (result, ")");
1179         }
1180       FREE (mode_string);
1181       break;
1182
1183     case ARRAY_TYPE:
1184       mode_string = grant_array_type (type);
1185       APPEND (result, mode_string->str);
1186       FREE (mode_string);
1187       break;
1188
1189     case BOOLEAN_TYPE:
1190       APPEND (result, "BOOL");
1191       break;
1192
1193     case CHAR_TYPE:
1194       APPEND (result, "CHAR");
1195       break;
1196
1197     case ENUMERAL_TYPE:
1198       mode_string = print_enumeral (type);
1199       APPEND (result, mode_string->str);
1200       FREE (mode_string);
1201       break;
1202
1203     case FUNCTION_TYPE:
1204       {
1205         tree args = TYPE_ARG_TYPES (type);
1206
1207         APPEND (result, "PROC (");
1208
1209         mode_string = print_proc_tail (type, args, 0);
1210         APPEND (result, mode_string->str);
1211         FREE (mode_string);
1212       }
1213       break;
1214
1215     case INTEGER_TYPE:
1216       mode_string = print_integer_type (type);
1217       APPEND (result, mode_string->str);
1218       FREE (mode_string);
1219       break;
1220
1221     case RECORD_TYPE:
1222       if (CH_IS_INSTANCE_MODE (type))
1223         {
1224           APPEND (result, "INSTANCE");
1225           return result;
1226         }
1227       else if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
1228         { tree bufsize = max_queue_size (type);
1229           APPEND (result, CH_IS_BUFFER_MODE (type) ? "BUFFER " : "EVENT ");
1230           if (bufsize != NULL_TREE)
1231             {
1232               APPEND (result, "(");
1233               mode_string = decode_constant (bufsize);
1234               APPEND (result, mode_string->str);
1235               APPEND (result, ") ");
1236               FREE (mode_string);
1237             }
1238           if (CH_IS_BUFFER_MODE (type))
1239             {
1240               mode_string = decode_mode (buffer_element_mode (type));
1241               APPEND (result, mode_string->str);
1242               FREE (mode_string);
1243             }
1244           break;
1245         }
1246       else if (CH_IS_ACCESS_MODE (type))
1247         {
1248           tree indexmode, recordmode, dynamic;
1249
1250           APPEND (result, "ACCESS");
1251           recordmode = access_recordmode (type);
1252           indexmode = access_indexmode (type);
1253           dynamic = access_dynamic (type);
1254
1255           if (indexmode != void_type_node)
1256             {
1257               mode_string = decode_mode (indexmode);
1258               APPEND (result, " (");
1259               APPEND (result, mode_string->str);
1260               APPEND (result, ")");
1261               FREE (mode_string);
1262             }
1263           if (recordmode != void_type_node)
1264             {
1265               mode_string = decode_mode (recordmode);
1266               APPEND (result, " ");
1267               APPEND (result, mode_string->str);
1268               FREE (mode_string);
1269             }
1270           if (dynamic != integer_zero_node)
1271             APPEND (result, " DYNAMIC");
1272           break;
1273         }
1274       else if (CH_IS_TEXT_MODE (type))
1275         {
1276           tree indexmode, dynamic, length;
1277
1278           APPEND (result, "TEXT (");
1279           length = text_length (type);
1280           indexmode = text_indexmode (type);
1281           dynamic = text_dynamic (type);
1282
1283           mode_string = decode_constant (length);
1284           APPEND (result, mode_string->str);
1285           FREE (mode_string);
1286           APPEND (result, ")");
1287           if (indexmode != void_type_node)
1288             {
1289               APPEND (result, " ");
1290               mode_string = decode_mode (indexmode);
1291               APPEND (result, mode_string->str);
1292               FREE (mode_string);
1293             }
1294           if (dynamic != integer_zero_node)
1295             APPEND (result, " DYNAMIC");
1296           return result;
1297         }
1298       mode_string = print_struct (type);
1299       APPEND (result, mode_string->str);
1300       FREE (mode_string);
1301       break;
1302
1303     case POINTER_TYPE:
1304       if (TREE_CODE (TREE_TYPE (type)) == VOID_TYPE)
1305         APPEND (result, "PTR");
1306       else
1307         {
1308           if (TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE)
1309             {
1310               mode_string = get_type (TREE_TYPE (type));
1311               APPEND (result, mode_string->str);
1312               FREE (mode_string);
1313             }
1314           else
1315             {
1316               APPEND (result, "REF ");
1317               mode_string = get_type (TREE_TYPE (type));
1318               APPEND (result, mode_string->str);
1319               FREE (mode_string);
1320             }
1321         }
1322       break;
1323
1324     case REAL_TYPE:
1325       if (TREE_INT_CST_LOW (TYPE_SIZE (type)) == 32)
1326         APPEND (result, "REAL");
1327       else
1328         APPEND (result, "LONG_REAL");
1329       break;
1330
1331     case SET_TYPE:
1332       if (CH_BOOLS_TYPE_P (type))
1333         mode_string = grant_array_type (type);
1334       else
1335         {
1336           APPEND (result, "POWERSET ");
1337           mode_string = get_type (TYPE_DOMAIN (type));
1338         }
1339       APPEND (result, mode_string->str);
1340       FREE (mode_string);
1341       break;
1342
1343     case REFERENCE_TYPE:
1344       mode_string = get_type (TREE_TYPE (type));
1345       APPEND (result, mode_string->str);
1346       FREE (mode_string);
1347       break;
1348
1349     default:
1350       APPEND (result, "/* ---- not implemented ---- */");
1351       break;
1352     }
1353
1354   return (result);
1355 }
1356
1357 static tree
1358 find_in_decls (id, all_decls)
1359      tree id;
1360      tree all_decls;
1361 {
1362   tree wrk;
1363
1364   for (wrk = all_decls; wrk != NULL_TREE; wrk = TREE_CHAIN (wrk))
1365     {
1366       if (DECL_NAME (wrk) == id || DECL_POSTFIX (wrk) == id)
1367         return wrk;
1368     }
1369   return NULL_TREE;
1370 }
1371
1372 static int
1373 in_ridpointers (id)
1374      tree id;
1375 {
1376   int i;
1377   for (i = RID_UNUSED; i < RID_MAX; i++)
1378     {
1379       if (id == ridpointers[i])
1380         return 1;
1381     }
1382   return 0;
1383 }
1384
1385 static void
1386 grant_seized_identifier (decl)
1387      tree decl;
1388 {
1389   seizefile_list *wrk = selective_seizes;
1390   MYSTRING *mode_string;
1391
1392   CH_ALREADY_GRANTED (decl) = 1;
1393
1394   /* comes from a SPEC MODULE in the module */
1395   if (DECL_SEIZEFILE (decl) == NULL_TREE)
1396     return;
1397
1398   /* search file already in process */
1399   while (wrk != 0)
1400     {
1401       if (wrk->filename == DECL_SEIZEFILE (decl))
1402         break;
1403       wrk = wrk->next;
1404     }
1405   if (!wrk)
1406     {
1407       wrk = (seizefile_list *)xmalloc (sizeof (seizefile_list));
1408       wrk->next = selective_seizes;
1409       selective_seizes = wrk;
1410       wrk->filename = DECL_SEIZEFILE (decl);
1411       wrk->seizes = newstring ("<> USE_SEIZE_FILE \"");
1412       APPEND (wrk->seizes, IDENTIFIER_POINTER (DECL_SEIZEFILE (decl)));
1413       APPEND (wrk->seizes, "\" <>\n");
1414     }
1415   APPEND (wrk->seizes, "SEIZE ");
1416   mode_string = decode_prefix_rename (decl);
1417   APPEND (wrk->seizes, mode_string->str);
1418   FREE (mode_string);
1419   APPEND (wrk->seizes, ";\n");
1420 }
1421
1422 static MYSTRING *
1423 decode_mode_selective (type, all_decls)
1424     tree type;
1425     tree all_decls;
1426 {
1427   MYSTRING      *result = newstring ("");
1428   MYSTRING      *mode_string;
1429   tree decl;
1430
1431   switch ((enum chill_tree_code)TREE_CODE (type))
1432     {
1433     case TYPE_DECL:
1434       /* FIXME: could this ever happen ?? */
1435       if (DECL_NAME (type))
1436         {
1437           FREE (result);
1438           result = decode_mode_selective (DECL_NAME (type), all_decls);
1439           return result;
1440         }
1441       break;
1442
1443     case IDENTIFIER_NODE:
1444       if (in_ridpointers (type))
1445         /* it's a predefined, we must not search the whole list */
1446         return result;
1447
1448       decl = find_in_decls (type, all_decls);
1449       if (decl != NULL_TREE)
1450         {
1451           if (CH_ALREADY_GRANTED (decl))
1452             /* already processed */
1453             return result;
1454
1455           if (TREE_CODE (decl) == ALIAS_DECL && DECL_POSTFIX (decl) != NULL_TREE)
1456             {
1457               /* If CH_DECL_GRANTED, decl was granted into this scope, and
1458                  so wasn't in the source code. */
1459               if (!CH_DECL_GRANTED (decl))
1460                 {
1461                   grant_seized_identifier (decl);
1462                 }
1463             }
1464           else
1465             {
1466               result = decode_decl (decl);
1467               mode_string = decode_decl_selective (decl, all_decls);
1468               if (mode_string->len)
1469                 {
1470                   PREPEND (result, mode_string->str);
1471                 }
1472               FREE (mode_string);
1473             }
1474         }
1475       return result;
1476
1477     case LANG_TYPE:
1478       mode_string = get_type_selective (TREE_TYPE (type), all_decls);
1479       APPEND (result, mode_string->str);
1480       FREE (mode_string);
1481       break;
1482
1483     case ARRAY_TYPE:
1484       mode_string = grant_array_type_selective (type, all_decls);
1485       APPEND (result, mode_string->str);
1486       FREE (mode_string);
1487       break;
1488
1489     case BOOLEAN_TYPE:
1490       return result;
1491       break;
1492
1493     case CHAR_TYPE:
1494       return result;
1495       break;
1496
1497     case ENUMERAL_TYPE:
1498       mode_string = print_enumeral_selective (type, all_decls);
1499       if (mode_string->len)
1500         APPEND (result, mode_string->str);
1501       FREE (mode_string);
1502       break;
1503
1504     case FUNCTION_TYPE:
1505       {
1506         tree args = TYPE_ARG_TYPES (type);
1507
1508         mode_string = print_proc_tail_selective (type, args, all_decls);
1509         if (mode_string->len)
1510           APPEND (result, mode_string->str);
1511         FREE (mode_string);
1512       }
1513       break;
1514
1515     case INTEGER_TYPE:
1516       mode_string = print_integer_selective (type, all_decls);
1517       if (mode_string->len)
1518         APPEND (result, mode_string->str);
1519       FREE (mode_string);
1520       break;
1521
1522     case RECORD_TYPE:
1523       if (CH_IS_INSTANCE_MODE (type))
1524         {
1525           return result;
1526         }
1527       else if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
1528         {
1529           tree bufsize = max_queue_size (type);
1530           if (bufsize != NULL_TREE)
1531             {
1532               mode_string = decode_constant_selective (bufsize, all_decls);
1533               if (mode_string->len)
1534                 APPEND (result, mode_string->str);
1535               FREE (mode_string);
1536             }
1537           if (CH_IS_BUFFER_MODE (type))
1538             {
1539               mode_string = decode_mode_selective (buffer_element_mode (type), all_decls);
1540               if (mode_string->len)
1541                 {
1542                   MAYBE_NEWLINE (result);
1543                   APPEND (result, mode_string->str);
1544                 }
1545               FREE (mode_string);
1546             }
1547           break;
1548         }
1549       else if (CH_IS_ACCESS_MODE (type))
1550         {
1551           tree indexmode = access_indexmode (type);
1552           tree recordmode = access_recordmode (type);
1553
1554           if (indexmode != void_type_node)
1555             {
1556               mode_string = decode_mode_selective (indexmode, all_decls);
1557               if (mode_string->len)
1558                 {
1559                   if (result->len && result->str[result->len - 1] != '\n')
1560                     APPEND (result, ";\n");
1561                   APPEND (result, mode_string->str);
1562                 }
1563               FREE (mode_string);
1564             }
1565           if (recordmode != void_type_node)
1566             {
1567               mode_string = decode_mode_selective (recordmode, all_decls);
1568               if (mode_string->len)
1569                 {
1570                   if (result->len && result->str[result->len - 1] != '\n')
1571                     APPEND (result, ";\n");
1572                   APPEND (result, mode_string->str);
1573                 }
1574               FREE (mode_string);
1575             }
1576           break;
1577         }
1578       else if (CH_IS_TEXT_MODE (type))
1579         {
1580           tree indexmode = text_indexmode (type);
1581           tree length = text_length (type);
1582
1583           mode_string = decode_constant_selective (length, all_decls);
1584           if (mode_string->len)
1585             APPEND (result, mode_string->str);
1586           FREE (mode_string);
1587           if (indexmode != void_type_node)
1588             {
1589               mode_string = decode_mode_selective (indexmode, all_decls);
1590               if (mode_string->len)
1591                 {
1592                   if (result->len && result->str[result->len - 1] != '\n')
1593                     APPEND (result, ";\n");
1594                   APPEND (result, mode_string->str);
1595                 }
1596               FREE (mode_string);
1597             }
1598           break;
1599         }
1600       mode_string = print_struct_selective (type, all_decls);
1601       if (mode_string->len)
1602         {
1603           MAYBE_NEWLINE (result);
1604           APPEND (result, mode_string->str);
1605         }
1606       FREE (mode_string);
1607       break;
1608
1609     case POINTER_TYPE:
1610       if (TREE_CODE (TREE_TYPE (type)) == VOID_TYPE)
1611         break;
1612       else
1613         {
1614           if (TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE)
1615             {
1616               mode_string = get_type_selective (TREE_TYPE (type), all_decls);
1617               if (mode_string->len)
1618                 APPEND (result, mode_string->str);
1619               FREE (mode_string);
1620             }
1621           else
1622             {
1623               mode_string = get_type_selective (TREE_TYPE (type), all_decls);
1624               if (mode_string->len)
1625                 APPEND (result, mode_string->str);
1626               FREE (mode_string);
1627             }
1628         }
1629       break;
1630
1631     case REAL_TYPE:
1632       return result;
1633       break;
1634
1635     case SET_TYPE:
1636       if (CH_BOOLS_TYPE_P (type))
1637         mode_string = grant_array_type_selective (type, all_decls);
1638       else
1639         mode_string = get_type_selective (TYPE_DOMAIN (type), all_decls);
1640       if (mode_string->len)
1641         APPEND (result, mode_string->str);
1642       FREE (mode_string);
1643       break;
1644
1645     case REFERENCE_TYPE:
1646       mode_string = get_type_selective (TREE_TYPE (type), all_decls);
1647       if (mode_string->len)
1648         APPEND (result, mode_string->str);
1649       FREE (mode_string);
1650       break;
1651
1652     default:
1653       APPEND (result, "/* ---- not implemented ---- */");
1654       break;
1655     }
1656
1657   return (result);
1658 }
1659 \f
1660 static MYSTRING *
1661 get_type (type)
1662     tree        type;
1663 {
1664   if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
1665     return newstring ("");
1666
1667   return (decode_mode (type));
1668 }
1669
1670 static MYSTRING *
1671 get_type_selective (type, all_decls)
1672     tree        type;
1673     tree        all_decls;
1674 {
1675   if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
1676     return newstring ("");
1677
1678   return (decode_mode_selective (type, all_decls));
1679 }
1680
1681 #if 0
1682 static int
1683 is_forbidden (str, forbid)
1684     tree        str;
1685     tree        forbid;
1686 {
1687   if (forbid == NULL_TREE)
1688     return (0);
1689
1690   if (TREE_CODE (forbid) == INTEGER_CST)
1691     return (1);
1692
1693   while (forbid != NULL_TREE)
1694     {
1695       if (TREE_VALUE (forbid) == str)
1696         return (1);
1697       forbid = TREE_CHAIN (forbid);
1698     }
1699   /* nothing found */
1700   return (0);
1701 }
1702 #endif
1703
1704 static MYSTRING *
1705 decode_constant (init)
1706      tree       init;
1707 {
1708   MYSTRING *result = newstring ("");
1709   MYSTRING *tmp_string;
1710   tree      type = TREE_TYPE (init);
1711   tree  val = init;
1712   const char *op;
1713   char  wrk[256];
1714   MYSTRING *mode_string;
1715
1716   switch ((enum chill_tree_code)TREE_CODE (val))
1717     {
1718     case CALL_EXPR:
1719       tmp_string = decode_constant (TREE_OPERAND (val, 0));
1720       APPEND (result, tmp_string->str);
1721       FREE (tmp_string);
1722       val = TREE_OPERAND (val, 1);  /* argument list */
1723       if (val != NULL_TREE && TREE_CODE (val) != TREE_LIST)
1724         {
1725           APPEND (result, " ");
1726           tmp_string = decode_constant (val);
1727           APPEND (result, tmp_string->str);
1728           FREE (tmp_string);
1729         }
1730       else
1731         {
1732           APPEND (result, " (");
1733           if (val != NULL_TREE)
1734             {
1735               for (;;)
1736                 {
1737                   tmp_string = decode_constant (TREE_VALUE (val));
1738                   APPEND (result, tmp_string->str);
1739                   FREE (tmp_string);
1740                   val = TREE_CHAIN (val);
1741                   if (val == NULL_TREE)
1742                     break;
1743                   APPEND (result, ", ");
1744                 }
1745             }
1746           APPEND (result, ")");
1747         }
1748       return result;
1749
1750     case NOP_EXPR:
1751       /* Generate an "expression conversion" expression (a cast). */
1752       tmp_string = decode_mode (type);
1753
1754       APPEND (result, tmp_string->str);
1755       FREE (tmp_string);
1756       APPEND (result, "(");
1757       val = TREE_OPERAND (val, 0);
1758       type = TREE_TYPE (val);
1759
1760       /* If the coercee is a tuple, make sure it is prefixed by its mode. */
1761       if (TREE_CODE (val) == CONSTRUCTOR
1762         && !CH_BOOLS_TYPE_P (type) && !chill_varying_type_p (type))
1763         {
1764           tmp_string = decode_mode (type);
1765           APPEND (result, tmp_string->str);
1766           FREE (tmp_string);
1767           APPEND (result, " ");
1768         }
1769
1770       tmp_string = decode_constant (val);
1771       APPEND (result, tmp_string->str);
1772       FREE (tmp_string);
1773       APPEND (result, ")");
1774       return result;
1775
1776     case IDENTIFIER_NODE:
1777       APPEND (result, IDENTIFIER_POINTER (val));
1778       return result;
1779
1780     case PAREN_EXPR:
1781       APPEND (result, "(");
1782       tmp_string = decode_constant (TREE_OPERAND (val, 0));
1783       APPEND (result, tmp_string->str);
1784       FREE (tmp_string);
1785       APPEND (result, ")");
1786       return result;
1787
1788     case UNDEFINED_EXPR:
1789       APPEND (result, "*");
1790       return result;
1791
1792     case PLUS_EXPR:        op = "+";       goto binary;
1793     case MINUS_EXPR:       op = "-";       goto binary;
1794     case MULT_EXPR:        op = "*";       goto binary;
1795     case TRUNC_DIV_EXPR:   op = "/";       goto binary;
1796     case FLOOR_MOD_EXPR:   op = " MOD ";   goto binary;
1797     case TRUNC_MOD_EXPR:   op = " REM ";   goto binary;
1798     case CONCAT_EXPR:      op = "//";      goto binary;
1799     case BIT_IOR_EXPR:     op = " OR ";    goto binary;
1800     case BIT_XOR_EXPR:     op = " XOR ";   goto binary;
1801     case TRUTH_ORIF_EXPR:  op = " ORIF ";  goto binary;
1802     case BIT_AND_EXPR:     op = " AND ";   goto binary;
1803     case TRUTH_ANDIF_EXPR: op = " ANDIF "; goto binary;
1804     case GT_EXPR:          op = ">";       goto binary;
1805     case GE_EXPR:          op = ">=";      goto binary;
1806     case SET_IN_EXPR:      op = " IN ";    goto binary;
1807     case LT_EXPR:          op = "<";       goto binary;
1808     case LE_EXPR:          op = "<=";      goto binary;
1809     case EQ_EXPR:          op = "=";       goto binary;
1810     case NE_EXPR:          op = "/=";      goto binary;
1811     case RANGE_EXPR:
1812       if (TREE_OPERAND (val, 0) == NULL_TREE)
1813         {
1814           APPEND (result, TREE_OPERAND (val, 1) == NULL_TREE ? "*" : "ELSE");
1815           return result;
1816         }
1817       op = ":";       goto binary;
1818     binary:
1819       tmp_string = decode_constant (TREE_OPERAND (val, 0));
1820       APPEND (result, tmp_string->str);
1821       FREE (tmp_string);
1822       APPEND (result, op);
1823       tmp_string = decode_constant (TREE_OPERAND (val, 1));
1824       APPEND (result, tmp_string->str);
1825       FREE (tmp_string);
1826       return result;
1827
1828     case REPLICATE_EXPR:
1829       APPEND (result, "(");
1830       tmp_string = decode_constant (TREE_OPERAND (val, 0));
1831       APPEND (result, tmp_string->str);
1832       FREE (tmp_string);
1833       APPEND (result, ")");
1834       tmp_string = decode_constant (TREE_OPERAND (val, 1));
1835       APPEND (result, tmp_string->str);
1836       FREE (tmp_string);
1837       return result;
1838
1839     case NEGATE_EXPR:     op = "-";     goto unary;
1840     case BIT_NOT_EXPR:    op = " NOT "; goto unary;
1841     case ADDR_EXPR:       op = "->"; goto unary;
1842     unary:
1843       APPEND (result, op);
1844       tmp_string = decode_constant (TREE_OPERAND (val, 0));
1845       APPEND (result, tmp_string->str);
1846       FREE (tmp_string);
1847       return result;
1848
1849     case INTEGER_CST:
1850       APPEND (result, display_int_cst (val));
1851       return result;
1852
1853     case REAL_CST:
1854       REAL_VALUE_TO_DECIMAL (TREE_REAL_CST (val), "%.20g", wrk);
1855       APPEND (result, wrk);
1856       return result;
1857
1858     case STRING_CST:
1859       {
1860         const char *ptr = TREE_STRING_POINTER (val);
1861         int i = TREE_STRING_LENGTH (val);
1862         APPEND (result, "\"");
1863         while (--i >= 0)
1864           {
1865             char buf[10];
1866             unsigned char c = *ptr++;
1867             if (c == '^')
1868               APPEND (result, "^^");
1869             else if (c == '"')
1870               APPEND (result, "\"\"");
1871             else if (c == '\n')
1872               APPEND (result, "^J");
1873             else if (c < ' ' || c > '~')
1874               {
1875                 sprintf (buf, "^(%u)", c);
1876                 APPEND (result, buf);
1877               }
1878             else
1879               {
1880                 buf[0] = c;
1881                 buf[1] = 0;
1882                 APPEND (result, buf);
1883               }
1884           }
1885         APPEND (result, "\"");
1886         return result;
1887       }
1888
1889     case CONSTRUCTOR:
1890       val = TREE_OPERAND (val, 1);
1891       if (type != NULL && TREE_CODE (type) == SET_TYPE
1892           && CH_BOOLS_TYPE_P (type))
1893         {
1894           /* It's a bitstring. */
1895           tree domain = TYPE_DOMAIN (type);
1896           tree domain_max = TYPE_MAX_VALUE (domain);
1897           char *buf;
1898           register char *ptr;
1899           int len;
1900           if (TREE_CODE (domain_max) != INTEGER_CST
1901               || (val && TREE_CODE (val) != TREE_LIST))
1902             goto fail;
1903
1904           len = TREE_INT_CST_LOW (domain_max) + 1;
1905           if (TREE_CODE (init) != CONSTRUCTOR)
1906             goto fail;
1907           buf = (char *) alloca (len + 10);
1908           ptr = buf;
1909           *ptr++ = ' ';
1910           *ptr++ = 'B';
1911           *ptr++ = '\'';
1912           if (get_set_constructor_bits (init, ptr, len))
1913             goto fail;
1914           for (; --len >= 0; ptr++)
1915             *ptr += '0';
1916           *ptr++ = '\'';
1917           *ptr = '\0';
1918           APPEND (result, buf);
1919           return result;
1920         }
1921       else
1922         { /* It's some kind of tuple */
1923           if (type != NULL_TREE)
1924             {
1925               mode_string = get_type (type);
1926               APPEND (result, mode_string->str);
1927               FREE (mode_string);
1928               APPEND (result, " ");
1929             }
1930           if (val == NULL_TREE
1931               || TREE_CODE (val) == ERROR_MARK)
1932             APPEND (result, "[ ]");
1933           else if (TREE_CODE (val) != TREE_LIST)
1934             goto fail;
1935           else
1936             {
1937               APPEND (result, "[");
1938               for ( ; ; )
1939                 {
1940                   tree lo_val = TREE_PURPOSE (val);
1941                   tree hi_val = TREE_VALUE (val);
1942                   MYSTRING *val_string;
1943                   if (TUPLE_NAMED_FIELD (val))
1944                     APPEND(result, ".");
1945                   if (lo_val != NULL_TREE)
1946                     {
1947                       val_string = decode_constant (lo_val);
1948                       APPEND (result, val_string->str);
1949                       FREE (val_string);
1950                       APPEND (result, ":");
1951                     }
1952                   val_string = decode_constant (hi_val);
1953                   APPEND (result, val_string->str);
1954                   FREE (val_string);
1955                   val = TREE_CHAIN (val);
1956                   if (val == NULL_TREE)
1957                     break;
1958                   APPEND (result, ", ");
1959                 }
1960               APPEND (result, "]");
1961             }
1962         }
1963       return result;
1964     case COMPONENT_REF:
1965       {
1966         tree op1;
1967
1968         mode_string = decode_constant (TREE_OPERAND (init, 0));
1969         APPEND (result, mode_string->str);
1970         FREE (mode_string);
1971         op1 = TREE_OPERAND (init, 1);
1972         if (TREE_CODE (op1) != IDENTIFIER_NODE)
1973           {
1974             error ("decode_constant: invalid component_ref");
1975             break;
1976           }
1977         APPEND (result, ".");
1978         APPEND (result, IDENTIFIER_POINTER (op1));
1979         return result;
1980       }
1981     fail:
1982       error ("decode_constant: mode and value mismatch");
1983       break;
1984     default:
1985       error ("decode_constant: cannot decode this mode");
1986       break;
1987     }
1988   return result;
1989 }
1990
1991 static MYSTRING *
1992 decode_constant_selective (init, all_decls)
1993      tree       init;
1994      tree       all_decls;
1995 {
1996   MYSTRING *result = newstring ("");
1997   MYSTRING *tmp_string;
1998   tree      type = TREE_TYPE (init);
1999   tree  val = init;
2000   MYSTRING *mode_string;
2001
2002   switch ((enum chill_tree_code)TREE_CODE (val))
2003     {
2004     case CALL_EXPR:
2005       tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2006       if (tmp_string->len)
2007         APPEND (result, tmp_string->str);
2008       FREE (tmp_string);
2009       val = TREE_OPERAND (val, 1);  /* argument list */
2010       if (val != NULL_TREE && TREE_CODE (val) != TREE_LIST)
2011         {
2012           tmp_string = decode_constant_selective (val, all_decls);
2013           if (tmp_string->len)
2014             {
2015               MAYBE_NEWLINE (result);
2016               APPEND (result, tmp_string->str);
2017             }
2018           FREE (tmp_string);
2019         }
2020       else
2021         {
2022           if (val != NULL_TREE)
2023             {
2024               for (;;)
2025                 {
2026                   tmp_string = decode_constant_selective (TREE_VALUE (val), all_decls);
2027                   if (tmp_string->len)
2028                     {
2029                       MAYBE_NEWLINE (result);
2030                       APPEND (result, tmp_string->str);
2031                     }
2032                   FREE (tmp_string);
2033                   val = TREE_CHAIN (val);
2034                   if (val == NULL_TREE)
2035                     break;
2036                 }
2037             }
2038         }
2039       return result;
2040
2041     case NOP_EXPR:
2042       /* Generate an "expression conversion" expression (a cast). */
2043       tmp_string = decode_mode_selective (type, all_decls);
2044       if (tmp_string->len)
2045         APPEND (result, tmp_string->str);
2046       FREE (tmp_string);
2047       val = TREE_OPERAND (val, 0);
2048       type = TREE_TYPE (val);
2049
2050       /* If the coercee is a tuple, make sure it is prefixed by its mode. */
2051       if (TREE_CODE (val) == CONSTRUCTOR
2052         && !CH_BOOLS_TYPE_P (type) && !chill_varying_type_p (type))
2053         {
2054           tmp_string = decode_mode_selective (type, all_decls);
2055           if (tmp_string->len)
2056             APPEND (result, tmp_string->str);
2057           FREE (tmp_string);
2058         }
2059
2060       tmp_string = decode_constant_selective (val, all_decls);
2061       if (tmp_string->len)
2062         APPEND (result, tmp_string->str);
2063       FREE (tmp_string);
2064       return result;
2065
2066     case IDENTIFIER_NODE:
2067       tmp_string = decode_mode_selective (val, all_decls);
2068       if (tmp_string->len)
2069         APPEND (result, tmp_string->str);
2070       FREE (tmp_string);
2071       return result;
2072
2073     case PAREN_EXPR:
2074       tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2075       if (tmp_string->len)
2076         APPEND (result, tmp_string->str);
2077       FREE (tmp_string);
2078       return result;
2079
2080     case UNDEFINED_EXPR:
2081       return result;
2082
2083     case PLUS_EXPR:
2084     case MINUS_EXPR:
2085     case MULT_EXPR:
2086     case TRUNC_DIV_EXPR:
2087     case FLOOR_MOD_EXPR:
2088     case TRUNC_MOD_EXPR:
2089     case CONCAT_EXPR:
2090     case BIT_IOR_EXPR:
2091     case BIT_XOR_EXPR:
2092     case TRUTH_ORIF_EXPR:
2093     case BIT_AND_EXPR:
2094     case TRUTH_ANDIF_EXPR:
2095     case GT_EXPR:
2096     case GE_EXPR:
2097     case SET_IN_EXPR:
2098     case LT_EXPR:
2099     case LE_EXPR:
2100     case EQ_EXPR:
2101     case NE_EXPR:
2102       goto binary;
2103     case RANGE_EXPR:
2104       if (TREE_OPERAND (val, 0) == NULL_TREE)
2105           return result;
2106
2107     binary:
2108       tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2109       if (tmp_string->len)
2110         APPEND (result, tmp_string->str);
2111       FREE (tmp_string);
2112       tmp_string = decode_constant_selective (TREE_OPERAND (val, 1), all_decls);
2113       if (tmp_string->len)
2114         {
2115           MAYBE_NEWLINE (result);
2116           APPEND (result, tmp_string->str);
2117         }
2118       FREE (tmp_string);
2119       return result;
2120
2121     case REPLICATE_EXPR:
2122       tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2123       if (tmp_string->len)
2124         APPEND (result, tmp_string->str);
2125       FREE (tmp_string);
2126       tmp_string = decode_constant_selective (TREE_OPERAND (val, 1), all_decls);
2127       if (tmp_string->len)
2128         {
2129           MAYBE_NEWLINE (result);
2130           APPEND (result, tmp_string->str);
2131         }
2132       FREE (tmp_string);
2133       return result;
2134
2135     case NEGATE_EXPR:
2136     case BIT_NOT_EXPR:
2137     case ADDR_EXPR:
2138       tmp_string = decode_constant_selective (TREE_OPERAND (val, 0), all_decls);
2139       if (tmp_string->len)
2140         APPEND (result, tmp_string->str);
2141       FREE (tmp_string);
2142       return result;
2143
2144     case INTEGER_CST:
2145       return result;
2146
2147     case REAL_CST:
2148       return result;
2149
2150     case STRING_CST:
2151       return result;
2152
2153     case CONSTRUCTOR:
2154       val = TREE_OPERAND (val, 1);
2155       if (type != NULL && TREE_CODE (type) == SET_TYPE
2156           && CH_BOOLS_TYPE_P (type))
2157           /* It's a bitstring. */
2158           return result;
2159       else
2160         { /* It's some kind of tuple */
2161           if (type != NULL_TREE)
2162             {
2163               mode_string = get_type_selective (type, all_decls);
2164               if (mode_string->len)
2165                 APPEND (result, mode_string->str);
2166               FREE (mode_string);
2167             }
2168           if (val == NULL_TREE
2169               || TREE_CODE (val) == ERROR_MARK)
2170             return result;
2171           else if (TREE_CODE (val) != TREE_LIST)
2172             goto fail;
2173           else
2174             {
2175               for ( ; ; )
2176                 {
2177                   tree lo_val = TREE_PURPOSE (val);
2178                   tree hi_val = TREE_VALUE (val);
2179                   MYSTRING *val_string;
2180                   if (lo_val != NULL_TREE)
2181                     {
2182                       val_string = decode_constant_selective (lo_val, all_decls);
2183                       if (val_string->len)
2184                         APPEND (result, val_string->str);
2185                       FREE (val_string);
2186                     }
2187                   val_string = decode_constant_selective (hi_val, all_decls);
2188                   if (val_string->len)
2189                     {
2190                       MAYBE_NEWLINE (result);
2191                       APPEND (result, val_string->str);
2192                     }
2193                   FREE (val_string);
2194                   val = TREE_CHAIN (val);
2195                   if (val == NULL_TREE)
2196                     break;
2197                 }
2198             }
2199         }
2200       return result;
2201     case COMPONENT_REF:
2202       {
2203         mode_string = decode_constant_selective (TREE_OPERAND (init, 0), all_decls);
2204         if (mode_string->len)
2205           APPEND (result, mode_string->str);
2206         FREE (mode_string);
2207         return result;
2208       }
2209     fail:
2210       error ("decode_constant_selective: mode and value mismatch");
2211       break;
2212     default:
2213       error ("decode_constant_selective: cannot decode this mode");
2214       break;
2215     }
2216   return result;
2217 }
2218 \f
2219 /* Assuming DECL is an ALIAS_DECL, return its prefix rename clause. */
2220
2221 static MYSTRING *
2222 decode_prefix_rename (decl)
2223     tree decl;
2224 {
2225   MYSTRING *result = newstring ("");
2226   if (DECL_OLD_PREFIX (decl) || DECL_NEW_PREFIX (decl))
2227     {
2228       APPEND (result, "(");
2229       if (DECL_OLD_PREFIX (decl))
2230         APPEND (result, IDENTIFIER_POINTER (DECL_OLD_PREFIX (decl)));
2231       APPEND (result, "->");
2232       if (DECL_NEW_PREFIX (decl))
2233         APPEND (result, IDENTIFIER_POINTER (DECL_NEW_PREFIX (decl)));
2234       APPEND (result, ")!");
2235     }
2236   if (DECL_POSTFIX_ALL (decl))
2237     APPEND (result, "ALL");
2238   else
2239     APPEND (result, IDENTIFIER_POINTER  (DECL_POSTFIX (decl)));
2240   return result;
2241 }
2242
2243 static MYSTRING *
2244 decode_decl (decl)
2245     tree decl;
2246 {
2247   MYSTRING *result = newstring ("");
2248   MYSTRING *mode_string;
2249   tree      type;
2250
2251   switch ((enum chill_tree_code)TREE_CODE (decl))
2252     {
2253     case VAR_DECL:
2254     case BASED_DECL:
2255       APPEND (result, "DCL ");
2256       APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2257       APPEND (result, " ");
2258       mode_string = get_type (TREE_TYPE (decl));
2259       APPEND (result, mode_string->str);
2260       FREE (mode_string);
2261       if ((enum chill_tree_code)TREE_CODE (decl) == BASED_DECL)
2262         {
2263           APPEND (result, " BASED (");
2264           APPEND (result, IDENTIFIER_POINTER (DECL_ABSTRACT_ORIGIN (decl)));
2265           APPEND (result, ")");
2266         }
2267       break;
2268
2269     case TYPE_DECL:
2270       if (CH_DECL_SIGNAL (decl))
2271         {
2272           /* this is really a signal */
2273           tree fields = TYPE_FIELDS (TREE_TYPE (decl));
2274           tree signame = DECL_NAME (decl);
2275           tree sigdest;
2276
2277           APPEND (result, "SIGNAL ");
2278           APPEND (result, IDENTIFIER_POINTER (signame));
2279           if (IDENTIFIER_SIGNAL_DATA (signame))
2280             {
2281               APPEND (result, " = (");
2282               for ( ; fields != NULL_TREE;
2283                    fields = TREE_CHAIN (fields))
2284                 {
2285                   MYSTRING *mode_string;
2286
2287                   mode_string = get_type (TREE_TYPE (fields));
2288                   APPEND (result, mode_string->str);
2289                   FREE (mode_string);
2290                   if (TREE_CHAIN (fields) != NULL_TREE)
2291                     APPEND (result, ", ");
2292                 }
2293               APPEND (result, ")");
2294             }
2295           sigdest = IDENTIFIER_SIGNAL_DEST (signame);
2296           if (sigdest != NULL_TREE)
2297             {
2298               APPEND (result, " TO ");
2299               APPEND (result, IDENTIFIER_POINTER (DECL_NAME (sigdest)));
2300             }
2301         }
2302       else
2303         {
2304           /* avoid defining a mode as itself */
2305           if (CH_NOVELTY (TREE_TYPE (decl)) == decl)
2306             APPEND (result, "NEWMODE ");
2307           else
2308             APPEND (result, "SYNMODE ");
2309           APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2310           APPEND (result, " = ");
2311           mode_string = decode_mode (TREE_TYPE (decl));
2312           APPEND (result, mode_string->str);
2313           FREE (mode_string);
2314         }
2315       break;
2316
2317     case FUNCTION_DECL:
2318       {
2319         tree    args;
2320
2321         type = TREE_TYPE (decl);
2322         args = TYPE_ARG_TYPES (type);
2323
2324         APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2325
2326         if (CH_DECL_PROCESS (decl))
2327           APPEND (result, ": PROCESS (");
2328         else
2329           APPEND (result, ": PROC (");
2330
2331         args = TYPE_ARG_TYPES (type);
2332
2333         mode_string = print_proc_tail (type, args, 1);
2334         APPEND (result, mode_string->str);
2335         FREE (mode_string);
2336
2337         /* generality */
2338         if (CH_DECL_GENERAL (decl))
2339           APPEND (result, " GENERAL");
2340         if (CH_DECL_SIMPLE (decl))
2341           APPEND (result, " SIMPLE");
2342         if (DECL_INLINE (decl))
2343           APPEND (result, " INLINE");
2344         if (CH_DECL_RECURSIVE (decl))
2345           APPEND (result, " RECURSIVE");
2346         APPEND (result, " END");
2347       }
2348       break;
2349
2350     case FIELD_DECL:
2351       APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2352       APPEND (result, " ");
2353       mode_string = get_type (TREE_TYPE (decl));
2354       APPEND (result, mode_string->str);
2355       FREE (mode_string);
2356       if (DECL_INITIAL (decl) != NULL_TREE)
2357         {
2358           mode_string = decode_layout (DECL_INITIAL (decl));
2359           APPEND (result, mode_string->str);
2360           FREE (mode_string);
2361         }
2362 #if 0
2363       if (is_forbidden (DECL_NAME (decl), forbid))
2364         APPEND (result, " FORBID");
2365 #endif
2366       break;
2367
2368     case CONST_DECL:
2369       if (DECL_INITIAL (decl) == NULL_TREE
2370           || TREE_CODE (DECL_INITIAL (decl)) == ERROR_MARK)
2371         break;
2372       APPEND (result, "SYN ");
2373       APPEND (result, IDENTIFIER_POINTER (DECL_NAME (decl)));
2374       APPEND (result, " ");
2375       mode_string = get_type (TREE_TYPE (decl));
2376       APPEND (result, mode_string->str);
2377       FREE (mode_string);
2378       APPEND (result, " = ");
2379       mode_string = decode_constant (DECL_INITIAL (decl));
2380       APPEND (result, mode_string->str);
2381       FREE (mode_string);
2382       break;
2383
2384     case ALIAS_DECL:
2385       /* If CH_DECL_GRANTED, decl was granted into this scope, and
2386          so wasn't in the source code. */
2387       if (!CH_DECL_GRANTED (decl))
2388         {
2389           static int restricted = 0;
2390
2391           if (DECL_SEIZEFILE (decl) != use_seizefile_name
2392               && DECL_SEIZEFILE (decl))
2393             {
2394               use_seizefile_name = DECL_SEIZEFILE (decl);
2395               restricted = use_seizefile_name == NULL_TREE ? 0 : CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name);
2396               if (! restricted)
2397                 grant_use_seizefile (IDENTIFIER_POINTER (use_seizefile_name));
2398               mark_use_seizefile_written (use_seizefile_name);
2399             }
2400           if (! restricted)
2401             {
2402               APPEND (result, "SEIZE ");
2403               mode_string = decode_prefix_rename (decl);
2404               APPEND (result, mode_string->str);
2405               FREE (mode_string);
2406             }
2407         }
2408       break;
2409
2410     default:
2411       APPEND (result, "----- not implemented ------");
2412       break;
2413     }
2414   return (result);
2415 }
2416
2417 static MYSTRING *
2418 decode_decl_selective (decl, all_decls)
2419     tree decl;
2420     tree all_decls;
2421 {
2422   MYSTRING *result = newstring ("");
2423   MYSTRING *mode_string;
2424   tree      type;
2425
2426   if (CH_ALREADY_GRANTED (decl))
2427     /* do nothing */
2428     return result;
2429
2430   CH_ALREADY_GRANTED (decl) = 1;
2431
2432   switch ((int)TREE_CODE (decl))
2433     {
2434     case VAR_DECL:
2435     case BASED_DECL:
2436       mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
2437       if (mode_string->len)
2438         APPEND (result, mode_string->str);
2439       FREE (mode_string);
2440       if ((enum chill_tree_code)TREE_CODE (decl) == BASED_DECL)
2441         {
2442           mode_string = decode_mode_selective (DECL_ABSTRACT_ORIGIN (decl), all_decls);
2443           if (mode_string->len)
2444             PREPEND (result, mode_string->str);
2445           FREE (mode_string);
2446         }
2447       break;
2448
2449     case TYPE_DECL:
2450       if (CH_DECL_SIGNAL (decl))
2451         {
2452           /* this is really a signal */
2453           tree fields = TYPE_FIELDS (TREE_TYPE (decl));
2454           tree signame = DECL_NAME (decl);
2455           tree sigdest;
2456
2457           if (IDENTIFIER_SIGNAL_DATA (signame))
2458             {
2459               for ( ; fields != NULL_TREE;
2460                    fields = TREE_CHAIN (fields))
2461                 {
2462                   MYSTRING *mode_string;
2463
2464                   mode_string = get_type_selective (TREE_TYPE (fields),
2465                                                     all_decls);
2466                   if (mode_string->len)
2467                     APPEND (result, mode_string->str);
2468                   FREE (mode_string);
2469                 }
2470             }
2471           sigdest = IDENTIFIER_SIGNAL_DEST (signame);
2472           if (sigdest != NULL_TREE)
2473             {
2474               mode_string = decode_mode_selective (DECL_NAME (sigdest), all_decls);
2475               if (mode_string->len)
2476                 {
2477                   MAYBE_NEWLINE (result);
2478                   APPEND (result, mode_string->str);
2479                 }
2480               FREE (mode_string);
2481             }
2482         }
2483       else
2484         {
2485           /* avoid defining a mode as itself */
2486           mode_string = decode_mode_selective (TREE_TYPE (decl), all_decls);
2487           APPEND (result, mode_string->str);
2488           FREE (mode_string);
2489         }
2490       break;
2491
2492     case FUNCTION_DECL:
2493       {
2494         tree    args;
2495
2496         type = TREE_TYPE (decl);
2497         args = TYPE_ARG_TYPES (type);
2498
2499         args = TYPE_ARG_TYPES (type);
2500
2501         mode_string = print_proc_tail_selective (type, args, all_decls);
2502         if (mode_string->len)
2503           APPEND (result, mode_string->str);
2504         FREE (mode_string);
2505       }
2506       break;
2507
2508     case FIELD_DECL:
2509       mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
2510       if (mode_string->len)
2511         APPEND (result, mode_string->str);
2512       FREE (mode_string);
2513       break;
2514
2515     case CONST_DECL:
2516       if (DECL_INITIAL (decl) == NULL_TREE
2517           || TREE_CODE (DECL_INITIAL (decl)) == ERROR_MARK)
2518         break;
2519       mode_string = get_type_selective (TREE_TYPE (decl), all_decls);
2520       if (mode_string->len)
2521         APPEND (result, mode_string->str);
2522       FREE (mode_string);
2523       mode_string = decode_constant_selective (DECL_INITIAL (decl), all_decls);
2524       if (mode_string->len)
2525         {
2526           MAYBE_NEWLINE (result);
2527           APPEND (result, mode_string->str);
2528         }
2529       FREE (mode_string);
2530       break;
2531
2532     }
2533   MAYBE_NEWLINE (result);
2534   return (result);
2535 }
2536
2537 static void
2538 globalize_decl (decl)
2539     tree        decl;
2540 {
2541   if (!TREE_PUBLIC (decl) && DECL_NAME (decl) &&
2542       (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL))
2543     {
2544       const char *name = XSTR (XEXP (DECL_RTL (decl), 0), 0);
2545
2546       if (!first_global_object_name)
2547         first_global_object_name = name + (name[0] == '*');
2548       ASM_GLOBALIZE_LABEL (asm_out_file, name);
2549     }
2550 }
2551
2552
2553 static void
2554 grant_one_decl (decl)
2555     tree        decl;
2556 {
2557   MYSTRING      *result;
2558
2559   if (DECL_SOURCE_LINE (decl) == 0)
2560     return;
2561   result = decode_decl (decl);
2562   if (result->len)
2563     {
2564       APPEND (result, ";\n");
2565       APPEND (gstring, result->str);
2566     }
2567   FREE (result);
2568 }
2569
2570 static void
2571 grant_one_decl_selective (decl, all_decls)
2572      tree decl;
2573      tree all_decls;
2574 {
2575   MYSTRING *result;
2576   MYSTRING *fixups;
2577
2578   tree     d = DECL_ABSTRACT_ORIGIN (decl);
2579
2580   if (CH_ALREADY_GRANTED (d))
2581     /* already done */
2582     return;
2583
2584   result = decode_decl (d);
2585   if (!result->len)
2586     {
2587       /* nothing to do */
2588       FREE (result);
2589       return;
2590     }
2591
2592   APPEND (result, ";\n");
2593
2594   /* now process all undefined items in the decl */
2595   fixups = decode_decl_selective (d, all_decls);
2596   if (fixups->len)
2597     {
2598       PREPEND (result, fixups->str);
2599     }
2600   FREE (fixups);
2601
2602   /* we have finished a decl */
2603   APPEND (selective_gstring, result->str);
2604   FREE (result);
2605 }
2606
2607 static int
2608 compare_memory_file (fname, buf)
2609     const char  *fname;
2610     const char  *buf;
2611 {
2612   FILE  *fb;
2613   int           c;
2614
2615   /* check if we have something to write */
2616   if (!buf || !strlen (buf))
2617     return (0);
2618
2619   if ((fb = fopen (fname, "r")) == NULL)
2620     return (1);
2621
2622   while ((c = getc (fb)) != EOF)
2623     {
2624       if (c != *buf++)
2625         {
2626           fclose (fb);
2627           return (1);
2628         }
2629     }
2630   fclose (fb);
2631   return (*buf ? 1 : 0);
2632 }
2633
2634 void
2635 write_grant_file ()
2636 {
2637   FILE  *fb;
2638
2639   /* We only write out the grant file if it has changed,
2640      to avoid changing its time-stamp and triggering an
2641      unnecessary 'make' action.  Return if no change. */
2642   if (gstring == NULL || !spec_module_generated ||
2643       !compare_memory_file (grant_file_name, gstring->str))
2644     return;
2645
2646   fb = fopen (grant_file_name, "w");
2647   if (fb == NULL)
2648     fatal_io_error ("can't open %s", grant_file_name);
2649
2650   /* write file. Due to problems with record sizes on VAX/VMS
2651      write string to '\n' */
2652 #ifdef VMS
2653   /* do it this way for VMS, cause of problems with
2654      record sizes */
2655   p = gstring->str;
2656   while (*p)
2657     {
2658       p1 = strchr (p, '\n');
2659       c = *++p1;
2660       *p1 = '\0';
2661       fprintf (fb, "%s", p);
2662       *p1 = c;
2663       p = p1;
2664     }
2665 #else
2666   /* faster way to write */
2667   if (write (fileno (fb), gstring->str, gstring->len) < 0)
2668     {
2669       int save_errno = errno;
2670
2671       unlink (grant_file_name);
2672       errno = save_errno;
2673       fatal_io_error ("can't write to %s", grant_file_name);
2674     }
2675 #endif
2676   fclose (fb);
2677 }
2678
2679
2680 /* handle grant statement */
2681
2682 void
2683 set_default_grant_file ()
2684 {
2685     char        *p, *tmp;
2686     const char  *fname;
2687
2688     if (dump_base_name)
2689       fname = dump_base_name; /* Probably invoked via gcc */
2690     else
2691       { /* Probably invoked directly (not via gcc) */
2692         fname = asm_file_name;
2693         if (!fname)
2694           fname = main_input_filename ? main_input_filename : input_filename;
2695         if (!fname)
2696           return;
2697       }
2698
2699     p = strrchr (fname, '.');
2700     if (!p)
2701     {
2702         tmp = (char *) alloca (strlen (fname) + 10);
2703         strcpy (tmp, fname);
2704     }
2705     else
2706     {
2707         int     i = p - fname;
2708
2709         tmp = (char *) alloca (i + 10);
2710         strncpy (tmp, fname, i);
2711         tmp[i] = '\0';
2712     }
2713     strcat (tmp, ".grt");
2714     default_grant_file = build_string (strlen (tmp), tmp);
2715
2716     grant_file_name = TREE_STRING_POINTER (default_grant_file);
2717
2718     if (gstring == NULL)
2719       gstring = newstring ("");
2720     if (selective_gstring == NULL)
2721       selective_gstring = newstring ("");
2722 }
2723
2724 /* Make DECL visible under the name NAME in the (fake) outermost scope. */
2725
2726 void
2727 push_granted (name, decl)
2728      tree name ATTRIBUTE_UNUSED, decl ATTRIBUTE_UNUSED;
2729 {
2730 #if 0
2731   IDENTIFIER_GRANTED_VALUE (name) = decl;
2732   granted_decls = tree_cons (name, decl, granted_decls);
2733 #endif
2734 }
2735
2736 void
2737 chill_grant (old_prefix, new_prefix, postfix, forbid)
2738      tree old_prefix;
2739      tree new_prefix;
2740      tree postfix;
2741      tree forbid;
2742 {
2743   if (pass == 1)
2744     {
2745 #if 0
2746       tree old_name = old_prefix == NULL_TREE ? postfix
2747         : get_identifier3 (IDENTIFIER_POINTER (old_prefix),
2748                            "!", IDENTIFIER_POINTER (postfix));
2749       tree new_name = new_prefix == NULL_TREE ? postfix
2750         : get_identifier3 (IDENTIFIER_POINTER (new_prefix),
2751                            "!", IDENTIFIER_POINTER (postfix));
2752 #endif
2753       tree alias = build_alias_decl (old_prefix, new_prefix, postfix);
2754       CH_DECL_GRANTED (alias) = 1;
2755       DECL_SEIZEFILE (alias) = current_seizefile_name;
2756       TREE_CHAIN (alias) = current_module->granted_decls;
2757       current_module->granted_decls = alias;
2758
2759       if (forbid)
2760         warning ("FORBID is not yet implemented");  /* FIXME */
2761     }
2762 }
2763 \f
2764 /* flag GRANT ALL only once. Avoids search in case of GRANT ALL. */
2765 static int grant_all_seen = 0;
2766
2767 /* check if a decl is in the list of granted decls. */
2768 static int
2769 search_in_list (name, granted_decls)
2770     tree name;
2771     tree granted_decls;
2772 {
2773   tree vars;
2774
2775   for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2776     if (DECL_SOURCE_LINE (vars))
2777       {
2778         if (DECL_POSTFIX_ALL (vars))
2779           {
2780             grant_all_seen = 1;
2781             return 1;
2782           }
2783         else if (name == DECL_NAME (vars))
2784           return 1;
2785       }
2786   /* not found */
2787   return 0;
2788 }
2789
2790 static int
2791 really_grant_this (decl, granted_decls)
2792     tree decl;
2793     tree granted_decls;
2794 {
2795   /* we never grant labels at module level */
2796   if ((enum chill_tree_code)TREE_CODE (decl) == LABEL_DECL)
2797     return 0;
2798
2799   if (grant_all_seen)
2800     return 1;
2801
2802   switch ((enum chill_tree_code)TREE_CODE (decl))
2803     {
2804     case VAR_DECL:
2805     case BASED_DECL:
2806     case FUNCTION_DECL:
2807       return search_in_list (DECL_NAME (decl), granted_decls);
2808     case ALIAS_DECL:
2809     case CONST_DECL:
2810       return 1;
2811     case TYPE_DECL:
2812       if (CH_DECL_SIGNAL (decl))
2813         return search_in_list (DECL_NAME (decl), granted_decls);
2814       else
2815         return 1;
2816     default:
2817       break;
2818     }
2819
2820   /* this nerver should happen */
2821   error_with_decl (decl, "function \"really_grant_this\" called for `%s'");
2822   return 1;
2823 }
2824 \f
2825 /* Write a SPEC MODULE using the declarations in the list DECLS. */
2826 static int header_written = 0;
2827 #define HEADER_TEMPLATE "--\n-- WARNING: this file was generated by\n\
2828 -- GNUCHILL version %s\n-- based on gcc version %s\n--\n"
2829
2830 void
2831 write_spec_module (decls, granted_decls)
2832      tree decls;
2833      tree granted_decls;
2834 {
2835   tree   vars;
2836   char   *hdr;
2837
2838   if (granted_decls == NULL_TREE)
2839     return;
2840
2841   use_seizefile_name = NULL_TREE;
2842
2843   if (!header_written)
2844     {
2845       hdr = (char*) alloca (strlen (gnuchill_version)
2846                             + strlen (version_string)
2847                             + sizeof (HEADER_TEMPLATE) /* includes \0 */);
2848       sprintf (hdr, HEADER_TEMPLATE, gnuchill_version, version_string);
2849       APPEND (gstring, hdr);
2850       header_written = 1;
2851     }
2852   APPEND (gstring, IDENTIFIER_POINTER (current_module->name));
2853   APPEND (gstring, ": SPEC MODULE\n");
2854
2855   /* first of all we look for GRANT ALL specified */
2856   search_in_list (NULL_TREE, granted_decls);
2857
2858   if (grant_all_seen != 0)
2859     {
2860       /* write all identifiers to grant file */
2861       for (vars = decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2862         {
2863           if (DECL_SOURCE_LINE (vars))
2864             {
2865               if (DECL_NAME (vars))
2866                 {
2867                   if ((TREE_CODE (vars) != CONST_DECL || !CH_DECL_ENUM (vars)) &&
2868                       really_grant_this (vars, granted_decls))
2869                     grant_one_decl (vars);
2870                 }
2871               else if (DECL_POSTFIX_ALL (vars))
2872                 {
2873                   static int restricted = 0;
2874
2875                   if (DECL_SEIZEFILE (vars) != use_seizefile_name
2876                       && DECL_SEIZEFILE (vars))
2877                     {
2878                       use_seizefile_name = DECL_SEIZEFILE (vars);
2879                       restricted = use_seizefile_name == NULL_TREE ? 0 : CH_USE_SEIZEFILE_RESTRICTED (use_seizefile_name);
2880                       if (! restricted)
2881                         grant_use_seizefile (IDENTIFIER_POINTER (use_seizefile_name));
2882                       mark_use_seizefile_written (use_seizefile_name);
2883                     }
2884                   if (! restricted)
2885                     {
2886                       APPEND (gstring, "SEIZE ALL;\n");
2887                     }
2888                 }
2889             }
2890         }
2891     }
2892   else
2893     {
2894       seizefile_list *wrk, *x;
2895
2896       /* do a selective write to the grantfile. This will reduce the
2897          size of a grantfile and speed up compilation of
2898          modules depending on this grant file */
2899
2900       if (selective_gstring == 0)
2901         selective_gstring = newstring ("");
2902
2903       /* first of all process all SEIZE ALL's */
2904       for (vars = decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2905         {
2906           if (DECL_SOURCE_LINE (vars)
2907               && DECL_POSTFIX_ALL (vars))
2908             grant_seized_identifier (vars);
2909         }
2910
2911       /* now walk through granted decls */
2912       granted_decls = nreverse (granted_decls);
2913       for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2914         {
2915           grant_one_decl_selective (vars, decls);
2916         }
2917       granted_decls = nreverse (granted_decls);
2918
2919       /* append all SEIZES */
2920       wrk = selective_seizes;
2921       while (wrk != 0)
2922         {
2923           x = wrk->next;
2924           APPEND (gstring, wrk->seizes->str);
2925           FREE (wrk->seizes);
2926           free (wrk);
2927           wrk = x;
2928         }
2929       selective_seizes = 0;
2930
2931       /* append generated string to grant file */
2932       APPEND (gstring, selective_gstring->str);
2933       FREE (selective_gstring);
2934       selective_gstring = NULL;
2935     }
2936
2937   for (vars = granted_decls; vars != NULL_TREE; vars = TREE_CHAIN (vars))
2938     if (DECL_SOURCE_LINE (vars))
2939       {
2940         MYSTRING *mode_string = decode_prefix_rename (vars);
2941         APPEND (gstring, "GRANT ");
2942         APPEND (gstring, mode_string->str);
2943         FREE (mode_string);
2944         APPEND (gstring, ";\n");
2945       }
2946
2947   APPEND (gstring, "END;\n");
2948   spec_module_generated = 1;
2949
2950   /* initialize this for next spec module */
2951   grant_all_seen = 0;
2952 }
2953 \f
2954 /*
2955  * after the dark comes, after all of the modules are at rest,
2956  * we tuck the compilation unit to bed...  A story in pass 1
2957  * and a hug-and-a-kiss goodnight in pass 2.
2958  */
2959 void
2960 chill_finish_compile ()
2961 {
2962   tree global_list;
2963   tree chill_init_function;
2964
2965   tasking_setup ();
2966   build_enum_tables ();
2967
2968   /* We only need an initializer function for the source file if
2969      a) there's module-level code to be called, or
2970      b) tasking-related stuff to be initialized. */
2971   if (module_init_list != NULL_TREE || tasking_list != NULL_TREE)
2972     {
2973       extern tree initializer_type;
2974       static tree chill_init_name;
2975
2976       /* declare the global initializer list */
2977       global_list = do_decl (get_identifier ("_ch_init_list"),
2978                              build_chill_pointer_type (initializer_type), 1, 0,
2979                              NULL_TREE, 1);
2980
2981       /* Now, we're building the function which is the *real*
2982          constructor - if there's any module-level code in this
2983          source file, the compiler puts the file's initializer entry
2984          onto the global initializer list, so each module's body code
2985          will eventually get called, after all of the processes have
2986          been started up.  */
2987
2988       /* This is better done in pass 2 (when first_global_object_name
2989          may have been set), but that is too late.
2990          Perhaps rewrite this so nothing is done in pass 1. */
2991       if (pass == 1)
2992         {
2993           /* If we don't do this spoof, we get the name of the first
2994              tasking_code variable, and not the file name. */
2995           char *q;
2996           const char *tmp = first_global_object_name;
2997           first_global_object_name = NULL;
2998           chill_init_name = get_file_function_name ('I');
2999           first_global_object_name = tmp;
3000
3001           /* strip off the file's extension, if any. */
3002           q = strrchr (IDENTIFIER_POINTER (chill_init_name), '.');
3003           if (q)
3004             *q = '\0';
3005         }
3006
3007       start_chill_function (chill_init_name, void_type_node, NULL_TREE,
3008                             NULL_TREE, NULL_TREE);
3009       TREE_PUBLIC (current_function_decl) = 1;
3010       chill_init_function = current_function_decl;
3011
3012       /* For each module that we've compiled, that had module-level
3013          code to be called, add its entry to the global initializer
3014          list. */
3015
3016       if (pass == 2)
3017         {
3018           tree module_init;
3019
3020           for (module_init = module_init_list;
3021                module_init != NULL_TREE;
3022                module_init = TREE_CHAIN (module_init))
3023             {
3024               tree init_entry      = TREE_VALUE (module_init);
3025
3026               /* assign module_entry.next := _ch_init_list; */
3027               expand_expr_stmt (
3028                 build_chill_modify_expr (
3029                   build_component_ref (init_entry,
3030                     get_identifier ("__INIT_NEXT")),
3031                       global_list));
3032
3033               /* assign _ch_init_list := &module_entry; */
3034               expand_expr_stmt (
3035                 build_chill_modify_expr (global_list,
3036                   build1 (ADDR_EXPR, ptr_type_node, init_entry)));
3037             }
3038         }
3039
3040       tasking_registry ();
3041
3042       make_decl_rtl (current_function_decl, NULL, 1);
3043
3044       finish_chill_function ();
3045
3046       if (pass == 2 && targetm.have_ctors_dtors)
3047         (* targetm.asm_out.constructor)
3048           (XEXP (DECL_RTL (chill_init_function), 0), DEFAULT_INIT_PRIORITY);
3049
3050       /* ready now to link decls onto this list in pass 2. */
3051       module_init_list = NULL_TREE;
3052       tasking_list = NULL_TREE;
3053     }
3054 }
3055
3056