[RFC 4/8] Fortran language

Sergio Durigan Junior
2012-01-15T19:04:02Z

Hi,

This is the patch for the Fortran language files.

Thanks,

Sergio.

diff --git a/gdb/f-exp.y b/gdb/f-exp.y
index fa464cf..816f667 100644
--- a/gdb/f-exp.y
+++ b/gdb/f-exp.y
@@ -55,8 +55,8 @@
#include "block.h"
#include <ctype.h>

-#define parse_type builtin_type (parse_gdbarch)
-#define parse_f_type builtin_f_type (parse_gdbarch)
+#define parse_type(ps) builtin_type (parse_gdbarch (ps))
+#define parse_f_type(ps) builtin_f_type (parse_gdbarch (ps))

/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
as well as gratuitiously global symbol names, so we can have multiple
@@ -112,11 +112,11 @@

#define YYFPRINTF parser_fprintf

-int yyparse (void);
+int yyparse (struct parser_state *);

-static int yylex (void);
+static int yylex (struct parser_state *);

-void yyerror (char *);
+void yyerror (struct parser_state *, char *);

static void growbuf_by_size (int);

@@ -124,6 +124,9 @@ static int match_string_literal (void);

%}

+%parse-param {struct parser_state *ps}
+%lex-param {struct parser_state *ps}
+
/* Although the yacc "value" of an expression is not used,
since the result is stored in the structure being created,
other node types do have values. */
@@ -152,7 +155,7 @@ static int match_string_literal (void);

%{
/* YYSTYPE gets defined by %union */
-static int parse_number (char *, int, int, YYSTYPE *);
+static int parse_number (struct parser_state *, char *, int, int, YYSTYPE *);
%}

%type <voidval> exp type_exp start variable
@@ -234,9 +237,9 @@ start : exp
;

type_exp: type
- { write_exp_elt_opcode(OP_TYPE);
- write_exp_elt_type($1);
- write_exp_elt_opcode(OP_TYPE); }
+ { write_exp_elt_opcode (ps, OP_TYPE);
+ write_exp_elt_type (ps, $1);
+ write_exp_elt_opcode (ps, OP_TYPE); }
;

exp : '(' exp ')'
@@ -245,27 +248,27 @@ exp : '(' exp ')'

/* Expressions, not including the comma operator. */
exp : '*' exp %prec UNARY
- { write_exp_elt_opcode (UNOP_IND); }
+ { write_exp_elt_opcode (ps, UNOP_IND); }
;

exp : '&' exp %prec UNARY
- { write_exp_elt_opcode (UNOP_ADDR); }
+ { write_exp_elt_opcode (ps, UNOP_ADDR); }
;

exp : '-' exp %prec UNARY
- { write_exp_elt_opcode (UNOP_NEG); }
+ { write_exp_elt_opcode (ps, UNOP_NEG); }
;

exp : BOOL_NOT exp %prec UNARY
- { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
+ { write_exp_elt_opcode (ps, UNOP_LOGICAL_NOT); }
;

exp : '~' exp %prec UNARY
- { write_exp_elt_opcode (UNOP_COMPLEMENT); }
+ { write_exp_elt_opcode (ps, UNOP_COMPLEMENT); }
;

exp : SIZEOF exp %prec UNARY
- { write_exp_elt_opcode (UNOP_SIZEOF); }
+ { write_exp_elt_opcode (ps, UNOP_SIZEOF); }
;

/* No more explicit array operators, we treat everything in F77 as
@@ -276,9 +279,9 @@ exp : SIZEOF exp %prec UNARY
exp : exp '('
{ start_arglist (); }
arglist ')'
- { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
- write_exp_elt_longcst ((LONGEST) end_arglist ());
- write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
+ { write_exp_elt_opcode (ps, OP_F77_UNDETERMINED_ARGLIST);
+ write_exp_elt_longcst (ps, (LONGEST) end_arglist ());
+ write_exp_elt_opcode (ps, OP_F77_UNDETERMINED_ARGLIST); }
;

arglist :
@@ -299,27 +302,27 @@ arglist : arglist ',' exp %prec ABOVE_COMMA
/* There are four sorts of subrange types in F90. */

subrange: exp ':' exp %prec ABOVE_COMMA
- { write_exp_elt_opcode (OP_F90_RANGE);
- write_exp_elt_longcst (NONE_BOUND_DEFAULT);
- write_exp_elt_opcode (OP_F90_RANGE); }
+ { write_exp_elt_opcode (ps, OP_F90_RANGE);
+ write_exp_elt_longcst (ps, NONE_BOUND_DEFAULT);
+ write_exp_elt_opcode (ps, OP_F90_RANGE); }
;

subrange: exp ':' %prec ABOVE_COMMA
- { write_exp_elt_opcode (OP_F90_RANGE);
- write_exp_elt_longcst (HIGH_BOUND_DEFAULT);
- write_exp_elt_opcode (OP_F90_RANGE); }
+ { write_exp_elt_opcode (ps, OP_F90_RANGE);
+ write_exp_elt_longcst (ps, HIGH_BOUND_DEFAULT);
+ write_exp_elt_opcode (ps, OP_F90_RANGE); }
;

subrange: ':' exp %prec ABOVE_COMMA
- { write_exp_elt_opcode (OP_F90_RANGE);
- write_exp_elt_longcst (LOW_BOUND_DEFAULT);
- write_exp_elt_opcode (OP_F90_RANGE); }
+ { write_exp_elt_opcode (ps, OP_F90_RANGE);
+ write_exp_elt_longcst (ps, LOW_BOUND_DEFAULT);
+ write_exp_elt_opcode (ps, OP_F90_RANGE); }
;

subrange: ':' %prec ABOVE_COMMA
- { write_exp_elt_opcode (OP_F90_RANGE);
- write_exp_elt_longcst (BOTH_BOUND_DEFAULT);
- write_exp_elt_opcode (OP_F90_RANGE); }
+ { write_exp_elt_opcode (ps, OP_F90_RANGE);
+ write_exp_elt_longcst (ps, BOTH_BOUND_DEFAULT);
+ write_exp_elt_opcode (ps, OP_F90_RANGE); }
;

complexnum: exp ',' exp
@@ -327,133 +330,138 @@ complexnum: exp ',' exp
;

exp : '(' complexnum ')'
- { write_exp_elt_opcode(OP_COMPLEX);
- write_exp_elt_type (parse_f_type->builtin_complex_s16);
- write_exp_elt_opcode(OP_COMPLEX); }
+ { write_exp_elt_opcode (ps, OP_COMPLEX);
+ write_exp_elt_type (ps,
+ parse_f_type (ps)
+ ->builtin_complex_s16);
+ write_exp_elt_opcode (ps, OP_COMPLEX); }
;

exp : '(' type ')' exp %prec UNARY
- { write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type ($2);
- write_exp_elt_opcode (UNOP_CAST); }
+ { write_exp_elt_opcode (ps, UNOP_CAST);
+ write_exp_elt_type (ps, $2);
+ write_exp_elt_opcode (ps, UNOP_CAST); }
;

exp : exp '%' name
- { write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string ($3);
- write_exp_elt_opcode (STRUCTOP_STRUCT); }
+ { write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
+ write_exp_string (ps, $3);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT); }
;

/* Binary operators in order of decreasing precedence. */

exp : exp '@' exp
- { write_exp_elt_opcode (BINOP_REPEAT); }
+ { write_exp_elt_opcode (ps, BINOP_REPEAT); }
;

exp : exp STARSTAR exp
- { write_exp_elt_opcode (BINOP_EXP); }
+ { write_exp_elt_opcode (ps, BINOP_EXP); }
;

exp : exp '*' exp
- { write_exp_elt_opcode (BINOP_MUL); }
+ { write_exp_elt_opcode (ps, BINOP_MUL); }
;

exp : exp '/' exp
- { write_exp_elt_opcode (BINOP_DIV); }
+ { write_exp_elt_opcode (ps, BINOP_DIV); }
;

exp : exp '+' exp
- { write_exp_elt_opcode (BINOP_ADD); }
+ { write_exp_elt_opcode (ps, BINOP_ADD); }
;

exp : exp '-' exp
- { write_exp_elt_opcode (BINOP_SUB); }
+ { write_exp_elt_opcode (ps, BINOP_SUB); }
;

exp : exp LSH exp
- { write_exp_elt_opcode (BINOP_LSH); }
+ { write_exp_elt_opcode (ps, BINOP_LSH); }
;

exp : exp RSH exp
- { write_exp_elt_opcode (BINOP_RSH); }
+ { write_exp_elt_opcode (ps, BINOP_RSH); }
;

exp : exp EQUAL exp
- { write_exp_elt_opcode (BINOP_EQUAL); }
+ { write_exp_elt_opcode (ps, BINOP_EQUAL); }
;

exp : exp NOTEQUAL exp
- { write_exp_elt_opcode (BINOP_NOTEQUAL); }
+ { write_exp_elt_opcode (ps, BINOP_NOTEQUAL); }
;

exp : exp LEQ exp
- { write_exp_elt_opcode (BINOP_LEQ); }
+ { write_exp_elt_opcode (ps, BINOP_LEQ); }
;

exp : exp GEQ exp
- { write_exp_elt_opcode (BINOP_GEQ); }
+ { write_exp_elt_opcode (ps, BINOP_GEQ); }
;

exp : exp LESSTHAN exp
- { write_exp_elt_opcode (BINOP_LESS); }
+ { write_exp_elt_opcode (ps, BINOP_LESS); }
;

exp : exp GREATERTHAN exp
- { write_exp_elt_opcode (BINOP_GTR); }
+ { write_exp_elt_opcode (ps, BINOP_GTR); }
;

exp : exp '&' exp
- { write_exp_elt_opcode (BINOP_BITWISE_AND); }
+ { write_exp_elt_opcode (ps, BINOP_BITWISE_AND); }
;

exp : exp '^' exp
- { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
+ { write_exp_elt_opcode (ps, BINOP_BITWISE_XOR); }
;

exp : exp '|' exp
- { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
+ { write_exp_elt_opcode (ps, BINOP_BITWISE_IOR); }
;

exp : exp BOOL_AND exp
- { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
+ { write_exp_elt_opcode (ps, BINOP_LOGICAL_AND); }
;

exp : exp BOOL_OR exp
- { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
+ { write_exp_elt_opcode (ps, BINOP_LOGICAL_OR); }
;

exp : exp '=' exp
- { write_exp_elt_opcode (BINOP_ASSIGN); }
+ { write_exp_elt_opcode (ps, BINOP_ASSIGN); }
;

exp : exp ASSIGN_MODIFY exp
- { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
- write_exp_elt_opcode ($2);
- write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
+ { write_exp_elt_opcode (ps, BINOP_ASSIGN_MODIFY);
+ write_exp_elt_opcode (ps, $2);
+ write_exp_elt_opcode (ps, BINOP_ASSIGN_MODIFY); }
;

exp : INT
- { write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type ($1.type);
- write_exp_elt_longcst ((LONGEST)($1.val));
- write_exp_elt_opcode (OP_LONG); }
+ { write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps, $1.type);
+ write_exp_elt_longcst (ps, (LONGEST) ($1.val));
+ write_exp_elt_opcode (ps, OP_LONG); }
;

exp : NAME_OR_INT
{ YYSTYPE val;
- parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (val.typed_val.type);
- write_exp_elt_longcst ((LONGEST)val.typed_val.val);
- write_exp_elt_opcode (OP_LONG); }
+ parse_number (ps, $1.stoken.ptr, $1.stoken.length,
+ 0, &val);
+ write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps, val.typed_val.type);
+ write_exp_elt_longcst (ps, (LONGEST)val.typed_val.val);
+ write_exp_elt_opcode (ps, OP_LONG); }
;

exp : FLOAT
- { write_exp_elt_opcode (OP_DOUBLE);
- write_exp_elt_type (parse_f_type->builtin_real_s8);
- write_exp_elt_dblcst ($1);
- write_exp_elt_opcode (OP_DOUBLE); }
+ { write_exp_elt_opcode (ps, OP_DOUBLE);
+ write_exp_elt_type (ps,
+ parse_f_type (ps)
+ ->builtin_real_s8);
+ write_exp_elt_dblcst (ps, $1);
+ write_exp_elt_opcode (ps, OP_DOUBLE); }
;

exp : variable
@@ -463,25 +471,27 @@ exp : VARIABLE
;

exp : SIZEOF '(' type ')' %prec UNARY
- { write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (parse_f_type->builtin_integer);
+ { write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps,
+ parse_f_type (ps)
+ ->builtin_integer);
CHECK_TYPEDEF ($3);
- write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
- write_exp_elt_opcode (OP_LONG); }
+ write_exp_elt_longcst (ps, (LONGEST) TYPE_LENGTH ($3));
+ write_exp_elt_opcode (ps, OP_LONG); }
;

exp : BOOLEAN_LITERAL
- { write_exp_elt_opcode (OP_BOOL);
- write_exp_elt_longcst ((LONGEST) $1);
- write_exp_elt_opcode (OP_BOOL);
+ { write_exp_elt_opcode (ps, OP_BOOL);
+ write_exp_elt_longcst (ps, (LONGEST) $1);
+ write_exp_elt_opcode (ps, OP_BOOL);
}
;

exp : STRING_LITERAL
{
- write_exp_elt_opcode (OP_STRING);
- write_exp_string ($1);
- write_exp_elt_opcode (OP_STRING);
+ write_exp_elt_opcode (ps, OP_STRING);
+ write_exp_string (ps, $1);
+ write_exp_elt_opcode (ps, OP_STRING);
}
;

@@ -497,13 +507,13 @@ variable: name_not_typename
innermost_block))
innermost_block = block_found;
}
- write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE);
/* We want to use the selected frame, not
another more inner frame which happens to
be in the same block. */
- write_exp_elt_block (NULL);
- write_exp_elt_sym (sym);
- write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_block (ps, NULL);
+ write_exp_elt_sym (ps, sym);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE);
break;
}
else
@@ -514,7 +524,7 @@ variable: name_not_typename
msymbol =
lookup_minimal_symbol (arg, NULL, NULL);
if (msymbol != NULL)
- write_exp_msymbol (msymbol);
+ write_exp_msymbol (ps, msymbol);
else if (!have_full_symbols () && !have_partial_symbols ())
error (_("No symbol table is loaded. Use the \"file\" command."));
else
@@ -555,7 +565,8 @@ ptype : typebase
{
range_type =
create_range_type ((struct type *) NULL,
- parse_f_type->builtin_integer,
+ parse_f_type (ps)
+ ->builtin_integer,
0, array_size - 1);
follow_type =
create_array_type ((struct type *) NULL,
@@ -601,31 +612,31 @@ typebase /* Implements (approximately): (type-qualifier)* type-specifier */
: TYPENAME
{ $$ = $1.type; }
| INT_KEYWORD
- { $$ = parse_f_type->builtin_integer; }
+ { $$ = parse_f_type (ps)->builtin_integer; }
| INT_S2_KEYWORD
- { $$ = parse_f_type->builtin_integer_s2; }
+ { $$ = parse_f_type (ps)->builtin_integer_s2; }
| CHARACTER
- { $$ = parse_f_type->builtin_character; }
+ { $$ = parse_f_type (ps)->builtin_character; }
| LOGICAL_S8_KEYWORD
- { $$ = parse_f_type->builtin_logical_s8; }
+ { $$ = parse_f_type (ps)->builtin_logical_s8; }
| LOGICAL_KEYWORD
- { $$ = parse_f_type->builtin_logical; }
+ { $$ = parse_f_type (ps)->builtin_logical; }
| LOGICAL_S2_KEYWORD
- { $$ = parse_f_type->builtin_logical_s2; }
+ { $$ = parse_f_type (ps)->builtin_logical_s2; }
| LOGICAL_S1_KEYWORD
- { $$ = parse_f_type->builtin_logical_s1; }
+ { $$ = parse_f_type (ps)->builtin_logical_s1; }
| REAL_KEYWORD
- { $$ = parse_f_type->builtin_real; }
+ { $$ = parse_f_type (ps)->builtin_real; }
| REAL_S8_KEYWORD
- { $$ = parse_f_type->builtin_real_s8; }
+ { $$ = parse_f_type (ps)->builtin_real_s8; }
| REAL_S16_KEYWORD
- { $$ = parse_f_type->builtin_real_s16; }
+ { $$ = parse_f_type (ps)->builtin_real_s16; }
| COMPLEX_S8_KEYWORD
- { $$ = parse_f_type->builtin_complex_s8; }
+ { $$ = parse_f_type (ps)->builtin_complex_s8; }
| COMPLEX_S16_KEYWORD
- { $$ = parse_f_type->builtin_complex_s16; }
+ { $$ = parse_f_type (ps)->builtin_complex_s16; }
| COMPLEX_S32_KEYWORD
- { $$ = parse_f_type->builtin_complex_s32; }
+ { $$ = parse_f_type (ps)->builtin_complex_s32; }
;

nonempty_typelist
@@ -664,11 +675,8 @@ name_not_typename : NAME
/*** Needs some error checking for the float case ***/

static int
-parse_number (p, len, parsed_float, putithere)
- char *p;
- int len;
- int parsed_float;
- YYSTYPE *putithere;
+parse_number (struct parser_state *ps, char *p, int len, int parsed_float,
+ YYSTYPE *putithere)
{
LONGEST n = 0;
LONGEST prevn = 0;
@@ -774,20 +782,22 @@ parse_number (p, len, parsed_float, putithere)
are the same size. So we shift it twice, with fewer bits
each time, for the same result. */

- if ((gdbarch_int_bit (parse_gdbarch) != gdbarch_long_bit (parse_gdbarch)
+ if ((gdbarch_int_bit (parse_gdbarch (ps))
+ != gdbarch_long_bit (parse_gdbarch (ps))
&& ((n >> 2)
- >> (gdbarch_int_bit (parse_gdbarch)-2))) /* Avoid shift warning */
+ >> (gdbarch_int_bit (parse_gdbarch (ps))-2))) /* Avoid
+ shift warning */
|| long_p)
{
- high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch)-1);
- unsigned_type = parse_type->builtin_unsigned_long;
- signed_type = parse_type->builtin_long;
+ high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch (ps))-1);
+ unsigned_type = parse_type (ps)->builtin_unsigned_long;
+ signed_type = parse_type (ps)->builtin_long;
}
else
{
- high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch)-1);
- unsigned_type = parse_type->builtin_unsigned_int;
- signed_type = parse_type->builtin_int;
+ high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (ps))-1);
+ unsigned_type = parse_type (ps)->builtin_unsigned_int;
+ signed_type = parse_type (ps)->builtin_int;
}

putithere->typed_val.val = n;
@@ -895,8 +905,7 @@ static int tempbufindex; /* Current index into buffer */
first one on demand. */

static void
-growbuf_by_size (count)
- int count;
+growbuf_by_size (int count)
{
int growby;

@@ -950,7 +959,7 @@ match_string_literal (void)
/* Read one token, getting characters through lexptr. */

static int
-yylex (void)
+yylex (struct parser_state *ps)
{
int c;
int namelen;
@@ -1090,7 +1099,8 @@ yylex (void)
&& (*p < 'A' || *p > 'Z')))
break;
}
- toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d,
+ toktype = parse_number (ps, tokstart, p - tokstart,
+ got_dot|got_e|got_d,
&yylval);
if (toktype == ERROR)
{
@@ -1164,7 +1174,7 @@ yylex (void)

if (*tokstart == '$')
{
- write_dollar_variable (yylval.sval);
+ write_dollar_variable (ps, yylval.sval);
return VARIABLE;
}

@@ -1179,7 +1189,7 @@ yylex (void)

sym = lookup_symbol (tmp, expression_context_block,
VAR_DOMAIN,
- parse_language->la_language == language_cplus
+ parse_language (ps)->la_language == language_cplus
? &is_a_field_of_this : NULL);
if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
{
@@ -1187,8 +1197,8 @@ yylex (void)
return TYPENAME;
}
yylval.tsym.type
- = language_lookup_primitive_type_by_name (parse_language,
- parse_gdbarch, tmp);
+ = language_lookup_primitive_type_by_name (parse_language (ps),
+ parse_gdbarch (ps), tmp);
if (yylval.tsym.type != NULL)
return TYPENAME;

@@ -1200,7 +1210,7 @@ yylex (void)
|| (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
{
YYSTYPE newlval; /* Its value is ignored. */
- hextype = parse_number (tokstart, namelen, 0, &newlval);
+ hextype = parse_number (ps, tokstart, namelen, 0, &newlval);
if (hextype == INT)
{
yylval.ssym.sym = sym;
@@ -1217,8 +1227,7 @@ yylex (void)
}

void
-yyerror (msg)
- char *msg;
+yyerror (struct parser_state *ps, char *msg)
{
if (prev_lexptr)
lexptr = prev_lexptr;
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 3a46ebf..0e55d94 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -21,9 +21,11 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */

-extern int f_parse (void);
+struct parser_state;

-extern void f_error (char *); /* Defined in f-exp.y */
+extern int f_parse (struct parser_state *);
+
+extern void f_error (struct parser_state *, char *); /* Defined in f-exp.y */

extern void f_print_type (struct type *, const char *, struct ui_file *, int,
int);