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