1/* YACC parser for Pascal expressions, for GDB.
2   Copyright 2000
3   Free Software Foundation, Inc.
4
5This file is part of GDB.
6
7This program is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2 of the License, or
10(at your option) any later version.
11
12This program is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with this program; if not, write to the Free Software
19Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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 = this_val->type;
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 = this_val->type;
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	|	typebase COLONCOLON '*'
721			{ $$ = lookup_member_type (builtin_type_int, $1); }
722	;
723
724typebase  /* Implements (approximately): (type-qualifier)* type-specifier */
725	:	'^' typebase
726			{ $$ = lookup_pointer_type ($2); }
727	|	TYPENAME
728			{ $$ = $1.type; }
729	|	STRUCT name
730			{ $$ = lookup_struct (copy_name ($2),
731					      expression_context_block); }
732	|	CLASS name
733			{ $$ = lookup_struct (copy_name ($2),
734					      expression_context_block); }
735	/* "const" and "volatile" are curently ignored.  A type qualifier
736	   after the type is handled in the ptype rule.  I think these could
737	   be too.  */
738	;
739
740name	:	NAME { $$ = $1.stoken; }
741	|	BLOCKNAME { $$ = $1.stoken; }
742	|	TYPENAME { $$ = $1.stoken; }
743	|	NAME_OR_INT  { $$ = $1.stoken; }
744	;
745
746name_not_typename :	NAME
747	|	BLOCKNAME
748/* These would be useful if name_not_typename was useful, but it is just
749   a fake for "variable", so these cause reduce/reduce conflicts because
750   the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
751   =exp) or just an exp.  If name_not_typename was ever used in an lvalue
752   context where only a name could occur, this might be useful.
753  	|	NAME_OR_INT
754 */
755	;
756
757%%
758
759/* Take care of parsing a number (anything that starts with a digit).
760   Set yylval and return the token type; update lexptr.
761   LEN is the number of characters in it.  */
762
763/*** Needs some error checking for the float case ***/
764
765static int
766parse_number (p, len, parsed_float, putithere)
767     char *p;
768     int len;
769     int parsed_float;
770     YYSTYPE *putithere;
771{
772  /* FIXME: Shouldn't these be unsigned?  We don't deal with negative values
773     here, and we do kind of silly things like cast to unsigned.  */
774  LONGEST n = 0;
775  LONGEST prevn = 0;
776  ULONGEST un;
777
778  int i = 0;
779  int c;
780  int base = input_radix;
781  int unsigned_p = 0;
782
783  /* Number of "L" suffixes encountered.  */
784  int long_p = 0;
785
786  /* We have found a "L" or "U" suffix.  */
787  int found_suffix = 0;
788
789  ULONGEST high_bit;
790  struct type *signed_type;
791  struct type *unsigned_type;
792
793  if (parsed_float)
794    {
795      /* It's a float since it contains a point or an exponent.  */
796      char c;
797      int num = 0;	/* number of tokens scanned by scanf */
798      char saved_char = p[len];
799
800      p[len] = 0;	/* null-terminate the token */
801      if (sizeof (putithere->typed_val_float.dval) <= sizeof (float))
802	num = sscanf (p, "%g%c", (float *) &putithere->typed_val_float.dval,&c);
803      else if (sizeof (putithere->typed_val_float.dval) <= sizeof (double))
804	num = sscanf (p, "%lg%c", (double *) &putithere->typed_val_float.dval,&c);
805      else
806	{
807#ifdef SCANF_HAS_LONG_DOUBLE
808	  num = sscanf (p, "%Lg%c", &putithere->typed_val_float.dval,&c);
809#else
810	  /* Scan it into a double, then assign it to the long double.
811	     This at least wins with values representable in the range
812	     of doubles. */
813	  double temp;
814	  num = sscanf (p, "%lg%c", &temp,&c);
815	  putithere->typed_val_float.dval = temp;
816#endif
817	}
818      p[len] = saved_char;	/* restore the input stream */
819      if (num != 1) 		/* check scanf found ONLY a float ... */
820	return ERROR;
821      /* See if it has `f' or `l' suffix (float or long double).  */
822
823      c = tolower (p[len - 1]);
824
825      if (c == 'f')
826	putithere->typed_val_float.type = builtin_type_float;
827      else if (c == 'l')
828	putithere->typed_val_float.type = builtin_type_long_double;
829      else if (isdigit (c) || c == '.')
830	putithere->typed_val_float.type = builtin_type_double;
831      else
832	return ERROR;
833
834      return FLOAT;
835    }
836
837  /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
838  if (p[0] == '0')
839    switch (p[1])
840      {
841      case 'x':
842      case 'X':
843	if (len >= 3)
844	  {
845	    p += 2;
846	    base = 16;
847	    len -= 2;
848	  }
849	break;
850
851      case 't':
852      case 'T':
853      case 'd':
854      case 'D':
855	if (len >= 3)
856	  {
857	    p += 2;
858	    base = 10;
859	    len -= 2;
860	  }
861	break;
862
863      default:
864	base = 8;
865	break;
866      }
867
868  while (len-- > 0)
869    {
870      c = *p++;
871      if (c >= 'A' && c <= 'Z')
872	c += 'a' - 'A';
873      if (c != 'l' && c != 'u')
874	n *= base;
875      if (c >= '0' && c <= '9')
876	{
877	  if (found_suffix)
878	    return ERROR;
879	  n += i = c - '0';
880	}
881      else
882	{
883	  if (base > 10 && c >= 'a' && c <= 'f')
884	    {
885	      if (found_suffix)
886		return ERROR;
887	      n += i = c - 'a' + 10;
888	    }
889	  else if (c == 'l')
890	    {
891	      ++long_p;
892	      found_suffix = 1;
893	    }
894	  else if (c == 'u')
895	    {
896	      unsigned_p = 1;
897	      found_suffix = 1;
898	    }
899	  else
900	    return ERROR;	/* Char not a digit */
901	}
902      if (i >= base)
903	return ERROR;		/* Invalid digit in this base */
904
905      /* Portably test for overflow (only works for nonzero values, so make
906	 a second check for zero).  FIXME: Can't we just make n and prevn
907	 unsigned and avoid this?  */
908      if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
909	unsigned_p = 1;		/* Try something unsigned */
910
911      /* Portably test for unsigned overflow.
912	 FIXME: This check is wrong; for example it doesn't find overflow
913	 on 0x123456789 when LONGEST is 32 bits.  */
914      if (c != 'l' && c != 'u' && n != 0)
915	{
916	  if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
917	    error ("Numeric constant too large.");
918	}
919      prevn = n;
920    }
921
922  /* An integer constant is an int, a long, or a long long.  An L
923     suffix forces it to be long; an LL suffix forces it to be long
924     long.  If not forced to a larger size, it gets the first type of
925     the above that it fits in.  To figure out whether it fits, we
926     shift it right and see whether anything remains.  Note that we
927     can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
928     operation, because many compilers will warn about such a shift
929     (which always produces a zero result).  Sometimes TARGET_INT_BIT
930     or TARGET_LONG_BIT will be that big, sometimes not.  To deal with
931     the case where it is we just always shift the value more than
932     once, with fewer bits each time.  */
933
934  un = (ULONGEST)n >> 2;
935  if (long_p == 0
936      && (un >> (TARGET_INT_BIT - 2)) == 0)
937    {
938      high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-1);
939
940      /* A large decimal (not hex or octal) constant (between INT_MAX
941	 and UINT_MAX) is a long or unsigned long, according to ANSI,
942	 never an unsigned int, but this code treats it as unsigned
943	 int.  This probably should be fixed.  GCC gives a warning on
944	 such constants.  */
945
946      unsigned_type = builtin_type_unsigned_int;
947      signed_type = builtin_type_int;
948    }
949  else if (long_p <= 1
950	   && (un >> (TARGET_LONG_BIT - 2)) == 0)
951    {
952      high_bit = ((ULONGEST)1) << (TARGET_LONG_BIT-1);
953      unsigned_type = builtin_type_unsigned_long;
954      signed_type = builtin_type_long;
955    }
956  else
957    {
958      int shift;
959      if (sizeof (ULONGEST) * HOST_CHAR_BIT < TARGET_LONG_LONG_BIT)
960	/* A long long does not fit in a LONGEST.  */
961	shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
962      else
963	shift = (TARGET_LONG_LONG_BIT - 1);
964      high_bit = (ULONGEST) 1 << shift;
965      unsigned_type = builtin_type_unsigned_long_long;
966      signed_type = builtin_type_long_long;
967    }
968
969   putithere->typed_val_int.val = n;
970
971   /* If the high bit of the worked out type is set then this number
972      has to be unsigned. */
973
974   if (unsigned_p || (n & high_bit))
975     {
976       putithere->typed_val_int.type = unsigned_type;
977     }
978   else
979     {
980       putithere->typed_val_int.type = signed_type;
981     }
982
983   return INT;
984}
985
986
987struct type_push
988{
989  struct type *stored;
990  struct type_push *next;
991};
992
993static struct type_push *tp_top = NULL;
994
995static void
996push_current_type (void)
997{
998  struct type_push *tpnew;
999  tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1000  tpnew->next = tp_top;
1001  tpnew->stored = current_type;
1002  current_type = NULL;
1003  tp_top = tpnew;
1004}
1005
1006static void
1007pop_current_type (void)
1008{
1009  struct type_push *tp = tp_top;
1010  if (tp)
1011    {
1012      current_type = tp->stored;
1013      tp_top = tp->next;
1014      xfree (tp);
1015    }
1016}
1017
1018struct token
1019{
1020  char *operator;
1021  int token;
1022  enum exp_opcode opcode;
1023};
1024
1025static const struct token tokentab3[] =
1026  {
1027    {"shr", RSH, BINOP_END},
1028    {"shl", LSH, BINOP_END},
1029    {"and", ANDAND, BINOP_END},
1030    {"div", DIV, BINOP_END},
1031    {"not", NOT, BINOP_END},
1032    {"mod", MOD, BINOP_END},
1033    {"inc", INCREMENT, BINOP_END},
1034    {"dec", DECREMENT, BINOP_END},
1035    {"xor", XOR, BINOP_END}
1036  };
1037
1038static const struct token tokentab2[] =
1039  {
1040    {"or", OR, BINOP_END},
1041    {"<>", NOTEQUAL, BINOP_END},
1042    {"<=", LEQ, BINOP_END},
1043    {">=", GEQ, BINOP_END},
1044    {":=", ASSIGN, BINOP_END},
1045    {"::", COLONCOLON, BINOP_END} };
1046
1047/* Allocate uppercased var */
1048/* make an uppercased copy of tokstart */
1049static char * uptok (tokstart, namelen)
1050  char *tokstart;
1051  int namelen;
1052{
1053  int i;
1054  char *uptokstart = (char *)malloc(namelen+1);
1055  for (i = 0;i <= namelen;i++)
1056    {
1057      if ((tokstart[i]>='a' && tokstart[i]<='z'))
1058        uptokstart[i] = tokstart[i]-('a'-'A');
1059      else
1060        uptokstart[i] = tokstart[i];
1061    }
1062  uptokstart[namelen]='\0';
1063  return uptokstart;
1064}
1065/* Read one token, getting characters through lexptr.  */
1066
1067
1068static int
1069yylex ()
1070{
1071  int c;
1072  int namelen;
1073  unsigned int i;
1074  char *tokstart;
1075  char *uptokstart;
1076  char *tokptr;
1077  char *p;
1078  int explen, tempbufindex;
1079  static char *tempbuf;
1080  static int tempbufsize;
1081
1082 retry:
1083
1084  prev_lexptr = lexptr;
1085
1086  tokstart = lexptr;
1087  explen = strlen (lexptr);
1088  /* See if it is a special token of length 3.  */
1089  if (explen > 2)
1090    for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1091      if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
1092          && (!isalpha (tokentab3[i].operator[0]) || explen == 3
1093              || (!isalpha (tokstart[3]) && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1094        {
1095          lexptr += 3;
1096          yylval.opcode = tokentab3[i].opcode;
1097          return tokentab3[i].token;
1098        }
1099
1100  /* See if it is a special token of length 2.  */
1101  if (explen > 1)
1102  for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1103      if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
1104          && (!isalpha (tokentab2[i].operator[0]) || explen == 2
1105              || (!isalpha (tokstart[2]) && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1106        {
1107          lexptr += 2;
1108          yylval.opcode = tokentab2[i].opcode;
1109          return tokentab2[i].token;
1110        }
1111
1112  switch (c = *tokstart)
1113    {
1114    case 0:
1115      return 0;
1116
1117    case ' ':
1118    case '\t':
1119    case '\n':
1120      lexptr++;
1121      goto retry;
1122
1123    case '\'':
1124      /* We either have a character constant ('0' or '\177' for example)
1125	 or we have a quoted symbol reference ('foo(int,int)' in object pascal
1126	 for example). */
1127      lexptr++;
1128      c = *lexptr++;
1129      if (c == '\\')
1130	c = parse_escape (&lexptr);
1131      else if (c == '\'')
1132	error ("Empty character constant.");
1133
1134      yylval.typed_val_int.val = c;
1135      yylval.typed_val_int.type = builtin_type_char;
1136
1137      c = *lexptr++;
1138      if (c != '\'')
1139	{
1140	  namelen = skip_quoted (tokstart) - tokstart;
1141	  if (namelen > 2)
1142	    {
1143	      lexptr = tokstart + namelen;
1144	      if (lexptr[-1] != '\'')
1145		error ("Unmatched single quote.");
1146	      namelen -= 2;
1147              tokstart++;
1148              uptokstart = uptok(tokstart,namelen);
1149	      goto tryname;
1150	    }
1151	  error ("Invalid character constant.");
1152	}
1153      return INT;
1154
1155    case '(':
1156      paren_depth++;
1157      lexptr++;
1158      return c;
1159
1160    case ')':
1161      if (paren_depth == 0)
1162	return 0;
1163      paren_depth--;
1164      lexptr++;
1165      return c;
1166
1167    case ',':
1168      if (comma_terminates && paren_depth == 0)
1169	return 0;
1170      lexptr++;
1171      return c;
1172
1173    case '.':
1174      /* Might be a floating point number.  */
1175      if (lexptr[1] < '0' || lexptr[1] > '9')
1176	goto symbol;		/* Nope, must be a symbol. */
1177      /* FALL THRU into number case.  */
1178
1179    case '0':
1180    case '1':
1181    case '2':
1182    case '3':
1183    case '4':
1184    case '5':
1185    case '6':
1186    case '7':
1187    case '8':
1188    case '9':
1189      {
1190	/* It's a number.  */
1191	int got_dot = 0, got_e = 0, toktype;
1192	char *p = tokstart;
1193	int hex = input_radix > 10;
1194
1195	if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1196	  {
1197	    p += 2;
1198	    hex = 1;
1199	  }
1200	else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1201	  {
1202	    p += 2;
1203	    hex = 0;
1204	  }
1205
1206	for (;; ++p)
1207	  {
1208	    /* This test includes !hex because 'e' is a valid hex digit
1209	       and thus does not indicate a floating point number when
1210	       the radix is hex.  */
1211	    if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1212	      got_dot = got_e = 1;
1213	    /* This test does not include !hex, because a '.' always indicates
1214	       a decimal floating point number regardless of the radix.  */
1215	    else if (!got_dot && *p == '.')
1216	      got_dot = 1;
1217	    else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1218		     && (*p == '-' || *p == '+'))
1219	      /* This is the sign of the exponent, not the end of the
1220		 number.  */
1221	      continue;
1222	    /* We will take any letters or digits.  parse_number will
1223	       complain if past the radix, or if L or U are not final.  */
1224	    else if ((*p < '0' || *p > '9')
1225		     && ((*p < 'a' || *p > 'z')
1226				  && (*p < 'A' || *p > 'Z')))
1227	      break;
1228	  }
1229	toktype = parse_number (tokstart, p - tokstart, got_dot|got_e, &yylval);
1230        if (toktype == ERROR)
1231	  {
1232	    char *err_copy = (char *) alloca (p - tokstart + 1);
1233
1234	    memcpy (err_copy, tokstart, p - tokstart);
1235	    err_copy[p - tokstart] = 0;
1236	    error ("Invalid number \"%s\".", err_copy);
1237	  }
1238	lexptr = p;
1239	return toktype;
1240      }
1241
1242    case '+':
1243    case '-':
1244    case '*':
1245    case '/':
1246    case '|':
1247    case '&':
1248    case '^':
1249    case '~':
1250    case '!':
1251    case '@':
1252    case '<':
1253    case '>':
1254    case '[':
1255    case ']':
1256    case '?':
1257    case ':':
1258    case '=':
1259    case '{':
1260    case '}':
1261    symbol:
1262      lexptr++;
1263      return c;
1264
1265    case '"':
1266
1267      /* Build the gdb internal form of the input string in tempbuf,
1268	 translating any standard C escape forms seen.  Note that the
1269	 buffer is null byte terminated *only* for the convenience of
1270	 debugging gdb itself and printing the buffer contents when
1271	 the buffer contains no embedded nulls.  Gdb does not depend
1272	 upon the buffer being null byte terminated, it uses the length
1273	 string instead.  This allows gdb to handle C strings (as well
1274	 as strings in other languages) with embedded null bytes */
1275
1276      tokptr = ++tokstart;
1277      tempbufindex = 0;
1278
1279      do {
1280	/* Grow the static temp buffer if necessary, including allocating
1281	   the first one on demand. */
1282	if (tempbufindex + 1 >= tempbufsize)
1283	  {
1284	    tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1285	  }
1286
1287	switch (*tokptr)
1288	  {
1289	  case '\0':
1290	  case '"':
1291	    /* Do nothing, loop will terminate. */
1292	    break;
1293	  case '\\':
1294	    tokptr++;
1295	    c = parse_escape (&tokptr);
1296	    if (c == -1)
1297	      {
1298		continue;
1299	      }
1300	    tempbuf[tempbufindex++] = c;
1301	    break;
1302	  default:
1303	    tempbuf[tempbufindex++] = *tokptr++;
1304	    break;
1305	  }
1306      } while ((*tokptr != '"') && (*tokptr != '\0'));
1307      if (*tokptr++ != '"')
1308	{
1309	  error ("Unterminated string in expression.");
1310	}
1311      tempbuf[tempbufindex] = '\0';	/* See note above */
1312      yylval.sval.ptr = tempbuf;
1313      yylval.sval.length = tempbufindex;
1314      lexptr = tokptr;
1315      return (STRING);
1316    }
1317
1318  if (!(c == '_' || c == '$'
1319	|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1320    /* We must have come across a bad character (e.g. ';').  */
1321    error ("Invalid character '%c' in expression.", c);
1322
1323  /* It's a name.  See how long it is.  */
1324  namelen = 0;
1325  for (c = tokstart[namelen];
1326       (c == '_' || c == '$' || (c >= '0' && c <= '9')
1327	|| (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1328    {
1329      /* Template parameter lists are part of the name.
1330	 FIXME: This mishandles `print $a<4&&$a>3'.  */
1331      if (c == '<')
1332	{
1333	  int i = namelen;
1334	  int nesting_level = 1;
1335	  while (tokstart[++i])
1336	    {
1337	      if (tokstart[i] == '<')
1338		nesting_level++;
1339	      else if (tokstart[i] == '>')
1340		{
1341		  if (--nesting_level == 0)
1342		    break;
1343		}
1344	    }
1345	  if (tokstart[i] == '>')
1346	    namelen = i;
1347	  else
1348	    break;
1349	}
1350
1351      /* do NOT uppercase internals because of registers !!! */
1352      c = tokstart[++namelen];
1353    }
1354
1355  uptokstart = uptok(tokstart,namelen);
1356
1357  /* The token "if" terminates the expression and is NOT
1358     removed from the input stream.  */
1359  if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1360    {
1361      return 0;
1362    }
1363
1364  lexptr += namelen;
1365
1366  tryname:
1367
1368  /* Catch specific keywords.  Should be done with a data structure.  */
1369  switch (namelen)
1370    {
1371    case 6:
1372      if (DEPRECATED_STREQ (uptokstart, "OBJECT"))
1373	return CLASS;
1374      if (DEPRECATED_STREQ (uptokstart, "RECORD"))
1375	return STRUCT;
1376      if (DEPRECATED_STREQ (uptokstart, "SIZEOF"))
1377	return SIZEOF;
1378      break;
1379    case 5:
1380      if (DEPRECATED_STREQ (uptokstart, "CLASS"))
1381	return CLASS;
1382      if (DEPRECATED_STREQ (uptokstart, "FALSE"))
1383	{
1384          yylval.lval = 0;
1385          return FALSEKEYWORD;
1386        }
1387      break;
1388    case 4:
1389      if (DEPRECATED_STREQ (uptokstart, "TRUE"))
1390	{
1391          yylval.lval = 1;
1392  	  return TRUEKEYWORD;
1393        }
1394      if (DEPRECATED_STREQ (uptokstart, "SELF"))
1395        {
1396          /* here we search for 'this' like
1397             inserted in FPC stabs debug info */
1398	  static const char this_name[] = "this";
1399
1400	  if (lookup_symbol (this_name, expression_context_block,
1401			     VAR_DOMAIN, (int *) NULL,
1402			     (struct symtab **) NULL))
1403	    return THIS;
1404	}
1405      break;
1406    default:
1407      break;
1408    }
1409
1410  yylval.sval.ptr = tokstart;
1411  yylval.sval.length = namelen;
1412
1413  if (*tokstart == '$')
1414    {
1415      /* $ is the normal prefix for pascal hexadecimal values
1416        but this conflicts with the GDB use for debugger variables
1417        so in expression to enter hexadecimal values
1418        we still need to use C syntax with 0xff  */
1419      write_dollar_variable (yylval.sval);
1420      return VARIABLE;
1421    }
1422
1423  /* Use token-type BLOCKNAME for symbols that happen to be defined as
1424     functions or symtabs.  If this is not so, then ...
1425     Use token-type TYPENAME for symbols that happen to be defined
1426     currently as names of types; NAME for other symbols.
1427     The caller is not constrained to care about the distinction.  */
1428  {
1429    char *tmp = copy_name (yylval.sval);
1430    struct symbol *sym;
1431    int is_a_field_of_this = 0;
1432    int is_a_field = 0;
1433    int hextype;
1434
1435
1436    if (search_field && current_type)
1437      is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1438    if (is_a_field)
1439      sym = NULL;
1440    else
1441      sym = lookup_symbol (tmp, expression_context_block,
1442			   VAR_DOMAIN,
1443			   &is_a_field_of_this,
1444			   (struct symtab **) NULL);
1445    /* second chance uppercased (as Free Pascal does).  */
1446    if (!sym && !is_a_field_of_this && !is_a_field)
1447      {
1448       for (i = 0; i <= namelen; i++)
1449         {
1450           if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1451             tmp[i] -= ('a'-'A');
1452         }
1453       if (search_field && current_type)
1454	 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1455       if (is_a_field)
1456	 sym = NULL;
1457       else
1458	 sym = lookup_symbol (tmp, expression_context_block,
1459                        VAR_DOMAIN,
1460                        &is_a_field_of_this,
1461                        (struct symtab **) NULL);
1462       if (sym || is_a_field_of_this || is_a_field)
1463         for (i = 0; i <= namelen; i++)
1464           {
1465             if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1466               tokstart[i] -= ('a'-'A');
1467           }
1468      }
1469    /* Third chance Capitalized (as GPC does).  */
1470    if (!sym && !is_a_field_of_this && !is_a_field)
1471      {
1472       for (i = 0; i <= namelen; i++)
1473         {
1474           if (i == 0)
1475             {
1476              if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1477                tmp[i] -= ('a'-'A');
1478             }
1479           else
1480           if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1481             tmp[i] -= ('A'-'a');
1482          }
1483       if (search_field && current_type)
1484	 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
1485       if (is_a_field)
1486	 sym = NULL;
1487       else
1488	 sym = lookup_symbol (tmp, expression_context_block,
1489                         VAR_DOMAIN,
1490                         &is_a_field_of_this,
1491                         (struct symtab **) NULL);
1492       if (sym || is_a_field_of_this || is_a_field)
1493          for (i = 0; i <= namelen; i++)
1494            {
1495              if (i == 0)
1496                {
1497                  if ((tokstart[i] >= 'a' && tokstart[i] <= 'z'))
1498                    tokstart[i] -= ('a'-'A');
1499                }
1500              else
1501                if ((tokstart[i] >= 'A' && tokstart[i] <= 'Z'))
1502                  tokstart[i] -= ('A'-'a');
1503            }
1504      }
1505
1506    if (is_a_field)
1507      {
1508	tempbuf = (char *) realloc (tempbuf, namelen + 1);
1509	strncpy (tempbuf, tokstart, namelen); tempbuf [namelen] = 0;
1510	yylval.sval.ptr = tempbuf;
1511	yylval.sval.length = namelen;
1512	return FIELDNAME;
1513      }
1514    /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1515       no psymtabs (coff, xcoff, or some future change to blow away the
1516       psymtabs once once symbols are read).  */
1517    if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK) ||
1518        lookup_symtab (tmp))
1519      {
1520	yylval.ssym.sym = sym;
1521	yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1522	return BLOCKNAME;
1523      }
1524    if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1525        {
1526#if 1
1527	  /* Despite the following flaw, we need to keep this code enabled.
1528	     Because we can get called from check_stub_method, if we don't
1529	     handle nested types then it screws many operations in any
1530	     program which uses nested types.  */
1531	  /* In "A::x", if x is a member function of A and there happens
1532	     to be a type (nested or not, since the stabs don't make that
1533	     distinction) named x, then this code incorrectly thinks we
1534	     are dealing with nested types rather than a member function.  */
1535
1536	  char *p;
1537	  char *namestart;
1538	  struct symbol *best_sym;
1539
1540	  /* Look ahead to detect nested types.  This probably should be
1541	     done in the grammar, but trying seemed to introduce a lot
1542	     of shift/reduce and reduce/reduce conflicts.  It's possible
1543	     that it could be done, though.  Or perhaps a non-grammar, but
1544	     less ad hoc, approach would work well.  */
1545
1546	  /* Since we do not currently have any way of distinguishing
1547	     a nested type from a non-nested one (the stabs don't tell
1548	     us whether a type is nested), we just ignore the
1549	     containing type.  */
1550
1551	  p = lexptr;
1552	  best_sym = sym;
1553	  while (1)
1554	    {
1555	      /* Skip whitespace.  */
1556	      while (*p == ' ' || *p == '\t' || *p == '\n')
1557		++p;
1558	      if (*p == ':' && p[1] == ':')
1559		{
1560		  /* Skip the `::'.  */
1561		  p += 2;
1562		  /* Skip whitespace.  */
1563		  while (*p == ' ' || *p == '\t' || *p == '\n')
1564		    ++p;
1565		  namestart = p;
1566		  while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1567			 || (*p >= 'a' && *p <= 'z')
1568			 || (*p >= 'A' && *p <= 'Z'))
1569		    ++p;
1570		  if (p != namestart)
1571		    {
1572		      struct symbol *cur_sym;
1573		      /* As big as the whole rest of the expression, which is
1574			 at least big enough.  */
1575		      char *ncopy = alloca (strlen (tmp)+strlen (namestart)+3);
1576		      char *tmp1;
1577
1578		      tmp1 = ncopy;
1579		      memcpy (tmp1, tmp, strlen (tmp));
1580		      tmp1 += strlen (tmp);
1581		      memcpy (tmp1, "::", 2);
1582		      tmp1 += 2;
1583		      memcpy (tmp1, namestart, p - namestart);
1584		      tmp1[p - namestart] = '\0';
1585		      cur_sym = lookup_symbol (ncopy, expression_context_block,
1586					       VAR_DOMAIN, (int *) NULL,
1587					       (struct symtab **) NULL);
1588		      if (cur_sym)
1589			{
1590			  if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1591			    {
1592			      best_sym = cur_sym;
1593			      lexptr = p;
1594			    }
1595			  else
1596			    break;
1597			}
1598		      else
1599			break;
1600		    }
1601		  else
1602		    break;
1603		}
1604	      else
1605		break;
1606	    }
1607
1608	  yylval.tsym.type = SYMBOL_TYPE (best_sym);
1609#else /* not 0 */
1610	  yylval.tsym.type = SYMBOL_TYPE (sym);
1611#endif /* not 0 */
1612	  return TYPENAME;
1613        }
1614    if ((yylval.tsym.type = lookup_primitive_typename (tmp)) != 0)
1615	return TYPENAME;
1616
1617    /* Input names that aren't symbols but ARE valid hex numbers,
1618       when the input radix permits them, can be names or numbers
1619       depending on the parse.  Note we support radixes > 16 here.  */
1620    if (!sym &&
1621        ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10) ||
1622         (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1623      {
1624 	YYSTYPE newlval;	/* Its value is ignored.  */
1625	hextype = parse_number (tokstart, namelen, 0, &newlval);
1626	if (hextype == INT)
1627	  {
1628	    yylval.ssym.sym = sym;
1629	    yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1630	    return NAME_OR_INT;
1631	  }
1632      }
1633
1634    free(uptokstart);
1635    /* Any other kind of symbol */
1636    yylval.ssym.sym = sym;
1637    yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1638    return NAME;
1639  }
1640}
1641
1642void
1643yyerror (msg)
1644     char *msg;
1645{
1646  if (prev_lexptr)
1647    lexptr = prev_lexptr;
1648
1649  error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1650}
1651