gcc/ch/expr.c

   1 /* Convert language-specific tree expression to rtl instructions,
   2    for GNU CHILL compiler.
   3    Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000
   4    Free Software Foundation, Inc.
   5
   6 This file is part of GNU CC.
   7
   8 GNU CC is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 2, or (at your option)
  11 any later version.
  12
  13 GNU CC is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU CC; see the file COPYING.  If not, write to
  20 the Free Software Foundation, 59 Temple Place - Suite 330,
  21 Boston, MA 02111-1307, USA.  */
  22
  23
  24 #include "config.h"
  25 #include "system.h"
  26 #include "rtl.h"
  27 #include "tree.h"
  28 #include "flags.h"
  29 #include "expr.h"
  30 #include "ch-tree.h"
  31 #include "assert.h"
  32 #include "lex.h"
  33 #include "convert.h"
  34 #include "toplev.h"
  35
  36 extern char **boolean_code_name;
  37 extern int  flag_old_strings;
  38 extern int  ignore_case;
  39 extern int  special_UC;
  40
  41 /* definitions for duration built-ins */
  42 #define MILLISECS_MULTIPLIER                                 1
  43 #define SECS_MULTIPLIER            MILLISECS_MULTIPLIER * 1000
  44 #define MINUTES_MULTIPLIER                SECS_MULTIPLIER * 60
  45 #define HOURS_MULTIPLIER               MINUTES_MULTIPLIER * 60
  46 #define DAYS_MULTIPLIER                  HOURS_MULTIPLIER * 24
  47
  48 /* the maximum value for each of the calls */
  49 #define MILLISECS_MAX                               0xffffffff
  50 #define SECS_MAX                                       4294967
  51 #define MINUTES_MAX                                      71582
  52 #define HOURS_MAX                                         1193
  53 #define DAYS_MAX                                            49
  54
  55 /* forward declarations */
  56 static rtx chill_expand_expr            PARAMS ((tree, rtx, enum machine_mode,
  57                                                 enum expand_modifier));
  58 static tree chill_expand_case_expr      PARAMS ((tree));
  59 static int check_arglist_length         PARAMS ((tree, int, int, tree));
  60 static tree internal_build_compound_expr PARAMS ((tree, int));
  61 static int is_really_instance           PARAMS ((tree));
  62 static int invalid_operand              PARAMS ((enum chill_tree_code,
  63                                                 tree, int));
  64 static int invalid_right_operand        PARAMS ((enum chill_tree_code, tree));
  65 static tree build_chill_abstime         PARAMS ((tree));
  66 static tree build_allocate_memory_call  PARAMS ((tree, tree));
  67 static tree build_allocate_global_memory_call PARAMS ((tree, tree));
  68 static tree build_return_memory         PARAMS ((tree));
  69 static tree build_chill_duration        PARAMS ((tree, unsigned long,
  70                                                 tree, unsigned long));
  71 static tree build_chill_floatcall       PARAMS ((tree, const char *,
  72                                                 const char *));
  73 static tree build_allocate_getstack     PARAMS ((tree, tree, const char *,
  74                                                 const char *, tree, tree));
  75 static tree build_chill_allocate        PARAMS ((tree, tree));
  76 static tree build_chill_getstack        PARAMS ((tree, tree));
  77 static tree build_chill_terminate       PARAMS ((tree));
  78 static tree build_chill_inttime         PARAMS ((tree, tree));
  79 static tree build_chill_lower_or_upper  PARAMS ((tree, int));
  80 static tree build_max_min               PARAMS ((tree, int));
  81 static tree build_chill_pred_or_succ    PARAMS ((tree, enum tree_code));
  82 static tree expand_packed_set           PARAMS ((const char *, int, tree));
  83 static tree fold_set_expr               PARAMS ((enum chill_tree_code,
  84                                                 tree, tree));
  85 static tree build_compare_set_expr      PARAMS ((enum tree_code, tree, tree));
  86 static tree scalar_to_string            PARAMS ((tree));
  87 static tree build_concat_expr           PARAMS ((tree, tree));
  88 static tree build_compare_string_expr   PARAMS ((enum tree_code, tree, tree));
  89 static tree compare_records             PARAMS ((tree, tree));
  90 static tree string_char_rep             PARAMS ((int, tree));
  91 static tree build_boring_bitstring      PARAMS ((long, int));
  92
  93 /* variable to hold the type the DESCR built-in returns */
  94 static tree descr_type = NULL_TREE;
  95
  96 \f
  97 /* called from ch-lex.l */
  98 void
  99 init_chill_expand ()
 100 {
 101   lang_expand_expr = chill_expand_expr;
 102 }
 103
 104 /* Take the address of something that needs to be passed by reference. */
 105 tree
 106 force_addr_of (value)
 107      tree value;
 108 {
 109   /* FIXME.  Move to memory, if needed. */
 110   if (TREE_CODE (value) == INDIRECT_REF)
 111     return convert_to_pointer (ptr_type_node, TREE_OPERAND (value, 0));
 112   mark_addressable (value);
 113   return build1 (ADDR_EXPR, ptr_type_node, value);
 114 }
 115
 116 /* Check that EXP has a known type. */
 117
 118 tree
 119 check_have_mode (exp, context)
 120      tree exp;
 121      const char *context;
 122 {
 123   if (TREE_CODE (exp) != ERROR_MARK && TREE_TYPE (exp) == NULL_TREE)
 124     {
 125       if (TREE_CODE (exp) == CONSTRUCTOR)
 126         error ("tuple without specified mode not allowed in %s", context);
 127       else if (TREE_CODE (exp) == COND_EXPR || TREE_CODE (exp) == CASE_EXPR)
 128         error ("conditional expression not allowed in %s", context);
 129       else
 130         error ("internal error:  unknown expression mode in %s", context);
 131
 132       return error_mark_node;
 133     }
 134   return exp;
 135 }
 136
 137 /* Check that EXP is discrete.  Handle conversion if flag_old_strings. */
 138
 139 tree
 140 check_case_selector (exp)
 141      tree exp;
 142 {
 143   if (exp != NULL_TREE && TREE_TYPE (exp) != NULL_TREE)
 144     exp = convert_to_discrete (exp);
 145   if (exp)
 146     return exp;
 147   error ("CASE selector is not a discrete expression");
 148   return error_mark_node;
 149 }
 150
 151 tree
 152 check_case_selector_list (list)
 153      tree list;
 154 {
 155   tree selector, exp, return_list = NULL_TREE;
 156
 157   for (selector = list; selector != NULL_TREE; selector = TREE_CHAIN (selector))
 158     {
 159       exp = check_case_selector (TREE_VALUE (selector));
 160       if (exp == error_mark_node)
 161         {
 162           return_list = error_mark_node;
 163           break;
 164         }
 165       return_list = tree_cons (TREE_PURPOSE (selector), exp, return_list);
 166     }
 167
 168   return nreverse(return_list);
 169 }
 170
 171 static tree
 172 chill_expand_case_expr (expr)
 173      tree expr;
 174 {
 175   tree selector_list = TREE_OPERAND (expr, 0), selector;
 176   tree alternatives  = TREE_OPERAND (expr, 1);
 177   tree type = TREE_TYPE (expr);
 178   int  else_seen = 0;
 179   tree result;
 180
 181   if (TREE_CODE (selector_list) != TREE_LIST
 182     || TREE_CODE (alternatives) != TREE_LIST)
 183     abort();
 184   if (TREE_CHAIN (selector_list) != NULL_TREE)
 185     abort ();
 186
 187   /* make a temp for the case result */
 188   result = decl_temp1 (get_unique_identifier ("CASE_EXPR"),
 189                        type, 0, NULL_TREE, 0, 0);
 190
 191   selector = check_case_selector (TREE_VALUE (selector_list));
 192
 193   expand_start_case (1, selector, TREE_TYPE (selector), "CASE expression");
 194
 195   alternatives = nreverse (alternatives);
 196   for ( ; alternatives != NULL_TREE; alternatives = TREE_CHAIN (alternatives))
 197     {
 198       tree labels = TREE_PURPOSE (alternatives), t;
 199
 200       if (labels == NULL_TREE)
 201         {
 202           chill_handle_case_default ();
 203           else_seen++;
 204         }
 205       else
 206         {
 207           tree label;
 208           if (labels != NULL_TREE)
 209             {
 210               for (label = TREE_VALUE (labels);
 211                    label != NULL_TREE; label = TREE_CHAIN (label))
 212                 chill_handle_case_label (TREE_VALUE (label), selector);
 213               labels = TREE_CHAIN (labels);
 214               if (labels != NULL_TREE)
 215                 error ("The number of CASE selectors does not match the number of CASE label lists");
 216
 217             }
 218         }
 219
 220       t = build (MODIFY_EXPR, type, result,
 221                  convert (type, TREE_VALUE (alternatives)));
 222       TREE_SIDE_EFFECTS (t) = 1;
 223       expand_expr_stmt (t);
 224       expand_exit_something ();
 225     }
 226
 227   if (!else_seen)
 228     {
 229       chill_handle_case_default ();
 230       expand_exit_something ();
 231 #if 0
 232       expand_raise ();
 233 #endif
 234
 235       check_missing_cases (TREE_TYPE (selector));
 236     }
 237
 238   expand_end_case (selector);
 239   return result;
 240 }
 241 \f
 242 /* Hook used by expand_expr to expand CHILL-specific tree codes.  */
 243
 244 static rtx
 245 chill_expand_expr (exp, target, tmode, modifier)
 246      tree exp;
 247      rtx target;
 248      enum machine_mode tmode;
 249      enum expand_modifier modifier;
 250 {
 251   tree type = TREE_TYPE (exp);
 252   register enum machine_mode mode = TYPE_MODE (type);
 253   register enum tree_code code = TREE_CODE (exp);
 254   rtx original_target = target;
 255   rtx op0, op1;
 256   int ignore = target == const0_rtx;
 257   const char *lib_func;                   /* name of library routine */
 258
 259   if (ignore)
 260     target = 0, original_target = 0;
 261
 262   /* No sense saving up arithmetic to be done
 263      if it's all in the wrong mode to form part of an address.
 264      And force_operand won't know whether to sign-extend or zero-extend.  */
 265
 266   if (mode != Pmode && modifier == EXPAND_SUM)
 267     modifier = EXPAND_NORMAL;
 268
 269   switch (code)
 270     {
 271     case STRING_EQ_EXPR:
 272     case STRING_LT_EXPR:
 273       {
 274         rtx func = gen_rtx (SYMBOL_REF, Pmode,
 275                             code == STRING_EQ_EXPR ? "__eqstring"
 276                             : "__ltstring");
 277         tree exp0 = TREE_OPERAND (exp, 0);
 278         tree exp1 = TREE_OPERAND (exp, 1);
 279         tree size0, size1;
 280         rtx op0, op1, siz0, siz1;
 281         if (chill_varying_type_p (TREE_TYPE (exp0)))
 282           {
 283             exp0 = save_if_needed (exp0);
 284             size0 = convert (integer_type_node,
 285                              build_component_ref (exp0, var_length_id));
 286             exp0 = build_component_ref (exp0, var_data_id);
 287           }
 288         else
 289           size0 = size_in_bytes (TREE_TYPE (exp0));
 290         if (chill_varying_type_p (TREE_TYPE (exp1)))
 291           {
 292             exp1 = save_if_needed (exp1);
 293             size1 = convert (integer_type_node,
 294                              build_component_ref (exp1, var_length_id));
 295             exp1 = build_component_ref (exp1, var_data_id);
 296           }
 297         else
 298           size1 = size_in_bytes (TREE_TYPE (exp1));
 299
 300         op0 = expand_expr (force_addr_of (exp0),
 301                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
 302         op1 = expand_expr (force_addr_of (exp1),
 303                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
 304         siz0 = expand_expr (size0, NULL_RTX, VOIDmode, 0);
 305         siz1 = expand_expr (size1, NULL_RTX, VOIDmode, 0);
 306         return emit_library_call_value (func, target,
 307                                         0, QImode, 4,
 308                                         op0, GET_MODE (op0),
 309                                         siz0, TYPE_MODE (sizetype),
 310                                         op1, GET_MODE (op1),
 311                                         siz1, TYPE_MODE (sizetype));
 312       }
 313
 314     case CASE_EXPR:
 315       return expand_expr (chill_expand_case_expr (exp),
 316                           NULL_RTX, VOIDmode, 0);
 317       break;
 318
 319     case SLICE_EXPR:
 320       {
 321         tree func_call;
 322         tree array = TREE_OPERAND (exp, 0);
 323         tree min_value = TREE_OPERAND (exp, 1);
 324         tree length = TREE_OPERAND (exp, 2);
 325         tree new_type = TREE_TYPE (exp);
 326         tree temp = decl_temp1 (get_unique_identifier ("BITSTRING"),
 327                                 new_type, 0, NULL_TREE, 0, 0);
 328         if (! CH_REFERABLE (array) && TYPE_MODE (TREE_TYPE (array)) != BLKmode)
 329           array = decl_temp1 (get_unique_identifier ("BSTRINGVAL"),
 330                                 TREE_TYPE (array), 0, array, 0, 0);
 331         func_call = build_chill_function_call (
 332                     lookup_name (get_identifier ("__psslice")),
 333                            tree_cons (NULL_TREE,
 334                              build_chill_addr_expr (temp, (char *)0),
 335                                tree_cons (NULL_TREE, length,
 336                                  tree_cons (NULL_TREE,
 337                                     force_addr_of (array),
 338                                      tree_cons (NULL_TREE, powersetlen (array),
 339                                        tree_cons (NULL_TREE, convert (integer_type_node, min_value),
 340                                          tree_cons (NULL_TREE, length, NULL_TREE)))))));
 341         expand_expr (func_call, const0_rtx, VOIDmode, 0);
 342         emit_queue ();
 343         return expand_expr (temp, ignore ? const0_rtx : target,
 344                             VOIDmode, 0);
 345       }
 346
 347     /* void __concatstring (char *out, char *left, unsigned left_len,
 348                             char *right, unsigned right_len) */
 349     case CONCAT_EXPR:
 350       {
 351         tree exp0 = TREE_OPERAND (exp, 0);
 352         tree exp1 = TREE_OPERAND (exp, 1);
 353         rtx size0 = NULL_RTX, size1 = NULL_RTX;
 354         rtx targetx;
 355
 356         if (TREE_CODE (exp1) == UNDEFINED_EXPR)
 357           {
 358             if (TYPE_MODE (TREE_TYPE (exp0)) == BLKmode
 359                 && TYPE_MODE (TREE_TYPE (exp)) == BLKmode)
 360               {
 361                 rtx temp = expand_expr (exp0, target, tmode, modifier);
 362                 if (temp == target || target == NULL_RTX)
 363                   return temp;
 364                 emit_block_move (target, temp, expr_size (exp0),
 365                                  TYPE_ALIGN (TREE_TYPE(exp0)));
 366                 return target;
 367               }
 368             else
 369               {
 370                 exp0 = force_addr_of (exp0);
 371                 exp0 = convert (build_pointer_type (TREE_TYPE (exp)), exp0);
 372                 exp0 = build1 (INDIRECT_REF, TREE_TYPE (exp), exp0);
 373                 return expand_expr (exp0,
 374                                     NULL_RTX, Pmode, EXPAND_CONST_ADDRESS);
 375               }
 376           }
 377
 378         if (TREE_CODE (type) == ARRAY_TYPE)
 379           {
 380             /* No need to handle scalars or varying strings here, since that
 381                was done in convert or build_concat_expr. */
 382             size0 = expand_expr (size_in_bytes (TREE_TYPE (exp0)),
 383                                  NULL_RTX, Pmode, EXPAND_CONST_ADDRESS);
 384
 385             size1 = expand_expr (size_in_bytes (TREE_TYPE (exp1)),
 386                                    NULL_RTX, Pmode, EXPAND_CONST_ADDRESS);
 387
 388             /* build a temp for the result, target is its address */
 389             if (target == NULL_RTX)
 390               {
 391                 tree type0 = TREE_TYPE (exp0);
 392                 tree type1 = TREE_TYPE (exp1);
 393                 int     len0 = int_size_in_bytes (type0);
 394                 int     len1 = int_size_in_bytes (type1);
 395
 396                 if (len0 < 0 && TYPE_ARRAY_MAX_SIZE (type0)
 397                     && TREE_CODE (TYPE_ARRAY_MAX_SIZE (type0)) == INTEGER_CST)
 398                   len0 = TREE_INT_CST_LOW (TYPE_ARRAY_MAX_SIZE (type0));
 399
 400                 if (len1 < 0 && TYPE_ARRAY_MAX_SIZE (type1)
 401                     && TREE_CODE (TYPE_ARRAY_MAX_SIZE (type1)) == INTEGER_CST)
 402                   len1 = TREE_INT_CST_LOW (TYPE_ARRAY_MAX_SIZE (type1));
 403
 404                 if (len0 < 0 || len1 < 0)
 405                   fatal ("internal error - don't know how much space is needed for concatenation");
 406                 target = assign_stack_temp (mode, len0 + len1, 0);
 407                 preserve_temp_slots (target);
 408               }
 409           }
 410         else if (TREE_CODE (type) == SET_TYPE)
 411           {
 412             if (target == NULL_RTX)
 413               {
 414                 target = assign_stack_temp (mode, int_size_in_bytes (type), 0);
 415                 preserve_temp_slots (target);
 416               }
 417           }
 418         else
 419           abort ();
 420
 421         if (GET_CODE (target) == MEM)
 422           targetx = target;
 423         else
 424           targetx = assign_stack_temp (mode, GET_MODE_SIZE (mode), 0);
 425
 426         /* expand 1st operand to a pointer to the array */
 427         op0 = expand_expr (force_addr_of (exp0),
 428                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
 429
 430         /* expand 2nd operand to a pointer to the array */
 431         op1 = expand_expr (force_addr_of (exp1),
 432                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
 433
 434         if (TREE_CODE (type) == SET_TYPE)
 435           {
 436             size0 = expand_expr (powersetlen (exp0),
 437                                  NULL_RTX, VOIDmode, 0);
 438             size1 = expand_expr (powersetlen (exp1),
 439                                  NULL_RTX, VOIDmode, 0);
 440
 441             emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__concatps"),
 442                                0, Pmode, 5, XEXP (targetx, 0), Pmode,
 443                                op0, GET_MODE (op0),
 444                                convert_to_mode (TYPE_MODE (sizetype),
 445                                                 size0, TREE_UNSIGNED (sizetype)),
 446                                TYPE_MODE (sizetype),
 447                                op1, GET_MODE (op1),
 448                                convert_to_mode (TYPE_MODE (sizetype),
 449                                                 size1, TREE_UNSIGNED (sizetype)),
 450                                TYPE_MODE (sizetype));
 451           }
 452         else
 453           {
 454             /* copy left, then right array to target */
 455             emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__concatstring"),
 456                                0, Pmode, 5, XEXP (targetx, 0), Pmode,
 457                                op0, GET_MODE (op0),
 458                                convert_to_mode (TYPE_MODE (sizetype),
 459                                                 size0, TREE_UNSIGNED (sizetype)),
 460                                TYPE_MODE (sizetype),
 461                                op1, GET_MODE (op1),
 462                                convert_to_mode (TYPE_MODE (sizetype),
 463                                                 size1, TREE_UNSIGNED (sizetype)),
 464                                TYPE_MODE (sizetype));
 465           }
 466         if (targetx != target)
 467           emit_move_insn (target, targetx);
 468         return target;
 469       }
 470 \f
 471       /* FIXME: the set_length computed below is a compile-time constant;
 472          you'll need to re-write that part for VARYING bit arrays, and
 473          possibly the set pointer will need to be adjusted to point past
 474          the word containing its dynamic length. */
 475
 476     /* void __notpowerset (char *out, char *src,
 477        unsigned long bitlength) */
 478     case SET_NOT_EXPR:
 479       {
 480
 481         tree expr = TREE_OPERAND (exp, 0);
 482         tree tsize = powersetlen (expr);
 483         rtx targetx;
 484
 485         if (TREE_CODE (TREE_TYPE (expr)) != SET_TYPE)
 486           tsize = fold (build (MULT_EXPR, sizetype, tsize,
 487                                size_int (BITS_PER_UNIT)));
 488
 489         /* expand 1st operand to a pointer to the set */
 490         op0 = expand_expr (force_addr_of (expr),
 491                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
 492
 493         /* build a temp for the result, target is its address */
 494         if (target == NULL_RTX)
 495           {
 496             target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)),
 497                                         int_size_in_bytes (TREE_TYPE (exp)),
 498                                         0);
 499             preserve_temp_slots (target);
 500           }
 501         if (GET_CODE (target) == MEM)
 502           targetx = target;
 503         else
 504           targetx = assign_stack_temp (GET_MODE (target),
 505                                        GET_MODE_SIZE (GET_MODE (target)),
 506                                        0);
 507         emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__notpowerset"),
 508                            0, VOIDmode, 3, XEXP (targetx, 0), Pmode,
 509                            op0, GET_MODE (op0),
 510                            expand_expr (tsize, NULL_RTX, MEM,
 511                                         EXPAND_CONST_ADDRESS),
 512                            TYPE_MODE (long_unsigned_type_node));
 513         if (targetx != target)
 514           emit_move_insn (target, targetx);
 515         return target;
 516       }
 517
 518     case SET_DIFF_EXPR:
 519       lib_func = "__diffpowerset";
 520       goto format_2;
 521
 522     case SET_IOR_EXPR:
 523       lib_func = "__orpowerset";
 524       goto format_2;
 525
 526     case SET_XOR_EXPR:
 527       lib_func = "__xorpowerset";
 528       goto format_2;
 529
 530     /* void __diffpowerset (char *out, char *left, char *right,
 531                             unsigned bitlength) */
 532     case SET_AND_EXPR:
 533       lib_func = "__andpowerset";
 534     format_2:
 535       {
 536         tree expr = TREE_OPERAND (exp, 0);
 537         tree tsize = powersetlen (expr);
 538         rtx targetx;
 539
 540         if (TREE_CODE (TREE_TYPE (expr)) != SET_TYPE)
 541           tsize = fold (build (MULT_EXPR, long_unsigned_type_node,
 542                                tsize,
 543                                size_int (BITS_PER_UNIT)));
 544
 545         /* expand 1st operand to a pointer to the set */
 546         op0 = expand_expr (force_addr_of (expr),
 547                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
 548
 549         /* expand 2nd operand to a pointer to the set */
 550         op1 = expand_expr (force_addr_of (TREE_OPERAND (exp, 1)),
 551                            NULL_RTX, MEM,
 552                            EXPAND_CONST_ADDRESS);
 553
 554 /* FIXME: re-examine this code - the unary operator code above has recently
 555    (93/03/12) been changed a lot.  Should this code also change? */
 556         /* build a temp for the result, target is its address */
 557         if (target == NULL_RTX)
 558           {
 559             target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)),
 560                                         int_size_in_bytes (TREE_TYPE (exp)),
 561                                         0);
 562             preserve_temp_slots (target);
 563           }
 564         if (GET_CODE (target) == MEM)
 565           targetx = target;
 566         else
 567           targetx = assign_stack_temp (GET_MODE (target),
 568                                        GET_MODE_SIZE (GET_MODE (target)), 0);
 569         emit_library_call (gen_rtx(SYMBOL_REF, Pmode, lib_func),
 570                            0, VOIDmode, 4, XEXP (targetx, 0), Pmode,
 571                            op0, GET_MODE (op0), op1, GET_MODE (op1),
 572                            expand_expr (tsize, NULL_RTX, MEM,
 573                                         EXPAND_CONST_ADDRESS),
 574                            TYPE_MODE (long_unsigned_type_node));
 575         if (target != targetx)
 576           emit_move_insn (target, targetx);
 577         return target;
 578       }
 579
 580     case SET_IN_EXPR:
 581       {
 582         tree set = TREE_OPERAND (exp, 1);
 583         tree pos = convert (long_unsigned_type_node, TREE_OPERAND (exp, 0));
 584         tree set_type = TREE_TYPE (set);
 585         tree set_length = discrete_count (TYPE_DOMAIN (set_type));
 586         tree min_val = convert (long_integer_type_node,
 587                                 TYPE_MIN_VALUE (TYPE_DOMAIN (set_type)));
 588         tree fcall;
 589
 590         /* FIXME: Function-call not needed if pos and width are constant! */
 591         if (! mark_addressable (set))
 592           {
 593             error ("powerset is not addressable");
 594             return const0_rtx;
 595           }
 596         /* we use different functions for bitstrings and powersets */
 597         if (CH_BOOLS_TYPE_P (set_type))
 598           fcall =
 599              build_chill_function_call (
 600                lookup_name (get_identifier ("__inbitstring")),
 601                  tree_cons (NULL_TREE,
 602                    convert (long_unsigned_type_node, pos),
 603                      tree_cons (NULL_TREE,
 604                        build1 (ADDR_EXPR, build_pointer_type (set_type), set),
 605                          tree_cons (NULL_TREE,
 606                            convert (long_unsigned_type_node, set_length),
 607                              tree_cons (NULL_TREE, min_val,
 608                                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
 609                                  build_tree_list (NULL_TREE, get_chill_linenumber ())))))));
 610         else
 611           fcall =
 612              build_chill_function_call (
 613                lookup_name (get_identifier ("__inpowerset")),
 614                  tree_cons (NULL_TREE,
 615                    convert (long_unsigned_type_node, pos),
 616                      tree_cons (NULL_TREE,
 617                        build1 (ADDR_EXPR, build_pointer_type (set_type), set),
 618                          tree_cons (NULL_TREE,
 619                            convert (long_unsigned_type_node, set_length),
 620                              build_tree_list (NULL_TREE, min_val)))));
 621         return expand_expr (fcall, NULL_RTX, VOIDmode, 0);
 622       }
 623
 624     case PACKED_ARRAY_REF:
 625       {
 626         tree array = TREE_OPERAND (exp, 0);
 627         tree pos = save_expr (TREE_OPERAND (exp, 1));
 628         tree array_type = TREE_TYPE (array);
 629         tree array_length = discrete_count (TYPE_DOMAIN (array_type));
 630         tree min_val = convert (long_integer_type_node,
 631                                 TYPE_MIN_VALUE (TYPE_DOMAIN (array_type)));
 632         tree fcall;
 633
 634         /* FIXME: Function-call not needed if pos and width are constant! */
 635         /* TODO: make sure this makes sense. */
 636         if (! mark_addressable (array))
 637           {
 638             error ("array is not addressable");
 639             return const0_rtx;
 640           }
 641         fcall =
 642           build_chill_function_call (
 643                lookup_name (get_identifier ("__inpowerset")),
 644                  tree_cons (NULL_TREE,
 645                    convert (long_unsigned_type_node, pos),
 646                      tree_cons (NULL_TREE,
 647                        build1 (ADDR_EXPR, build_pointer_type (array_type), array),
 648                          tree_cons (NULL_TREE,
 649                            convert (long_unsigned_type_node, array_length),
 650                              build_tree_list (NULL_TREE, min_val)))));
 651         return expand_expr (fcall, NULL_RTX, VOIDmode, 0);
 652       }
 653
 654     case UNDEFINED_EXPR:
 655       if (target == 0)
 656         {
 657           target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)),
 658                                       int_size_in_bytes (TREE_TYPE (exp)), 0);
 659           preserve_temp_slots (target);
 660         }
 661       /* We don't actually need to *do* anything ... */
 662       return target;
 663
 664     default:
 665       break;
 666     }
 667
 668   /* NOTREACHED */
 669   return NULL;
 670 }
 671 \f
 672 /* Check that the argument list has a length in [min_length .. max_length].
 673    (max_length == -1 means "infinite".)
 674    If so return the actual length.
 675    Otherwise, return an error message and return -1. */
 676
 677 static int
 678 check_arglist_length (args, min_length, max_length, name)
 679      tree args;
 680      int min_length;
 681      int max_length;
 682      tree name;
 683 {
 684   int length = list_length (args);
 685   if (length < min_length)
 686     error ("Too few arguments in call to `%s'", IDENTIFIER_POINTER (name));
 687   else if (max_length != -1 && length > max_length)
 688     error ("Too many arguments in call to `%s'", IDENTIFIER_POINTER (name));
 689   else
 690     return length;
 691   return -1;
 692 }
 693 \f
 694 /*
 695  * This is the code from c-typeck.c, with the C-specific cruft
 696  * removed (possibly I just didn't understand it, but it was
 697  * apparently simply discarding part of my LIST).
 698  */
 699 static tree
 700 internal_build_compound_expr (list, first_p)
 701      tree list;
 702      int first_p ATTRIBUTE_UNUSED;
 703 {
 704   register tree rest;
 705
 706   if (TREE_CHAIN (list) == 0)
 707     return TREE_VALUE (list);
 708
 709   rest = internal_build_compound_expr (TREE_CHAIN (list), FALSE);
 710
 711   if (! TREE_SIDE_EFFECTS (TREE_VALUE (list)))
 712     return rest;
 713
 714   return build (COMPOUND_EXPR, TREE_TYPE (rest), TREE_VALUE (list), rest);
 715 }
 716
 717
 718 /* Given a list of expressions, return a compound expression
 719    that performs them all and returns the value of the last of them.  */
 720 /* FIXME: this should be merged with the C version */
 721 tree
 722 build_chill_compound_expr (list)
 723      tree list;
 724 {
 725   return internal_build_compound_expr (list, TRUE);
 726 }
 727 \f
 728 /* Given an expression PTR for a pointer, return an expression
 729    for the value pointed to.
 730    do_empty_check is 0, don't perform a NULL pointer check,
 731    else do it. */
 732
 733 tree
 734 build_chill_indirect_ref (ptr, mode, do_empty_check)
 735      tree ptr;
 736      tree mode;
 737      int do_empty_check;
 738 {
 739   register tree type;
 740
 741   if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
 742     return ptr;
 743   if (mode != NULL_TREE && TREE_CODE (mode) == ERROR_MARK)
 744     return error_mark_node;
 745
 746   type = TREE_TYPE (ptr);
 747
 748   if (TREE_CODE (type) == REFERENCE_TYPE)
 749     {
 750       type = TREE_TYPE (type);
 751       ptr = convert (type, ptr);
 752     }
 753
 754   /* check for ptr is really a POINTER */
 755   if (TREE_CODE (type) != POINTER_TYPE)
 756     {
 757       error ("cannot dereference, not a pointer.");
 758       return error_mark_node;
 759     }
 760
 761   if (mode && TREE_CODE (mode) == IDENTIFIER_NODE)
 762     {
 763       tree decl = lookup_name (mode);
 764       if (decl == NULL_TREE || TREE_CODE (decl) != TYPE_DECL)
 765         {
 766           if (pass == 2)
 767             error ("missing '.' operator or undefined mode name `%s'.",
 768                    IDENTIFIER_POINTER (mode));
 769 #if 0
 770           error ("You have forgotten the '.' operator which must");
 771           error (" precede a STRUCT field reference, or `%s' is an undefined mode",
 772                  IDENTIFIER_POINTER (mode));
 773 #endif
 774           return error_mark_node;
 775         }
 776     }
 777
 778   if (mode)
 779     {
 780       mode = get_type_of (mode);
 781       ptr = convert (build_pointer_type (mode), ptr);
 782     }
 783   else if (type == ptr_type_node)
 784     {
 785       error ("Can't dereference PTR value using unary `->'.");
 786       return error_mark_node;
 787     }
 788
 789   if (do_empty_check)
 790     ptr = check_non_null (ptr);
 791
 792   type = TREE_TYPE (ptr);
 793
 794   if (TREE_CODE (type) == POINTER_TYPE)
 795     {
 796       if (TREE_CODE (ptr) == ADDR_EXPR
 797           && !flag_volatile
 798           && (TREE_TYPE (TREE_OPERAND (ptr, 0))
 799               == TREE_TYPE (type)))
 800         return TREE_OPERAND (ptr, 0);
 801       else
 802         {
 803           tree t = TREE_TYPE (type);
 804           register tree ref = build1 (INDIRECT_REF,
 805                                       TYPE_MAIN_VARIANT (t), ptr);
 806
 807           if (TYPE_SIZE (t) == 0 && TREE_CODE (t) != ARRAY_TYPE)
 808             {
 809               error ("dereferencing pointer to incomplete type");
 810               return error_mark_node;
 811             }
 812           if (TREE_CODE (t) == VOID_TYPE)
 813             warning ("dereferencing `void *' pointer");
 814
 815           /* We *must* set TREE_READONLY when dereferencing a pointer to const,
 816              so that we get the proper error message if the result is used
 817              to assign to.  Also, &* is supposed to be a no-op.
 818              And ANSI C seems to specify that the type of the result
 819              should be the const type.  */
 820           /* A de-reference of a pointer to const is not a const.  It is valid
 821              to change it via some other pointer.  */
 822           TREE_READONLY (ref) = TYPE_READONLY (t);
 823           TREE_SIDE_EFFECTS (ref)
 824             = TYPE_VOLATILE (t) || TREE_SIDE_EFFECTS (ptr) || flag_volatile;
 825           TREE_THIS_VOLATILE (ref) = TYPE_VOLATILE (t) || flag_volatile;
 826           return ref;
 827         }
 828     }
 829   else if (TREE_CODE (ptr) != ERROR_MARK)
 830     error ("invalid type argument of `->'");
 831   return error_mark_node;
 832 }
 833
 834 /* NODE is a COMPONENT_REF whose mode is an IDENTIFIER,
 835    which is replaced by the proper FIELD_DECL.
 836    Also do the right thing for variant records. */
 837
 838 tree
 839 resolve_component_ref (node)
 840      tree node;
 841 {
 842   tree datum = TREE_OPERAND (node, 0);
 843   tree field_name = TREE_OPERAND (node, 1);
 844   tree type = TREE_TYPE (datum);
 845   tree field;
 846   if (TREE_CODE (datum) == ERROR_MARK)
 847     return error_mark_node;
 848   if (TREE_CODE (type) == REFERENCE_TYPE)
 849     {
 850       type = TREE_TYPE (type);
 851       TREE_OPERAND (node, 0) = datum = convert (type, datum);
 852     }
 853   if (TREE_CODE (type) != RECORD_TYPE)
 854     {
 855       error ("operand of '.' is not a STRUCT");
 856       return error_mark_node;
 857     }
 858
 859   TREE_READONLY (node) = TREE_READONLY (datum);
 860   TREE_SIDE_EFFECTS (node) = TREE_SIDE_EFFECTS (datum);
 861
 862   for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
 863     {
 864       if (TREE_CODE (TREE_TYPE (field)) == UNION_TYPE)
 865         {
 866           tree variant;
 867           for (variant = TYPE_FIELDS (TREE_TYPE (field));
 868                variant;  variant = TREE_CHAIN (variant))
 869             {
 870               tree vfield;
 871               for (vfield = TYPE_FIELDS (TREE_TYPE (variant));
 872                    vfield; vfield = TREE_CHAIN (vfield))
 873                 {
 874                   if (DECL_NAME (vfield) == field_name)
 875                     { /* Found a variant field */
 876                       datum = build (COMPONENT_REF, TREE_TYPE (field),
 877                                      datum, field);
 878                       datum = build (COMPONENT_REF, TREE_TYPE (variant),
 879                                      datum, variant);
 880                       TREE_OPERAND (node, 0) = datum;
 881                       TREE_OPERAND (node, 1) = vfield;
 882                       TREE_TYPE (node) = TREE_TYPE (vfield);
 883                       TREE_READONLY (node) |= TYPE_READONLY (TREE_TYPE (node));
 884 #if 0
 885                       if (flag_testing_tags)
 886                         {
 887                           tree tagtest = NOT IMPLEMENTED;
 888                           tree tagf = ridpointers[(int) RID_RANGEFAIL];
 889                           node = check_expression (node, tagtest,
 890                                                    tagf);
 891                         }
 892 #endif
 893                       return node;
 894                     }
 895                 }
 896             }
 897         }
 898
 899       if (DECL_NAME (field) == field_name)
 900         { /* Found a fixed field */
 901           TREE_OPERAND (node, 1) = field;
 902           TREE_TYPE (node) = TREE_TYPE (field);
 903           TREE_READONLY (node) |= TYPE_READONLY (TREE_TYPE (node));
 904           return fold (node);
 905         }
 906     }
 907
 908   error ("No field named `%s'", IDENTIFIER_POINTER (field_name));
 909   return error_mark_node;
 910 }
 911
 912 tree
 913 build_component_ref (datum, field_name)
 914   tree datum, field_name;
 915 {
 916   tree node = build_nt (COMPONENT_REF, datum, field_name);
 917   if (pass != 1)
 918     node = resolve_component_ref (node);
 919   return node;
 920 }
 921
 922 /*
 923  function checks (for build_chill_component_ref) if a given
 924  type is really an instance type. CH_IS_INSTANCE_MODE is not
 925  strict enough in this case, i.e. SYNMODE foo = STRUCT (a, b UINT)
 926  is compatible to INSTANCE. */
 927
 928 static int
 929 is_really_instance (type)
 930      tree type;
 931 {
 932   tree decl = TYPE_NAME (type);
 933
 934   if (decl == NULL_TREE)
 935     /* this is not an instance */
 936     return 0;
 937
 938   if (DECL_NAME (decl) == ridpointers[(int)RID_INSTANCE])
 939     /* this is an instance */
 940     return 1;
 941
 942   if (TYPE_FIELDS (type) == TYPE_FIELDS (instance_type_node))
 943     /* we have a NEWMODE'd instance */
 944     return 1;
 945
 946   return 0;
 947 }
 948
 949 /* This function is called by the parse.
 950    Here we check if the user tries to access a field in a type which is
 951    layouted as a structure but isn't like INSTANCE, BUFFER, EVENT, ASSOCIATION,
 952    ACCESS, TEXT, or VARYING array or character string.
 953    We don't do this in build_component_ref cause this function gets
 954    called from the compiler to access fields in one of the above mentioned
 955    modes. */
 956 tree
 957 build_chill_component_ref (datum, field_name)
 958      tree datum, field_name;
 959 {
 960   tree type = TREE_TYPE (datum);
 961   if ((type != NULL_TREE && TREE_CODE (type) == RECORD_TYPE) &&
 962       ((CH_IS_INSTANCE_MODE (type) && is_really_instance (type)) ||
 963         CH_IS_BUFFER_MODE (type) ||
 964        CH_IS_EVENT_MODE (type) || CH_IS_ASSOCIATION_MODE (type) ||
 965        CH_IS_ACCESS_MODE (type) || CH_IS_TEXT_MODE (type) ||
 966        chill_varying_type_p (type)))
 967     {
 968       error ("operand of '.' is not a STRUCT");
 969       return error_mark_node;
 970     }
 971   return build_component_ref (datum, field_name);
 972 }
 973 \f
 974 /*
 975  * Check for invalid binary operands & unary operands
 976  * RIGHT is 1 if checking right operand or unary operand;
 977  * it is 0 if checking left operand.
 978  *
 979  * return 1 if the given operand is NOT compatible as the
 980  * operand of the given operator
 981  *
 982  * return 0 if they might be compatible
 983  */
 984 static int
 985 invalid_operand (code, type, right)
 986      enum chill_tree_code code;
 987      tree type;
 988      int right; /* 1 if right operand */
 989 {
 990   switch ((int)code)
 991     {
 992     case ADDR_EXPR:
 993       break;
 994     case BIT_AND_EXPR:
 995     case BIT_IOR_EXPR:
 996     case BIT_NOT_EXPR:
 997     case BIT_XOR_EXPR:
 998       goto relationals;
 999     case CASE_EXPR:
1000       break;
1001     case CEIL_MOD_EXPR:
1002       goto numerics;
1003     case CONCAT_EXPR:           /* must be static or varying char array */
1004       if (TREE_CODE (type) == CHAR_TYPE)
1005         return 0;
1006       if (TREE_CODE (type) == ARRAY_TYPE
1007            && TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
1008         return 0;
1009       if (!chill_varying_type_p (type))
1010           return 1;
1011       if (TREE_CODE (TREE_TYPE (CH_VARYING_ARRAY_TYPE (type)))
1012             == CHAR_TYPE)
1013         return 0;
1014       else
1015         return 1;
1016     /* note: CHILL conditional expressions (COND_EXPR) won't come
1017      *  through here; they're routed straight to C-specific code */
1018     case EQ_EXPR:
1019       return 0;                  /* ANYTHING can be compared equal */
1020     case FLOOR_MOD_EXPR:
1021       if (TREE_CODE (type) == REAL_TYPE)
1022         return 1;
1023       goto numerics;
1024     case GE_EXPR:
1025     case GT_EXPR:
1026       goto relatables;
1027     case SET_IN_EXPR:
1028       if (TREE_CODE (type) == SET_TYPE)
1029         return 0;
1030       else
1031         return 1;
1032     case PACKED_ARRAY_REF:
1033       if (TREE_CODE (type) == ARRAY_TYPE)
1034         return 0;
1035       else
1036         return 1;
1037     case LE_EXPR:
1038     case LT_EXPR:
1039     relatables:
1040       switch ((int)TREE_CODE(type))   /* right operand must be set/bitarray type */
1041         {
1042         case ARRAY_TYPE:
1043           if (TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
1044             return 0;
1045           else
1046             return 1;
1047         case BOOLEAN_TYPE:
1048         case CHAR_TYPE:
1049         case COMPLEX_TYPE:
1050         case ENUMERAL_TYPE:
1051         case INTEGER_TYPE:
1052         case OFFSET_TYPE:
1053         case POINTER_TYPE:
1054         case REAL_TYPE:
1055         case SET_TYPE:
1056           return 0;
1057         case FILE_TYPE:
1058         case FUNCTION_TYPE:
1059         case GRANT_TYPE:
1060         case LANG_TYPE:
1061         case METHOD_TYPE:
1062           return 1;
1063         case RECORD_TYPE:
1064           if (chill_varying_type_p (type)
1065               && TREE_CODE (TREE_TYPE (CH_VARYING_ARRAY_TYPE (type))) == CHAR_TYPE)
1066             return 0;
1067           else
1068             return 1;
1069         case REFERENCE_TYPE:
1070         case SEIZE_TYPE:
1071         case UNION_TYPE:
1072         case VOID_TYPE:
1073           return 1;
1074         }
1075       break;
1076     case MINUS_EXPR:
1077     case MULT_EXPR:
1078       goto numerics;
1079     case NEGATE_EXPR:
1080       if (TREE_CODE (type) == BOOLEAN_TYPE)
1081         return 0;
1082       else
1083         goto numerics;
1084     case NE_EXPR:
1085       return 0;                  /* ANYTHING can be compared unequal */
1086     case NOP_EXPR:
1087       return 0;                  /* ANYTHING can be converted */
1088     case PLUS_EXPR:
1089     numerics:
1090       switch ((int)TREE_CODE(type))   /* left operand must be discrete type */
1091         {
1092         case ARRAY_TYPE:
1093           if (right || TREE_CODE (TREE_TYPE (type)) != BOOLEAN_TYPE)
1094             return 1;
1095           else
1096             return 0;
1097         case CHAR_TYPE:
1098           return right;
1099         case BOOLEAN_TYPE:
1100         case COMPLEX_TYPE:
1101         case FILE_TYPE:
1102         case FUNCTION_TYPE:
1103         case GRANT_TYPE:
1104         case LANG_TYPE:
1105         case METHOD_TYPE:
1106         case RECORD_TYPE:
1107         case REFERENCE_TYPE:
1108         case SEIZE_TYPE:
1109         case UNION_TYPE:
1110         case VOID_TYPE:
1111           return 1;
1112         case ENUMERAL_TYPE:
1113         case INTEGER_TYPE:
1114         case OFFSET_TYPE:
1115         case POINTER_TYPE:
1116         case REAL_TYPE:
1117         case SET_TYPE:
1118           return 0;
1119         }
1120       break;
1121     case RANGE_EXPR:
1122       break;
1123
1124     case REPLICATE_EXPR:
1125       switch ((int)TREE_CODE(type))   /* right operand must be set/bitarray type */
1126         {
1127         case COMPLEX_TYPE:
1128         case FILE_TYPE:
1129         case FUNCTION_TYPE:
1130         case GRANT_TYPE:
1131         case LANG_TYPE:
1132         case METHOD_TYPE:
1133         case OFFSET_TYPE:
1134         case POINTER_TYPE:
1135         case RECORD_TYPE:
1136         case REAL_TYPE:
1137         case SEIZE_TYPE:
1138         case UNION_TYPE:
1139         case VOID_TYPE:
1140           return 1;
1141         case ARRAY_TYPE:
1142         case BOOLEAN_TYPE:
1143         case CHAR_TYPE:
1144         case ENUMERAL_TYPE:
1145         case INTEGER_TYPE:
1146         case REFERENCE_TYPE:
1147         case SET_TYPE:
1148           return 0;
1149         }
1150
1151     case TRUNC_DIV_EXPR:
1152       goto numerics;
1153     case TRUNC_MOD_EXPR:
1154       if (TREE_CODE (type) == REAL_TYPE)
1155         return 1;
1156       goto numerics;
1157     case TRUTH_ANDIF_EXPR:
1158     case TRUTH_AND_EXPR:
1159     case TRUTH_NOT_EXPR:
1160     case TRUTH_ORIF_EXPR:
1161     case TRUTH_OR_EXPR:
1162     relationals:
1163       switch ((int)TREE_CODE(type))   /* left operand must be discrete type */
1164         {
1165         case ARRAY_TYPE:
1166         case CHAR_TYPE:
1167         case COMPLEX_TYPE:
1168         case ENUMERAL_TYPE:
1169         case FILE_TYPE:
1170         case FUNCTION_TYPE:
1171         case GRANT_TYPE:
1172         case INTEGER_TYPE:
1173         case LANG_TYPE:
1174         case METHOD_TYPE:
1175         case OFFSET_TYPE:
1176         case POINTER_TYPE:
1177         case REAL_TYPE:
1178         case RECORD_TYPE:
1179         case REFERENCE_TYPE:
1180         case SEIZE_TYPE:
1181         case UNION_TYPE:
1182         case VOID_TYPE:
1183           return 1;
1184         case BOOLEAN_TYPE:
1185         case SET_TYPE:
1186           return 0;
1187         }
1188       break;
1189
1190     default:
1191       return 1;       /* perhaps you forgot to add a new DEFTREECODE? */
1192     }
1193   return 1;
1194 }
1195
1196
1197 static int
1198 invalid_right_operand (code, type)
1199      enum chill_tree_code code;
1200      tree type;
1201 {
1202   return invalid_operand (code, type, 1);
1203 }
1204 \f
1205 tree
1206 build_chill_abs (expr)
1207      tree expr;
1208 {
1209   tree temp;
1210
1211   if (TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE
1212       || discrete_type_p (TREE_TYPE (expr)))
1213     temp = fold (build1 (ABS_EXPR, TREE_TYPE (expr), expr));
1214   else
1215     {
1216       error("ABS argument must be discrete or real mode");
1217       return error_mark_node;
1218     }
1219   /* FIXME: should call
1220    * cond_type_range_exception (temp);
1221    */
1222   return temp;
1223 }
1224
1225 static tree
1226 build_chill_abstime (exprlist)
1227      tree exprlist;
1228 {
1229   int  mask = 0, i, numargs;
1230   tree args = NULL_TREE;
1231   tree filename, lineno;
1232   int  had_errors = 0;
1233   tree tmp;
1234
1235   if (exprlist != NULL_TREE && TREE_CODE (exprlist) == ERROR_MARK)
1236     return error_mark_node;
1237
1238   /* check for integer expressions */
1239   i = 1;
1240   tmp = exprlist;
1241   while (tmp != NULL_TREE)
1242     {
1243       tree exp = TREE_VALUE (tmp);
1244
1245       if (exp == NULL_TREE || TREE_CODE (exp) == ERROR_MARK)
1246         had_errors = 1;
1247       else if (TREE_CODE (TREE_TYPE (exp)) != INTEGER_TYPE)
1248         {
1249           error ("argument %d to ABSTIME must be of integer type.", i);
1250           had_errors = 1;
1251         }
1252       tmp = TREE_CHAIN (tmp);
1253       i++;
1254     }
1255   if (had_errors)
1256     return error_mark_node;
1257
1258   numargs = list_length (exprlist);
1259   for (i = 0; i < numargs; i++)
1260     mask |= (1 << i);
1261
1262   /* make it all arguments */
1263   for (i = numargs; i < 6; i++)
1264     exprlist = tree_cons (NULL_TREE, integer_zero_node, exprlist);
1265
1266   args = tree_cons (NULL_TREE, build_int_2 (mask, 0), exprlist);
1267
1268   filename = force_addr_of (get_chill_filename ());
1269   lineno = get_chill_linenumber ();
1270   args = chainon (args, tree_cons (NULL_TREE, filename,
1271                           tree_cons (NULL_TREE, lineno, NULL_TREE)));
1272
1273   return build_chill_function_call (
1274     lookup_name (get_identifier ("_abstime")), args);
1275 }
1276
1277
1278 static tree
1279 build_allocate_memory_call (ptr, size)
1280   tree ptr, size;
1281 {
1282   int err = 0;
1283
1284   /* check for ptr is referable */
1285   if (! CH_REFERABLE (ptr))
1286     {
1287       error ("parameter 1 must be referable.");
1288       err++;
1289     }
1290    /* check for pointer */
1291   else if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
1292     {
1293       error ("mode mismatch in parameter 1.");
1294       err++;
1295     }
1296
1297   /* check for size > 0 if it is a constant */
1298   if (TREE_CODE (size) == INTEGER_CST && TREE_INT_CST_LOW (size) <= 0)
1299     {
1300       error ("parameter 2 must be a positive integer.");
1301       err++;
1302     }
1303   if (err)
1304     return error_mark_node;
1305
1306   if (TREE_TYPE (ptr) != ptr_type_node)
1307     ptr = build_chill_cast (ptr_type_node, ptr);
1308
1309   return build_chill_function_call (
1310     lookup_name (get_identifier ("_allocate_memory")),
1311            tree_cons (NULL_TREE, ptr,
1312              tree_cons (NULL_TREE, size,
1313                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
1314                  tree_cons (NULL_TREE, get_chill_linenumber (),
1315                             NULL_TREE)))));
1316 }
1317
1318
1319 static tree
1320 build_allocate_global_memory_call (ptr, size)
1321   tree ptr, size;
1322 {
1323   int err = 0;
1324
1325   /* check for ptr is referable */
1326   if (! CH_REFERABLE (ptr))
1327     {
1328       error ("parameter 1 must be referable.");
1329       err++;
1330     }
1331   /* check for pointer */
1332   else if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
1333     {
1334       error ("mode mismatch in parameter 1.");
1335       err++;
1336     }
1337
1338   /* check for size > 0 if it is a constant */
1339   if (TREE_CODE (size) == INTEGER_CST && TREE_INT_CST_LOW (size) <= 0)
1340     {
1341       error ("parameter 2 must be a positive integer.");
1342       err++;
1343     }
1344   if (err)
1345     return error_mark_node;
1346
1347   if (TREE_TYPE (ptr) != ptr_type_node)
1348     ptr = build_chill_cast (ptr_type_node, ptr);
1349
1350   return build_chill_function_call (
1351     lookup_name (get_identifier ("_allocate_global_memory")),
1352            tree_cons (NULL_TREE, ptr,
1353              tree_cons (NULL_TREE, size,
1354                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
1355                  tree_cons (NULL_TREE, get_chill_linenumber (),
1356                             NULL_TREE)))));
1357 }
1358
1359
1360 static tree
1361 build_return_memory (ptr)
1362   tree ptr;
1363 {
1364   /* check input */
1365   if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
1366       return error_mark_node;
1367
1368   /* check for pointer */
1369   if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
1370     {
1371       error ("mode mismatch in parameter 1.");
1372       return error_mark_node;
1373     }
1374
1375   if (TREE_TYPE (ptr) != ptr_type_node)
1376     ptr = build_chill_cast (ptr_type_node, ptr);
1377
1378   return build_chill_function_call (
1379     lookup_name (get_identifier ("_return_memory")),
1380       tree_cons (NULL_TREE, ptr,
1381         tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
1382           tree_cons (NULL_TREE, get_chill_linenumber (),
1383                      NULL_TREE))));
1384 }
1385
1386
1387 /* Compute the number of runtime members of the
1388  * given powerset.
1389  */
1390 tree
1391 build_chill_card (powerset)
1392      tree powerset;
1393 {
1394   if (pass == 2)
1395     {
1396       tree temp;
1397       tree card_func = lookup_name (get_identifier ("__cardpowerset"));
1398
1399       if (powerset == NULL_TREE || TREE_CODE (powerset) == ERROR_MARK)
1400         return error_mark_node;
1401
1402       if (TREE_CODE (powerset) == IDENTIFIER_NODE)
1403         powerset = lookup_name (powerset);
1404
1405       if (TREE_CODE (TREE_TYPE(powerset)) == SET_TYPE)
1406         { int size;
1407
1408           /* Do constant folding, if possible. */
1409           if (TREE_CODE (powerset) == CONSTRUCTOR
1410               && TREE_CONSTANT (powerset)
1411               && (size = int_size_in_bytes (TREE_TYPE (powerset))) >= 0)
1412             {
1413               int bit_size = size * BITS_PER_UNIT;
1414               char* buffer = (char*) alloca (bit_size);
1415               temp = get_set_constructor_bits (powerset, buffer, bit_size);
1416               if (!temp)
1417                 { int i;
1418                   int count = 0;
1419                   for (i = 0; i < bit_size; i++)
1420                     if (buffer[i])
1421                       count++;
1422                   temp = build_int_2 (count, 0);
1423                   TREE_TYPE (temp) = TREE_TYPE (TREE_TYPE (card_func));
1424                   return temp;
1425                 }
1426             }
1427           temp = build_chill_function_call (card_func,
1428                      tree_cons (NULL_TREE, force_addr_of (powerset),
1429                        tree_cons (NULL_TREE, powersetlen (powerset), NULL_TREE)));
1430           /* FIXME: should call
1431            * cond_type_range_exception (op0);
1432            */
1433           return temp;
1434         }
1435       error("CARD argument must be powerset mode");
1436       return error_mark_node;
1437     }
1438   return NULL_TREE;
1439 }
1440
1441 /* function to build the type needed for the DESCR-built-in
1442  */
1443
1444 void build_chill_descr_type ()
1445 {
1446   tree decl1, decl2;
1447
1448   if (descr_type != NULL_TREE)
1449     /* already done */
1450     return;
1451
1452   decl1 = build_decl (FIELD_DECL, get_identifier ("datap"), ptr_type_node);
1453   decl2 = build_decl (FIELD_DECL, get_identifier ("len"),
1454                       TREE_TYPE (lookup_name (
1455                                               get_identifier ((ignore_case || ! special_UC) ? "ulong" : "ULONG"))));
1456   TREE_CHAIN (decl1) = decl2;
1457   TREE_CHAIN (decl2) = NULL_TREE;
1458   decl2 = build_chill_struct_type (decl1);
1459   descr_type = build_decl (TYPE_DECL, get_identifier ("__tmp_DESCR_type"), decl2);
1460   pushdecl (descr_type);
1461   DECL_SOURCE_LINE (descr_type) = 0;
1462   satisfy_decl (descr_type, 0);
1463 }
1464
1465 /* build a pointer to a descriptor.
1466  * descriptor = STRUCT (datap PTR,
1467  *                      len ULONG);
1468  * This descriptor is build in variable descr_type.
1469  */
1470
1471 tree
1472 build_chill_descr (expr)
1473     tree expr;
1474 {
1475   if (pass == 2)
1476     {
1477       tree tuple, decl, descr_var, datap, len, tmp;
1478       int is_static;
1479
1480       if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1481         return error_mark_node;
1482
1483       /* check for expression is referable */
1484       if (! CH_REFERABLE (expr))
1485         {
1486           error ("expression for DESCR-builtin must be referable.");
1487           return error_mark_node;
1488         }
1489
1490       mark_addressable (expr);
1491 #if 0
1492       datap = build1 (ADDR_EXPR, build_chill_pointer_type (descr_type), expr);
1493 #else
1494       datap = build_chill_arrow_expr (expr, 1);
1495 #endif
1496       len = size_in_bytes (TREE_TYPE (expr));
1497
1498       descr_var = get_unique_identifier ("DESCR");
1499       tuple = build_nt (CONSTRUCTOR, NULL_TREE,
1500                         tree_cons (NULL_TREE, datap,
1501                                    tree_cons (NULL_TREE, len, NULL_TREE)));
1502
1503       is_static = (current_function_decl == global_function_decl) && TREE_STATIC (expr);
1504       decl = decl_temp1 (descr_var, TREE_TYPE (descr_type), is_static,
1505                          tuple, 0, 0);
1506 #if 0
1507       tmp = force_addr_of (decl);
1508 #else
1509       tmp = build_chill_arrow_expr (decl, 1);
1510 #endif
1511       return tmp;
1512     }
1513   return NULL_TREE;
1514 }
1515
1516 /* this function process the builtin's
1517    MILLISECS, SECS, MINUTES, HOURS and DAYS.
1518    The built duration value is in milliseconds. */
1519
1520 static tree
1521 build_chill_duration (expr, multiplier, fnname, maxvalue)
1522      tree           expr;
1523      unsigned long  multiplier;
1524      tree           fnname;
1525      unsigned long  maxvalue;
1526 {
1527   tree temp;
1528
1529   if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1530     return error_mark_node;
1531
1532   if (TREE_CODE (TREE_TYPE (expr)) != INTEGER_TYPE)
1533     {
1534       error ("argument to `%s' must be of integer type.", IDENTIFIER_POINTER (fnname));
1535       return error_mark_node;
1536     }
1537
1538   temp = convert (duration_timing_type_node, expr);
1539   temp = fold (build (MULT_EXPR, duration_timing_type_node,
1540                       temp, build_int_2 (multiplier, 0)));
1541
1542   if (range_checking)
1543     temp = check_range (temp, expr, integer_zero_node, build_int_2 (maxvalue, 0));
1544
1545   return temp;
1546 }
1547
1548 /* build function call to one of the floating point functions */
1549 static tree
1550 build_chill_floatcall (expr, chillname, funcname)
1551      tree expr;
1552      const char *chillname;
1553      const char *funcname;
1554 {
1555   tree result;
1556   tree type;
1557
1558   if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1559     return error_mark_node;
1560
1561   /* look if expr is a REAL_TYPE */
1562   type = TREE_TYPE (expr);
1563   if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
1564     return error_mark_node;
1565   if (TREE_CODE (type) != REAL_TYPE)
1566     {
1567       error ("argument 1 to `%s' must be of floating point mode", chillname);
1568       return error_mark_node;
1569     }
1570   result = build_chill_function_call (
1571              lookup_name (get_identifier (funcname)),
1572                tree_cons (NULL_TREE, expr, NULL_TREE));
1573   return result;
1574 }
1575
1576 /* common function for ALLOCATE and GETSTACK */
1577 static tree
1578 build_allocate_getstack (mode, value, chill_name, fnname, filename, linenumber)
1579      tree mode;
1580      tree value;
1581      const char *chill_name;
1582      const char *fnname;
1583      tree filename;
1584      tree linenumber;
1585 {
1586   tree type, result;
1587   tree expr = NULL_TREE;
1588   tree args, tmpvar, fncall, ptr, outlist = NULL_TREE;
1589
1590   if (mode == NULL_TREE || TREE_CODE (mode) == ERROR_MARK)
1591     return error_mark_node;
1592
1593   if (TREE_CODE (mode) == TYPE_DECL)
1594     type = TREE_TYPE (mode);
1595   else
1596     type = mode;
1597
1598   /* check if we have a mode */
1599   if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
1600     {
1601       error ("First argument to `%s' must be a mode", chill_name);
1602       return error_mark_node;
1603     }
1604
1605   /* check if we have a value if type is READonly */
1606   if (TYPE_READONLY_PROPERTY (type) && value == NULL_TREE)
1607     {
1608       error ("READonly modes for %s must have a value", chill_name);
1609       return error_mark_node;
1610     }
1611
1612   if (value != NULL_TREE)
1613     {
1614       if (TREE_CODE (value) == ERROR_MARK)
1615         return error_mark_node;
1616       expr = chill_convert_for_assignment (type, value, "assignment");
1617     }
1618
1619   /* build function arguments */
1620   if (filename == NULL_TREE)
1621     args = tree_cons (NULL_TREE, size_in_bytes (type), NULL_TREE);
1622   else
1623     args = tree_cons (NULL_TREE, size_in_bytes (type),
1624              tree_cons (NULL_TREE, force_addr_of (filename),
1625                tree_cons (NULL_TREE, linenumber, NULL_TREE)));
1626
1627   ptr = build_chill_pointer_type (type);
1628   tmpvar = decl_temp1 (get_unique_identifier (chill_name),
1629                        ptr, 0, NULL_TREE, 0, 0);
1630   fncall = build_chill_function_call (
1631              lookup_name (get_identifier (fnname)), args);
1632   outlist = tree_cons (NULL_TREE,
1633                build_chill_modify_expr (tmpvar, fncall), outlist);
1634   if (expr == NULL_TREE)
1635     {
1636       /* set allocated memory to 0 */
1637       fncall = build_chill_function_call (
1638                  lookup_name (get_identifier ("memset")),
1639                    tree_cons (NULL_TREE, convert (ptr_type_node, tmpvar),
1640                      tree_cons (NULL_TREE, integer_zero_node,
1641                        tree_cons (NULL_TREE, size_in_bytes (type), NULL_TREE))));
1642       outlist = tree_cons (NULL_TREE, fncall, outlist);
1643     }
1644   else
1645     {
1646       /* write the init value to allocated memory */
1647       outlist = tree_cons (NULL_TREE,
1648                   build_chill_modify_expr (build_chill_indirect_ref (tmpvar, NULL_TREE, 0),
1649                                            expr),
1650                            outlist);
1651     }
1652   outlist = tree_cons (NULL_TREE, tmpvar, outlist);
1653   result = build_chill_compound_expr (nreverse (outlist));
1654   return result;
1655 }
1656
1657 /* process the ALLOCATE built-in */
1658 static tree
1659 build_chill_allocate (mode, value)
1660      tree mode;
1661      tree value;
1662 {
1663   return build_allocate_getstack (mode, value, "ALLOCATE", "__allocate",
1664                                   get_chill_filename (), get_chill_linenumber ());
1665 }
1666
1667 /* process the GETSTACK built-in */
1668 static tree
1669 build_chill_getstack (mode, value)
1670      tree mode;
1671      tree value;
1672 {
1673   return build_allocate_getstack (mode, value, "GETSTACK", "__builtin_alloca",
1674                                   NULL_TREE, NULL_TREE);
1675 }
1676
1677 /* process the TERMINATE built-in */
1678 static tree
1679 build_chill_terminate (ptr)
1680      tree ptr;
1681 {
1682   tree result;
1683   tree type;
1684
1685   if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
1686     return error_mark_node;
1687
1688   type = TREE_TYPE (ptr);
1689   if (type == NULL_TREE || TREE_CODE (type) != POINTER_TYPE)
1690     {
1691       error ("argument to TERMINATE must be a reference primitive value");
1692       return error_mark_node;
1693     }
1694   result = build_chill_function_call (
1695              lookup_name (get_identifier ("__terminate")),
1696                tree_cons (NULL_TREE, convert (ptr_type_node, ptr),
1697                  tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
1698                    tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
1699   return result;
1700 }
1701
1702 /* build the type passed to _inttime function */
1703 void
1704 build_chill_inttime_type ()
1705 {
1706   tree idxlist;
1707   tree arrtype;
1708   tree decl;
1709
1710   idxlist = build_tree_list (NULL_TREE,
1711                build_chill_range_type (NULL_TREE,
1712                                        integer_zero_node,
1713                                        build_int_2 (5, 0)));
1714   arrtype = build_chill_array_type (ptr_type_node, idxlist, 0, NULL_TREE);
1715
1716   decl = build_decl (TYPE_DECL, get_identifier ("__tmp_INTTIME_type"), arrtype);
1717   pushdecl (decl);
1718   DECL_SOURCE_LINE (decl) = 0;
1719   satisfy_decl (decl, 0);
1720 }
1721
1722 static tree
1723 build_chill_inttime (t, loclist)
1724      tree t, loclist;
1725 {
1726   int  had_errors = 0, cnt;
1727   tree tmp;
1728   tree init = NULL_TREE;
1729   int  numargs;
1730   tree tuple, var;
1731
1732   if (t == NULL_TREE || TREE_CODE (t) == ERROR_MARK)
1733     return error_mark_node;
1734   if (loclist == NULL_TREE || TREE_CODE (loclist) == ERROR_MARK)
1735     return error_mark_node;
1736
1737   /* check first argument to be NEWMODE TIME */
1738   if (TREE_TYPE (t) != abs_timing_type_node)
1739     {
1740       error ("argument 1 to INTTIME must be of mode TIME.");
1741       had_errors = 1;
1742     }
1743
1744   cnt = 2;
1745   tmp = loclist;
1746   while (tmp != NULL_TREE)
1747     {
1748       tree loc = TREE_VALUE (tmp);
1749       char errmsg[200];
1750       char *p, *p1;
1751       int  write_error = 0;
1752
1753       sprintf (errmsg, "argument %d to INTTIME must be ", cnt);
1754       p = errmsg + strlen (errmsg);
1755       p1 = p;
1756
1757       if (loc == NULL_TREE || TREE_CODE (loc) == ERROR_MARK)
1758         had_errors = 1;
1759       else
1760         {
1761           if (! CH_REFERABLE (loc))
1762             {
1763               strcpy (p, "referable");
1764               p += strlen (p);
1765               write_error = 1;
1766               had_errors = 1;
1767             }
1768           if (TREE_CODE (TREE_TYPE (loc)) != INTEGER_TYPE)
1769             {
1770               if (p != p1)
1771                 {
1772                   strcpy (p, " and ");
1773                   p += strlen (p);
1774                 }
1775               strcpy (p, "of integer type");
1776               write_error = 1;
1777               had_errors = 1;
1778             }
1779           /* FIXME: what's about ranges can't hold the result ?? */
1780           if (write_error)
1781             error ("%s.", errmsg);
1782         }
1783       /* next location */
1784       tmp = TREE_CHAIN (tmp);
1785       cnt++;
1786     }
1787
1788   if (had_errors)
1789     return error_mark_node;
1790
1791   /* make it always 6 arguments */
1792   numargs = list_length (loclist);
1793   for (cnt = numargs; cnt < 6; cnt++)
1794     init = tree_cons (NULL_TREE, null_pointer_node, init);
1795
1796   /* append the given one's */
1797   tmp = loclist;
1798   while (tmp != NULL_TREE)
1799     {
1800       init = chainon (init,
1801                       build_tree_list (NULL_TREE,
1802                                        build_chill_descr (TREE_VALUE (tmp))));
1803       tmp = TREE_CHAIN (tmp);
1804     }
1805
1806   tuple = build_nt (CONSTRUCTOR, NULL_TREE, init);
1807   var = decl_temp1 (get_unique_identifier ("INTTIME"),
1808                     TREE_TYPE (lookup_name (get_identifier ("__tmp_INTTIME_type"))),
1809                     0, tuple, 0, 0);
1810
1811   return build_chill_function_call (
1812     lookup_name (get_identifier ("_inttime")),
1813        tree_cons (NULL_TREE, t,
1814           tree_cons (NULL_TREE, force_addr_of (var),
1815                      NULL_TREE)));
1816 }
1817
1818
1819 /* Compute the runtime length of the given string variable
1820  * or expression.
1821  */
1822 tree
1823 build_chill_length (expr)
1824      tree expr;
1825 {
1826   if (pass == 2)
1827     {
1828       tree type;
1829
1830       if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1831         return error_mark_node;
1832
1833       if (TREE_CODE (expr) == IDENTIFIER_NODE)
1834         expr = lookup_name (expr);
1835
1836       type = TREE_TYPE (expr);
1837
1838       if (TREE_CODE(type) == ERROR_MARK)
1839         return type;
1840       if (chill_varying_type_p (type))
1841         {
1842           tree temp = convert (integer_type_node,
1843                           build_component_ref (expr, var_length_id));
1844           /* FIXME: should call
1845            * cond_type_range_exception (temp);
1846            */
1847           return temp;
1848         }
1849
1850       if ((TREE_CODE (type) == ARRAY_TYPE ||
1851            /* should work for a bitstring too */
1852            (TREE_CODE (type) == SET_TYPE && TREE_CODE (TREE_TYPE (type)) == BOOLEAN_TYPE)) &&
1853           integer_zerop (TYPE_MIN_VALUE (TYPE_DOMAIN (type))))
1854         {
1855           tree temp =  fold (build (PLUS_EXPR, chill_integer_type_node,
1856                                     integer_one_node,
1857                                     TYPE_MAX_VALUE (TYPE_DOMAIN (type))));
1858           return convert (chill_integer_type_node, temp);
1859         }
1860
1861       if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
1862         {
1863           tree len = max_queue_size (type);
1864
1865           if (len == NULL_TREE)
1866             len = integer_minus_one_node;
1867           return len;
1868         }
1869
1870       if (CH_IS_TEXT_MODE (type))
1871         {
1872           if (TREE_CODE (expr) == TYPE_DECL)
1873             {
1874               /* text mode name */
1875               return text_length (type);
1876             }
1877           else
1878             {
1879               /* text location */
1880               tree temp = build_component_ref (
1881                             build_component_ref (expr, get_identifier ("tloc")),
1882                                 var_length_id);
1883               return convert (integer_type_node, temp);
1884             }
1885         }
1886
1887       error("LENGTH argument must be string, buffer, event mode, text location or mode");
1888       return error_mark_node;
1889     }
1890   return NULL_TREE;
1891 }
1892
1893 /* Compute the declared minimum/maximum value of the variable,
1894  * expression or declared type
1895  */
1896 static tree
1897 build_chill_lower_or_upper (what, is_upper)
1898      tree what;
1899      int is_upper;  /* o -> LOWER; 1 -> UPPER */
1900 {
1901   if (pass == 2)
1902     {
1903       tree type;
1904       struct ch_class class;
1905
1906       if (what == NULL_TREE || TREE_CODE (what) == ERROR_MARK)
1907         return error_mark_node;
1908
1909       if (TREE_CODE_CLASS (TREE_CODE (what)) == 't')
1910         type = what;
1911       else
1912         type = TREE_TYPE (what);
1913       if (type == NULL_TREE)
1914         {
1915           if (is_upper)
1916             error ("UPPER argument must have a mode, or be a mode");
1917           else
1918             error ("LOWER argument must have a mode, or be a mode");
1919           return error_mark_node;
1920         }
1921       while (TREE_CODE (type) == REFERENCE_TYPE)
1922         type = TREE_TYPE (type);
1923       if (chill_varying_type_p (type))
1924         type = CH_VARYING_ARRAY_TYPE (type);
1925
1926       if (discrete_type_p (type))
1927         {
1928           tree val = is_upper ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type);
1929           class.kind = CH_VALUE_CLASS;
1930           class.mode = type;
1931           return convert_to_class (class, val);
1932         }
1933       else if (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == SET_TYPE)
1934         {
1935           if (TYPE_STRING_FLAG (type))
1936             {
1937               class.kind = CH_DERIVED_CLASS;
1938               class.mode = integer_type_node;
1939             }
1940           else
1941             {
1942               class.kind = CH_VALUE_CLASS;
1943               class.mode = TYPE_DOMAIN (type);
1944             }
1945           type = TYPE_DOMAIN (type);
1946           return convert_to_class (class,
1947                                    is_upper
1948                                    ? TYPE_MAX_VALUE (type)
1949                                    : TYPE_MIN_VALUE (type));
1950         }
1951       if (is_upper)
1952         error("UPPER argument must be string, array, mode or integer");
1953       else
1954         error("LOWER argument must be string, array, mode or integer");
1955       return error_mark_node;
1956     }
1957   return NULL_TREE;
1958 }
1959
1960 tree
1961 build_chill_lower (what)
1962      tree what;
1963 {
1964   return build_chill_lower_or_upper (what, 0);
1965 }
1966
1967 static tree
1968 build_max_min (expr, max_min)
1969      tree expr;
1970      int max_min; /* 0: calculate MIN; 1: calculate MAX */
1971 {
1972   if (pass == 2)
1973     {
1974       tree type, temp, setminval;
1975       tree set_base_type;
1976       int size_in_bytes;
1977
1978       if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1979         return error_mark_node;
1980
1981       if (TREE_CODE (expr) == IDENTIFIER_NODE)
1982         expr = lookup_name (expr);
1983
1984       type = TREE_TYPE (expr);
1985       set_base_type = TYPE_DOMAIN (type);
1986       setminval = TYPE_MIN_VALUE (set_base_type);
1987
1988       if (TREE_CODE (type) != SET_TYPE)
1989         {
1990           error("%s argument must be POWERSET mode",
1991                 max_min ? "MAX" : "MIN");
1992           return error_mark_node;
1993         }
1994
1995       /* find max/min of constant powerset at compile time */
1996       if (TREE_CODE (expr) == CONSTRUCTOR && TREE_CONSTANT (expr)
1997           && (size_in_bytes = int_size_in_bytes (type)) >= 0)
1998         {
1999           HOST_WIDE_INT min_val = -1, max_val = -1;
2000           HOST_WIDE_INT i, i_hi = 0;
2001           HOST_WIDE_INT size_in_bits = size_in_bytes * BITS_PER_UNIT;
2002           char *buffer = (char*) alloca (size_in_bits);
2003           if (buffer == NULL
2004               || get_set_constructor_bits (expr, buffer, size_in_bits))
2005             abort ();
2006           for (i = 0; i < size_in_bits; i++)
2007             {
2008               if (buffer[i])
2009                 {
2010                   if (min_val < 0)
2011                     min_val = i;
2012                   max_val = i;
2013                 }
2014             }
2015           if (min_val < 0)
2016             error ("%s called for empty POWERSET", max_min ? "MAX" : "MIN");
2017           i = max_min ? max_val : min_val;
2018           temp = TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (expr)));
2019           add_double (i, i_hi,
2020                       TREE_INT_CST_LOW (temp), TREE_INT_CST_HIGH (temp),
2021                       &i, &i_hi);
2022           temp = build_int_2 (i, i_hi);
2023           TREE_TYPE (temp) = set_base_type;
2024           return temp;
2025         }
2026       else
2027         {
2028           tree parmlist, filename, lineno;
2029           const char *funcname;
2030
2031           /* set up to call appropriate runtime function */
2032           if (max_min)
2033             funcname = "__flsetpowerset";
2034           else
2035             funcname = "__ffsetpowerset";
2036
2037           setminval = convert (long_integer_type_node, setminval);
2038           filename = force_addr_of (get_chill_filename());
2039           lineno = get_chill_linenumber();
2040           parmlist = tree_cons (NULL_TREE, force_addr_of (expr),
2041                        tree_cons (NULL_TREE, powersetlen (expr),
2042                          tree_cons (NULL_TREE, setminval,
2043                            tree_cons (NULL_TREE, filename,
2044                              build_tree_list (NULL_TREE, lineno)))));
2045           temp = lookup_name (get_identifier (funcname));
2046           temp = build_chill_function_call (temp, parmlist);
2047           TREE_TYPE (temp) = set_base_type;
2048           return temp;
2049         }
2050     }
2051   return NULL_TREE;
2052 }
2053
2054
2055 /* Compute the current runtime maximum value of the powerset
2056  */
2057 tree
2058 build_chill_max (expr)
2059      tree expr;
2060 {
2061   return build_max_min (expr, 1);
2062 }
2063
2064
2065 /* Compute the current runtime minimum value of the powerset
2066  */
2067 tree
2068 build_chill_min (expr)
2069      tree expr;
2070 {
2071   return build_max_min (expr, 0);
2072 }
2073
2074
2075 /* Build a conversion from the given expression to an INT,
2076  * but only when the expression's type is the same size as
2077  * an INT.
2078  */
2079 tree
2080 build_chill_num (expr)
2081      tree expr;
2082 {
2083   if (pass == 2)
2084     {
2085       tree temp;
2086       int need_unsigned;
2087
2088       if (expr == NULL_TREE || TREE_CODE(expr) == ERROR_MARK)
2089         return error_mark_node;
2090
2091       if (TREE_CODE (expr) == IDENTIFIER_NODE)
2092         expr = lookup_name (expr);
2093
2094       expr = convert_to_discrete (expr);
2095       if (expr == NULL_TREE)
2096         {
2097           error ("argument to NUM is not discrete");
2098           return error_mark_node;
2099         }
2100
2101       /* enumeral types and string slices of length 1 must be kept unsigned */
2102       need_unsigned = (TREE_CODE (TREE_TYPE (expr)) == ENUMERAL_TYPE)
2103         || TREE_UNSIGNED (TREE_TYPE (expr));
2104
2105       temp = type_for_size (TYPE_PRECISION (TREE_TYPE (expr)),
2106                             need_unsigned);
2107       if (temp == NULL_TREE)
2108         {
2109           error ("No integer mode which matches expression's mode");
2110           return integer_zero_node;
2111         }
2112       temp = convert (temp, expr);
2113
2114       if (TREE_CONSTANT (temp))
2115         {
2116           if (tree_int_cst_lt (temp,
2117                                TYPE_MIN_VALUE (TREE_TYPE (temp))))
2118             error ("NUM's parameter is below its mode range");
2119           if (tree_int_cst_lt (TYPE_MAX_VALUE (TREE_TYPE (temp)),
2120                                temp))
2121             error ("NUM's parameter is above its mode range");
2122         }
2123 #if 0
2124       else
2125         {
2126           if (range_checking)
2127             cond_overflow_exception (temp,
2128               TYPE_MIN_VALUE (TREE_TYPE (temp)),
2129               TYPE_MAX_VALUE (TREE_TYPE (temp)));
2130         }
2131 #endif
2132
2133       /* NUM delivers the INT derived class */
2134       CH_DERIVED_FLAG (temp) = 1;
2135
2136       return temp;
2137     }
2138   return NULL_TREE;
2139 }
2140
2141
2142 static tree
2143 build_chill_pred_or_succ (expr, op)
2144      tree expr;
2145      enum tree_code op; /* PLUS_EXPR for SUCC; MINUS_EXPR for PRED. */
2146 {
2147   struct ch_class class;
2148   tree etype, cond;
2149
2150   if (pass == 1)
2151     return NULL_TREE;
2152
2153   if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
2154     return error_mark_node;
2155
2156   /* disallow numbered SETs */
2157   if (TREE_CODE (TREE_TYPE (expr)) == ENUMERAL_TYPE
2158       && CH_ENUM_IS_NUMBERED (TREE_TYPE (expr)))
2159     {
2160       error ("Cannot take SUCC or PRED of a numbered SET");
2161       return error_mark_node;
2162     }
2163
2164   if (TREE_CODE (TREE_TYPE (expr)) == POINTER_TYPE)
2165     {
2166       if (TREE_TYPE (TREE_TYPE (expr)) == void_type_node)
2167         {
2168           error ("SUCC or PRED must not be done on a PTR.");
2169           return error_mark_node;
2170         }
2171       pedwarn ("SUCC or PRED for a reference type is not standard.");
2172       return fold (build (op, TREE_TYPE (expr),
2173                           expr,
2174                           size_in_bytes (TREE_TYPE (TREE_TYPE (expr)))));
2175     }
2176
2177   expr = convert_to_discrete (expr);
2178
2179   if (expr == NULL_TREE)
2180     {
2181       error ("SUCC or PRED argument must be a discrete mode");
2182       return error_mark_node;
2183     }
2184
2185   class = chill_expr_class (expr);
2186   if (class.mode)
2187     class.mode = CH_ROOT_MODE (class.mode);
2188   etype = class.mode;
2189   expr = convert (etype, expr);
2190
2191   /* Exception if expression is already at the
2192      min (PRED)/max(SUCC) valid value for its type. */
2193   cond = fold (build (op == PLUS_EXPR ? GE_EXPR : LE_EXPR,
2194                       boolean_type_node,
2195                       expr,
2196                       convert (etype,
2197                                op == PLUS_EXPR ? TYPE_MAX_VALUE (etype)
2198                                : TYPE_MIN_VALUE (etype))));
2199   if (TREE_CODE (cond) == INTEGER_CST
2200       && tree_int_cst_equal (cond, integer_one_node))
2201     {
2202       error ("Taking the %s of a value already at its %s value",
2203              op == PLUS_EXPR ? "SUCC" : "PRED",
2204              op == PLUS_EXPR ? "maximum" : "minimum");
2205       return error_mark_node;
2206     }
2207
2208   if (range_checking)
2209     expr = check_expression (expr, cond,
2210                              ridpointers[(int) RID_OVERFLOW]);
2211
2212   expr = fold (build (op, etype, expr,
2213            convert (etype, integer_one_node)));
2214   return convert_to_class (class, expr);
2215 }
2216 \f
2217 /* Compute the value of the CHILL `size' operator just
2218  * like the C 'sizeof' operator (code stolen from c-typeck.c)
2219  * TYPE may be a location or mode tree.  In pass 1, we build
2220  * a function-call syntax tree;  in pass 2, we evaluate it.
2221  */
2222 tree
2223 build_chill_sizeof (type)
2224      tree type;
2225 {
2226   if (pass == 2)
2227     {
2228       tree temp;
2229       struct ch_class class;
2230       enum tree_code code;
2231       tree signame = NULL_TREE;
2232
2233       if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
2234         return error_mark_node;
2235
2236       if (TREE_CODE (type) == IDENTIFIER_NODE)
2237         type = lookup_name (type);
2238
2239       code = TREE_CODE (type);
2240       if (code == ERROR_MARK)
2241         return error_mark_node;
2242
2243       if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
2244         {
2245           if (TREE_CODE (type) == TYPE_DECL && CH_DECL_SIGNAL (type))
2246             signame = DECL_NAME (type);
2247         type = TREE_TYPE (type);
2248         }
2249
2250       if (code == FUNCTION_TYPE)
2251         {
2252           if (pedantic || warn_pointer_arith)
2253             pedwarn ("size applied to a function mode");
2254           return error_mark_node;
2255         }
2256       if (code == VOID_TYPE)
2257         {
2258           if (pedantic || warn_pointer_arith)
2259             pedwarn ("sizeof applied to a void mode");
2260           return error_mark_node;
2261         }
2262       if (TYPE_SIZE (type) == 0)
2263         {
2264           error ("sizeof applied to an incomplete mode");
2265           return error_mark_node;
2266         }
2267
2268       temp = size_binop (CEIL_DIV_EXPR, TYPE_SIZE_UNIT (type),
2269                          size_int (TYPE_PRECISION (char_type_node)
2270                                    / BITS_PER_UNIT));
2271       if (signame != NULL_TREE)
2272         {
2273           /* we have a signal definition. This signal may have no
2274              data items specified. The definition however says that
2275              there are data, cause we cannot build a structure without
2276              fields. In this case return 0. */
2277           if (IDENTIFIER_SIGNAL_DATA (signame) == 0)
2278             temp = integer_zero_node;
2279         }
2280
2281       /* FIXME: should call
2282        * cond_type_range_exception (temp);
2283        */
2284       class.kind = CH_DERIVED_CLASS;
2285       class.mode = integer_type_node;
2286       return convert_to_class (class, temp);
2287     }
2288   return NULL_TREE;
2289 }
2290 \f
2291 /* Compute the declared maximum value of the variable,
2292  * expression or declared type
2293  */
2294 tree
2295 build_chill_upper (what)
2296      tree what;
2297 {
2298   return build_chill_lower_or_upper (what, 1);
2299 }
2300 \f
2301 /*
2302  * Here at the site of a function/procedure call..  We need to build
2303  * temps for the INOUT and OUT parameters, and copy the actual parameters
2304  * into the temps.  After the call, we 'copy back' the values from the
2305  * temps to the actual parameter variables.  This somewhat verbose pol-
2306  * icy meets the requirement that the actual parameters are undisturbed
2307  * if the function/procedure causes an exception.  They are updated only
2308  * upon a normal return from the function.
2309  *
2310  * Note: the expr_list, which collects all of the above assignments, etc,
2311  * is built in REVERSE execution order.  The list is corrected by nreverse
2312  * inside the build_chill_compound_expr call.
2313  */
2314 tree
2315 build_chill_function_call (function, expr)
2316      tree function, expr;
2317 {
2318   register tree typetail, valtail, typelist;
2319   register tree temp, actual_args = NULL_TREE;
2320   tree name = NULL_TREE;
2321   tree function_call;
2322   tree fntype;
2323   int parmno = 1;            /* parameter number for error message */
2324   int callee_raise_exception = 0;
2325
2326   /* list of assignments to run after the actual call,
2327      copying from the temps back to the user's variables. */
2328   tree copy_back = NULL_TREE;
2329
2330   /* list of expressions to run before the call, copying from
2331      the user's variable to the temps that are passed to the function */
2332   tree expr_list = NULL_TREE;
2333
2334   if (function == NULL_TREE || TREE_CODE (function) == ERROR_MARK)
2335     return error_mark_node;
2336
2337   if (expr != NULL_TREE && TREE_CODE (expr) == ERROR_MARK)
2338     return error_mark_node;
2339
2340   if (pass < 2)
2341     return error_mark_node;
2342
2343   fntype = TREE_TYPE (function);
2344   if (TREE_CODE (function) == FUNCTION_DECL)
2345     {
2346       callee_raise_exception = TYPE_RAISES_EXCEPTIONS (fntype) != NULL_TREE;
2347
2348       /* Differs from default_conversion by not setting TREE_ADDRESSABLE
2349          (because calling an inline function does not mean the function
2350          needs to be separately compiled).  */
2351       fntype = build_type_variant (fntype,
2352                                    TREE_READONLY (function),
2353                                    TREE_THIS_VOLATILE (function));
2354       name = DECL_NAME (function);
2355
2356       /* check that function is not a PROCESS */
2357       if (CH_DECL_PROCESS (function))
2358         {
2359           error ("cannot call a PROCESS, you START a PROCESS");
2360           return error_mark_node;
2361         }
2362
2363       function = build1 (ADDR_EXPR, build_pointer_type (fntype), function);
2364     }
2365   else if (TREE_CODE (fntype) == POINTER_TYPE)
2366     {
2367       fntype = TREE_TYPE (fntype);
2368       callee_raise_exception = TYPE_RAISES_EXCEPTIONS (fntype) != NULL_TREE;
2369
2370       /* Z.200 6.7 Call Action:
2371          "A procedure call causes the EMPTY exception if the
2372          procedure primitive value delivers NULL. */
2373       if (TREE_CODE (function) != ADDR_EXPR
2374           || TREE_CODE (TREE_OPERAND (function, 0)) != FUNCTION_DECL)
2375         function = check_non_null (function);
2376     }
2377
2378   typelist = TYPE_ARG_TYPES (fntype);
2379   if (callee_raise_exception)
2380     {
2381       /* remove last two arguments from list for subsequent checking.
2382           They will get added automatically after checking */
2383       int len = list_length (typelist);
2384       int i;
2385       tree newtypelist = NULL_TREE;
2386       tree wrk = typelist;
2387
2388       for (i = 0; i < len - 3; i++)
2389         {
2390             newtypelist = tree_cons (TREE_PURPOSE (wrk), TREE_VALUE (wrk), newtypelist);
2391               wrk = TREE_CHAIN (wrk);
2392           }
2393       /* add the void_type_node */
2394       newtypelist = tree_cons (NULL_TREE, void_type_node, newtypelist);
2395       typelist = nreverse (newtypelist);
2396     }
2397
2398   /* Scan the given expressions and types, producing individual
2399      converted arguments and pushing them on ACTUAL_ARGS in
2400      reverse order.  */
2401   for (valtail = expr, typetail = typelist;
2402        valtail != NULL_TREE && typetail != NULL_TREE;  parmno++,
2403        valtail = TREE_CHAIN (valtail), typetail = TREE_CHAIN (typetail))
2404     {
2405       register tree actual = TREE_VALUE (valtail);
2406       register tree attr   = TREE_PURPOSE (typetail)
2407         ? TREE_PURPOSE (typetail) : ridpointers[(int) RID_IN];
2408       register tree type   = TREE_VALUE (typetail);
2409       char place[30];
2410       sprintf (place, "parameter %d", parmno);
2411
2412       /* if we have reached void_type_node in typelist we are at the
2413           end of formal parameters and then we have too many actual
2414            parameters */
2415       if (type == void_type_node)
2416          break;
2417
2418       /* check if actual is a TYPE_DECL. FIXME: what else ? */
2419       if (TREE_CODE (actual) == TYPE_DECL)
2420         {
2421           error ("invalid %s", place);
2422           actual = error_mark_node;
2423         }
2424       /* INOUT or OUT param to handle? */
2425       else if (attr == ridpointers[(int) RID_OUT]
2426           || attr == ridpointers[(int)RID_INOUT])
2427         {
2428           char temp_name[20];
2429           tree parmtmp;
2430           tree in_actual = NULL_TREE, out_actual;
2431
2432           /* actual parameter must be a location so we can
2433              build a reference to it */
2434           if (!CH_LOCATION_P (actual))
2435             {
2436               error ("%s parameter %d must be a location",
2437                      (attr == ridpointers[(int) RID_OUT]) ?
2438                      "OUT" : "INOUT", parmno);
2439               continue;
2440             }
2441           if (TYPE_READONLY_PROPERTY (TREE_TYPE (actual))
2442               || TREE_READONLY (actual))
2443             {
2444               error ("%s parameter %d is READ-only",
2445                      (attr == ridpointers[(int) RID_OUT]) ?
2446                      "OUT" : "INOUT", parmno);
2447               continue;
2448             }
2449
2450           sprintf (temp_name, "PARM_%d_%s",  parmno,
2451                    (attr == ridpointers[(int)RID_OUT]) ?
2452                    "OUT" : "INOUT");
2453           parmtmp = decl_temp1 (get_unique_identifier (temp_name),
2454                                 TREE_TYPE (type), 0, NULL_TREE, 0, 0);
2455           /* this temp *must not* be optimized into a register */
2456           mark_addressable (parmtmp);
2457
2458           if (attr == ridpointers[(int)RID_INOUT])
2459             {
2460               tree in_actual = chill_convert_for_assignment (TREE_TYPE (type),
2461                                                              actual, place);
2462               tree tmp = build_chill_modify_expr (parmtmp, in_actual);
2463               expr_list = tree_cons (NULL_TREE, tmp, expr_list);
2464             }
2465           if (in_actual != error_mark_node)
2466             {
2467               /* list of copy back assignments to perform, from the temp
2468                  back to the actual parameter */
2469               out_actual = chill_convert_for_assignment (TREE_TYPE (actual),
2470                                                          parmtmp, place);
2471               copy_back = tree_cons (NULL_TREE,
2472                                      build_chill_modify_expr (actual,
2473                                                               out_actual),
2474                                      copy_back);
2475             }
2476           /* we can do this because build_chill_function_type
2477              turned these parameters into REFERENCE_TYPEs. */
2478           actual = build1 (ADDR_EXPR, type, parmtmp);
2479         }
2480       else if (attr == ridpointers[(int) RID_LOC])
2481         {
2482           int is_location = chill_location (actual);
2483           if (is_location)
2484             {
2485               if (is_location == 1)
2486                 {
2487                   error ("LOC actual parameter %d is a non-referable location",
2488                          parmno);
2489                   actual = error_mark_node;
2490                 }
2491               else if (! CH_READ_COMPATIBLE (type, TREE_TYPE (actual)))
2492                 {
2493                   error ("mode mismatch in parameter %d", parmno);
2494                   actual = error_mark_node;
2495                 }
2496               else
2497                 actual = convert (type, actual);
2498             }
2499           else
2500             {
2501               sprintf (place, "parameter_%d", parmno);
2502               actual = decl_temp1 (get_identifier (place),
2503                                    TREE_TYPE (type), 0, actual, 0, 0);
2504               actual = convert (type, actual);
2505             }
2506           mark_addressable (actual);
2507         }
2508       else
2509         actual = chill_convert_for_assignment (type, actual, place);
2510
2511       actual_args = tree_cons (NULL_TREE, actual, actual_args);
2512     }
2513
2514   if (valtail != 0 && TREE_VALUE (valtail) != void_type_node)
2515     {
2516       if (name)
2517         error ("too many arguments to procedure `%s'",
2518                IDENTIFIER_POINTER (name));
2519       else
2520         error ("too many arguments to procedure");
2521       return error_mark_node;
2522     }
2523   else if (typetail != 0 && TREE_VALUE (typetail) != void_type_node)
2524     {
2525       if (name)
2526         error ("too few arguments to procedure `%s'",
2527                IDENTIFIER_POINTER (name));
2528       else
2529         error ("too few arguments to procedure");
2530       return error_mark_node;
2531     }
2532
2533   if (callee_raise_exception)
2534     {
2535       /* add linenumber and filename of the caller as arguments */
2536       actual_args = tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2537                                       actual_args);
2538       actual_args = tree_cons (NULL_TREE, get_chill_linenumber (), actual_args);
2539     }
2540
2541   function_call = build (CALL_EXPR, TREE_TYPE (fntype),
2542                           function, nreverse (actual_args), NULL_TREE);
2543   TREE_SIDE_EFFECTS (function_call) = 1;
2544
2545   if (copy_back == NULL_TREE && expr_list == NULL_TREE)
2546     return function_call;        /* no copying to do, either way */
2547   else
2548     {
2549       tree result_type = TREE_TYPE (fntype);
2550       tree result_tmp = NULL_TREE;
2551
2552       /* no result wanted from procedure call */
2553       if (result_type == NULL_TREE || result_type == void_type_node)
2554         expr_list = tree_cons (NULL_TREE, function_call, expr_list);
2555       else
2556         {
2557           /* create a temp for the function's result. this is so that we can
2558              evaluate this temp as the last expression in the list, which will
2559              make the function's return value the value of the whole list of
2560              expressions (by the C rules for compound expressions) */
2561           result_tmp = decl_temp1 (get_unique_identifier ("FUNC_RESULT"),
2562                                    result_type, 0, NULL_TREE, 0, 0);
2563           expr_list = tree_cons (NULL_TREE,
2564                         build_chill_modify_expr (result_tmp, function_call),
2565                                  expr_list);
2566         }
2567
2568       expr_list = chainon (copy_back, expr_list);
2569
2570       /* last, but not least, the function's result */
2571       if (result_tmp != NULL_TREE)
2572         expr_list = tree_cons (NULL_TREE, result_tmp, expr_list);
2573       temp = build_chill_compound_expr (nreverse (expr_list));
2574       return temp;
2575     }
2576 }
2577 \f
2578 /* We saw something that looks like a function call,
2579    but if it's pass 1, we're not sure. */
2580
2581 tree
2582 build_generalized_call (func, args)
2583      tree func, args;
2584 {
2585   tree type = TREE_TYPE (func);
2586
2587   if (pass == 1)
2588     return build (CALL_EXPR, NULL_TREE, func, args, NULL_TREE);
2589
2590   /* Handle string repetition */
2591   if (TREE_CODE (func) == INTEGER_CST)
2592     {
2593       if (args == NULL_TREE || TREE_CHAIN (args) != NULL_TREE)
2594         {
2595           error ("syntax error (integer used as function)");
2596           return error_mark_node;
2597         }
2598       if (TREE_CODE (args) == TREE_LIST)
2599         args = TREE_VALUE (args);
2600       return build_chill_repetition_op (func, args);
2601     }
2602
2603   if (args != NULL_TREE)
2604     {
2605       if (TREE_CODE (args) == RANGE_EXPR)
2606         {
2607           tree lo = TREE_OPERAND (args, 0), hi = TREE_OPERAND (args, 1);
2608           if (TREE_CODE_CLASS (TREE_CODE (func)) == 't')
2609             return build_chill_range_type (func, lo, hi);
2610           else
2611             return build_chill_slice_with_range (func, lo, hi);
2612         }
2613       else if (TREE_CODE (args) != TREE_LIST)
2614         {
2615           error ("syntax error - missing operator, comma, or '('?");
2616           return error_mark_node;
2617         }
2618     }
2619
2620   if (TREE_CODE (func) == TYPE_DECL)
2621     {
2622       if (CH_DECL_SIGNAL (func))
2623         return build_signal_descriptor (func, args);
2624       func = TREE_TYPE (func);
2625     }
2626
2627   if (TREE_CODE_CLASS (TREE_CODE (func)) == 't'
2628       && args != NULL_TREE && TREE_CHAIN (args) == NULL_TREE)
2629     return build_chill_cast (func, TREE_VALUE (args));
2630
2631   if (TREE_CODE (type) == FUNCTION_TYPE
2632       || (TREE_CODE (type) == POINTER_TYPE
2633           && TREE_TYPE (type) != NULL_TREE
2634           && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE))
2635     {
2636       /* Check for a built-in Chill function.  */
2637       if (TREE_CODE (func) == FUNCTION_DECL
2638           && DECL_BUILT_IN (func)
2639           && DECL_FUNCTION_CODE (func) > END_BUILTINS)
2640         {
2641           tree fnname = DECL_NAME (func);
2642           switch ((enum chill_built_in_function)DECL_FUNCTION_CODE (func))
2643             {
2644             case BUILT_IN_CH_ABS:
2645               if (check_arglist_length (args, 1, 1, fnname) < 0)
2646                 return error_mark_node;
2647               return build_chill_abs (TREE_VALUE (args));
2648             case BUILT_IN_ABSTIME:
2649               if (check_arglist_length (args, 0, 6, fnname) < 0)
2650                 return error_mark_node;
2651               return build_chill_abstime (args);
2652             case BUILT_IN_ADDR:
2653               if (check_arglist_length (args, 1, 1, fnname) < 0)
2654                 return error_mark_node;
2655 #if 0
2656               return build_chill_addr_expr (TREE_VALUE (args), (char *)0);
2657 #else
2658               return build_chill_arrow_expr (TREE_VALUE (args), 0);
2659 #endif
2660             case BUILT_IN_ALLOCATE_GLOBAL_MEMORY:
2661               if (check_arglist_length (args, 2, 2, fnname) < 0)
2662                 return error_mark_node;
2663               return build_allocate_global_memory_call
2664                 (TREE_VALUE (args),
2665                  TREE_VALUE (TREE_CHAIN (args)));
2666             case BUILT_IN_ALLOCATE:
2667               if (check_arglist_length (args, 1, 2, fnname) < 0)
2668                 return error_mark_node;
2669               return build_chill_allocate (TREE_VALUE (args),
2670                        TREE_CHAIN (args) == NULL_TREE ? NULL_TREE : TREE_VALUE (TREE_CHAIN (args)));
2671             case BUILT_IN_ALLOCATE_MEMORY:
2672               if (check_arglist_length (args, 2, 2, fnname) < 0)
2673                 return error_mark_node;
2674               return build_allocate_memory_call
2675                 (TREE_VALUE (args),
2676                  TREE_VALUE (TREE_CHAIN (args)));
2677             case BUILT_IN_ASSOCIATE:
2678               if (check_arglist_length (args, 2, 3, fnname) < 0)
2679                 return error_mark_node;
2680               return build_chill_associate
2681                 (TREE_VALUE (args),
2682                  TREE_VALUE (TREE_CHAIN (args)),
2683                  TREE_CHAIN (TREE_CHAIN (args)));
2684             case BUILT_IN_ARCCOS:
2685               if (check_arglist_length (args, 1, 1, fnname) < 0)
2686                 return error_mark_node;
2687               return build_chill_floatcall (TREE_VALUE (args),
2688                                             IDENTIFIER_POINTER (fnname),
2689                                             "__acos");
2690             case BUILT_IN_ARCSIN:
2691               if (check_arglist_length (args, 1, 1, fnname) < 0)
2692                 return error_mark_node;
2693               return build_chill_floatcall (TREE_VALUE (args),
2694                                             IDENTIFIER_POINTER (fnname),
2695                                             "__asin");
2696             case BUILT_IN_ARCTAN:
2697               if (check_arglist_length (args, 1, 1, fnname) < 0)
2698                 return error_mark_node;
2699               return build_chill_floatcall (TREE_VALUE (args),
2700                                             IDENTIFIER_POINTER (fnname),
2701                                             "__atan");
2702             case BUILT_IN_CARD:
2703               if (check_arglist_length (args, 1, 1, fnname) < 0)
2704                 return error_mark_node;
2705               return build_chill_card (TREE_VALUE (args));
2706             case BUILT_IN_CONNECT:
2707               if (check_arglist_length (args, 3, 5, fnname) < 0)
2708                 return error_mark_node;
2709               return build_chill_connect
2710                 (TREE_VALUE (args),
2711                  TREE_VALUE (TREE_CHAIN (args)),
2712                  TREE_VALUE (TREE_CHAIN (TREE_CHAIN (args))),
2713                  TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args))));
2714             case BUILT_IN_COPY_NUMBER:
2715               if (check_arglist_length (args, 1, 1, fnname) < 0)
2716                 return error_mark_node;
2717               return build_copy_number (TREE_VALUE (args));
2718             case BUILT_IN_CH_COS:
2719               if (check_arglist_length (args, 1, 1, fnname) < 0)
2720                 return error_mark_node;
2721               return build_chill_floatcall (TREE_VALUE (args),
2722                                             IDENTIFIER_POINTER (fnname),
2723                                             "__cos");
2724             case BUILT_IN_CREATE:
2725               if (check_arglist_length (args, 1, 1, fnname) < 0)
2726                 return error_mark_node;
2727               return build_chill_create (TREE_VALUE (args));
2728             case BUILT_IN_DAYS:
2729               if (check_arglist_length (args, 1, 1, fnname) < 0)
2730                 return error_mark_node;
2731               return build_chill_duration (TREE_VALUE (args), DAYS_MULTIPLIER,
2732                                            fnname, DAYS_MAX);
2733             case BUILT_IN_CH_DELETE:
2734               if (check_arglist_length (args, 1, 1, fnname) < 0)
2735                 return error_mark_node;
2736               return build_chill_delete (TREE_VALUE (args));
2737             case BUILT_IN_DESCR:
2738               if (check_arglist_length (args, 1, 1, fnname) < 0)
2739                 return error_mark_node;
2740               return build_chill_descr (TREE_VALUE (args));
2741             case BUILT_IN_DISCONNECT:
2742               if (check_arglist_length (args, 1, 1, fnname) < 0)
2743                 return error_mark_node;
2744               return build_chill_disconnect (TREE_VALUE (args));
2745             case BUILT_IN_DISSOCIATE:
2746               if (check_arglist_length (args, 1, 1, fnname) < 0)
2747                 return error_mark_node;
2748               return build_chill_dissociate (TREE_VALUE (args));
2749             case BUILT_IN_EOLN:
2750               if (check_arglist_length (args, 1, 1, fnname) < 0)
2751                 return error_mark_node;
2752               return build_chill_eoln (TREE_VALUE (args));
2753             case BUILT_IN_EXISTING:
2754               if (check_arglist_length (args, 1, 1, fnname) < 0)
2755                 return error_mark_node;
2756               return build_chill_existing (TREE_VALUE (args));
2757             case BUILT_IN_EXP:
2758               if (check_arglist_length (args, 1, 1, fnname) < 0)
2759                 return error_mark_node;
2760               return build_chill_floatcall (TREE_VALUE (args),
2761                                             IDENTIFIER_POINTER (fnname),
2762                                             "__exp");
2763             case BUILT_IN_GEN_CODE:
2764               if (check_arglist_length (args, 1, 1, fnname) < 0)
2765                 return error_mark_node;
2766               return build_gen_code (TREE_VALUE (args));
2767             case BUILT_IN_GEN_INST:
2768               if (check_arglist_length (args, 2, 2, fnname) < 0)
2769                 return error_mark_node;
2770               return build_gen_inst (TREE_VALUE (args),
2771                  TREE_VALUE (TREE_CHAIN (args)));
2772             case BUILT_IN_GEN_PTYPE:
2773               if (check_arglist_length (args, 1, 1, fnname) < 0)
2774                 return error_mark_node;
2775               return build_gen_ptype (TREE_VALUE (args));
2776             case BUILT_IN_GETASSOCIATION:
2777               if (check_arglist_length (args, 1, 1, fnname) < 0)
2778                 return error_mark_node;
2779               return build_chill_getassociation (TREE_VALUE (args));
2780             case BUILT_IN_GETSTACK:
2781               if (check_arglist_length (args, 1, 2, fnname) < 0)
2782                 return error_mark_node;
2783               return build_chill_getstack (TREE_VALUE (args),
2784                        TREE_CHAIN (args) == NULL_TREE ? NULL_TREE : TREE_VALUE (TREE_CHAIN (args)));
2785             case BUILT_IN_GETTEXTACCESS:
2786               if (check_arglist_length (args, 1, 1, fnname) < 0)
2787                 return error_mark_node;
2788               return build_chill_gettextaccess (TREE_VALUE (args));
2789             case BUILT_IN_GETTEXTINDEX:
2790               if (check_arglist_length (args, 1, 1, fnname) < 0)
2791                 return error_mark_node;
2792               return build_chill_gettextindex (TREE_VALUE (args));
2793             case BUILT_IN_GETTEXTRECORD:
2794               if (check_arglist_length (args, 1, 1, fnname) < 0)
2795                 return error_mark_node;
2796               return build_chill_gettextrecord (TREE_VALUE (args));
2797             case BUILT_IN_GETUSAGE:
2798               if (check_arglist_length (args, 1, 1, fnname) < 0)
2799                 return error_mark_node;
2800               return build_chill_getusage (TREE_VALUE (args));
2801             case BUILT_IN_HOURS:
2802               if (check_arglist_length (args, 1, 1, fnname) < 0)
2803                 return error_mark_node;
2804               return build_chill_duration (TREE_VALUE (args), HOURS_MULTIPLIER,
2805                                            fnname, HOURS_MAX);
2806             case BUILT_IN_INDEXABLE:
2807               if (check_arglist_length (args, 1, 1, fnname) < 0)
2808                 return error_mark_node;
2809               return build_chill_indexable (TREE_VALUE (args));
2810             case BUILT_IN_INTTIME:
2811               if (check_arglist_length (args, 2, 7, fnname) < 0)
2812                 return error_mark_node;
2813               return build_chill_inttime (TREE_VALUE (args),
2814                  TREE_CHAIN (args));
2815             case BUILT_IN_ISASSOCIATED:
2816               if (check_arglist_length (args, 1, 1, fnname) < 0)
2817                 return error_mark_node;
2818               return build_chill_isassociated (TREE_VALUE (args));
2819             case BUILT_IN_LENGTH:
2820               if (check_arglist_length (args, 1, 1, fnname) < 0)
2821                 return error_mark_node;
2822               return build_chill_length (TREE_VALUE (args));
2823             case BUILT_IN_LN:
2824               if (check_arglist_length (args, 1, 1, fnname) < 0)
2825                 return error_mark_node;
2826               return build_chill_floatcall (TREE_VALUE (args),
2827                                             IDENTIFIER_POINTER (fnname),
2828                                             "__log");
2829             case BUILT_IN_LOG:
2830               if (check_arglist_length (args, 1, 1, fnname) < 0)
2831                 return error_mark_node;
2832               return build_chill_floatcall (TREE_VALUE (args),
2833                                             IDENTIFIER_POINTER (fnname),
2834                                             "__log10");
2835             case BUILT_IN_LOWER:
2836               if (check_arglist_length (args, 1, 1, fnname) < 0)
2837                 return error_mark_node;
2838               return build_chill_lower (TREE_VALUE (args));
2839             case BUILT_IN_MAX:
2840               if (check_arglist_length (args, 1, 1, fnname) < 0)
2841                 return error_mark_node;
2842               return build_chill_max (TREE_VALUE (args));
2843             case BUILT_IN_MILLISECS:
2844               if (check_arglist_length (args, 1, 1, fnname) < 0)
2845                 return error_mark_node;
2846               return build_chill_duration (TREE_VALUE (args), MILLISECS_MULTIPLIER,
2847                                            fnname, MILLISECS_MAX);
2848             case BUILT_IN_MIN:
2849               if (check_arglist_length (args, 1, 1, fnname) < 0)
2850                 return error_mark_node;
2851               return build_chill_min (TREE_VALUE (args));
2852             case BUILT_IN_MINUTES:
2853               if (check_arglist_length (args, 1, 1, fnname) < 0)
2854                 return error_mark_node;
2855               return build_chill_duration (TREE_VALUE (args), MINUTES_MULTIPLIER,
2856                                            fnname, MINUTES_MAX);
2857             case BUILT_IN_MODIFY:
2858               if (check_arglist_length (args, 1, -1, fnname) < 0)
2859                 return error_mark_node;
2860               return build_chill_modify (TREE_VALUE (args), TREE_CHAIN (args));
2861             case BUILT_IN_NUM:
2862               if (check_arglist_length (args, 1, 1, fnname) < 0)
2863                 return error_mark_node;
2864               return build_chill_num (TREE_VALUE (args));
2865             case BUILT_IN_OUTOFFILE:
2866               if (check_arglist_length (args, 1, 1, fnname) < 0)
2867                 return error_mark_node;
2868               return build_chill_outoffile (TREE_VALUE (args));
2869             case BUILT_IN_PRED:
2870               if (check_arglist_length (args, 1, 1, fnname) < 0)
2871                 return error_mark_node;
2872               return build_chill_pred_or_succ (TREE_VALUE (args), MINUS_EXPR);
2873             case BUILT_IN_PROC_TYPE:
2874               if (check_arglist_length (args, 1, 1, fnname) < 0)
2875                 return error_mark_node;
2876               return build_proc_type (TREE_VALUE (args));
2877             case BUILT_IN_QUEUE_LENGTH:
2878               if (check_arglist_length (args, 1, 1, fnname) < 0)
2879                 return error_mark_node;
2880               return build_queue_length (TREE_VALUE (args));
2881             case BUILT_IN_READABLE:
2882               if (check_arglist_length (args, 1, 1, fnname) < 0)
2883                 return error_mark_node;
2884               return build_chill_readable (TREE_VALUE (args));
2885             case BUILT_IN_READRECORD:
2886               if (check_arglist_length (args, 1, 3, fnname) < 0)
2887                 return error_mark_node;
2888               return build_chill_readrecord (TREE_VALUE (args), TREE_CHAIN (args));
2889             case BUILT_IN_READTEXT:
2890               if (check_arglist_length (args, 2, -1, fnname) < 0)
2891                 return error_mark_node;
2892               return build_chill_readtext (TREE_VALUE (args),
2893                                            TREE_CHAIN (args));
2894             case BUILT_IN_RETURN_MEMORY:
2895               if (check_arglist_length (args, 1, 1, fnname) < 0)
2896                 return error_mark_node;
2897               return build_return_memory (TREE_VALUE (args));
2898             case BUILT_IN_SECS:
2899               if (check_arglist_length (args, 1, 1, fnname) < 0)
2900                 return error_mark_node;
2901               return build_chill_duration (TREE_VALUE (args), SECS_MULTIPLIER,
2902                                            fnname, SECS_MAX);
2903             case BUILT_IN_SEQUENCIBLE:
2904               if (check_arglist_length (args, 1, 1, fnname) < 0)
2905                 return error_mark_node;
2906               return build_chill_sequencible (TREE_VALUE (args));
2907             case BUILT_IN_SETTEXTACCESS:
2908               if (check_arglist_length (args, 2, 2, fnname) < 0)
2909                 return error_mark_node;
2910               return build_chill_settextaccess (TREE_VALUE (args),
2911                                                 TREE_VALUE (TREE_CHAIN (args)));
2912             case BUILT_IN_SETTEXTINDEX:
2913               if (check_arglist_length (args, 2, 2, fnname) < 0)
2914                 return error_mark_node;
2915               return build_chill_settextindex (TREE_VALUE (args),
2916                                                TREE_VALUE (TREE_CHAIN (args)));
2917             case BUILT_IN_SETTEXTRECORD:
2918               if (check_arglist_length (args, 2, 2, fnname) < 0)
2919                 return error_mark_node;
2920               return build_chill_settextrecord (TREE_VALUE (args),
2921                                                 TREE_VALUE (TREE_CHAIN (args)));
2922             case BUILT_IN_CH_SIN:
2923               if (check_arglist_length (args, 1, 1, fnname) < 0)
2924                 return error_mark_node;
2925               return build_chill_floatcall (TREE_VALUE (args),
2926                                             IDENTIFIER_POINTER (fnname),
2927                                             "__sin");
2928             case BUILT_IN_SIZE:
2929               if (check_arglist_length (args, 1, 1, fnname) < 0)
2930                 return error_mark_node;
2931               return build_chill_sizeof (TREE_VALUE (args));
2932             case BUILT_IN_SQRT:
2933               if (check_arglist_length (args, 1, 1, fnname) < 0)
2934                 return error_mark_node;
2935               return build_chill_floatcall (TREE_VALUE (args),
2936                                             IDENTIFIER_POINTER (fnname),
2937                                             "__sqrt");
2938             case BUILT_IN_SUCC:
2939               if (check_arglist_length (args, 1, 1, fnname) < 0)
2940                 return error_mark_node;
2941               return build_chill_pred_or_succ (TREE_VALUE (args), PLUS_EXPR);
2942             case BUILT_IN_TAN:
2943               if (check_arglist_length (args, 1, 1, fnname) < 0)
2944                 return error_mark_node;
2945               return build_chill_floatcall (TREE_VALUE (args),
2946                                             IDENTIFIER_POINTER (fnname),
2947                                             "__tan");
2948             case BUILT_IN_TERMINATE:
2949               if (check_arglist_length (args, 1, 1, fnname) < 0)
2950                 return error_mark_node;
2951               return build_chill_terminate (TREE_VALUE (args));
2952             case BUILT_IN_UPPER:
2953               if (check_arglist_length (args, 1, 1, fnname) < 0)
2954                 return error_mark_node;
2955               return build_chill_upper (TREE_VALUE (args));
2956             case BUILT_IN_VARIABLE:
2957               if (check_arglist_length (args, 1, 1, fnname) < 0)
2958                 return error_mark_node;
2959               return build_chill_variable (TREE_VALUE (args));
2960             case BUILT_IN_WRITEABLE:
2961               if (check_arglist_length (args, 1, 1, fnname) < 0)
2962                 return error_mark_node;
2963               return build_chill_writeable (TREE_VALUE (args));
2964             case BUILT_IN_WRITERECORD:
2965               if (check_arglist_length (args, 2, 3, fnname) < 0)
2966                 return error_mark_node;
2967               return build_chill_writerecord (TREE_VALUE (args), TREE_CHAIN (args));
2968             case BUILT_IN_WRITETEXT:
2969               if (check_arglist_length (args, 2, -1, fnname) < 0)
2970                 return error_mark_node;
2971               return build_chill_writetext (TREE_VALUE (args),
2972                                             TREE_CHAIN (args));
2973
2974             case BUILT_IN_EXPIRED:
2975             case BUILT_IN_WAIT:
2976               sorry ("unimplemented builtin function `%s'",
2977                      IDENTIFIER_POINTER (fnname));
2978               break;
2979             default:
2980               error ("internal error - bad builtin function `%s'",
2981                      IDENTIFIER_POINTER (fnname));
2982             }
2983         }
2984       return build_chill_function_call (func, args);
2985     }
2986
2987   if (chill_varying_type_p (TREE_TYPE (func)))
2988     type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
2989
2990   if (CH_STRING_TYPE_P (type))
2991     {
2992       if (args == NULL_TREE)
2993         {
2994           error ("empty expression in string index");
2995           return error_mark_node;
2996         }
2997       if (TREE_CHAIN (args) != NULL)
2998         {
2999           error ("only one expression allowed in string index");
3000           return error_mark_node;
3001         }
3002       if (flag_old_strings)
3003         return build_chill_slice_with_length (func,
3004                                               TREE_VALUE (args),
3005                                               integer_one_node);
3006       else if (CH_BOOLS_TYPE_P (type))
3007         return build_chill_bitref (func, args);
3008       else
3009         return build_chill_array_ref (func, args);
3010     }
3011
3012   else if (TREE_CODE (type) == ARRAY_TYPE)
3013     return build_chill_array_ref (func, args);
3014
3015   if (TREE_CODE (func) != ERROR_MARK)
3016     error ("invalid: primval ( untyped_exprlist )");
3017   return error_mark_node;
3018 }
3019 \f
3020 /* Given a set stored as one bit per char (in BUFFER[0 .. BIT_SIZE-1]),
3021    return a CONTRUCTOR, of type TYPE (a SET_TYPE). */
3022 static tree
3023 expand_packed_set (buffer, bit_size, type)
3024      const char *buffer;
3025      int   bit_size;
3026      tree type;
3027 {
3028   /* The ordinal number corresponding to the first stored bit. */
3029   HOST_WIDE_INT first_bit_no =
3030     TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (type)));
3031   tree list = NULL_TREE;
3032   int i;
3033
3034   for (i = 0; i < bit_size; i++)
3035     if (buffer[i])
3036       {
3037         int next_0;
3038         for (next_0 = i + 1;
3039              next_0 < bit_size && buffer[next_0]; next_0++)
3040           ;
3041         if (next_0 == i + 1)
3042           list = tree_cons (NULL_TREE,
3043                    build_int_2 (i + first_bit_no, 0), list);
3044         else
3045           {
3046             list = tree_cons (build_int_2 (i + first_bit_no, 0),
3047                               build_int_2 (next_0 - 1 + first_bit_no, 0), list);
3048             /* advance i past the range of 1-bits */
3049             i = next_0;
3050           }
3051       }
3052   list = build (CONSTRUCTOR, type, NULL_TREE, nreverse (list));
3053   TREE_CONSTANT (list) = 1;
3054   return list;
3055 }
3056 \f
3057 /*
3058  * fold a set represented as a CONSTRUCTOR list.
3059  * An empty set has a NULL_TREE in its TREE_OPERAND (set, 1) slot.
3060  */
3061 static tree
3062 fold_set_expr (code, op0, op1)
3063      enum chill_tree_code code;
3064      tree op0, op1;
3065 {
3066   tree temp;
3067   char *buffer0, *buffer1 = NULL, *bufferr;
3068   int i, size0, size1, first_unused_bit;
3069
3070   if (! TREE_CONSTANT (op0) || TREE_CODE (op0) != CONSTRUCTOR)
3071       return NULL_TREE;
3072
3073   if (op1
3074       && (! TREE_CONSTANT (op1) || TREE_CODE (op1) != CONSTRUCTOR))
3075     return NULL_TREE;
3076
3077   size0 = int_size_in_bytes (TREE_TYPE (op0)) * BITS_PER_UNIT;
3078   if (size0 < 0)
3079     {
3080       error ("operand is variable-size bitstring/power-set");
3081       return error_mark_node;
3082     }
3083   buffer0 = (char*) alloca (size0);
3084
3085   temp = get_set_constructor_bits (op0, buffer0, size0);
3086   if (temp)
3087     return NULL_TREE;
3088
3089   if (op0 && op1)
3090     {
3091       size1 = int_size_in_bytes (TREE_TYPE (op1)) * BITS_PER_UNIT;
3092       if (size1 < 0)
3093         {
3094           error ("operand is variable-size bitstring/power-set");
3095           return error_mark_node;
3096         }
3097       if (size0 != size1)
3098         return NULL_TREE;
3099       buffer1 = (char*) alloca (size1);
3100       temp = get_set_constructor_bits (op1, buffer1, size1);
3101       if (temp)
3102         return NULL_TREE;
3103     }
3104
3105   bufferr = (char*) alloca (size0); /* result buffer */
3106
3107   switch ((int)code)
3108     {
3109     case SET_NOT_EXPR:
3110     case BIT_NOT_EXPR:
3111       for (i = 0; i < size0; i++)
3112         bufferr[i] = 1 & ~buffer0[i];
3113       goto build_result;
3114     case SET_AND_EXPR:
3115     case BIT_AND_EXPR:
3116       for (i = 0; i < size0; i++)
3117         bufferr[i] = buffer0[i] & buffer1[i];
3118       goto build_result;
3119     case SET_IOR_EXPR:
3120     case BIT_IOR_EXPR:
3121       for (i = 0; i < size0; i++)
3122         bufferr[i] = buffer0[i] | buffer1[i];
3123       goto build_result;
3124     case SET_XOR_EXPR:
3125     case BIT_XOR_EXPR:
3126       for (i = 0; i < size0; i++)
3127         bufferr[i] = (buffer0[i] ^ buffer1[i]) & 1;
3128       goto build_result;
3129     case SET_DIFF_EXPR:
3130     case MINUS_EXPR:
3131       for (i = 0; i < size0; i++)
3132         bufferr[i] = buffer0[i] & ~buffer1[i];
3133       goto build_result;
3134     build_result:
3135       /* mask out unused bits. Same as runtime library does. */
3136       first_unused_bit = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (op0))))
3137         - TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (op0)))) + 1;
3138       for (i = first_unused_bit; i < size0 ; i++)
3139         bufferr[i] = 0;
3140       return expand_packed_set (bufferr, size0, TREE_TYPE (op0));
3141     case EQ_EXPR:
3142       for (i = 0; i < size0; i++)
3143         if (buffer0[i] != buffer1[i])
3144           return boolean_false_node;
3145       return boolean_true_node;
3146
3147     case NE_EXPR:
3148       for (i = 0; i < size0; i++)
3149         if (buffer0[i] != buffer1[i])
3150           return boolean_true_node;
3151       return boolean_false_node;
3152
3153     default:
3154       return NULL_TREE;
3155     }
3156 }
3157 \f
3158 /*
3159  * build a set or bit-array expression.  Type-checking is
3160  * done elsewhere.
3161  */
3162 static tree
3163 build_compare_set_expr (code, op0, op1)
3164      enum tree_code code;
3165      tree op0, op1;
3166 {
3167   tree result_type = NULL_TREE;
3168   const char *fnname;
3169   tree x;
3170
3171   /* These conversions are needed if -fold-strings. */
3172   if (TREE_CODE (TREE_TYPE (op0)) == BOOLEAN_TYPE)
3173     {
3174       if (CH_BOOLS_ONE_P (TREE_TYPE (op1)))
3175         return build_compare_discrete_expr (code,
3176                                             op0,
3177                                             convert (boolean_type_node, op1));
3178       else
3179         op0 = convert (bitstring_one_type_node, op0);
3180     }
3181   if (TREE_CODE (TREE_TYPE (op1)) == BOOLEAN_TYPE)
3182     {
3183       if (CH_BOOLS_ONE_P (TREE_TYPE (op0)))
3184         return build_compare_discrete_expr (code,
3185                                             convert (boolean_type_node, op0),
3186                                             op1);
3187       else
3188         op1 = convert (bitstring_one_type_node, op1);
3189     }
3190
3191   switch ((int)code)
3192     {
3193     case EQ_EXPR:
3194       {
3195         tree temp = fold_set_expr (EQ_EXPR, op0, op1);
3196         if (temp)
3197           return temp;
3198         fnname = "__eqpowerset";
3199         goto compare_powerset;
3200       }
3201       break;
3202
3203     case GE_EXPR:
3204       /* switch operands and fall thru */
3205       x = op0;
3206       op0 = op1;
3207       op1 = x;
3208
3209     case LE_EXPR:
3210       fnname = "__lepowerset";
3211       goto compare_powerset;
3212
3213     case GT_EXPR:
3214       /* switch operands and fall thru */
3215       x = op0;
3216       op0 = op1;
3217       op1 = x;
3218
3219     case LT_EXPR:
3220       fnname = "__ltpowerset";
3221       goto compare_powerset;
3222
3223     case NE_EXPR:
3224       return invert_truthvalue (build_compare_set_expr (EQ_EXPR, op0, op1));
3225
3226     compare_powerset:
3227       {
3228         tree tsize = powersetlen (op0);
3229
3230         if (TREE_CODE (TREE_TYPE (op0)) != SET_TYPE)
3231           tsize = fold (build (MULT_EXPR, sizetype, tsize,
3232                                size_int (BITS_PER_UNIT)));
3233
3234         return build_chill_function_call (lookup_name (get_identifier (fnname)),
3235                tree_cons (NULL_TREE, force_addr_of (op0),
3236                  tree_cons (NULL_TREE, force_addr_of (op1),
3237                    tree_cons (NULL_TREE, tsize, NULL_TREE))));
3238       }
3239       break;
3240
3241     default:
3242       if ((int) code >= (int)LAST_AND_UNUSED_TREE_CODE)
3243         {
3244           error ("tree code `%s' unhandled in build_compare_set_expr",
3245                  tree_code_name[(int)code]);
3246           return error_mark_node;
3247         }
3248       break;
3249     }
3250
3251   return build ((enum tree_code)code, result_type,
3252                 op0, op1);
3253 }
3254 \f
3255 /* Convert a varying string (or array) to dynamic non-varying string:
3256    EXP becomes EXP.var_data(0 UP EXP.var_length). */
3257
3258 tree
3259 varying_to_slice (exp)
3260      tree exp;
3261 {
3262   if (!chill_varying_type_p (TREE_TYPE (exp)))
3263     return exp;
3264   else
3265     { tree size, data, data_domain, min;
3266       tree novelty = CH_NOVELTY (TREE_TYPE (exp));
3267       exp = save_if_needed (exp);
3268       size = build_component_ref (exp, var_length_id);
3269       data = build_component_ref (exp, var_data_id);
3270       TREE_TYPE (data) = copy_novelty (novelty, TREE_TYPE (data));
3271       data_domain = TYPE_DOMAIN (TREE_TYPE (data));
3272       if (data_domain != NULL_TREE
3273           && TYPE_MIN_VALUE (data_domain) != NULL_TREE)
3274         min = TYPE_MIN_VALUE (data_domain);
3275       else
3276         min = integer_zero_node;
3277       return build_chill_slice (data, min, size);
3278     }
3279 }
3280
3281 /* Convert a scalar argument to a string or array type.  This is a subroutine
3282    of `build_concat_expr'.  */
3283
3284 static tree
3285 scalar_to_string (exp)
3286      tree exp;
3287 {
3288   tree type = TREE_TYPE (exp);
3289
3290   if (SCALAR_P (type))
3291     {
3292       int was_const = TREE_CONSTANT (exp);
3293       if (TREE_TYPE (exp) == char_type_node)
3294         exp = convert (string_one_type_node, exp);
3295       else if (TREE_TYPE (exp) == boolean_type_node)
3296         exp = convert (bitstring_one_type_node, exp);
3297       else
3298         exp = convert (build_array_type_for_scalar (type), exp);
3299       TREE_CONSTANT (exp) = was_const;
3300       return exp;
3301     }
3302   return varying_to_slice (exp);
3303 }
3304
3305 /* FIXME:  Generalize this to general arrays (not just strings),
3306    at least for the compiler-generated case of padding fixed-length arrays. */
3307
3308 static tree
3309 build_concat_expr (op0, op1)
3310      tree op0, op1;
3311 {
3312   tree orig_op0 = op0, orig_op1 = op1;
3313   tree type0, type1, size0, size1, res;
3314
3315   op0 = scalar_to_string (op0);
3316   type0 = TREE_TYPE (op0);
3317   op1 = scalar_to_string (op1);
3318   type1 = TREE_TYPE (op1);
3319   size1 = size_in_bytes (type1);
3320
3321   /* try to fold constant string literals */
3322   if (TREE_CODE (op0) == STRING_CST
3323       && (TREE_CODE (op1) == STRING_CST
3324           || TREE_CODE (op1) == UNDEFINED_EXPR)
3325       && TREE_CODE (size1) == INTEGER_CST)
3326     {
3327       int len0 = TREE_STRING_LENGTH (op0);
3328       int len1 = TREE_INT_CST_LOW (size1);
3329       char *result = xmalloc (len0 + len1 + 1);
3330       memcpy (result, TREE_STRING_POINTER (op0), len0);
3331       if (TREE_CODE (op1) == UNDEFINED_EXPR)
3332         memset (&result[len0], '\0', len1);
3333       else
3334         memcpy (&result[len0], TREE_STRING_POINTER (op1), len1);
3335       return build_chill_string (len0 + len1, result);
3336     }
3337   else if (TREE_CODE (type0) == TREE_CODE (type1))
3338     {
3339       tree result_size;
3340       struct ch_class result_class;
3341       struct ch_class class0;
3342       struct ch_class class1;
3343
3344       class0 = chill_expr_class (orig_op0);
3345       class1 = chill_expr_class (orig_op1);
3346
3347       if (TREE_CODE (type0) == SET_TYPE)
3348         {
3349           result_size = fold (build (PLUS_EXPR, integer_type_node,
3350                                      discrete_count (TYPE_DOMAIN (type0)),
3351                                      discrete_count (TYPE_DOMAIN (type1))));
3352           result_class.mode = build_bitstring_type (result_size);
3353         }
3354       else
3355         {
3356           tree max0 = TYPE_MAX_VALUE (type0);
3357           tree max1 = TYPE_MAX_VALUE (type1);
3358
3359           /* new array's dynamic size (in bytes). */
3360           size0     = size_in_bytes (type0);
3361           /* size1 was computed above.  */
3362
3363           result_size = size_binop (PLUS_EXPR, size0, size1);
3364           /* new array's type. */
3365           result_class.mode = build_string_type (char_type_node, result_size);
3366
3367           if (max0 || max1)
3368             {
3369               max0 = max0 == 0 ? size0 : convert (sizetype, max0);
3370               max1 = max1 == 0 ? size1 : convert (sizetype, max1);
3371               TYPE_MAX_VALUE (result_class.mode)
3372                 = size_binop (PLUS_EXPR, max0, max1);
3373             }
3374         }
3375
3376       if (class0.kind == CH_VALUE_CLASS || class1.kind == CH_VALUE_CLASS)
3377         {
3378           tree novelty0 = CH_NOVELTY (TREE_TYPE (orig_op0));
3379           result_class.kind = CH_VALUE_CLASS;
3380           if (class0.kind == CH_VALUE_CLASS && novelty0 != NULL_TREE)
3381             SET_CH_NOVELTY_NONNIL (result_class.mode, novelty0);
3382           else if (class1.kind == CH_VALUE_CLASS)
3383             SET_CH_NOVELTY (result_class.mode,
3384                             CH_NOVELTY (TREE_TYPE (orig_op1)));
3385         }
3386       else
3387         result_class.kind = CH_DERIVED_CLASS;
3388
3389       if (TREE_CODE (result_class.mode) == SET_TYPE
3390           && TREE_CONSTANT (op0) && TREE_CONSTANT (op1)
3391           && TREE_CODE (op0) == CONSTRUCTOR && TREE_CODE (op1) == CONSTRUCTOR)
3392         {
3393           HOST_WIDE_INT size0, size1;  char *buffer;
3394           size0 = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type0))) + 1;
3395           size1 = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type1))) + 1;
3396           buffer = (char*) alloca (size0 + size1);
3397           if (size0 < 0 || size1 < 0
3398               || get_set_constructor_bits (op0, buffer, size0)
3399               || get_set_constructor_bits (op1, buffer + size0, size1))
3400             abort ();
3401           res = expand_packed_set (buffer, size0 + size1, result_class.mode);
3402         }
3403       else
3404         res = build (CONCAT_EXPR, result_class.mode, op0, op1);
3405       return convert_to_class (result_class, res);
3406     }
3407   else
3408     {
3409       error ("incompatible modes in concat expression");
3410       return error_mark_node;
3411     }
3412 }
3413
3414 /*
3415  * handle varying and fixed array compare operations
3416  */
3417 static tree
3418 build_compare_string_expr (code, op0, op1)
3419      enum tree_code code;
3420      tree op0, op1;
3421 {
3422   if (op0 == NULL_TREE || TREE_CODE (op0) == ERROR_MARK)
3423     return error_mark_node;
3424   if (op1 == NULL_TREE || TREE_CODE (op1) == ERROR_MARK)
3425     return error_mark_node;
3426
3427   if (tree_int_cst_equal (TYPE_SIZE (TREE_TYPE (op0)),
3428                           TYPE_SIZE (TREE_TYPE (op1)))
3429       && ! chill_varying_type_p (TREE_TYPE (op0))
3430       && ! chill_varying_type_p (TREE_TYPE (op1)))
3431     {
3432       tree size = size_in_bytes (TREE_TYPE (op0));
3433       tree temp = lookup_name (get_identifier ("memcmp"));
3434       temp = build_chill_function_call (temp,
3435                  tree_cons (NULL_TREE, force_addr_of (op0),
3436                      tree_cons (NULL_TREE, force_addr_of (op1),
3437                        tree_cons (NULL_TREE, size, NULL_TREE))));
3438       return build_compare_discrete_expr (code, temp, integer_zero_node);
3439     }
3440
3441   switch ((int)code)
3442     {
3443     case EQ_EXPR:
3444       code = STRING_EQ_EXPR;
3445       break;
3446     case GE_EXPR:
3447       return invert_truthvalue (build_compare_string_expr (LT_EXPR, op0, op1));
3448     case LE_EXPR:
3449       return invert_truthvalue (build_compare_string_expr (LT_EXPR, op1, op0));
3450     case GT_EXPR:
3451       return build_compare_string_expr (LT_EXPR, op1, op0);
3452     case LT_EXPR:
3453       code = STRING_LT_EXPR;
3454       break;
3455     case NE_EXPR:
3456       return invert_truthvalue (build_compare_string_expr (EQ_EXPR, op0, op1));
3457     default:
3458       error ("Invalid operation on array of chars");
3459       return error_mark_node;
3460     }
3461
3462   return build (code, boolean_type_node, op0, op1);
3463 }
3464
3465 static tree
3466 compare_records (exp0, exp1)
3467      tree exp0, exp1;
3468 {
3469   tree type = TREE_TYPE (exp0);
3470   tree field;
3471   int have_variants = 0;
3472
3473   tree result = boolean_true_node;
3474
3475   if (TREE_CODE (type) != RECORD_TYPE)
3476     abort ();
3477
3478   exp0 = save_if_needed (exp0);
3479   exp1 = save_if_needed (exp1);
3480
3481   for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
3482     {
3483       if (DECL_NAME (field) == NULL_TREE)
3484         {
3485           have_variants = 1;
3486           break;
3487         }
3488     }
3489
3490   /* in case of -fpack we always do a memcmp */
3491   if (maximum_field_alignment != 0)
3492     {
3493       tree memcmp_func = lookup_name (get_identifier ("memcmp"));
3494       tree arg1 = force_addr_of (exp0);
3495       tree arg2 = force_addr_of (exp1);
3496       tree arg3 = size_in_bytes (type);
3497       tree fcall = build_chill_function_call (memcmp_func,
3498                      tree_cons (NULL_TREE, arg1,
3499                        tree_cons (NULL_TREE, arg2,
3500                          tree_cons (NULL_TREE, arg3, NULL_TREE))));
3501
3502       if (have_variants)
3503         warning ("comparison of variant structures is unsafe");
3504       result = build_chill_binary_op (EQ_EXPR, fcall, integer_zero_node);
3505       return result;
3506     }
3507
3508   if (have_variants)
3509     {
3510       sorry ("compare with variant records");
3511       return error_mark_node;
3512     }
3513
3514   for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
3515     {
3516       tree exp0fld = build_component_ref (exp0, DECL_NAME (field));
3517       tree exp1fld = build_component_ref (exp1, DECL_NAME (field));
3518       tree eq_flds = build_chill_binary_op (EQ_EXPR, exp0fld, exp1fld);
3519       result = build_chill_binary_op (TRUTH_AND_EXPR, result, eq_flds);
3520     }
3521   return result;
3522 }
3523 \f
3524 int
3525 compare_int_csts (op, val1, val2)
3526      enum tree_code op;
3527      tree val1, val2;
3528 {
3529   int result;
3530   tree tmp;
3531   tree type1 = TREE_TYPE (val1);
3532   tree type2 = TREE_TYPE (val2);
3533   switch (op)
3534     {
3535     case GT_EXPR:
3536     case GE_EXPR:
3537       tmp = val1;  val1 = val2;  val2 = tmp;
3538       tmp = type1;  type1 = type2; type2 = tmp;
3539       op = (op == GT_EXPR) ? LT_EXPR : LE_EXPR;
3540       /* ... fall through ... */
3541     case LT_EXPR:
3542     case LE_EXPR:
3543       if (!TREE_UNSIGNED (type1))
3544         {
3545           if (!TREE_UNSIGNED (type2))
3546             result = INT_CST_LT (val1, val2);
3547           else if (TREE_INT_CST_HIGH (val1) < 0)
3548             result = 1;
3549           else
3550             result = INT_CST_LT_UNSIGNED (val1, val2);
3551         }
3552       else
3553         {
3554           if (!TREE_UNSIGNED (type2) && TREE_INT_CST_HIGH (val2) < 0)
3555             result = 0;
3556           else
3557             result = INT_CST_LT_UNSIGNED (val1, val2);
3558         }
3559       if (op == LT_EXPR || result == 1)
3560         break;
3561       /* else fall through ... */
3562     case NE_EXPR:
3563     case EQ_EXPR:
3564       if (TREE_INT_CST_LOW (val1) == TREE_INT_CST_LOW (val2)
3565           && TREE_INT_CST_HIGH (val1) == TREE_INT_CST_HIGH (val2)
3566           /* They're bitwise equal.
3567              Check for one being negative and the other unsigned. */
3568           && (TREE_INT_CST_HIGH (val2) >= 0
3569               || TREE_UNSIGNED (TREE_TYPE (val1))
3570               == TREE_UNSIGNED (TREE_TYPE (val2))))
3571         result = 1;
3572       else
3573         result = 0;
3574       if (op == NE_EXPR)
3575         result = !result;
3576       break;
3577     default:
3578       abort();
3579     }
3580   return result;
3581 }
3582
3583 /* Build an expression to compare discrete values VAL1 and VAL2.
3584    This does not check that they are discrete, nor that they are
3585    compatible;  if you need such checks use build_compare_expr. */
3586
3587 tree
3588 build_compare_discrete_expr (op, val1, val2)
3589      enum tree_code op;
3590      tree val1, val2;
3591 {
3592   tree type1 = TREE_TYPE (val1);
3593   tree type2 = TREE_TYPE (val2);
3594   tree tmp;
3595
3596   if (TREE_CODE (val1) == INTEGER_CST && TREE_CODE (val2) == INTEGER_CST)
3597     {
3598       if (compare_int_csts (op, val1, val2))
3599         return boolean_true_node;
3600       else
3601         return boolean_false_node;
3602     }
3603
3604   if (TREE_UNSIGNED (type1) != TREE_UNSIGNED (type2))
3605     {
3606       switch (op)
3607         {
3608         case GT_EXPR:
3609         case GE_EXPR:
3610           tmp = val1;  val1 = val2;  val2 = tmp;
3611           tmp = type1;  type1 = type2; type2 = tmp;
3612           op = (op == GT_EXPR) ? LT_EXPR : LE_EXPR;
3613           /* ... fall through ... */
3614         case LT_EXPR:
3615         case LE_EXPR:
3616           if (TREE_UNSIGNED (type2))
3617             {
3618               tmp = build_int_2_wide (0, 0);
3619               TREE_TYPE (tmp) = type1;
3620               val1 = save_expr (val1);
3621               tmp = fold (build (LT_EXPR, boolean_type_node, val1, tmp));
3622               if (TYPE_PRECISION (type2) < TYPE_PRECISION (type1))
3623                 {
3624                   type2 = unsigned_type (type1);
3625                   val2 = convert_to_integer (type2, val2);
3626                 }
3627               val1 = convert_to_integer (type2, val1);
3628               return fold (build (TRUTH_OR_EXPR, boolean_type_node,
3629                                   tmp,
3630                                   fold (build (op, boolean_type_node,
3631                                                val1, val2))));
3632             }
3633         unsigned_vs_signed: /* val1 is unsigned, val2 is signed */
3634           tmp = build_int_2_wide (0, 0);
3635           TREE_TYPE (tmp) = type2;
3636           val2 = save_expr (val2);
3637           tmp = fold (build (GE_EXPR, boolean_type_node, val2, tmp));
3638           if (TYPE_PRECISION (type1) < TYPE_PRECISION (type2))
3639             {
3640               type1 = unsigned_type (type2);
3641               val1 = convert_to_integer (type1, val1);
3642             }
3643           val2 = convert_to_integer (type1, val2);
3644           return fold (build (TRUTH_AND_EXPR, boolean_type_node, tmp,
3645                               fold (build (op, boolean_type_node,
3646                                            val1, val2))));
3647         case EQ_EXPR:
3648           if (TREE_UNSIGNED (val2))
3649             {
3650               tmp = val1;  val1 = val2;  val2 = tmp;
3651               tmp = type1;  type1 = type2; type2 = tmp;
3652             }
3653           goto unsigned_vs_signed;
3654         case NE_EXPR:
3655           tmp = build_compare_expr (EQ_EXPR, val1, val2);
3656           return build_chill_unary_op (TRUTH_NOT_EXPR, tmp);
3657         default:
3658           abort();
3659         }
3660     }
3661   if (TYPE_PRECISION (type1) > TYPE_PRECISION (type2))
3662     val2 = convert (type1, val2);
3663   else if (TYPE_PRECISION (type1) < TYPE_PRECISION (type2))
3664     val1 = convert (type2, val1);
3665   return fold (build (op, boolean_type_node, val1, val2));
3666 }
3667
3668 tree
3669 build_compare_expr (op, val1, val2)
3670      enum tree_code op;
3671      tree val1, val2;
3672 {
3673   tree tmp;
3674   tree type1, type2;
3675   val1 = check_have_mode (val1, "relational expression");
3676   val2 = check_have_mode (val2, "relational expression");
3677   if (val1 == NULL_TREE || TREE_CODE (val1) == ERROR_MARK)
3678     return error_mark_node;
3679   if (val2 == NULL_TREE || TREE_CODE (val2) == ERROR_MARK)
3680     return error_mark_node;
3681
3682   if (pass == 1)
3683     return build (op, NULL_TREE, val1, val2);
3684
3685   if (!CH_COMPATIBLE_CLASSES (val1, val2))
3686     {
3687       error ("incompatible operands to %s", boolean_code_name [op]);
3688       return error_mark_node;
3689     }
3690
3691   tmp = CH_ROOT_MODE (TREE_TYPE (val1));
3692   if (tmp != TREE_TYPE (val1))
3693     val1 = convert (tmp, val1);
3694   tmp = CH_ROOT_MODE (TREE_TYPE (val2));
3695   if (tmp != TREE_TYPE (val2))
3696     val2 = convert (tmp, val2);
3697
3698   type1 = TREE_TYPE (val1);
3699   type2 = TREE_TYPE (val2);
3700
3701   if (TREE_CODE (type1) == SET_TYPE)
3702     tmp =  build_compare_set_expr (op, val1, val2);
3703
3704   else if (discrete_type_p (type1))
3705     tmp = build_compare_discrete_expr (op, val1, val2);
3706
3707   else if (chill_varying_type_p (type1) || chill_varying_type_p (type2)
3708       || (TREE_CODE (type1) == ARRAY_TYPE
3709           && TREE_CODE (TREE_TYPE (type1)) == CHAR_TYPE)
3710       || (TREE_CODE (type2) == ARRAY_TYPE
3711           && TREE_CODE (TREE_TYPE (type2)) == CHAR_TYPE) )
3712     tmp =  build_compare_string_expr (op, val1, val2);
3713
3714   else if ((TREE_CODE (type1) == RECORD_TYPE
3715             || TREE_CODE (type2) == RECORD_TYPE)
3716            && (op == EQ_EXPR || op == NE_EXPR))
3717     {
3718       /* This is for handling INSTANCEs being compared against NULL. */
3719       if (val1 == null_pointer_node)
3720         val1 = convert (type2, val1);
3721       if (val2 == null_pointer_node)
3722         val2 = convert (type1, val2);
3723
3724       tmp = compare_records (val1, val2);
3725       if (op == NE_EXPR)
3726         tmp = build_chill_unary_op (TRUTH_NOT_EXPR, tmp);
3727     }
3728
3729   else if (TREE_CODE (type1) == REAL_TYPE || TREE_CODE (type2) == REAL_TYPE
3730            || (op == EQ_EXPR || op == NE_EXPR))
3731     {
3732       tmp = build (op, boolean_type_node, val1, val2);
3733       CH_DERIVED_FLAG (tmp) = 1; /* Optimization to avoid copy_node. */
3734       tmp = fold (tmp);
3735     }
3736
3737   else
3738     {
3739       error ("relational operator not allowed for this mode");
3740       return error_mark_node;
3741     }
3742
3743   if (!CH_DERIVED_FLAG (tmp))
3744     {
3745       tmp = copy_node (tmp);
3746       CH_DERIVED_FLAG (tmp) = 1;
3747     }
3748   return tmp;
3749 }
3750 \f
3751 tree
3752 finish_chill_binary_op (node)
3753      tree node;
3754 {
3755   tree op0 = check_have_mode (TREE_OPERAND (node, 0), "binary expression");
3756   tree op1 = check_have_mode (TREE_OPERAND (node, 1), "binary expression");
3757   tree type0 = TREE_TYPE (op0);
3758   tree type1 = TREE_TYPE (op1);
3759   tree folded;
3760
3761   if (TREE_CODE (op0) == ERROR_MARK || TREE_CODE (op1) == ERROR_MARK)
3762     return error_mark_node;
3763
3764   if (UNSATISFIED (op0) || UNSATISFIED (op1))
3765     {
3766       UNSATISFIED_FLAG (node) = 1;
3767       return node;
3768     }
3769 #if 0
3770   /* assure that both operands have a type */
3771   if (! type0 && type1)
3772     {
3773       op0 = convert (type1, op0);
3774       type0 = TREE_TYPE (op0);
3775     }
3776   if (! type1 && type0)
3777     {
3778       op1 = convert (type0, op1);
3779       type1 = TREE_TYPE (op1);
3780     }
3781 #endif
3782   UNSATISFIED_FLAG (node) = 0;
3783 #if 0
3784
3785   { int op0f = TREE_CODE (op0) == FUNCTION_DECL;
3786     int op1f = TREE_CODE (op1) == FUNCTION_DECL;
3787     if (op0f)
3788       op0 = convert (build_pointer_type (TREE_TYPE (op0)), op0);
3789     if (op1f)
3790       op1 = convert (build_pointer_type (TREE_TYPE (op1)), op1);
3791     if ((op0f || op1f)
3792         && code != EQ_EXPR && code != NE_EXPR)
3793       error ("Cannot use %s operator on PROC mode variable",
3794              tree_code_name[(int)code]);
3795   }
3796
3797   if (invalid_left_operand (type0, code))
3798     {
3799       error ("invalid left operand of %s", tree_code_name[(int)code]);
3800       return error_mark_node;
3801     }
3802   if (invalid_right_operand (code, type1))
3803     {
3804       error ("invalid right operand of %s", tree_code_name[(int)code]);
3805       return error_mark_node;
3806     }
3807 #endif
3808
3809   switch (TREE_CODE (node))
3810     {
3811     case CONCAT_EXPR:
3812       return build_concat_expr (op0, op1);
3813
3814     case REPLICATE_EXPR:
3815       op0 = fold (op0);
3816       if (!TREE_CONSTANT (op0) || !TREE_CONSTANT (op1))
3817         {
3818           error ("repetition expression must be constant");
3819           return error_mark_node;
3820         }
3821       else
3822         return build_chill_repetition_op (op0, op1);
3823
3824     case FLOOR_MOD_EXPR:
3825     case TRUNC_MOD_EXPR:
3826       if (TREE_CODE (type0) != INTEGER_TYPE)
3827         {
3828           error ("left argument to MOD/REM operator must be integral");
3829           return error_mark_node;
3830         }
3831       if (TREE_CODE (type1) != INTEGER_TYPE)
3832         {
3833           error ("right argument to MOD/REM operator must be integral");
3834           return error_mark_node;
3835         }
3836       break;
3837
3838     case MINUS_EXPR:
3839       if (TREE_CODE (type1) == SET_TYPE)
3840         {
3841           tree temp = fold_set_expr (MINUS_EXPR, op0, op1);
3842
3843           if (temp)
3844             return temp;
3845           if (TYPE_MODE (type1) == BLKmode)
3846             TREE_SET_CODE (node, SET_DIFF_EXPR);
3847           else
3848             {
3849               op1 = build_chill_unary_op (BIT_NOT_EXPR, op1);
3850               TREE_OPERAND (node, 1) = op1;
3851               TREE_SET_CODE (node, BIT_AND_EXPR);
3852             }
3853         }
3854       break;
3855
3856     case TRUNC_DIV_EXPR:
3857       if (TREE_CODE (type0) == REAL_TYPE || TREE_CODE (type1) == REAL_TYPE)
3858         TREE_SET_CODE (node, RDIV_EXPR);
3859       break;
3860
3861     case BIT_AND_EXPR:
3862       if (TYPE_MODE (type1) == BLKmode)
3863         TREE_SET_CODE (node, SET_AND_EXPR);
3864       goto fold_set_binop;
3865     case BIT_IOR_EXPR:
3866       if (TYPE_MODE (type1) == BLKmode)
3867         TREE_SET_CODE (node, SET_IOR_EXPR);
3868       goto fold_set_binop;
3869     case BIT_XOR_EXPR:
3870       if (TYPE_MODE (type1) == BLKmode)
3871         TREE_SET_CODE (node, SET_XOR_EXPR);
3872       goto fold_set_binop;
3873     case SET_AND_EXPR:
3874     case SET_IOR_EXPR:
3875     case SET_XOR_EXPR:
3876     case SET_DIFF_EXPR:
3877     fold_set_binop:
3878       if (TREE_CODE (type0) == SET_TYPE)
3879         {
3880           tree temp = fold_set_expr (TREE_CODE (node), op0, op1);
3881
3882           if (temp)
3883             return temp;
3884         }
3885       break;
3886
3887     case SET_IN_EXPR:
3888       if (TREE_CODE (type1) != SET_TYPE || CH_BOOLS_TYPE_P (type1))
3889         {
3890           error ("right operand of IN is not a powerset");
3891           return error_mark_node;
3892         }
3893       if (!CH_COMPATIBLE (op0, TYPE_DOMAIN (type1)))
3894         {
3895           error ("left operand of IN incompatible with right operand");
3896           return error_mark_node;
3897         }
3898       type0 = CH_ROOT_MODE (type0);
3899       if (type0 != TREE_TYPE (op0))
3900         TREE_OPERAND (node, 0) = op0 = convert (type0, op0);
3901       TREE_TYPE (node) = boolean_type_node;
3902       CH_DERIVED_FLAG (node) = 1;
3903       node = fold (node);
3904       if (!CH_DERIVED_FLAG (node))
3905         {
3906           node = copy_node (node);
3907           CH_DERIVED_FLAG (node) = 1;
3908         }
3909       return node;
3910     case NE_EXPR:
3911     case EQ_EXPR:
3912     case GE_EXPR:
3913     case GT_EXPR:
3914     case LE_EXPR:
3915     case LT_EXPR:
3916       return build_compare_expr (TREE_CODE (node), op0, op1);
3917     default:
3918       ;
3919     }
3920
3921   if (!CH_COMPATIBLE_CLASSES (op0, op1))
3922     {
3923       error ("incompatible operands to %s", tree_code_name[(int) TREE_CODE (node)]);
3924       return error_mark_node;
3925     }
3926
3927   if (TREE_TYPE (node) == NULL_TREE)
3928     {
3929       struct ch_class class;
3930       class = CH_ROOT_RESULTING_CLASS (op0, op1);
3931       TREE_OPERAND (node, 0) = op0 = convert_to_class (class, op0);
3932       type0 = TREE_TYPE (op0);
3933       TREE_OPERAND (node, 1) = op1 = convert_to_class (class, op1);
3934       type1 = TREE_TYPE (op1);
3935       TREE_TYPE (node) = class.mode;
3936       folded = convert_to_class (class, fold (node));
3937     }
3938   else
3939     folded = fold (node);
3940 #if 0
3941   if (folded == node)
3942     TREE_CONSTANT (folded) = TREE_CONSTANT (op0) & TREE_CONSTANT (op1);
3943 #endif
3944   if (TREE_CODE (node) == TRUNC_DIV_EXPR)
3945     {
3946       if (TREE_CONSTANT (op1))
3947         {
3948           if (tree_int_cst_equal (op1, integer_zero_node))
3949             {
3950               error ("division by zero");
3951               return integer_zero_node;
3952             }
3953         }
3954       else if (range_checking)
3955         {
3956 #if 0
3957           tree test =
3958             build (EQ_EXPR, boolean_type_node, op1, integer_zero_node);
3959           /* Should this be overflow? */
3960           folded = check_expression (folded, test,
3961                                      ridpointers[(int) RID_RANGEFAIL]);
3962 #endif
3963         }
3964     }
3965   return folded;
3966 }
3967 \f
3968 /*
3969  * This implements the '->' operator, which, like the '&' in C,
3970  * returns a pointer to an object, which has the type of
3971  * pointer-to-that-object.
3972  *
3973  * FORCE is 0 when we're evaluating a user-level syntactic construct,
3974  * and 1 when we're calling from inside the compiler.
3975  */
3976 tree
3977 build_chill_arrow_expr (ref, force)
3978      tree ref;
3979      int force;
3980 {
3981   tree addr_type;
3982   tree result;
3983
3984   if (pass == 1)
3985     {
3986       error ("-> operator not allow in constant expression");
3987       return error_mark_node;
3988     }
3989
3990   if (ref == NULL_TREE || TREE_CODE (ref) == ERROR_MARK)
3991     return ref;
3992
3993   while (TREE_CODE (TREE_TYPE (ref)) == REFERENCE_TYPE)
3994     ref = convert (TREE_TYPE (TREE_TYPE (ref)), ref);
3995
3996   if (!force && ! CH_LOCATION_P (ref))
3997     {
3998       if (TREE_CODE (ref) == STRING_CST)
3999         pedwarn ("taking the address of a string literal is non-standard");
4000       else if (TREE_CODE (TREE_TYPE (ref)) == FUNCTION_TYPE)
4001         pedwarn ("taking the address of a function is non-standard");
4002       else
4003         {
4004           error ("ADDR requires a LOCATION argument");
4005           return error_mark_node;
4006         }
4007       /* FIXME: Should we be sure that ref isn't a
4008          function if we're being pedantic? */
4009     }
4010
4011   addr_type = build_pointer_type (TREE_TYPE (ref));
4012
4013 #if 0
4014   /* This transformation makes chill_expr_class return CH_VALUE_CLASS
4015      when it should return CH_REFERENCE_CLASS.  That could be fixed,
4016      but we probably don't want this transformation anyway. */
4017   if (TREE_CODE (ref) == NOP_EXPR) /* RETYPE_EXPR */
4018     {
4019       tree addr;
4020       while (TREE_CODE (ref) == NOP_EXPR) /* RETYPE_EXPR */
4021         ref = TREE_OPERAND (ref, 0);
4022       mark_addressable (ref);
4023       addr = build1 (ADDR_EXPR,
4024                      build_pointer_type (TREE_TYPE (ref)), ref);
4025       return build1 (NOP_EXPR, /* RETYPE_EXPR */
4026                       addr_type,
4027                       addr);
4028     }
4029   else
4030 #endif
4031     {
4032       if (! mark_addressable (ref))
4033         {
4034           error ("-> expression is not addressable");
4035           return error_mark_node;
4036         }
4037       result = build1 (ADDR_EXPR, addr_type, ref);
4038       if (staticp (ref)
4039           && ! (TREE_CODE (ref) == FUNCTION_DECL
4040                 && DECL_CONTEXT (ref) != 0))
4041         TREE_CONSTANT (result) = 1;
4042       return result;
4043     }
4044 }
4045 \f
4046 /*
4047  * This implements the ADDR builtin function, which returns a
4048  * free reference, analogous to the C 'void *'.
4049  */
4050 tree
4051 build_chill_addr_expr (ref, errormsg)
4052      tree ref;
4053      const char *errormsg;
4054 {
4055   if (ref == error_mark_node)
4056     return ref;
4057
4058   if (! CH_LOCATION_P (ref)
4059       && TREE_CODE (TREE_TYPE (ref)) != FUNCTION_TYPE)
4060     {
4061       error ("ADDR parameter must be a LOCATION");
4062       return error_mark_node;
4063     }
4064   ref = build_chill_arrow_expr (ref, 1);
4065
4066   if (ref != NULL_TREE && TREE_CODE (ref) != ERROR_MARK)
4067     TREE_TYPE (ref) = ptr_type_node;
4068   else if (errormsg == NULL)
4069     {
4070       error ("possible internal error in build_chill_arrow_expr");
4071       return error_mark_node;
4072     }
4073   else
4074     {
4075       error ("%s is not addressable", errormsg);
4076       return error_mark_node;
4077     }
4078   return ref;
4079 }
4080 \f
4081 tree
4082 build_chill_binary_op (code, op0, op1)
4083      enum chill_tree_code code;
4084      tree op0, op1;
4085 {
4086   register tree result;
4087
4088   if (op0 == NULL_TREE || TREE_CODE (op0) == ERROR_MARK)
4089     return error_mark_node;
4090   if (op1 == NULL_TREE || TREE_CODE (op1) == ERROR_MARK)
4091     return error_mark_node;
4092
4093   result = build (code, NULL_TREE, op0, op1);
4094
4095   if (pass != 1)
4096     result = finish_chill_binary_op (result);
4097   return result;
4098 }
4099 \f
4100 /*
4101  * process a string repetition phrase '(' COUNT ')' STRING
4102  */
4103 static tree
4104 string_char_rep (count, string)
4105      int count;
4106      tree string;
4107 {
4108   int slen, charindx, repcnt;
4109   char ch;
4110   char *temp;
4111   const char *inp;
4112   char *outp;
4113   tree type;
4114
4115   if (string == NULL_TREE || TREE_CODE (string) == ERROR_MARK)
4116     return error_mark_node;
4117
4118   type = TREE_TYPE (string);
4119   slen = int_size_in_bytes (type);
4120   temp = xmalloc (slen * count);
4121   inp = &ch;
4122   outp = temp;
4123   if (TREE_CODE (string) == STRING_CST)
4124     inp = TREE_STRING_POINTER (string);
4125   else                           /* single character */
4126     ch = (char)TREE_INT_CST_LOW (string);
4127
4128   /* copy the string/char COUNT times into the output buffer */
4129   for (outp = temp, repcnt = 0; repcnt < count; repcnt++)
4130     for (charindx = 0; charindx < slen; charindx++)
4131       *outp++ = inp[charindx];
4132   return build_chill_string (slen * count, temp);
4133 }
4134 \f
4135 /* Build a bit-string constant containing with the given LENGTH
4136    containing all ones (if VALUE is true), or all zeros (if VALUE is false). */
4137
4138 static tree
4139 build_boring_bitstring (length, value)
4140      long length;
4141      int value;
4142 {
4143   tree result;
4144   tree list;  /* Value of CONSTRUCTOR_ELTS in the result. */
4145   if (value && length > 0)
4146     list = tree_cons (integer_zero_node, size_int (length - 1), NULL_TREE);
4147   else
4148     list = NULL_TREE;
4149
4150   result = build (CONSTRUCTOR,
4151                   build_bitstring_type (size_int (length)),
4152                   NULL_TREE,
4153                   list);
4154   TREE_CONSTANT (result) = 1;
4155   CH_DERIVED_FLAG (result) = 1;
4156   return result;
4157 }
4158
4159 /*
4160  * handle a string repetition, with the syntax:
4161  *        ( COUNT ) 'STRING'
4162  * COUNT is required to be constant, positive and folded.
4163  */
4164 tree
4165 build_chill_repetition_op (count_op, string)
4166      tree count_op;
4167      tree string;
4168 {
4169   int count;
4170   tree type = TREE_TYPE (string);
4171
4172   if (TREE_CODE (count_op) != INTEGER_CST)
4173     {
4174       error ("repetition count is not an integer constant");
4175       return error_mark_node;
4176     }
4177
4178   count = TREE_INT_CST_LOW (count_op);
4179
4180   if (count < 0)
4181     {
4182       error ("repetition count < 0");
4183       return error_mark_node;
4184     }
4185   if (! TREE_CONSTANT (string))
4186     {
4187       error ("repetition value not constant");
4188       return error_mark_node;
4189     }
4190
4191   if (TREE_CODE (string) == STRING_CST)
4192     return string_char_rep (count, string);
4193
4194   switch ((int)TREE_CODE (type))
4195     {
4196     case BOOLEAN_TYPE:
4197       if (TREE_CODE (string) == INTEGER_CST)
4198         return build_boring_bitstring (count, TREE_INT_CST_LOW (string));
4199       error ("bitstring repetition of non-constant boolean");
4200       return error_mark_node;
4201
4202     case CHAR_TYPE:
4203       return string_char_rep (count, string);
4204
4205     case SET_TYPE:
4206       { int i, tree_const = 1;
4207         tree new_list = NULL_TREE;
4208         tree vallist;
4209         tree result;
4210         tree domain = TYPE_DOMAIN (type);
4211         tree orig_length;
4212         HOST_WIDE_INT orig_len;
4213
4214         if (!CH_BOOLS_TYPE_P (type)) /* cannot replicate a powerset */
4215           break;
4216
4217         orig_length = discrete_count (domain);
4218
4219         if (TREE_CODE (string) != CONSTRUCTOR || !TREE_CONSTANT (string)
4220             || TREE_CODE (orig_length) != INTEGER_CST)
4221           {
4222             error ("string repetition operand is non-constant bitstring");
4223             return error_mark_node;
4224           }
4225
4226
4227         orig_len = TREE_INT_CST_LOW (orig_length);
4228
4229         /* if the set is empty, this is NULL */
4230         vallist = TREE_OPERAND (string, 1);
4231
4232         if (vallist == NULL_TREE) /* No bits are set. */
4233           return build_boring_bitstring (count * orig_len, 0);
4234         else if (TREE_CHAIN (vallist) == NULL_TREE
4235                  && (TREE_PURPOSE (vallist) == NULL_TREE
4236                      ? (orig_len == 1
4237                         && tree_int_cst_equal (TYPE_MIN_VALUE (domain),
4238                                                TREE_VALUE (vallist)))
4239                      : (tree_int_cst_equal (TYPE_MIN_VALUE (domain),
4240                                             TREE_PURPOSE (vallist))
4241                         && tree_int_cst_equal (TYPE_MAX_VALUE (domain),
4242                                                TREE_VALUE (vallist)))))
4243           return build_boring_bitstring (count * orig_len, 1);
4244
4245         for (i = 0; i < count; i++)
4246           {
4247             tree origin = build_int_2 (i * orig_len, 0);
4248             tree temp;
4249
4250             /* scan down the given value list, building
4251                new bit-positions */
4252             for (temp = vallist; temp; temp = TREE_CHAIN (temp))
4253               {
4254                 tree new_value
4255                   = fold (build (PLUS_EXPR, TREE_TYPE (origin),
4256                                  TREE_VALUE (temp)));
4257                 tree new_purpose = NULL_TREE;
4258
4259                 if (! TREE_CONSTANT (TREE_VALUE (temp)))
4260                   tree_const = 0;
4261                 if (TREE_PURPOSE (temp))
4262                   {
4263                     new_purpose = fold (build (PLUS_EXPR, TREE_TYPE (origin),
4264                                                origin, TREE_PURPOSE (temp)));
4265                     if (! TREE_CONSTANT (TREE_PURPOSE (temp)))
4266                       tree_const = 0;
4267                   }
4268
4269                 new_list = tree_cons (new_purpose,
4270                                           new_value, new_list);
4271               }
4272           }
4273         result = build (CONSTRUCTOR,
4274                         build_bitstring_type (size_int (count * orig_len)),
4275                         NULL_TREE, nreverse (new_list));
4276         TREE_CONSTANT (result) = tree_const;
4277         CH_DERIVED_FLAG (result) = CH_DERIVED_FLAG (string);
4278         return result;
4279       }
4280
4281     default:
4282       error ("non-char, non-bit string repetition");
4283       return error_mark_node;
4284   }
4285   return error_mark_node;
4286 }
4287 \f
4288 tree
4289 finish_chill_unary_op (node)
4290      tree node;
4291 {
4292   enum chill_tree_code code = TREE_CODE (node);
4293   tree op0 = check_have_mode (TREE_OPERAND (node, 0), "unary expression");
4294   tree type0 = TREE_TYPE (op0);
4295   struct ch_class class;
4296
4297   if (TREE_CODE (op0) == ERROR_MARK)
4298     return error_mark_node;
4299   /* The expression codes of the data types of the arguments tell us
4300      whether the arguments are integers, floating, pointers, etc.  */
4301
4302   if (TREE_CODE (type0) == REFERENCE_TYPE)
4303     {
4304       op0 = convert (TREE_TYPE (type0), op0);
4305       type0 = TREE_TYPE (op0);
4306     }
4307
4308   if (invalid_right_operand (code, type0))
4309     {
4310       error ("invalid operand of %s",
4311              tree_code_name[(int)code]);
4312       return error_mark_node;
4313     }
4314   switch ((int)TREE_CODE (type0))
4315     {
4316     case ARRAY_TYPE:
4317       if (TREE_CODE ( TREE_TYPE (type0)) == BOOLEAN_TYPE)
4318         code = SET_NOT_EXPR;
4319       else
4320         {
4321           error ("right operand of %s is not array of boolean",
4322                  tree_code_name[(int)code]);
4323           return error_mark_node;
4324         }
4325       break;
4326     case BOOLEAN_TYPE:
4327       switch ((int)code)
4328         {
4329         case BIT_NOT_EXPR:
4330         case TRUTH_NOT_EXPR:
4331           return invert_truthvalue (truthvalue_conversion (op0));
4332
4333         default:
4334           error ("%s operator applied to boolean variable",
4335                  tree_code_name[(int)code]);
4336           return error_mark_node;
4337         }
4338       break;
4339
4340     case SET_TYPE:
4341       switch ((int)code)
4342         {
4343         case BIT_NOT_EXPR:
4344         case NEGATE_EXPR:
4345           {
4346             tree temp = fold_set_expr (BIT_NOT_EXPR, op0, NULL_TREE);
4347
4348             if (temp)
4349               return temp;
4350
4351             code = SET_NOT_EXPR;
4352           }
4353           break;
4354
4355         default:
4356           error ("invalid right operand of %s", tree_code_name[(int)code]);
4357           return error_mark_node;
4358         }
4359
4360     }
4361
4362   class = chill_expr_class (op0);
4363   if (class.mode)
4364     class.mode = CH_ROOT_MODE (class.mode);
4365   TREE_SET_CODE (node, code);
4366   TREE_OPERAND (node, 0) = op0 = convert_to_class (class, op0);
4367   TREE_TYPE (node) = TREE_TYPE (op0);
4368
4369   node = convert_to_class (class, fold (node));
4370
4371   /* FIXME: should call
4372    * cond_type_range_exception (op0);
4373    */
4374   return node;
4375 }
4376
4377 /* op is TRUTH_NOT_EXPR, BIT_NOT_EXPR, or NEGATE_EXPR */
4378
4379 tree
4380 build_chill_unary_op (code, op0)
4381      enum chill_tree_code code;
4382      tree op0;
4383 {
4384   register tree result = NULL_TREE;
4385
4386   if (op0 == NULL_TREE || TREE_CODE (op0) == ERROR_MARK)
4387     return error_mark_node;
4388
4389   result = build1 (code, NULL_TREE, op0);
4390
4391   if (pass != 1)
4392     result = finish_chill_unary_op (result);
4393   return result;
4394 }
4395
4396 tree
4397 truthvalue_conversion (expr)
4398      tree expr;
4399 {
4400   if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
4401     return error_mark_node;
4402
4403 #if 0        /* what about a LE_EXPR (integer_type, integer_type ) */
4404   if (TREE_CODE (TREE_TYPE (expr)) != BOOLEAN_TYPE)
4405     error ("non-boolean mode in conditional expression");
4406 #endif
4407
4408   switch ((int)TREE_CODE (expr))
4409     {
4410       /* It is simpler and generates better code to have only TRUTH_*_EXPR
4411          or comparison expressions as truth values at this level.  */
4412 #if 0
4413     case COMPONENT_REF:
4414       /* A one-bit unsigned bit-field is already acceptable.  */
4415       if (1 == TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (expr, 1)))
4416           && TREE_UNSIGNED (TREE_OPERAND (expr, 1)))
4417         return expr;
4418       break;
4419 #endif
4420
4421     case EQ_EXPR:
4422       /* It is simpler and generates better code to have only TRUTH_*_EXPR
4423          or comparison expressions as truth values at this level.  */
4424     case NE_EXPR: case LE_EXPR: case GE_EXPR: case LT_EXPR: case GT_EXPR:
4425     case TRUTH_ANDIF_EXPR:
4426     case TRUTH_ORIF_EXPR:
4427     case TRUTH_AND_EXPR:
4428     case TRUTH_OR_EXPR:
4429     case ERROR_MARK:
4430       return expr;
4431
4432     case INTEGER_CST:
4433       return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
4434
4435     case REAL_CST:
4436       return real_zerop (expr) ? boolean_false_node : boolean_true_node;
4437
4438     case ADDR_EXPR:
4439       if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 0)))
4440         return build (COMPOUND_EXPR, boolean_type_node,
4441                       TREE_OPERAND (expr, 0), boolean_true_node);
4442       else
4443         return boolean_true_node;
4444
4445     case NEGATE_EXPR:
4446     case ABS_EXPR:
4447     case FLOAT_EXPR:
4448     case FFS_EXPR:
4449       /* These don't change whether an object is non-zero or zero.  */
4450       return truthvalue_conversion (TREE_OPERAND (expr, 0));
4451
4452     case LROTATE_EXPR:
4453     case RROTATE_EXPR:
4454       /* These don't change whether an object is zero or non-zero, but
4455          we can't ignore them if their second arg has side-effects.  */
4456       if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1)))
4457         return build (COMPOUND_EXPR, boolean_type_node, TREE_OPERAND (expr, 1),
4458                       truthvalue_conversion (TREE_OPERAND (expr, 0)));
4459       else
4460         return truthvalue_conversion (TREE_OPERAND (expr, 0));
4461
4462     case COND_EXPR:
4463       /* Distribute the conversion into the arms of a COND_EXPR.  */
4464       return fold (build (COND_EXPR, boolean_type_node, TREE_OPERAND (expr, 0),
4465                           truthvalue_conversion (TREE_OPERAND (expr, 1)),
4466                           truthvalue_conversion (TREE_OPERAND (expr, 2))));
4467
4468     case CONVERT_EXPR:
4469       /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE,
4470          since that affects how `default_conversion' will behave.  */
4471       if (TREE_CODE (TREE_TYPE (expr)) == REFERENCE_TYPE
4472           || TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == REFERENCE_TYPE)
4473         break;
4474       /* fall through... */
4475     case NOP_EXPR:
4476       /* If this is widening the argument, we can ignore it.  */
4477       if (TYPE_PRECISION (TREE_TYPE (expr))
4478           >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (expr, 0))))
4479         return truthvalue_conversion (TREE_OPERAND (expr, 0));
4480       break;
4481
4482     case BIT_XOR_EXPR:
4483     case MINUS_EXPR:
4484       /* These can be changed into a comparison of the two objects.  */
4485       if (TREE_TYPE (TREE_OPERAND (expr, 0))
4486           == TREE_TYPE (TREE_OPERAND (expr, 1)))
4487         return build_chill_binary_op (NE_EXPR, TREE_OPERAND (expr, 0),
4488                                       TREE_OPERAND (expr, 1));
4489       return build_chill_binary_op (NE_EXPR, TREE_OPERAND (expr, 0),
4490                                     fold (build1 (NOP_EXPR,
4491                                             TREE_TYPE (TREE_OPERAND (expr, 0)),
4492                                             TREE_OPERAND (expr, 1))));
4493     }
4494
4495   return build_chill_binary_op (NE_EXPR, expr, boolean_false_node);
4496 }
4497
4498
4499 /*
4500  * return a folded tree for the powerset's length in bits.  If a
4501  * non-set is passed, we assume it's an array or boolean bytes.
4502  */
4503 tree
4504 powersetlen (powerset)
4505      tree powerset;
4506 {
4507   if (powerset == NULL_TREE || TREE_CODE (powerset) == ERROR_MARK)
4508     return error_mark_node;
4509
4510   return discrete_count (TYPE_DOMAIN (TREE_TYPE (powerset)));
4511 }