1 /* YACC parser for Pascal expressions, for GDB.
2    Copyright 2000
3    Free Software Foundation, Inc.
4 
5 This file is part of GDB.
6 
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
11 
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16 
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, 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 
115 int yyparse (void);
116 
117 static int yylex (void);
118 
119 void
120 yyerror (char *);
121 
122 static 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 */
156 static int
157 parse_number (char *, int, int, YYSTYPE *);
158 
159 static struct type *current_type;
160 
161 static void push_current_type (void);
162 static void pop_current_type (void);
163 static 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 
234 start   :	{ current_type = NULL;
235 		  search_field = 0;
236 		}
237 		normal_start {}
238 	;
239 
240 normal_start	:
241 		exp1
242 	|	type_exp
243 	;
244 
245 type_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.  */
252 exp1	:	exp
253 	|	exp1 ',' exp
254 			{ write_exp_elt_opcode (BINOP_COMMA); }
255 	;
256 
257 /* Expressions, not including the comma operator.  */
258 exp	:	exp '^'   %prec UNARY
259 			{ write_exp_elt_opcode (UNOP_IND);
260 			  if (current_type)
261 			    current_type = TYPE_TARGET_TYPE (current_type); }
262 	;
263 
264 exp	:	'@' exp    %prec UNARY
265 			{ write_exp_elt_opcode (UNOP_ADDR);
266 			  if (current_type)
267 			    current_type = TYPE_POINTER_TYPE (current_type); }
268 	;
269 
270 exp	:	'-' exp    %prec UNARY
271 			{ write_exp_elt_opcode (UNOP_NEG); }
272 	;
273 
274 exp	:	NOT exp    %prec UNARY
275 			{ write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
276 	;
277 
278 exp	:	INCREMENT '(' exp ')'   %prec UNARY
279 			{ write_exp_elt_opcode (UNOP_PREINCREMENT); }
280 	;
281 
282 exp	:	DECREMENT  '(' exp ')'   %prec UNARY
283 			{ write_exp_elt_opcode (UNOP_PREDECREMENT); }
284 	;
285 
286 exp	:	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 			 } ;
299 exp	:	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 
326 exp	:	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 
338 arglist	:
339          | exp
340 			{ arglist_len = 1; }
341 	 | arglist ',' exp   %prec ABOVE_COMMA
342 			{ arglist_len++; }
343 	;
344 
345 exp	:	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 
360 exp	:	'(' exp1 ')'
361 			{ }
362 	;
363 
364 /* Binary operators in order of decreasing precedence.  */
365 
366 exp	:	exp '*' exp
367 			{ write_exp_elt_opcode (BINOP_MUL); }
368 	;
369 
370 exp	:	exp '/' exp
371 			{ write_exp_elt_opcode (BINOP_DIV); }
372 	;
373 
374 exp	:	exp DIV exp
375 			{ write_exp_elt_opcode (BINOP_INTDIV); }
376 	;
377 
378 exp	:	exp MOD exp
379 			{ write_exp_elt_opcode (BINOP_REM); }
380 	;
381 
382 exp	:	exp '+' exp
383 			{ write_exp_elt_opcode (BINOP_ADD); }
384 	;
385 
386 exp	:	exp '-' exp
387 			{ write_exp_elt_opcode (BINOP_SUB); }
388 	;
389 
390 exp	:	exp LSH exp
391 			{ write_exp_elt_opcode (BINOP_LSH); }
392 	;
393 
394 exp	:	exp RSH exp
395 			{ write_exp_elt_opcode (BINOP_RSH); }
396 	;
397 
398 exp	:	exp '=' exp
399 			{ write_exp_elt_opcode (BINOP_EQUAL); }
400 	;
401 
402 exp	:	exp NOTEQUAL exp
403 			{ write_exp_elt_opcode (BINOP_NOTEQUAL); }
404 	;
405 
406 exp	:	exp LEQ exp
407 			{ write_exp_elt_opcode (BINOP_LEQ); }
408 	;
409 
410 exp	:	exp GEQ exp
411 			{ write_exp_elt_opcode (BINOP_GEQ); }
412 	;
413 
414 exp	:	exp '<' exp
415 			{ write_exp_elt_opcode (BINOP_LESS); }
416 	;
417 
418 exp	:	exp '>' exp
419 			{ write_exp_elt_opcode (BINOP_GTR); }
420 	;
421 
422 exp	:	exp ANDAND exp
423 			{ write_exp_elt_opcode (BINOP_BITWISE_AND); }
424 	;
425 
426 exp	:	exp XOR exp
427 			{ write_exp_elt_opcode (BINOP_BITWISE_XOR); }
428 	;
429 
430 exp	:	exp OR exp
431 			{ write_exp_elt_opcode (BINOP_BITWISE_IOR); }
432 	;
433 
434 exp	:	exp ASSIGN exp
435 			{ write_exp_elt_opcode (BINOP_ASSIGN); }
436 	;
437 
438 exp	:	TRUEKEYWORD
439 			{ write_exp_elt_opcode (OP_BOOL);
440 			  write_exp_elt_longcst ((LONGEST) $1);
441 			  write_exp_elt_opcode (OP_BOOL); }
442 	;
443 
444 exp	:	FALSEKEYWORD
445 			{ write_exp_elt_opcode (OP_BOOL);
446 			  write_exp_elt_longcst ((LONGEST) $1);
447 			  write_exp_elt_opcode (OP_BOOL); }
448 	;
449 
450 exp	:	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 
457 exp	:	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 
468 exp	:	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 
475 exp	:	variable
476 	;
477 
478 exp	:	VARIABLE
479 			/* Already written by write_dollar_variable. */
480 	;
481 
482 exp	:	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 
490 exp	:	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  */
515 exp	:	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 
542 block	:	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 
559 block	:	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 
570 variable:	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 
586 qualified_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 
601 variable:	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 
636 variable:	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 
708 ptype	:	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 
719 type	:	ptype
720 	|	typebase COLONCOLON '*'
721 			{ $$ = lookup_member_type (builtin_type_int, $1); }
722 	;
723 
724 typebase  /* 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 
740 name	:	NAME { $$ = $1.stoken; }
741 	|	BLOCKNAME { $$ = $1.stoken; }
742 	|	TYPENAME { $$ = $1.stoken; }
743 	|	NAME_OR_INT  { $$ = $1.stoken; }
744 	;
745 
746 name_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 
765 static int
parse_number(p,len,parsed_float,putithere)766 parse_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 
987 struct type_push
988 {
989   struct type *stored;
990   struct type_push *next;
991 };
992 
993 static struct type_push *tp_top = NULL;
994 
995 static void
push_current_type(void)996 push_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 
1006 static void
pop_current_type(void)1007 pop_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 
1018 struct token
1019 {
1020   char *operator;
1021   int token;
1022   enum exp_opcode opcode;
1023 };
1024 
1025 static 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 
1038 static 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 */
uptok(tokstart,namelen)1049 static 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 
1068 static int
yylex()1069 yylex ()
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 
1642 void
yyerror(msg)1643 yyerror (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