diff mbox

[v4,09/10] Pascal language

Message ID 1395463432-29750-10-git-send-email-sergiodj@redhat.com
State Committed
Headers show

Commit Message

Sergio Durigan Junior March 22, 2014, 4:43 a.m. UTC
Patch for the Pascal language.  Similar to the C language one.

2014-03-22  Sergio Durigan Junior  <sergiodj@redhat.com>

	* p-exp.y (parse_type): Rewrite macro to use parser state.
	(yyparse): Redefine macro to pascal_parse_internal.
	(pstate): New variable.
	(parse_number): Add "struct parser_state" argument.
	(type_exp, exp1, exp, qualified_name, variable): Update calls to
	write_exp* and similars in order to use parser state.
	(parse_number, yylex): Adjust code to use parser state.
	(pascal_parse): New function.
	* p-lang.h: Forward declare "struct parser_state".
	(pascal_parse): Add "struct parser_state" argument.
---
 gdb/p-exp.y  | 352 +++++++++++++++++++++++++++++++++--------------------------
 gdb/p-lang.h |   3 +-
 2 files changed, 197 insertions(+), 158 deletions(-)
diff mbox

Patch

diff --git a/gdb/p-exp.y b/gdb/p-exp.y
index f1c91ba..4e8f96c 100644
--- a/gdb/p-exp.y
+++ b/gdb/p-exp.y
@@ -57,7 +57,7 @@ 
 #include "block.h"
 #include "completer.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
@@ -67,7 +67,7 @@ 
    generators need to be fixed instead of adding those names to this list.  */
 
 #define	yymaxdepth pascal_maxdepth
-#define	yyparse	pascal_parse
+#define	yyparse	pascal_parse_internal
 #define	yylex	pascal_lex
 #define	yyerror	pascal_error
 #define	yylval	pascal_lval
@@ -119,6 +119,11 @@ 
 
 #define YYFPRINTF parser_fprintf
 
+/* The state of the parser, used internally when we are parsing the
+   expression.  */
+
+static struct parser_state *pstate = NULL;
+
 int yyparse (void);
 
 static int yylex (void);
@@ -159,7 +164,8 @@  static char *uptok (const char *, int);
 
 %{
 /* YYSTYPE gets defined by %union */
-static int parse_number (const char *, int, int, YYSTYPE *);
+static int parse_number (struct parser_state *,
+			 const char *, int, int, YYSTYPE *);
 
 static struct type *current_type;
 static struct internalvar *intvar;
@@ -252,44 +258,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 (pstate, OP_TYPE);
+			  write_exp_elt_type (pstate, $1);
+			  write_exp_elt_opcode (pstate, OP_TYPE);
 			  current_type = $1; } ;
 
 /* Expressions, including the comma operator.  */
 exp1	:	exp
 	|	exp1 ',' exp
-			{ write_exp_elt_opcode (BINOP_COMMA); }
+			{ write_exp_elt_opcode (pstate, BINOP_COMMA); }
 	;
 
 /* Expressions, not including the comma operator.  */
 exp	:	exp '^'   %prec UNARY
-			{ write_exp_elt_opcode (UNOP_IND);
+			{ write_exp_elt_opcode (pstate, 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 (pstate, 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 (pstate, UNOP_NEG); }
 	;
 
 exp	:	NOT exp    %prec UNARY
-			{ write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
+			{ write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
 	;
 
 exp	:	INCREMENT '(' exp ')'   %prec UNARY
-			{ write_exp_elt_opcode (UNOP_PREINCREMENT); }
+			{ write_exp_elt_opcode (pstate, UNOP_PREINCREMENT); }
 	;
 
 exp	:	DECREMENT  '(' exp ')'   %prec UNARY
-			{ write_exp_elt_opcode (UNOP_PREDECREMENT); }
+			{ write_exp_elt_opcode (pstate, UNOP_PREDECREMENT); }
 	;
 
 
@@ -298,9 +304,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 (pstate, STRUCTOP_STRUCT);
+			  write_exp_string (pstate, $2);
+			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
 			  search_field = 0;
 			  if (current_type)
 			    {
@@ -316,9 +322,9 @@  exp	:	field_exp FIELDNAME
 
 
 exp	:	field_exp name
-			{ write_exp_elt_opcode (STRUCTOP_STRUCT);
-			  write_exp_string ($2);
-			  write_exp_elt_opcode (STRUCTOP_STRUCT);
+			{ write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
+			  write_exp_string (pstate, $2);
+			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
 			  search_field = 0;
 			  if (current_type)
 			    {
@@ -332,19 +338,19 @@  exp	:	field_exp name
 			}
 	;
 exp	:	field_exp  name COMPLETE
-			{ mark_struct_expression ();
-			  write_exp_elt_opcode (STRUCTOP_STRUCT);
-			  write_exp_string ($2);
-			  write_exp_elt_opcode (STRUCTOP_STRUCT); }
+			{ mark_struct_expression (pstate);
+			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
+			  write_exp_string (pstate, $2);
+			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
 	;
 exp	:	field_exp COMPLETE
 			{ struct stoken s;
-			  mark_struct_expression ();
-			  write_exp_elt_opcode (STRUCTOP_STRUCT);
+			  mark_struct_expression (pstate);
+			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
 			  s.ptr = "";
 			  s.length = 0;
-			  write_exp_string (s);
-			  write_exp_elt_opcode (STRUCTOP_STRUCT); }
+			  write_exp_string (pstate, s);
+			  write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
 	;
 
 exp	:	exp '['
@@ -365,14 +371,14 @@  exp	:	exp '['
 			      strcpy (buf, 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 (pstate, STRUCTOP_STRUCT);
+			      write_exp_string (pstate, stringsval);
+			      write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
 			    }
 			  push_current_type ();  }
 		exp1 ']'
 			{ pop_current_type ();
-			  write_exp_elt_opcode (BINOP_SUBSCRIPT);
+			  write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT);
 			  if (current_type)
 			    current_type = TYPE_TARGET_TYPE (current_type); }
 	;
@@ -383,9 +389,10 @@  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 (pstate, OP_FUNCALL);
+			  write_exp_elt_longcst (pstate,
+						 (LONGEST) end_arglist ());
+			  write_exp_elt_opcode (pstate, OP_FUNCALL);
 			  pop_current_type ();
 			  if (current_type)
  	  		    current_type = TYPE_TARGET_TYPE (current_type);
@@ -406,11 +413,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 (pstate, UNOP_IND);
 			    }
-			  write_exp_elt_opcode (UNOP_CAST);
-			  write_exp_elt_type ($1);
-			  write_exp_elt_opcode (UNOP_CAST);
+			  write_exp_elt_opcode (pstate, UNOP_CAST);
+			  write_exp_elt_type (pstate, $1);
+			  write_exp_elt_opcode (pstate, UNOP_CAST);
 			  current_type = $1; }
 	;
 
@@ -421,7 +428,7 @@  exp	:	'(' exp1 ')'
 /* Binary operators in order of decreasing precedence.  */
 
 exp	:	exp '*' exp
-			{ write_exp_elt_opcode (BINOP_MUL); }
+			{ write_exp_elt_opcode (pstate, BINOP_MUL); }
 	;
 
 exp	:	exp '/' {
@@ -433,135 +440,138 @@  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 (pstate, UNOP_CAST);
+			      write_exp_elt_type (pstate,
+						  parse_type (pstate)
+						  ->builtin_long_double);
+			      current_type
+				= parse_type (pstate)->builtin_long_double;
+			      write_exp_elt_opcode (pstate, UNOP_CAST);
 			      leftdiv_is_integer = 0;
 			    }
 
-			  write_exp_elt_opcode (BINOP_DIV);
+			  write_exp_elt_opcode (pstate, BINOP_DIV);
 			}
 	;
 
 exp	:	exp DIV exp
-			{ write_exp_elt_opcode (BINOP_INTDIV); }
+			{ write_exp_elt_opcode (pstate, BINOP_INTDIV); }
 	;
 
 exp	:	exp MOD exp
-			{ write_exp_elt_opcode (BINOP_REM); }
+			{ write_exp_elt_opcode (pstate, BINOP_REM); }
 	;
 
 exp	:	exp '+' exp
-			{ write_exp_elt_opcode (BINOP_ADD); }
+			{ write_exp_elt_opcode (pstate, BINOP_ADD); }
 	;
 
 exp	:	exp '-' exp
-			{ write_exp_elt_opcode (BINOP_SUB); }
+			{ write_exp_elt_opcode (pstate, BINOP_SUB); }
 	;
 
 exp	:	exp LSH exp
-			{ write_exp_elt_opcode (BINOP_LSH); }
+			{ write_exp_elt_opcode (pstate, BINOP_LSH); }
 	;
 
 exp	:	exp RSH exp
-			{ write_exp_elt_opcode (BINOP_RSH); }
+			{ write_exp_elt_opcode (pstate, BINOP_RSH); }
 	;
 
 exp	:	exp '=' exp
-			{ write_exp_elt_opcode (BINOP_EQUAL);
-			  current_type = parse_type->builtin_bool;
+			{ write_exp_elt_opcode (pstate, BINOP_EQUAL);
+			  current_type = parse_type (pstate)->builtin_bool;
 			}
 	;
 
 exp	:	exp NOTEQUAL exp
-			{ write_exp_elt_opcode (BINOP_NOTEQUAL);
-			  current_type = parse_type->builtin_bool;
+			{ write_exp_elt_opcode (pstate, BINOP_NOTEQUAL);
+			  current_type = parse_type (pstate)->builtin_bool;
 			}
 	;
 
 exp	:	exp LEQ exp
-			{ write_exp_elt_opcode (BINOP_LEQ);
-			  current_type = parse_type->builtin_bool;
+			{ write_exp_elt_opcode (pstate, BINOP_LEQ);
+			  current_type = parse_type (pstate)->builtin_bool;
 			}
 	;
 
 exp	:	exp GEQ exp
-			{ write_exp_elt_opcode (BINOP_GEQ);
-			  current_type = parse_type->builtin_bool;
+			{ write_exp_elt_opcode (pstate, BINOP_GEQ);
+			  current_type = parse_type (pstate)->builtin_bool;
 			}
 	;
 
 exp	:	exp '<' exp
-			{ write_exp_elt_opcode (BINOP_LESS);
-			  current_type = parse_type->builtin_bool;
+			{ write_exp_elt_opcode (pstate, BINOP_LESS);
+			  current_type = parse_type (pstate)->builtin_bool;
 			}
 	;
 
 exp	:	exp '>' exp
-			{ write_exp_elt_opcode (BINOP_GTR);
-			  current_type = parse_type->builtin_bool;
+			{ write_exp_elt_opcode (pstate, BINOP_GTR);
+			  current_type = parse_type (pstate)->builtin_bool;
 			}
 	;
 
 exp	:	exp ANDAND exp
-			{ write_exp_elt_opcode (BINOP_BITWISE_AND); }
+			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
 	;
 
 exp	:	exp XOR exp
-			{ write_exp_elt_opcode (BINOP_BITWISE_XOR); }
+			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
 	;
 
 exp	:	exp OR exp
-			{ write_exp_elt_opcode (BINOP_BITWISE_IOR); }
+			{ write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
 	;
 
 exp	:	exp ASSIGN exp
-			{ write_exp_elt_opcode (BINOP_ASSIGN); }
+			{ write_exp_elt_opcode (pstate, 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 (pstate, OP_BOOL);
+			  write_exp_elt_longcst (pstate, (LONGEST) $1);
+			  current_type = parse_type (pstate)->builtin_bool;
+			  write_exp_elt_opcode (pstate, 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 (pstate, OP_BOOL);
+			  write_exp_elt_longcst (pstate, (LONGEST) $1);
+			  current_type = parse_type (pstate)->builtin_bool;
+			  write_exp_elt_opcode (pstate, OP_BOOL); }
 	;
 
 exp	:	INT
-			{ write_exp_elt_opcode (OP_LONG);
-			  write_exp_elt_type ($1.type);
+			{ write_exp_elt_opcode (pstate, OP_LONG);
+			  write_exp_elt_type (pstate, $1.type);
 			  current_type = $1.type;
-			  write_exp_elt_longcst ((LONGEST)($1.val));
-			  write_exp_elt_opcode (OP_LONG); }
+			  write_exp_elt_longcst (pstate, (LONGEST)($1.val));
+			  write_exp_elt_opcode (pstate, OP_LONG); }
 	;
 
 exp	:	NAME_OR_INT
 			{ YYSTYPE val;
-			  parse_number ($1.stoken.ptr,
+			  parse_number (pstate, $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 (pstate, OP_LONG);
+			  write_exp_elt_type (pstate, val.typed_val_int.type);
 			  current_type = val.typed_val_int.type;
-			  write_exp_elt_longcst ((LONGEST)
+			  write_exp_elt_longcst (pstate, (LONGEST)
 						 val.typed_val_int.val);
-			  write_exp_elt_opcode (OP_LONG);
+			  write_exp_elt_opcode (pstate, OP_LONG);
 			}
 	;
 
 
 exp	:	FLOAT
-			{ write_exp_elt_opcode (OP_DOUBLE);
-			  write_exp_elt_type ($1.type);
+			{ write_exp_elt_opcode (pstate, OP_DOUBLE);
+			  write_exp_elt_type (pstate, $1.type);
 			  current_type = $1.type;
-			  write_exp_elt_dblcst ($1.dval);
-			  write_exp_elt_opcode (OP_DOUBLE); }
+			  write_exp_elt_dblcst (pstate, $1.dval);
+			  write_exp_elt_opcode (pstate, OP_DOUBLE); }
 	;
 
 exp	:	variable
@@ -574,7 +584,7 @@  exp	:	VARIABLE
  			     struct value * val, * mark;
 
 			     mark = value_mark ();
- 			     val = value_of_internalvar (parse_gdbarch,
+ 			     val = value_of_internalvar (parse_gdbarch (pstate),
  							 intvar);
  			     current_type = value_type (val);
 			     value_release_to_mark (mark);
@@ -583,17 +593,19 @@  exp	:	VARIABLE
  	;
 
 exp	:	SIZEOF '(' type ')'	%prec UNARY
-			{ write_exp_elt_opcode (OP_LONG);
-			  write_exp_elt_type (parse_type->builtin_int);
-			  current_type = parse_type->builtin_int;
+			{ write_exp_elt_opcode (pstate, OP_LONG);
+			  write_exp_elt_type (pstate,
+					    parse_type (pstate)->builtin_int);
+			  current_type = parse_type (pstate)->builtin_int;
 			  CHECK_TYPEDEF ($3);
-			  write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
-			  write_exp_elt_opcode (OP_LONG); }
+			  write_exp_elt_longcst (pstate,
+						 (LONGEST) TYPE_LENGTH ($3));
+			  write_exp_elt_opcode (pstate, OP_LONG); }
 	;
 
 exp	:	SIZEOF  '(' exp ')'      %prec UNARY
-			{ write_exp_elt_opcode (UNOP_SIZEOF);
-			  current_type = parse_type->builtin_int; }
+			{ write_exp_elt_opcode (pstate, UNOP_SIZEOF);
+			  current_type = parse_type (pstate)->builtin_int; }
 
 exp	:	STRING
 			{ /* C strings are converted into array constants with
@@ -605,19 +617,25 @@  exp	:	STRING
 
 			  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 (pstate, OP_LONG);
+			      write_exp_elt_type (pstate,
+						  parse_type (pstate)
+						  ->builtin_char);
+			      write_exp_elt_longcst (pstate,
+						     (LONGEST) (*sp++));
+			      write_exp_elt_opcode (pstate, 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 (pstate, OP_LONG);
+			  write_exp_elt_type (pstate,
+					      parse_type (pstate)
+					      ->builtin_char);
+			  write_exp_elt_longcst (pstate, (LONGEST)'\0');
+			  write_exp_elt_opcode (pstate, OP_LONG);
+			  write_exp_elt_opcode (pstate, OP_ARRAY);
+			  write_exp_elt_longcst (pstate, (LONGEST) 0);
+			  write_exp_elt_longcst (pstate,
+						 (LONGEST) ($1.length));
+			  write_exp_elt_opcode (pstate, OP_ARRAY); }
 	;
 
 /* Object pascal  */
@@ -625,10 +643,11 @@  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 (pstate, OP_THIS);
+			  write_exp_elt_opcode (pstate, OP_THIS);
 			  /* We need type of this.  */
-			  this_val = value_of_this_silent (parse_language);
+			  this_val
+			    = value_of_this_silent (parse_language (pstate));
 			  if (this_val)
 			    this_type = value_type (this_val);
 			  else
@@ -638,7 +657,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 (pstate, UNOP_IND);
 				}
 			    }
 
@@ -684,11 +703,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 (pstate, 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 (pstate, block_found);
+			  write_exp_elt_sym (pstate, sym);
+			  write_exp_elt_opcode (pstate, OP_VAR_VALUE); }
 	;
 
 qualified_name:	typebase COLONCOLON name
@@ -699,10 +718,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 (pstate, OP_SCOPE);
+			  write_exp_elt_type (pstate, type);
+			  write_exp_string (pstate, $3);
+			  write_exp_elt_opcode (pstate, OP_SCOPE);
 			}
 	;
 
@@ -718,16 +737,16 @@  variable:	qualified_name
 					   VAR_DOMAIN, 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 (pstate, OP_VAR_VALUE);
+			      write_exp_elt_block (pstate, NULL);
+			      write_exp_elt_sym (pstate, sym);
+			      write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 			      break;
 			    }
 
 			  msymbol = lookup_bound_minimal_symbol (name);
 			  if (msymbol.minsym != NULL)
-			    write_exp_msymbol (msymbol);
+			    write_exp_msymbol (pstate, msymbol);
 			  else if (!have_full_symbols ()
 				   && !have_partial_symbols ())
 			    error (_("No symbol table is loaded.  "
@@ -751,13 +770,13 @@  variable:	name_not_typename
 				    innermost_block = block_found;
 				}
 
-			      write_exp_elt_opcode (OP_VAR_VALUE);
+			      write_exp_elt_opcode (pstate, 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 (pstate, NULL);
+			      write_exp_elt_sym (pstate, sym);
+			      write_exp_elt_opcode (pstate, OP_VAR_VALUE);
 			      current_type = sym->type; }
 			  else if ($1.is_a_field_of_this)
 			    {
@@ -770,13 +789,14 @@  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 (pstate, OP_THIS);
+			      write_exp_elt_opcode (pstate, OP_THIS);
+			      write_exp_elt_opcode (pstate, STRUCTOP_PTR);
+			      write_exp_string (pstate, $1.stoken);
+			      write_exp_elt_opcode (pstate, STRUCTOP_PTR);
 			      /* We need type of this.  */
-			      this_val = value_of_this_silent (parse_language);
+			      this_val
+				= value_of_this_silent (parse_language (pstate));
 			      if (this_val)
 				this_type = value_type (this_val);
 			      else
@@ -796,7 +816,7 @@  variable:	name_not_typename
 			      msymbol =
 				lookup_bound_minimal_symbol (arg);
 			      if (msymbol.minsym != NULL)
-				write_exp_msymbol (msymbol);
+				write_exp_msymbol (pstate, msymbol);
 			      else if (!have_full_symbols ()
 				       && !have_partial_symbols ())
 				error (_("No symbol table is loaded.  "
@@ -865,7 +885,8 @@  name_not_typename :	NAME
 /*** Needs some error checking for the float case ***/
 
 static int
-parse_number (const char *p, int len, int parsed_float, YYSTYPE *putithere)
+parse_number (struct parser_state *par_state,
+	      const 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.  */
@@ -890,7 +911,7 @@  parse_number (const 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 (par_state), p, len,
 			   &putithere->typed_val_float.dval,
 			   &putithere->typed_val_float.type))
 	return ERROR;
@@ -996,9 +1017,10 @@  parse_number (const 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 (par_state)) - 2)) == 0)
     {
-      high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch) - 1);
+      high_bit
+	= ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (par_state)) - 1);
 
       /* A large decimal (not hex or octal) constant (between INT_MAX
 	 and UINT_MAX) is a long or unsigned long, according to ANSI,
@@ -1006,28 +1028,29 @@  parse_number (const 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 (par_state)->builtin_unsigned_int;
+      signed_type = parse_type (par_state)->builtin_int;
     }
   else if (long_p <= 1
-	   && (un >> (gdbarch_long_bit (parse_gdbarch) - 2)) == 0)
+	   && (un >> (gdbarch_long_bit (parse_gdbarch (par_state)) - 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 (par_state)) - 1);
+      unsigned_type = parse_type (par_state)->builtin_unsigned_long;
+      signed_type = parse_type (par_state)->builtin_long;
     }
   else
     {
       int shift;
       if (sizeof (ULONGEST) * HOST_CHAR_BIT
-	  < gdbarch_long_long_bit (parse_gdbarch))
+	  < gdbarch_long_long_bit (parse_gdbarch (par_state)))
 	/* 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 (par_state)) - 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 (par_state)->builtin_unsigned_long_long;
+      signed_type = parse_type (par_state)->builtin_long_long;
     }
 
    putithere->typed_val_int.val = n;
@@ -1195,12 +1218,12 @@  yylex (void)
       lexptr++;
       c = *lexptr++;
       if (c == '\\')
-	c = parse_escape (parse_gdbarch, &lexptr);
+	c = parse_escape (parse_gdbarch (pstate), &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 (pstate)->builtin_char;
 
       c = *lexptr++;
       if (c != '\'')
@@ -1298,7 +1321,7 @@  yylex (void)
 				  && (*p < 'A' || *p > 'Z')))
 	      break;
 	  }
-	toktype = parse_number (tokstart,
+	toktype = parse_number (pstate, tokstart,
 				p - tokstart, got_dot | got_e, &yylval);
         if (toktype == ERROR)
 	  {
@@ -1365,7 +1388,7 @@  yylex (void)
 	    break;
 	  case '\\':
 	    ++tokptr;
-	    c = parse_escape (parse_gdbarch, &tokptr);
+	    c = parse_escape (parse_gdbarch (pstate), &tokptr);
 	    if (c == -1)
 	      {
 		continue;
@@ -1508,7 +1531,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 (pstate, yylval.sval);
       tmp = alloca (namelen + 1);
       memcpy (tmp, tokstart, namelen);
       tmp[namelen] = '\0';
@@ -1688,8 +1711,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 (pstate),
+						parse_gdbarch (pstate), tmp);
     if (yylval.tsym.type != NULL)
       {
 	free (uptokstart);
@@ -1704,7 +1727,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 (pstate, tokstart, namelen, 0, &newlval);
 	if (hextype == INT)
 	  {
 	    yylval.ssym.sym = sym;
@@ -1722,6 +1745,21 @@  yylex (void)
   }
 }
 
+int
+pascal_parse (struct parser_state *par_state)
+{
+  int result;
+  struct cleanup *c = make_cleanup_clear_parser_state (&pstate);
+
+  /* Setting up the parser state.  */
+  gdb_assert (par_state != NULL);
+  pstate = par_state;
+
+  result = yyparse ();
+  do_cleanups (c);
+  return result;
+}
+
 void
 yyerror (char *msg)
 {
diff --git a/gdb/p-lang.h b/gdb/p-lang.h
index 1a94b8f..ea2d37c 100644
--- a/gdb/p-lang.h
+++ b/gdb/p-lang.h
@@ -20,11 +20,12 @@ 
 /* 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 */