gcc/ch/tasking.c

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