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.

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index b97d85af0f00a149d20ef3b3a3ed21046c659370..0e6d839971f7745eae2e44e7067125d382458309 100644 (file)
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,16 @@
+Mon Dec 13 20:17:39 1993  Per Bothner  ([email protected])
+
+       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  ([email protected])
 
        * paread.c (pa_symfile_init): Check for the existance of stabs

diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y
index 3900f7730f81036e64d6a4e034cff43ce7ce9dc0..b6be4a283856251cf3a0d091279caaf5d6eb9ee3 100644 (file)
--- a/gdb/ch-exp.y
+++ b/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);
                        }
                ;
 

diff --git a/gdb/ch-typeprint.c b/gdb/ch-typeprint.c
index da64b45372ffa7072ef39be148cc53667556ab85..3073486b88ce5497453485e74f277958ac66b606 100644 (file)
--- a/gdb/ch-typeprint.c
+++ b/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);

diff --git a/gdb/ch-valprint.c b/gdb/ch-valprint.c
index 4be369bd9ac4345651e49d9c516016e44883cb4e..1f0987c93492d44092fb26090554af611bd600ab 100644 (file)
--- a/gdb/ch-valprint.c
+++ b/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, "]");
 }
-

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 4755c82620de4d88862332dfb372d5fb34dfbf49..528e907cbbd92c052d1ea9d050dbf74093ee8f4c 100644 (file)
--- a/gdb/gdbtypes.c
+++ b/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

diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 26ed45c26257d95d1e7b04a892fe0720c099c2aa..2c5685f789cc8d74734d08040fe962cce2a92025 100644 (file)
--- a/gdb/gdbtypes.h
+++ b/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 *));
 

diff --git a/gdb/stabsread.c b/gdb/stabsread.c
index 3203cbf33290c580b4c1f7c6261963afc61ed5ae..a0c9672ed7305efd150d4936788c1e8cd34def1f 100644 (file)
--- a/gdb/stabsread.c
+++ b/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! */