From 6137983598c57aa8557001079b10fa3be8b77ef6 Mon Sep 17 00:00:00 2001 From: Per Bothner Date: Wed, 14 Jun 1995 19:59:35 +0000 Subject: * parser-defs.h (enum precedence): Added PREC_BUILTIN_FUNCTION. * expression.h (enum exp_opcode): Added UNOP_LOWER, UNOP_UPPER, UNUP_LENGTH. * expprint.c (dump_expression): Handle the new exp_opcodes. (print_subexp): Handle PREC_BUILTIN_FUNCTION. (print_simple_m2_func): Removed. (print_subexp): Remove support for Modula2 builtin functions. * m2-lang.c (m2_op_print_tab): Add support for builtin functions. * ch-exp.y: Parse LOWER, UPPER, and LENGTH builtins. (write_lower_upper_value): Convenience function for LOWER and UPPER. (upper_lower_argument, length_argument): Removed non-terminals. * ch-lang.c (chill_op_print_tab): Entries for UPPER, LOWER, LENGTH. (type_lower_upper): New function. Calculate LOWER/UPPER of type. (value_chill_length): New function. Calcalate LENGTH of ARRAY/STRING. (evaluate_subexp_chill): Handle UNOP_LOWER, UNOP_UPPER, UNOP_LENGTH. This fixes PR 5015 (and 5826 which is a duplicate). --- gdb/ChangeLog | 18 +++++++++ gdb/ch-exp.y | 54 ++++++++++++--------------- gdb/ch-lang.c | 110 +++++++++++++++++++++++++++++++++++++++++++++++++++++- gdb/m2-lang.c | 9 +++++ gdb/parser-defs.h | 2 +- 5 files changed, 161 insertions(+), 32 deletions(-) diff --git a/gdb/ChangeLog b/gdb/ChangeLog index aebb3bd..cc6c2c4 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,21 @@ +Tue Jun 13 21:40:11 1995 Per Bothner + + * parser-defs.h (enum precedence): Added PREC_BUILTIN_FUNCTION. + * expression.h (enum exp_opcode): Added UNOP_LOWER, UNOP_UPPER, + UNUP_LENGTH. + * expprint.c (dump_expression): Handle the new exp_opcodes. + (print_subexp): Handle PREC_BUILTIN_FUNCTION. + (print_simple_m2_func): Removed. + (print_subexp): Remove support for Modula2 builtin functions. + * m2-lang.c (m2_op_print_tab): Add support for builtin functions. + * ch-exp.y: Parse LOWER, UPPER, and LENGTH builtins. + (write_lower_upper_value): Convenience function for LOWER and UPPER. + (upper_lower_argument, length_argument): Removed non-terminals. + * ch-lang.c (chill_op_print_tab): Entries for UPPER, LOWER, LENGTH. + (type_lower_upper): New function. Calculate LOWER/UPPER of type. + (value_chill_length): New function. Calcalate LENGTH of ARRAY/STRING. + (evaluate_subexp_chill): Handle UNOP_LOWER, UNOP_UPPER, UNOP_LENGTH. + Mon Jun 12 12:48:13 1995 Stan Shebs Windows support bits from Steve Chamberlain . diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y index c1b132b..c450b5c 100644 --- a/gdb/ch-exp.y +++ b/gdb/ch-exp.y @@ -291,8 +291,6 @@ yyerror PARAMS ((char *)); %type value_receive_name %type expression_list %type mode_argument -%type upper_lower_argument -%type length_argument %type array_mode_name %type string_mode_name %type variant_structure_mode_name @@ -940,18 +938,16 @@ chill_value_built_in_routine_call : write_exp_elt_type (builtin_type_int); write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3)); write_exp_elt_opcode (OP_LONG); } - | UPPER '(' upper_lower_argument ')' - { - $$ = 0; /* FIXME */ - } - | LOWER '(' upper_lower_argument ')' - { - $$ = 0; /* FIXME */ - } - | LENGTH '(' length_argument ')' - { - $$ = 0; /* FIXME */ - } + | LOWER '(' mode_argument ')' + { write_lower_upper_value (UNOP_LOWER, $3); } + | UPPER '(' mode_argument ')' + { write_lower_upper_value (UNOP_UPPER, $3); } + | LOWER '(' expression ')' + { write_exp_elt_opcode (UNOP_LOWER); } + | UPPER '(' expression ')' + { write_exp_elt_opcode (UNOP_UPPER); } + | LENGTH '(' expression ')' + { write_exp_elt_opcode (UNOP_LENGTH); } ; mode_argument : mode_name @@ -975,22 +971,6 @@ mode_argument : mode_name mode_name : TYPENAME ; -upper_lower_argument : expression - { - $$ = 0; /* FIXME */ - } - | mode_name - { - $$ = 0; /* FIXME */ - } - ; - -length_argument : expression - { - $$ = 0; /* FIXME */ - } - ; - /* Things which still need productions... */ array_mode_name : FIXME_08 { $$ = 0; } @@ -2019,6 +1999,20 @@ yylex () } void +write_lower_upper_value (opcode, type) + enum exp_opcode opcode; /* Either UNOP_LOWER or UNOP_UPPER */ + struct type *type; +{ + extern LONGEST type_lower_upper (); + struct type *result_type; + LONGEST val = type_lower_upper (opcode, type, &result_type); + write_exp_elt_opcode (OP_LONG); + write_exp_elt_type (result_type); + write_exp_elt_longcst (val); + write_exp_elt_opcode (OP_LONG); +} + +void yyerror (msg) char *msg; { diff --git a/gdb/ch-lang.c b/gdb/ch-lang.c index 2b65fb4..e90e4a7 100644 --- a/gdb/ch-lang.c +++ b/gdb/ch-lang.c @@ -253,6 +253,10 @@ static const struct op_print chill_op_print_tab[] = { {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, {"MOD", BINOP_MOD, PREC_MUL, 0}, {"REM", BINOP_REM, PREC_MUL, 0}, + {"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}, {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, {"=", BINOP_EQUAL, PREC_EQUAL, 0}, {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0}, @@ -289,6 +293,87 @@ struct type ** const (chill_builtin_types[]) = 0 }; +/* Calculate LOWER or UPPER of TYPE. + Returns the result as an integer. + *RESULT_TYPE is the appropriate type for the result. */ + +LONGEST +type_lower_upper (op, type, result_type) + enum exp_opcode op; /* Either UNOP_LOWER or UNOP_UPPER */ + struct type *type; + struct type **result_type; +{ + LONGEST tmp; + *result_type = builtin_type_int; + retry: + switch (TYPE_CODE (type)) + { + case TYPE_CODE_STRUCT: + if (chill_varying_type (type)) + return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type); + break; + case TYPE_CODE_ARRAY: + case TYPE_CODE_BITSTRING: + case TYPE_CODE_STRING: + type = TYPE_FIELD_TYPE (type, 0); /* Get index type */ + + /* ... fall through ... */ + case TYPE_CODE_RANGE: + if (TYPE_DUMMY_RANGE (type) > 0) + return type_lower_upper (op, TYPE_TARGET_TYPE (type), result_type); + *result_type = TYPE_TARGET_TYPE (type); + return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type); + + case TYPE_CODE_ENUM: + *result_type = type; + if (TYPE_NFIELDS (type) > 0) + return TYPE_FIELD_BITPOS (type, + op == UNOP_LOWER ? 0 + : TYPE_NFIELDS (type) - 1); + + case TYPE_CODE_BOOL: + *result_type = type; + return op == UNOP_LOWER ? 0 : 1; + case TYPE_CODE_INT: + case TYPE_CODE_CHAR: + *result_type = type; + tmp = (LONGEST) 1 << (TARGET_CHAR_BIT * TYPE_LENGTH (type)); + if (TYPE_UNSIGNED (type)) + return op == UNOP_LOWER ? 0 : tmp - (LONGEST) 1; + tmp = tmp >> 1; + return op == UNOP_LOWER ? -tmp : (tmp - 1); + } + error ("unknown mode for LOWER/UPPER builtin"); +} + +static value_ptr +value_chill_length (val) + value_ptr val; +{ + LONGEST tmp; + struct type *type = VALUE_TYPE (val); + struct type *ttype; + switch (TYPE_CODE (type)) + { + case TYPE_CODE_ARRAY: + case TYPE_CODE_BITSTRING: + case TYPE_CODE_STRING: + tmp = type_lower_upper (UNOP_UPPER, type, &ttype) + - type_lower_upper (UNOP_LOWER, type, &ttype) + 1; + break; + case TYPE_CODE_STRUCT: + if (chill_varying_type (type)) + { + tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val)); + break; + } + /* ... else fall through ... */ + default: + error ("bad argument to LENGTH builtin"); + } + return value_from_longest (builtin_type_int, tmp); +} + static value_ptr evaluate_subexp_chill (expect_type, exp, pos, noside) struct type *expect_type; @@ -297,10 +382,12 @@ evaluate_subexp_chill (expect_type, exp, pos, noside) enum noside noside; { int pc = *pos; + struct type *type; int tem, nargs; value_ptr arg1; value_ptr *argvec; - switch (exp->elts[*pos].opcode) + enum exp_opcode op = exp->elts[*pos].opcode; + switch (op) { case MULTI_SUBSCRIPT: if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS) @@ -334,11 +421,32 @@ evaluate_subexp_chill (expect_type, exp, pos, noside) arg1 = value_subscript (arg1, index); } return (arg1); + + case UNOP_LOWER: + case UNOP_UPPER: + (*pos)++; + if (noside == EVAL_SKIP) + { + (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP); + goto nosideret; + } + arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, + EVAL_AVOID_SIDE_EFFECTS); + tem = type_lower_upper (op, VALUE_TYPE (arg1), &type); + return value_from_longest (type, tem); + + case UNOP_LENGTH: + (*pos)++; + arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside); + return value_chill_length (arg1); + default: break; } return evaluate_subexp_standard (expect_type, exp, pos, noside); + nosideret: + return value_from_longest (builtin_type_long, (LONGEST) 1); } const struct language_defn chill_language_defn = { diff --git a/gdb/m2-lang.c b/gdb/m2-lang.c index 1a7fd6d..4eac7e6 100644 --- a/gdb/m2-lang.c +++ b/gdb/m2-lang.c @@ -378,6 +378,15 @@ static const struct op_print m2_op_print_tab[] = { {"<", BINOP_LESS, PREC_ORDER, 0}, {"^", UNOP_IND, PREC_PREFIX, 0}, {"@", BINOP_REPEAT, PREC_REPEAT, 0}, + {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0}, + {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0}, + {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0}, + {"FLOAT",UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0}, + {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0}, + {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0}, + {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0}, + {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0}, + {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0}, {NULL, 0, 0, 0} }; diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h index f294402..3845c1a 100644 --- a/gdb/parser-defs.h +++ b/gdb/parser-defs.h @@ -169,7 +169,7 @@ enum precedence { PREC_NULL, PREC_COMMA, PREC_ABOVE_COMMA, PREC_ASSIGN, PREC_LOGICAL_OR, PREC_LOGICAL_AND, PREC_BITWISE_IOR, PREC_BITWISE_AND, PREC_BITWISE_XOR, PREC_EQUAL, PREC_ORDER, PREC_SHIFT, PREC_ADD, PREC_MUL, PREC_REPEAT, - PREC_HYPER, PREC_PREFIX, PREC_SUFFIX }; + PREC_HYPER, PREC_PREFIX, PREC_SUFFIX, PREC_BUILTIN_FUNCTION }; /* Table mapping opcodes into strings for printing operators and precedences of the operators. */ -- cgit v1.1