diff options
Diffstat (limited to 'gdb/f-exp.y')
-rw-r--r-- | gdb/f-exp.y | 418 |
1 files changed, 291 insertions, 127 deletions
diff --git a/gdb/f-exp.y b/gdb/f-exp.y index 42d3130bf8a..90cc2c65c7b 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -90,6 +90,18 @@ static void push_kind_type (LONGEST val, struct type *type); static struct type *convert_to_kind_type (struct type *basetype, int kind); +static void wrap_unop_intrinsic (exp_opcode opcode); + +static void wrap_binop_intrinsic (exp_opcode opcode); + +static void wrap_ternop_intrinsic (exp_opcode opcode); + +template<typename T> +static void fortran_wrap2_kind (type *base_type); + +template<typename T> +static void fortran_wrap3_kind (type *base_type); + using namespace expr; %} @@ -167,11 +179,12 @@ static int parse_number (struct parser_state *, const char *, int, /* Special type cases, put in to allow the parser to distinguish different legal basetypes. */ -%token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD +%token INT_S1_KEYWORD INT_S2_KEYWORD INT_KEYWORD INT_S4_KEYWORD INT_S8_KEYWORD +%token LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD LOGICAL_KEYWORD LOGICAL_S4_KEYWORD %token LOGICAL_S8_KEYWORD -%token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD -%token COMPLEX_KEYWORD -%token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD +%token REAL_KEYWORD REAL_S4_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD +%token COMPLEX_KEYWORD COMPLEX_S4_KEYWORD COMPLEX_S8_KEYWORD +%token COMPLEX_S16_KEYWORD %token BOOL_AND BOOL_OR BOOL_NOT %token SINGLE DOUBLE PRECISION %token <lval> CHARACTER @@ -180,7 +193,7 @@ static int parse_number (struct parser_state *, const char *, int, %token <opcode> ASSIGN_MODIFY %token <opcode> UNOP_INTRINSIC BINOP_INTRINSIC -%token <opcode> UNOP_OR_BINOP_INTRINSIC +%token <opcode> UNOP_OR_BINOP_INTRINSIC UNOP_OR_BINOP_OR_TERNOP_INTRINSIC %left ',' %left ABOVE_COMMA @@ -247,54 +260,6 @@ exp : KIND '(' exp ')' %prec UNARY { pstate->wrap<fortran_kind_operation> (); } ; -exp : UNOP_OR_BINOP_INTRINSIC '(' - { pstate->start_arglist (); } - one_or_two_args ')' - { - int n = pstate->end_arglist (); - gdb_assert (n == 1 || n == 2); - if ($1 == FORTRAN_ASSOCIATED) - { - if (n == 1) - pstate->wrap<fortran_associated_1arg> (); - else - pstate->wrap2<fortran_associated_2arg> (); - } - else if ($1 == FORTRAN_ARRAY_SIZE) - { - if (n == 1) - pstate->wrap<fortran_array_size_1arg> (); - else - pstate->wrap2<fortran_array_size_2arg> (); - } - else - { - std::vector<operation_up> args - = pstate->pop_vector (n); - gdb_assert ($1 == FORTRAN_LBOUND - || $1 == FORTRAN_UBOUND); - operation_up op; - if (n == 1) - op.reset - (new fortran_bound_1arg ($1, - std::move (args[0]))); - else - op.reset - (new fortran_bound_2arg ($1, - std::move (args[0]), - std::move (args[1]))); - pstate->push (std::move (op)); - } - } - ; - -one_or_two_args - : exp - { pstate->arglist_len = 1; } - | exp ',' exp - { pstate->arglist_len = 2; } - ; - /* No more explicit array operators, we treat everything in F77 as a function call. The disambiguation as to whether we are doing a subscript operation or a function call is done @@ -313,50 +278,56 @@ exp : exp '(' exp : UNOP_INTRINSIC '(' exp ')' { - switch ($1) + wrap_unop_intrinsic ($1); + } + ; + +exp : BINOP_INTRINSIC '(' exp ',' exp ')' + { + wrap_binop_intrinsic ($1); + } + ; + +exp : UNOP_OR_BINOP_INTRINSIC '(' + { pstate->start_arglist (); } + arglist ')' + { + const int n = pstate->end_arglist (); + + switch (n) { - case UNOP_ABS: - pstate->wrap<fortran_abs_operation> (); - break; - case UNOP_FORTRAN_FLOOR: - pstate->wrap<fortran_floor_operation> (); - break; - case UNOP_FORTRAN_CEILING: - pstate->wrap<fortran_ceil_operation> (); - break; - case UNOP_FORTRAN_ALLOCATED: - pstate->wrap<fortran_allocated_operation> (); - break; - case UNOP_FORTRAN_RANK: - pstate->wrap<fortran_rank_operation> (); - break; - case UNOP_FORTRAN_SHAPE: - pstate->wrap<fortran_array_shape_operation> (); + case 1: + wrap_unop_intrinsic ($1); break; - case UNOP_FORTRAN_LOC: - pstate->wrap<fortran_loc_operation> (); + case 2: + wrap_binop_intrinsic ($1); break; default: - gdb_assert_not_reached ("unhandled intrinsic"); + gdb_assert_not_reached + ("wrong number of arguments for intrinsics"); } } - ; -exp : BINOP_INTRINSIC '(' exp ',' exp ')' +exp : UNOP_OR_BINOP_OR_TERNOP_INTRINSIC '(' + { pstate->start_arglist (); } + arglist ')' { - switch ($1) + const int n = pstate->end_arglist (); + + switch (n) { - case BINOP_MOD: - pstate->wrap2<fortran_mod_operation> (); + case 1: + wrap_unop_intrinsic ($1); break; - case BINOP_FORTRAN_MODULO: - pstate->wrap2<fortran_modulo_operation> (); + case 2: + wrap_binop_intrinsic ($1); break; - case BINOP_FORTRAN_CMPLX: - pstate->wrap2<fortran_cmplx_operation> (); + case 3: + wrap_ternop_intrinsic ($1); break; default: - gdb_assert_not_reached ("unhandled intrinsic"); + gdb_assert_not_reached + ("wrong number of arguments for intrinsics"); } } ; @@ -757,42 +728,52 @@ func_mod: '(' ')' typebase /* Implements (approximately): (type-qualifier)* type-specifier */ : TYPENAME { $$ = $1.type; } + | INT_S1_KEYWORD + { $$ = parse_f_type (pstate)->builtin_integer_s1; } + | INT_S2_KEYWORD + { $$ = parse_f_type (pstate)->builtin_integer_s2; } | INT_KEYWORD { $$ = parse_f_type (pstate)->builtin_integer; } - | INT_S2_KEYWORD - { $$ = parse_f_type (pstate)->builtin_integer_s2; } + | INT_S4_KEYWORD + { $$ = parse_f_type (pstate)->builtin_integer; } + | INT_S8_KEYWORD + { $$ = parse_f_type (pstate)->builtin_integer_s8; } | CHARACTER { $$ = parse_f_type (pstate)->builtin_character; } - | LOGICAL_S8_KEYWORD - { $$ = parse_f_type (pstate)->builtin_logical_s8; } - | LOGICAL_KEYWORD - { $$ = parse_f_type (pstate)->builtin_logical; } - | LOGICAL_S2_KEYWORD - { $$ = parse_f_type (pstate)->builtin_logical_s2; } | LOGICAL_S1_KEYWORD { $$ = parse_f_type (pstate)->builtin_logical_s1; } + | LOGICAL_S2_KEYWORD + { $$ = parse_f_type (pstate)->builtin_logical_s2; } + | LOGICAL_KEYWORD + { $$ = parse_f_type (pstate)->builtin_logical; } + | LOGICAL_S4_KEYWORD + { $$ = parse_f_type (pstate)->builtin_logical; } + | LOGICAL_S8_KEYWORD + { $$ = parse_f_type (pstate)->builtin_logical_s8; } | REAL_KEYWORD { $$ = parse_f_type (pstate)->builtin_real; } + | REAL_S4_KEYWORD + { $$ = parse_f_type (pstate)->builtin_real; } | REAL_S8_KEYWORD { $$ = parse_f_type (pstate)->builtin_real_s8; } | REAL_S16_KEYWORD { $$ = parse_f_type (pstate)->builtin_real_s16; } | COMPLEX_KEYWORD - { $$ = parse_f_type (pstate)->builtin_complex_s8; } + { $$ = parse_f_type (pstate)->builtin_complex; } + | COMPLEX_S4_KEYWORD + { $$ = parse_f_type (pstate)->builtin_complex; } | COMPLEX_S8_KEYWORD { $$ = parse_f_type (pstate)->builtin_complex_s8; } | COMPLEX_S16_KEYWORD { $$ = parse_f_type (pstate)->builtin_complex_s16; } - | COMPLEX_S32_KEYWORD - { $$ = parse_f_type (pstate)->builtin_complex_s32; } | SINGLE PRECISION { $$ = parse_f_type (pstate)->builtin_real;} | DOUBLE PRECISION { $$ = parse_f_type (pstate)->builtin_real_s8;} | SINGLE COMPLEX_KEYWORD - { $$ = parse_f_type (pstate)->builtin_complex_s8;} + { $$ = parse_f_type (pstate)->builtin_complex;} | DOUBLE COMPLEX_KEYWORD - { $$ = parse_f_type (pstate)->builtin_complex_s16;} + { $$ = parse_f_type (pstate)->builtin_complex_s8;} ; nonempty_typelist @@ -808,8 +789,11 @@ nonempty_typelist } ; -name : NAME - { $$ = $1.stoken; } +name + : NAME + { $$ = $1.stoken; } + | TYPENAME + { $$ = $1.stoken; } ; name_not_typename : NAME @@ -824,6 +808,179 @@ name_not_typename : NAME %% +/* Called to match intrinsic function calls with one argument to their + respective implementation and push the operation. */ + +static void +wrap_unop_intrinsic (exp_opcode code) +{ + switch (code) + { + case UNOP_ABS: + pstate->wrap<fortran_abs_operation> (); + break; + case FORTRAN_FLOOR: + pstate->wrap<fortran_floor_operation_1arg> (); + break; + case FORTRAN_CEILING: + pstate->wrap<fortran_ceil_operation_1arg> (); + break; + case UNOP_FORTRAN_ALLOCATED: + pstate->wrap<fortran_allocated_operation> (); + break; + case UNOP_FORTRAN_RANK: + pstate->wrap<fortran_rank_operation> (); + break; + case UNOP_FORTRAN_SHAPE: + pstate->wrap<fortran_array_shape_operation> (); + break; + case UNOP_FORTRAN_LOC: + pstate->wrap<fortran_loc_operation> (); + break; + case FORTRAN_ASSOCIATED: + pstate->wrap<fortran_associated_1arg> (); + break; + case FORTRAN_ARRAY_SIZE: + pstate->wrap<fortran_array_size_1arg> (); + break; + case FORTRAN_CMPLX: + pstate->wrap<fortran_cmplx_operation_1arg> (); + break; + case FORTRAN_LBOUND: + case FORTRAN_UBOUND: + pstate->push_new<fortran_bound_1arg> (code, pstate->pop ()); + break; + default: + gdb_assert_not_reached ("unhandled intrinsic"); + } +} + +/* Called to match intrinsic function calls with two arguments to their + respective implementation and push the operation. */ + +static void +wrap_binop_intrinsic (exp_opcode code) +{ + switch (code) + { + case FORTRAN_FLOOR: + fortran_wrap2_kind<fortran_floor_operation_2arg> + (parse_f_type (pstate)->builtin_integer); + break; + case FORTRAN_CEILING: + fortran_wrap2_kind<fortran_ceil_operation_2arg> + (parse_f_type (pstate)->builtin_integer); + break; + case BINOP_MOD: + pstate->wrap2<fortran_mod_operation> (); + break; + case BINOP_FORTRAN_MODULO: + pstate->wrap2<fortran_modulo_operation> (); + break; + case FORTRAN_CMPLX: + pstate->wrap2<fortran_cmplx_operation_2arg> (); + break; + case FORTRAN_ASSOCIATED: + pstate->wrap2<fortran_associated_2arg> (); + break; + case FORTRAN_ARRAY_SIZE: + pstate->wrap2<fortran_array_size_2arg> (); + break; + case FORTRAN_LBOUND: + case FORTRAN_UBOUND: + { + operation_up arg2 = pstate->pop (); + operation_up arg1 = pstate->pop (); + pstate->push_new<fortran_bound_2arg> (code, std::move (arg1), + std::move (arg2)); + } + break; + default: + gdb_assert_not_reached ("unhandled intrinsic"); + } +} + +/* Called to match intrinsic function calls with three arguments to their + respective implementation and push the operation. */ + +static void +wrap_ternop_intrinsic (exp_opcode code) +{ + switch (code) + { + case FORTRAN_LBOUND: + case FORTRAN_UBOUND: + { + operation_up kind_arg = pstate->pop (); + operation_up arg2 = pstate->pop (); + operation_up arg1 = pstate->pop (); + + value *val = kind_arg->evaluate (nullptr, pstate->expout.get (), + EVAL_AVOID_SIDE_EFFECTS); + gdb_assert (val != nullptr); + + type *follow_type + = convert_to_kind_type (parse_f_type (pstate)->builtin_integer, + value_as_long (val)); + + pstate->push_new<fortran_bound_3arg> (code, std::move (arg1), + std::move (arg2), follow_type); + } + break; + case FORTRAN_ARRAY_SIZE: + fortran_wrap3_kind<fortran_array_size_3arg> + (parse_f_type (pstate)->builtin_integer); + break; + case FORTRAN_CMPLX: + fortran_wrap3_kind<fortran_cmplx_operation_3arg> + (parse_f_type (pstate)->builtin_complex); + break; + default: + gdb_assert_not_reached ("unhandled intrinsic"); + } +} + +/* A helper that pops two operations (similar to wrap2), evaluates the last one + assuming it is a kind parameter, and wraps them in some other operation + pushing it to the stack. */ + +template<typename T> +static void +fortran_wrap2_kind (type *base_type) +{ + operation_up kind_arg = pstate->pop (); + operation_up arg = pstate->pop (); + + value *val = kind_arg->evaluate (nullptr, pstate->expout.get (), + EVAL_AVOID_SIDE_EFFECTS); + gdb_assert (val != nullptr); + + type *follow_type = convert_to_kind_type (base_type, value_as_long (val)); + + pstate->push_new<T> (std::move (arg), follow_type); +} + +/* A helper that pops three operations, evaluates the last one assuming it is a + kind parameter, and wraps them in some other operation pushing it to the + stack. */ + +template<typename T> +static void +fortran_wrap3_kind (type *base_type) +{ + operation_up kind_arg = pstate->pop (); + operation_up arg2 = pstate->pop (); + operation_up arg1 = pstate->pop (); + + value *val = kind_arg->evaluate (nullptr, pstate->expout.get (), + EVAL_AVOID_SIDE_EFFECTS); + gdb_assert (val != nullptr); + + type *follow_type = convert_to_kind_type (base_type, value_as_long (val)); + + pstate->push_new<T> (std::move (arg1), std::move (arg2), follow_type); +} + /* Take care of parsing a number (anything that starts with a digit). Set yylval and return the token type; update lexptr. LEN is the number of characters in it. */ @@ -834,8 +991,8 @@ static int parse_number (struct parser_state *par_state, const char *p, int len, int parsed_float, YYSTYPE *putithere) { - LONGEST n = 0; - LONGEST prevn = 0; + ULONGEST n = 0; + ULONGEST prevn = 0; int c; int base = input_radix; int unsigned_p = 0; @@ -866,7 +1023,7 @@ parse_number (struct parser_state *par_state, } /* Handle base-switching prefixes 0x, 0t, 0d, 0 */ - if (p[0] == '0') + if (p[0] == '0' && len > 1) switch (p[1]) { case 'x': @@ -926,7 +1083,7 @@ parse_number (struct parser_state *par_state, /* If range checking enabled, portably test for unsigned overflow. */ if (RANGE_CHECK && n != 0) { - if ((unsigned_p && (unsigned)prevn >= (unsigned)n)) + if ((unsigned_p && prevn >= n)) range_error (_("Overflow on numeric constant.")); } prevn = n; @@ -1017,14 +1174,14 @@ convert_to_kind_type (struct type *basetype, int kind) if (kind == 1) return parse_f_type (pstate)->builtin_character; } - else if (basetype == parse_f_type (pstate)->builtin_complex_s8) + else if (basetype == parse_f_type (pstate)->builtin_complex) { if (kind == 4) - return parse_f_type (pstate)->builtin_complex_s8; + return parse_f_type (pstate)->builtin_complex; else if (kind == 8) - return parse_f_type (pstate)->builtin_complex_s16; + return parse_f_type (pstate)->builtin_complex_s8; else if (kind == 16) - return parse_f_type (pstate)->builtin_complex_s32; + return parse_f_type (pstate)->builtin_complex_s16; } else if (basetype == parse_f_type (pstate)->builtin_real) { @@ -1048,7 +1205,9 @@ convert_to_kind_type (struct type *basetype, int kind) } else if (basetype == parse_f_type (pstate)->builtin_integer) { - if (kind == 2) + if (kind == 1) + return parse_f_type (pstate)->builtin_integer_s1; + else if (kind == 2) return parse_f_type (pstate)->builtin_integer_s2; else if (kind == 4) return parse_f_type (pstate)->builtin_integer; @@ -1122,24 +1281,29 @@ static const struct f77_boolean_val boolean_values[] = { ".false.", 0 } }; -static const struct token f77_keywords[] = +static const token f_keywords[] = { /* Historically these have always been lowercase only in GDB. */ - { "complex_16", COMPLEX_S16_KEYWORD, OP_NULL, true }, - { "complex_32", COMPLEX_S32_KEYWORD, OP_NULL, true }, { "character", CHARACTER, OP_NULL, true }, + { "complex", COMPLEX_KEYWORD, OP_NULL, true }, + { "complex_4", COMPLEX_S4_KEYWORD, OP_NULL, true }, + { "complex_8", COMPLEX_S8_KEYWORD, OP_NULL, true }, + { "complex_16", COMPLEX_S16_KEYWORD, OP_NULL, true }, + { "integer_1", INT_S1_KEYWORD, OP_NULL, true }, { "integer_2", INT_S2_KEYWORD, OP_NULL, true }, + { "integer_4", INT_S4_KEYWORD, OP_NULL, true }, + { "integer", INT_KEYWORD, OP_NULL, true }, + { "integer_8", INT_S8_KEYWORD, OP_NULL, true }, { "logical_1", LOGICAL_S1_KEYWORD, OP_NULL, true }, { "logical_2", LOGICAL_S2_KEYWORD, OP_NULL, true }, - { "logical_8", LOGICAL_S8_KEYWORD, OP_NULL, true }, - { "complex_8", COMPLEX_S8_KEYWORD, OP_NULL, true }, - { "integer", INT_KEYWORD, OP_NULL, true }, { "logical", LOGICAL_KEYWORD, OP_NULL, true }, + { "logical_4", LOGICAL_S4_KEYWORD, OP_NULL, true }, + { "logical_8", LOGICAL_S8_KEYWORD, OP_NULL, true }, + { "real", REAL_KEYWORD, OP_NULL, true }, + { "real_4", REAL_S4_KEYWORD, OP_NULL, true }, + { "real_8", REAL_S8_KEYWORD, OP_NULL, true }, { "real_16", REAL_S16_KEYWORD, OP_NULL, true }, - { "complex", COMPLEX_KEYWORD, OP_NULL, true }, { "sizeof", SIZEOF, OP_NULL, true }, - { "real_8", REAL_S8_KEYWORD, OP_NULL, true }, - { "real", REAL_KEYWORD, OP_NULL, true }, { "single", SINGLE, OP_NULL, true }, { "double", DOUBLE, OP_NULL, true }, { "precision", PRECISION, OP_NULL, true }, @@ -1148,16 +1312,16 @@ static const struct token f77_keywords[] = { "kind", KIND, OP_NULL, false }, { "abs", UNOP_INTRINSIC, UNOP_ABS, false }, { "mod", BINOP_INTRINSIC, BINOP_MOD, false }, - { "floor", UNOP_INTRINSIC, UNOP_FORTRAN_FLOOR, false }, - { "ceiling", UNOP_INTRINSIC, UNOP_FORTRAN_CEILING, false }, + { "floor", UNOP_OR_BINOP_INTRINSIC, FORTRAN_FLOOR, false }, + { "ceiling", UNOP_OR_BINOP_INTRINSIC, FORTRAN_CEILING, false }, { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false }, - { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false }, - { "lbound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_LBOUND, false }, - { "ubound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_UBOUND, false }, + { "cmplx", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_CMPLX, false }, + { "lbound", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_LBOUND, false }, + { "ubound", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_UBOUND, false }, { "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false }, { "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false }, { "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false }, - { "size", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false }, + { "size", UNOP_OR_BINOP_OR_TERNOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false }, { "shape", UNOP_INTRINSIC, UNOP_FORTRAN_SHAPE, false }, { "loc", UNOP_INTRINSIC, UNOP_FORTRAN_LOC, false }, }; @@ -1452,7 +1616,7 @@ yylex (void) /* Catch specific keywords. */ - for (const auto &keyword : f77_keywords) + for (const auto &keyword : f_keywords) if (strlen (keyword.oper) == namelen && ((!keyword.case_sensitive && strncasecmp (tokstart, keyword.oper, namelen) == 0) @@ -1475,7 +1639,7 @@ yylex (void) { std::string tmp = copy_name (yylval.sval); struct block_symbol result; - const enum domain_enum_tag lookup_domains[] = + const domain_enum lookup_domains[] = { STRUCT_DOMAIN, VAR_DOMAIN, @@ -1487,9 +1651,9 @@ yylex (void) { result = lookup_symbol (tmp.c_str (), pstate->expression_context_block, domain, NULL); - if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF) + if (result.symbol && result.symbol->aclass () == LOC_TYPEDEF) { - yylval.tsym.type = SYMBOL_TYPE (result.symbol); + yylval.tsym.type = result.symbol->type (); return TYPENAME; } |