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