From e909f287a8340e2fe7a99f6fc1649801ec807768 Mon Sep 17 00:00:00 2001 From: Per Bothner Date: Tue, 14 Dec 1993 04:32:51 +0000 Subject: [PATCH] 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 | 13 +++++++++++++ gdb/ch-exp.y | 2 +- gdb/ch-typeprint.c | 5 +++++ gdb/ch-valprint.c | 46 +++++++++++++++++++++++++++++++++++++++++++++- gdb/gdbtypes.c | 34 ++++++++++++++++++++++++++++++++++ gdb/gdbtypes.h | 3 +++ gdb/stabsread.c | 7 +++++++ 7 files changed, 108 insertions(+), 2 deletions(-) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index b97d85af0f0..0e6d839971f 100644 --- a/gdb/ChangeLog +++ b/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 diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y index 3900f7730f8..b6be4a28385 100644 --- 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 da64b45372f..3073486b88c 100644 --- 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 4be369bd9ac..1f0987c9349 100644 --- 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 4755c82620d..528e907cbbd 100644 --- 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 26ed45c2625..2c5685f789c 100644 --- 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 3203cbf3329..a0c9672ed73 100644 --- 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! */ -- 2.30.2