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