gcc/ch/tasking.c

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