[RFC 8/8] Pascal language

Sergio Durigan Junior
2012-01-15T19:10:25Z

Hello,

This is the patch for the Pascal language. I forgot to mention in the
other patches: I also took the liberty (in all files) to cleanup #if 0
functions, and to convert old-style function declarations to use the
"new" style, i.e.:

static void
foo (bar)
int bar;
{
/* ... */
}

becomes:

static void
foo (int bar)
{
/* ... */
}

Thanks,

Sergio.

diff --git a/gdb/p-exp.y b/gdb/p-exp.y
index 7b05d58..a3d75e4 100644
--- a/gdb/p-exp.y
+++ b/gdb/p-exp.y
@@ -56,7 +56,7 @@
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols. */
#include "block.h"

-#define parse_type builtin_type (parse_gdbarch)
+#define parse_type(ps) builtin_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,15 +112,18 @@

#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 char * uptok (char *, int);
%}

+%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 char * uptok (char *, int);

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

static struct type *current_type;
static struct internalvar *intvar;
@@ -245,44 +248,44 @@ normal_start :
;

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);
current_type = $1; } ;

/* Expressions, including the comma operator. */
exp1 : exp
| exp1 ',' exp
- { write_exp_elt_opcode (BINOP_COMMA); }
+ { write_exp_elt_opcode (ps, BINOP_COMMA); }
;

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

exp : '@' exp %prec UNARY
- { write_exp_elt_opcode (UNOP_ADDR);
+ { write_exp_elt_opcode (ps, UNOP_ADDR);
if (current_type)
current_type = TYPE_POINTER_TYPE (current_type); }
;

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

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

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

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

@@ -291,9 +294,9 @@ field_exp : exp '.' %prec UNARY
;

exp : field_exp FIELDNAME
- { write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string ($2);
- write_exp_elt_opcode (STRUCTOP_STRUCT);
+ { write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
+ write_exp_string (ps, $2);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
search_field = 0;
if (current_type)
{
@@ -309,10 +312,10 @@ exp : field_exp FIELDNAME

exp : field_exp name
- { mark_struct_expression ();
- write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string ($2);
- write_exp_elt_opcode (STRUCTOP_STRUCT);
+ { mark_struct_expression (ps);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
+ write_exp_string (ps, $2);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
search_field = 0;
if (current_type)
{
@@ -328,12 +331,12 @@ exp : field_exp name

exp : field_exp COMPLETE
{ struct stoken s;
- mark_struct_expression ();
- write_exp_elt_opcode (STRUCTOP_STRUCT);
+ mark_struct_expression (ps);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
s.ptr = "";
s.length = 0;
- write_exp_string (s);
- write_exp_elt_opcode (STRUCTOP_STRUCT); }
+ write_exp_string (ps, s);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT); }
;

exp : exp '['
@@ -351,14 +354,14 @@ exp : exp '['
strcpy (stringsval.ptr, arrayname);
current_type = TYPE_FIELD_TYPE (current_type,
arrayfieldindex - 1);
- write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string (stringsval);
- write_exp_elt_opcode (STRUCTOP_STRUCT);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
+ write_exp_string (ps, stringsval);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
}
push_current_type (); }
exp1 ']'
{ pop_current_type ();
- write_exp_elt_opcode (BINOP_SUBSCRIPT);
+ write_exp_elt_opcode (ps, BINOP_SUBSCRIPT);
if (current_type)
current_type = TYPE_TARGET_TYPE (current_type); }
;
@@ -369,9 +372,9 @@ exp : exp '('
{ push_current_type ();
start_arglist (); }
arglist ')' %prec ARROW
- { write_exp_elt_opcode (OP_FUNCALL);
- write_exp_elt_longcst ((LONGEST) end_arglist ());
- write_exp_elt_opcode (OP_FUNCALL);
+ { write_exp_elt_opcode (ps, OP_FUNCALL);
+ write_exp_elt_longcst (ps, (LONGEST) end_arglist ());
+ write_exp_elt_opcode (ps, OP_FUNCALL);
pop_current_type ();
if (current_type)
current_type = TYPE_TARGET_TYPE (current_type);
@@ -392,11 +395,11 @@ exp : type '(' exp ')' %prec UNARY
if ((TYPE_CODE (current_type) == TYPE_CODE_PTR)
&& (TYPE_CODE (TYPE_TARGET_TYPE (current_type)) == TYPE_CODE_CLASS)
&& (TYPE_CODE ($1) == TYPE_CODE_CLASS))
- write_exp_elt_opcode (UNOP_IND);
+ write_exp_elt_opcode (ps, UNOP_IND);
}
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type ($1);
- write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_opcode (ps, UNOP_CAST);
+ write_exp_elt_type (ps, $1);
+ write_exp_elt_opcode (ps, UNOP_CAST);
current_type = $1; }
;

@@ -407,7 +410,7 @@ exp : '(' exp1 ')'
/* Binary operators in order of decreasing precedence. */

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

exp : exp '/' {
@@ -419,135 +422,137 @@ exp : exp '/' {
if (leftdiv_is_integer && current_type
&& is_integral_type (current_type))
{
- write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type (parse_type->builtin_long_double);
- current_type = parse_type->builtin_long_double;
- write_exp_elt_opcode (UNOP_CAST);
+ write_exp_elt_opcode (ps, UNOP_CAST);
+ write_exp_elt_type (ps,
+ parse_type (ps)
+ ->builtin_long_double);
+ current_type = parse_type (ps)->builtin_long_double;
+ write_exp_elt_opcode (ps, UNOP_CAST);
leftdiv_is_integer = 0;
}

- write_exp_elt_opcode (BINOP_DIV);
+ write_exp_elt_opcode (ps, BINOP_DIV);
}
;

exp : exp DIV exp
- { write_exp_elt_opcode (BINOP_INTDIV); }
+ { write_exp_elt_opcode (ps, BINOP_INTDIV); }
;

exp : exp MOD exp
- { write_exp_elt_opcode (BINOP_REM); }
+ { write_exp_elt_opcode (ps, BINOP_REM); }
;

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 '=' exp
- { write_exp_elt_opcode (BINOP_EQUAL);
- current_type = parse_type->builtin_bool;
+ { write_exp_elt_opcode (ps, BINOP_EQUAL);
+ current_type = parse_type (ps)->builtin_bool;
}
;

exp : exp NOTEQUAL exp
- { write_exp_elt_opcode (BINOP_NOTEQUAL);
- current_type = parse_type->builtin_bool;
+ { write_exp_elt_opcode (ps, BINOP_NOTEQUAL);
+ current_type = parse_type (ps)->builtin_bool;
}
;

exp : exp LEQ exp
- { write_exp_elt_opcode (BINOP_LEQ);
- current_type = parse_type->builtin_bool;
+ { write_exp_elt_opcode (ps, BINOP_LEQ);
+ current_type = parse_type (ps)->builtin_bool;
}
;

exp : exp GEQ exp
- { write_exp_elt_opcode (BINOP_GEQ);
- current_type = parse_type->builtin_bool;
+ { write_exp_elt_opcode (ps, BINOP_GEQ);
+ current_type = parse_type (ps)->builtin_bool;
}
;

exp : exp '<' exp
- { write_exp_elt_opcode (BINOP_LESS);
- current_type = parse_type->builtin_bool;
+ { write_exp_elt_opcode (ps, BINOP_LESS);
+ current_type = parse_type (ps)->builtin_bool;
}
;

exp : exp '>' exp
- { write_exp_elt_opcode (BINOP_GTR);
- current_type = parse_type->builtin_bool;
+ { write_exp_elt_opcode (ps, BINOP_GTR);
+ current_type = parse_type (ps)->builtin_bool;
}
;

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

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

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

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

exp : TRUEKEYWORD
- { write_exp_elt_opcode (OP_BOOL);
- write_exp_elt_longcst ((LONGEST) $1);
- current_type = parse_type->builtin_bool;
- write_exp_elt_opcode (OP_BOOL); }
+ { write_exp_elt_opcode (ps, OP_BOOL);
+ write_exp_elt_longcst (ps, (LONGEST) $1);
+ current_type = parse_type (ps)->builtin_bool;
+ write_exp_elt_opcode (ps, OP_BOOL); }
;

exp : FALSEKEYWORD
- { write_exp_elt_opcode (OP_BOOL);
- write_exp_elt_longcst ((LONGEST) $1);
- current_type = parse_type->builtin_bool;
- write_exp_elt_opcode (OP_BOOL); }
+ { write_exp_elt_opcode (ps, OP_BOOL);
+ write_exp_elt_longcst (ps, (LONGEST) $1);
+ current_type = parse_type (ps)->builtin_bool;
+ write_exp_elt_opcode (ps, OP_BOOL); }
;

exp : INT
- { write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type ($1.type);
+ { write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps, $1.type);
current_type = $1.type;
- write_exp_elt_longcst ((LONGEST)($1.val));
- write_exp_elt_opcode (OP_LONG); }
+ 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,
+ parse_number (ps, $1.stoken.ptr,
$1.stoken.length, 0, &val);
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (val.typed_val_int.type);
+ write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps, val.typed_val_int.type);
current_type = val.typed_val_int.type;
- write_exp_elt_longcst ((LONGEST)
+ write_exp_elt_longcst (ps, (LONGEST)
val.typed_val_int.val);
- write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_opcode (ps, OP_LONG);
}
;

exp : FLOAT
- { write_exp_elt_opcode (OP_DOUBLE);
- write_exp_elt_type ($1.type);
+ { write_exp_elt_opcode (ps, OP_DOUBLE);
+ write_exp_elt_type (ps, $1.type);
current_type = $1.type;
- write_exp_elt_dblcst ($1.dval);
- write_exp_elt_opcode (OP_DOUBLE); }
+ write_exp_elt_dblcst (ps, $1.dval);
+ write_exp_elt_opcode (ps, OP_DOUBLE); }
;

exp : variable
@@ -560,7 +565,7 @@ exp : VARIABLE
struct value * val, * mark;

mark = value_mark ();
- val = value_of_internalvar (parse_gdbarch,
+ val = value_of_internalvar (parse_gdbarch (ps),
intvar);
current_type = value_type (val);
value_release_to_mark (mark);
@@ -569,15 +574,16 @@ exp : VARIABLE
;

exp : SIZEOF '(' type ')' %prec UNARY
- { write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (parse_type->builtin_int);
+ { write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps, parse_type (ps)->builtin_int);
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 : SIZEOF '(' exp ')' %prec UNARY
- { write_exp_elt_opcode (UNOP_SIZEOF); }
+ { write_exp_elt_opcode (ps, UNOP_SIZEOF); }

exp : STRING
{ /* C strings are converted into array constants with
@@ -588,19 +594,23 @@ exp : STRING
char *sp = $1.ptr; int count = $1.length;
while (count-- > 0)
{
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (parse_type->builtin_char);
- write_exp_elt_longcst ((LONGEST)(*sp++));
- write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps,
+ parse_type (ps)
+ ->builtin_char);
+ write_exp_elt_longcst (ps, (LONGEST) (*sp++));
+ write_exp_elt_opcode (ps, OP_LONG);
}
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (parse_type->builtin_char);
- write_exp_elt_longcst ((LONGEST)'\0');
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_opcode (OP_ARRAY);
- write_exp_elt_longcst ((LONGEST) 0);
- write_exp_elt_longcst ((LONGEST) ($1.length));
- write_exp_elt_opcode (OP_ARRAY); }
+ write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps,
+ parse_type (ps)
+ ->builtin_char);
+ write_exp_elt_longcst (ps, (LONGEST)'\0');
+ write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_opcode (ps, OP_ARRAY);
+ write_exp_elt_longcst (ps, (LONGEST) 0);
+ write_exp_elt_longcst (ps, (LONGEST) ($1.length));
+ write_exp_elt_opcode (ps, OP_ARRAY); }
;

/* Object pascal */
@@ -608,10 +618,10 @@ exp : THIS
{
struct value * this_val;
struct type * this_type;
- write_exp_elt_opcode (OP_THIS);
- write_exp_elt_opcode (OP_THIS);
+ write_exp_elt_opcode (ps, OP_THIS);
+ write_exp_elt_opcode (ps, OP_THIS);
/* We need type of this. */
- this_val = value_of_this_silent (parse_language);
+ this_val = value_of_this_silent (parse_language (ps));
if (this_val)
this_type = value_type (this_val);
else
@@ -621,7 +631,7 @@ exp : THIS
if (TYPE_CODE (this_type) == TYPE_CODE_PTR)
{
this_type = TYPE_TARGET_TYPE (this_type);
- write_exp_elt_opcode (UNOP_IND);
+ write_exp_elt_opcode (ps, UNOP_IND);
}
}

@@ -667,11 +677,11 @@ variable: block COLONCOLON name
error (_("No symbol \"%s\" in specified context."),
copy_name ($3));

- write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE);
/* block_found is set by lookup_symbol. */
- write_exp_elt_block (block_found);
- write_exp_elt_sym (sym);
- write_exp_elt_opcode (OP_VAR_VALUE); }
+ write_exp_elt_block (ps, block_found);
+ write_exp_elt_sym (ps, sym);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE); }
;

qualified_name: typebase COLONCOLON name
@@ -682,10 +692,10 @@ qualified_name: typebase COLONCOLON name
error (_("`%s' is not defined as an aggregate type."),
TYPE_NAME (type));

- write_exp_elt_opcode (OP_SCOPE);
- write_exp_elt_type (type);
- write_exp_string ($3);
- write_exp_elt_opcode (OP_SCOPE);
+ write_exp_elt_opcode (ps, OP_SCOPE);
+ write_exp_elt_type (ps, type);
+ write_exp_string (ps, $3);
+ write_exp_elt_opcode (ps, OP_SCOPE);
}
;

@@ -701,16 +711,16 @@ variable: qualified_name
VAR_DOMAIN, (int *) NULL);
if (sym)
{
- write_exp_elt_opcode (OP_VAR_VALUE);
- write_exp_elt_block (NULL);
- write_exp_elt_sym (sym);
- write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE);
+ write_exp_elt_block (ps, NULL);
+ write_exp_elt_sym (ps, sym);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE);
break;
}

msymbol = lookup_minimal_symbol (name, 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. "
@@ -734,13 +744,13 @@ variable: name_not_typename
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);
current_type = sym->type; }
else if ($1.is_a_field_of_this)
{
@@ -753,13 +763,13 @@ variable: name_not_typename
|| contained_in (block_found,
innermost_block))
innermost_block = block_found;
- write_exp_elt_opcode (OP_THIS);
- write_exp_elt_opcode (OP_THIS);
- write_exp_elt_opcode (STRUCTOP_PTR);
- write_exp_string ($1.stoken);
- write_exp_elt_opcode (STRUCTOP_PTR);
+ write_exp_elt_opcode (ps, OP_THIS);
+ write_exp_elt_opcode (ps, OP_THIS);
+ write_exp_elt_opcode (ps, STRUCTOP_PTR);
+ write_exp_string (ps, $1.stoken);
+ write_exp_elt_opcode (ps, STRUCTOP_PTR);
/* We need type of this. */
- this_val = value_of_this_silent (parse_language);
+ this_val = value_of_this_silent (parse_language (ps));
if (this_val)
this_type = value_type (this_val);
else
@@ -779,7 +789,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. "
@@ -848,7 +858,8 @@ name_not_typename : NAME
/*** Needs some error checking for the float case ***/

static int
-parse_number (char *p, int len, int parsed_float, YYSTYPE *putithere)
+parse_number (struct parser_state *ps, char *p, int len, int parsed_float,
+ YYSTYPE *putithere)
{
/* FIXME: Shouldn't these be unsigned? We don't deal with negative values
here, and we do kind of silly things like cast to unsigned. */
@@ -873,7 +884,7 @@ parse_number (char *p, int len, int parsed_float, YYSTYPE *putithere)

if (parsed_float)
{
- if (! parse_c_float (parse_gdbarch, p, len,
+ if (! parse_c_float (parse_gdbarch (ps), p, len,
&putithere->typed_val_float.dval,
&putithere->typed_val_float.type))
return ERROR;
@@ -979,9 +990,9 @@ parse_number (char *p, int len, int parsed_float, YYSTYPE *putithere)

un = (ULONGEST)n >> 2;
if (long_p == 0
- && (un >> (gdbarch_int_bit (parse_gdbarch) - 2)) == 0)
+ && (un >> (gdbarch_int_bit (parse_gdbarch (ps)) - 2)) == 0)
{
- high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch) - 1);
+ high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (ps)) - 1);

/* A large decimal (not hex or octal) constant (between INT_MAX
and UINT_MAX) is a long or unsigned long, according to ANSI,
@@ -989,28 +1000,28 @@ parse_number (char *p, int len, int parsed_float, YYSTYPE *putithere)
int. This probably should be fixed. GCC gives a warning on
such constants. */

- unsigned_type = parse_type->builtin_unsigned_int;
- signed_type = parse_type->builtin_int;
+ unsigned_type = parse_type (ps)->builtin_unsigned_int;
+ signed_type = parse_type (ps)->builtin_int;
}
else if (long_p <= 1
- && (un >> (gdbarch_long_bit (parse_gdbarch) - 2)) == 0)
+ && (un >> (gdbarch_long_bit (parse_gdbarch (ps)) - 2)) == 0)
{
- 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
{
int shift;
if (sizeof (ULONGEST) * HOST_CHAR_BIT
- < gdbarch_long_long_bit (parse_gdbarch))
+ < gdbarch_long_long_bit (parse_gdbarch (ps)))
/* A long long does not fit in a LONGEST. */
shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
else
- shift = (gdbarch_long_long_bit (parse_gdbarch) - 1);
+ shift = (gdbarch_long_long_bit (parse_gdbarch (ps)) - 1);
high_bit = (ULONGEST) 1 << shift;
- unsigned_type = parse_type->builtin_unsigned_long_long;
- signed_type = parse_type->builtin_long_long;
+ unsigned_type = parse_type (ps)->builtin_unsigned_long_long;
+ signed_type = parse_type (ps)->builtin_long_long;
}

putithere->typed_val_int.val = n;
@@ -1093,9 +1104,7 @@ static const struct token tokentab2[] =

/* Allocate uppercased var: */
/* make an uppercased copy of tokstart. */
-static char * uptok (tokstart, namelen)
- char *tokstart;
- int namelen;
+static char * uptok (char *tokstart, int namelen)
{
int i;
char *uptokstart = (char *)malloc(namelen+1);
@@ -1118,7 +1127,7 @@ static int last_was_structop;
/* Read one token, getting characters through lexptr. */

static int
-yylex (void)
+yylex (struct parser_state *ps)
{
int c;
int namelen;
@@ -1185,12 +1194,12 @@ yylex (void)
lexptr++;
c = *lexptr++;
if (c == '\\')
- c = parse_escape (parse_gdbarch, &lexptr);
+ c = parse_escape (parse_gdbarch (ps), &lexptr);
else if (c == '\'')
error (_("Empty character constant."));

yylval.typed_val_int.val = c;
- yylval.typed_val_int.type = parse_type->builtin_char;
+ yylval.typed_val_int.type = parse_type (ps)->builtin_char;

c = *lexptr++;
if (c != '\'')
@@ -1290,7 +1299,7 @@ yylex (void)
&& (*p < 'A' || *p > 'Z')))
break;
}
- toktype = parse_number (tokstart,
+ toktype = parse_number (ps, tokstart,
p - tokstart, got_dot | got_e, &yylval);
if (toktype == ERROR)
{
@@ -1357,7 +1366,7 @@ yylex (void)
break;
case '\\':
tokptr++;
- c = parse_escape (parse_gdbarch, &tokptr);
+ c = parse_escape (parse_gdbarch (ps), &tokptr);
if (c == -1)
{
continue;
@@ -1499,7 +1508,7 @@ yylex (void)
but this conflicts with the GDB use for debugger variables
so in expression to enter hexadecimal values
we still need to use C syntax with 0xff */
- write_dollar_variable (yylval.sval);
+ write_dollar_variable (ps, yylval.sval);
c = tokstart[namelen];
tokstart[namelen] = 0;
intvar = lookup_only_internalvar (++tokstart);
@@ -1697,8 +1706,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)
{
free (uptokstart);
@@ -1713,7 +1722,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;
@@ -1732,8 +1741,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/p-lang.h b/gdb/p-lang.h
index 308b7b5..d07a249 100644
--- a/gdb/p-lang.h
+++ b/gdb/p-lang.h
@@ -20,13 +20,15 @@
/* This file is derived from c-lang.h */

struct value;
+struct parser_state;

/* Defined in p-lang.c */
extern const char *pascal_main_name (void);

-extern int pascal_parse (void); /* Defined in p-exp.y */
+extern int pascal_parse (struct parser_state *); /* Defined in p-exp.y */

-extern void pascal_error (char *); /* Defined in p-exp.y */
+extern void pascal_error (struct parser_state *, char *); /* Defined
+ in p-exp.y */

/* Defined in p-typeprint.c */
extern void pascal_print_type (struct type *, const char *, struct ui_file *,