diff options
| -rw-r--r-- | gdb/ChangeLog | 20 | ||||
| -rw-r--r-- | gdb/ch-exp.c | 113 | ||||
| -rw-r--r-- | gdb/ch-lang.c | 124 | ||||
| -rw-r--r-- | gdb/valarith.c | 4 |
4 files changed, 225 insertions, 36 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 55c1e64..2654d1d 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,23 @@ +Tue Mar 5 23:48:36 1996 Wilfried Moser (Alcatel) <moser@rtl.cygnus.com> + + * ch-exp.c (parse_primval): Handle CARD, MAX, MIN. + (match_string_literal): Handle control sequence. + (match_character_literal): Deto. + + * ch-lang.c (chill_printchar): Change formating of nonprintable + characters from C'xx' to ^(num). + (chill_printstr): Deto. + (value_chill_card, value_chill_max_min): New functions to process + Chill's CARD, MAX, MIN. + (evaluate_subexp_chill): Process UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN. + + * expression.h (exp_opcode): Add UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN + for Chill's CARD, MAX, MIN. + + * valarith.c (value_in): Add processing of TYPE_CODE_RANGE + and change return type from builtin_type_int to + builtin_type_chill_bool. + Tue Mar 5 18:54:04 1996 Stan Shebs <shebs@andros.cygnus.com> * config/nm-nbsd.h (link_object, lo_name, etc): Move to here diff --git a/gdb/ch-exp.c b/gdb/ch-exp.c index 4767d94..af43fc2 100644 --- a/gdb/ch-exp.c +++ b/gdb/ch-exp.c @@ -683,12 +683,21 @@ parse_primval () write_exp_elt_type (builtin_type_int); write_exp_elt_opcode (UNOP_CAST); break; + case CARD: + parse_unary_call (); + write_exp_elt_opcode (UNOP_CARD); + break; + case MAX_TOKEN: + parse_unary_call (); + write_exp_elt_opcode (UNOP_CHMAX); + break; + case MIN_TOKEN: + parse_unary_call (); + write_exp_elt_opcode (UNOP_CHMIN); + break; case PRED: op_name = "PRED"; goto unimplemented_unary_builtin; case SUCC: op_name = "SUCC"; goto unimplemented_unary_builtin; case ABS: op_name = "ABS"; goto unimplemented_unary_builtin; - case CARD: op_name = "CARD"; goto unimplemented_unary_builtin; - case MAX_TOKEN: op_name = "MAX"; goto unimplemented_unary_builtin; - case MIN_TOKEN: op_name = "MIN"; goto unimplemented_unary_builtin; unimplemented_unary_builtin: parse_unary_call (); error ("not implemented: %s builtin function", op_name); @@ -1404,23 +1413,67 @@ static enum ch_terminal match_string_literal () { char *tokptr = lexptr; + int in_ctrlseq = 0; + LONGEST ival; for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++) { CHECKBUF (1); - if (*tokptr == *lexptr) + tryagain: ; + if (in_ctrlseq) { - if (*(tokptr + 1) == *lexptr) + /* skip possible whitespaces */ + while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr) + tokptr++; + if (*tokptr == ')') { + in_ctrlseq = 0; tokptr++; + goto tryagain; + } + else if (*tokptr != ',') + error ("Invalid control sequence"); + tokptr++; + /* skip possible whitespaces */ + while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr) + tokptr++; + if (!decode_integer_literal (&ival, &tokptr)) + error ("Invalid control sequence"); + tokptr--; + } + else if (*tokptr == *lexptr) + { + if (*(tokptr + 1) == *lexptr) + { + ival = *tokptr++; } else { break; } } - tempbuf[tempbufindex++] = *tokptr; + else if (*tokptr == '^') + { + if (*(tokptr + 1) == '(') + { + in_ctrlseq = 1; + tokptr += 2; + if (!decode_integer_literal (&ival, &tokptr)) + error ("Invalid control sequence"); + tokptr--; + } + else if (*(tokptr + 1) == '^') + ival = *tokptr++; + else + error ("Invalid control sequence"); + } + else + ival = *tokptr; + tempbuf[tempbufindex++] = ival; } + if (in_ctrlseq) + error ("Invalid control sequence"); + if (*tokptr == '\0' /* no terminator */ || (tempbufindex == 1 && *tokptr == '\'')) /* char literal */ { @@ -1449,12 +1502,6 @@ match_string_literal () Note that more than a single character, enclosed in single quotes, is a string literal. - Also note that the control sequence form is not in GNU Chill since it - is ambiguous with the string literal form using single quotes. I.E. - is '^(7)' a character literal or a string literal. In theory it it - possible to tell by context, but GNU Chill doesn't accept the control - sequence form, so neither do we (for now the code is disabled). - Returns CHARACTER_LITERAL if a match is found. */ @@ -1483,28 +1530,39 @@ match_character_literal () /* Determine which form we have, either a control sequence or the single character form. */ - if ((*tokptr == '^') && (*(tokptr + 1) == '(')) + if (*tokptr == '^') { -#if 0 /* Disable, see note above. -fnf */ - /* Match and decode a control sequence. Return zero if we don't - find a valid integer literal, or if the next unconsumed character - after the integer literal is not the trailing ')'. - FIXME: We currently don't handle the multiple integer literal - form. */ - tokptr += 2; - if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')')) + if (*(tokptr + 1) == '(') { - return (0); + /* Match and decode a control sequence. Return zero if we don't + find a valid integer literal, or if the next unconsumed character + after the integer literal is not the trailing ')'. */ + tokptr += 2; + if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')')) + { + return (0); + } } -#else - return (0); -#endif + else if (*(tokptr + 1) == '^') + { + ival = *tokptr; + tokptr += 2; + } + else + /* fail */ + error ("Invalid control sequence"); + } + else if (*tokptr == '\'') + { + /* this must be duplicated */ + ival = *tokptr; + tokptr += 2; } else { ival = *tokptr++; } - + /* The trailing quote has not yet been consumed. If we don't find it, then we have no match. */ @@ -1618,7 +1676,8 @@ match_bitstring_literal () digit += 10; break; default: - error ("Invalid character in bitstring or integer."); + /* this is not a bitstring literal, probably an integer */ + return 0; } if (digit >= 1 << bits_per_char) { diff --git a/gdb/ch-lang.c b/gdb/ch-lang.c index 5c041d7..12d2f98 100644 --- a/gdb/ch-lang.c +++ b/gdb/ch-lang.c @@ -68,11 +68,14 @@ chill_printchar (c, stream) if (PRINT_LITERAL_FORM (c)) { - fprintf_filtered (stream, "'%c'", c); + if (c == '\'' || c == '^') + fprintf_filtered (stream, "'%c%c'", c, c); + else + fprintf_filtered (stream, "'%c'", c); } else { - fprintf_filtered (stream, "C'%.2x'", (unsigned int) c); + fprintf_filtered (stream, "'^(%u)'", (unsigned int) c); } } @@ -138,6 +141,8 @@ chill_printstr (stream, string, length, force_ellipses) { if (in_control_form || in_literal_form) { + if (in_control_form) + fputs_filtered (")", stream); fputs_filtered ("\"//", stream); in_control_form = in_literal_form = 0; } @@ -149,19 +154,23 @@ chill_printstr (stream, string, length, force_ellipses) } else { + if (! in_literal_form && ! in_control_form) + fputs_filtered ("\"", stream); if (PRINT_LITERAL_FORM (c)) { if (!in_literal_form) { if (in_control_form) { - fputs_filtered ("\"//", stream); + fputs_filtered (")", stream); in_control_form = 0; } - fputs_filtered ("\"", stream); in_literal_form = 1; } fprintf_filtered (stream, "%c", c); + if (c == '"' || c == '^') + /* duplicate this one as must be done at input */ + fprintf_filtered (stream, "%c", c); } else { @@ -169,19 +178,25 @@ chill_printstr (stream, string, length, force_ellipses) { if (in_literal_form) { - fputs_filtered ("\"//", stream); in_literal_form = 0; } - fputs_filtered ("c\"", stream); + fputs_filtered ("^(", stream); in_control_form = 1; } - fprintf_filtered (stream, "%.2x", c); + else + fprintf_filtered (stream, ","); + c = c & 0xff; + fprintf_filtered (stream, "%u", (unsigned int) c); } ++things_printed; } } /* Terminate the quotes if necessary. */ + if (in_control_form) + { + fputs_filtered (")", stream); + } if (in_literal_form || in_control_form) { fputs_filtered ("\"", stream); @@ -265,7 +280,9 @@ static const struct op_print chill_op_print_tab[] = { {"SIZE",UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0}, {"LOWER",UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0}, {"UPPER",UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0}, - {"LOWER",UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0}, + {"CARD",UNOP_CARD, PREC_BUILTIN_FUNCTION, 0}, + {"MAX",UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0}, + {"MIN",UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0}, {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, {"=", BINOP_EQUAL, PREC_EQUAL, 0}, {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0}, @@ -391,6 +408,86 @@ value_chill_length (val) } static value_ptr +value_chill_card (val) + value_ptr val; +{ + LONGEST tmp = 0; + struct type *type = VALUE_TYPE (val); + CHECK_TYPEDEF (type); + + if (TYPE_CODE (type) == TYPE_CODE_SET) + { + struct type *range_type = TYPE_INDEX_TYPE (type); + LONGEST lower_bound, upper_bound; + int i; + + get_discrete_bounds (range_type, &lower_bound, &upper_bound); + for (i = lower_bound; i <= upper_bound; i++) + if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0) + tmp++; + } + else + error ("bad argument to CARD builtin"); + + return value_from_longest (builtin_type_int, tmp); +} + +static value_ptr +value_chill_max_min (op, val) + enum exp_opcode op; + value_ptr val; +{ + LONGEST tmp = 0; + struct type *type = VALUE_TYPE (val); + struct type *elttype; + CHECK_TYPEDEF (type); + + if (TYPE_CODE (type) == TYPE_CODE_SET) + { + LONGEST lower_bound, upper_bound; + int i, empty = 1; + + elttype = TYPE_INDEX_TYPE (type); + CHECK_TYPEDEF (elttype); + get_discrete_bounds (elttype, &lower_bound, &upper_bound); + + if (op == UNOP_CHMAX) + { + for (i = upper_bound; i >= lower_bound; i--) + { + if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0) + { + tmp = i; + empty = 0; + break; + } + } + } + else + { + for (i = lower_bound; i <= upper_bound; i++) + { + if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0) + { + tmp = i; + empty = 0; + break; + } + } + } + if (empty) + error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN"); + } + else + error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN"); + + return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE + ? TYPE_TARGET_TYPE (elttype) + : elttype, + tmp); +} + +static value_ptr evaluate_subexp_chill (expect_type, exp, pos, noside) struct type *expect_type; register struct expression *exp; @@ -477,6 +574,17 @@ evaluate_subexp_chill (expect_type, exp, pos, noside) arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside); return value_chill_length (arg1); + case UNOP_CARD: + (*pos)++; + arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside); + return value_chill_card (arg1); + + case UNOP_CHMAX: + case UNOP_CHMIN: + (*pos)++; + arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside); + return value_chill_max_min (op, arg1); + case BINOP_COMMA: error ("',' operator used in invalid context"); diff --git a/gdb/valarith.c b/gdb/valarith.c index 3b9d9cc..0446907 100644 --- a/gdb/valarith.c +++ b/gdb/valarith.c @@ -1191,6 +1191,8 @@ value_in (element, set) int member; struct type *settype = check_typedef (VALUE_TYPE (set)); struct type *eltype = check_typedef (VALUE_TYPE (element)); + if (TYPE_CODE (eltype) == TYPE_CODE_RANGE) + eltype = TYPE_TARGET_TYPE (eltype); if (TYPE_CODE (settype) != TYPE_CODE_SET) error ("Second argument of 'IN' has wrong type"); if (TYPE_CODE (eltype) != TYPE_CODE_INT @@ -1202,7 +1204,7 @@ value_in (element, set) value_as_long (element)); if (member < 0) error ("First argument of 'IN' not in range"); - return value_from_longest (builtin_type_int, member); + return value_from_longest (builtin_type_chill_bool, member); } void |