OSDN Git Service

* config/alpha/vms.h (INCLUDE_DEFAULTS): Add /gnu/lib/gcc-lib/include.
[pf3gnuchains/gcc-fork.git] / 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, 2001
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                 HOST_WIDE_INT len0 = int_size_in_bytes (type0);
394                 HOST_WIDE_INT len1 = int_size_in_bytes (type1);
395
396                 if (len0 < 0 && TYPE_ARRAY_MAX_SIZE (type0)
397                     && host_integerp (TYPE_ARRAY_MAX_SIZE (type0), 1))
398                   len0 = tree_low_cst (TYPE_ARRAY_MAX_SIZE (type0), 1);
399
400                 if (len1 < 0 && TYPE_ARRAY_MAX_SIZE (type1)
401                     && host_integerp (TYPE_ARRAY_MAX_SIZE (type1), 1))
402                   len1 = tree_low_cst (TYPE_ARRAY_MAX_SIZE (type1), 1);
403
404                 if (len0 < 0 || len1 < 0)
405                   abort ();
406
407                 target = assign_stack_temp (mode, len0 + len1, 0);
408                 preserve_temp_slots (target);
409               }
410           }
411         else if (TREE_CODE (type) == SET_TYPE)
412           {
413             if (target == NULL_RTX)
414               {
415                 target = assign_stack_temp (mode, int_size_in_bytes (type), 0);
416                 preserve_temp_slots (target);
417               }
418           }
419         else
420           abort ();
421
422         if (GET_CODE (target) == MEM)
423           targetx = target;
424         else
425           targetx = assign_stack_temp (mode, GET_MODE_SIZE (mode), 0);
426
427         /* expand 1st operand to a pointer to the array */
428         op0 = expand_expr (force_addr_of (exp0),
429                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
430
431         /* expand 2nd operand to a pointer to the array */
432         op1 = expand_expr (force_addr_of (exp1),
433                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
434
435         if (TREE_CODE (type) == SET_TYPE)
436           {
437             size0 = expand_expr (powersetlen (exp0),
438                                  NULL_RTX, VOIDmode, 0);
439             size1 = expand_expr (powersetlen (exp1),
440                                  NULL_RTX, VOIDmode, 0);
441
442             emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__concatps"),
443                                0, Pmode, 5, XEXP (targetx, 0), Pmode,
444                                op0, GET_MODE (op0),
445                                convert_to_mode (TYPE_MODE (sizetype),
446                                                 size0, TREE_UNSIGNED (sizetype)),
447                                TYPE_MODE (sizetype),
448                                op1, GET_MODE (op1),
449                                convert_to_mode (TYPE_MODE (sizetype),
450                                                 size1, TREE_UNSIGNED (sizetype)),
451                                TYPE_MODE (sizetype));
452           }
453         else
454           {
455             /* copy left, then right array to target */
456             emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__concatstring"),
457                                0, Pmode, 5, XEXP (targetx, 0), Pmode,
458                                op0, GET_MODE (op0),
459                                convert_to_mode (TYPE_MODE (sizetype),
460                                                 size0, TREE_UNSIGNED (sizetype)),
461                                TYPE_MODE (sizetype),
462                                op1, GET_MODE (op1),
463                                convert_to_mode (TYPE_MODE (sizetype),
464                                                 size1, TREE_UNSIGNED (sizetype)),
465                                TYPE_MODE (sizetype));
466           }
467         if (targetx != target)
468           emit_move_insn (target, targetx);
469         return target;
470       }
471 \f
472       /* FIXME: the set_length computed below is a compile-time constant;
473          you'll need to re-write that part for VARYING bit arrays, and
474          possibly the set pointer will need to be adjusted to point past
475          the word containing its dynamic length. */
476
477     /* void __notpowerset (char *out, char *src,
478        unsigned long bitlength) */
479     case SET_NOT_EXPR:
480       {
481         
482         tree expr = TREE_OPERAND (exp, 0);
483         tree tsize = powersetlen (expr);
484         rtx targetx;
485
486         if (TREE_CODE (TREE_TYPE (expr)) != SET_TYPE)
487           tsize = fold (build (MULT_EXPR, sizetype, tsize, 
488                                size_int (BITS_PER_UNIT)));
489
490         /* expand 1st operand to a pointer to the set */
491         op0 = expand_expr (force_addr_of (expr),
492                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
493
494         /* build a temp for the result, target is its address */
495         if (target == NULL_RTX)
496           {
497             target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)), 
498                                         int_size_in_bytes (TREE_TYPE (exp)),
499                                         0);
500             preserve_temp_slots (target);
501           }
502         if (GET_CODE (target) == MEM)
503           targetx = target;
504         else
505           targetx = assign_stack_temp (GET_MODE (target),
506                                        GET_MODE_SIZE (GET_MODE (target)),
507                                        0);
508         emit_library_call (gen_rtx(SYMBOL_REF, Pmode, "__notpowerset"), 
509                            0, VOIDmode, 3, XEXP (targetx, 0), Pmode,
510                            op0, GET_MODE (op0),
511                            expand_expr (tsize, NULL_RTX, MEM, 
512                                         EXPAND_CONST_ADDRESS),
513                            TYPE_MODE (long_unsigned_type_node));
514         if (targetx != target)
515           emit_move_insn (target, targetx);
516         return target;
517       }
518
519     case SET_DIFF_EXPR:
520       lib_func = "__diffpowerset";
521       goto format_2;
522
523     case SET_IOR_EXPR:
524       lib_func = "__orpowerset";
525       goto format_2;
526
527     case SET_XOR_EXPR:
528       lib_func = "__xorpowerset";
529       goto format_2;
530
531     /* void __diffpowerset (char *out, char *left, char *right,
532                             unsigned bitlength) */
533     case SET_AND_EXPR:
534       lib_func = "__andpowerset";
535     format_2:
536       {
537         tree expr = TREE_OPERAND (exp, 0);
538         tree tsize = powersetlen (expr);
539         rtx targetx;
540
541         if (TREE_CODE (TREE_TYPE (expr)) != SET_TYPE)
542           tsize = fold (build (MULT_EXPR, long_unsigned_type_node,
543                                tsize, 
544                                size_int (BITS_PER_UNIT)));
545
546         /* expand 1st operand to a pointer to the set */
547         op0 = expand_expr (force_addr_of (expr),
548                            NULL_RTX, MEM, EXPAND_CONST_ADDRESS);
549
550         /* expand 2nd operand to a pointer to the set */
551         op1 = expand_expr (force_addr_of (TREE_OPERAND (exp, 1)),
552                            NULL_RTX, MEM,
553                            EXPAND_CONST_ADDRESS);
554
555 /* FIXME: re-examine this code - the unary operator code above has recently
556    (93/03/12) been changed a lot.  Should this code also change? */
557         /* build a temp for the result, target is its address */
558         if (target == NULL_RTX)
559           {
560             target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)), 
561                                         int_size_in_bytes (TREE_TYPE (exp)),
562                                         0);
563             preserve_temp_slots (target);
564           }
565         if (GET_CODE (target) == MEM)
566           targetx = target;
567         else
568           targetx = assign_stack_temp (GET_MODE (target),
569                                        GET_MODE_SIZE (GET_MODE (target)), 0);
570         emit_library_call (gen_rtx(SYMBOL_REF, Pmode, lib_func),
571                            0, VOIDmode, 4, XEXP (targetx, 0), Pmode,
572                            op0, GET_MODE (op0), op1, GET_MODE (op1),
573                            expand_expr (tsize, NULL_RTX, MEM, 
574                                         EXPAND_CONST_ADDRESS),
575                            TYPE_MODE (long_unsigned_type_node));
576         if (target != targetx)
577           emit_move_insn (target, targetx);
578         return target;
579       }
580
581     case SET_IN_EXPR:
582       {
583         tree set = TREE_OPERAND (exp, 1);
584         tree pos = convert (long_unsigned_type_node, TREE_OPERAND (exp, 0));
585         tree set_type = TREE_TYPE (set);
586         tree set_length = discrete_count (TYPE_DOMAIN (set_type));
587         tree min_val = convert (long_integer_type_node,
588                                 TYPE_MIN_VALUE (TYPE_DOMAIN (set_type)));
589         tree fcall;
590         
591         /* FIXME: Function-call not needed if pos and width are constant! */
592         if (! mark_addressable (set))
593           {
594             error ("powerset is not addressable");
595             return const0_rtx;
596           }
597         /* we use different functions for bitstrings and powersets */
598         if (CH_BOOLS_TYPE_P (set_type))
599           fcall =
600              build_chill_function_call (
601                lookup_name (get_identifier ("__inbitstring")),
602                  tree_cons (NULL_TREE, 
603                    convert (long_unsigned_type_node, pos), 
604                      tree_cons (NULL_TREE,
605                        build1 (ADDR_EXPR, build_pointer_type (set_type), set),
606                          tree_cons (NULL_TREE, 
607                            convert (long_unsigned_type_node, set_length),
608                              tree_cons (NULL_TREE, min_val,
609                                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
610                                  build_tree_list (NULL_TREE, get_chill_linenumber ())))))));
611         else
612           fcall =
613              build_chill_function_call (
614                lookup_name (get_identifier ("__inpowerset")),
615                  tree_cons (NULL_TREE, 
616                    convert (long_unsigned_type_node, pos), 
617                      tree_cons (NULL_TREE,
618                        build1 (ADDR_EXPR, build_pointer_type (set_type), set),
619                          tree_cons (NULL_TREE, 
620                            convert (long_unsigned_type_node, set_length),
621                              build_tree_list (NULL_TREE, min_val)))));
622         return expand_expr (fcall, NULL_RTX, VOIDmode, 0);
623       }
624
625     case PACKED_ARRAY_REF:
626       {
627         tree array = TREE_OPERAND (exp, 0);
628         tree pos = save_expr (TREE_OPERAND (exp, 1));
629         tree array_type = TREE_TYPE (array);
630         tree array_length = discrete_count (TYPE_DOMAIN (array_type));
631         tree min_val = convert (long_integer_type_node,
632                                 TYPE_MIN_VALUE (TYPE_DOMAIN (array_type)));
633         tree fcall;
634         
635         /* FIXME: Function-call not needed if pos and width are constant! */
636         /* TODO: make sure this makes sense. */
637         if (! mark_addressable (array))
638           {
639             error ("array is not addressable");
640             return const0_rtx;
641           }
642         fcall =
643           build_chill_function_call (
644                lookup_name (get_identifier ("__inpowerset")),
645                  tree_cons (NULL_TREE, 
646                    convert (long_unsigned_type_node, pos), 
647                      tree_cons (NULL_TREE,
648                        build1 (ADDR_EXPR, build_pointer_type (array_type), array),
649                          tree_cons (NULL_TREE, 
650                            convert (long_unsigned_type_node, array_length),
651                              build_tree_list (NULL_TREE, min_val)))));
652         return expand_expr (fcall, NULL_RTX, VOIDmode, 0);
653       }
654
655     case UNDEFINED_EXPR:
656       if (target == 0)
657         {
658           target = assign_stack_temp (TYPE_MODE (TREE_TYPE (exp)), 
659                                       int_size_in_bytes (TREE_TYPE (exp)), 0);
660           preserve_temp_slots (target);
661         }
662       /* We don't actually need to *do* anything ... */
663       return target;
664
665     default:
666       break;
667     }
668
669   /* NOTREACHED */
670   return NULL;
671 }
672 \f
673 /* Check that the argument list has a length in [min_length .. max_length].
674    (max_length == -1 means "infinite".)
675    If so return the actual length.
676    Otherwise, return an error message and return -1. */
677
678 static int
679 check_arglist_length (args, min_length, max_length, name)
680      tree args;
681      int min_length;
682      int max_length;
683      tree name;
684 {
685   int length = list_length (args);
686   if (length < min_length)
687     error ("too few arguments in call to `%s'", IDENTIFIER_POINTER (name));
688   else if (max_length != -1 && length > max_length)
689     error ("too many arguments in call to `%s'", IDENTIFIER_POINTER (name));
690   else
691     return length;
692   return -1;
693 }
694 \f
695 /*
696  * This is the code from c-typeck.c, with the C-specific cruft
697  * removed (possibly I just didn't understand it, but it was
698  * apparently simply discarding part of my LIST).
699  */
700 static tree
701 internal_build_compound_expr (list, first_p)
702      tree list;
703      int first_p ATTRIBUTE_UNUSED;
704 {
705   register tree rest;
706
707   if (TREE_CHAIN (list) == 0)
708     return TREE_VALUE (list);
709
710   rest = internal_build_compound_expr (TREE_CHAIN (list), FALSE);
711
712   if (! TREE_SIDE_EFFECTS (TREE_VALUE (list)))
713     return rest;
714
715   return build (COMPOUND_EXPR, TREE_TYPE (rest), TREE_VALUE (list), rest);
716 }
717
718
719 /* Given a list of expressions, return a compound expression
720    that performs them all and returns the value of the last of them.  */
721 /* FIXME: this should be merged with the C version */
722 tree
723 build_chill_compound_expr (list)
724      tree list;
725 {
726   return internal_build_compound_expr (list, TRUE);
727 }
728 \f
729 /* Given an expression PTR for a pointer, return an expression
730    for the value pointed to.
731    do_empty_check is 0, don't perform a NULL pointer check,
732    else do it. */
733
734 tree
735 build_chill_indirect_ref (ptr, mode, do_empty_check)
736      tree ptr;
737      tree mode;
738      int do_empty_check;
739 {
740   register tree type;
741
742   if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
743     return ptr;
744   if (mode != NULL_TREE && TREE_CODE (mode) == ERROR_MARK)
745     return error_mark_node;
746
747   type = TREE_TYPE (ptr);
748
749   if (TREE_CODE (type) == REFERENCE_TYPE)
750     {
751       type = TREE_TYPE (type);
752       ptr = convert (type, ptr);
753     }
754
755   /* check for ptr is really a POINTER */
756   if (TREE_CODE (type) != POINTER_TYPE)
757     {
758       error ("cannot dereference, not a pointer");
759       return error_mark_node;
760     }
761   
762   if (mode && TREE_CODE (mode) == IDENTIFIER_NODE)
763     {
764       tree decl = lookup_name (mode);
765       if (decl == NULL_TREE || TREE_CODE (decl) != TYPE_DECL)
766         {
767           if (pass == 2)
768             error ("missing '.' operator or undefined mode name `%s'",
769                    IDENTIFIER_POINTER (mode));
770 #if 0
771           error ("you have forgotten the '.' operator which must");
772           error (" precede a STRUCT field reference, or `%s' is an undefined mode", 
773                  IDENTIFIER_POINTER (mode));
774 #endif
775           return error_mark_node;
776         }
777     }
778
779   if (mode)
780     {
781       mode = get_type_of (mode);
782       ptr = convert (build_pointer_type (mode), ptr);
783     }
784   else if (type == ptr_type_node)
785     {
786       error ("can't dereference PTR value using unary `->'");
787       return error_mark_node;
788     }
789
790   if (do_empty_check)
791     ptr = check_non_null (ptr);
792
793   type = TREE_TYPE (ptr);
794
795   if (TREE_CODE (type) == POINTER_TYPE)
796     {
797       if (TREE_CODE (ptr) == ADDR_EXPR
798           && !flag_volatile
799           && (TREE_TYPE (TREE_OPERAND (ptr, 0))
800               == TREE_TYPE (type)))
801         return TREE_OPERAND (ptr, 0);
802       else
803         {
804           tree t = TREE_TYPE (type);
805           register tree ref = build1 (INDIRECT_REF,
806                                       TYPE_MAIN_VARIANT (t), ptr);
807
808           if (TYPE_SIZE (t) == 0 && TREE_CODE (t) != ARRAY_TYPE)
809             {
810               error ("dereferencing pointer to incomplete type");
811               return error_mark_node;
812             }
813           if (TREE_CODE (t) == VOID_TYPE)
814             warning ("dereferencing `void *' pointer");
815
816           /* We *must* set TREE_READONLY when dereferencing a pointer to const,
817              so that we get the proper error message if the result is used
818              to assign to.  Also, &* is supposed to be a no-op.
819              And ANSI C seems to specify that the type of the result
820              should be the const type.  */
821           /* A de-reference of a pointer to const is not a const.  It is valid
822              to change it via some other pointer.  */
823           TREE_READONLY (ref) = TYPE_READONLY (t);
824           TREE_SIDE_EFFECTS (ref)
825             = TYPE_VOLATILE (t) || TREE_SIDE_EFFECTS (ptr) || flag_volatile;
826           TREE_THIS_VOLATILE (ref) = TYPE_VOLATILE (t) || flag_volatile;
827           return ref;
828         }
829     }
830   else if (TREE_CODE (ptr) != ERROR_MARK)
831     error ("invalid type argument of `->'");
832   return error_mark_node;
833 }
834
835 /* NODE is a COMPONENT_REF whose mode is an IDENTIFIER,
836    which is replaced by the proper FIELD_DECL.
837    Also do the right thing for variant records. */
838
839 tree
840 resolve_component_ref (node)
841      tree node;
842 {
843   tree datum = TREE_OPERAND (node, 0);
844   tree field_name = TREE_OPERAND (node, 1);
845   tree type = TREE_TYPE (datum);
846   tree field;
847   if (TREE_CODE (datum) == ERROR_MARK)
848     return error_mark_node;
849   if (TREE_CODE (type) == REFERENCE_TYPE)
850     {
851       type = TREE_TYPE (type);
852       TREE_OPERAND (node, 0) = datum = convert (type, datum);
853     }
854   if (TREE_CODE (type) != RECORD_TYPE)
855     {
856       error ("operand of '.' is not a STRUCT");
857       return error_mark_node;
858     }
859
860   TREE_READONLY (node) = TREE_READONLY (datum);
861   TREE_SIDE_EFFECTS (node) = TREE_SIDE_EFFECTS (datum);
862
863   for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
864     {
865       if (TREE_CODE (TREE_TYPE (field)) == UNION_TYPE)
866         {
867           tree variant;
868           for (variant = TYPE_FIELDS (TREE_TYPE (field));
869                variant;  variant = TREE_CHAIN (variant))
870             {
871               tree vfield;
872               for (vfield = TYPE_FIELDS (TREE_TYPE (variant));
873                    vfield; vfield = TREE_CHAIN (vfield))
874                 {
875                   if (DECL_NAME (vfield) == field_name)
876                     { /* Found a variant field */
877                       datum = build (COMPONENT_REF, TREE_TYPE (field),
878                                      datum, field);
879                       datum = build (COMPONENT_REF, TREE_TYPE (variant),
880                                      datum, variant);
881                       TREE_OPERAND (node, 0) = datum;
882                       TREE_OPERAND (node, 1) = vfield;
883                       TREE_TYPE (node) = TREE_TYPE (vfield);
884                       TREE_READONLY (node) |= TYPE_READONLY (TREE_TYPE (node));
885 #if 0
886                       if (flag_testing_tags)
887                         {
888                           tree tagtest = NOT IMPLEMENTED;
889                           tree tagf = ridpointers[(int) RID_RANGEFAIL];
890                           node = check_expression (node, tagtest,
891                                                    tagf);
892                         }
893 #endif
894                       return node;
895                     }
896                 }
897             }
898         }
899
900       if (DECL_NAME (field) == field_name)
901         { /* Found a fixed field */
902           TREE_OPERAND (node, 1) = field;
903           TREE_TYPE (node) = TREE_TYPE (field);
904           TREE_READONLY (node) |= TYPE_READONLY (TREE_TYPE (node));
905           return fold (node);
906         }
907     }
908
909   error ("no field named `%s'", IDENTIFIER_POINTER (field_name));
910   return error_mark_node;
911 }
912
913 tree
914 build_component_ref (datum, field_name)
915   tree datum, field_name;
916 {
917   tree node = build_nt (COMPONENT_REF, datum, field_name);
918   if (pass != 1)
919     node = resolve_component_ref (node);
920   return node;
921 }
922
923 /*
924  function checks (for build_chill_component_ref) if a given
925  type is really an instance type. CH_IS_INSTANCE_MODE is not
926  strict enough in this case, i.e. SYNMODE foo = STRUCT (a, b UINT)
927  is compatible to INSTANCE. */
928
929 static int
930 is_really_instance (type)
931      tree type;
932 {
933   tree decl = TYPE_NAME (type);
934
935   if (decl == NULL_TREE)
936     /* this is not an instance */
937     return 0;
938
939   if (DECL_NAME (decl) == ridpointers[(int)RID_INSTANCE])
940     /* this is an instance */
941     return 1;
942
943   if (TYPE_FIELDS (type) == TYPE_FIELDS (instance_type_node))
944     /* we have a NEWMODE'd instance */
945     return 1;
946
947   return 0;
948 }
949
950 /* This function is called by the parse.
951    Here we check if the user tries to access a field in a type which is
952    layouted as a structure but isn't like INSTANCE, BUFFER, EVENT, ASSOCIATION,
953    ACCESS, TEXT, or VARYING array or character string.
954    We don't do this in build_component_ref cause this function gets
955    called from the compiler to access fields in one of the above mentioned
956    modes. */
957 tree
958 build_chill_component_ref (datum, field_name)
959      tree datum, field_name;
960 {
961   tree type = TREE_TYPE (datum);
962   if ((type != NULL_TREE && TREE_CODE (type) == RECORD_TYPE) &&
963       ((CH_IS_INSTANCE_MODE (type) && is_really_instance (type)) ||
964         CH_IS_BUFFER_MODE (type) ||
965        CH_IS_EVENT_MODE (type) || CH_IS_ASSOCIATION_MODE (type) ||
966        CH_IS_ACCESS_MODE (type) || CH_IS_TEXT_MODE (type) ||
967        chill_varying_type_p (type)))
968     {
969       error ("operand of '.' is not a STRUCT");
970       return error_mark_node;
971     }
972   return build_component_ref (datum, field_name);
973 }
974 \f
975 /*
976  * Check for invalid binary operands & unary operands
977  * RIGHT is 1 if checking right operand or unary operand;
978  * it is 0 if checking left operand.
979  *
980  * return 1 if the given operand is NOT compatible as the
981  * operand of the given operator
982  *
983  * return 0 if they might be compatible
984  */
985 static int
986 invalid_operand (code, type, right)
987      enum chill_tree_code code;
988      tree type;
989      int right; /* 1 if right operand */
990 {
991   switch ((int)code)
992     {
993     case ADDR_EXPR:
994       break;
995     case BIT_AND_EXPR:
996     case BIT_IOR_EXPR:
997     case BIT_NOT_EXPR:
998     case BIT_XOR_EXPR:
999       goto relationals;
1000     case CASE_EXPR:
1001       break;
1002     case CEIL_MOD_EXPR:
1003       goto numerics;
1004     case CONCAT_EXPR:           /* must be static or varying char array */
1005       if (TREE_CODE (type) == CHAR_TYPE)
1006         return 0;
1007       if (TREE_CODE (type) == ARRAY_TYPE 
1008            && TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
1009         return 0;
1010       if (!chill_varying_type_p (type))
1011           return 1;
1012       if (TREE_CODE (TREE_TYPE (CH_VARYING_ARRAY_TYPE (type)))
1013             == CHAR_TYPE)
1014         return 0;
1015       else
1016         return 1;
1017     /* note: CHILL conditional expressions (COND_EXPR) won't come
1018      *  through here; they're routed straight to C-specific code */
1019     case EQ_EXPR:
1020       return 0;                  /* ANYTHING can be compared equal */
1021     case FLOOR_MOD_EXPR:
1022       if (TREE_CODE (type) == REAL_TYPE)
1023         return 1;
1024       goto numerics;
1025     case GE_EXPR:
1026     case GT_EXPR:
1027       goto relatables;
1028     case SET_IN_EXPR:
1029       if (TREE_CODE (type) == SET_TYPE)
1030         return 0;
1031       else
1032         return 1;
1033     case PACKED_ARRAY_REF:
1034       if (TREE_CODE (type) == ARRAY_TYPE)
1035         return 0;
1036       else
1037         return 1;
1038     case LE_EXPR:
1039     case LT_EXPR:
1040     relatables:
1041       switch ((int)TREE_CODE(type))   /* right operand must be set/bitarray type */
1042         {
1043         case ARRAY_TYPE:
1044           if (TREE_CODE (TREE_TYPE (type)) == CHAR_TYPE)
1045             return 0;
1046           else
1047             return 1;
1048         case BOOLEAN_TYPE:
1049         case CHAR_TYPE:
1050         case COMPLEX_TYPE:
1051         case ENUMERAL_TYPE:
1052         case INTEGER_TYPE:
1053         case OFFSET_TYPE:
1054         case POINTER_TYPE:
1055         case REAL_TYPE:
1056         case SET_TYPE:
1057           return 0;
1058         case FILE_TYPE:
1059         case FUNCTION_TYPE:
1060         case GRANT_TYPE:
1061         case LANG_TYPE:
1062         case METHOD_TYPE:
1063           return 1;
1064         case RECORD_TYPE:
1065           if (chill_varying_type_p (type)
1066               && TREE_CODE (TREE_TYPE (CH_VARYING_ARRAY_TYPE (type))) == CHAR_TYPE)
1067             return 0;
1068           else
1069             return 1;
1070         case REFERENCE_TYPE:
1071         case SEIZE_TYPE:
1072         case UNION_TYPE:
1073         case VOID_TYPE:
1074           return 1;
1075         }
1076       break;
1077     case MINUS_EXPR:
1078     case MULT_EXPR:
1079       goto numerics;
1080     case NEGATE_EXPR:
1081       if (TREE_CODE (type) == BOOLEAN_TYPE)
1082         return 0;
1083       else
1084         goto numerics;
1085     case NE_EXPR:
1086       return 0;                  /* ANYTHING can be compared unequal */
1087     case NOP_EXPR:
1088       return 0;                  /* ANYTHING can be converted */
1089     case PLUS_EXPR:
1090     numerics:
1091       switch ((int)TREE_CODE(type))   /* left operand must be discrete type */
1092         {
1093         case ARRAY_TYPE:
1094           if (right || TREE_CODE (TREE_TYPE (type)) != BOOLEAN_TYPE)
1095             return 1;
1096           else
1097             return 0;
1098         case CHAR_TYPE:
1099           return right;
1100         case BOOLEAN_TYPE:
1101         case COMPLEX_TYPE:
1102         case FILE_TYPE:
1103         case FUNCTION_TYPE:
1104         case GRANT_TYPE:
1105         case LANG_TYPE:
1106         case METHOD_TYPE:
1107         case RECORD_TYPE:
1108         case REFERENCE_TYPE:
1109         case SEIZE_TYPE:
1110         case UNION_TYPE:
1111         case VOID_TYPE:
1112           return 1;
1113         case ENUMERAL_TYPE:
1114         case INTEGER_TYPE:
1115         case OFFSET_TYPE:
1116         case POINTER_TYPE:
1117         case REAL_TYPE:
1118         case SET_TYPE:
1119           return 0;
1120         }
1121       break;
1122     case RANGE_EXPR:
1123       break;
1124
1125     case REPLICATE_EXPR:
1126       switch ((int)TREE_CODE(type))   /* right operand must be set/bitarray type */
1127         {
1128         case COMPLEX_TYPE:
1129         case FILE_TYPE:
1130         case FUNCTION_TYPE:
1131         case GRANT_TYPE:
1132         case LANG_TYPE:
1133         case METHOD_TYPE:
1134         case OFFSET_TYPE:
1135         case POINTER_TYPE:
1136         case RECORD_TYPE:
1137         case REAL_TYPE:
1138         case SEIZE_TYPE:
1139         case UNION_TYPE:
1140         case VOID_TYPE:
1141           return 1;
1142         case ARRAY_TYPE:
1143         case BOOLEAN_TYPE:
1144         case CHAR_TYPE:
1145         case ENUMERAL_TYPE:
1146         case INTEGER_TYPE:
1147         case REFERENCE_TYPE:
1148         case SET_TYPE:
1149           return 0;
1150         }
1151       
1152     case TRUNC_DIV_EXPR:
1153       goto numerics;
1154     case TRUNC_MOD_EXPR:
1155       if (TREE_CODE (type) == REAL_TYPE)
1156         return 1;
1157       goto numerics;
1158     case TRUTH_ANDIF_EXPR:
1159     case TRUTH_AND_EXPR:
1160     case TRUTH_NOT_EXPR:
1161     case TRUTH_ORIF_EXPR:
1162     case TRUTH_OR_EXPR:
1163     relationals:
1164       switch ((int)TREE_CODE(type))   /* left operand must be discrete type */
1165         {
1166         case ARRAY_TYPE:
1167         case CHAR_TYPE:
1168         case COMPLEX_TYPE:
1169         case ENUMERAL_TYPE:
1170         case FILE_TYPE:
1171         case FUNCTION_TYPE:
1172         case GRANT_TYPE:
1173         case INTEGER_TYPE:
1174         case LANG_TYPE:
1175         case METHOD_TYPE:
1176         case OFFSET_TYPE:
1177         case POINTER_TYPE:
1178         case REAL_TYPE:
1179         case RECORD_TYPE:
1180         case REFERENCE_TYPE:
1181         case SEIZE_TYPE:
1182         case UNION_TYPE:
1183         case VOID_TYPE:
1184           return 1;
1185         case BOOLEAN_TYPE:
1186         case SET_TYPE:
1187           return 0;
1188         }
1189       break;
1190
1191     default:
1192       return 1;       /* perhaps you forgot to add a new DEFTREECODE? */
1193     }
1194   return 1;
1195 }
1196
1197
1198 static int
1199 invalid_right_operand (code, type)
1200      enum chill_tree_code code;
1201      tree type;
1202 {
1203   return invalid_operand (code, type, 1);
1204 }
1205 \f
1206 tree
1207 build_chill_abs (expr)
1208      tree expr;
1209 {
1210   tree temp;
1211
1212   if (TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE
1213       || discrete_type_p (TREE_TYPE (expr)))
1214     temp = fold (build1 (ABS_EXPR, TREE_TYPE (expr), expr));
1215   else 
1216     {
1217       error("ABS argument must be discrete or real mode");
1218       return error_mark_node;
1219     }
1220   /* FIXME: should call
1221    * cond_type_range_exception (temp);
1222    */
1223   return temp;
1224 }
1225
1226 static tree
1227 build_chill_abstime (exprlist)
1228      tree exprlist;
1229 {
1230   int  mask = 0, i, numargs;
1231   tree args = NULL_TREE;
1232   tree filename, lineno;
1233   int  had_errors = 0;
1234   tree tmp;
1235
1236   if (exprlist != NULL_TREE && TREE_CODE (exprlist) == ERROR_MARK)
1237     return error_mark_node;
1238
1239   /* check for integer expressions */
1240   i = 1;
1241   tmp = exprlist;
1242   while (tmp != NULL_TREE)
1243     {
1244       tree exp = TREE_VALUE (tmp);
1245
1246       if (exp == NULL_TREE || TREE_CODE (exp) == ERROR_MARK)
1247         had_errors = 1;
1248       else if (TREE_CODE (TREE_TYPE (exp)) != INTEGER_TYPE)
1249         {
1250           error ("argument %d to ABSTIME must be of integer type", i);
1251           had_errors = 1;
1252         }
1253       tmp = TREE_CHAIN (tmp);
1254       i++;
1255     }
1256   if (had_errors)
1257     return error_mark_node;
1258
1259   numargs = list_length (exprlist);
1260   for (i = 0; i < numargs; i++)
1261     mask |= (1 << i);
1262
1263   /* make it all arguments */
1264   for (i = numargs; i < 6; i++)
1265     exprlist = tree_cons (NULL_TREE, integer_zero_node, exprlist);
1266
1267   args = tree_cons (NULL_TREE, build_int_2 (mask, 0), exprlist);
1268
1269   filename = force_addr_of (get_chill_filename ());
1270   lineno = get_chill_linenumber ();
1271   args = chainon (args, tree_cons (NULL_TREE, filename,
1272                           tree_cons (NULL_TREE, lineno, NULL_TREE)));
1273
1274   return build_chill_function_call (
1275     lookup_name (get_identifier ("_abstime")), args);
1276 }
1277
1278
1279 static tree
1280 build_allocate_memory_call (ptr, size)
1281   tree ptr, size;
1282 {
1283   int err = 0;
1284     
1285   /* check for ptr is referable */
1286   if (! CH_REFERABLE (ptr))
1287     {
1288       error ("parameter 1 must be referable");
1289       err++;
1290     }
1291    /* check for pointer */
1292   else if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
1293     {
1294       error ("mode mismatch in parameter 1");
1295       err++;
1296     }
1297
1298   /* check for size > 0 if it is a constant */
1299   if (TREE_CODE (size) == INTEGER_CST && TREE_INT_CST_LOW (size) <= 0)
1300     {
1301       error ("parameter 2 must be a positive integer");
1302       err++;
1303     }
1304   if (err)
1305     return error_mark_node;
1306
1307   if (TREE_TYPE (ptr) != ptr_type_node)
1308     ptr = build_chill_cast (ptr_type_node, ptr);
1309
1310   return build_chill_function_call (
1311     lookup_name (get_identifier ("_allocate_memory")),
1312            tree_cons (NULL_TREE, ptr,
1313              tree_cons (NULL_TREE, size,
1314                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
1315                  tree_cons (NULL_TREE, get_chill_linenumber (), 
1316                             NULL_TREE)))));
1317 }
1318
1319
1320 static tree
1321 build_allocate_global_memory_call (ptr, size)
1322   tree ptr, size;
1323 {
1324   int err = 0;
1325     
1326   /* check for ptr is referable */
1327   if (! CH_REFERABLE (ptr))
1328     {
1329       error ("parameter 1 must be referable");
1330       err++;
1331     }
1332   /* check for pointer */
1333   else if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
1334     {
1335       error ("mode mismatch in parameter 1");
1336       err++;
1337     }
1338
1339   /* check for size > 0 if it is a constant */
1340   if (TREE_CODE (size) == INTEGER_CST && TREE_INT_CST_LOW (size) <= 0)
1341     {
1342       error ("parameter 2 must be a positive integer");
1343       err++;
1344     }
1345   if (err)
1346     return error_mark_node;
1347     
1348   if (TREE_TYPE (ptr) != ptr_type_node)
1349     ptr = build_chill_cast (ptr_type_node, ptr);
1350
1351   return build_chill_function_call (
1352     lookup_name (get_identifier ("_allocate_global_memory")),
1353            tree_cons (NULL_TREE, ptr,
1354              tree_cons (NULL_TREE, size,
1355                tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
1356                  tree_cons (NULL_TREE, get_chill_linenumber (), 
1357                             NULL_TREE)))));
1358 }
1359
1360
1361 static tree
1362 build_return_memory (ptr)
1363   tree ptr;
1364 {
1365   /* check input */
1366   if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
1367       return error_mark_node;
1368   
1369   /* check for pointer */
1370   if (TREE_CODE (TREE_TYPE (ptr)) != POINTER_TYPE)
1371     {
1372       error ("mode mismatch in parameter 1");
1373       return error_mark_node;
1374     }
1375
1376   if (TREE_TYPE (ptr) != ptr_type_node)
1377     ptr = build_chill_cast (ptr_type_node, ptr);
1378
1379   return build_chill_function_call (
1380     lookup_name (get_identifier ("_return_memory")),
1381       tree_cons (NULL_TREE, ptr,
1382         tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
1383           tree_cons (NULL_TREE, get_chill_linenumber (), 
1384                      NULL_TREE))));
1385 }
1386
1387
1388 /* Compute the number of runtime members of the
1389  * given powerset.
1390  */
1391 tree
1392 build_chill_card (powerset)
1393      tree powerset;
1394 {
1395   if (pass == 2)
1396     {
1397       tree temp;
1398       tree card_func = lookup_name (get_identifier ("__cardpowerset"));
1399       
1400       if (powerset == NULL_TREE || TREE_CODE (powerset) == ERROR_MARK)
1401         return error_mark_node;
1402       
1403       if (TREE_CODE (powerset) == IDENTIFIER_NODE)
1404         powerset = lookup_name (powerset);
1405
1406       if (TREE_CODE (TREE_TYPE(powerset)) == SET_TYPE)
1407         { int size;
1408
1409           /* Do constant folding, if possible. */
1410           if (TREE_CODE (powerset) == CONSTRUCTOR
1411               && TREE_CONSTANT (powerset)
1412               && (size = int_size_in_bytes (TREE_TYPE (powerset))) >= 0)
1413             {
1414               int bit_size = size * BITS_PER_UNIT;
1415               char* buffer = (char*) alloca (bit_size);
1416               temp = get_set_constructor_bits (powerset, buffer, bit_size);
1417               if (!temp)
1418                 { int i;
1419                   int count = 0;
1420                   for (i = 0; i < bit_size; i++)
1421                     if (buffer[i])
1422                       count++;
1423                   temp = build_int_2 (count, 0);
1424                   TREE_TYPE (temp) = TREE_TYPE (TREE_TYPE (card_func));
1425                   return temp;
1426                 }
1427             }
1428           temp = build_chill_function_call (card_func,
1429                      tree_cons (NULL_TREE, force_addr_of (powerset),
1430                        tree_cons (NULL_TREE, powersetlen (powerset), NULL_TREE)));
1431           /* FIXME: should call
1432            * cond_type_range_exception (op0);
1433            */
1434           return temp;
1435         }
1436       error("CARD argument must be powerset mode");
1437       return error_mark_node;
1438     }
1439   return NULL_TREE;
1440 }
1441
1442 /* function to build the type needed for the DESCR-built-in
1443  */
1444
1445 void build_chill_descr_type ()
1446 {
1447   tree decl1, decl2;
1448   
1449   if (descr_type != NULL_TREE)
1450     /* already done */
1451     return;
1452   
1453   decl1 = build_decl (FIELD_DECL, get_identifier ("datap"), ptr_type_node);
1454   decl2 = build_decl (FIELD_DECL, get_identifier ("len"),
1455                       TREE_TYPE (lookup_name (
1456                                               get_identifier ((ignore_case || ! special_UC) ? "ulong" : "ULONG"))));
1457   TREE_CHAIN (decl1) = decl2;
1458   TREE_CHAIN (decl2) = NULL_TREE;
1459   decl2 = build_chill_struct_type (decl1);
1460   descr_type = build_decl (TYPE_DECL, get_identifier ("__tmp_DESCR_type"), decl2);
1461   pushdecl (descr_type);
1462   DECL_SOURCE_LINE (descr_type) = 0;
1463   satisfy_decl (descr_type, 0);
1464 }
1465
1466 /* build a pointer to a descriptor.
1467  * descriptor = STRUCT (datap PTR,
1468  *                      len ULONG);
1469  * This descriptor is build in variable descr_type.
1470  */
1471
1472 tree
1473 build_chill_descr (expr)
1474     tree expr;
1475 {
1476   if (pass == 2)
1477     {
1478       tree tuple, decl, descr_var, datap, len, tmp;
1479       int is_static;
1480
1481       if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1482         return error_mark_node;
1483       
1484       /* check for expression is referable */
1485       if (! CH_REFERABLE (expr))
1486         {
1487           error ("expression for DESCR-built-in must be referable");
1488           return error_mark_node;
1489         }
1490       
1491       mark_addressable (expr);
1492 #if 0
1493       datap = build1 (ADDR_EXPR, build_chill_pointer_type (descr_type), expr);
1494 #else
1495       datap = build_chill_arrow_expr (expr, 1);
1496 #endif
1497       len = size_in_bytes (TREE_TYPE (expr));
1498       
1499       descr_var = get_unique_identifier ("DESCR");
1500       tuple = build_nt (CONSTRUCTOR, NULL_TREE,
1501                         tree_cons (NULL_TREE, datap,
1502                                    tree_cons (NULL_TREE, len, NULL_TREE)));
1503
1504       is_static = (current_function_decl == global_function_decl) && TREE_STATIC (expr);
1505       decl = decl_temp1 (descr_var, TREE_TYPE (descr_type), is_static,
1506                          tuple, 0, 0);
1507 #if 0
1508       tmp = force_addr_of (decl);
1509 #else
1510       tmp = build_chill_arrow_expr (decl, 1);
1511 #endif
1512       return tmp;
1513     }
1514   return NULL_TREE;
1515 }
1516
1517 /* this function process the builtin's
1518    MILLISECS, SECS, MINUTES, HOURS and DAYS.
1519    The built duration value is in milliseconds. */
1520
1521 static tree
1522 build_chill_duration (expr, multiplier, fnname, maxvalue)
1523      tree           expr;
1524      unsigned long  multiplier;
1525      tree           fnname;
1526      unsigned long  maxvalue;
1527 {
1528   tree temp;
1529
1530   if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1531     return error_mark_node;
1532
1533   if (TREE_CODE (TREE_TYPE (expr)) != INTEGER_TYPE)
1534     {
1535       error ("argument to `%s' must be of integer type", IDENTIFIER_POINTER (fnname));
1536       return error_mark_node;
1537     }
1538
1539   temp = convert (duration_timing_type_node, expr);
1540   temp = fold (build (MULT_EXPR, duration_timing_type_node,
1541                       temp, build_int_2 (multiplier, 0)));
1542
1543   if (range_checking)
1544     temp = check_range (temp, expr, integer_zero_node, build_int_2 (maxvalue, 0));
1545
1546   return temp;
1547 }
1548
1549 /* build function call to one of the floating point functions */
1550 static tree
1551 build_chill_floatcall (expr, chillname, funcname)
1552      tree expr;
1553      const char *chillname;
1554      const char *funcname;
1555 {
1556   tree result;
1557   tree type;
1558
1559   if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1560     return error_mark_node;
1561
1562   /* look if expr is a REAL_TYPE */
1563   type = TREE_TYPE (expr);
1564   if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
1565     return error_mark_node;
1566   if (TREE_CODE (type) != REAL_TYPE)
1567     {
1568       error ("argument 1 to `%s' must be of floating point mode", chillname);
1569       return error_mark_node;
1570     }
1571   result = build_chill_function_call (
1572              lookup_name (get_identifier (funcname)),
1573                tree_cons (NULL_TREE, expr, NULL_TREE));
1574   return result;
1575 }
1576
1577 /* common function for ALLOCATE and GETSTACK */
1578 static tree
1579 build_allocate_getstack (mode, value, chill_name, fnname, filename, linenumber)
1580      tree mode;
1581      tree value;
1582      const char *chill_name;
1583      const char *fnname;
1584      tree filename;
1585      tree linenumber;
1586 {
1587   tree type, result;
1588   tree expr = NULL_TREE;
1589   tree args, tmpvar, fncall, ptr, outlist = NULL_TREE;
1590
1591   if (mode == NULL_TREE || TREE_CODE (mode) == ERROR_MARK)
1592     return error_mark_node;
1593
1594   if (TREE_CODE (mode) == TYPE_DECL)
1595     type = TREE_TYPE (mode);
1596   else
1597     type = mode;
1598
1599   /* check if we have a mode */
1600   if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
1601     {
1602       error ("first argument to `%s' must be a mode", chill_name);
1603       return error_mark_node;
1604     }
1605
1606   /* check if we have a value if type is READonly */
1607   if (TYPE_READONLY_PROPERTY (type) && value == NULL_TREE)
1608     {
1609       error ("READonly modes for %s must have a value", chill_name);
1610       return error_mark_node;
1611     }
1612
1613   if (value != NULL_TREE)
1614     {
1615       if (TREE_CODE (value) == ERROR_MARK)
1616         return error_mark_node;
1617       expr = chill_convert_for_assignment (type, value, "assignment");
1618     }
1619
1620   /* build function arguments */
1621   if (filename == NULL_TREE)
1622     args = tree_cons (NULL_TREE, size_in_bytes (type), NULL_TREE);
1623   else
1624     args = tree_cons (NULL_TREE, size_in_bytes (type),
1625              tree_cons (NULL_TREE, force_addr_of (filename),
1626                tree_cons (NULL_TREE, linenumber, NULL_TREE)));
1627
1628   ptr = build_chill_pointer_type (type);
1629   tmpvar = decl_temp1 (get_unique_identifier (chill_name),
1630                        ptr, 0, NULL_TREE, 0, 0);
1631   fncall = build_chill_function_call (
1632              lookup_name (get_identifier (fnname)), args);
1633   outlist = tree_cons (NULL_TREE,
1634                build_chill_modify_expr (tmpvar, fncall), outlist);
1635   if (expr == NULL_TREE)
1636     {
1637       /* set allocated memory to 0 */
1638       fncall = build_chill_function_call (
1639                  lookup_name (get_identifier ("memset")),
1640                    tree_cons (NULL_TREE, convert (ptr_type_node, tmpvar),
1641                      tree_cons (NULL_TREE, integer_zero_node,
1642                        tree_cons (NULL_TREE, size_in_bytes (type), NULL_TREE))));
1643       outlist = tree_cons (NULL_TREE, fncall, outlist);
1644     }
1645   else
1646     {
1647       /* write the init value to allocated memory */
1648       outlist = tree_cons (NULL_TREE,
1649                   build_chill_modify_expr (build_chill_indirect_ref (tmpvar, NULL_TREE, 0),
1650                                            expr), 
1651                            outlist);
1652     }
1653   outlist = tree_cons (NULL_TREE, tmpvar, outlist);
1654   result = build_chill_compound_expr (nreverse (outlist));
1655   return result;
1656 }
1657
1658 /* process the ALLOCATE built-in */
1659 static tree
1660 build_chill_allocate (mode, value)
1661      tree mode;
1662      tree value;
1663 {
1664   return build_allocate_getstack (mode, value, "ALLOCATE", "__allocate",
1665                                   get_chill_filename (), get_chill_linenumber ());
1666 }
1667
1668 /* process the GETSTACK built-in */
1669 static tree
1670 build_chill_getstack (mode, value)
1671      tree mode;
1672      tree value;
1673 {
1674   return build_allocate_getstack (mode, value, "GETSTACK", "__builtin_alloca",
1675                                   NULL_TREE, NULL_TREE);
1676 }
1677
1678 /* process the TERMINATE built-in */
1679 static tree
1680 build_chill_terminate (ptr)
1681      tree ptr;
1682 {
1683   tree result;
1684   tree type;
1685
1686   if (ptr == NULL_TREE || TREE_CODE (ptr) == ERROR_MARK)
1687     return error_mark_node;
1688
1689   type = TREE_TYPE (ptr);
1690   if (type == NULL_TREE || TREE_CODE (type) != POINTER_TYPE)
1691     {
1692       error ("argument to TERMINATE must be a reference primitive value");
1693       return error_mark_node;
1694     }
1695   result = build_chill_function_call (
1696              lookup_name (get_identifier ("__terminate")),
1697                tree_cons (NULL_TREE, convert (ptr_type_node, ptr),
1698                  tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
1699                    tree_cons (NULL_TREE, get_chill_linenumber (), NULL_TREE))));
1700   return result;
1701 }
1702
1703 /* build the type passed to _inttime function */
1704 void
1705 build_chill_inttime_type ()
1706 {
1707   tree idxlist;
1708   tree arrtype;
1709   tree decl;
1710
1711   idxlist = build_tree_list (NULL_TREE,
1712                build_chill_range_type (NULL_TREE,
1713                                        integer_zero_node,
1714                                        build_int_2 (5, 0)));
1715   arrtype = build_chill_array_type (ptr_type_node, idxlist, 0, NULL_TREE);
1716
1717   decl = build_decl (TYPE_DECL, get_identifier ("__tmp_INTTIME_type"), arrtype);
1718   pushdecl (decl);
1719   DECL_SOURCE_LINE (decl) = 0;
1720   satisfy_decl (decl, 0);
1721 }
1722
1723 static tree
1724 build_chill_inttime (t, loclist)
1725      tree t, loclist;
1726 {
1727   int  had_errors = 0, cnt;
1728   tree tmp;
1729   tree init = NULL_TREE;
1730   int  numargs;
1731   tree tuple, var;
1732
1733   if (t == NULL_TREE || TREE_CODE (t) == ERROR_MARK)
1734     return error_mark_node;
1735   if (loclist == NULL_TREE || TREE_CODE (loclist) == ERROR_MARK)
1736     return error_mark_node;
1737
1738   /* check first argument to be NEWMODE TIME */
1739   if (TREE_TYPE (t) != abs_timing_type_node)
1740     {
1741       error ("argument 1 to INTTIME must be of mode TIME");
1742       had_errors = 1;
1743     }
1744
1745   cnt = 2;
1746   tmp = loclist;
1747   while (tmp != NULL_TREE)
1748     {
1749       tree loc = TREE_VALUE (tmp);
1750       char errmsg[200];
1751       char *p, *p1;
1752       int  write_error = 0;
1753
1754       sprintf (errmsg, "argument %d to INTTIME must be ", cnt);
1755       p = errmsg + strlen (errmsg);
1756       p1 = p;
1757       
1758       if (loc == NULL_TREE || TREE_CODE (loc) == ERROR_MARK)
1759         had_errors = 1;
1760       else
1761         {
1762           if (! CH_REFERABLE (loc))
1763             {
1764               strcpy (p, "referable");
1765               p += strlen (p);
1766               write_error = 1;
1767               had_errors = 1;
1768             }
1769           if (TREE_CODE (TREE_TYPE (loc)) != INTEGER_TYPE)
1770             {
1771               if (p != p1)
1772                 {
1773                   strcpy (p, " and ");
1774                   p += strlen (p);
1775                 }
1776               strcpy (p, "of integer type");
1777               write_error = 1;
1778               had_errors = 1;
1779             }
1780           /* FIXME: what's about ranges can't hold the result ?? */
1781           if (write_error)
1782             error ("%s", errmsg);
1783         }
1784       /* next location */
1785       tmp = TREE_CHAIN (tmp);
1786       cnt++;
1787     }
1788
1789   if (had_errors)
1790     return error_mark_node;
1791
1792   /* make it always 6 arguments */
1793   numargs = list_length (loclist);
1794   for (cnt = numargs; cnt < 6; cnt++)
1795     init = tree_cons (NULL_TREE, null_pointer_node, init);
1796
1797   /* append the given one's */
1798   tmp = loclist;
1799   while (tmp != NULL_TREE)
1800     {
1801       init = chainon (init,
1802                       build_tree_list (NULL_TREE,
1803                                        build_chill_descr (TREE_VALUE (tmp))));
1804       tmp = TREE_CHAIN (tmp);
1805     }
1806
1807   tuple = build_nt (CONSTRUCTOR, NULL_TREE, init);
1808   var = decl_temp1 (get_unique_identifier ("INTTIME"),
1809                     TREE_TYPE (lookup_name (get_identifier ("__tmp_INTTIME_type"))),
1810                     0, tuple, 0, 0);
1811
1812   return build_chill_function_call (
1813     lookup_name (get_identifier ("_inttime")),
1814        tree_cons (NULL_TREE, t,
1815           tree_cons (NULL_TREE, force_addr_of (var),
1816                      NULL_TREE)));
1817 }
1818
1819
1820 /* Compute the runtime length of the given string variable
1821  * or expression.
1822  */
1823 tree
1824 build_chill_length (expr)
1825      tree expr;
1826 {
1827   if (pass == 2)
1828     {
1829       tree type;
1830       
1831       if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1832         return error_mark_node;
1833       
1834       if (TREE_CODE (expr) == IDENTIFIER_NODE)
1835         expr = lookup_name (expr);
1836
1837       type = TREE_TYPE (expr);
1838       
1839       if (TREE_CODE(type) == ERROR_MARK)
1840         return type;
1841       if (chill_varying_type_p (type))
1842         { 
1843           tree temp = convert (integer_type_node,
1844                           build_component_ref (expr, var_length_id));
1845           /* FIXME: should call
1846            * cond_type_range_exception (temp);
1847            */
1848           return temp;
1849         }
1850       
1851       if ((TREE_CODE (type) == ARRAY_TYPE ||
1852            /* should work for a bitstring too */
1853            (TREE_CODE (type) == SET_TYPE && TREE_CODE (TREE_TYPE (type)) == BOOLEAN_TYPE)) &&
1854           integer_zerop (TYPE_MIN_VALUE (TYPE_DOMAIN (type))))
1855         {
1856           tree temp =  fold (build (PLUS_EXPR, chill_integer_type_node,
1857                                     integer_one_node,
1858                                     TYPE_MAX_VALUE (TYPE_DOMAIN (type))));
1859           return convert (chill_integer_type_node, temp);
1860         }
1861       
1862       if (CH_IS_BUFFER_MODE (type) || CH_IS_EVENT_MODE (type))
1863         {
1864           tree len = max_queue_size (type);
1865           
1866           if (len == NULL_TREE)
1867             len = integer_minus_one_node;
1868           return len;
1869         }
1870
1871       if (CH_IS_TEXT_MODE (type))
1872         {
1873           if (TREE_CODE (expr) == TYPE_DECL)
1874             {
1875               /* text mode name */
1876               return text_length (type);
1877             }
1878           else
1879             {
1880               /* text location */
1881               tree temp = build_component_ref (
1882                             build_component_ref (expr, get_identifier ("tloc")),
1883                                 var_length_id);
1884               return convert (integer_type_node, temp);
1885             }
1886         }
1887  
1888       error("LENGTH argument must be string, buffer, event mode, text location or mode");
1889       return error_mark_node;
1890     }
1891   return NULL_TREE;
1892 }
1893
1894 /* Compute the declared minimum/maximum value of the variable,
1895  * expression or declared type
1896  */
1897 static tree
1898 build_chill_lower_or_upper (what, is_upper)
1899      tree what;
1900      int is_upper;  /* o -> LOWER; 1 -> UPPER */
1901 {
1902   if (pass == 2)
1903     {
1904       tree type;
1905       struct ch_class class;
1906
1907       if (what == NULL_TREE || TREE_CODE (what) == ERROR_MARK)
1908         return error_mark_node;
1909       
1910       if (TREE_CODE_CLASS (TREE_CODE (what)) == 't')
1911         type = what;
1912       else
1913         type = TREE_TYPE (what);
1914       if (type == NULL_TREE)
1915         {
1916           if (is_upper)
1917             error ("UPPER argument must have a mode, or be a mode");
1918           else
1919             error ("LOWER argument must have a mode, or be a mode");
1920           return error_mark_node;
1921         }
1922       while (TREE_CODE (type) == REFERENCE_TYPE)
1923         type = TREE_TYPE (type);
1924       if (chill_varying_type_p (type))
1925         type = CH_VARYING_ARRAY_TYPE (type);
1926      
1927       if (discrete_type_p (type))
1928         {
1929           tree val = is_upper ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type);
1930           class.kind = CH_VALUE_CLASS;
1931           class.mode = type;
1932           return convert_to_class (class, val);
1933         }
1934       else if (TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == SET_TYPE)
1935         {
1936           if (TYPE_STRING_FLAG (type))
1937             {
1938               class.kind = CH_DERIVED_CLASS;
1939               class.mode = integer_type_node;
1940             }
1941           else
1942             {
1943               class.kind = CH_VALUE_CLASS;
1944               class.mode = TYPE_DOMAIN (type);
1945             }
1946           type = TYPE_DOMAIN (type);
1947           return convert_to_class (class,
1948                                    is_upper
1949                                    ? TYPE_MAX_VALUE (type)
1950                                    : TYPE_MIN_VALUE (type));
1951         }
1952       if (is_upper)
1953         error("UPPER argument must be string, array, mode or integer");
1954       else
1955         error("LOWER argument must be string, array, mode or integer");
1956       return error_mark_node;
1957     }
1958   return NULL_TREE;
1959 }
1960
1961 tree
1962 build_chill_lower (what)
1963      tree what;
1964 {
1965   return build_chill_lower_or_upper (what, 0);
1966 }
1967
1968 static tree
1969 build_max_min (expr, max_min)
1970      tree expr;
1971      int max_min; /* 0: calculate MIN; 1: calculate MAX */
1972 {
1973   if (pass == 2)
1974     {
1975       tree type, temp, setminval;
1976       tree set_base_type;
1977       int size_in_bytes;
1978       
1979       if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
1980         return error_mark_node;
1981       
1982       if (TREE_CODE (expr) == IDENTIFIER_NODE)
1983         expr = lookup_name (expr);
1984
1985       type = TREE_TYPE (expr);
1986       set_base_type = TYPE_DOMAIN (type);
1987       setminval = TYPE_MIN_VALUE (set_base_type);
1988       
1989       if (TREE_CODE (type) != SET_TYPE)
1990         {
1991           error("%s argument must be POWERSET mode",
1992                 max_min ? "MAX" : "MIN");
1993           return error_mark_node;
1994         }
1995
1996       /* find max/min of constant powerset at compile time */
1997       if (TREE_CODE (expr) == CONSTRUCTOR && TREE_CONSTANT (expr)
1998           && (size_in_bytes = int_size_in_bytes (type)) >= 0)
1999         {
2000           HOST_WIDE_INT min_val = -1, max_val = -1;
2001           HOST_WIDE_INT i, i_hi = 0;
2002           HOST_WIDE_INT size_in_bits = size_in_bytes * BITS_PER_UNIT;
2003           char *buffer = (char*) alloca (size_in_bits);
2004           if (buffer == NULL
2005               || get_set_constructor_bits (expr, buffer, size_in_bits))
2006             abort ();
2007           for (i = 0; i < size_in_bits; i++)
2008             {
2009               if (buffer[i])
2010                 {
2011                   if (min_val < 0)
2012                     min_val = i;
2013                   max_val = i;
2014                 }
2015             }
2016           if (min_val < 0)
2017             error ("%s called for empty POWERSET", max_min ? "MAX" : "MIN");
2018           i = max_min ? max_val : min_val;
2019           temp = TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (expr)));
2020           add_double (i, i_hi,
2021                       TREE_INT_CST_LOW (temp), TREE_INT_CST_HIGH (temp),
2022                       &i, &i_hi);
2023           temp = build_int_2 (i, i_hi);
2024           TREE_TYPE (temp) = set_base_type;
2025           return temp;
2026         }
2027       else
2028         {
2029           tree parmlist, filename, lineno;
2030           const char *funcname;
2031           
2032           /* set up to call appropriate runtime function */
2033           if (max_min)
2034             funcname = "__flsetpowerset";
2035           else
2036             funcname = "__ffsetpowerset";
2037           
2038           setminval = convert (long_integer_type_node, setminval);
2039           filename = force_addr_of (get_chill_filename());
2040           lineno = get_chill_linenumber();
2041           parmlist = tree_cons (NULL_TREE, force_addr_of (expr),
2042                        tree_cons (NULL_TREE, powersetlen (expr),
2043                          tree_cons (NULL_TREE, setminval,
2044                            tree_cons (NULL_TREE, filename,
2045                              build_tree_list (NULL_TREE, lineno)))));
2046           temp = lookup_name (get_identifier (funcname));
2047           temp = build_chill_function_call (temp, parmlist);
2048           TREE_TYPE (temp) = set_base_type;
2049           return temp;
2050         }
2051     }
2052   return NULL_TREE;
2053 }
2054
2055
2056 /* Compute the current runtime maximum value of the powerset
2057  */
2058 tree
2059 build_chill_max (expr)
2060      tree expr;
2061 {
2062   return build_max_min (expr, 1);
2063 }
2064
2065
2066 /* Compute the current runtime minimum value of the powerset
2067  */
2068 tree
2069 build_chill_min (expr)
2070      tree expr;
2071 {
2072   return build_max_min (expr, 0);
2073 }
2074
2075
2076 /* Build a conversion from the given expression to an INT,
2077  * but only when the expression's type is the same size as
2078  * an INT.
2079  */
2080 tree
2081 build_chill_num (expr)
2082      tree expr;
2083 {
2084   if (pass == 2)
2085     {
2086       tree temp;
2087       int need_unsigned;
2088
2089       if (expr == NULL_TREE || TREE_CODE(expr) == ERROR_MARK)
2090         return error_mark_node;
2091       
2092       if (TREE_CODE (expr) == IDENTIFIER_NODE)
2093         expr = lookup_name (expr);
2094
2095       expr = convert_to_discrete (expr);
2096       if (expr == NULL_TREE)
2097         {
2098           error ("argument to NUM is not discrete");
2099           return error_mark_node;
2100         }
2101
2102       /* enumeral types and string slices of length 1 must be kept unsigned */
2103       need_unsigned = (TREE_CODE (TREE_TYPE (expr)) == ENUMERAL_TYPE)
2104         || TREE_UNSIGNED (TREE_TYPE (expr));
2105
2106       temp = type_for_size (TYPE_PRECISION (TREE_TYPE (expr)), 
2107                             need_unsigned);
2108       if (temp == NULL_TREE)
2109         {
2110           error ("no integer mode which matches expression's mode");
2111           return integer_zero_node;
2112         }
2113       temp = convert (temp, expr);
2114
2115       if (TREE_CONSTANT (temp))
2116         {
2117           if (tree_int_cst_lt (temp, 
2118                                TYPE_MIN_VALUE (TREE_TYPE (temp))))
2119             error ("NUM's parameter is below its mode range");
2120           if (tree_int_cst_lt (TYPE_MAX_VALUE (TREE_TYPE (temp)),
2121                                temp))
2122             error ("NUM's parameter is above its mode range");
2123         }
2124 #if 0
2125       else
2126         {
2127           if (range_checking)
2128             cond_overflow_exception (temp, 
2129               TYPE_MIN_VALUE (TREE_TYPE (temp)),
2130               TYPE_MAX_VALUE (TREE_TYPE (temp)));
2131         }
2132 #endif
2133
2134       /* NUM delivers the INT derived class */
2135       CH_DERIVED_FLAG (temp) = 1;
2136       
2137       return temp;
2138     }
2139   return NULL_TREE;
2140 }
2141
2142
2143 static tree
2144 build_chill_pred_or_succ (expr, op)
2145      tree expr;
2146      enum tree_code op; /* PLUS_EXPR for SUCC; MINUS_EXPR for PRED. */
2147 {
2148   struct ch_class class;
2149   tree etype, cond;
2150
2151   if (pass == 1)
2152     return NULL_TREE;
2153
2154   if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK)
2155     return error_mark_node;
2156   
2157   /* disallow numbered SETs */
2158   if (TREE_CODE (TREE_TYPE (expr)) == ENUMERAL_TYPE
2159       && CH_ENUM_IS_NUMBERED (TREE_TYPE (expr)))
2160     {
2161       error ("cannot take SUCC or PRED of a numbered SET");
2162       return error_mark_node;
2163     }
2164   
2165   if (TREE_CODE (TREE_TYPE (expr)) == POINTER_TYPE)
2166     {
2167       if (TREE_TYPE (TREE_TYPE (expr)) == void_type_node)
2168         {
2169           error ("SUCC or PRED must not be done on a PTR");
2170           return error_mark_node;
2171         }
2172       pedwarn ("SUCC or PRED for a reference type is not standard");
2173       return fold (build (op, TREE_TYPE (expr),
2174                           expr,
2175                           size_in_bytes (TREE_TYPE (TREE_TYPE (expr)))));
2176     }
2177
2178   expr = convert_to_discrete (expr);
2179
2180   if (expr == NULL_TREE)
2181     {
2182       error ("SUCC or PRED argument must be a discrete mode");
2183       return error_mark_node;
2184     }
2185
2186   class = chill_expr_class (expr);
2187   if (class.mode)
2188     class.mode = CH_ROOT_MODE (class.mode);
2189   etype = class.mode;
2190   expr = convert (etype, expr);
2191
2192   /* Exception if expression is already at the
2193      min (PRED)/max(SUCC) valid value for its type. */
2194   cond = fold (build (op == PLUS_EXPR ? GE_EXPR : LE_EXPR,
2195                       boolean_type_node,
2196                       expr,
2197                       convert (etype,
2198                                op == PLUS_EXPR ? TYPE_MAX_VALUE (etype)
2199                                : TYPE_MIN_VALUE (etype))));
2200   if (TREE_CODE (cond) == INTEGER_CST
2201       && tree_int_cst_equal (cond, integer_one_node))
2202     {
2203       error ("taking the %s of a value already at its %s value",
2204              op == PLUS_EXPR ? "SUCC" : "PRED",
2205              op == PLUS_EXPR ? "maximum" : "minimum");
2206       return error_mark_node;
2207     }
2208
2209   if (range_checking)
2210     expr = check_expression (expr, cond,
2211                              ridpointers[(int) RID_OVERFLOW]);
2212
2213   expr = fold (build (op, etype, expr, 
2214            convert (etype, integer_one_node)));
2215   return convert_to_class (class, expr);
2216 }
2217 \f
2218 /* Compute the value of the CHILL `size' operator just
2219  * like the C 'sizeof' operator (code stolen from c-typeck.c)
2220  * TYPE may be a location or mode tree.  In pass 1, we build
2221  * a function-call syntax tree;  in pass 2, we evaluate it.
2222  */
2223 tree
2224 build_chill_sizeof (type)
2225      tree type;
2226 {
2227   if (pass == 2)
2228     {
2229       tree temp;
2230       struct ch_class class;
2231       enum tree_code code;
2232       tree signame = NULL_TREE;
2233
2234       if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK)
2235         return error_mark_node;
2236
2237       if (TREE_CODE (type) == IDENTIFIER_NODE)
2238         type = lookup_name (type);
2239
2240       code = TREE_CODE (type);
2241       if (code == ERROR_MARK)
2242         return error_mark_node;
2243       
2244       if (TREE_CODE_CLASS (TREE_CODE (type)) != 't')
2245         {
2246           if (TREE_CODE (type) == TYPE_DECL && CH_DECL_SIGNAL (type))
2247             signame = DECL_NAME (type);
2248         type = TREE_TYPE (type);
2249         }
2250
2251       if (code == FUNCTION_TYPE)
2252         {
2253           if (pedantic || warn_pointer_arith)
2254             pedwarn ("size applied to a function mode");
2255           return error_mark_node;
2256         }
2257       if (code == VOID_TYPE)
2258         {
2259           if (pedantic || warn_pointer_arith)
2260             pedwarn ("sizeof applied to a void mode");
2261           return error_mark_node;
2262         }
2263       if (TYPE_SIZE (type) == 0)
2264         {
2265           error ("sizeof applied to an incomplete mode");
2266           return error_mark_node;
2267         }
2268       
2269       temp = size_binop (CEIL_DIV_EXPR, TYPE_SIZE_UNIT (type),
2270                          size_int (TYPE_PRECISION (char_type_node)
2271                                    / BITS_PER_UNIT));
2272       if (signame != NULL_TREE)
2273         {
2274           /* we have a signal definition. This signal may have no
2275              data items specified. The definition however says that
2276              there are data, cause we cannot build a structure without
2277              fields. In this case return 0. */
2278           if (IDENTIFIER_SIGNAL_DATA (signame) == 0)
2279             temp = integer_zero_node;
2280         }
2281       
2282       /* FIXME: should call
2283        * cond_type_range_exception (temp);
2284        */
2285       class.kind = CH_DERIVED_CLASS;
2286       class.mode = integer_type_node;
2287       return convert_to_class (class, temp);
2288     }
2289   return NULL_TREE;
2290 }
2291 \f
2292 /* Compute the declared maximum value of the variable,
2293  * expression or declared type
2294  */
2295 tree
2296 build_chill_upper (what)
2297      tree what;
2298 {
2299   return build_chill_lower_or_upper (what, 1);
2300 }
2301 \f
2302 /*
2303  * Here at the site of a function/procedure call..  We need to build
2304  * temps for the INOUT and OUT parameters, and copy the actual parameters
2305  * into the temps.  After the call, we 'copy back' the values from the
2306  * temps to the actual parameter variables.  This somewhat verbose pol-
2307  * icy meets the requirement that the actual parameters are undisturbed
2308  * if the function/procedure causes an exception.  They are updated only
2309  * upon a normal return from the function.
2310  *
2311  * Note: the expr_list, which collects all of the above assignments, etc,
2312  * is built in REVERSE execution order.  The list is corrected by nreverse
2313  * inside the build_chill_compound_expr call.
2314  */
2315 tree
2316 build_chill_function_call (function, expr)
2317      tree function, expr;
2318 {
2319   register tree typetail, valtail, typelist;
2320   register tree temp, actual_args = NULL_TREE;
2321   tree name = NULL_TREE;
2322   tree function_call;
2323   tree fntype;
2324   int parmno = 1;            /* parameter number for error message */
2325   int callee_raise_exception = 0;
2326
2327   /* list of assignments to run after the actual call,
2328      copying from the temps back to the user's variables. */
2329   tree copy_back = NULL_TREE;
2330
2331   /* list of expressions to run before the call, copying from
2332      the user's variable to the temps that are passed to the function */
2333   tree expr_list = NULL_TREE;
2334  
2335   if (function == NULL_TREE || TREE_CODE (function) == ERROR_MARK)
2336     return error_mark_node;
2337
2338   if (expr != NULL_TREE && TREE_CODE (expr) == ERROR_MARK)
2339     return error_mark_node;
2340
2341   if (pass < 2)
2342     return error_mark_node;
2343
2344   fntype = TREE_TYPE (function);
2345   if (TREE_CODE (function) == FUNCTION_DECL)
2346     {
2347       callee_raise_exception = TYPE_RAISES_EXCEPTIONS (fntype) != NULL_TREE;
2348
2349       /* Differs from default_conversion by not setting TREE_ADDRESSABLE
2350          (because calling an inline function does not mean the function
2351          needs to be separately compiled).  */
2352       fntype = build_type_variant (fntype,
2353                                    TREE_READONLY (function),
2354                                    TREE_THIS_VOLATILE (function));
2355       name = DECL_NAME (function);
2356
2357       /* check that function is not a PROCESS */
2358       if (CH_DECL_PROCESS (function))
2359         {
2360           error ("cannot call a PROCESS, you START a PROCESS");
2361           return error_mark_node;
2362         }
2363
2364       function = build1 (ADDR_EXPR, build_pointer_type (fntype), function);
2365     }
2366   else if (TREE_CODE (fntype) == POINTER_TYPE)
2367     {
2368       fntype = TREE_TYPE (fntype);
2369       callee_raise_exception = TYPE_RAISES_EXCEPTIONS (fntype) != NULL_TREE;
2370
2371       /* Z.200 6.7 Call Action:
2372          "A procedure call causes the EMPTY exception if the
2373          procedure primitive value delivers NULL. */
2374       if (TREE_CODE (function) != ADDR_EXPR
2375           || TREE_CODE (TREE_OPERAND (function, 0)) != FUNCTION_DECL)
2376         function = check_non_null (function);
2377     }
2378
2379   typelist = TYPE_ARG_TYPES (fntype);
2380   if (callee_raise_exception)
2381     {
2382       /* remove last two arguments from list for subsequent checking.
2383           They will get added automatically after checking */
2384       int len = list_length (typelist);
2385       int i;
2386       tree newtypelist = NULL_TREE;
2387       tree wrk = typelist;
2388       
2389       for (i = 0; i < len - 3; i++)
2390         {
2391             newtypelist = tree_cons (TREE_PURPOSE (wrk), TREE_VALUE (wrk), newtypelist);
2392               wrk = TREE_CHAIN (wrk);
2393           }
2394       /* add the void_type_node */
2395       newtypelist = tree_cons (NULL_TREE, void_type_node, newtypelist);
2396       typelist = nreverse (newtypelist);
2397     }
2398
2399   /* Scan the given expressions and types, producing individual
2400      converted arguments and pushing them on ACTUAL_ARGS in 
2401      reverse order.  */
2402   for (valtail = expr, typetail = typelist;
2403        valtail != NULL_TREE && typetail != NULL_TREE;  parmno++,
2404        valtail = TREE_CHAIN (valtail), typetail = TREE_CHAIN (typetail))
2405     {
2406       register tree actual = TREE_VALUE (valtail);
2407       register tree attr   = TREE_PURPOSE (typetail)
2408         ? TREE_PURPOSE (typetail) : ridpointers[(int) RID_IN];
2409       register tree type   = TREE_VALUE (typetail);
2410       char place[30];
2411       sprintf (place, "parameter %d", parmno);
2412           
2413       /* if we have reached void_type_node in typelist we are at the
2414           end of formal parameters and then we have too many actual
2415            parameters */
2416       if (type == void_type_node)
2417          break;
2418
2419       /* check if actual is a TYPE_DECL. FIXME: what else ? */
2420       if (TREE_CODE (actual) == TYPE_DECL)
2421         {
2422           error ("invalid %s", place);
2423           actual = error_mark_node;
2424         }
2425       /* INOUT or OUT param to handle? */
2426       else if (attr == ridpointers[(int) RID_OUT]
2427           || attr == ridpointers[(int)RID_INOUT])
2428         {
2429           char temp_name[20]; 
2430           tree parmtmp;
2431           tree in_actual = NULL_TREE, out_actual;
2432
2433           /* actual parameter must be a location so we can
2434              build a reference to it */
2435           if (!CH_LOCATION_P (actual))
2436             {
2437               error ("%s parameter %d must be a location", 
2438                      (attr == ridpointers[(int) RID_OUT]) ?
2439                      "OUT" : "INOUT", parmno);
2440               continue;
2441             }
2442           if (TYPE_READONLY_PROPERTY (TREE_TYPE (actual))
2443               || TREE_READONLY (actual))
2444             {
2445               error ("%s parameter %d is READ-only", 
2446                      (attr == ridpointers[(int) RID_OUT]) ?
2447                      "OUT" : "INOUT", parmno);
2448               continue;
2449             }
2450
2451           sprintf (temp_name, "PARM_%d_%s",  parmno,
2452                    (attr == ridpointers[(int)RID_OUT]) ?
2453                    "OUT" : "INOUT");
2454           parmtmp = decl_temp1 (get_unique_identifier (temp_name),
2455                                 TREE_TYPE (type), 0, NULL_TREE, 0, 0);
2456           /* this temp *must not* be optimized into a register */
2457           mark_addressable (parmtmp);
2458
2459           if (attr == ridpointers[(int)RID_INOUT])
2460             {
2461               tree in_actual = chill_convert_for_assignment (TREE_TYPE (type),
2462                                                              actual, place);
2463               tree tmp = build_chill_modify_expr (parmtmp, in_actual);
2464               expr_list = tree_cons (NULL_TREE, tmp, expr_list);
2465             }
2466           if (in_actual != error_mark_node)
2467             {
2468               /* list of copy back assignments to perform, from the temp
2469                  back to the actual parameter */
2470               out_actual = chill_convert_for_assignment (TREE_TYPE (actual),
2471                                                          parmtmp, place);
2472               copy_back = tree_cons (NULL_TREE,
2473                                      build_chill_modify_expr (actual,
2474                                                               out_actual),
2475                                      copy_back);
2476             }
2477           /* we can do this because build_chill_function_type
2478              turned these parameters into REFERENCE_TYPEs. */
2479           actual = build1 (ADDR_EXPR, type, parmtmp);
2480         }
2481       else if (attr == ridpointers[(int) RID_LOC])
2482         {
2483           int is_location = chill_location (actual);
2484           if (is_location)
2485             {
2486               if (is_location == 1)
2487                 {
2488                   error ("LOC actual parameter %d is a non-referable location",
2489                          parmno);
2490                   actual = error_mark_node;
2491                 }
2492               else if (! CH_READ_COMPATIBLE (type, TREE_TYPE (actual)))
2493                 {
2494                   error ("mode mismatch in parameter %d", parmno);
2495                   actual = error_mark_node;
2496                 }
2497               else
2498                 actual = convert (type, actual);
2499             }
2500           else
2501             {
2502               sprintf (place, "parameter_%d", parmno);
2503               actual = decl_temp1 (get_identifier (place),
2504                                    TREE_TYPE (type), 0, actual, 0, 0);
2505               actual = convert (type, actual);
2506             }
2507           mark_addressable (actual);
2508         }
2509       else
2510         actual = chill_convert_for_assignment (type, actual, place);
2511
2512       actual_args = tree_cons (NULL_TREE, actual, actual_args);
2513     }
2514  
2515   if (valtail != 0 && TREE_VALUE (valtail) != void_type_node)
2516     {
2517       if (name)
2518         error ("too many arguments to procedure `%s'",
2519                IDENTIFIER_POINTER (name));
2520       else
2521         error ("too many arguments to procedure");
2522       return error_mark_node;
2523     }
2524   else if (typetail != 0 && TREE_VALUE (typetail) != void_type_node)
2525     {
2526       if (name)
2527         error ("too few arguments to procedure `%s'",
2528                IDENTIFIER_POINTER (name));
2529       else
2530         error ("too few arguments to procedure");
2531       return error_mark_node;
2532     }
2533   
2534   if (callee_raise_exception)
2535     {
2536       /* add linenumber and filename of the caller as arguments */
2537       actual_args = tree_cons (NULL_TREE, force_addr_of (get_chill_filename ()),
2538                                       actual_args);
2539       actual_args = tree_cons (NULL_TREE, get_chill_linenumber (), actual_args);
2540     }
2541   
2542   function_call = build (CALL_EXPR, TREE_TYPE (fntype),
2543                           function, nreverse (actual_args), NULL_TREE);
2544   TREE_SIDE_EFFECTS (function_call) = 1;
2545
2546   if (copy_back == NULL_TREE && expr_list == NULL_TREE)
2547     return function_call;        /* no copying to do, either way */
2548   else
2549     {
2550       tree result_type = TREE_TYPE (fntype);
2551       tree result_tmp = NULL_TREE;
2552
2553       /* no result wanted from procedure call */
2554       if (result_type == NULL_TREE || result_type == void_type_node)
2555         expr_list = tree_cons (NULL_TREE, function_call, expr_list);
2556       else
2557         {
2558           /* create a temp for the function's result. this is so that we can
2559              evaluate this temp as the last expression in the list, which will
2560              make the function's return value the value of the whole list of
2561              expressions (by the C rules for compound expressions) */
2562           result_tmp = decl_temp1 (get_unique_identifier ("FUNC_RESULT"),
2563                                    result_type, 0, NULL_TREE, 0, 0);
2564           expr_list = tree_cons (NULL_TREE, 
2565                         build_chill_modify_expr (result_tmp, function_call),
2566                                  expr_list);
2567         }
2568
2569       expr_list = chainon (copy_back, expr_list);
2570
2571       /* last, but not least, the function's result */
2572       if (result_tmp != NULL_TREE)
2573         expr_list = tree_cons (NULL_TREE, result_tmp, expr_list);
2574       temp = build_chill_compound_expr (nreverse (expr_list));
2575       return temp;
2576     }
2577 }
2578 \f
2579 /* We saw something that looks like a function call,
2580    but if it's pass 1, we're not sure. */
2581
2582 tree
2583 build_generalized_call (func, args)
2584      tree func, args;
2585 {
2586   tree type = TREE_TYPE (func);
2587
2588   if (pass == 1)
2589     return build (CALL_EXPR, NULL_TREE, func, args, NULL_TREE);
2590
2591   /* Handle string repetition */
2592   if (TREE_CODE (func) == INTEGER_CST)
2593     {
2594       if (args == NULL_TREE || TREE_CHAIN (args) != NULL_TREE)
2595         {
2596           error ("syntax error (integer used as function)");
2597           return error_mark_node;
2598         }
2599       if (TREE_CODE (args) == TREE_LIST)
2600         args = TREE_VALUE (args);
2601       return build_chill_repetition_op (func, args);
2602     }
2603
2604   if (args != NULL_TREE)
2605     {
2606       if (TREE_CODE (args) == RANGE_EXPR)
2607         {
2608           tree lo = TREE_OPERAND (args, 0), hi = TREE_OPERAND (args, 1);
2609           if (TREE_CODE_CLASS (TREE_CODE (func)) == 't')
2610             return build_chill_range_type (func, lo, hi);
2611           else
2612             return build_chill_slice_with_range (func, lo, hi);
2613         }
2614       else if (TREE_CODE (args) != TREE_LIST)
2615         {
2616           error ("syntax error - missing operator, comma, or '('?");
2617           return error_mark_node;
2618         }
2619     }
2620
2621   if (TREE_CODE (func) == TYPE_DECL)
2622     {
2623       if (CH_DECL_SIGNAL (func))
2624         return build_signal_descriptor (func, args);
2625       func = TREE_TYPE (func);
2626     }
2627
2628   if (TREE_CODE_CLASS (TREE_CODE (func)) == 't'
2629       && args != NULL_TREE && TREE_CHAIN (args) == NULL_TREE)
2630     return build_chill_cast (func, TREE_VALUE (args));
2631
2632   if (TREE_CODE (type) == FUNCTION_TYPE
2633       || (TREE_CODE (type) == POINTER_TYPE
2634           && TREE_TYPE (type) != NULL_TREE
2635           && TREE_CODE (TREE_TYPE (type)) == FUNCTION_TYPE))
2636     {
2637       /* Check for a built-in Chill function.  */
2638       if (TREE_CODE (func) == FUNCTION_DECL
2639           && DECL_BUILT_IN (func)
2640           && DECL_FUNCTION_CODE (func) > END_BUILTINS)
2641         {
2642           tree fnname = DECL_NAME (func);
2643           switch ((enum chill_built_in_function)DECL_FUNCTION_CODE (func))
2644             {
2645             case BUILT_IN_CH_ABS:
2646               if (check_arglist_length (args, 1, 1, fnname) < 0)
2647                 return error_mark_node;
2648               return build_chill_abs (TREE_VALUE (args));
2649             case BUILT_IN_ABSTIME:
2650               if (check_arglist_length (args, 0, 6, fnname) < 0)
2651                 return error_mark_node;
2652               return build_chill_abstime (args);
2653             case BUILT_IN_ADDR:
2654               if (check_arglist_length (args, 1, 1, fnname) < 0)
2655                 return error_mark_node;
2656 #if 0
2657               return build_chill_addr_expr (TREE_VALUE (args), (char *)0);
2658 #else
2659               return build_chill_arrow_expr (TREE_VALUE (args), 0);
2660 #endif
2661             case BUILT_IN_ALLOCATE_GLOBAL_MEMORY:
2662               if (check_arglist_length (args, 2, 2, fnname) < 0)
2663                 return error_mark_node;
2664               return build_allocate_global_memory_call
2665                 (TREE_VALUE (args),
2666                  TREE_VALUE (TREE_CHAIN (args)));
2667             case BUILT_IN_ALLOCATE:
2668               if (check_arglist_length (args, 1, 2, fnname) < 0)
2669                 return error_mark_node;
2670               return build_chill_allocate (TREE_VALUE (args),
2671                        TREE_CHAIN (args) == NULL_TREE ? NULL_TREE : TREE_VALUE (TREE_CHAIN (args)));
2672             case BUILT_IN_ALLOCATE_MEMORY:
2673               if (check_arglist_length (args, 2, 2, fnname) < 0)
2674                 return error_mark_node;
2675               return build_allocate_memory_call
2676                 (TREE_VALUE (args),
2677                  TREE_VALUE (TREE_CHAIN (args)));
2678             case BUILT_IN_ASSOCIATE:
2679               if (check_arglist_length (args, 2, 3, fnname) < 0)
2680                 return error_mark_node;
2681               return build_chill_associate
2682                 (TREE_VALUE (args),
2683                  TREE_VALUE (TREE_CHAIN (args)),
2684                  TREE_CHAIN (TREE_CHAIN (args)));
2685             case BUILT_IN_ARCCOS:
2686               if (check_arglist_length (args, 1, 1, fnname) < 0)
2687                 return error_mark_node;
2688               return build_chill_floatcall (TREE_VALUE (args),
2689                                             IDENTIFIER_POINTER (fnname),
2690                                             "__acos");
2691             case BUILT_IN_ARCSIN:
2692               if (check_arglist_length (args, 1, 1, fnname) < 0)
2693                 return error_mark_node;
2694               return build_chill_floatcall (TREE_VALUE (args),
2695                                             IDENTIFIER_POINTER (fnname),
2696                                             "__asin");
2697             case BUILT_IN_ARCTAN:
2698               if (check_arglist_length (args, 1, 1, fnname) < 0)
2699                 return error_mark_node;
2700               return build_chill_floatcall (TREE_VALUE (args),
2701                                             IDENTIFIER_POINTER (fnname),
2702                                             "__atan");
2703             case BUILT_IN_CARD:
2704               if (check_arglist_length (args, 1, 1, fnname) < 0)
2705                 return error_mark_node;
2706               return build_chill_card (TREE_VALUE (args));
2707             case BUILT_IN_CONNECT:
2708               if (check_arglist_length (args, 3, 5, fnname) < 0)
2709                 return error_mark_node;
2710               return build_chill_connect 
2711                 (TREE_VALUE (args),
2712                  TREE_VALUE (TREE_CHAIN (args)),
2713                  TREE_VALUE (TREE_CHAIN (TREE_CHAIN (args))),
2714                  TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args))));
2715             case BUILT_IN_COPY_NUMBER:
2716               if (check_arglist_length (args, 1, 1, fnname) < 0)
2717                 return error_mark_node;
2718               return build_copy_number (TREE_VALUE (args));
2719             case BUILT_IN_CH_COS:
2720               if (check_arglist_length (args, 1, 1, fnname) < 0)
2721                 return error_mark_node;
2722               return build_chill_floatcall (TREE_VALUE (args),
2723                                             IDENTIFIER_POINTER (fnname),
2724                                             "__cos");
2725             case BUILT_IN_CREATE:
2726               if (check_arglist_length (args, 1, 1, fnname) < 0)
2727                 return error_mark_node;
2728               return build_chill_create (TREE_VALUE (args));
2729             case BUILT_IN_DAYS:
2730               if (check_arglist_length (args, 1, 1, fnname) < 0)
2731                 return error_mark_node;
2732               return build_chill_duration (TREE_VALUE (args), DAYS_MULTIPLIER,
2733                                            fnname, DAYS_MAX);
2734             case BUILT_IN_CH_DELETE:
2735               if (check_arglist_length (args, 1, 1, fnname) < 0)
2736                 return error_mark_node;
2737               return build_chill_delete (TREE_VALUE (args));
2738             case BUILT_IN_DESCR:
2739               if (check_arglist_length (args, 1, 1, fnname) < 0)
2740                 return error_mark_node;
2741               return build_chill_descr (TREE_VALUE (args));
2742             case BUILT_IN_DISCONNECT:
2743               if (check_arglist_length (args, 1, 1, fnname) < 0)
2744                 return error_mark_node;
2745               return build_chill_disconnect (TREE_VALUE (args));
2746             case BUILT_IN_DISSOCIATE:
2747               if (check_arglist_length (args, 1, 1, fnname) < 0)
2748                 return error_mark_node;
2749               return build_chill_dissociate (TREE_VALUE (args));
2750             case BUILT_IN_EOLN:
2751               if (check_arglist_length (args, 1, 1, fnname) < 0)
2752                 return error_mark_node;
2753               return build_chill_eoln (TREE_VALUE (args));
2754             case BUILT_IN_EXISTING:
2755               if (check_arglist_length (args, 1, 1, fnname) < 0)
2756                 return error_mark_node;
2757               return build_chill_existing (TREE_VALUE (args));
2758             case BUILT_IN_EXP:
2759               if (check_arglist_length (args, 1, 1, fnname) < 0)
2760                 return error_mark_node;
2761               return build_chill_floatcall (TREE_VALUE (args),
2762                                             IDENTIFIER_POINTER (fnname),
2763                                             "__exp");
2764             case BUILT_IN_GEN_CODE:
2765               if (check_arglist_length (args, 1, 1, fnname) < 0)
2766                 return error_mark_node;
2767               return build_gen_code (TREE_VALUE (args));
2768             case BUILT_IN_GEN_INST:
2769               if (check_arglist_length (args, 2, 2, fnname) < 0)
2770                 return error_mark_node;
2771               return build_gen_inst (TREE_VALUE (args),
2772                  TREE_VALUE (TREE_CHAIN (args)));
2773             case BUILT_IN_GEN_PTYPE:
2774               if (check_arglist_length (args, 1, 1, fnname) < 0)
2775                 return error_mark_node;
2776               return build_gen_ptype (TREE_VALUE (args));
2777             case BUILT_IN_GETASSOCIATION:
2778               if (check_arglist_length (args, 1, 1, fnname) < 0)
2779                 return error_mark_node;
2780               return build_chill_getassociation (TREE_VALUE (args));
2781             case BUILT_IN_GETSTACK:
2782               if (check_arglist_length (args, 1, 2, fnname) < 0)
2783                 return error_mark_node;
2784               return build_chill_getstack (TREE_VALUE (args),
2785                        TREE_CHAIN (args) == NULL_TREE ? NULL_TREE : TREE_VALUE (TREE_CHAIN (args)));
2786             case BUILT_IN_GETTEXTACCESS:
2787               if (check_arglist_length (args, 1, 1, fnname) < 0)
2788                 return error_mark_node;
2789               return build_chill_gettextaccess (TREE_VALUE (args));
2790             case BUILT_IN_GETTEXTINDEX:
2791               if (check_arglist_length (args, 1, 1, fnname) < 0)
2792                 return error_mark_node;
2793               return build_chill_gettextindex (TREE_VALUE (args));
2794             case BUILT_IN_GETTEXTRECORD:
2795               if (check_arglist_length (args, 1, 1, fnname) < 0)
2796                 return error_mark_node;
2797               return build_chill_gettextrecord (TREE_VALUE (args));
2798             case BUILT_IN_GETUSAGE:
2799               if (check_arglist_length (args, 1, 1, fnname) < 0)
2800                 return error_mark_node;
2801               return build_chill_getusage (TREE_VALUE (args));
2802             case BUILT_IN_HOURS:
2803               if (check_arglist_length (args, 1, 1, fnname) < 0)
2804                 return error_mark_node;
2805               return build_chill_duration (TREE_VALUE (args), HOURS_MULTIPLIER,
2806                                            fnname, HOURS_MAX);
2807             case BUILT_IN_INDEXABLE:
2808               if (check_arglist_length (args, 1, 1, fnname) < 0)
2809                 return error_mark_node;
2810               return build_chill_indexable (TREE_VALUE (args));
2811             case BUILT_IN_INTTIME:
2812               if (check_arglist_length (args, 2, 7, fnname) < 0)
2813                 return error_mark_node;
2814               return build_chill_inttime (TREE_VALUE (args),
2815                  TREE_CHAIN (args));
2816             case BUILT_IN_ISASSOCIATED:
2817               if (check_arglist_length (args, 1, 1, fnname) < 0)
2818                 return error_mark_node;
2819               return build_chill_isassociated (TREE_VALUE (args));
2820             case BUILT_IN_LENGTH:
2821               if (check_arglist_length (args, 1, 1, fnname) < 0)
2822                 return error_mark_node;
2823               return build_chill_length (TREE_VALUE (args));
2824             case BUILT_IN_LN:
2825               if (check_arglist_length (args, 1, 1, fnname) < 0)
2826                 return error_mark_node;
2827               return build_chill_floatcall (TREE_VALUE (args),
2828                                             IDENTIFIER_POINTER (fnname),
2829                                             "__log");
2830             case BUILT_IN_LOG:
2831               if (check_arglist_length (args, 1, 1, fnname) < 0)
2832                 return error_mark_node;
2833               return build_chill_floatcall (TREE_VALUE (args),
2834                                             IDENTIFIER_POINTER (fnname),
2835                                             "__log10");
2836             case BUILT_IN_LOWER:
2837               if (check_arglist_length (args, 1, 1, fnname) < 0)
2838                 return error_mark_node;
2839               return build_chill_lower (TREE_VALUE (args));
2840             case BUILT_IN_MAX:
2841               if (check_arglist_length (args, 1, 1, fnname) < 0)
2842                 return error_mark_node;
2843               return build_chill_max (TREE_VALUE (args));
2844             case BUILT_IN_MILLISECS:
2845               if (check_arglist_length (args, 1, 1, fnname) < 0)
2846                 return error_mark_node;
2847               return build_chill_duration (TREE_VALUE (args), MILLISECS_MULTIPLIER,
2848                                            fnname, MILLISECS_MAX);
2849             case BUILT_IN_MIN:
2850               if (check_arglist_length (args, 1, 1, fnname) < 0)
2851                 return error_mark_node;
2852               return build_chill_min (TREE_VALUE (args));
2853             case BUILT_IN_MINUTES:
2854               if (check_arglist_length (args, 1, 1, fnname) < 0)
2855                 return error_mark_node;
2856               return build_chill_duration (TREE_VALUE (args), MINUTES_MULTIPLIER,
2857                                            fnname, MINUTES_MAX);
2858             case BUILT_IN_MODIFY:
2859               if (check_arglist_length (args, 1, -1, fnname) < 0)
2860                 return error_mark_node;
2861               return build_chill_modify (TREE_VALUE (args), TREE_CHAIN (args));
2862             case BUILT_IN_NUM:
2863               if (check_arglist_length (args, 1, 1, fnname) < 0)
2864                 return error_mark_node;
2865               return build_chill_num (TREE_VALUE (args));
2866             case BUILT_IN_OUTOFFILE:
2867               if (check_arglist_length (args, 1, 1, fnname) < 0)
2868                 return error_mark_node;
2869               return build_chill_outoffile (TREE_VALUE (args));
2870             case BUILT_IN_PRED:
2871               if (check_arglist_length (args, 1, 1, fnname) < 0)
2872                 return error_mark_node;
2873               return build_chill_pred_or_succ (TREE_VALUE (args), MINUS_EXPR);
2874             case BUILT_IN_PROC_TYPE:
2875               if (check_arglist_length (args, 1, 1, fnname) < 0)
2876                 return error_mark_node;
2877               return build_proc_type (TREE_VALUE (args));
2878             case BUILT_IN_QUEUE_LENGTH:
2879               if (check_arglist_length (args, 1, 1, fnname) < 0)
2880                 return error_mark_node;
2881               return build_queue_length (TREE_VALUE (args));
2882             case BUILT_IN_READABLE:
2883               if (check_arglist_length (args, 1, 1, fnname) < 0)
2884                 return error_mark_node;
2885               return build_chill_readable (TREE_VALUE (args));
2886             case BUILT_IN_READRECORD:
2887               if (check_arglist_length (args, 1, 3, fnname) < 0)
2888                 return error_mark_node;
2889               return build_chill_readrecord (TREE_VALUE (args), TREE_CHAIN (args));
2890             case BUILT_IN_READTEXT:
2891               if (check_arglist_length (args, 2, -1, fnname) < 0)
2892                 return error_mark_node;
2893               return build_chill_readtext (TREE_VALUE (args),
2894                                            TREE_CHAIN (args));
2895             case BUILT_IN_RETURN_MEMORY:
2896               if (check_arglist_length (args, 1, 1, fnname) < 0)
2897                 return error_mark_node;
2898               return build_return_memory (TREE_VALUE (args));
2899             case BUILT_IN_SECS:
2900               if (check_arglist_length (args, 1, 1, fnname) < 0)
2901                 return error_mark_node;
2902               return build_chill_duration (TREE_VALUE (args), SECS_MULTIPLIER,
2903                                            fnname, SECS_MAX);
2904             case BUILT_IN_SEQUENCIBLE:
2905               if (check_arglist_length (args, 1, 1, fnname) < 0)
2906                 return error_mark_node;
2907               return build_chill_sequencible (TREE_VALUE (args));
2908             case BUILT_IN_SETTEXTACCESS:
2909               if (check_arglist_length (args, 2, 2, fnname) < 0)
2910                 return error_mark_node;
2911               return build_chill_settextaccess (TREE_VALUE (args),
2912                                                 TREE_VALUE (TREE_CHAIN (args)));
2913             case BUILT_IN_SETTEXTINDEX:
2914               if (check_arglist_length (args, 2, 2, fnname) < 0)
2915                 return error_mark_node;
2916               return build_chill_settextindex (TREE_VALUE (args),
2917                                                TREE_VALUE (TREE_CHAIN (args)));
2918             case BUILT_IN_SETTEXTRECORD:
2919               if (check_arglist_length (args, 2, 2, fnname) < 0)
2920                 return error_mark_node;
2921               return build_chill_settextrecord (TREE_VALUE (args),
2922                                                 TREE_VALUE (TREE_CHAIN (args)));
2923             case BUILT_IN_CH_SIN:
2924               if (check_arglist_length (args, 1, 1, fnname) < 0)
2925                 return error_mark_node;
2926               return build_chill_floatcall (TREE_VALUE (args),
2927                                             IDENTIFIER_POINTER (fnname),
2928                                             "__sin");
2929             case BUILT_IN_SIZE:
2930               if (check_arglist_length (args, 1, 1, fnname) < 0)
2931                 return error_mark_node;
2932               return build_chill_sizeof (TREE_VALUE (args));
2933             case BUILT_IN_SQRT:
2934               if (check_arglist_length (args, 1, 1, fnname) < 0)
2935                 return error_mark_node;
2936               return build_chill_floatcall (TREE_VALUE (args),
2937                                             IDENTIFIER_POINTER (fnname),
2938                                             "__sqrt");
2939             case BUILT_IN_SUCC:
2940               if (check_arglist_length (args, 1, 1, fnname) < 0)
2941                 return error_mark_node;
2942               return build_chill_pred_or_succ (TREE_VALUE (args), PLUS_EXPR);
2943             case BUILT_IN_TAN:
2944               if (check_arglist_length (args, 1, 1, fnname) < 0)
2945                 return error_mark_node;
2946               return build_chill_floatcall (TREE_VALUE (args),
2947                                             IDENTIFIER_POINTER (fnname),
2948                                             "__tan");
2949             case BUILT_IN_TERMINATE:
2950               if (check_arglist_length (args, 1, 1, fnname) < 0)
2951                 return error_mark_node;
2952               return build_chill_terminate (TREE_VALUE (args));
2953             case BUILT_IN_UPPER:
2954               if (check_arglist_length (args, 1, 1, fnname) < 0)
2955                 return error_mark_node;
2956               return build_chill_upper (TREE_VALUE (args));
2957             case BUILT_IN_VARIABLE:
2958               if (check_arglist_length (args, 1, 1, fnname) < 0)
2959                 return error_mark_node;
2960               return build_chill_variable (TREE_VALUE (args));
2961             case BUILT_IN_WRITEABLE:
2962               if (check_arglist_length (args, 1, 1, fnname) < 0)
2963                 return error_mark_node;
2964               return build_chill_writeable (TREE_VALUE (args));
2965             case BUILT_IN_WRITERECORD:
2966               if (check_arglist_length (args, 2, 3, fnname) < 0)
2967                 return error_mark_node;
2968               return build_chill_writerecord (TREE_VALUE (args), TREE_CHAIN (args));
2969             case BUILT_IN_WRITETEXT:
2970               if (check_arglist_length (args, 2, -1, fnname) < 0)
2971                 return error_mark_node;
2972               return build_chill_writetext (TREE_VALUE (args),
2973                                             TREE_CHAIN (args));
2974
2975             case BUILT_IN_EXPIRED:
2976             case BUILT_IN_WAIT:
2977               sorry ("unimplemented built-in function `%s'",
2978                      IDENTIFIER_POINTER (fnname));
2979               break;
2980             default:
2981               error ("internal error - bad built-in function `%s'",
2982                      IDENTIFIER_POINTER (fnname));
2983             }
2984         }
2985       return build_chill_function_call (func, args);
2986     }
2987
2988   if (chill_varying_type_p (TREE_TYPE (func)))
2989     type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)));
2990
2991   if (CH_STRING_TYPE_P (type))
2992     {
2993       if (args == NULL_TREE)
2994         {
2995           error ("empty expression in string index");
2996           return error_mark_node;
2997         }
2998       if (TREE_CHAIN (args) != NULL)
2999         {
3000           error ("only one expression allowed in string index");
3001           return error_mark_node;
3002         }
3003       if (flag_old_strings)
3004         return build_chill_slice_with_length (func,
3005                                               TREE_VALUE (args),
3006                                               integer_one_node);
3007       else if (CH_BOOLS_TYPE_P (type))
3008         return build_chill_bitref (func, args);
3009       else
3010         return build_chill_array_ref (func, args);
3011     }
3012
3013   else if (TREE_CODE (type) == ARRAY_TYPE)
3014     return build_chill_array_ref (func, args);
3015
3016   if (TREE_CODE (func) != ERROR_MARK)
3017     error ("invalid: primval ( untyped_exprlist )");
3018   return error_mark_node;
3019 }
3020 \f
3021 /* Given a set stored as one bit per char (in BUFFER[0 .. BIT_SIZE-1]),
3022    return a CONTRUCTOR, of type TYPE (a SET_TYPE). */
3023 static tree
3024 expand_packed_set (buffer, bit_size, type)
3025      const char *buffer;
3026      int   bit_size;
3027      tree type;
3028 {
3029   /* The ordinal number corresponding to the first stored bit. */
3030   HOST_WIDE_INT first_bit_no =
3031     TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (type)));
3032   tree list = NULL_TREE;
3033   int i;
3034
3035   for (i = 0; i < bit_size; i++)
3036     if (buffer[i])
3037       {
3038         int next_0;
3039         for (next_0 = i + 1; 
3040              next_0 < bit_size && buffer[next_0]; next_0++)
3041           ;
3042         if (next_0 == i + 1)
3043           list = tree_cons (NULL_TREE, 
3044                    build_int_2 (i + first_bit_no, 0), list);
3045         else
3046           {
3047             list = tree_cons (build_int_2 (i + first_bit_no, 0),
3048                               build_int_2 (next_0 - 1 + first_bit_no, 0), list);
3049             /* advance i past the range of 1-bits */
3050             i = next_0;
3051           }
3052       }
3053   list = build (CONSTRUCTOR, type, NULL_TREE, nreverse (list));
3054   TREE_CONSTANT (list) = 1;
3055   return list;
3056 }
3057 \f
3058 /*
3059  * fold a set represented as a CONSTRUCTOR list.
3060  * An empty set has a NULL_TREE in its TREE_OPERAND (set, 1) slot.
3061  */
3062 static tree
3063 fold_set_expr (code, op0, op1)
3064      enum chill_tree_code code;
3065      tree op0, op1;
3066 {
3067   tree temp;
3068   char *buffer0, *buffer1 = NULL, *bufferr;
3069   int i, size0, size1, first_unused_bit;
3070
3071   if (! TREE_CONSTANT (op0) || TREE_CODE (op0) != CONSTRUCTOR)
3072       return NULL_TREE;
3073
3074   if (op1 
3075       && (! TREE_CONSTANT (op1) || TREE_CODE (op1) != CONSTRUCTOR))
3076     return NULL_TREE;
3077
3078   size0 = int_size_in_bytes (TREE_TYPE (op0)) * BITS_PER_UNIT;
3079   if (size0 < 0)
3080     {
3081       error ("operand is variable-size bitstring/power-set");
3082       return error_mark_node;
3083     }
3084   buffer0 = (char*) alloca (size0);
3085
3086   temp = get_set_constructor_bits (op0, buffer0, size0);
3087   if (temp)
3088     return NULL_TREE;
3089   
3090   if (op0 && op1)
3091     {
3092       size1 = int_size_in_bytes (TREE_TYPE (op1)) * BITS_PER_UNIT;
3093       if (size1 < 0)
3094         {
3095           error ("operand is variable-size bitstring/power-set");
3096           return error_mark_node;
3097         }
3098       if (size0 != size1)
3099         return NULL_TREE;
3100       buffer1 = (char*) alloca (size1);
3101       temp = get_set_constructor_bits (op1, buffer1, size1);
3102       if (temp)
3103         return NULL_TREE;
3104     }
3105
3106   bufferr = (char*) alloca (size0); /* result buffer */
3107
3108   switch ((int)code)
3109     {
3110     case SET_NOT_EXPR:
3111     case BIT_NOT_EXPR:
3112       for (i = 0; i < size0; i++) 
3113         bufferr[i] = 1 & ~buffer0[i];
3114       goto build_result;
3115     case SET_AND_EXPR:
3116     case BIT_AND_EXPR:
3117       for (i = 0; i < size0; i++)
3118         bufferr[i] = buffer0[i] & buffer1[i];
3119       goto build_result;
3120     case SET_IOR_EXPR:
3121     case BIT_IOR_EXPR:
3122       for (i = 0; i < size0; i++)
3123         bufferr[i] = buffer0[i] | buffer1[i];
3124       goto build_result;
3125     case SET_XOR_EXPR:
3126     case BIT_XOR_EXPR:
3127       for (i = 0; i < size0; i++) 
3128         bufferr[i] = (buffer0[i] ^ buffer1[i]) & 1;      
3129       goto build_result;
3130     case SET_DIFF_EXPR:
3131     case MINUS_EXPR:
3132       for (i = 0; i < size0; i++)
3133         bufferr[i] = buffer0[i] & ~buffer1[i];
3134       goto build_result;
3135     build_result:
3136       /* mask out unused bits. Same as runtime library does. */
3137       first_unused_bit = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (op0))))
3138         - TREE_INT_CST_LOW (TYPE_MIN_VALUE (TYPE_DOMAIN (TREE_TYPE (op0)))) + 1;
3139       for (i = first_unused_bit; i < size0 ; i++)
3140         bufferr[i] = 0;
3141       return expand_packed_set (bufferr, size0, TREE_TYPE (op0));
3142     case EQ_EXPR:
3143       for (i = 0; i < size0; i++)
3144         if (buffer0[i] != buffer1[i])
3145           return boolean_false_node;
3146       return boolean_true_node;
3147       
3148     case NE_EXPR:
3149       for (i = 0; i < size0; i++)
3150         if (buffer0[i] != buffer1[i])
3151           return boolean_true_node;
3152       return boolean_false_node;
3153
3154     default:
3155       return NULL_TREE;
3156     }
3157 }
3158 \f
3159 /*
3160  * build a set or bit-array expression.  Type-checking is
3161  * done elsewhere.
3162  */
3163 static tree
3164 build_compare_set_expr (code, op0, op1)
3165      enum tree_code code;
3166      tree op0, op1;
3167 {
3168   tree result_type = NULL_TREE;
3169   const char *fnname;
3170   tree x;
3171
3172   /* These conversions are needed if -fold-strings. */
3173   if (TREE_CODE (TREE_TYPE (op0)) == BOOLEAN_TYPE)
3174     {
3175       if (CH_BOOLS_ONE_P (TREE_TYPE (op1)))
3176         return build_compare_discrete_expr (code,
3177                                             op0,
3178                                             convert (boolean_type_node, op1));
3179       else
3180         op0 = convert (bitstring_one_type_node, op0);
3181     }
3182   if (TREE_CODE (TREE_TYPE (op1)) == BOOLEAN_TYPE)
3183     {
3184       if (CH_BOOLS_ONE_P (TREE_TYPE (op0)))
3185         return build_compare_discrete_expr (code,
3186                                             convert (boolean_type_node, op0),
3187                                             op1);
3188       else
3189         op1 = convert (bitstring_one_type_node, op1);
3190     }
3191
3192   switch ((int)code)
3193     {
3194     case EQ_EXPR:
3195       {
3196         tree temp = fold_set_expr (EQ_EXPR, op0, op1);
3197         if (temp) 
3198           return temp;
3199         fnname = "__eqpowerset";
3200         goto compare_powerset;
3201       }
3202       break;
3203
3204     case GE_EXPR:
3205       /* switch operands and fall thru */
3206       x = op0;
3207       op0 = op1;
3208       op1 = x;
3209
3210     case LE_EXPR:
3211       fnname = "__lepowerset";
3212       goto compare_powerset;
3213
3214     case GT_EXPR:
3215       /* switch operands and fall thru */
3216       x = op0;
3217       op0 = op1;
3218       op1 = x;
3219
3220     case LT_EXPR:
3221       fnname = "__ltpowerset";
3222       goto compare_powerset;
3223
3224     case NE_EXPR:
3225       return invert_truthvalue (build_compare_set_expr (EQ_EXPR, op0, op1));
3226
3227     compare_powerset:
3228       {
3229         tree tsize = powersetlen (op0);
3230         
3231         if (TREE_CODE (TREE_TYPE (op0)) != SET_TYPE)
3232           tsize = fold (build (MULT_EXPR, sizetype, tsize,
3233                                size_int (BITS_PER_UNIT)));
3234
3235         return build_chill_function_call (lookup_name (get_identifier (fnname)),
3236                tree_cons (NULL_TREE, force_addr_of (op0),
3237                  tree_cons (NULL_TREE, force_addr_of (op1),
3238                    tree_cons (NULL_TREE, tsize, NULL_TREE))));
3239       }
3240       break;
3241
3242     default:
3243       if ((int) code >= (int)LAST_AND_UNUSED_TREE_CODE)
3244         {
3245           error ("tree code `%s' unhandled in build_compare_set_expr",
3246                  tree_code_name[(int)code]);
3247           return error_mark_node;
3248         }
3249       break;
3250     }
3251
3252   return build ((enum tree_code)code, result_type, 
3253                 op0, op1);
3254 }
3255 \f
3256 /* Convert a varying string (or array) to dynamic non-varying string:
3257    EXP becomes EXP.var_data(0 UP EXP.var_length). */
3258
3259 tree
3260 varying_to_slice (exp)
3261      tree exp;
3262 {
3263   if (!chill_varying_type_p (TREE_TYPE (exp)))
3264     return exp;
3265   else
3266     { tree size, data, data_domain, min;
3267       tree novelty = CH_NOVELTY (TREE_TYPE (exp));
3268       exp = save_if_needed (exp);
3269       size = build_component_ref (exp, var_length_id);
3270       data = build_component_ref (exp, var_data_id);
3271       TREE_TYPE (data) = copy_novelty (novelty, TREE_TYPE (data));
3272       data_domain = TYPE_DOMAIN (TREE_TYPE (data));
3273       if (data_domain != NULL_TREE
3274           && TYPE_MIN_VALUE (data_domain) != NULL_TREE)
3275         min = TYPE_MIN_VALUE (data_domain);
3276       else
3277         min = integer_zero_node;
3278       return build_chill_slice (data, min, size);
3279     }
3280 }
3281
3282 /* Convert a scalar argument to a string or array type.  This is a subroutine
3283    of `build_concat_expr'.  */
3284
3285 static tree
3286 scalar_to_string (exp)
3287      tree exp;
3288 {
3289   tree type = TREE_TYPE (exp);
3290
3291   if (SCALAR_P (type))
3292     {
3293       int was_const = TREE_CONSTANT (exp);
3294       if (TREE_TYPE (exp) == char_type_node)
3295         exp = convert (string_one_type_node, exp);
3296       else if (TREE_TYPE (exp) == boolean_type_node)
3297         exp = convert (bitstring_one_type_node, exp);
3298       else
3299         exp = convert (build_array_type_for_scalar (type), exp);
3300       TREE_CONSTANT (exp) = was_const;
3301       return exp;
3302     }
3303   return varying_to_slice (exp);
3304 }
3305
3306 /* FIXME:  Generalize this to general arrays (not just strings),
3307    at least for the compiler-generated case of padding fixed-length arrays. */
3308
3309 static tree
3310 build_concat_expr (op0, op1)
3311      tree op0, op1;
3312 {
3313   tree orig_op0 = op0, orig_op1 = op1;
3314   tree type0, type1, size0, size1, res;
3315
3316   op0 = scalar_to_string (op0);
3317   type0 = TREE_TYPE (op0);
3318   op1 = scalar_to_string (op1);
3319   type1 = TREE_TYPE (op1);
3320   size1 = size_in_bytes (type1);
3321
3322   /* try to fold constant string literals */
3323   if (TREE_CODE (op0) == STRING_CST
3324       && (TREE_CODE (op1) == STRING_CST 
3325           || TREE_CODE (op1) == UNDEFINED_EXPR)
3326       && TREE_CODE (size1) == INTEGER_CST)
3327     {
3328       int len0 = TREE_STRING_LENGTH (op0);
3329       int len1 = TREE_INT_CST_LOW (size1);
3330       char *result = xmalloc (len0 + len1 + 1);
3331       memcpy (result, TREE_STRING_POINTER (op0), len0);
3332       if (TREE_CODE (op1) == UNDEFINED_EXPR)
3333         memset (&result[len0], '\0', len1);
3334       else
3335         memcpy (&result[len0], TREE_STRING_POINTER (op1), len1);
3336       return build_chill_string (len0 + len1, result);
3337     }
3338   else if (TREE_CODE (type0) == TREE_CODE (type1))
3339     {
3340       tree result_size;
3341       struct ch_class result_class;
3342       struct ch_class class0;
3343       struct ch_class class1;
3344
3345       class0 = chill_expr_class (orig_op0);
3346       class1 = chill_expr_class (orig_op1);
3347
3348       if (TREE_CODE (type0) == SET_TYPE)
3349         {
3350           result_size = fold (build (PLUS_EXPR, integer_type_node,
3351                                      discrete_count (TYPE_DOMAIN (type0)),
3352                                      discrete_count (TYPE_DOMAIN (type1))));
3353           result_class.mode = build_bitstring_type (result_size);
3354         }
3355       else
3356         {
3357           tree max0 = TYPE_MAX_VALUE (type0);
3358           tree max1 = TYPE_MAX_VALUE (type1);
3359
3360           /* new array's dynamic size (in bytes). */
3361           size0     = size_in_bytes (type0);
3362           /* size1 was computed above.  */
3363
3364           result_size = size_binop (PLUS_EXPR, size0, size1);
3365           /* new array's type. */
3366           result_class.mode = build_string_type (char_type_node, result_size);
3367
3368           if (max0 || max1)
3369             {
3370               max0 = max0 == 0 ? size0 : convert (sizetype, max0);
3371               max1 = max1 == 0 ? size1 : convert (sizetype, max1);
3372               TYPE_MAX_VALUE (result_class.mode)
3373                 = size_binop (PLUS_EXPR, max0, max1);
3374             }
3375         }
3376
3377       if (class0.kind == CH_VALUE_CLASS || class1.kind == CH_VALUE_CLASS)
3378         {
3379           tree novelty0 = CH_NOVELTY (TREE_TYPE (orig_op0));
3380           result_class.kind = CH_VALUE_CLASS;
3381           if (class0.kind == CH_VALUE_CLASS && novelty0 != NULL_TREE)
3382             SET_CH_NOVELTY_NONNIL (result_class.mode, novelty0);
3383           else if (class1.kind == CH_VALUE_CLASS)
3384             SET_CH_NOVELTY (result_class.mode,
3385                             CH_NOVELTY (TREE_TYPE (orig_op1)));
3386         }
3387       else
3388         result_class.kind = CH_DERIVED_CLASS;
3389
3390       if (TREE_CODE (result_class.mode) == SET_TYPE
3391           && TREE_CONSTANT (op0) && TREE_CONSTANT (op1)
3392           && TREE_CODE (op0) == CONSTRUCTOR && TREE_CODE (op1) == CONSTRUCTOR)
3393         {
3394           HOST_WIDE_INT size0, size1;  char *buffer;
3395           size0 = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type0))) + 1;
3396           size1 = TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type1))) + 1;
3397           buffer = (char*) alloca (size0 + size1);
3398           if (size0 < 0 || size1 < 0
3399               || get_set_constructor_bits (op0, buffer, size0)
3400               || get_set_constructor_bits (op1, buffer + size0, size1))
3401             abort ();
3402           res = expand_packed_set (buffer, size0 + size1, result_class.mode);
3403         }
3404       else
3405         res = build (CONCAT_EXPR, result_class.mode, op0, op1);
3406       return convert_to_class (result_class, res);
3407     }
3408   else