Implement support for Chill POWERSETs.

* ch-exp.y (operand_2):  Implement 'Element IN PowerSet'.
	* ch-typeprint.c (chill_type_print_base):  Handle POWERSETs.
	* ch-valprint.c (chill_val_print):  Handle TYPE_CODE_SET.
	* eval.c (evaluate_subexp):  Implement BINOP_IN.
	* expression.h (enum exp_opcode):  Added BINOP_IN.
	* gdbtypes.c (create_set_type), gdbtypes.h:  New function.
	* stabsread.c (read_type):  If 'S', create a set type.
	* valarith.c (value_bit_index, value_in), value.h:  New functions,
	for indexing in SETs.

gdb/ChangeLog

@@ -1,3 +1,16 @@
+Mon Dec 13 20:17:39 1993  Per Bothner  (bothner@kalessin.cygnus.com)
+
+	Implement support for Chill POWERSETs.
+	* ch-exp.y (operand_2):  Implement 'Element IN PowerSet'.
+	* ch-typeprint.c (chill_type_print_base):  Handle POWERSETs.
+	* ch-valprint.c (chill_val_print):  Handle TYPE_CODE_SET.
+	* eval.c (evaluate_subexp):  Implement BINOP_IN.
+	* expression.h (enum exp_opcode):  Added BINOP_IN.
+	* gdbtypes.c (create_set_type), gdbtypes.h:  New function.
+	* stabsread.c (read_type):  If 'S', create a set type.
+	* valarith.c (value_bit_index, value_in), value.h:  New functions,
+	for indexing in SETs.
+
 Mon Dec 13 06:42:37 1993  Jeffrey A. Law  (law@snake.cs.utah.edu)
 
 	* paread.c (pa_symfile_init): Check for the existance of stabs

gdb/ch-exp.y

@@ -774,7 +774,7 @@ operand_2	:	operand_3
 			}
 		|	operand_2 IN operand_3
 			{
-			  $$ = 0;	/* FIXME */
+			  write_exp_elt_opcode (BINOP_IN);
 			}
 		;
 

gdb/ch-typeprint.c

@@ -131,6 +131,11 @@ chill_type_print_base (type, stream, show, level)
 	chill_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
 	break;
 
+      case TYPE_CODE_SET:
+        fputs_filtered ("POWERSET ", stream);
+	chill_print_type (TYPE_FIELD_TYPE (type, 0), "", stream, show, level);
+	break;
+
       case TYPE_CODE_STRING:
 	range_type = TYPE_FIELD_TYPE (type, 0);
 	index_type = TYPE_TARGET_TYPE (range_type);

gdb/ch-valprint.c

@@ -196,6 +196,51 @@ chill_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
       return (i + (print_max && i != print_max));
       break;
 
+    case TYPE_CODE_SET:
+      {
+	struct type *range = TYPE_FIELD_TYPE (type, 0);
+	int low_bound = TYPE_FIELD_BITPOS (range, 0);
+	int high_bound = TYPE_FIELD_BITPOS (range, 1);
+	int i;
+	int is_bitstring = 0;
+	int need_comma = 0;
+	int in_range = 0;
+
+	if (is_bitstring)
+	  fputs_filtered ("B'", stream);
+	else
+	  fputs_filtered ("[", stream);
+	for (i = low_bound; i <= high_bound; i++)
+	  {
+	    int element = value_bit_index (type, valaddr, i);
+	    if (is_bitstring)
+	      fprintf_filtered (stream, "%d", element);
+	    else if (element)
+	      {
+		if (need_comma)
+		  fputs_filtered (", ", stream);
+		print_type_scalar (TYPE_TARGET_TYPE (range), i, stream);
+		need_comma = 1;
+
+		/* Look for a continuous range of true elements. */
+		if (i+1 <= high_bound && value_bit_index (type, valaddr, ++i))
+		  {
+		    int j = i; /* j is the upper bound so far of the range */
+		    fputs_filtered (":", stream);
+		    while (i+1 <= high_bound
+			   && value_bit_index (type, valaddr, ++i))
+		      j = i;
+		    print_type_scalar (TYPE_TARGET_TYPE (range), j, stream);
+		  }
+	      }
+	  }
+	if (is_bitstring)
+	  fputs_filtered ("'", stream);
+	else
+	  fputs_filtered ("]", stream);
+      }
+      break;
+
     case TYPE_CODE_STRUCT:
       chill_print_value_fields (type, valaddr, stream, format, recurse, pretty,
 				0);
@@ -335,4 +380,3 @@ chill_print_value_fields (type, valaddr, stream, format, recurse, pretty,
     }
   fprintf_filtered (stream, "]");
 }
-

gdb/gdbtypes.c

@@ -417,6 +417,40 @@ create_string_type (result_type, range_type)
   return (result_type);
 }
 
+struct type *
+create_set_type (result_type, domain_type)
+     struct type *result_type;
+     struct type *domain_type;
+{
+  if (result_type == NULL)
+    {
+      result_type = alloc_type (TYPE_OBJFILE (domain_type));
+    }
+  TYPE_CODE (result_type) = TYPE_CODE_SET;
+  TYPE_NFIELDS (result_type) = 1;
+  TYPE_FIELDS (result_type) = (struct field *)
+    TYPE_ALLOC (result_type, 1 * sizeof (struct field));
+  memset (TYPE_FIELDS (result_type), 0, sizeof (struct field));
+  TYPE_FIELD_TYPE (result_type, 0) = domain_type;
+  if (TYPE_CODE (domain_type) != TYPE_CODE_RANGE)
+    TYPE_LENGTH (result_type) = 4;  /* Error? */
+  else
+    {
+      int low_bound = TYPE_FIELD_BITPOS (domain_type, 0);
+      int high_bound = TYPE_FIELD_BITPOS (domain_type, 1);
+      int bit_length = high_bound - low_bound + 1;
+      if (bit_length <= TARGET_CHAR_BIT)
+	TYPE_LENGTH (result_type) = 1;
+      else if (bit_length <= TARGET_SHORT_BIT)
+	TYPE_LENGTH (result_type) = TARGET_SHORT_BIT / TARGET_CHAR_BIT;
+      else
+	TYPE_LENGTH (result_type)
+	  = ((bit_length + TARGET_INT_BIT - 1) / TARGET_INT_BIT)
+	    * TARGET_CHAR_BIT;
+    }
+  return (result_type);
+}
+
 /* Smash TYPE to be a type of members of DOMAIN with type TO_TYPE. 
    A MEMBER is a wierd thing -- it amounts to a typed offset into
    a struct, e.g. "an int at offset 8".  A MEMBER TYPE doesn't

gdb/gdbtypes.h

@@ -672,6 +672,9 @@ create_array_type PARAMS ((struct type *, struct type *, struct type *));
 extern struct type *
 create_string_type PARAMS ((struct type *, struct type *));
 
+extern struct type *
+create_set_type PARAMS ((struct type *, struct type *));
+
 extern struct type *
 lookup_unsigned_typename PARAMS ((char *));
 

gdb/stabsread.c

@@ -1568,6 +1568,13 @@ read_type (pp, objfile)
       type = read_array_type (pp, type, objfile);
       break;
 
+    case 'S':
+      type1 = read_type (pp, objfile);
+      type = create_set_type ((struct type*) NULL, type1);
+      if (typenums[0] != -1)
+	*dbx_lookup_type (typenums) = type;
+      break;
+
     default:
       --*pp;			/* Go back to the symbol in error */
 				/* Particularly important if it was \0! */