gcc/ch/tasking.c

   1 /* Implement tasking-related actions for CHILL.
   2    Copyright (C) 1992, 93, 1994, 1998 Free Software Foundation, Inc.
   3
   4 This file is part of GNU CC.
   5
   6 GNU CC is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU CC is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU CC; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 #include "config.h"
  22 #include "system.h"
  23 #include "tree.h"
  24 #include "rtl.h"
  25 #include "ch-tree.h"
  26 #include "flags.h"
  27 #include "input.h"
  28 #include "obstack.h"
  29 #include "assert.h"
  30 #include "tasking.h"
  31 #include "lex.h"
  32 #include "toplev.h"
  33
  34 /* from ch-lex.l, from compiler directives */
  35 extern tree process_type;
  36 extern tree send_signal_prio;
  37 extern tree send_buffer_prio;
  38
  39 tree tasking_message_type;
  40 tree instance_type_node;
  41 tree generic_signal_type_node;
  42
  43 /* the type a tasking code variable has */
  44 tree chill_taskingcode_type_node;
  45
  46 /* forward declarations */
  47 void validate_process_parameters PROTO((tree));
  48 tree make_process_struct         PROTO((tree, tree));
  49
  50 /* list of this module's process, buffer, etc. decls.
  51  This is a list of TREE_VECs, chain by their TREE_CHAINs. */
  52 tree tasking_list = NULL_TREE;
  53 /* The parts of a tasking_list element. */
  54 #define TASK_INFO_PDECL(NODE) TREE_VEC_ELT(NODE,0)
  55 #define TASK_INFO_ENTRY(NODE) TREE_VEC_ELT(NODE,1)
  56 #define TASK_INFO_CODE_DECL(NODE) TREE_VEC_ELT(NODE,2)
  57 #define TASK_INFO_STUFF_NUM(NODE) TREE_VEC_ELT(NODE,3)
  58 #define TASK_INFO_STUFF_TYPE(NODE) TREE_VEC_ELT(NODE,4)
  59
  60 /* name template for process argument type */
  61 static char * struct_name = "__tmp_%s_arg_type";
  62
  63 /* name template for process arguments for debugging type */
  64 static char * struct_debug_name = "__tmp_%s_debug_type";
  65
  66 #if 0
  67 /* name template for process argument variable */
  68 static char * data_name = "__tmp_%s_arg_variable";
  69 #endif
  70
  71 /* name template for process wrapper */
  72 static char * wrapper_name = "__tmp_%s_wrapper";
  73
  74 extern int ignoring;
  75 static tree void_ftype_void;
  76 static tree pointer_to_instance;
  77 static tree infinite_buffer_event_length_node;
  78 \f
  79 tree
  80 get_struct_type_name (name)
  81      tree name;
  82 {
  83   char *idp = IDENTIFIER_POINTER (name);        /* process name */
  84   char *tmpname = xmalloc (strlen (idp) + strlen (struct_name) + 1);
  85
  86   sprintf (tmpname, struct_name, idp);
  87   return get_identifier (tmpname);
  88 }
  89
  90 tree
  91 get_struct_debug_type_name (name)
  92      tree name;
  93 {
  94   char *idp = IDENTIFIER_POINTER (name);        /* process name */
  95   char *tmpname = xmalloc (strlen (idp) + strlen (struct_debug_name) + 1);
  96
  97   sprintf (tmpname, struct_debug_name, idp);
  98   return get_identifier (tmpname);
  99 }
 100
 101
 102 tree
 103 get_tasking_code_name (name)
 104      tree name;
 105 {
 106   char *skelname = "__tmp_%s_code";
 107   char *name_str = IDENTIFIER_POINTER (name);
 108   char *tmpname  = (char *)alloca (IDENTIFIER_LENGTH (name) +
 109                                    strlen (skelname) + 1);
 110
 111   sprintf (tmpname, skelname, name_str);
 112   return get_identifier (tmpname);
 113 }
 114
 115 #if 0
 116 static tree
 117 get_struct_variable_name (name)
 118      tree name;
 119 {
 120   char *idp = IDENTIFIER_POINTER (name);        /* process name */
 121   char *tmpname = xmalloc (strlen (idp) + strlen (data_name) + 1);
 122
 123   sprintf (tmpname, data_name, idp);
 124   return get_identifier (tmpname);
 125 }
 126 #endif
 127
 128 static tree
 129 get_process_wrapper_name (name)
 130     tree name;
 131 {
 132   char *idp = IDENTIFIER_POINTER (name);
 133   char *tmpname = xmalloc (strlen (idp) + strlen (wrapper_name) + 1);
 134
 135   sprintf (tmpname, wrapper_name, idp);
 136   return get_identifier (tmpname);
 137 }
 138 \f
 139 /*
 140  * If this is a quasi declaration - parsed within a SPEC MODULE,
 141  * QUASI_FLAG is TRUE, to indicate that the variable should not
 142  * be initialized.  The other module will do that.
 143  */
 144 tree
 145 generate_tasking_code_variable (name, tasking_code_ptr, quasi_flag)
 146      tree name, *tasking_code_ptr;
 147      int  quasi_flag;
 148 {
 149
 150   tree decl;
 151   tree tasking_code_name = get_tasking_code_name (name);
 152
 153   if (pass == 2 && ! quasi_flag && *tasking_code_ptr != NULL_TREE)
 154     {
 155       /* check for value should be assigned is out of range */
 156       if (TREE_INT_CST_LOW (*tasking_code_ptr) >
 157           TREE_INT_CST_LOW (TYPE_MAX_VALUE (chill_taskingcode_type_node)))
 158           error ("Tasking code %ld out of range for `%s'.",
 159                  (long) TREE_INT_CST_LOW (*tasking_code_ptr),
 160                  IDENTIFIER_POINTER (name));
 161     }
 162
 163   decl = do_decl (tasking_code_name,
 164                   chill_taskingcode_type_node, 1, 1,
 165                   quasi_flag ? NULL_TREE : *tasking_code_ptr,
 166                   0);
 167
 168   /* prevent granting of this type */
 169   DECL_SOURCE_LINE (decl) = 0;
 170
 171   if (pass == 2 && ! quasi_flag && *tasking_code_ptr != NULL_TREE)
 172     *tasking_code_ptr = fold (build (PLUS_EXPR, chill_taskingcode_type_node,
 173                                      integer_one_node,
 174                                      *tasking_code_ptr));
 175   return decl;
 176 }
 177
 178
 179 /*
 180  * If this is a quasi declaration - parsed within a SPEC MODULE,
 181  * QUASI_FLAG is TRUE, to indicate that the variable should not
 182  * be initialized.  The other module will do that.  This is just
 183  * for BUFFERs and EVENTs.
 184  */
 185 tree
 186 decl_tasking_code_variable (name, tasking_code_ptr, quasi_flag)
 187      tree name, *tasking_code_ptr;
 188      int  quasi_flag;
 189 {
 190   extern struct obstack permanent_obstack;
 191   tree tasking_code_name = get_tasking_code_name (name);
 192   tree decl;
 193
 194   /* guarantee that RTL for the code_variable resides in
 195      the permanent obstack.  The BUFFER or EVENT may be
 196      declared in a PROC, not at global scope... */
 197   push_obstacks (&permanent_obstack, &permanent_obstack);
 198   push_obstacks_nochange ();
 199
 200   if (pass == 2 && ! quasi_flag && *tasking_code_ptr != NULL_TREE)
 201     {
 202       /* check for value should be assigned is out of range */
 203       if (TREE_INT_CST_LOW (*tasking_code_ptr) >
 204           TREE_INT_CST_LOW (TYPE_MAX_VALUE (chill_taskingcode_type_node)))
 205           error ("Tasking code %ld out of range for `%s'.",
 206                  (long) TREE_INT_CST_LOW (*tasking_code_ptr),
 207                  IDENTIFIER_POINTER (name));
 208     }
 209
 210   decl = decl_temp1 (tasking_code_name,
 211                      chill_taskingcode_type_node, 1,
 212                      quasi_flag ? NULL_TREE : *tasking_code_ptr,
 213                      0, 0);
 214   /* prevent granting of this type */
 215   DECL_SOURCE_LINE (decl) = 0;
 216
 217   /* Return to the ambient context.  */
 218   pop_obstacks ();
 219
 220   if (pass == 2 && ! quasi_flag && *tasking_code_ptr != NULL_TREE)
 221     *tasking_code_ptr = fold (build (PLUS_EXPR, chill_taskingcode_type_node,
 222                                      integer_one_node,
 223                                      *tasking_code_ptr));
 224   return decl;
 225 }
 226 \f
 227 /*
 228  * Transmute a process parameter list into an argument structure
 229  * TYPE_DECL for the start_process call to reference.  Create a
 230  * proc_type variable for later.  Returns the new struct type.
 231  */
 232 tree
 233 make_process_struct (name, processparlist)
 234      tree name, processparlist;
 235 {
 236   tree temp;
 237   tree a_parm;
 238   tree field_decls = NULL_TREE;
 239
 240   if (name == NULL_TREE || TREE_CODE (name) == ERROR_MARK)
 241     return error_mark_node;
 242
 243   if (processparlist == NULL_TREE)
 244     return tree_cons (NULL_TREE, NULL_TREE, void_list_node);
 245
 246   if (TREE_CODE (processparlist) == ERROR_MARK)
 247     return error_mark_node;
 248
 249   /* build list of field decls for build_chill_struct_type */
 250   for (a_parm = processparlist; a_parm != NULL_TREE;
 251        a_parm = TREE_CHAIN (a_parm))
 252     {
 253       tree parnamelist = TREE_VALUE (a_parm);
 254       tree purpose     = TREE_PURPOSE (a_parm);
 255       tree mode        = TREE_VALUE (purpose);
 256       tree parm_attr   = TREE_PURPOSE (purpose);
 257       tree field;
 258
 259       /* build a FIELD_DECL node */
 260       if (parm_attr != NULL_TREE)
 261         {
 262           if (parm_attr == ridpointers[(int)RID_LOC])
 263             mode = build_chill_reference_type (mode);
 264           else if (parm_attr == ridpointers[(int)RID_IN])
 265             ;
 266           else if (pass == 1)
 267             {
 268               for (field = parnamelist; field != NULL_TREE;
 269                    field = TREE_CHAIN (field))
 270                 error ("invalid attribute for argument `%s' (only IN or LOC allowed).",
 271                        IDENTIFIER_POINTER (TREE_VALUE (field)));
 272             }
 273         }
 274
 275       field = grok_chill_fixedfields (parnamelist, mode, NULL_TREE);
 276
 277       /* chain the fields in reverse */
 278       if (field_decls == NULL_TREE)
 279         field_decls = field;
 280       else
 281         chainon (field_decls, field);
 282     }
 283
 284   temp = build_chill_struct_type (field_decls);
 285   return temp;
 286 }
 287 \f
 288 /* Build a function for a PROCESS  and define some
 289    types for the process arguments.
 290    After the PROCESS a wrapper function will be
 291    generated which gets the PROCESS arguments via a pointer
 292    to a structure having the same layout as the arguments.
 293    This wrapper function then will call the PROCESS.
 294    The advantage in doing it this way is, that PROCESS
 295    arguments may be displayed by gdb without any change
 296    to gdb.
 297 */
 298 tree
 299 build_process_header (plabel, paramlist)
 300      tree plabel, paramlist;
 301 {
 302   tree struct_ptr_type = NULL_TREE;
 303   tree new_param_list = NULL_TREE;
 304   tree struct_decl = NULL_TREE;
 305   tree process_struct = NULL_TREE;
 306   tree struct_debug_type = NULL_TREE;
 307   tree code_decl;
 308
 309   if (! global_bindings_p ())
 310     {
 311       error ("PROCESS may only be declared at module level");
 312       return error_mark_node;
 313     }
 314
 315   if (paramlist)
 316     {
 317       /* must make the structure OUTSIDE the parameter scope */
 318       if (pass == 1)
 319         {
 320           process_struct = make_process_struct (plabel, paramlist);
 321           struct_ptr_type = build_chill_pointer_type (process_struct);
 322         }
 323       else
 324         {
 325           process_struct = NULL_TREE;
 326           struct_ptr_type = NULL_TREE;
 327         }
 328
 329       struct_decl = push_modedef (get_struct_type_name (plabel),
 330                                   struct_ptr_type, -1);
 331       DECL_SOURCE_LINE (struct_decl) = 0;
 332       struct_debug_type = push_modedef (get_struct_debug_type_name (plabel),
 333                                         process_struct, -1);
 334       DECL_SOURCE_LINE (struct_debug_type) = 0;
 335
 336       if (pass == 2)
 337         {
 338           /* build a list of PARM_DECL's */
 339           tree  wrk = paramlist;
 340           tree  tmp, list = NULL_TREE;
 341
 342           while (wrk != NULL_TREE)
 343             {
 344               tree wrk1 = TREE_VALUE (wrk);
 345
 346               while (wrk1 != NULL_TREE)
 347                 {
 348                   tmp = make_node (PARM_DECL);
 349                   DECL_ASSEMBLER_NAME (tmp) = DECL_NAME (tmp) = TREE_VALUE (wrk1);
 350                   if (list == NULL_TREE)
 351                     new_param_list = list = tmp;
 352                   else
 353                     {
 354                       TREE_CHAIN (list) = tmp;
 355                       list = tmp;
 356                     }
 357                   wrk1 = TREE_CHAIN (wrk1);
 358                 }
 359               wrk = TREE_CHAIN (wrk);
 360             }
 361         }
 362       else
 363         {
 364           /* build a list of modes */
 365           tree  wrk = paramlist;
 366
 367           while (wrk != NULL_TREE)
 368             {
 369               tree wrk1 = TREE_VALUE (wrk);
 370
 371               while (wrk1 != NULL_TREE)
 372                 {
 373                   new_param_list = tree_cons (TREE_PURPOSE (TREE_PURPOSE (wrk)),
 374                                               TREE_VALUE (TREE_PURPOSE (wrk)),
 375                                               new_param_list);
 376                   wrk1 = TREE_CHAIN (wrk1);
 377                 }
 378               wrk = TREE_CHAIN (wrk);
 379             }
 380           new_param_list = nreverse (new_param_list);
 381         }
 382     }
 383
 384   /* declare the code variable outside the process */
 385   code_decl = generate_tasking_code_variable (plabel,
 386                                               &process_type, 0);
 387
 388   /* start the parameter scope */
 389   push_chill_function_context ();
 390
 391   if (! start_chill_function (plabel, void_type_node,
 392                               new_param_list, NULL_TREE, NULL_TREE))
 393     return error_mark_node;
 394
 395   current_module->procedure_seen = 1;
 396   CH_DECL_PROCESS (current_function_decl) = 1;
 397   /* remember the code variable in the function decl */
 398   DECL_TASKING_CODE_DECL (current_function_decl) =
 399     (struct lang_decl *)code_decl;
 400   if (paramlist == NULL_TREE)
 401       /* do it here, cause we don't have a wrapper */
 402     add_taskstuff_to_list (code_decl, "_TT_Process", process_type,
 403                            current_function_decl, NULL_TREE);
 404
 405   return perm_tree_cons (code_decl, struct_decl, NULL_TREE);
 406 }
 407 \f
 408 /* Generate a function which gets a pointer
 409    to an argument block and call the corresponding
 410    PROCESS
 411 */
 412 void
 413 build_process_wrapper (plabel, processdata)
 414     tree        plabel;
 415     tree        processdata;
 416 {
 417   tree  args = NULL_TREE;
 418   tree  wrapper = NULL_TREE;
 419   tree  parammode = TREE_VALUE (processdata);
 420   tree  code_decl = TREE_PURPOSE (processdata);
 421   tree  func = lookup_name (plabel);
 422
 423   /* check the mode. If it is an ERROR_MARK there was an error
 424      in build_process_header, if it is a NULL_TREE the process
 425      don't have parameters, so we must not generate a wrapper */
 426   if (parammode == NULL_TREE ||
 427       TREE_CODE (parammode) == ERROR_MARK)
 428     return;
 429
 430   /* get the function name */
 431   wrapper = get_process_wrapper_name (plabel);
 432
 433   /* build the argument */
 434   if (pass == 2)
 435     {
 436       /* build a PARM_DECL */
 437       args = make_node (PARM_DECL);
 438       DECL_ASSEMBLER_NAME (args) = DECL_NAME (args) = get_identifier ("x");
 439     }
 440   else
 441     {
 442       /* build a tree list with the mode */
 443       args = tree_cons (NULL_TREE,
 444                         TREE_TYPE (parammode),
 445                         NULL_TREE);
 446     }
 447
 448   /* start the function */
 449   push_chill_function_context ();
 450
 451   if (! start_chill_function (wrapper, void_type_node,
 452                               args, NULL_TREE, NULL_TREE))
 453     return;
 454
 455   /* to avoid granting */
 456   DECL_SOURCE_LINE (current_function_decl) = 0;
 457
 458   if (! ignoring)
 459     {
 460       /* make the call to the PROCESS */
 461       tree      wrk;
 462       tree      x = lookup_name (get_identifier ("x"));
 463       /* no need to check this pointer to be NULL */
 464       tree      indref = build_chill_indirect_ref (x, NULL_TREE, 0);
 465
 466       args = NULL_TREE;
 467       wrk = TYPE_FIELDS (TREE_TYPE (TREE_TYPE (x)));
 468       while (wrk != NULL_TREE)
 469         {
 470           args = tree_cons (NULL_TREE,
 471                             build_component_ref (indref, DECL_NAME (wrk)),
 472                             args);
 473           wrk = TREE_CHAIN (wrk);
 474         }
 475       CH_DECL_PROCESS (func) = 0;
 476       expand_expr_stmt (
 477         build_chill_function_call (func, nreverse (args)));
 478       CH_DECL_PROCESS (func) = 1;
 479     }
 480
 481   add_taskstuff_to_list (code_decl, "_TT_Process", process_type,
 482                          func, current_function_decl);
 483
 484   /* finish the function */
 485   finish_chill_function ();
 486   pop_chill_function_context ();
 487 }
 488 \f
 489 /* Generate errors for INOUT, OUT parameters.
 490
 491    "Only if LOC is specified may the mode have the non-value
 492     property"
 493  */
 494
 495 void
 496 validate_process_parameters (parms)
 497      tree parms ATTRIBUTE_UNUSED;
 498 {
 499 }
 500 \f
 501 /*
 502  * build the tree for a start process action.  Loop through the
 503  * actual parameters, making a constructor list, which we use to
 504  * initialize the argument structure.  NAME is the process' name.
 505  * COPYNUM is its copy number, whatever that is.  EXPRLIST is the
 506  * list of actual parameters passed by the start call.  They must
 507  * match. EXPRLIST must still be in reverse order;  we'll reverse it here.
 508  *
 509  * Note: the OPTSET name is not now used - it's here for
 510  * possible future support for the optional 'SET instance-var'
 511  * clause.
 512  */
 513 void
 514 build_start_process (process_name, copynum,
 515                      exprlist, optset)
 516      tree process_name, copynum, exprlist, optset;
 517 {
 518   tree process_decl, struct_type_node;
 519   tree result;
 520   tree valtail, typetail;
 521   tree tuple = NULL_TREE, actuallist = NULL_TREE;
 522   tree typelist;
 523   int  parmno = 2;
 524   tree args;
 525   tree filename, linenumber;
 526
 527   if (exprlist != NULL_TREE && TREE_CODE (exprlist) == ERROR_MARK)
 528     process_decl = NULL_TREE;
 529   else if (! ignoring)
 530     {
 531       process_decl = lookup_name (process_name);
 532       if (process_decl == NULL_TREE)
 533         error ("process name %s never declared",
 534                IDENTIFIER_POINTER (process_name));
 535       else if (TREE_CODE (process_decl) != FUNCTION_DECL
 536           || ! CH_DECL_PROCESS (process_decl))
 537         {
 538           error ("You may only START a process, not a proc");
 539           process_decl = NULL_TREE;
 540         }
 541       else if (DECL_EXTERNAL (process_decl))
 542         {
 543           args = TYPE_ARG_TYPES (TREE_TYPE (process_decl));
 544           if (TREE_VALUE (args) != void_type_node)
 545               struct_type_node = TREE_TYPE (TREE_VALUE (args));
 546           else
 547               struct_type_node = NULL_TREE;
 548         }
 549       else
 550         {
 551           tree  debug_type = lookup_name (
 552                                get_struct_debug_type_name (DECL_NAME (process_decl)));
 553
 554           if (debug_type == NULL_TREE)
 555               /* no debug type, no arguments */
 556               struct_type_node = NULL_TREE;
 557           else
 558               struct_type_node = TREE_TYPE (debug_type);
 559         }
 560     }
 561
 562   /* begin a new name scope */
 563   pushlevel (1);
 564   clear_last_expr ();
 565   push_momentary ();
 566   if (pass == 2)
 567     expand_start_bindings (0);
 568
 569   if (! ignoring && process_decl != NULL_TREE)
 570     {
 571       if (optset == NULL_TREE) ;
 572       else if (!CH_REFERABLE (optset))
 573         {
 574           error ("SET expression not a location.");
 575           optset = NULL_TREE;
 576         }
 577       else if (!CH_IS_INSTANCE_MODE (TREE_TYPE (optset)))
 578         {
 579           error ("SET location must be INSTANCE mode");
 580           optset = NULL_TREE;
 581         }
 582       if (optset)
 583         optset = force_addr_of (optset);
 584       else
 585         optset = convert (ptr_type_node, integer_zero_node);
 586
 587       if (struct_type_node != NULL_TREE)
 588         {
 589           typelist = TYPE_FIELDS (struct_type_node);
 590
 591           for (valtail = nreverse (exprlist), typetail = typelist;
 592                valtail != NULL_TREE && typetail != NULL_TREE;  parmno++,
 593                valtail = TREE_CHAIN (valtail), typetail = TREE_CHAIN (typetail))
 594             {
 595               register tree actual  = valtail  ? TREE_VALUE (valtail)  : 0;
 596               register tree type    = typetail ? TREE_TYPE (typetail) : 0;
 597               char place[30];
 598               sprintf (place, "signal field %d", parmno);
 599               actual = chill_convert_for_assignment (type, actual, place);
 600               actuallist = tree_cons (NULL_TREE, actual,
 601                                       actuallist);
 602             }
 603
 604           tuple = build_nt (CONSTRUCTOR, NULL_TREE,
 605                             nreverse (actuallist));
 606         }
 607       else
 608         {
 609           valtail = NULL_TREE;
 610           typetail = NULL_TREE;
 611         }
 612
 613       if (valtail != 0 && TREE_VALUE (valtail) != void_type_node)
 614         {
 615           char *errstr = "too many arguments to process";
 616           if (process_name)
 617             error ("%s `%s'", errstr, IDENTIFIER_POINTER (process_name));
 618           else
 619             error (errstr);
 620         }
 621       else if (typetail != 0 && TREE_VALUE (typetail) != void_type_node)
 622         {
 623           char *errstr = "too few arguments to process";
 624           if (process_name)
 625             error ("%s `%s'", errstr, IDENTIFIER_POINTER (process_name));
 626           else
 627             error (errstr);
 628         }
 629       else
 630       {
 631         tree process_decl = lookup_name (process_name);
 632         tree process_type = (tree)DECL_TASKING_CODE_DECL (process_decl);
 633         tree struct_size, struct_pointer;
 634
 635         if (struct_type_node != NULL_TREE)
 636           {
 637             result =
 638               decl_temp1 (get_unique_identifier ("START_ARG"),
 639                           struct_type_node, 0, tuple, 0, 0);
 640             /* prevent granting of this type */
 641             DECL_SOURCE_LINE (result) = 0;
 642
 643             mark_addressable (result);
 644             struct_pointer
 645               = build1 (ADDR_EXPR,
 646                         build_chill_pointer_type (struct_type_node),
 647                         result);
 648             struct_size = size_in_bytes (struct_type_node);
 649           }
 650         else
 651           {
 652             struct_size = integer_zero_node;
 653             struct_pointer = null_pointer_node;
 654           }
 655
 656         filename = force_addr_of (get_chill_filename ());
 657         linenumber = get_chill_linenumber ();
 658
 659         expand_expr_stmt (
 660           build_chill_function_call (lookup_name (get_identifier ("__start_process")),
 661             tree_cons (NULL_TREE, process_type,
 662               tree_cons (NULL_TREE, convert (integer_type_node, copynum),
 663                 tree_cons (NULL_TREE, struct_size,
 664                   tree_cons (NULL_TREE, struct_pointer,
 665                     tree_cons (NULL_TREE, optset,
 666                       tree_cons (NULL_TREE, filename,
 667                         build_tree_list (NULL_TREE, linenumber)))))))));
 668       }
 669     }
 670   /* end of scope */
 671
 672   if (pass == 2)
 673     expand_end_bindings (getdecls (), kept_level_p (), 0);
 674   poplevel (kept_level_p (), 0, 0);
 675   pop_momentary ();
 676 }
 677 \f
 678 /*
 679  * A CHILL SET which represents all of the possible tasking
 680  * elements.
 681  */
 682 static tree
 683 build_tasking_enum ()
 684 {
 685   tree result, decl1;
 686   tree enum1;
 687   tree list = NULL_TREE;
 688   tree value = integer_zero_node;
 689
 690   enum1  = start_enum (NULL_TREE);
 691   result = build_enumerator (get_identifier ("_TT_UNUSED"),
 692                              value);
 693   list = chainon (result, list);
 694   value = fold (build (PLUS_EXPR, integer_type_node,
 695                        value, integer_one_node));
 696
 697   result = build_enumerator (get_identifier ("_TT_Process"),
 698                              value);
 699   list = chainon (result, list);
 700   value = fold (build (PLUS_EXPR, integer_type_node,
 701                        value, integer_one_node));
 702
 703   result = build_enumerator (get_identifier ("_TT_Signal"),
 704                              value);
 705   list = chainon (result, list);
 706   value = fold (build (PLUS_EXPR, integer_type_node,
 707                        value, integer_one_node));
 708
 709   result = build_enumerator (get_identifier ("_TT_Buffer"),
 710                              value);
 711   list = chainon (result, list);
 712   value = fold (build (PLUS_EXPR, integer_type_node,
 713                        value, integer_one_node));
 714
 715   result = build_enumerator (get_identifier ("_TT_Event"),
 716                              value);
 717   list = chainon (result, list);
 718   value = fold (build (PLUS_EXPR, integer_type_node,
 719                        value, integer_one_node));
 720
 721   result = build_enumerator (get_identifier ("_TT_Synonym"),
 722                              value);
 723   list = chainon (result, list);
 724   value = fold (build (PLUS_EXPR, integer_type_node,
 725                        value, integer_one_node));
 726
 727   result = build_enumerator (get_identifier ("_TT_Exception"),
 728                              value);
 729   list = chainon (result, list);
 730   value = fold (build (PLUS_EXPR, integer_type_node,
 731                        value, integer_one_node));
 732
 733   result = finish_enum (enum1, list);
 734
 735   decl1 = build_decl (TYPE_DECL,
 736                       get_identifier ("__tmp_TaskingEnum"),
 737                       result);
 738   pushdecl (decl1);
 739   satisfy_decl (decl1, 0);
 740   return decl1;
 741 }
 742 \f
 743 tree
 744 build_tasking_struct ()
 745 {
 746   tree listbase, decl1, decl2, result;
 747   tree enum_type = TREE_TYPE (build_tasking_enum ());
 748   /* We temporarily reset the maximum_field_alignment to zero so the
 749      compiler's init data structures can be compatible with the
 750      run-time system, even when we're compiling with -fpack. */
 751   extern int maximum_field_alignment;
 752   int save_maximum_field_alignment = maximum_field_alignment;
 753   maximum_field_alignment = 0;
 754
 755   decl1 = build_decl (FIELD_DECL, get_identifier ("TaskName"),
 756                       build_chill_pointer_type (char_type_node));
 757   DECL_INITIAL (decl1) = NULL_TREE;
 758   listbase = decl1;
 759
 760   decl2 = build_decl (FIELD_DECL, get_identifier ("TaskValue"),
 761                       build_chill_pointer_type (chill_taskingcode_type_node));
 762   TREE_CHAIN (decl1) = decl2;
 763   DECL_INITIAL (decl2) = NULL_TREE;
 764   decl1 = decl2;
 765
 766   decl2 = build_decl (FIELD_DECL, get_identifier ("TaskValueDefined"),
 767                       integer_type_node);
 768   TREE_CHAIN (decl1) = decl2;
 769   DECL_INITIAL (decl2) = NULL_TREE;
 770   decl1 = decl2;
 771
 772   decl2 = build_decl (FIELD_DECL, get_identifier ("TaskEntry"),
 773                       build_chill_pointer_type (void_ftype_void));
 774   TREE_CHAIN (decl1) = decl2;
 775   DECL_INITIAL (decl2) = NULL_TREE;
 776   decl1 = decl2;
 777
 778   decl2 = build_decl (FIELD_DECL, get_identifier ("TaskType"),
 779                       enum_type);
 780   TREE_CHAIN (decl1) = decl2;
 781   DECL_INITIAL (decl2) = NULL_TREE;
 782   decl1 = decl2;
 783
 784   TREE_CHAIN (decl2) = NULL_TREE;
 785   result = build_chill_struct_type (listbase);
 786   satisfy_decl (result, 0);
 787   maximum_field_alignment = save_maximum_field_alignment;
 788   return result;
 789 }
 790 \f
 791 /*
 792  * build data structures describing each task/signal, etc.
 793  * in current module.
 794  */
 795 void
 796 tasking_setup ()
 797 {
 798   tree tasknode;
 799   tree struct_type;
 800
 801   if (pass == 1)
 802     return;
 803
 804   struct_type = TREE_TYPE (lookup_name (
 805                   get_identifier ("__tmp_TaskingStruct")));
 806
 807   for (tasknode = tasking_list; tasknode != NULL_TREE;
 808        tasknode = TREE_CHAIN (tasknode))
 809     {
 810       /* This is the tasking_code_variable's decl */
 811       tree stuffnumber = TASK_INFO_STUFF_NUM (tasknode);
 812       tree code_decl   = TASK_INFO_CODE_DECL (tasknode);
 813       tree proc_decl   = TASK_INFO_PDECL (tasknode);
 814       tree entry       = TASK_INFO_ENTRY (tasknode);
 815       tree name = DECL_NAME (proc_decl);
 816       char *init_struct = (char *) alloca (IDENTIFIER_LENGTH(name) + 20);
 817       /* take care of zero termination */
 818       tree task_name;
 819       /* these are the fields of the struct, in declaration order */
 820       tree init_flag = (stuffnumber == NULL_TREE) ?
 821         integer_zero_node : integer_one_node;
 822       tree type = DECL_INITIAL (TASK_INFO_STUFF_TYPE (tasknode));
 823       tree int_addr;
 824       tree entry_point;
 825       tree name_ptr;
 826       tree decl;
 827       tree struct_id;
 828       tree initializer;
 829
 830       if (TREE_CODE (proc_decl) == FUNCTION_DECL
 831           && CH_DECL_PROCESS (proc_decl)
 832           && ! DECL_EXTERNAL (proc_decl))
 833         {
 834           if (entry == NULL_TREE)
 835             entry = proc_decl;
 836           mark_addressable (entry);
 837           entry_point = build1 (ADDR_EXPR,
 838                                 build_chill_pointer_type (void_ftype_void),
 839                                 entry);
 840         }
 841       else
 842         entry_point = build1 (NOP_EXPR,
 843                         build_chill_pointer_type (void_ftype_void),
 844                           null_pointer_node);
 845
 846       /* take care of zero termination */
 847       task_name =
 848         build_chill_string (IDENTIFIER_LENGTH (name) + 1,
 849                             IDENTIFIER_POINTER (name));
 850
 851       mark_addressable (code_decl);
 852       int_addr = build1 (ADDR_EXPR,
 853                          build_chill_pointer_type (chill_integer_type_node),
 854                          code_decl);
 855
 856       mark_addressable (task_name);
 857       name_ptr = build1 (ADDR_EXPR,
 858                    build_chill_pointer_type (char_type_node),
 859                      task_name);
 860
 861       sprintf (init_struct, "__tmp_%s_struct",
 862                IDENTIFIER_POINTER (name));
 863
 864       struct_id = get_identifier (init_struct);
 865       initializer = build (CONSTRUCTOR, struct_type, NULL_TREE,
 866                       tree_cons (NULL_TREE, name_ptr,
 867                         tree_cons (NULL_TREE, int_addr,
 868                           tree_cons (NULL_TREE, init_flag,
 869                             tree_cons (NULL_TREE, entry_point,
 870                               tree_cons (NULL_TREE, type, NULL_TREE))))));
 871       TREE_CONSTANT (initializer) = 1;
 872       decl = decl_temp1 (struct_id, struct_type, 1, initializer, 0, 0);
 873       /* prevent granting of this type */
 874       DECL_SOURCE_LINE (decl) = 0;
 875
 876       /* pass the decl to tasking_registry() in the symbol table */
 877       IDENTIFIER_LOCAL_VALUE (struct_id) = decl;
 878     }
 879 }
 880
 881
 882 /*
 883  * Generate code to register the tasking-related stuff
 884  * with the runtime.  Only in pass 2.
 885  */
 886 void
 887 tasking_registry ()
 888 {
 889   tree tasknode, fn_decl;
 890
 891   if (pass == 1)
 892     return;
 893
 894   fn_decl = lookup_name (get_identifier ("__register_tasking"));
 895
 896   for (tasknode = tasking_list; tasknode != NULL_TREE;
 897        tasknode = TREE_CHAIN (tasknode))
 898     {
 899       tree proc_decl = TASK_INFO_PDECL (tasknode);
 900       tree name = DECL_NAME (proc_decl);
 901       tree arg_decl;
 902       char *init_struct = (char *) alloca (IDENTIFIER_LENGTH (name) + 20);
 903
 904       sprintf (init_struct, "__tmp_%s_struct",
 905                IDENTIFIER_POINTER (name));
 906       arg_decl = lookup_name (get_identifier (init_struct));
 907
 908       expand_expr_stmt (
 909         build_chill_function_call (fn_decl,
 910           build_tree_list (NULL_TREE, force_addr_of (arg_decl))));
 911     }
 912 }
 913 \f
 914 /*
 915  * Put a tasking entity (a PROCESS, or SIGNAL) onto
 916  * the list for tasking_setup (). CODE_DECL is the integer code
 917  * variable's DECL, which describes the shadow integer which
 918  * accompanies each tasking entity.  STUFFTYPE is a string
 919  * representing the sort of tasking entity we have here (i.e.
 920  * process, signal, etc.).  STUFFNUMBER is an enumeration
 921  * value saying the same thing.  PROC_DECL is the declaration of
 922  * the entity.  It's a FUNCTION_DECL if the entity is a PROCESS, it's
 923  * a TYPE_DECL if the entity is a SIGNAL.
 924  */
 925 void
 926 add_taskstuff_to_list (code_decl, stufftype, stuffnumber,
 927                        proc_decl, entry)
 928      tree code_decl;
 929      char *stufftype;
 930      tree stuffnumber, proc_decl, entry;
 931 {
 932   if (pass == 1)
 933     /* tell chill_finish_compile that there's
 934        task-level code to be processed. */
 935     tasking_list = integer_one_node;
 936
 937   /* do only in pass 2 so we know in chill_finish_compile whether
 938      to generate a constructor function, and to avoid double the
 939      correct number of entries. */
 940   else /* pass == 2 */
 941     {
 942       tree task_node = make_tree_vec (5);
 943       TASK_INFO_PDECL (task_node) = proc_decl;
 944       TASK_INFO_ENTRY (task_node) = entry;
 945       TASK_INFO_CODE_DECL (task_node) = code_decl;
 946       TASK_INFO_STUFF_NUM (task_node) = stuffnumber;
 947       TASK_INFO_STUFF_TYPE (task_node)
 948         = lookup_name (get_identifier (stufftype));
 949       TREE_CHAIN (task_node) = tasking_list;
 950       tasking_list = task_node;
 951     }
 952 }
 953 \f
 954 /*
 955  * These next routines are called out of build_generalized_call
 956  */
 957 tree
 958 build_copy_number (instance_expr)
 959      tree instance_expr;
 960 {
 961   tree result;
 962
 963   if (instance_expr == NULL_TREE
 964       || TREE_CODE (instance_expr) == ERROR_MARK)
 965     return error_mark_node;
 966   if (! CH_IS_INSTANCE_MODE (TREE_TYPE (instance_expr)))
 967     {
 968       error ("COPY_NUMBER argument must be INSTANCE expression");
 969       return error_mark_node;
 970     }
 971   result = build_component_ref (instance_expr,
 972                                 get_identifier (INS_COPY));
 973   CH_DERIVED_FLAG (result) = 1;
 974   return result;
 975 }
 976
 977
 978 tree
 979 build_gen_code (decl)
 980      tree decl;
 981 {
 982   tree result;
 983
 984   if (decl == NULL_TREE || TREE_CODE (decl) == ERROR_MARK)
 985     return error_mark_node;
 986
 987   if ((TREE_CODE (decl) == FUNCTION_DECL && CH_DECL_PROCESS (decl))
 988       || (TREE_CODE (decl) == TYPE_DECL && CH_DECL_SIGNAL (decl)))
 989     result = (tree)(DECL_TASKING_CODE_DECL (decl));
 990   else
 991     {
 992       error ("GEN_CODE argument must be a process or signal name.");
 993       return error_mark_node;
 994     }
 995   CH_DERIVED_FLAG (result) = 1;
 996   return (result);
 997 }
 998
 999
1000 tree
1001 build_gen_inst (process, copyn)
1002      tree process, copyn;
1003 {
1004   tree ptype;
1005   tree result;
1006
1007   if (copyn == NULL_TREE || TREE_CODE (copyn) == ERROR_MARK)
1008     return error_mark_node;
1009   if (process == NULL_TREE || TREE_CODE (process) == ERROR_MARK)
1010     return error_mark_node;
1011
1012   if (TREE_CODE (TREE_TYPE (copyn)) != INTEGER_TYPE)
1013     {
1014       error ("GEN_INST parameter 2 must be an integer mode");
1015       copyn = integer_zero_node;
1016     }
1017
1018   copyn = check_range (copyn, copyn,
1019                        TYPE_MIN_VALUE (chill_taskingcode_type_node),
1020                        TYPE_MAX_VALUE (chill_taskingcode_type_node));
1021
1022   if (TREE_CODE (process) == FUNCTION_DECL
1023       && CH_DECL_PROCESS (process))
1024     ptype = (tree)DECL_TASKING_CODE_DECL (process);
1025   else if (TREE_TYPE (process) != NULL_TREE
1026            && TREE_CODE (TREE_TYPE (process)) == INTEGER_TYPE)
1027     {
1028       process = check_range (process, process,
1029                              TYPE_MIN_VALUE (chill_taskingcode_type_node),
1030                              TYPE_MAX_VALUE (chill_taskingcode_type_node));
1031       ptype = convert (chill_taskingcode_type_node, process);
1032     }
1033   else
1034     {
1035       error ("GEN_INST parameter 1 must be a PROCESS or an integer expression");
1036       return (error_mark_node);
1037     }
1038
1039   result = convert (instance_type_node,
1040              build_nt (CONSTRUCTOR, NULL_TREE,
1041                tree_cons (NULL_TREE, ptype,
1042                  tree_cons (NULL_TREE,
1043                    convert (chill_taskingcode_type_node, copyn), NULL_TREE))));
1044   CH_DERIVED_FLAG (result) = 1;
1045   return result;
1046 }
1047
1048
1049 tree
1050 build_gen_ptype (process_decl)
1051      tree process_decl;
1052 {
1053   tree result;
1054
1055   if (process_decl == NULL_TREE || TREE_CODE (process_decl) == ERROR_MARK)
1056     return error_mark_node;
1057
1058   if (TREE_CODE (process_decl) != FUNCTION_DECL
1059       || ! CH_DECL_PROCESS (process_decl))
1060     {
1061       error_with_decl (process_decl, "%s is not a declared process");
1062       return error_mark_node;
1063     }
1064
1065   result = (tree)DECL_TASKING_CODE_DECL (process_decl);
1066   CH_DERIVED_FLAG (result) = 1;
1067   return result;
1068 }
1069
1070
1071 tree
1072 build_proc_type (instance_expr)
1073      tree instance_expr;
1074 {
1075   tree result;
1076
1077   if (instance_expr == NULL_TREE || TREE_CODE (instance_expr) == ERROR_MARK)
1078     return error_mark_node;
1079
1080   if (! CH_IS_INSTANCE_MODE (TREE_TYPE (instance_expr)))
1081     {
1082       error ("PROC_TYPE argument must be INSTANCE expression");
1083       return error_mark_node;
1084     }
1085   result = build_component_ref (instance_expr,
1086                                 get_identifier (INS_PTYPE));
1087   CH_DERIVED_FLAG (result) = 1;
1088   return result;
1089 }
1090
1091 tree
1092 build_queue_length (buf_ev)
1093      tree buf_ev;
1094 {
1095   if (buf_ev == NULL_TREE || TREE_CODE (buf_ev) == ERROR_MARK)
1096     return error_mark_node;
1097   if (TREE_TYPE (buf_ev) == NULL_TREE ||
1098       TREE_CODE (TREE_TYPE (buf_ev)) == ERROR_MARK)
1099     return error_mark_node;
1100
1101   if (CH_IS_BUFFER_MODE (TREE_TYPE (buf_ev)) ||
1102       CH_IS_EVENT_MODE (TREE_TYPE (buf_ev)))
1103     {
1104       char *field_name;
1105       tree  arg1, arg2;
1106
1107       if (CH_IS_EVENT_MODE (TREE_TYPE (buf_ev)))
1108         {
1109           field_name = "__event_data";
1110           arg2 = integer_one_node;
1111         }
1112       else
1113         {
1114           field_name = "__buffer_data";
1115           arg2 = integer_zero_node;
1116         }
1117       arg1 = build_component_ref (buf_ev, get_identifier (field_name));
1118       return build_chill_function_call (
1119                 lookup_name (get_identifier ("__queue_length")),
1120                    tree_cons (NULL_TREE, arg1,
1121                       tree_cons (NULL_TREE, arg2, NULL_TREE)));
1122     }
1123
1124   error ("QUEUE_LENGTH argument must be a BUFFER/EVENT location.");
1125   return error_mark_node;
1126 }
1127 \f
1128 tree
1129 build_signal_struct_type (signame, sigmodelist, optsigdest)
1130      tree signame, sigmodelist, optsigdest;
1131 {
1132   tree decl, temp;
1133
1134   if (pass == 1)
1135     {
1136       int  fldcnt = 0;
1137       tree mode, field_decls = NULL_TREE;
1138
1139       for (mode = sigmodelist; mode != NULL_TREE; mode = TREE_CHAIN (mode))
1140         {
1141           tree field;
1142           char fldname[20];
1143
1144           if (TREE_VALUE (mode) == NULL_TREE)
1145             continue;
1146           sprintf (fldname, "fld%03d", fldcnt++);
1147           field = build_decl (FIELD_DECL,
1148                               get_identifier (fldname),
1149                               TREE_VALUE (mode));
1150           if (field_decls == NULL_TREE)
1151             field_decls = field;
1152           else
1153             chainon (field_decls, field);
1154         }
1155       if (field_decls == NULL_TREE)
1156         field_decls = build_decl (FIELD_DECL,
1157                                   get_identifier ("__tmp_empty"),
1158                                   boolean_type_node);
1159       temp = build_chill_struct_type (field_decls);
1160
1161       /* save the destination process name of the signal */
1162       IDENTIFIER_SIGNAL_DEST (signame) = optsigdest;
1163       IDENTIFIER_SIGNAL_DATA (signame) = fldcnt;
1164     }
1165   else
1166     {
1167       /* optsigset is only valid in pass 2, so we have to save it now */
1168       IDENTIFIER_SIGNAL_DEST (signame) = optsigdest;
1169       temp = NULL_TREE; /* Actually, don't care. */
1170     }
1171
1172   decl = push_modedef (signame, temp, -1);
1173   if (decl != NULL_TREE)
1174     CH_DECL_SIGNAL (decl) = 1;
1175   return decl;
1176 }
1177 \f
1178 /*
1179  * An instance type is a unique process identifier in the CHILL
1180  * tasking arena.  It consists of a process type and a copy number.
1181  */
1182 void
1183 build_instance_type ()
1184 {
1185   tree decl1, decl2, tdecl;
1186
1187   decl1 = build_decl (FIELD_DECL, get_identifier (INS_PTYPE),
1188                       chill_taskingcode_type_node);
1189
1190   TREE_CHAIN (decl1) = decl2 =
1191     build_decl (FIELD_DECL, get_identifier (INS_COPY),
1192                 chill_taskingcode_type_node);
1193   TREE_CHAIN (decl2) = NULL_TREE;
1194
1195   instance_type_node = build_chill_struct_type (decl1);
1196   tdecl = build_decl (TYPE_DECL, ridpointers[(int) RID_INSTANCE],
1197                       instance_type_node);
1198   TYPE_NAME (instance_type_node) = tdecl;
1199   CH_NOVELTY (instance_type_node) = tdecl;
1200   DECL_SOURCE_LINE (tdecl) = 0;
1201   pushdecl (tdecl);
1202
1203   pointer_to_instance = build_chill_pointer_type (instance_type_node);
1204 }
1205 \f
1206 #if 0
1207  *
1208  * The tasking message descriptor looks like this C structure:
1209  *
1210  * typedef struct
1211  *   {
1212  *     short *sc;                 /* ptr to code integer */
1213  *     int    data_len;           /* length of signal/buffer data msg */
1214  *     void  *data;               /* ptr to signal/buffer data */
1215  *   } SignalDescr;
1216  *
1217  *
1218 #endif
1219
1220 void
1221 build_tasking_message_type ()
1222 {
1223   tree type_name;
1224   tree temp;
1225   /* We temporarily reset maximum_field_alignment to deal with
1226      the runtime system. */
1227   extern int maximum_field_alignment;
1228   int save_maximum_field_alignment = maximum_field_alignment;
1229   tree field1, field2, field3;
1230
1231   maximum_field_alignment = 0;
1232   field1 = build_decl (FIELD_DECL,
1233                        get_identifier ("_SD_code_ptr"),
1234                        build_pointer_type (chill_integer_type_node));
1235   field2 = build_decl (FIELD_DECL,
1236                        get_identifier ("_SD_data_len"),
1237                        integer_type_node);
1238   field3 = build_decl (FIELD_DECL,
1239                        get_identifier ("_SD_data_ptr"),
1240                        ptr_type_node);
1241   TREE_CHAIN (field1) = field2;
1242   TREE_CHAIN (field2) = field3;
1243   temp = build_chill_struct_type (field1);
1244
1245   type_name = get_identifier ("__tmp_SD_struct");
1246   tasking_message_type = build_decl (TYPE_DECL, type_name, temp);
1247
1248   /* This won't get seen in pass 2, so lay it out now.  */
1249   layout_chill_struct_type (temp);
1250   pushdecl (tasking_message_type);
1251   maximum_field_alignment = save_maximum_field_alignment;
1252 }
1253 \f
1254 tree
1255 build_signal_descriptor (sigdef, exprlist)
1256      tree sigdef, exprlist;
1257 {
1258   tree fieldlist, typetail, valtail;
1259   tree actuallist = NULL_TREE;
1260   tree signame = DECL_NAME (sigdef);
1261   tree dataptr, datalen;
1262   int  parmno = 1;
1263
1264   if (sigdef == NULL_TREE
1265       || TREE_CODE (sigdef) == ERROR_MARK)
1266     return error_mark_node;
1267
1268   if (exprlist != NULL_TREE
1269       && TREE_CODE (exprlist) == ERROR_MARK)
1270     return error_mark_node;
1271
1272   if (TREE_CODE (sigdef) != TYPE_DECL
1273       || ! CH_DECL_SIGNAL (sigdef))
1274     {
1275       error ("SEND requires a SIGNAL; %s is not a SIGNAL name",
1276              IDENTIFIER_POINTER (signame));
1277       return error_mark_node;
1278     }
1279   if (CH_TYPE_NONVALUE_P (TREE_TYPE (sigdef)))
1280     return error_mark_node;
1281
1282   fieldlist = TYPE_FIELDS (TREE_TYPE (sigdef));
1283   if (IDENTIFIER_SIGNAL_DATA (signame) == 0)
1284     fieldlist = TREE_CHAIN (fieldlist);
1285
1286   for (valtail = exprlist, typetail = fieldlist;
1287        valtail != NULL_TREE && typetail != NULL_TREE;
1288        parmno++, valtail = TREE_CHAIN (valtail),
1289        typetail = TREE_CHAIN (typetail))
1290     {
1291       register tree actual  = valtail  ? TREE_VALUE (valtail) : 0;
1292       register tree type    = typetail ? TREE_TYPE (typetail) : 0;
1293       char place[30];
1294       sprintf (place, "signal field %d", parmno);
1295       actual = chill_convert_for_assignment (type, actual, place);
1296       actuallist = tree_cons (NULL_TREE,  actual, actuallist);
1297     }
1298   if (valtail != 0 && TREE_VALUE (valtail) != void_type_node)
1299     {
1300       error ("too many values for SIGNAL `%s'",
1301              IDENTIFIER_POINTER (signame));
1302       return error_mark_node;
1303     }
1304   else if (typetail != 0 && TREE_VALUE (typetail) != void_type_node)
1305     {
1306       error ("too few values for SIGNAL `%s'",
1307            IDENTIFIER_POINTER (signame));
1308       return error_mark_node;
1309     }
1310
1311   {
1312     /* build signal data structure */
1313     tree sigdataname = get_unique_identifier (
1314                          IDENTIFIER_POINTER (signame));
1315     if (exprlist == NULL_TREE)
1316       {
1317         dataptr = null_pointer_node;
1318         datalen = integer_zero_node;
1319       }
1320     else
1321       {
1322         tree tuple = build_nt (CONSTRUCTOR,
1323                        NULL_TREE, nreverse (actuallist));
1324         tree decl = decl_temp1 (sigdataname, TREE_TYPE (sigdef),
1325                            0, tuple, 0, 0);
1326         /* prevent granting of this type */
1327         DECL_SOURCE_LINE (decl) = 0;
1328
1329         dataptr = force_addr_of (decl);
1330         datalen = size_in_bytes (TREE_TYPE (decl));
1331       }
1332
1333     /* build descriptor pointing to signal data */
1334     {
1335       tree decl, tuple;
1336       tree tasking_message_var = get_unique_identifier (
1337                                    IDENTIFIER_POINTER (signame));
1338
1339       tree tasking_code =
1340         (tree)DECL_TASKING_CODE_DECL (lookup_name (signame));
1341
1342       mark_addressable (tasking_code);
1343       tuple = build_nt (CONSTRUCTOR, NULL_TREE,
1344                 tree_cons (NULL_TREE,
1345                   build1 (ADDR_EXPR,
1346                     build_chill_pointer_type (chill_integer_type_node),
1347                           tasking_code),
1348                       tree_cons (NULL_TREE, datalen,
1349                         tree_cons (NULL_TREE, dataptr, NULL_TREE))));
1350
1351       decl = decl_temp1 (tasking_message_var,
1352                          TREE_TYPE (tasking_message_type), 0,
1353                          tuple, 0, 0);
1354       /* prevent granting of this type */
1355       DECL_SOURCE_LINE (decl) = 0;
1356
1357       tuple = force_addr_of (decl);
1358       return tuple;
1359     }
1360   }
1361 }
1362 \f
1363 void
1364 expand_send_signal (sigmsgbuffer, optroutinginfo, optsendto,
1365                    optpriority, signame)
1366      tree sigmsgbuffer;
1367      tree optroutinginfo;
1368      tree optsendto;
1369      tree optpriority;
1370      tree signame;
1371 {
1372   tree routing_size, routing_addr;
1373   tree filename, linenumber;
1374   tree sigdest = IDENTIFIER_SIGNAL_DEST (signame);
1375
1376   /* check the presence of priority */
1377   if (optpriority == NULL_TREE)
1378     {
1379       if (send_signal_prio == NULL_TREE)
1380         {
1381           /* issue a warning in case of -Wall */
1382           if (extra_warnings)
1383             {
1384               warning ("Signal sent without priority");
1385               warning (" and no default priority was set.");
1386               warning (" PRIORITY defaulted to 0");
1387             }
1388           optpriority = integer_zero_node;
1389         }
1390       else
1391         optpriority = send_signal_prio;
1392     }
1393
1394   /* check the presence of a destination.
1395      optdest either may be an instance location
1396      or a process declaration */
1397   if (optsendto == NULL_TREE)
1398     {
1399       if (sigdest == NULL_TREE)
1400         {
1401           error ("SEND without a destination instance");
1402           error (" and no destination process specified");
1403           error (" for the signal");
1404           optsendto = convert (instance_type_node,
1405                                null_pointer_node);
1406         }
1407       else
1408         {
1409           /* build an instance [sigdest; -1] */
1410           tree process_name = DECL_NAME (sigdest);
1411           tree copy_number = fold (build (MINUS_EXPR, integer_type_node,
1412                                           integer_zero_node,
1413                                           integer_one_node));
1414           tree tasking_code = (tree)DECL_TASKING_CODE_DECL (
1415                                 lookup_name (process_name));
1416
1417           optsendto = build (CONSTRUCTOR, instance_type_node, NULL_TREE,
1418                         tree_cons (NULL_TREE, tasking_code,
1419                           tree_cons (NULL_TREE, copy_number, NULL_TREE)));
1420           /* as our system doesn't allow that and Z.200 specifies it,
1421              we issue a warning */
1422           warning ("SEND to ANY copy of process `%s'.", IDENTIFIER_POINTER (process_name));
1423         }
1424     }
1425   else if (! CH_IS_INSTANCE_MODE (TREE_TYPE (optsendto)))
1426     {
1427       error ("SEND TO must be an INSTANCE mode");
1428       optsendto = convert (instance_type_node, null_pointer_node);
1429     }
1430   else
1431     optsendto = check_non_null (convert (instance_type_node, optsendto));
1432
1433   /* check the routing stuff */
1434   if (optroutinginfo != NULL_TREE)
1435     {
1436       tree routing_name;
1437       tree decl;
1438
1439       if (TREE_TYPE (optroutinginfo) == NULL_TREE)
1440         {
1441           error ("SEND WITH must have a mode");
1442           optroutinginfo = integer_zero_node;
1443         }
1444       routing_name = get_unique_identifier ("RI");
1445       decl = decl_temp1 (routing_name,
1446                          TREE_TYPE (optroutinginfo), 0,
1447                          optroutinginfo, 0, 0);
1448       /* prevent granting of this type */
1449       DECL_SOURCE_LINE (decl) = 0;
1450
1451       routing_addr = force_addr_of (decl);
1452       routing_size = size_in_bytes (TREE_TYPE (decl));
1453     }
1454   else
1455     {
1456       routing_size = integer_zero_node;
1457       routing_addr = null_pointer_node;
1458     }
1459   /* get filename and linenumber */
1460   filename = force_addr_of (get_chill_filename ());
1461   linenumber = get_chill_linenumber ();
1462
1463   /* Now (at last!) we can call the runtime */
1464   expand_expr_stmt (
1465     build_chill_function_call (lookup_name (get_identifier ("__send_signal")),
1466       tree_cons (NULL_TREE, sigmsgbuffer,
1467         tree_cons (NULL_TREE, optsendto,
1468           tree_cons (NULL_TREE, optpriority,
1469             tree_cons (NULL_TREE, routing_size,
1470               tree_cons (NULL_TREE, routing_addr,
1471                 tree_cons (NULL_TREE, filename,
1472                   tree_cons (NULL_TREE, linenumber, NULL_TREE)))))))));
1473 }
1474 \f
1475 #if 0
1476  * The following code builds a RECEIVE CASE action, which actually
1477  * has 2 different functionalities:
1478  *
1479  * 1) RECEIVE signal CASE action
1480  *   which looks like this:
1481  *
1482  *    SIGNAL advance;
1483  *    SIGNAL terminate = (CHAR);
1484  *    SIGNAL sig1 = (CHAR);
1485  *
1486  *    DCL user, system INSTANCE;
1487  *    DCL count INT, char_code CHAR;
1488  *    DCL instance_loc INSTANCE;
1489  *
1490  *    workloop:
1491  *      RECEIVE CASE SET instance_loc;
1492  *        (advance):
1493  *           count + := 1;
1494  *        (terminate IN char_code):
1495  *           SEND sig1(char_code) TO system;
1496  *           EXIT workloop;
1497  *      ELSE
1498  *        STOP;
1499  *      ESAC;
1500  *
1501  * Because we don''t know until we get to the ESAC how
1502  * many signals need processing, we generate the following
1503  * C-equivalent code:
1504  *
1505  * /* define the codes for the signals */
1506  * static short __tmp_advance_code;
1507  * static short __tmp_terminate_code;
1508  * static short __tmp_sig1_code;
1509  *
1510  * /* define the types of the signals */
1511  * typedef struct
1512  *  {
1513  *     char fld0;
1514  *  } __tmp_terminate_struct;
1515  *
1516  * typedef struct
1517  *  {
1518  *     char fld0;
1519  *  } __tmp_sig1_struct;
1520  *
1521  * static INSTANCE user, system, instance_loc;
1522  * static short count;
1523  * static char char_code;
1524  *
1525  * {               /* start a new symbol context */
1526  *   int    number_of_sigs;
1527  *   short *sig_code [];
1528  *   void  *sigdatabuf;
1529  *   int    sigdatalen;
1530  *   short  sigcode;
1531  *
1532  *   goto __rcsetup;
1533  *
1534  *  __rcdoit: ;
1535  *   int timedout = __wait_signal (&sigcode
1536  *                                 number_of_sigs,
1537  *                                 sig_code,
1538  *                                 sigdatabuf,
1539  *                                 sigdatalen,
1540  *                                 &instance_loc);
1541  *   if (sigcode == __tmp_advance_code)
1542  *     {
1543  *       /* code for advance alternative's action_statement_list */
1544  *       count++;
1545  *     }
1546  *   else if (sigcode == __tmp_terminate_code)
1547  *     {
1548  *        /* copy signal's data to where they belong,
1549  *           with range-check, if enabled */
1550  *        char_code = ((__tmp_terminate_struct *)sigdatabuf)->fld0;
1551  *
1552  *       /* code for terminate alternative's action_statement_list */
1553  *        __send_signal (sig1 ..... );
1554  *        goto __workloop_end;
1555  *     }
1556  *   else
1557  *     {
1558  *        /* code here for the ELSE action_statement_list */
1559  *        __stop_process ();
1560  *     }
1561  *   goto __rc_done;
1562  *
1563  * __rcsetup:
1564  *   union { __tmp_terminate_struct terminate;
1565  *           __tmp_sig1_struct } databuf;
1566  *   short *sig_code_ptr [2] = { &__tmp_advance_code,
1567  *                               &__tmp_terminate_code };
1568  *   sigdatabuf = &databuf;
1569  *   sigdatalen = sizeof (databuf);
1570  *   sig_code = &sig_code_ptr[0];
1571  *   number_of_sigs = 2;
1572  *   goto __rcdoit;
1573  *
1574  * __rc_done: ;
1575  * }               /* end the new symbol context */
1576  * __workloop_end: ;
1577  *
1578  *
1579  * 2) RECEIVE buffer CASE action:
1580  *   which looks like this:
1581  *
1582  *    NEWMODE m_s = STRUCT (mini INT, maxi INT);
1583  *    DCL b1 BUFFER INT;
1584  *    DCL b2 BUFFER (30) s;
1585  *
1586  *    DCL i INT, s m_s, ins INSTANCE;
1587  *    DCL count INT;
1588  *
1589  *    workloop:
1590  *      RECEIVE CASE SET ins;
1591  *        (b1 IN i):
1592  *          count +:= i;
1593  *        (b2 in s):
1594  *          IF count < s.mini OR count > s.maxi THEN
1595  *            EXIT workloop;
1596  *          FI;
1597  *        ELSE
1598  *          STOP;
1599  *      ESAC;
1600  *
1601  * Because we don''t know until we get to the ESAC how
1602  * many buffers need processing, we generate the following
1603  * C-equivalent code:
1604  *
1605  * typedef struct
1606  * {
1607  *    short mini;
1608  *    short maxi;
1609  * } m_s;
1610  *
1611  * static void *b1;
1612  * static void *b2;
1613  * static short i;
1614  * static m_s s;
1615  * static INSTANCE ins;
1616  * static short count;
1617  *
1618  * workloop:
1619  * {                     /* start a new symbol context */
1620  *   int     number_of_sigs;
1621  *   void   *sig_code [];
1622  *   void   *sigdatabuf;
1623  *   int     sigdatalen;
1624  *   void   *buflocation;
1625  *   int     timedout;
1626  *
1627  *   goto __rcsetup;
1628  *
1629  *  __rcdoit:
1630  *   timedout = __wait_buffer (&buflocation,
1631  *                             number_of_sigs,
1632  *                             sig_code,
1633  *                             sigdatabuf,
1634  *                             sigdatalen,
1635  *                             &ins, ...);
1636  *   if (buflocation == &b1)
1637  *     {
1638  *       i = ((short *)sigdatabuf)->fld0;
1639  *       count += i;
1640  *     }
1641  *   else if (buflocation == &b2)
1642  *     {
1643  *       s = ((m_s)*sigdatabuf)->fld1;
1644  *       if (count < s.mini || count > s.maxi)
1645  *         goto __workloop_end;
1646  *     }
1647  *   else
1648  *       __stop_process ();
1649  *   goto __rc_done;
1650  *
1651  *  __rcsetup:
1652  *   typedef struct
1653  *   {
1654  *      void      *p;
1655  *      unsigned   maxqueuesize;
1656  *   } Buffer_Descr;
1657  *   union { short    b1,
1658  *           m_s      b2 } databuf;
1659  *   Buffer_Descr bufptr [2] =
1660  *       {
1661  *         { &b1, -1 },
1662  *         { &b2, 30 },
1663  *       };
1664  *   void * bufarray[2] = { &bufptr[0],
1665  *                          &bufptr[1] };
1666  *   sigdatabuf = &databuf;
1667  *   sigdatalen = sizeof (databuf);
1668  *   sig_code = &bufarray[0];
1669  *   number_of_sigs = 2;
1670  *   goto __rcdoit;
1671  *
1672  *  __rc_done;
1673  * }          /* end of symbol context */
1674  * __workloop_end:
1675  *
1676 #endif
1677 \f
1678 struct rc_state_type
1679 {
1680   struct rc_state_type *enclosing;
1681   rtx  rcdoit;
1682   rtx  rcsetup;
1683   tree n_sigs;
1684   tree sig_code;
1685   tree databufp;
1686   tree datalen;
1687   tree else_clause;
1688   tree received_signal;
1689   tree received_buffer;
1690   tree to_loc;
1691   int  sigseen;
1692   int  bufseen;
1693   tree actuallist;
1694   int  call_generated;
1695   int  if_generated;
1696   int  bufcnt;
1697 };
1698
1699 struct rc_state_type *current_rc_state = NULL;
1700
1701 /*
1702  * this function tells if there is an if to terminate
1703  * or not
1704  */
1705 int
1706 build_receive_case_if_generated()
1707 {
1708   if (!current_rc_state)
1709     {
1710       error ("internal error: RECEIVE CASE stack invalid.");
1711       abort ();
1712     }
1713   return current_rc_state->if_generated;
1714 }
1715
1716 /* build_receive_case_start returns an INTEGER_CST node
1717    containing the case-label number to be used by
1718    build_receive_case_end to generate correct labels */
1719 tree
1720 build_receive_case_start (optset)
1721      tree optset;
1722 {
1723   /* counter to generate unique receive_case labels */
1724   static int rc_lbl_count = 0;
1725   tree current_label_value =
1726     build_int_2 ((HOST_WIDE_INT)rc_lbl_count, 0);
1727   tree sigcodename, filename, linenumber;
1728
1729   struct rc_state_type *rc_state
1730     = (struct rc_state_type*) xmalloc (sizeof (struct rc_state_type));
1731   rc_state->rcdoit = gen_label_rtx ();
1732   rc_state->rcsetup = gen_label_rtx ();
1733   rc_state->enclosing = current_rc_state;
1734   current_rc_state = rc_state;
1735   rc_state->sigseen = 0;
1736   rc_state->bufseen = 0;
1737   rc_state->call_generated = 0;
1738   rc_state->if_generated = 0;
1739   rc_state->bufcnt = 0;
1740
1741   rc_lbl_count++;
1742   if (optset == NULL_TREE || TREE_CODE (optset) == ERROR_MARK)
1743     optset = null_pointer_node;
1744   else
1745     {
1746       if (CH_IS_INSTANCE_MODE (TREE_TYPE (optset)) && CH_LOCATION_P (optset))
1747         optset = force_addr_of (optset);
1748       else
1749         {
1750           error ("SET requires INSTANCE location");
1751           optset = null_pointer_node;
1752         }
1753     }
1754
1755   rc_state->to_loc = build_timeout_preface ();
1756
1757   rc_state->n_sigs =
1758     decl_temp1 (get_identifier ("number_of_sigs"),
1759                 integer_type_node, 0, integer_zero_node, 0, 0);
1760
1761   rc_state->sig_code =
1762     decl_temp1 (get_identifier ("sig_codep"),
1763                 ptr_type_node, 0, null_pointer_node, 0, 0);
1764
1765   rc_state->databufp =
1766     decl_temp1 (get_identifier ("databufp"),
1767                 ptr_type_node, 0, null_pointer_node, 0, 0);
1768
1769   rc_state->datalen =
1770     decl_temp1 (get_identifier ("datalen"),
1771                 integer_type_node, 0, integer_zero_node, 0, 0);
1772
1773   rc_state->else_clause =
1774     decl_temp1 (get_identifier ("else_clause"),
1775                 integer_type_node, 0, integer_zero_node, 0, 0);
1776
1777   /* wait_signal will store the signal number in here */
1778   sigcodename = get_identifier ("received_signal");
1779   rc_state->received_signal =
1780     decl_temp1 (sigcodename, chill_integer_type_node, 0,
1781                 NULL_TREE, 0, 0);
1782
1783   /* wait_buffer will store the buffer address in here */
1784   sigcodename = get_unique_identifier ("received_buffer");
1785   rc_state->received_buffer =
1786     decl_temp1 (sigcodename, ptr_type_node, 0,
1787                 NULL_TREE, 0, 0);
1788
1789   /* now jump to the end of RECEIVE CASE actions, to
1790      set up variables for them. */
1791   emit_jump (rc_state->rcsetup);
1792
1793   /* define the __rcdoit label. We come here after
1794      initialization of all variables, to execute the
1795      actions. */
1796   emit_label (rc_state->rcdoit);
1797
1798   filename = force_addr_of (get_chill_filename ());
1799   linenumber = get_chill_linenumber ();
1800
1801   /* Argument list for calling the runtime routine.  We'll call it
1802      the first time we call build_receive_case_label, when we know
1803      whether to call wait_signal or wait_buffer. NOTE: at this time
1804      the first argument will be set. */
1805   rc_state->actuallist =
1806     tree_cons (NULL_TREE, NULL_TREE,
1807       tree_cons (NULL_TREE, rc_state->n_sigs,
1808         tree_cons (NULL_TREE, rc_state->sig_code,
1809           tree_cons (NULL_TREE, rc_state->databufp,
1810             tree_cons (NULL_TREE, rc_state->datalen,
1811               tree_cons (NULL_TREE, optset,
1812                 tree_cons (NULL_TREE, rc_state->else_clause,
1813                   tree_cons (NULL_TREE, rc_state->to_loc,
1814                     tree_cons (NULL_TREE, filename,
1815                       tree_cons (NULL_TREE, linenumber, NULL_TREE))))))))));
1816   return current_label_value;
1817 }
1818 \f
1819 static tree
1820 build_receive_signal_case_label (sigdecl, loclist)
1821      tree sigdecl, loclist;
1822 {
1823   struct rc_state_type *rc_state = current_rc_state;
1824   tree signame = DECL_NAME (sigdecl);
1825   tree expr;
1826
1827   if (rc_state->bufseen != 0)
1828     {
1829       error ("SIGNAL in RECEIVE CASE alternative follows");
1830       error (" a BUFFER name on line %d", rc_state->bufseen);
1831       return error_mark_node;
1832     }
1833   rc_state->sigseen = lineno;
1834   rc_state->bufseen = 0;
1835
1836   if (!IDENTIFIER_SIGNAL_DATA (signame) && loclist != NULL_TREE)
1837     {
1838       error ("SIGNAL `%s' has no data fields", IDENTIFIER_POINTER (signame));
1839       return error_mark_node;
1840     }
1841   if (IDENTIFIER_SIGNAL_DATA (signame) && loclist == NULL_TREE)
1842     {
1843       error ("SIGNAL `%s' requires data fields", IDENTIFIER_POINTER (signame));
1844       return error_mark_node;
1845     }
1846
1847   if (!rc_state->call_generated)
1848     {
1849       tree wait_call;
1850
1851       TREE_VALUE (rc_state->actuallist) = force_addr_of (rc_state->received_signal);
1852       wait_call = build_chill_function_call (lookup_name
1853                     (get_identifier ("__wait_signal_timed")),
1854                        rc_state->actuallist);
1855 #if 0
1856       chill_expand_assignment (rc_state->received_signal,
1857                                NOP_EXPR, wait_call);
1858 #endif
1859       build_timesupervised_call (wait_call, rc_state->to_loc);
1860
1861       rc_state->call_generated = 1;
1862     }
1863
1864   /* build the conditional expression */
1865   expr = build (EQ_EXPR, boolean_type_node,
1866                 rc_state->received_signal,
1867                 (tree)DECL_TASKING_CODE_DECL (sigdecl));
1868
1869   if (!rc_state->if_generated)
1870     {
1871       expand_start_cond (expr, 0);
1872       rc_state->if_generated = 1;
1873     }
1874   else
1875     expand_start_elseif (expr);
1876
1877   if (IDENTIFIER_SIGNAL_DATA (signame))
1878     {
1879       /* copy data from signal buffer to user's variables */
1880       tree typelist = TYPE_FIELDS (TREE_TYPE (sigdecl));
1881       tree valtail, typetail;
1882       int  parmno = 1;
1883       tree pointer_type = build_chill_pointer_type (TREE_TYPE (sigdecl));
1884       tree pointer = convert (pointer_type, rc_state->databufp);
1885
1886       for (valtail = nreverse (loclist), typetail = typelist;
1887            valtail != NULL_TREE && typetail != NULL_TREE;
1888            parmno++, valtail = TREE_CHAIN (valtail),
1889            typetail = TREE_CHAIN (typetail))
1890         {
1891           register tree actual  = valtail  ? TREE_VALUE (valtail)  : 0;
1892           register tree type    = typetail ? TREE_TYPE (typetail) : 0;
1893           register tree assgn;
1894           char place[30];
1895           sprintf (place, "signal field %d", parmno);
1896
1897           assgn = build_component_ref (build1 (INDIRECT_REF,
1898                                                TREE_TYPE (sigdecl),
1899                                                pointer),
1900                                        DECL_NAME (typetail));
1901           if (!CH_TYPE_NONVALUE_P (type))
1902             /* don't assign to non-value type. Error printed at signal definition */
1903             chill_expand_assignment (actual, NOP_EXPR, assgn);
1904         }
1905
1906       if (valtail == NULL_TREE && typetail != NULL_TREE)
1907         error ("too few data fields provided for `%s'",
1908                IDENTIFIER_POINTER (signame));
1909       if (valtail != NULL_TREE && typetail == NULL_TREE)
1910         error ("too many data fields provided for `%s'",
1911                IDENTIFIER_POINTER (signame));
1912     }
1913
1914   /* last action here */
1915   emit_line_note (input_filename, lineno);
1916
1917   return build_tree_list (loclist, signame);
1918 }
1919
1920 static tree
1921 build_receive_buffer_case_label (buffer, loclist)
1922      tree buffer, loclist;
1923 {
1924   struct rc_state_type *rc_state = current_rc_state;
1925   tree buftype = buffer_element_mode (TREE_TYPE (buffer));
1926   tree expr, var;
1927   tree pointer_type, pointer, assgn;
1928   int  had_errors = 0;
1929   tree x, y, z, bufaddr;
1930
1931   if (rc_state->sigseen != 0)
1932     {
1933       error ("BUFFER in RECEIVE CASE alternative follows");
1934       error (" a SIGNAL name on line %d", rc_state->sigseen);
1935       return error_mark_node;
1936     }
1937   rc_state->bufseen = lineno;
1938   rc_state->sigseen = 0;
1939
1940   if (! CH_REFERABLE (buffer))
1941     {
1942       error ("BUFFER in RECEIVE CASE alternative must be a location.");
1943       return error_mark_node;
1944     }
1945
1946   if (TREE_CHAIN (loclist) != NULL_TREE)
1947     {
1948       error ("buffer receive alternative requires only 1 defining occurence.");
1949       return error_mark_node;
1950     }
1951
1952   if (!rc_state->call_generated)
1953     {
1954       tree wait_call;
1955
1956       /* here we change the mode of rc_state->sig_code to
1957          REF ARRAY (0:65535) REF __tmp_DESCR_type.
1958          This is neccesary, cause we cannot evaluate the buffer twice
1959          (once here where we compare against the address of the buffer
1960          and second in build_receive_buffer_case_end, where we use the
1961          address build the descriptor, which gets passed to __wait_buffer).
1962          So we change the comparison from
1963          if (rc_state->received_buffer == &buffer)
1964          to
1965          if (rc_state->received_buffer ==
1966          rc_state->sig_codep->[rc_state->bufcnt]->datap).
1967
1968          This will evaluate the buffer location only once
1969          (in build_receive_buffer_case_end) and therefore doesn't confuse
1970          our machinery. */
1971
1972       tree reftmpdescr = build_chill_pointer_type (
1973                             TREE_TYPE (lookup_name (
1974                                 get_identifier ("__tmp_DESCR_type"))));
1975       tree idxtype = build_chill_range_type (NULL_TREE,
1976                         integer_zero_node,
1977                            build_int_2 (65535, 0)); /* should be enough, probably use ULONG */
1978       tree arrtype = build_chill_array_type (reftmpdescr,
1979                         tree_cons (NULL_TREE, idxtype, NULL_TREE),
1980                            0, NULL_TREE);
1981       tree refarrtype = build_chill_pointer_type (arrtype);
1982
1983       TREE_VALUE (rc_state->actuallist) = force_addr_of (rc_state->received_buffer);
1984       wait_call = build_chill_function_call (
1985                     lookup_name (get_identifier ("__wait_buffer")),
1986                       rc_state->actuallist);
1987 #if 0
1988       chill_expand_assignment (rc_state->received_buffer,
1989                                  NOP_EXPR, wait_call);
1990 #endif
1991       build_timesupervised_call (wait_call, rc_state->to_loc);
1992
1993       /* do this after the call, otherwise there will be a mode mismatch */
1994       TREE_TYPE (rc_state->sig_code) = refarrtype;
1995
1996       /* now we are ready to generate the call */
1997       rc_state->call_generated = 1;
1998     }
1999
2000   x = build_chill_indirect_ref (rc_state->sig_code, NULL_TREE, 0);
2001   y = build_chill_array_ref (x,
2002         tree_cons (NULL_TREE, build_int_2 (rc_state->bufcnt, 0), NULL_TREE));
2003   z = build_chill_indirect_ref (y, NULL_TREE, 0);
2004   bufaddr = build_chill_component_ref (z, get_identifier ("datap"));
2005
2006   /* build the conditional expression */
2007   expr = build (EQ_EXPR, boolean_type_node,
2008                 rc_state->received_buffer,
2009                 bufaddr);
2010
2011   /* next buffer in list */
2012   rc_state->bufcnt++;
2013
2014   if (!rc_state->if_generated)
2015     {
2016       expand_start_cond (expr, 0);
2017       rc_state->if_generated = 1;
2018     }
2019   else
2020     expand_start_elseif (expr);
2021
2022   /* copy buffer's data to destination */
2023   var = TREE_VALUE (loclist);
2024
2025   if (buftype != NULL_TREE && TREE_CODE (buftype) == ERROR_MARK)
2026     had_errors = 1;
2027   else if (! CH_COMPATIBLE (var, buftype))
2028     {
2029       error ("incompatible modes in receive buffer alternative.");
2030       had_errors = 1;
2031     }
2032
2033   if (! CH_LOCATION_P (var))
2034     {
2035       error ("defining occurence in receive buffer alternative must be a location.");
2036       had_errors = 1;
2037     }
2038
2039   if (! had_errors)
2040     {
2041       pointer_type = build_chill_pointer_type (TREE_TYPE (var));
2042       pointer = convert (pointer_type,
2043                          rc_state->databufp);
2044       /* no need to check this pointer being NULL */
2045       assgn = build_chill_indirect_ref (pointer, NULL_TREE, 0);
2046
2047       chill_expand_assignment (var, NOP_EXPR, assgn);
2048     }
2049
2050   /* last action here */
2051   emit_line_note (input_filename, lineno);
2052
2053   return build_tree_list (loclist, buffer);
2054 }
2055 /*
2056  *  SIGNAME is the signal name or buffer location,
2057  *  LOCLIST is a list of possible locations to store data in
2058  */
2059 tree
2060 build_receive_case_label (signame, loclist)
2061      tree signame, loclist;
2062 {
2063   /* now see what we have got and do some checks */
2064   if (TREE_CODE (signame) == TYPE_DECL && CH_DECL_SIGNAL (signame))
2065     return build_receive_signal_case_label (signame, loclist);
2066
2067   if (TREE_TYPE (signame) != NULL_TREE
2068       && CH_IS_BUFFER_MODE (TREE_TYPE (signame)))
2069     {
2070       if (loclist == NULL_TREE)
2071         {
2072           error ("buffer receive alternative without `IN location'.");
2073           return error_mark_node;
2074         }
2075       return build_receive_buffer_case_label (signame, loclist);
2076     }
2077
2078   error ("RECEIVE CASE alternative must specify a SIGNAL name or BUFFER location.");
2079   return error_mark_node;
2080 }
2081 \f
2082 /*
2083  * LABEL_CNT is the case-label counter passed from build_receive_case_start.
2084  * ELSE_CLAUSE defines if the RECEIVE CASE action had an ELSE(1) or not(0).
2085  * BUF_LIST is a tree-list of tree-lists, where TREE_VALUE defines the
2086  * BUFFER location and TREE_PURPOSE defines the defining occurence.
2087  */
2088 static void
2089 build_receive_buffer_case_end (buf_list, else_clause)
2090      tree buf_list, else_clause;
2091 {
2092   struct rc_state_type *rc_state = current_rc_state;
2093   tree alist;
2094   tree field_decls = NULL_TREE; /* list of all buffer types, for the union */
2095   int  buffer_cnt = 0;
2096   tree descr_type = lookup_name (get_identifier ("__tmp_DESCR_type"));
2097   tree tuple = NULL_TREE;       /* constructors for array of ptrs */
2098   tree union_type_node = NULL_TREE;
2099
2100   /* walk thru all the buffers */
2101   for (alist = buf_list; alist != NULL_TREE;
2102        buffer_cnt++, alist = TREE_CHAIN (alist))
2103     {
2104       tree value      = TREE_VALUE (alist);
2105       tree buffer     = TREE_VALUE (value);                 /* this is the buffer */
2106       tree data       = TREE_VALUE (TREE_PURPOSE (value));  /* the location to receive in */
2107       tree buffer_descr;
2108       tree buffer_descr_init;
2109       tree buffer_length;
2110       tree field;
2111       char fldname[20];
2112
2113       /* build descriptor for buffer */
2114       buffer_length = max_queue_size (TREE_TYPE (buffer));
2115       if (buffer_length == NULL_TREE)
2116         buffer_length = infinite_buffer_event_length_node;
2117       buffer_descr_init = build_nt (CONSTRUCTOR, NULL_TREE,
2118                             tree_cons (NULL_TREE, force_addr_of (buffer),
2119                               tree_cons (NULL_TREE, buffer_length, NULL_TREE)));
2120       buffer_descr = decl_temp1 (get_unique_identifier ("RCbuffer"),
2121                                  TREE_TYPE (descr_type), 0,
2122                                  buffer_descr_init, 0, 0);
2123       tuple = tree_cons (NULL_TREE,
2124                          force_addr_of (buffer_descr),
2125                          tuple);
2126
2127       /* make a field for the union */
2128       sprintf (fldname, "fld%03d", buffer_cnt);
2129       field = grok_chill_fixedfields (
2130                  tree_cons (NULL_TREE, get_identifier (fldname), NULL_TREE),
2131                    TREE_TYPE (data), NULL_TREE);
2132       if (field_decls == NULL_TREE)
2133         field_decls = field;
2134       else
2135         chainon (field_decls, field);
2136     }
2137
2138   /* generate the union */
2139   if (field_decls != NULL_TREE)
2140     {
2141       tree data_id = get_identifier ("databuffer");
2142       tree data_decl;
2143
2144       union_type_node = finish_struct (
2145                           start_struct (UNION_TYPE, NULL_TREE),
2146                             field_decls);
2147       data_decl = decl_temp1 (data_id, union_type_node, 0, NULL_TREE, 0, 0);
2148
2149       chill_expand_assignment (rc_state->databufp, NOP_EXPR,
2150                                force_addr_of (data_decl));
2151
2152       chill_expand_assignment (rc_state->datalen, NOP_EXPR,
2153                                size_in_bytes (TREE_TYPE (data_decl)));
2154     }
2155
2156   /* tell runtime system if we had an else or not */
2157   chill_expand_assignment (rc_state->else_clause, NOP_EXPR, else_clause);
2158
2159   /* generate the array of pointers to all buffers */
2160   {
2161     tree array_id = get_identifier ("buf_ptr_array");
2162     tree array_type_node =
2163            build_chill_array_type (ptr_type_node,
2164              tree_cons (NULL_TREE,
2165                build_chill_range_type (NULL_TREE,
2166                                        integer_one_node,
2167                                        build_int_2 (buffer_cnt, 0)),
2168                         NULL_TREE),
2169                           0, NULL_TREE);
2170     tree constr = build_nt (CONSTRUCTOR, NULL_TREE, nreverse (tuple));
2171     tree array_decl = decl_temp1 (array_id, array_type_node, 0,
2172                                   constr, 0, 0);
2173
2174     chill_expand_assignment (build_chill_cast (ptr_type_node, rc_state->sig_code),
2175                              NOP_EXPR,
2176                              force_addr_of (array_decl));
2177     chill_expand_assignment (rc_state->n_sigs, NOP_EXPR,
2178                              build_int_2 (buffer_cnt, 0));
2179   }
2180 }
2181
2182 /*
2183  * SIG_LIST is a tree list.  The TREE_VALUEs are VAR_DECLs of
2184  * __tmp_%s_code variables, and the TREE_PURPOSEs are the
2185  * TYPE_DECLs of the __tmp_%s_struct types.  LABEL_CNT is the
2186  * case-label counter passed from build_receive_case_start.
2187  */
2188 static void
2189 build_receive_signal_case_end (sig_list, else_clause)
2190      tree sig_list, else_clause;
2191 {
2192   struct rc_state_type *rc_state = current_rc_state;
2193   tree alist, temp1;
2194   tree union_type_node = NULL_TREE;
2195   tree field_decls = NULL_TREE;  /* list of signal
2196                                    structure, for the union */
2197   tree tuple = NULL_TREE;    /* constructor for array of ptrs */
2198   int  signal_cnt = 0;
2199   int  fldcnt = 0;
2200
2201   /* for each list of locations, validate it against the
2202      corresponding signal's list of fields. */
2203   {
2204     for (alist = sig_list; alist != NULL_TREE;
2205          signal_cnt++, alist = TREE_CHAIN (alist))
2206       {
2207         tree value    = TREE_VALUE (alist);
2208         tree signame  = TREE_VALUE (value);  /* signal's ID node */
2209         tree sigdecl  = lookup_name (signame);
2210         tree sigtype  = TREE_TYPE (sigdecl);
2211         tree field;
2212         char fldname[20];
2213
2214         if (IDENTIFIER_SIGNAL_DATA (signame))
2215           {
2216             sprintf (fldname, "fld%03d", fldcnt++);
2217             field = grok_chill_fixedfields (
2218                       tree_cons (NULL_TREE,
2219                                  get_identifier (fldname),
2220                                  NULL_TREE),
2221                         sigtype, NULL_TREE);
2222             if (field_decls == NULL_TREE)
2223               field_decls = field;
2224             else
2225               chainon (field_decls, field);
2226
2227           }
2228
2229         temp1 = (tree)DECL_TASKING_CODE_DECL (sigdecl);
2230         mark_addressable (temp1);
2231         tuple = tree_cons (NULL_TREE,
2232                   build1 (ADDR_EXPR,
2233                     build_chill_pointer_type (chill_integer_type_node),
2234                           temp1),
2235                     tuple);
2236       }
2237   }
2238
2239   /* generate the union of all of the signal data types */
2240   if (field_decls != NULL_TREE)
2241     {
2242       tree data_id = get_identifier ("databuffer");
2243       tree data_decl;
2244       union_type_node = finish_struct (start_struct (UNION_TYPE,
2245                                                NULL_TREE),
2246                                  field_decls);
2247       data_decl =
2248         decl_temp1 (data_id, union_type_node, 0, NULL_TREE, 0, 0);
2249
2250       chill_expand_assignment (rc_state->databufp, NOP_EXPR,
2251                                force_addr_of (data_decl));
2252
2253       chill_expand_assignment (rc_state->datalen, NOP_EXPR,
2254                                size_in_bytes (TREE_TYPE (data_decl)));
2255     }
2256
2257   /* tell runtime system if we had an else or not */
2258   chill_expand_assignment (rc_state->else_clause, NOP_EXPR, else_clause);
2259
2260   /* generate the array of all signal codes */
2261   {
2262     tree array_id = get_identifier ("sig_code_array");
2263     tree array_type_node
2264       = build_chill_array_type (
2265           build_chill_pointer_type (chill_integer_type_node),
2266             tree_cons (NULL_TREE,
2267               build_chill_range_type (NULL_TREE,
2268                                       integer_one_node,
2269                                       build_int_2 (signal_cnt, 0)),
2270                        NULL_TREE),
2271          0, NULL_TREE);
2272     tree constr = build_nt (CONSTRUCTOR, NULL_TREE,
2273                             nreverse (tuple));
2274     tree array_decl =
2275       decl_temp1 (array_id, array_type_node, 0, constr, 0, 0);
2276
2277     chill_expand_assignment (rc_state->sig_code, NOP_EXPR,
2278                              force_addr_of (array_decl));
2279
2280     /* give number of signals to runtime system */
2281     chill_expand_assignment (rc_state->n_sigs, NOP_EXPR,
2282                              build_int_2 (signal_cnt, 0));
2283   }
2284 }
2285
2286 /* General function for the end of a RECEIVE CASE action */
2287
2288 void
2289 build_receive_case_end (alist, else_clause)
2290      tree alist, else_clause;
2291 {
2292   rtx rcdone = gen_label_rtx ();
2293   struct rc_state_type *rc_state = current_rc_state;
2294   tree tmp;
2295   int had_errors = 0;
2296
2297   /* finish the if's, if generated */
2298   if (rc_state->if_generated)
2299     expand_end_cond ();
2300
2301   /* check alist for errors */
2302   for (tmp = alist; tmp != NULL_TREE; tmp = TREE_CHAIN (tmp))
2303     {
2304       if (TREE_CODE (TREE_VALUE (tmp)) == ERROR_MARK)
2305         had_errors++;
2306     }
2307
2308   /* jump to the end of RECEIVE CASE processing */
2309   emit_jump (rcdone);
2310
2311   /* define the __rcsetup label. We come here to initialize
2312      all variables */
2313   emit_label (rc_state->rcsetup);
2314
2315   if (alist == NULL_TREE && !had_errors)
2316     {
2317       error ("RECEIVE CASE without alternatives");
2318       goto gen_rcdoit;
2319     }
2320
2321   if (TREE_CODE (alist) == ERROR_MARK || had_errors)
2322     goto gen_rcdoit;
2323
2324   /* now call the actual end function */
2325   if (rc_state->bufseen)
2326     build_receive_buffer_case_end (alist, else_clause);
2327   else
2328     build_receive_signal_case_end (alist, else_clause);
2329
2330   /* now jump to the beginning of RECEIVE CASE processing */
2331 gen_rcdoit: ;
2332   emit_jump (rc_state->rcdoit);
2333
2334   /* define the __rcdone label. We come here when the whole
2335      receive case is done. */
2336   emit_label (rcdone);
2337
2338   current_rc_state = rc_state->enclosing;
2339   free(rc_state);
2340 }
2341 \f
2342 /* build a CONTINUE action */
2343
2344 void expand_continue_event (evloc)
2345      tree evloc;
2346 {
2347   tree filename, linenumber, evaddr;
2348
2349   /* do some checks */
2350   if (evloc == NULL_TREE || TREE_CODE (evloc) == ERROR_MARK)
2351     return;
2352
2353   if (! CH_REFERABLE (evloc) || ! CH_IS_EVENT_MODE (TREE_TYPE (evloc)))
2354     {
2355       error ("CONTINUE requires an event location.");
2356       return;
2357     }
2358
2359   evaddr = force_addr_of (evloc);
2360   filename = force_addr_of (get_chill_filename ());
2361   linenumber = get_chill_linenumber ();
2362
2363   expand_expr_stmt (
2364     build_chill_function_call (lookup_name (get_identifier ("__continue")),
2365       tree_cons (NULL_TREE, evaddr,
2366         tree_cons (NULL_TREE, filename,
2367           tree_cons (NULL_TREE, linenumber, NULL_TREE)))));
2368 }
2369 \f
2370 #if 0
2371  * The following code builds a DELAY CASE statement,
2372  * which looks like this in CHILL:
2373  *
2374  *    DCL ev1, ev2 EVENT, ins INSTANCE;
2375  *    DCL ev3 EVENT (10);
2376  *    DCL count1 INT := 0, count2 INT := 0;
2377  *
2378  *    DELAY CASE SET ins;
2379  *      (ev1): count1 +:= 1;
2380  *      (ev2, ev3): count2 +:= 1;
2381  *    ESAC;
2382  *
2383  * Because we don''t know until we get to the ESAC how
2384  * many events need processing, we generate the following
2385  * C-equivalent code:
2386  *
2387  *
2388  * {               /* start a new symbol context */
2389  *   typedef struct
2390  *   {
2391  *      void           *p;
2392  *      unsigned long  len;
2393  *   } Descr;
2394  *   int     number_of_events;
2395  *   Descr  *event_codes;
2396  *
2397  *   goto __dlsetup;
2398  *
2399  *  __dldoit:
2400  *   void *whatevent = __delay_event (number_of_events,
2401  *                                    event_codes,
2402  *                                    priority,
2403  *                                    &instance_loc,
2404  *                                    filename,
2405  *                                    linenumber);
2406  *   if (whatevent == &ev1)
2407  *     {
2408  *       /* code for ev1 alternative's action_statement_list */
2409  *       count1 += 1;
2410  *     }
2411  *   else if (whatevent == &ev2 || whatevent == &ev3)
2412  *     {
2413  *       /* code for ev2 and ev3 alternative's action_statement_list */
2414  *       count2 += 1;
2415  *     }
2416  *   goto __dl_done;
2417  *
2418  * __dlsetup:
2419  *   Descr event_code_ptr [3] = {
2420  *              { &ev1, -1 },
2421  *              { &ev2, -1 },
2422  *              { &ev3, 10 } };
2423  *   event_codes = &event_code_ptr[0];
2424  *   number_of_events = 3;
2425  *   goto __dldoit;
2426  *
2427  * __dl_done:
2428  *   ;
2429  * }               /* end the new symbol context */
2430  *
2431 #endif
2432 \f
2433 struct dl_state_type
2434 {
2435   struct dl_state_type *enclosing;
2436   rtx  dldoit;
2437   rtx  dlsetup;
2438   tree n_events;
2439   tree event_codes;
2440   tree received_event;
2441 };
2442
2443 struct dl_state_type *current_dl_state = NULL;
2444
2445 /* build_receive_case_start returns an INTEGER_CST node
2446    containing the case-label number to be used by
2447    build_receive_case_end to generate correct labels */
2448 tree
2449 build_delay_case_start (optset, optpriority)
2450      tree optset, optpriority;
2451 {
2452   /* counter to generate unique delay case labels */
2453   static int dl_lbl_count = 0;
2454   tree current_label_value =
2455     build_int_2 ((HOST_WIDE_INT)dl_lbl_count, 0);
2456   tree wait_call;
2457   tree actuallist = NULL_TREE;
2458   tree filename, linenumber;
2459   tree to_loc;
2460
2461   struct dl_state_type *dl_state
2462     = (struct dl_state_type*) xmalloc (sizeof (struct dl_state_type));
2463   dl_state->enclosing = current_dl_state;
2464   current_dl_state = dl_state;
2465   dl_state->dldoit = gen_label_rtx ();
2466   dl_state->dlsetup = gen_label_rtx ();
2467
2468   dl_lbl_count++;
2469
2470   /* check the optional SET location */
2471   if (optset == NULL_TREE
2472       || TREE_CODE (optset) == ERROR_MARK)
2473     optset = null_pointer_node;
2474   else if (CH_IS_INSTANCE_MODE (TREE_TYPE (optset)) && CH_LOCATION_P (optset))
2475     optset = force_addr_of (optset);
2476   else
2477     {
2478       error ("SET requires INSTANCE location");
2479       optset = null_pointer_node;
2480     }
2481
2482   /* check the presence of the PRIORITY expression */
2483   if (optpriority == NULL_TREE)
2484     optpriority = integer_zero_node;
2485   else if (TREE_CODE (optpriority) == ERROR_MARK)
2486     optpriority = integer_zero_node;
2487   else if (TREE_CODE (TREE_TYPE (optpriority)) != INTEGER_TYPE)
2488     {
2489       error ("PRIORITY must be of integer type.");
2490       optpriority = integer_zero_node;
2491     }
2492
2493   /* check for time supervised */
2494   to_loc = build_timeout_preface ();
2495
2496   dl_state->n_events =
2497     decl_temp1 (get_identifier ("number_of_events"),
2498                 integer_type_node, 0, integer_zero_node, 0, 0);
2499
2500   dl_state->event_codes =
2501     decl_temp1 (get_identifier ("event_codes"),
2502                 ptr_type_node, 0, null_pointer_node, 0, 0);
2503
2504   /* wait_event will store the signal number in here */
2505   dl_state->received_event =
2506     decl_temp1 (get_identifier ("received_event"),
2507                 ptr_type_node, 0, NULL_TREE, 0, 0);
2508
2509   /* now jump to the end of RECEIVE CASE actions, to
2510      set up variables for them. */
2511   emit_jump (dl_state->dlsetup);
2512
2513   /* define the __rcdoit label. We come here after
2514      initialization of all variables, to execute the
2515      actions. */
2516   emit_label (dl_state->dldoit);
2517
2518   filename = force_addr_of (get_chill_filename ());
2519   linenumber = get_chill_linenumber ();
2520
2521   /* here we go, call the runtime routine */
2522   actuallist = tree_cons (NULL_TREE, force_addr_of (dl_state->received_event),
2523                  tree_cons (NULL_TREE, dl_state->n_events,
2524                    tree_cons (NULL_TREE, dl_state->event_codes,
2525                      tree_cons (NULL_TREE, optpriority,
2526                        tree_cons (NULL_TREE, to_loc,
2527                          tree_cons (NULL_TREE, optset,
2528                            tree_cons (NULL_TREE, filename,
2529                              tree_cons (NULL_TREE, linenumber, NULL_TREE))))))));
2530
2531   wait_call = build_chill_function_call (
2532                 lookup_name (get_identifier ("__delay_event")),
2533                                          actuallist);
2534
2535 #if 0
2536   chill_expand_assignment (dl_state->received_event, NOP_EXPR, wait_call);
2537 #endif
2538   build_timesupervised_call (wait_call, to_loc);
2539   return current_label_value;
2540 }
2541 \f
2542 /*
2543    EVENTLIST is the list of this alternative's events
2544    and IF_OR_ELSEIF indicates what action (1 for if and
2545    0 for else if) should be generated.
2546 */
2547 void
2548 build_delay_case_label (eventlist, if_or_elseif)
2549      tree eventlist;
2550      int  if_or_elseif;
2551 {
2552   tree eventp, expr = NULL_TREE;
2553
2554   if (eventlist == NULL_TREE || TREE_CODE (eventlist) == ERROR_MARK)
2555     return;
2556
2557   for (eventp = eventlist; eventp != NULL_TREE;
2558        eventp = TREE_CHAIN (eventp))
2559     {
2560       tree event = TREE_VALUE (eventp);
2561       tree temp1;
2562
2563       if (event == NULL_TREE || TREE_CODE (event) == ERROR_MARK)
2564         temp1 = null_pointer_node;
2565       else if (! CH_IS_EVENT_MODE (TREE_TYPE (event)) || ! CH_REFERABLE (event))
2566         {
2567           error ("delay alternative must be an EVENT location.");
2568           temp1 = null_pointer_node;
2569         }
2570       else
2571         temp1 = force_addr_of (event);
2572
2573       /* build the conditional expression */
2574       if (expr == NULL_TREE)
2575         expr = build (EQ_EXPR, boolean_type_node,
2576                       current_dl_state->received_event, temp1);
2577       else
2578         expr =
2579           build (TRUTH_ORIF_EXPR, boolean_type_node, expr,
2580                  build (EQ_EXPR, boolean_type_node,
2581                         current_dl_state->received_event, temp1));
2582     }
2583   if (if_or_elseif)
2584     expand_start_cond (expr, 0);
2585   else
2586     expand_start_elseif (expr);
2587
2588   /* last action here */
2589   emit_line_note (input_filename, lineno);
2590 }
2591 \f
2592 /*
2593  * EVENT_LIST is a tree list.  The TREE_VALUEs are VAR_DECLs of
2594  * EVENT variables.  LABEL_CNT is the case-label counter
2595  * passed from build_delay_case_start.
2596  */
2597 void
2598 build_delay_case_end (event_list)
2599      tree event_list;
2600 {
2601   struct dl_state_type *dl_state = current_dl_state;
2602   rtx    dldone          = gen_label_rtx ();
2603   tree tuple = NULL_TREE;    /* constructor for array of descrs */
2604   tree acode;
2605   int  event_cnt = 0;
2606
2607   /* if we have an empty event_list, there was no alternatives and we
2608      havn't started an if therefor don't run expand_end_cond */
2609   if (event_list != NULL_TREE)
2610     /* finish the if's */
2611     expand_end_cond ();
2612
2613   /* jump to the end of RECEIVE CASE processing */
2614   emit_jump (dldone);
2615
2616   /* define the __dlsetup label. We come here to initialize
2617      all variables */
2618   emit_label (dl_state->dlsetup);
2619
2620   if (event_list == NULL_TREE)
2621     {
2622       error ("DELAY CASE without alternatives");
2623       goto gen_dldoit;
2624     }
2625
2626   if (event_list == NULL_TREE
2627       || TREE_CODE (event_list) == ERROR_MARK)
2628     goto gen_dldoit;
2629
2630   /* make a list of pointers (in reverse order)
2631      to the event code variables */
2632   for (acode = event_list; acode != NULL_TREE;
2633        acode = TREE_CHAIN (acode))
2634     {
2635       tree event = TREE_VALUE (acode);
2636       tree event_length;
2637       tree descr_init;
2638
2639       if (event == NULL_TREE || TREE_CODE (event) == ERROR_MARK)
2640         {
2641           descr_init =
2642             tree_cons (NULL_TREE, null_pointer_node,
2643               tree_cons (NULL_TREE, integer_zero_node, NULL_TREE));
2644         }
2645       else
2646         {
2647           event_length = max_queue_size (TREE_TYPE (event));
2648           if (event_length == NULL_TREE)
2649             event_length = infinite_buffer_event_length_node;
2650           descr_init =
2651             tree_cons (NULL_TREE, force_addr_of (event),
2652               tree_cons (NULL_TREE, event_length, NULL_TREE));
2653         }
2654       tuple = tree_cons (NULL_TREE,
2655                 build_nt (CONSTRUCTOR, NULL_TREE, descr_init),
2656                   tuple);
2657       event_cnt++;
2658     }
2659
2660   /* generate the array of all event code pointers */
2661   {
2662     tree descr_type = TREE_TYPE (lookup_name (get_identifier ("__tmp_DESCR_type")));
2663     tree array_id = get_identifier ("event_code_array");
2664     tree array_type_node
2665       = build_chill_array_type (descr_type,
2666          tree_cons (NULL_TREE,
2667            build_chill_range_type (NULL_TREE,
2668                                    integer_one_node,
2669                                    build_int_2 (event_cnt, 0)),
2670                     NULL_TREE),
2671          0, NULL_TREE);
2672     tree constr = build_nt (CONSTRUCTOR, NULL_TREE,
2673                             nreverse (tuple));
2674     tree array_decl =
2675       decl_temp1 (array_id, array_type_node, 0, constr, 0, 0);
2676
2677     chill_expand_assignment (dl_state->event_codes, NOP_EXPR,
2678                              force_addr_of (array_decl));
2679
2680     /* give number of signals to runtime system */
2681     chill_expand_assignment (dl_state->n_events, NOP_EXPR,
2682                              build_int_2 (event_cnt, 0));
2683   }
2684
2685   /* now jump to the beginning of DELAY CASE processing */
2686 gen_dldoit:
2687   emit_jump (dl_state->dldoit);
2688
2689   /* define the __dldone label. We come here when the whole
2690      DELAY CASE is done. */
2691   emit_label (dldone);
2692
2693   current_dl_state = dl_state->enclosing;
2694   free(dl_state);
2695 }
2696 \f
2697 #if 0
2698  * The following code builds a simple delay statement,
2699  * which looks like this in CHILL:
2700  *
2701  *    DCL ev1 EVENT(5), ins INSTANCE;
2702  *
2703  *    DELAY ev1 PRIORITY 7;
2704  *
2705  * This statement unconditionally delays the current
2706  * PROCESS, until some other process CONTINUEs it.
2707  *
2708  * Here is the generated C code:
2709  *
2710  * typedef struct
2711  * {
2712  *   void          *p;
2713  *   unsigned long len;
2714  * } Descr;
2715  *
2716  * static short __tmp_ev1_code;
2717  *
2718  * {  /* start a new symbol context */
2719  *
2720  *   Descr __delay_array[1] = { { ev1, 5 } };
2721  *
2722  *   __delay_event (1, &__delay_array, 7, NULL,
2723  *                  filename, linenumber);
2724  *
2725  * } /* end of symbol scope */
2726  */
2727 #endif
2728 void
2729 build_delay_action (event, optpriority)
2730         tree event, optpriority;
2731 {
2732   int had_errors = 0;
2733   tree to_loc = NULL_TREE;
2734   /* we discard the return value of __delay_event, cause in
2735      a normal DELAY action no selections have to be made */
2736   tree ev_got = null_pointer_node;
2737
2738   /* check the event */
2739   if (event == NULL_TREE || TREE_CODE (event) == ERROR_MARK)
2740     had_errors = 1;
2741   else if (! CH_IS_EVENT_MODE (TREE_TYPE (event)) || ! CH_REFERABLE (event))
2742     {
2743       error ("DELAY action requires an event location.");
2744       had_errors = 1;
2745     }
2746
2747   /* check the presence of priority */
2748   if (optpriority != NULL_TREE)
2749     {
2750       if (TREE_CODE (optpriority) == ERROR_MARK)
2751         return;
2752       if (TREE_CODE (TREE_TYPE (optpriority)) != INTEGER_TYPE)
2753         {
2754           error ("PRIORITY in DELAY action must be of integer type.");
2755           return;
2756         }
2757     }
2758   else
2759     {
2760       /* issue a warning in case of -Wall */
2761       if (extra_warnings)
2762         {
2763           warning ("DELAY action without priority.");
2764           warning (" PRIORITY defaulted to 0.");
2765         }
2766       optpriority = integer_zero_node;
2767     }
2768   if (had_errors)
2769     return;
2770
2771   {
2772     tree descr_type;
2773     tree array_type_node;
2774     tree array_decl;
2775     tree descr_init;
2776     tree array_init;
2777     tree event_length = max_queue_size (TREE_TYPE (event));
2778     tree event_codes;
2779     tree filename = force_addr_of (get_chill_filename ());
2780     tree linenumber = get_chill_linenumber ();
2781     tree actuallist;
2782
2783     to_loc = build_timeout_preface ();
2784
2785     descr_type = TREE_TYPE (lookup_name (get_identifier ("__tmp_DESCR_type")));
2786
2787     array_type_node =
2788         build_chill_array_type (descr_type,
2789           tree_cons (NULL_TREE,
2790             build_chill_range_type (NULL_TREE, integer_one_node,
2791                                     integer_one_node),
2792                      NULL_TREE),
2793                        0, NULL_TREE);
2794     if (event_length == NULL_TREE)
2795       event_length = infinite_buffer_event_length_node;
2796
2797     descr_init =
2798       tree_cons (NULL_TREE, force_addr_of (event),
2799         tree_cons (NULL_TREE, event_length, NULL_TREE));
2800     array_init =
2801       tree_cons (NULL_TREE,
2802                  build_nt (CONSTRUCTOR, NULL_TREE, descr_init),
2803                  NULL_TREE);
2804     array_decl =
2805       decl_temp1 (get_unique_identifier ("event_codes_array"),
2806                   array_type_node, 0,
2807                   build_nt (CONSTRUCTOR, NULL_TREE, array_init),
2808                   0, 0);
2809
2810     event_codes =
2811       decl_temp1 (get_unique_identifier ("event_ptr"),
2812                   ptr_type_node, 0,
2813                   force_addr_of (array_decl),
2814                   0, 0);
2815
2816     actuallist =
2817       tree_cons (NULL_TREE, ev_got,
2818         tree_cons (NULL_TREE, integer_one_node,
2819           tree_cons (NULL_TREE, event_codes,
2820             tree_cons (NULL_TREE, optpriority,
2821               tree_cons (NULL_TREE, to_loc,
2822                 tree_cons (NULL_TREE, null_pointer_node,
2823                   tree_cons (NULL_TREE, filename,
2824                     tree_cons (NULL_TREE, linenumber, NULL_TREE))))))));
2825
2826
2827     build_timesupervised_call (
2828       build_chill_function_call (
2829         lookup_name (get_identifier ("__delay_event")),
2830           actuallist), to_loc);
2831   }
2832 }
2833 \f
2834 void
2835 expand_send_buffer (buffer, value, optpriority, optwith, optto)
2836      tree buffer, value, optpriority, optwith, optto;
2837 {
2838   tree filename, linenumber;
2839   tree buffer_mode_decl = NULL_TREE;
2840   tree buffer_ptr, value_ptr;
2841   int  had_errors = 0;
2842   tree timeout_value, fcall;
2843
2844   /* check buffer location */
2845   if (buffer == NULL_TREE || TREE_CODE (buffer) == ERROR_MARK)
2846     {
2847       buffer = NULL_TREE;
2848       had_errors = 1;
2849     }
2850   if (buffer != NULL_TREE)
2851     {
2852       if (! CH_IS_BUFFER_MODE (TREE_TYPE (buffer)) || ! CH_REFERABLE (buffer))
2853         {
2854           error ("send buffer action requires a BUFFER location.");
2855           had_errors = 1;
2856         }
2857       else
2858         buffer_mode_decl = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (buffer)));
2859     }
2860
2861   /* check value and type */
2862   if (value == NULL_TREE || TREE_CODE (value) == ERROR_MARK)
2863     {
2864       had_errors = 1;
2865       value = NULL_TREE;
2866     }
2867   if (value != NULL_TREE)
2868     {
2869       if (TREE_CHAIN (value) != NULL_TREE)
2870         {
2871           error ("there must be only 1 value for send buffer action.");
2872           had_errors = 1;
2873         }
2874       else
2875         {
2876           value = TREE_VALUE (value);
2877           if (value == NULL_TREE || TREE_CODE (value) == ERROR_MARK)
2878             {
2879               had_errors = 1;
2880               value = NULL_TREE;
2881             }
2882           if (value != NULL_TREE && buffer_mode_decl != NULL_TREE)
2883             {
2884               if (TREE_TYPE (buffer_mode_decl) != NULL_TREE &&
2885                   TREE_CODE (TREE_TYPE (buffer_mode_decl)) == ERROR_MARK)
2886                 had_errors = 1;
2887               else if (CH_COMPATIBLE (value, TREE_TYPE (buffer_mode_decl)))
2888                 {
2889                   value = convert (TREE_TYPE (buffer_mode_decl), value);
2890                   if (value == NULL_TREE || TREE_CODE (value) == ERROR_MARK)
2891                     {
2892                       error ("convert failed for send buffer action.");
2893                       had_errors = 1;
2894                     }
2895                 }
2896               else
2897                 {
2898                   error ("incompatible modes in send buffer action.");
2899                   had_errors = 1;
2900                 }
2901             }
2902         }
2903     }
2904
2905   /* check the presence of priority */
2906   if (optpriority == NULL_TREE)
2907     {
2908       if (send_buffer_prio == NULL_TREE)
2909         {
2910           /* issue a warning in case of -Wall */
2911           if (extra_warnings)
2912             {
2913               warning ("Buffer sent without priority");
2914               warning (" and no default priority was set.");
2915               warning (" PRIORITY defaulted to 0.");
2916             }
2917           optpriority = integer_zero_node;
2918         }
2919       else
2920         optpriority = send_buffer_prio;
2921     }
2922   else if (TREE_CODE (optpriority) == ERROR_MARK)
2923     had_errors = 1;
2924   else if (TREE_CODE (TREE_TYPE (optpriority)) != INTEGER_TYPE)
2925     {
2926       error ("PRIORITY must be of integer type.");
2927       had_errors = 1;
2928     }
2929
2930   if (optwith != NULL_TREE)
2931     {
2932       error ("WITH not allowed for send buffer action.");
2933       had_errors = 1;
2934     }
2935   if (optto != NULL_TREE)
2936     {
2937       error ("TO not allowed for send buffer action.");
2938       had_errors = 1;
2939     }
2940   if (had_errors)
2941     return;
2942
2943   {
2944     tree descr_type;
2945     tree buffer_descr, buffer_init, buffer_length;
2946     tree val;
2947
2948     /* process timeout */
2949     timeout_value = build_timeout_preface ();
2950
2951     descr_type = lookup_name (get_identifier ("__tmp_DESCR_type"));
2952
2953     /* build descr for buffer */
2954     buffer_length = max_queue_size (TREE_TYPE (buffer));
2955     if (buffer_length == NULL_TREE)
2956       buffer_length = infinite_buffer_event_length_node;
2957     buffer_init = build_nt (CONSTRUCTOR, NULL_TREE,
2958                     tree_cons (NULL_TREE, force_addr_of (buffer),
2959                       tree_cons (NULL_TREE, buffer_length, NULL_TREE)));
2960     buffer_descr = decl_temp1 (get_unique_identifier ("buffer_descr"),
2961                                TREE_TYPE (descr_type), 0, buffer_init,
2962                                0, 0);
2963     buffer_ptr = decl_temp1 (get_unique_identifier ("buffer_ptr"),
2964                              ptr_type_node, 0,
2965                              force_addr_of (buffer_descr),
2966                              0, 0);
2967
2968     /* build descr for value */
2969     if (! CH_REFERABLE (value))
2970       val = decl_temp1 (get_identifier ("buffer_value"),
2971                         TREE_TYPE (value), 0,
2972                         value, 0, 0);
2973     else
2974       val = value;
2975
2976     value_ptr = build_chill_descr (val);
2977
2978   }
2979
2980   /* get filename and linenumber */
2981   filename = force_addr_of (get_chill_filename ());
2982   linenumber = get_chill_linenumber ();
2983
2984   /* Now, we can call the runtime */
2985   fcall = build_chill_function_call (
2986     lookup_name (get_identifier ("__send_buffer")),
2987       tree_cons (NULL_TREE, buffer_ptr,
2988         tree_cons (NULL_TREE, value_ptr,
2989           tree_cons (NULL_TREE, optpriority,
2990             tree_cons (NULL_TREE, timeout_value,
2991               tree_cons (NULL_TREE, filename,
2992                 tree_cons (NULL_TREE, linenumber, NULL_TREE)))))));
2993   build_timesupervised_call (fcall, timeout_value);
2994 }
2995 # if 0
2996 \f
2997 void
2998 process_buffer_decls (namelist, mode, optstatic)
2999   tree namelist, mode;
3000   int  optstatic;
3001 {
3002   tree names;
3003   int quasi_flag = current_module->is_spec_module;
3004
3005   if (pass < 2)
3006     return;
3007
3008   for (names = namelist; names != NULL_TREE; names = TREE_CHAIN (names))
3009     {
3010       tree name = TREE_VALUE (names);
3011       tree bufdecl = lookup_name (name);
3012       tree code_decl =
3013         decl_tasking_code_variable (name, &buffer_code, quasi_flag);
3014
3015       /* remember the code variable in the buffer decl */
3016       DECL_TASKING_CODE_DECL (bufdecl) = (struct lang_decl *)code_decl;
3017
3018       add_taskstuff_to_list (code_decl, "_TT_Buffer",
3019                              quasi_flag ? NULL_TREE : buffer_code,
3020                              bufdecl);
3021     }
3022 }
3023 #endif
3024 \f
3025 /*
3026  * if no queue size was specified, QUEUESIZE is integer_zero_node.
3027  */
3028 tree
3029 build_buffer_type (element_type, queuesize)
3030      tree element_type, queuesize;
3031 {
3032   tree type, field;
3033   if (element_type == NULL_TREE || TREE_CODE (element_type) == ERROR_MARK)
3034     return error_mark_node;
3035   if (queuesize != NULL_TREE && TREE_CODE (queuesize) == ERROR_MARK)
3036     return error_mark_node;
3037
3038   type = make_node (RECORD_TYPE);
3039   field = build_decl (FIELD_DECL, get_identifier("__buffer_data"),
3040                       ptr_type_node);
3041   TYPE_FIELDS (type) = field;
3042   TREE_CHAIN (field)
3043     = build_lang_decl (TYPE_DECL, get_identifier ("__element_mode"),
3044                        element_type);
3045   field = TREE_CHAIN (field);
3046   if (queuesize)
3047     {
3048       tree size_field = build_decl (CONST_DECL, get_identifier("__queue_max"),
3049                                     integer_type_node);
3050       DECL_INITIAL (size_field) = queuesize;
3051       TREE_CHAIN (field) = size_field;
3052     }
3053   CH_IS_BUFFER_MODE (type) = 1;
3054   CH_TYPE_NONVALUE_P (type) = 1;
3055   if (pass == 2)
3056     type = layout_chill_struct_type (type);
3057   return type;
3058 }
3059 \f
3060 #if 0
3061 tree
3062 build_buffer_descriptor (bufname, expr, optpriority)
3063      tree bufname, expr, optpriority;
3064 {
3065   tree bufdecl;
3066
3067   if (bufname == NULL_TREE
3068       || TREE_CODE (bufname) == ERROR_MARK)
3069     return error_mark_node;
3070
3071   if (expr != NULL_TREE
3072       && TREE_CODE (expr) == ERROR_MARK)
3073     return error_mark_node;
3074 #if 0
3075 /* FIXME: is this what we really want to test? */
3076   bufdecl = lookup_name (bufname);
3077   if (TREE_CODE (bufdecl) != TYPE_DECL
3078       || ! CH_IS_BUFFER_MODE (TREE_TYPE (bufdecl)))
3079     {
3080       error ("SEND requires a BUFFER; `%s' is not a BUFFER name",
3081              bufname);
3082       return error_mark_node;
3083     }
3084 #endif
3085   {
3086     /* build buffer/signal data structure */
3087     tree bufdataname = get_unique_identifier (IDENTIFIER_POINTER (bufname));
3088     tree dataptr;
3089
3090     if (expr == NULL_TREE)
3091       dataptr = null_pointer_node;
3092     else
3093       {
3094         tree decl =
3095           decl_temp1 (bufdataname, TREE_TYPE (bufdecl), 0,
3096                       expr, 0, 0);
3097         /* prevent granting of this variable */
3098         DECL_SOURCE_LINE (decl) = 0;
3099
3100         dataptr = force_addr_of (decl);
3101       }
3102
3103     /* build descriptor pointing to buffer data */
3104     {
3105       tree tasking_message_var = get_unique_identifier (IDENTIFIER_POINTER (bufname));
3106       tree data_len = (expr == NULL_TREE) ? integer_zero_node :
3107                              size_in_bytes (TREE_TYPE (bufdecl));
3108       tree tasking_code = (tree)DECL_TASKING_CODE_DECL (bufdecl);
3109       tree tuple = build_nt (CONSTRUCTOR, NULL_TREE,
3110                      tree_cons (NULL_TREE,
3111                        build1 (ADDR_EXPR,
3112                                build_chill_pointer_type (chill_integer_type_node),
3113                                tasking_code),
3114                            tree_cons (NULL_TREE, data_len,
3115                              tree_cons (NULL_TREE, dataptr, NULL_TREE))));
3116
3117       tree decl = decl_temp1 (tasking_message_var,
3118                               TREE_TYPE (tasking_message_type), 0,
3119                               tuple, 0, 0);
3120       mark_addressable (tasking_code);
3121       /* prevent granting of this variable */
3122       DECL_SOURCE_LINE (decl) = 0;
3123
3124       tuple = force_addr_of (decl);
3125       return tuple;
3126     }
3127   }
3128 }
3129 #endif
3130 \f
3131 #if 0
3132 void
3133 process_event_decls (namelist, mode, optstatic)
3134   tree namelist, mode;
3135   int  optstatic;
3136 {
3137   tree names;
3138   int quasi_flag = current_module->is_spec_module;
3139
3140   if (pass < 2)
3141     return;
3142
3143   for (names = namelist; names != NULL_TREE; names = TREE_CHAIN (names))
3144     {
3145       tree name = TREE_VALUE (names);
3146       tree eventdecl = lookup_name (name);
3147       tree code_decl =
3148         decl_tasking_code_variable (name, &event_code, quasi_flag);
3149
3150       /* remember the code variable in the event decl */
3151       DECL_TASKING_CODE_DECL (eventdecl) = (struct lang_decl *)code_decl;
3152
3153       add_taskstuff_to_list (code_decl, "_TT_Event",
3154                              quasi_flag ? NULL_TREE : event_code,
3155                              eventdecl);
3156     }
3157 }
3158 #endif
3159 \f
3160 /* Return the buffer or event length of a buffer or event mode.
3161    (NULL_TREE means unlimited.) */
3162
3163 tree
3164 max_queue_size (mode)
3165      tree mode;
3166 {
3167   tree field = TYPE_FIELDS (mode);
3168   for ( ; field != NULL_TREE ; field = TREE_CHAIN (field))
3169     {
3170       if (TREE_CODE (field) == CONST_DECL)
3171         return DECL_INITIAL (field);
3172     }
3173   return NULL_TREE;
3174 }
3175
3176 /* Return the buffer element mode of a buffer mode. */
3177
3178 tree
3179 buffer_element_mode (bufmode)
3180      tree bufmode;
3181 {
3182   tree field = TYPE_FIELDS (bufmode);
3183   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
3184     {
3185       if (TREE_CODE (field) == TYPE_DECL)
3186         return TREE_TYPE (field);
3187     }
3188   return NULL_TREE;
3189 }
3190
3191 /* invalidate buffer element mode in case we detect, that the
3192    elelment mode has the non-value property */
3193
3194 void
3195 invalidate_buffer_element_mode (bufmode)
3196      tree bufmode;
3197 {
3198   tree field = TYPE_FIELDS (bufmode);
3199   for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
3200     {
3201       if (TREE_CODE (field) == TYPE_DECL)
3202         {
3203           TREE_TYPE (field) = error_mark_node;
3204           return;
3205         }
3206     }
3207 }
3208
3209 /* For an EVENT or BUFFER mode TYPE, with a give maximum queue size QSIZE,
3210    perform various error checks.  Return a new queue size. */
3211
3212 tree
3213 check_queue_size (qsize)
3214      tree qsize;
3215 {
3216   if (qsize == NULL_TREE || TREE_CODE (qsize) == ERROR_MARK)
3217     return qsize;
3218   if (TREE_TYPE (qsize) == NULL_TREE
3219       || !CH_SIMILAR (TREE_TYPE (qsize), integer_type_node))
3220     {
3221       error ("non-integral max queue size for EVENT/BUFFER mode");
3222       return integer_one_node;
3223     }
3224   if (TREE_CODE (qsize) != INTEGER_CST)
3225     {
3226       error ("non-constant max queue size for EVENT/BUFFER mode");
3227       return integer_one_node;
3228     }
3229   if (compare_int_csts (pedantic ? LE_EXPR : LT_EXPR,
3230                         qsize,
3231                         integer_zero_node))
3232     {
3233       error ("max queue_size for EVENT/BUFFER is not positive");
3234       return integer_one_node;
3235     }
3236   return qsize;
3237 }
3238
3239 /*
3240  * An EVENT type is modelled as a boolean type, which should
3241  * allocate the minimum amount of space.
3242  */
3243 tree
3244 build_event_type (queuesize)
3245      tree queuesize;
3246 {
3247   tree type = make_node (RECORD_TYPE);
3248   tree field = build_decl (FIELD_DECL, get_identifier("__event_data"),
3249                       ptr_type_node);
3250   TYPE_FIELDS (type) = field;
3251   if (queuesize)
3252     {
3253       tree size_field = build_decl (CONST_DECL, get_identifier("__queue_max"),
3254                                     integer_type_node);
3255       DECL_INITIAL (size_field) = queuesize;
3256       TREE_CHAIN (field) = size_field;
3257     }
3258   CH_IS_EVENT_MODE (type) = 1;
3259   CH_TYPE_NONVALUE_P (type) = 1;
3260   if (pass == 2)
3261     type = layout_chill_struct_type (type);
3262   return type;
3263 }
3264 \f
3265 /*
3266  * Initialize the various types of tasking data.
3267  */
3268 void
3269 tasking_init ()
3270 {
3271   extern int  ignore_case;
3272   extern int  special_UC;
3273   extern tree chill_predefined_function_type;
3274   tree temp, ins_ftype_void;
3275   tree endlink = void_list_node;
3276   tree int_ftype_ptr_int_ptr_ptr_int_ptr_int_ptr_ptr_int;
3277   tree void_ftype_ptr;
3278   tree void_ftype_ptr_ins_int_int_ptr_ptr_int;
3279   tree int_ftype_ptr_ptr_int_ptr_ptr_int;
3280   tree void_ftype_int_int_int_ptr_ptr_ptr_int;
3281   tree int_ftype_ptr_int_ptr_int_ptr_ptr_ptr_int;
3282   tree int_ftype_ptr_int;
3283
3284   /* type of tasking code variables */
3285   chill_taskingcode_type_node = short_unsigned_type_node;
3286
3287   void_ftype_void =
3288        build_function_type (void_type_node,
3289          tree_cons (NULL_TREE, void_type_node, NULL_TREE));
3290
3291   build_instance_type ();
3292   ins_ftype_void
3293     = build_function_type (instance_type_node,
3294         tree_cons (NULL_TREE, void_type_node,
3295           build_tree_list (NULL_TREE, void_type_node)));
3296
3297   builtin_function ("__whoami", ins_ftype_void,
3298                     NOT_BUILT_IN, NULL_PTR);
3299
3300   build_tasking_message_type ();
3301
3302   temp = build_decl (TYPE_DECL,
3303            get_identifier ("__tmp_TaskingStruct"),
3304              build_tasking_struct ());
3305   pushdecl (temp);
3306   DECL_SOURCE_LINE (temp) = 0;
3307
3308   /* any SIGNAL will be compatible with this one */
3309   generic_signal_type_node = copy_node (boolean_type_node);
3310
3311   builtin_function ((ignore_case || ! special_UC) ? "copy_number" : "COPY_NUMBER",
3312                     chill_predefined_function_type,
3313                     BUILT_IN_COPY_NUMBER, NULL_PTR);
3314   builtin_function ((ignore_case || ! special_UC) ? "gen_code" : "GEN_CODE",
3315                     chill_predefined_function_type,
3316                     BUILT_IN_GEN_CODE, NULL_PTR);
3317   builtin_function ((ignore_case || ! special_UC) ? "gen_inst" : "GEN_INST",
3318                     chill_predefined_function_type,
3319                     BUILT_IN_GEN_INST, NULL_PTR);
3320   builtin_function ((ignore_case || ! special_UC) ? "gen_ptype" : "GEN_PTYPE",
3321                     chill_predefined_function_type,
3322                     BUILT_IN_GEN_PTYPE, NULL_PTR);
3323   builtin_function ((ignore_case || ! special_UC) ? "proc_type" : "PROC_TYPE",
3324                     chill_predefined_function_type,
3325                     BUILT_IN_PROC_TYPE, NULL_PTR);
3326   builtin_function ((ignore_case || ! special_UC) ? "queue_length" : "QUEUE_LENGTH",
3327                     chill_predefined_function_type,
3328                     BUILT_IN_QUEUE_LENGTH, NULL_PTR);
3329
3330   int_ftype_ptr_int_ptr_ptr_int_ptr_int_ptr_ptr_int
3331      = build_function_type (integer_type_node,
3332          tree_cons (NULL_TREE, ptr_type_node,
3333            tree_cons (NULL_TREE, integer_type_node,
3334              tree_cons (NULL_TREE, ptr_type_node,
3335                tree_cons (NULL_TREE, ptr_type_node,
3336                  tree_cons (NULL_TREE, integer_type_node,
3337                    tree_cons (NULL_TREE, ptr_type_node,
3338                      tree_cons (NULL_TREE, integer_type_node,
3339                        tree_cons (NULL_TREE, ptr_type_node,
3340                          tree_cons (NULL_TREE, ptr_type_node,
3341                            tree_cons (NULL_TREE, integer_type_node,
3342                              endlink)))))))))));
3343   void_ftype_ptr
3344      = build_function_type (void_type_node,
3345            tree_cons (NULL_TREE, ptr_type_node, endlink));
3346
3347   int_ftype_ptr_int_ptr_int_ptr_ptr_ptr_int
3348      = build_function_type (integer_type_node,
3349          tree_cons (NULL_TREE, ptr_type_node,
3350            tree_cons (NULL_TREE, integer_type_node,
3351              tree_cons (NULL_TREE, ptr_type_node,
3352                tree_cons (NULL_TREE, integer_type_node,
3353                  tree_cons (NULL_TREE, ptr_type_node,
3354                    tree_cons (NULL_TREE, ptr_type_node,
3355                      tree_cons (NULL_TREE, ptr_type_node,
3356                        tree_cons (NULL_TREE, integer_type_node,
3357                          endlink)))))))));
3358
3359   void_ftype_ptr_ins_int_int_ptr_ptr_int
3360     = build_function_type (void_type_node,
3361           tree_cons (NULL_TREE, ptr_type_node,
3362               tree_cons (NULL_TREE, instance_type_node,
3363                   tree_cons (NULL_TREE, integer_type_node,
3364                       tree_cons (NULL_TREE, integer_type_node,
3365                         tree_cons (NULL_TREE, ptr_type_node,
3366                             tree_cons (NULL_TREE, ptr_type_node,
3367                                 tree_cons (NULL_TREE, integer_type_node,
3368                                     endlink))))))));
3369   int_ftype_ptr_ptr_int_ptr_ptr_int
3370     = build_function_type (integer_type_node,
3371           tree_cons (NULL_TREE, ptr_type_node,
3372             tree_cons (NULL_TREE, ptr_type_node,
3373                 tree_cons (NULL_TREE, integer_type_node,
3374                     tree_cons (NULL_TREE, ptr_type_node,
3375                         tree_cons (NULL_TREE, ptr_type_node,
3376                             tree_cons (NULL_TREE, integer_type_node,
3377                                 endlink)))))));
3378
3379   void_ftype_int_int_int_ptr_ptr_ptr_int
3380      = build_function_type (void_type_node,
3381            tree_cons (NULL_TREE, integer_type_node,
3382                tree_cons (NULL_TREE, integer_type_node,
3383                    tree_cons (NULL_TREE, integer_type_node,
3384                        tree_cons (NULL_TREE, ptr_type_node,
3385                            tree_cons (NULL_TREE, ptr_type_node,
3386                                tree_cons (NULL_TREE, ptr_type_node,
3387                                    tree_cons (NULL_TREE, integer_type_node,
3388                                        endlink))))))));
3389
3390   int_ftype_ptr_int
3391      = build_function_type (integer_type_node,
3392            tree_cons (NULL_TREE, ptr_type_node,
3393                tree_cons (NULL_TREE, integer_type_node,
3394                    endlink)));
3395
3396   builtin_function ("__delay_event", int_ftype_ptr_int_ptr_int_ptr_ptr_ptr_int,
3397                     NOT_BUILT_IN, NULL_PTR);
3398   builtin_function ("__queue_length", int_ftype_ptr_int,
3399                     NOT_BUILT_IN, NULL_PTR);
3400   builtin_function ("__register_tasking", void_ftype_ptr,
3401                     NOT_BUILT_IN, NULL_PTR);
3402   builtin_function ("__send_signal", void_ftype_ptr_ins_int_int_ptr_ptr_int,
3403                     NOT_BUILT_IN, NULL_PTR);
3404   builtin_function ("__send_buffer", int_ftype_ptr_ptr_int_ptr_ptr_int,
3405                     NOT_BUILT_IN, NULL_PTR);
3406   builtin_function ("__start_process", void_ftype_int_int_int_ptr_ptr_ptr_int,
3407                     NOT_BUILT_IN, NULL_PTR);
3408   builtin_function ("__stop_process", void_ftype_void, NOT_BUILT_IN,
3409                     NULL_PTR);
3410   builtin_function ("__wait_buffer", int_ftype_ptr_int_ptr_ptr_int_ptr_int_ptr_ptr_int,
3411                     NOT_BUILT_IN, NULL_PTR);
3412   builtin_function ("__wait_signal_timed", int_ftype_ptr_int_ptr_ptr_int_ptr_int_ptr_ptr_int,
3413                     NOT_BUILT_IN, NULL_PTR);
3414
3415   infinite_buffer_event_length_node = build_int_2 (-1, 0);
3416   TREE_TYPE (infinite_buffer_event_length_node) = long_integer_type_node;
3417   TREE_UNSIGNED (infinite_buffer_event_length_node) = 1;
3418 }