xref: /dragonfly/contrib/gdb-7/gdb/p-exp.y (revision 10f4bf95)
1 /* YACC parser for Pascal expressions, for GDB.
2    Copyright (C) 2000, 2006, 2007, 2008, 2009, 2010
3    Free Software Foundation, Inc.
4 
5    This file is part of GDB.
6 
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11 
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16 
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19 
20 /* This file is derived from c-exp.y */
21 
22 /* Parse a Pascal expression from text in a string,
23    and return the result as a  struct expression  pointer.
24    That structure contains arithmetic operations in reverse polish,
25    with constants represented by operations that are followed by special data.
26    See expression.h for the details of the format.
27    What is important here is that it can be built up sequentially
28    during the process of parsing; the lower levels of the tree always
29    come first in the result.
30 
31    Note that malloc's and realloc's in this file are transformed to
32    xmalloc and xrealloc respectively by the same sed command in the
33    makefile that remaps any other malloc/realloc inserted by the parser
34    generator.  Doing this with #defines and trying to control the interaction
35    with include files (<malloc.h> and <stdlib.h> for example) just became
36    too messy, particularly when such includes can be inserted at random
37    times by the parser generator.  */
38 
39 /* Known bugs or limitations:
40     - pascal string operations are not supported at all.
41     - there are some problems with boolean types.
42     - Pascal type hexadecimal constants are not supported
43       because they conflict with the internal variables format.
44    Probably also lots of other problems, less well defined PM */
45 %{
46 
47 #include "defs.h"
48 #include "gdb_string.h"
49 #include <ctype.h>
50 #include "expression.h"
51 #include "value.h"
52 #include "parser-defs.h"
53 #include "language.h"
54 #include "p-lang.h"
55 #include "bfd.h" /* Required by objfiles.h.  */
56 #include "symfile.h" /* Required by objfiles.h.  */
57 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
58 #include "block.h"
59 
60 #define parse_type builtin_type (parse_gdbarch)
61 
62 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
63    as well as gratuitiously global symbol names, so we can have multiple
64    yacc generated parsers in gdb.  Note that these are only the variables
65    produced by yacc.  If other parser generators (bison, byacc, etc) produce
66    additional global names that conflict at link time, then those parser
67    generators need to be fixed instead of adding those names to this list. */
68 
69 #define	yymaxdepth pascal_maxdepth
70 #define	yyparse	pascal_parse
71 #define	yylex	pascal_lex
72 #define	yyerror	pascal_error
73 #define	yylval	pascal_lval
74 #define	yychar	pascal_char
75 #define	yydebug	pascal_debug
76 #define	yypact	pascal_pact
77 #define	yyr1	pascal_r1
78 #define	yyr2	pascal_r2
79 #define	yydef	pascal_def
80 #define	yychk	pascal_chk
81 #define	yypgo	pascal_pgo
82 #define	yyact	pascal_act
83 #define	yyexca	pascal_exca
84 #define yyerrflag pascal_errflag
85 #define yynerrs	pascal_nerrs
86 #define	yyps	pascal_ps
87 #define	yypv	pascal_pv
88 #define	yys	pascal_s
89 #define	yy_yys	pascal_yys
90 #define	yystate	pascal_state
91 #define	yytmp	pascal_tmp
92 #define	yyv	pascal_v
93 #define	yy_yyv	pascal_yyv
94 #define	yyval	pascal_val
95 #define	yylloc	pascal_lloc
96 #define yyreds	pascal_reds		/* With YYDEBUG defined */
97 #define yytoks	pascal_toks		/* With YYDEBUG defined */
98 #define yyname	pascal_name		/* With YYDEBUG defined */
99 #define yyrule	pascal_rule		/* With YYDEBUG defined */
100 #define yylhs	pascal_yylhs
101 #define yylen	pascal_yylen
102 #define yydefred pascal_yydefred
103 #define yydgoto	pascal_yydgoto
104 #define yysindex pascal_yysindex
105 #define yyrindex pascal_yyrindex
106 #define yygindex pascal_yygindex
107 #define yytable	 pascal_yytable
108 #define yycheck	 pascal_yycheck
109 
110 #ifndef YYDEBUG
111 #define	YYDEBUG 1		/* Default to yydebug support */
112 #endif
113 
114 #define YYFPRINTF parser_fprintf
115 
116 int yyparse (void);
117 
118 static int yylex (void);
119 
120 void
121 yyerror (char *);
122 
123 static char * uptok (char *, int);
124 %}
125 
126 /* Although the yacc "value" of an expression is not used,
127    since the result is stored in the structure being created,
128    other node types do have values.  */
129 
130 %union
131   {
132     LONGEST lval;
133     struct {
134       LONGEST val;
135       struct type *type;
136     } typed_val_int;
137     struct {
138       DOUBLEST dval;
139       struct type *type;
140     } typed_val_float;
141     struct symbol *sym;
142     struct type *tval;
143     struct stoken sval;
144     struct ttype tsym;
145     struct symtoken ssym;
146     int voidval;
147     struct block *bval;
148     enum exp_opcode opcode;
149     struct internalvar *ivar;
150 
151     struct type **tvec;
152     int *ivec;
153   }
154 
155 %{
156 /* YYSTYPE gets defined by %union */
157 static int
158 parse_number (char *, int, int, YYSTYPE *);
159 
160 static struct type *current_type;
161 static int leftdiv_is_integer;
162 static void push_current_type (void);
163 static void pop_current_type (void);
164 static int search_field;
165 %}
166 
167 %type <voidval> exp exp1 type_exp start normal_start variable qualified_name
168 %type <tval> type typebase
169 /* %type <bval> block */
170 
171 /* Fancy type parsing.  */
172 %type <tval> ptype
173 
174 %token <typed_val_int> INT
175 %token <typed_val_float> FLOAT
176 
177 /* Both NAME and TYPENAME tokens represent symbols in the input,
178    and both convey their data as strings.
179    But a TYPENAME is a string that happens to be defined as a typedef
180    or builtin type name (such as int or char)
181    and a NAME is any other symbol.
182    Contexts where this distinction is not important can use the
183    nonterminal "name", which matches either NAME or TYPENAME.  */
184 
185 %token <sval> STRING
186 %token <sval> FIELDNAME
187 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
188 %token <tsym> TYPENAME
189 %type <sval> name
190 %type <ssym> name_not_typename
191 
192 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
193    but which would parse as a valid number in the current input radix.
194    E.g. "c" when input_radix==16.  Depending on the parse, it will be
195    turned into a name or into a number.  */
196 
197 %token <ssym> NAME_OR_INT
198 
199 %token STRUCT CLASS SIZEOF COLONCOLON
200 %token ERROR
201 
202 /* Special type cases, put in to allow the parser to distinguish different
203    legal basetypes.  */
204 
205 %token <voidval> VARIABLE
206 
207 
208 /* Object pascal */
209 %token THIS
210 %token <lval> TRUEKEYWORD FALSEKEYWORD
211 
212 %left ','
213 %left ABOVE_COMMA
214 %right ASSIGN
215 %left NOT
216 %left OR
217 %left XOR
218 %left ANDAND
219 %left '=' NOTEQUAL
220 %left '<' '>' LEQ GEQ
221 %left LSH RSH DIV MOD
222 %left '@'
223 %left '+' '-'
224 %left '*' '/'
225 %right UNARY INCREMENT DECREMENT
226 %right ARROW '.' '[' '('
227 %left '^'
228 %token <ssym> BLOCKNAME
229 %type <bval> block
230 %left COLONCOLON
231 
232 
233 %%
234 
235 start   :	{ current_type = NULL;
236 		  search_field = 0;
237 		  leftdiv_is_integer = 0;
238 		}
239 		normal_start {}
240 	;
241 
242 normal_start	:
243 		exp1
244 	|	type_exp
245 	;
246 
247 type_exp:	type
248 			{ write_exp_elt_opcode(OP_TYPE);
249 			  write_exp_elt_type($1);
250 			  write_exp_elt_opcode(OP_TYPE);
251 			  current_type = $1; } ;
252 
253 /* Expressions, including the comma operator.  */
254 exp1	:	exp
255 	|	exp1 ',' exp
256 			{ write_exp_elt_opcode (BINOP_COMMA); }
257 	;
258 
259 /* Expressions, not including the comma operator.  */
260 exp	:	exp '^'   %prec UNARY
261 			{ write_exp_elt_opcode (UNOP_IND);
262 			  if (current_type)
263 			    current_type = TYPE_TARGET_TYPE (current_type); }
264 	;
265 
266 exp	:	'@' exp    %prec UNARY
267 			{ write_exp_elt_opcode (UNOP_ADDR);
268 			  if (current_type)
269 			    current_type = TYPE_POINTER_TYPE (current_type); }
270 	;
271 
272 exp	:	'-' exp    %prec UNARY
273 			{ write_exp_elt_opcode (UNOP_NEG); }
274 	;
275 
276 exp	:	NOT exp    %prec UNARY
277 			{ write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
278 	;
279 
280 exp	:	INCREMENT '(' exp ')'   %prec UNARY
281 			{ write_exp_elt_opcode (UNOP_PREINCREMENT); }
282 	;
283 
284 exp	:	DECREMENT  '(' exp ')'   %prec UNARY
285 			{ write_exp_elt_opcode (UNOP_PREDECREMENT); }
286 	;
287 
288 exp	:	exp '.' { search_field = 1; }
289 		FIELDNAME
290 		/* name */
291 			{ write_exp_elt_opcode (STRUCTOP_STRUCT);
292 			  write_exp_string ($4);
293 			  write_exp_elt_opcode (STRUCTOP_STRUCT);
294 			  search_field = 0;
295 			  if (current_type)
296 			    { while (TYPE_CODE (current_type) == TYPE_CODE_PTR)
297 				current_type = TYPE_TARGET_TYPE (current_type);
298 			      current_type = lookup_struct_elt_type (
299 				current_type, $4.ptr, 0); };
300 			 } ;
301 exp	:	exp '['
302 			/* We need to save the current_type value */
303 			{ char *arrayname;
304 			  int arrayfieldindex;
305 			  arrayfieldindex = is_pascal_string_type (
306 				current_type, NULL, NULL,
307 				NULL, NULL, &arrayname);
308 			  if (arrayfieldindex)
309 			    {
310 			      struct stoken stringsval;
311 			      stringsval.ptr = alloca (strlen (arrayname) + 1);
312 			      stringsval.length = strlen (arrayname);
313 			      strcpy (stringsval.ptr, arrayname);
314 			      current_type = TYPE_FIELD_TYPE (current_type,
315 				arrayfieldindex - 1);
316 			      write_exp_elt_opcode (STRUCTOP_STRUCT);
317 			      write_exp_string (stringsval);
318 			      write_exp_elt_opcode (STRUCTOP_STRUCT);
319 			    }
320 			  push_current_type ();  }
321 		exp1 ']'
322 			{ pop_current_type ();
323 			  write_exp_elt_opcode (BINOP_SUBSCRIPT);
324 			  if (current_type)
325 			    current_type = TYPE_TARGET_TYPE (current_type); }
326 	;
327 
328 exp	:	exp '('
329 			/* This is to save the value of arglist_len
330 			   being accumulated by an outer function call.  */
331 			{ push_current_type ();
332 			  start_arglist (); }
333 		arglist ')'	%prec ARROW
334 			{ write_exp_elt_opcode (OP_FUNCALL);
335 			  write_exp_elt_longcst ((LONGEST) end_arglist ());
336 			  write_exp_elt_opcode (OP_FUNCALL);
337 			  pop_current_type ();
338 			  if (current_type)
339  	  		    current_type = TYPE_TARGET_TYPE (current_type);
340 			}
341 	;
342 
343 arglist	:
344          | exp
345 			{ arglist_len = 1; }
346 	 | arglist ',' exp   %prec ABOVE_COMMA
347 			{ arglist_len++; }
348 	;
349 
350 exp	:	type '(' exp ')' %prec UNARY
351 			{ if (current_type)
352 			    {
353 			      /* Allow automatic dereference of classes.  */
354 			      if ((TYPE_CODE (current_type) == TYPE_CODE_PTR)
355 				  && (TYPE_CODE (TYPE_TARGET_TYPE (current_type)) == TYPE_CODE_CLASS)
356 				  && (TYPE_CODE ($1) == TYPE_CODE_CLASS))
357 				write_exp_elt_opcode (UNOP_IND);
358 			    }
359 			  write_exp_elt_opcode (UNOP_CAST);
360 			  write_exp_elt_type ($1);
361 			  write_exp_elt_opcode (UNOP_CAST);
362 			  current_type = $1; }
363 	;
364 
365 exp	:	'(' exp1 ')'
366 			{ }
367 	;
368 
369 /* Binary operators in order of decreasing precedence.  */
370 
371 exp	:	exp '*' exp
372 			{ write_exp_elt_opcode (BINOP_MUL); }
373 	;
374 
375 exp	:	exp '/' {
376 			  if (current_type && is_integral_type (current_type))
377 			    leftdiv_is_integer = 1;
378 			}
379 		exp
380 			{
381 			  if (leftdiv_is_integer && current_type
382 			      && is_integral_type (current_type))
383 			    {
384 			      write_exp_elt_opcode (UNOP_CAST);
385 			      write_exp_elt_type (parse_type->builtin_long_double);
386 			      current_type = parse_type->builtin_long_double;
387 			      write_exp_elt_opcode (UNOP_CAST);
388 			      leftdiv_is_integer = 0;
389 			    }
390 
391 			  write_exp_elt_opcode (BINOP_DIV);
392 			}
393 	;
394 
395 exp	:	exp DIV exp
396 			{ write_exp_elt_opcode (BINOP_INTDIV); }
397 	;
398 
399 exp	:	exp MOD exp
400 			{ write_exp_elt_opcode (BINOP_REM); }
401 	;
402 
403 exp	:	exp '+' exp
404 			{ write_exp_elt_opcode (BINOP_ADD); }
405 	;
406 
407 exp	:	exp '-' exp
408 			{ write_exp_elt_opcode (BINOP_SUB); }
409 	;
410 
411 exp	:	exp LSH exp
412 			{ write_exp_elt_opcode (BINOP_LSH); }
413 	;
414 
415 exp	:	exp RSH exp
416 			{ write_exp_elt_opcode (BINOP_RSH); }
417 	;
418 
419 exp	:	exp '=' exp
420 			{ write_exp_elt_opcode (BINOP_EQUAL);
421 			  current_type = parse_type->builtin_bool;
422 			}
423 	;
424 
425 exp	:	exp NOTEQUAL exp
426 			{ write_exp_elt_opcode (BINOP_NOTEQUAL);
427 			  current_type = parse_type->builtin_bool;
428 			}
429 	;
430 
431 exp	:	exp LEQ exp
432 			{ write_exp_elt_opcode (BINOP_LEQ);
433 			  current_type = parse_type->builtin_bool;
434 			}
435 	;
436 
437 exp	:	exp GEQ exp
438 			{ write_exp_elt_opcode (BINOP_GEQ);
439 			  current_type = parse_type->builtin_bool;
440 			}
441 	;
442 
443 exp	:	exp '<' exp
444 			{ write_exp_elt_opcode (BINOP_LESS);
445 			  current_type = parse_type->builtin_bool;
446 			}
447 	;
448 
449 exp	:	exp '>' exp
450 			{ write_exp_elt_opcode (BINOP_GTR);
451 			  current_type = parse_type->builtin_bool;
452 			}
453 	;
454 
455 exp	:	exp ANDAND exp
456 			{ write_exp_elt_opcode (BINOP_BITWISE_AND); }
457 	;
458 
459 exp	:	exp XOR exp
460 			{ write_exp_elt_opcode (BINOP_BITWISE_XOR); }
461 	;
462 
463 exp	:	exp OR exp
464 			{ write_exp_elt_opcode (BINOP_BITWISE_IOR); }
465 	;
466 
467 exp	:	exp ASSIGN exp
468 			{ write_exp_elt_opcode (BINOP_ASSIGN); }
469 	;
470 
471 exp	:	TRUEKEYWORD
472 			{ write_exp_elt_opcode (OP_BOOL);
473 			  write_exp_elt_longcst ((LONGEST) $1);
474 			  current_type = parse_type->builtin_bool;
475 			  write_exp_elt_opcode (OP_BOOL); }
476 	;
477 
478 exp	:	FALSEKEYWORD
479 			{ write_exp_elt_opcode (OP_BOOL);
480 			  write_exp_elt_longcst ((LONGEST) $1);
481 			  current_type = parse_type->builtin_bool;
482 			  write_exp_elt_opcode (OP_BOOL); }
483 	;
484 
485 exp	:	INT
486 			{ write_exp_elt_opcode (OP_LONG);
487 			  write_exp_elt_type ($1.type);
488 			  current_type = $1.type;
489 			  write_exp_elt_longcst ((LONGEST)($1.val));
490 			  write_exp_elt_opcode (OP_LONG); }
491 	;
492 
493 exp	:	NAME_OR_INT
494 			{ YYSTYPE val;
495 			  parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
496 			  write_exp_elt_opcode (OP_LONG);
497 			  write_exp_elt_type (val.typed_val_int.type);
498 			  current_type = val.typed_val_int.type;
499 			  write_exp_elt_longcst ((LONGEST)val.typed_val_int.val);
500 			  write_exp_elt_opcode (OP_LONG);
501 			}
502 	;
503 
504 
505 exp	:	FLOAT
506 			{ write_exp_elt_opcode (OP_DOUBLE);
507 			  write_exp_elt_type ($1.type);
508 			  current_type = $1.type;
509 			  write_exp_elt_dblcst ($1.dval);
510 			  write_exp_elt_opcode (OP_DOUBLE); }
511 	;
512 
513 exp	:	variable
514 	;
515 
516 exp	:	VARIABLE
517 			/* Already written by write_dollar_variable. */
518 	;
519 
520 exp	:	SIZEOF '(' type ')'	%prec UNARY
521 			{ write_exp_elt_opcode (OP_LONG);
522 			  write_exp_elt_type (parse_type->builtin_int);
523 			  CHECK_TYPEDEF ($3);
524 			  write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
525 			  write_exp_elt_opcode (OP_LONG); }
526 	;
527 
528 exp	:	SIZEOF  '(' exp ')'      %prec UNARY
529 			{ write_exp_elt_opcode (UNOP_SIZEOF); }
530 
531 exp	:	STRING
532 			{ /* C strings are converted into array constants with
533 			     an explicit null byte added at the end.  Thus
534 			     the array upper bound is the string length.
535 			     There is no such thing in C as a completely empty
536 			     string. */
537 			  char *sp = $1.ptr; int count = $1.length;
538 			  while (count-- > 0)
539 			    {
540 			      write_exp_elt_opcode (OP_LONG);
541 			      write_exp_elt_type (parse_type->builtin_char);
542 			      write_exp_elt_longcst ((LONGEST)(*sp++));
543 			      write_exp_elt_opcode (OP_LONG);
544 			    }
545 			  write_exp_elt_opcode (OP_LONG);
546 			  write_exp_elt_type (parse_type->builtin_char);
547 			  write_exp_elt_longcst ((LONGEST)'\0');
548 			  write_exp_elt_opcode (OP_LONG);
549 			  write_exp_elt_opcode (OP_ARRAY);
550 			  write_exp_elt_longcst ((LONGEST) 0);
551 			  write_exp_elt_longcst ((LONGEST) ($1.length));
552 			  write_exp_elt_opcode (OP_ARRAY); }
553 	;
554 
555 /* Object pascal  */
556 exp	:	THIS
557 			{
558 			  struct value * this_val;
559 			  struct type * this_type;
560 			  write_exp_elt_opcode (OP_THIS);
561 			  write_exp_elt_opcode (OP_THIS);
562 			  /* we need type of this */
563 			  this_val = value_of_this (0);
564 			  if (this_val)
565 			    this_type = value_type (this_val);
566 			  else
567 			    this_type = NULL;
568 			  if (this_type)
569 			    {
570 			      if (TYPE_CODE (this_type) == TYPE_CODE_PTR)
571 				{
572 				  this_type = TYPE_TARGET_TYPE (this_type);
573 				  write_exp_elt_opcode (UNOP_IND);
574 				}
575 			    }
576 
577 			  current_type = this_type;
578 			}
579 	;
580 
581 /* end of object pascal.  */
582 
583 block	:	BLOCKNAME
584 			{
585 			  if ($1.sym != 0)
586 			      $$ = SYMBOL_BLOCK_VALUE ($1.sym);
587 			  else
588 			    {
589 			      struct symtab *tem =
590 				  lookup_symtab (copy_name ($1.stoken));
591 			      if (tem)
592 				$$ = BLOCKVECTOR_BLOCK (BLOCKVECTOR (tem), STATIC_BLOCK);
593 			      else
594 				error ("No file or function \"%s\".",
595 				       copy_name ($1.stoken));
596 			    }
597 			}
598 	;
599 
600 block	:	block COLONCOLON name
601 			{ struct symbol *tem
602 			    = lookup_symbol (copy_name ($3), $1,
603 					     VAR_DOMAIN, (int *) NULL);
604 			  if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
605 			    error ("No function \"%s\" in specified context.",
606 				   copy_name ($3));
607 			  $$ = SYMBOL_BLOCK_VALUE (tem); }
608 	;
609 
610 variable:	block COLONCOLON name
611 			{ struct symbol *sym;
612 			  sym = lookup_symbol (copy_name ($3), $1,
613 					       VAR_DOMAIN, (int *) NULL);
614 			  if (sym == 0)
615 			    error ("No symbol \"%s\" in specified context.",
616 				   copy_name ($3));
617 
618 			  write_exp_elt_opcode (OP_VAR_VALUE);
619 			  /* block_found is set by lookup_symbol.  */
620 			  write_exp_elt_block (block_found);
621 			  write_exp_elt_sym (sym);
622 			  write_exp_elt_opcode (OP_VAR_VALUE); }
623 	;
624 
625 qualified_name:	typebase COLONCOLON name
626 			{
627 			  struct type *type = $1;
628 			  if (TYPE_CODE (type) != TYPE_CODE_STRUCT
629 			      && TYPE_CODE (type) != TYPE_CODE_UNION)
630 			    error ("`%s' is not defined as an aggregate type.",
631 				   TYPE_NAME (type));
632 
633 			  write_exp_elt_opcode (OP_SCOPE);
634 			  write_exp_elt_type (type);
635 			  write_exp_string ($3);
636 			  write_exp_elt_opcode (OP_SCOPE);
637 			}
638 	;
639 
640 variable:	qualified_name
641 	|	COLONCOLON name
642 			{
643 			  char *name = copy_name ($2);
644 			  struct symbol *sym;
645 			  struct minimal_symbol *msymbol;
646 
647 			  sym =
648 			    lookup_symbol (name, (const struct block *) NULL,
649 					   VAR_DOMAIN, (int *) NULL);
650 			  if (sym)
651 			    {
652 			      write_exp_elt_opcode (OP_VAR_VALUE);
653 			      write_exp_elt_block (NULL);
654 			      write_exp_elt_sym (sym);
655 			      write_exp_elt_opcode (OP_VAR_VALUE);
656 			      break;
657 			    }
658 
659 			  msymbol = lookup_minimal_symbol (name, NULL, NULL);
660 			  if (msymbol != NULL)
661 			    write_exp_msymbol (msymbol);
662 			  else if (!have_full_symbols () && !have_partial_symbols ())
663 			    error ("No symbol table is loaded.  Use the \"file\" command.");
664 			  else
665 			    error ("No symbol \"%s\" in current context.", name);
666 			}
667 	;
668 
669 variable:	name_not_typename
670 			{ struct symbol *sym = $1.sym;
671 
672 			  if (sym)
673 			    {
674 			      if (symbol_read_needs_frame (sym))
675 				{
676 				  if (innermost_block == 0
677 				      || contained_in (block_found,
678 						       innermost_block))
679 				    innermost_block = block_found;
680 				}
681 
682 			      write_exp_elt_opcode (OP_VAR_VALUE);
683 			      /* We want to use the selected frame, not
684 				 another more inner frame which happens to
685 				 be in the same block.  */
686 			      write_exp_elt_block (NULL);
687 			      write_exp_elt_sym (sym);
688 			      write_exp_elt_opcode (OP_VAR_VALUE);
689 			      current_type = sym->type; }
690 			  else if ($1.is_a_field_of_this)
691 			    {
692 			      struct value * this_val;
693 			      struct type * this_type;
694 			      /* Object pascal: it hangs off of `this'.  Must
695 			         not inadvertently convert from a method call
696 				 to data ref.  */
697 			      if (innermost_block == 0
698 				  || contained_in (block_found,
699 						   innermost_block))
700 				innermost_block = block_found;
701 			      write_exp_elt_opcode (OP_THIS);
702 			      write_exp_elt_opcode (OP_THIS);
703 			      write_exp_elt_opcode (STRUCTOP_PTR);
704 			      write_exp_string ($1.stoken);
705 			      write_exp_elt_opcode (STRUCTOP_PTR);
706 			      /* we need type of this */
707 			      this_val = value_of_this (0);
708 			      if (this_val)
709 				this_type = value_type (this_val);
710 			      else
711 				this_type = NULL;
712 			      if (this_type)
713 				current_type = lookup_struct_elt_type (
714 				  this_type,
715 				  copy_name ($1.stoken), 0);
716 			      else
717 				current_type = NULL;
718 			    }
719 			  else
720 			    {
721 			      struct minimal_symbol *msymbol;
722 			      char *arg = copy_name ($1.stoken);
723 
724 			      msymbol =
725 				lookup_minimal_symbol (arg, NULL, NULL);
726 			      if (msymbol != NULL)
727 				write_exp_msymbol (msymbol);
728 			      else if (!have_full_symbols () && !have_partial_symbols ())
729 				error ("No symbol table is loaded.  Use the \"file\" command.");
730 			      else
731 				error ("No symbol \"%s\" in current context.",
732 				       copy_name ($1.stoken));
733 			    }
734 			}
735 	;
736 
737 
738 ptype	:	typebase
739 	;
740 
741 /* We used to try to recognize more pointer to member types here, but
742    that didn't work (shift/reduce conflicts meant that these rules never
743    got executed).  The problem is that
744      int (foo::bar::baz::bizzle)
745    is a function type but
746      int (foo::bar::baz::bizzle::*)
747    is a pointer to member type.  Stroustrup loses again!  */
748 
749 type	:	ptype
750 	;
751 
752 typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
753 	:	'^' typebase
754 			{ $$ = lookup_pointer_type ($2); }
755 	|	TYPENAME
756 			{ $$ = $1.type; }
757 	|	STRUCT name
758 			{ $$ = lookup_struct (copy_name ($2),
759 					      expression_context_block); }
760 	|	CLASS name
761 			{ $$ = lookup_struct (copy_name ($2),
762 					      expression_context_block); }
763 	/* "const" and "volatile" are curently ignored.  A type qualifier
764 	   after the type is handled in the ptype rule.  I think these could
765 	   be too.  */
766 	;
767 
768 name	:	NAME { $$ = $1.stoken; }
769 	|	BLOCKNAME { $$ = $1.stoken; }
770 	|	TYPENAME { $$ = $1.stoken; }
771 	|	NAME_OR_INT  { $$ = $1.stoken; }
772 	;
773 
774 name_not_typename :	NAME
775 	|	BLOCKNAME
776 /* These would be useful if name_not_typename was useful, but it is just
777    a fake for "variable", so these cause reduce/reduce conflicts because
778    the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
779    =exp) or just an exp.  If name_not_typename was ever used in an lvalue
780    context where only a name could occur, this might be useful.
781   	|	NAME_OR_INT
782  */
783 	;
784 
785 %%
786 
787 /* Take care of parsing a number (anything that starts with a digit).
788    Set yylval and return the token type; update lexptr.
789    LEN is the number of characters in it.  */
790 
791 /*** Needs some error checking for the float case ***/
792 
793 static int
794 parse_number (p, len, parsed_float, putithere)
795      char *p;
796      int len;
797      int parsed_float;
798      YYSTYPE *putithere;
799 {
800   /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
801      here, and we do kind of silly things like cast to unsigned.  */
802   LONGEST n = 0;
803   LONGEST prevn = 0;
804   ULONGEST un;
805 
806   int i = 0;
807   int c;
808   int base = input_radix;
809   int unsigned_p = 0;
810 
811   /* Number of "L" suffixes encountered.  */
812   int long_p = 0;
813 
814   /* We have found a "L" or "U" suffix.  */
815   int found_suffix = 0;
816 
817   ULONGEST high_bit;
818   struct type *signed_type;
819   struct type *unsigned_type;
820 
821   if (parsed_float)
822     {
823       /* It's a float since it contains a point or an exponent.  */
824       char c;
825       int num = 0;	/* number of tokens scanned by scanf */
826       char saved_char = p[len];
827 
828       p[len] = 0;	/* null-terminate the token */
829       num = sscanf (p, "%" DOUBLEST_SCAN_FORMAT "%c",
830 		    &putithere->typed_val_float.dval, &c);
831       p[len] = saved_char;	/* restore the input stream */
832       if (num != 1) 		/* check scanf found ONLY a float ... */
833 	return ERROR;
834       /* See if it has `f' or `l' suffix (float or long double).  */
835 
836       c = tolower (p[len - 1]);
837 
838       if (c == 'f')
839 	putithere->typed_val_float.type = parse_type->builtin_float;
840       else if (c == 'l')
841 	putithere->typed_val_float.type = parse_type->builtin_long_double;
842       else if (isdigit (c) || c == '.')
843 	putithere->typed_val_float.type = parse_type->builtin_double;
844       else
845 	return ERROR;
846 
847       return FLOAT;
848     }
849 
850   /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
851   if (p[0] == '0')
852     switch (p[1])
853       {
854       case 'x':
855       case 'X':
856 	if (len >= 3)
857 	  {
858 	    p += 2;
859 	    base = 16;
860 	    len -= 2;
861 	  }
862 	break;
863 
864       case 't':
865       case 'T':
866       case 'd':
867       case 'D':
868 	if (len >= 3)
869 	  {
870 	    p += 2;
871 	    base = 10;
872 	    len -= 2;
873 	  }
874 	break;
875 
876       default:
877 	base = 8;
878 	break;
879       }
880 
881   while (len-- > 0)
882     {
883       c = *p++;
884       if (c >= 'A' && c <= 'Z')
885 	c += 'a' - 'A';
886       if (c != 'l' && c != 'u')
887 	n *= base;
888       if (c >= '0' && c <= '9')
889 	{
890 	  if (found_suffix)
891 	    return ERROR;
892 	  n += i = c - '0';
893 	}
894       else
895 	{
896 	  if (base > 10 && c >= 'a' && c <= 'f')
897 	    {
898 	      if (found_suffix)
899 		return ERROR;
900 	      n += i = c - 'a' + 10;
901 	    }
902 	  else if (c == 'l')
903 	    {
904 	      ++long_p;
905 	      found_suffix = 1;
906 	    }
907 	  else if (c == 'u')
908 	    {
909 	      unsigned_p = 1;
910 	      found_suffix = 1;
911 	    }
912 	  else
913 	    return ERROR;	/* Char not a digit */
914 	}
915       if (i >= base)
916 	return ERROR;		/* Invalid digit in this base */
917 
918       /* Portably test for overflow (only works for nonzero values, so make
919 	 a second check for zero).  FIXME: Can't we just make n and prevn
920 	 unsigned and avoid this?  */
921       if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
922 	unsigned_p = 1;		/* Try something unsigned */
923 
924       /* Portably test for unsigned overflow.
925 	 FIXME: This check is wrong; for example it doesn't find overflow
926 	 on 0x123456789 when LONGEST is 32 bits.  */
927       if (c != 'l' && c != 'u' && n != 0)
928 	{
929 	  if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
930 	    error ("Numeric constant too large.");
931 	}
932       prevn = n;
933     }
934 
935   /* An integer constant is an int, a long, or a long long.  An L
936      suffix forces it to be long; an LL suffix forces it to be long
937      long.  If not forced to a larger size, it gets the first type of
938      the above that it fits in.  To figure out whether it fits, we
939      shift it right and see whether anything remains.  Note that we
940      can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
941      operation, because many compilers will warn about such a shift
942      (which always produces a zero result).  Sometimes gdbarch_int_bit
943      or gdbarch_long_bit will be that big, sometimes not.  To deal with
944      the case where it is we just always shift the value more than
945      once, with fewer bits each time.  */
946 
947   un = (ULONGEST)n >> 2;
948   if (long_p == 0
949       && (un >> (gdbarch_int_bit (parse_gdbarch) - 2)) == 0)
950     {
951       high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch) - 1);
952 
953       /* A large decimal (not hex or octal) constant (between INT_MAX
954 	 and UINT_MAX) is a long or unsigned long, according to ANSI,
955 	 never an unsigned int, but this code treats it as unsigned
956 	 int.  This probably should be fixed.  GCC gives a warning on
957 	 such constants.  */
958 
959       unsigned_type = parse_type->builtin_unsigned_int;
960       signed_type = parse_type->builtin_int;
961     }
962   else if (long_p <= 1
963 	   && (un >> (gdbarch_long_bit (parse_gdbarch) - 2)) == 0)
964     {
965       high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch) - 1);
966       unsigned_type = parse_type->builtin_unsigned_long;
967       signed_type = parse_type->builtin_long;
968     }
969   else
970     {
971       int shift;
972       if (sizeof (ULONGEST) * HOST_CHAR_BIT
973 	  < gdbarch_long_long_bit (parse_gdbarch))
974 	/* A long long does not fit in a LONGEST.  */
975 	shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
976       else
977 	shift = (gdbarch_long_long_bit (parse_gdbarch) - 1);
978       high_bit = (ULONGEST) 1 << shift;
979       unsigned_type = parse_type->builtin_unsigned_long_long;
980       signed_type = parse_type->builtin_long_long;
981     }
982 
983    putithere->typed_val_int.val = n;
984 
985    /* If the high bit of the worked out type is set then this number
986       has to be unsigned. */
987 
988    if (unsigned_p || (n & high_bit))
989      {
990        putithere->typed_val_int.type = unsigned_type;
991      }
992    else
993      {
994        putithere->typed_val_int.type = signed_type;
995      }
996 
997    return INT;
998 }
999 
1000 
1001 struct type_push
1002 {
1003   struct type *stored;
1004   struct type_push *next;
1005 };
1006 
1007 static struct type_push *tp_top = NULL;
1008 
1009 static void
1010 push_current_type (void)
1011 {
1012   struct type_push *tpnew;
1013   tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1014   tpnew->next = tp_top;
1015   tpnew->stored = current_type;
1016   current_type = NULL;
1017   tp_top = tpnew;
1018 }
1019 
1020 static void
1021 pop_current_type (void)
1022 {
1023   struct type_push *tp = tp_top;
1024   if (tp)
1025     {
1026       current_type = tp->stored;
1027       tp_top = tp->next;
1028       free (tp);
1029     }
1030 }
1031 
1032 struct token
1033 {
1034   char *operator;
1035   int token;
1036   enum exp_opcode opcode;
1037 };
1038 
1039 static const struct token tokentab3[] =
1040   {
1041     {"shr", RSH, BINOP_END},
1042     {"shl", LSH, BINOP_END},
1043     {"and", ANDAND, BINOP_END},
1044     {"div", DIV, BINOP_END},
1045     {"not", NOT, BINOP_END},
1046     {"mod", MOD, BINOP_END},
1047     {"inc", INCREMENT, BINOP_END},
1048     {"dec", DECREMENT, BINOP_END},
1049     {"xor", XOR, BINOP_END}
1050   };
1051 
1052 static const struct token tokentab2[] =
1053   {
1054     {"or", OR, BINOP_END},
1055     {"<>", NOTEQUAL, BINOP_END},
1056     {"<=", LEQ, BINOP_END},
1057     {">=", GEQ, BINOP_END},
1058     {":=", ASSIGN, BINOP_END},
1059     {"::", COLONCOLON, BINOP_END} };
1060 
1061 /* Allocate uppercased var */
1062 /* make an uppercased copy of tokstart */
1063 static char * uptok (tokstart, namelen)
1064   char *tokstart;
1065   int namelen;
1066 {
1067   int i;
1068   char *uptokstart = (char *)malloc(namelen+1);
1069   for (i = 0;i <= namelen;i++)
1070     {
1071       if ((tokstart[i]>='a' && tokstart[i]<='z'))
1072         uptokstart[i] = tokstart[i]-('a'-'A');
1073       else
1074         uptokstart[i] = tokstart[i];
1075     }
1076   uptokstart[namelen]='\0';
1077   return uptokstart;
1078 }
1079 /* Read one token, getting characters through lexptr.  */
1080 
1081 
1082 static int
1083 yylex ()
1084 {
1085   int c;
1086   int namelen;
1087   unsigned int i;
1088   char *tokstart;
1089   char *uptokstart;
1090   char *tokptr;
1091   int explen, tempbufindex;
1092   static char *tempbuf;
1093   static int tempbufsize;
1094 
1095  retry:
1096 
1097   prev_lexptr = lexptr;
1098 
1099   tokstart = lexptr;
1100   explen = strlen (lexptr);
1101   /* See if it is a special token of length 3.  */
1102   if (explen > 2)
1103     for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1104       if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
1105           && (!isalpha (tokentab3[i].operator[0]) || explen == 3
1106               || (!isalpha (tokstart[3]) && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1107         {
1108           lexptr += 3;
1109           yylval.opcode = tokentab3[i].opcode;
1110           return tokentab3[i].token;
1111         }
1112 
1113   /* See if it is a special token of length 2.  */
1114   if (explen > 1)
1115   for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1116       if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
1117           && (!isalpha (tokentab2[i].operator[0]) || explen == 2
1118               || (!isalpha (tokstart[2]) && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1119         {
1120           lexptr += 2;
1121           yylval.opcode = tokentab2[i].opcode;
1122           return tokentab2[i].token;
1123         }
1124 
1125   switch (c = *tokstart)
1126     {
1127     case 0:
1128       return 0;
1129 
1130     case ' ':
1131     case '\t':
1132     case '\n':
1133       lexptr++;
1134       goto retry;
1135 
1136     case '\'':
1137       /* We either have a character constant ('0' or '\177' for example)
1138 	 or we have a quoted symbol reference ('foo(int,int)' in object pascal
1139 	 for example). */
1140       lexptr++;
1141       c = *lexptr++;
1142       if (c == '\\')
1143 	c = parse_escape (parse_gdbarch, &lexptr);
1144       else if (c == '\'')
1145 	error ("Empty character constant.");
1146 
1147       yylval.typed_val_int.val = c;
1148       yylval.typed_val_int.type = parse_type->builtin_char;
1149 
1150       c = *lexptr++;
1151       if (c != '\'')
1152 	{
1153 	  namelen = skip_quoted (tokstart) - tokstart;
1154 	  if (namelen > 2)
1155 	    {
1156 	      lexptr = tokstart + namelen;
1157 	      if (lexptr[-1] != '\'')
1158 		error ("Unmatched single quote.");
1159 	      namelen -= 2;
1160               tokstart++;
1161               uptokstart = uptok(tokstart,namelen);
1162 	      goto tryname;
1163 	    }
1164 	  error ("Invalid character constant.");
1165 	}
1166       return INT;
1167 
1168     case '(':
1169       paren_depth++;
1170       lexptr++;
1171       return c;
1172 
1173     case ')':
1174       if (paren_depth == 0)
1175 	return 0;
1176       paren_depth--;
1177       lexptr++;
1178       return c;
1179 
1180     case ',':
1181       if (comma_terminates && paren_depth == 0)
1182 	return 0;
1183       lexptr++;
1184       return c;
1185 
1186     case '.':
1187       /* Might be a floating point number.  */
1188       if (lexptr[1] < '0' || lexptr[1] > '9')
1189 	goto symbol;		/* Nope, must be a symbol. */
1190       /* FALL THRU into number case.  */
1191 
1192     case '0':
1193     case '1':
1194     case '2':
1195     case '3':
1196     case '4':
1197     case '5':
1198     case '6':
1199     case '7':
1200     case '8':
1201     case '9':
1202       {
1203 	/* It's a number.  */
1204 	int got_dot = 0, got_e = 0, toktype;
1205 	char *p = tokstart;
1206 	int hex = input_radix > 10;
1207 
1208 	if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1209 	  {
1210 	    p += 2;
1211 	    hex = 1;
1212 	  }
1213 	else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1214 	  {
1215 	    p += 2;
1216 	    hex = 0;
1217 	  }
1218 
1219 	for (;; ++p)
1220 	  {
1221 	    /* This test includes !hex because 'e' is a valid hex digit
1222 	       and thus does not indicate a floating point number when
1223 	       the radix is hex.  */
1224 	    if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1225 	      got_dot = got_e = 1;
1226 	    /* This test does not include !hex, because a '.' always indicates
1227 	       a decimal floating point number regardless of the radix.  */
1228 	    else if (!got_dot && *p == '.')
1229 	      got_dot = 1;
1230 	    else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1231 		     && (*p == '-' || *p == '+'))
1232 	      /* This is the sign of the exponent, not the end of the
1233 		 number.  */
1234 	      continue;
1235 	    /* We will take any letters or digits.  parse_number will
1236 	       complain if past the radix, or if L or U are not final.  */
1237 	    else if ((*p < '0' || *p > '9')
1238 		     && ((*p < 'a' || *p > 'z')
1239 				  && (*p < 'A' || *p > 'Z')))
1240 	      break;
1241 	  }
1242 	toktype = parse_number (tokstart, p - tokstart, got_dot|got_e, &yylval);
1243         if (toktype == ERROR)
1244 	  {
1245 	    char *err_copy = (char *) alloca (p - tokstart + 1);
1246 
1247 	    memcpy (err_copy, tokstart, p - tokstart);
1248 	    err_copy[p - tokstart] = 0;
1249 	    error ("Invalid number \"%s\".", err_copy);
1250 	  }
1251 	lexptr = p;
1252 	return toktype;
1253       }
1254 
1255     case '+':
1256     case '-':
1257     case '*':
1258     case '/':
1259     case '|':
1260     case '&':
1261     case '^':
1262     case '~':
1263     case '!':
1264     case '@':
1265     case '<':
1266     case '>':
1267     case '[':
1268     case ']':
1269     case '?':
1270     case ':':
1271     case '=':
1272     case '{':
1273     case '}':
1274     symbol:
1275       lexptr++;
1276       return c;
1277 
1278     case '"':
1279 
1280       /* Build the gdb internal form of the input string in tempbuf,
1281 	 translating any standard C escape forms seen.  Note that the
1282 	 buffer is null byte terminated *only* for the convenience of
1283 	 debugging gdb itself and printing the buffer contents when
1284 	 the buffer contains no embedded nulls.  Gdb does not depend
1285 	 upon the buffer being null byte terminated, it uses the length
1286 	 string instead.  This allows gdb to handle C strings (as well
1287 	 as strings in other languages) with embedded null bytes */
1288 
1289       tokptr = ++tokstart;
1290       tempbufindex = 0;
1291 
1292       do {
1293 	/* Grow the static temp buffer if necessary, including allocating
1294 	   the first one on demand. */
1295 	if (tempbufindex + 1 >= tempbufsize)
1296 	  {
1297 	    tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1298 	  }
1299 
1300 	switch (*tokptr)
1301 	  {
1302 	  case '\0':
1303 	  case '"':
1304 	    /* Do nothing, loop will terminate. */
1305 	    break;
1306 	  case '\\':
1307 	    tokptr++;
1308 	    c = parse_escape (parse_gdbarch, &tokptr);
1309 	    if (c == -1)
1310 	      {
1311 		continue;
1312 	      }
1313 	    tempbuf[tempbufindex++] = c;
1314 	    break;
1315 	  default:
1316 	    tempbuf[tempbufindex++] = *tokptr++;
1317 	    break;
1318 	  }
1319       } while ((*tokptr != '"') && (*tokptr != '\0'));
1320       if (*tokptr++ != '"')
1321 	{
1322 	  error ("Unterminated string in expression.");
1323 	}
1324       tempbuf[tempbufindex] = '\0';	/* See note above */
1325       yylval.sval.ptr = tempbuf;
1326       yylval.sval.length = tempbufindex;
1327       lexptr = tokptr;
1328       return (STRING);
1329     }
1330 
1331   if (!(c == '_' || c == '$'
1332 	|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1333     /* We must have come across a bad character (e.g. ';').  */
1334     error ("Invalid character '%c' in expression.", c);
1335 
1336   /* It's a name.  See how long it is.  */
1337   namelen = 0;
1338   for (c = tokstart[namelen];
1339        (c == '_' || c == '$' || (c >= '0' && c <= '9')
1340 	|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1341     {
1342       /* Template parameter lists are part of the name.
1343 	 FIXME: This mishandles `print $a<4&&$a>3'.  */
1344       if (c == '<')
1345 	{
1346 	  int i = namelen;
1347 	  int nesting_level = 1;
1348 	  while (tokstart[++i])
1349 	    {
1350 	      if (tokstart[i] == '<')
1351 		nesting_level++;
1352 	      else if (tokstart[i] == '>')
1353 		{
1354 		  if (--nesting_level == 0)
1355 		    break;
1356 		}
1357 	    }
1358 	  if (tokstart[i] == '>')
1359 	    namelen = i;
1360 	  else
1361 	    break;
1362 	}
1363 
1364       /* do NOT uppercase internals because of registers !!! */
1365       c = tokstart[++namelen];
1366     }
1367 
1368   uptokstart = uptok(tokstart,namelen);
1369 
1370   /* The token "if" terminates the expression and is NOT
1371      removed from the input stream.  */
1372   if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1373     {
1374       free (uptokstart);
1375       return 0;
1376     }
1377 
1378   lexptr += namelen;
1379 
1380   tryname:
1381 
1382   /* Catch specific keywords.  Should be done with a data structure.  */
1383   switch (namelen)
1384     {
1385     case 6:
1386       if (strcmp (uptokstart, "OBJECT") == 0)
1387 	{
1388 	  free (uptokstart);
1389 	  return CLASS;
1390 	}
1391       if (strcmp (uptokstart, "RECORD") == 0)
1392 	{
1393 	  free (uptokstart);
1394 	  return STRUCT;
1395 	}
1396       if (strcmp (uptokstart, "SIZEOF") == 0)
1397 	{
1398 	  free (uptokstart);
1399 	  return SIZEOF;
1400 	}
1401       break;
1402     case 5:
1403       if (strcmp (uptokstart, "CLASS") == 0)
1404 	{
1405 	  free (uptokstart);
1406 	  return CLASS;
1407 	}
1408       if (strcmp (uptokstart, "FALSE") == 0)
1409 	{
1410           yylval.lval = 0;
1411 	  free (uptokstart);
1412           return FALSEKEYWORD;
1413         }
1414       break;
1415     case 4:
1416       if (strcmp (uptokstart, "TRUE") == 0)
1417 	{
1418           yylval.lval = 1;
1419 	  free (uptokstart);
1420   	  return TRUEKEYWORD;
1421         }
1422       if (strcmp (uptokstart, "SELF") == 0)
1423         {
1424           /* here we search for 'this' like
1425              inserted in FPC stabs debug info */
1426 	  static const char this_name[] = "this";
1427 
1428 	  if (lookup_symbol (this_name, expression_context_block,
1429 			     VAR_DOMAIN, (int *) NULL))
1430 	    {
1431 	      free (uptokstart);
1432 	      return THIS;
1433 	    }
1434 	}
1435       break;
1436     default:
1437       break;
1438     }
1439 
1440   yylval.sval.ptr = tokstart;
1441   yylval.sval.length = namelen;
1442 
1443   if (*tokstart == '$')
1444     {
1445       /* $ is the normal prefix for pascal hexadecimal values
1446         but this conflicts with the GDB use for debugger variables
1447         so in expression to enter hexadecimal values
1448         we still need to use C syntax with 0xff  */
1449       write_dollar_variable (yylval.sval);
1450       free (uptokstart);
1451       return VARIABLE;
1452     }
1453 
1454   /* Use token-type BLOCKNAME for symbols that happen to be defined as
1455      functions or symtabs.  If this is not so, then ...
1456      Use token-type TYPENAME for symbols that happen to be defined
1457      currently as names of types; NAME for other symbols.
1458      The caller is not constrained to care about the distinction.  */
1459   {
1460     char *tmp = copy_name (yylval.sval);
1461     struct symbol *sym;
1462     int is_a_field_of_this = 0;
1463     int is_a_field = 0;
1464     int hextype;
1465 
1466 
1467     if (search_field && current_type)
1468       is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1469     if (is_a_field)
1470       sym = NULL;
1471     else
1472       sym = lookup_symbol (tmp, expression_context_block,
1473 			   VAR_DOMAIN, &is_a_field_of_this);
1474     /* second chance uppercased (as Free Pascal does).  */
1475     if (!sym && !is_a_field_of_this && !is_a_field)
1476       {
1477        for (i = 0; i <= namelen; i++)
1478          {
1479            if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1480              tmp[i] -= ('a'-'A');
1481          }
1482        if (search_field && current_type)
1483 	 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1484        if (is_a_field)
1485 	 sym = NULL;
1486        else
1487 	 sym = lookup_symbol (tmp, expression_context_block,
1488 			      VAR_DOMAIN, &is_a_field_of_this);
1489        if (sym || is_a_field_of_this || is_a_field)
1490          for (i = 0; i <= namelen; i++)
1491            {
1492              if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1493                tokstart[i] -= ('a'-'A');
1494            }
1495       }
1496     /* Third chance Capitalized (as GPC does).  */
1497     if (!sym && !is_a_field_of_this && !is_a_field)
1498       {
1499        for (i = 0; i <= namelen; i++)
1500          {
1501            if (i == 0)
1502              {
1503               if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1504                 tmp[i] -= ('a'-'A');
1505              }
1506            else
1507            if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1508              tmp[i] -= ('A'-'a');
1509           }
1510        if (search_field && current_type)
1511 	 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1512        if (is_a_field)
1513 	 sym = NULL;
1514        else
1515 	 sym = lookup_symbol (tmp, expression_context_block,
1516 			      VAR_DOMAIN, &is_a_field_of_this);
1517        if (sym || is_a_field_of_this || is_a_field)
1518           for (i = 0; i <= namelen; i++)
1519             {
1520               if (i == 0)
1521                 {
1522                   if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1523                     tokstart[i] -= ('a'-'A');
1524                 }
1525               else
1526                 if ((tokstart[i] >= 'A' && tokstart[i] <= 'Z'))
1527                   tokstart[i] -= ('A'-'a');
1528             }
1529       }
1530 
1531     if (is_a_field)
1532       {
1533 	tempbuf = (char *) realloc (tempbuf, namelen + 1);
1534 	strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0;
1535 	yylval.sval.ptr = tempbuf;
1536 	yylval.sval.length = namelen;
1537 	free (uptokstart);
1538 	return FIELDNAME;
1539       }
1540     /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1541        no psymtabs (coff, xcoff, or some future change to blow away the
1542        psymtabs once once symbols are read).  */
1543     if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1544         || lookup_symtab (tmp))
1545       {
1546 	yylval.ssym.sym = sym;
1547 	yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1548 	free (uptokstart);
1549 	return BLOCKNAME;
1550       }
1551     if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1552         {
1553 #if 1
1554 	  /* Despite the following flaw, we need to keep this code enabled.
1555 	     Because we can get called from check_stub_method, if we don't
1556 	     handle nested types then it screws many operations in any
1557 	     program which uses nested types.  */
1558 	  /* In "A::x", if x is a member function of A and there happens
1559 	     to be a type (nested or not, since the stabs don't make that
1560 	     distinction) named x, then this code incorrectly thinks we
1561 	     are dealing with nested types rather than a member function.  */
1562 
1563 	  char *p;
1564 	  char *namestart;
1565 	  struct symbol *best_sym;
1566 
1567 	  /* Look ahead to detect nested types.  This probably should be
1568 	     done in the grammar, but trying seemed to introduce a lot
1569 	     of shift/reduce and reduce/reduce conflicts.  It's possible
1570 	     that it could be done, though.  Or perhaps a non-grammar, but
1571 	     less ad hoc, approach would work well.  */
1572 
1573 	  /* Since we do not currently have any way of distinguishing
1574 	     a nested type from a non-nested one (the stabs don't tell
1575 	     us whether a type is nested), we just ignore the
1576 	     containing type.  */
1577 
1578 	  p = lexptr;
1579 	  best_sym = sym;
1580 	  while (1)
1581 	    {
1582 	      /* Skip whitespace.  */
1583 	      while (*p == ' ' || *p == '\t' || *p == '\n')
1584 		++p;
1585 	      if (*p == ':' && p[1] == ':')
1586 		{
1587 		  /* Skip the `::'.  */
1588 		  p += 2;
1589 		  /* Skip whitespace.  */
1590 		  while (*p == ' ' || *p == '\t' || *p == '\n')
1591 		    ++p;
1592 		  namestart = p;
1593 		  while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1594 			 || (*p >= 'a' && *p <= 'z')
1595 			 || (*p >= 'A' && *p <= 'Z'))
1596 		    ++p;
1597 		  if (p != namestart)
1598 		    {
1599 		      struct symbol *cur_sym;
1600 		      /* As big as the whole rest of the expression, which is
1601 			 at least big enough.  */
1602 		      char *ncopy = alloca (strlen (tmp)+strlen (namestart)+3);
1603 		      char *tmp1;
1604 
1605 		      tmp1 = ncopy;
1606 		      memcpy (tmp1, tmp, strlen (tmp));
1607 		      tmp1 += strlen (tmp);
1608 		      memcpy (tmp1, "::", 2);
1609 		      tmp1 += 2;
1610 		      memcpy (tmp1, namestart, p - namestart);
1611 		      tmp1[p - namestart] = '\0';
1612 		      cur_sym = lookup_symbol (ncopy, expression_context_block,
1613 					       VAR_DOMAIN, (int *) NULL);
1614 		      if (cur_sym)
1615 			{
1616 			  if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1617 			    {
1618 			      best_sym = cur_sym;
1619 			      lexptr = p;
1620 			    }
1621 			  else
1622 			    break;
1623 			}
1624 		      else
1625 			break;
1626 		    }
1627 		  else
1628 		    break;
1629 		}
1630 	      else
1631 		break;
1632 	    }
1633 
1634 	  yylval.tsym.type = SYMBOL_TYPE (best_sym);
1635 #else /* not 0 */
1636 	  yylval.tsym.type = SYMBOL_TYPE (sym);
1637 #endif /* not 0 */
1638 	  free (uptokstart);
1639 	  return TYPENAME;
1640         }
1641     yylval.tsym.type
1642       = language_lookup_primitive_type_by_name (parse_language,
1643 						parse_gdbarch, tmp);
1644     if (yylval.tsym.type != NULL)
1645       {
1646 	free (uptokstart);
1647 	return TYPENAME;
1648       }
1649 
1650     /* Input names that aren't symbols but ARE valid hex numbers,
1651        when the input radix permits them, can be names or numbers
1652        depending on the parse.  Note we support radixes > 16 here.  */
1653     if (!sym
1654         && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1655             || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1656       {
1657  	YYSTYPE newlval;	/* Its value is ignored.  */
1658 	hextype = parse_number (tokstart, namelen, 0, &newlval);
1659 	if (hextype == INT)
1660 	  {
1661 	    yylval.ssym.sym = sym;
1662 	    yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1663 	    free (uptokstart);
1664 	    return NAME_OR_INT;
1665 	  }
1666       }
1667 
1668     free(uptokstart);
1669     /* Any other kind of symbol */
1670     yylval.ssym.sym = sym;
1671     yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1672     return NAME;
1673   }
1674 }
1675 
1676 void
1677 yyerror (msg)
1678      char *msg;
1679 {
1680   if (prev_lexptr)
1681     lexptr = prev_lexptr;
1682 
1683   error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1684 }
1685