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