Upgrade GDB from 7.4.1 to 7.6.1 on the vendor branch
[dragonfly.git] / contrib / gdb-7 / gdb / p-exp.y
CommitLineData
5796c8dc 1/* YACC parser for Pascal expressions, for GDB.
ef5ccd6c 2 Copyright (C) 2000-2013 Free Software Foundation, Inc.
5796c8dc
SS
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.
c50c785c 43 Probably also lots of other problems, less well defined PM. */
5796c8dc
SS
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. */
c50c785c 56#include "objfiles.h" /* For have_full_symbols and have_partial_symbols. */
5796c8dc
SS
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
c50c785c 66 generators need to be fixed instead of adding those names to this list. */
5796c8dc
SS
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
c50c785c
JM
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
5796c8dc
SS
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
ef5ccd6c
JM
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
5796c8dc
SS
114
115#ifndef YYDEBUG
116#define YYDEBUG 1 /* Default to yydebug support */
117#endif
118
119#define YYFPRINTF parser_fprintf
120
121int yyparse (void);
122
123static int yylex (void);
124
c50c785c 125void yyerror (char *);
5796c8dc
SS
126
127static 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 */
c50c785c 161static int parse_number (char *, int, int, YYSTYPE *);
5796c8dc
SS
162
163static struct type *current_type;
c50c785c 164static struct internalvar *intvar;
5796c8dc
SS
165static int leftdiv_is_integer;
166static void push_current_type (void);
167static void pop_current_type (void);
168static 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
c50c785c 189%token <sval> STRING
5796c8dc 190%token <sval> FIELDNAME
c50c785c
JM
191%token <voidval> COMPLETE
192%token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
5796c8dc
SS
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
240start : { current_type = NULL;
c50c785c 241 intvar = NULL;
5796c8dc
SS
242 search_field = 0;
243 leftdiv_is_integer = 0;
244 }
245 normal_start {}
246 ;
247
248normal_start :
249 exp1
250 | type_exp
251 ;
252
253type_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. */
260exp1 : exp
261 | exp1 ',' exp
262 { write_exp_elt_opcode (BINOP_COMMA); }
263 ;
264
265/* Expressions, not including the comma operator. */
266exp : exp '^' %prec UNARY
267 { write_exp_elt_opcode (UNOP_IND);
c50c785c 268 if (current_type)
5796c8dc
SS
269 current_type = TYPE_TARGET_TYPE (current_type); }
270 ;
271
272exp : '@' exp %prec UNARY
c50c785c 273 { write_exp_elt_opcode (UNOP_ADDR);
5796c8dc
SS
274 if (current_type)
275 current_type = TYPE_POINTER_TYPE (current_type); }
276 ;
277
278exp : '-' exp %prec UNARY
279 { write_exp_elt_opcode (UNOP_NEG); }
280 ;
281
282exp : NOT exp %prec UNARY
283 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
284 ;
285
286exp : INCREMENT '(' exp ')' %prec UNARY
287 { write_exp_elt_opcode (UNOP_PREINCREMENT); }
288 ;
289
290exp : DECREMENT '(' exp ')' %prec UNARY
291 { write_exp_elt_opcode (UNOP_PREDECREMENT); }
292 ;
293
c50c785c
JM
294
295field_exp : exp '.' %prec UNARY
296 { search_field = 1; }
297 ;
298
299exp : field_exp FIELDNAME
5796c8dc 300 { write_exp_elt_opcode (STRUCTOP_STRUCT);
c50c785c 301 write_exp_string ($2);
5796c8dc 302 write_exp_elt_opcode (STRUCTOP_STRUCT);
c50c785c 303 search_field = 0;
5796c8dc 304 if (current_type)
c50c785c
JM
305 {
306 while (TYPE_CODE (current_type)
307 == TYPE_CODE_PTR)
308 current_type =
309 TYPE_TARGET_TYPE (current_type);
5796c8dc 310 current_type = lookup_struct_elt_type (
c50c785c
JM
311 current_type, $2.ptr, 0);
312 }
313 }
314 ;
315
316
317exp : 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
335exp : 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
5796c8dc 345exp : exp '['
c50c785c 346 /* We need to save the current_type value. */
ef5ccd6c 347 { const char *arrayname;
5796c8dc
SS
348 int arrayfieldindex;
349 arrayfieldindex = is_pascal_string_type (
350 current_type, NULL, NULL,
c50c785c
JM
351 NULL, NULL, &arrayname);
352 if (arrayfieldindex)
5796c8dc
SS
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,
c50c785c 359 arrayfieldindex - 1);
5796c8dc 360 write_exp_elt_opcode (STRUCTOP_STRUCT);
c50c785c 361 write_exp_string (stringsval);
5796c8dc
SS
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
372exp : 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 ());
c50c785c 380 write_exp_elt_opcode (OP_FUNCALL);
5796c8dc
SS
381 pop_current_type ();
382 if (current_type)
383 current_type = TYPE_TARGET_TYPE (current_type);
384 }
385 ;
386
387arglist :
388 | exp
389 { arglist_len = 1; }
390 | arglist ',' exp %prec ABOVE_COMMA
391 { arglist_len++; }
392 ;
393
394exp : 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);
c50c785c 405 write_exp_elt_opcode (UNOP_CAST);
5796c8dc
SS
406 current_type = $1; }
407 ;
408
409exp : '(' exp1 ')'
410 { }
411 ;
412
413/* Binary operators in order of decreasing precedence. */
414
415exp : exp '*' exp
416 { write_exp_elt_opcode (BINOP_MUL); }
417 ;
418
419exp : exp '/' {
420 if (current_type && is_integral_type (current_type))
421 leftdiv_is_integer = 1;
c50c785c 422 }
5796c8dc 423 exp
c50c785c 424 {
5796c8dc
SS
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
c50c785c 435 write_exp_elt_opcode (BINOP_DIV);
5796c8dc
SS
436 }
437 ;
438
439exp : exp DIV exp
440 { write_exp_elt_opcode (BINOP_INTDIV); }
441 ;
442
443exp : exp MOD exp
444 { write_exp_elt_opcode (BINOP_REM); }
445 ;
446
447exp : exp '+' exp
448 { write_exp_elt_opcode (BINOP_ADD); }
449 ;
450
451exp : exp '-' exp
452 { write_exp_elt_opcode (BINOP_SUB); }
453 ;
454
455exp : exp LSH exp
456 { write_exp_elt_opcode (BINOP_LSH); }
457 ;
458
459exp : exp RSH exp
460 { write_exp_elt_opcode (BINOP_RSH); }
461 ;
462
463exp : exp '=' exp
c50c785c 464 { write_exp_elt_opcode (BINOP_EQUAL);
5796c8dc
SS
465 current_type = parse_type->builtin_bool;
466 }
467 ;
468
469exp : exp NOTEQUAL exp
c50c785c 470 { write_exp_elt_opcode (BINOP_NOTEQUAL);
5796c8dc
SS
471 current_type = parse_type->builtin_bool;
472 }
473 ;
474
475exp : exp LEQ exp
c50c785c 476 { write_exp_elt_opcode (BINOP_LEQ);
5796c8dc
SS
477 current_type = parse_type->builtin_bool;
478 }
479 ;
480
481exp : exp GEQ exp
c50c785c 482 { write_exp_elt_opcode (BINOP_GEQ);
5796c8dc
SS
483 current_type = parse_type->builtin_bool;
484 }
485 ;
486
487exp : exp '<' exp
c50c785c 488 { write_exp_elt_opcode (BINOP_LESS);
5796c8dc
SS
489 current_type = parse_type->builtin_bool;
490 }
491 ;
492
493exp : exp '>' exp
c50c785c 494 { write_exp_elt_opcode (BINOP_GTR);
5796c8dc
SS
495 current_type = parse_type->builtin_bool;
496 }
497 ;
498
499exp : exp ANDAND exp
500 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
501 ;
502
503exp : exp XOR exp
504 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
505 ;
506
507exp : exp OR exp
508 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
509 ;
510
511exp : exp ASSIGN exp
512 { write_exp_elt_opcode (BINOP_ASSIGN); }
513 ;
514
515exp : 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
522exp : 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
529exp : 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
537exp : NAME_OR_INT
538 { YYSTYPE val;
c50c785c
JM
539 parse_number ($1.stoken.ptr,
540 $1.stoken.length, 0, &val);
5796c8dc
SS
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;
c50c785c
JM
544 write_exp_elt_longcst ((LONGEST)
545 val.typed_val_int.val);
5796c8dc
SS
546 write_exp_elt_opcode (OP_LONG);
547 }
548 ;
549
550
551exp : 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
559exp : variable
560 ;
561
562exp : VARIABLE
c50c785c
JM
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 ;
5796c8dc
SS
576
577exp : 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
cf7f2e2d
JM
585exp : SIZEOF '(' exp ')' %prec UNARY
586 { write_exp_elt_opcode (UNOP_SIZEOF); }
c50c785c 587
5796c8dc
SS
588exp : 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
c50c785c 593 string. */
5796c8dc
SS
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 */
613exp : THIS
c50c785c 614 {
5796c8dc
SS
615 struct value * this_val;
616 struct type * this_type;
617 write_exp_elt_opcode (OP_THIS);
c50c785c
JM
618 write_exp_elt_opcode (OP_THIS);
619 /* We need type of this. */
a45ae5f8 620 this_val = value_of_this_silent (parse_language);
5796c8dc
SS
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 }
c50c785c 633
5796c8dc
SS
634 current_type = this_type;
635 }
636 ;
637
638/* end of object pascal. */
639
640block : 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)
c50c785c
JM
649 $$ = BLOCKVECTOR_BLOCK (BLOCKVECTOR (tem),
650 STATIC_BLOCK);
5796c8dc 651 else
c50c785c 652 error (_("No file or function \"%s\"."),
5796c8dc
SS
653 copy_name ($1.stoken));
654 }
655 }
656 ;
657
658block : block COLONCOLON name
659 { struct symbol *tem
660 = lookup_symbol (copy_name ($3), $1,
ef5ccd6c 661 VAR_DOMAIN, NULL);
5796c8dc 662 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
c50c785c 663 error (_("No function \"%s\" in specified context."),
5796c8dc
SS
664 copy_name ($3));
665 $$ = SYMBOL_BLOCK_VALUE (tem); }
666 ;
667
668variable: block COLONCOLON name
669 { struct symbol *sym;
670 sym = lookup_symbol (copy_name ($3), $1,
ef5ccd6c 671 VAR_DOMAIN, NULL);
5796c8dc 672 if (sym == 0)
c50c785c 673 error (_("No symbol \"%s\" in specified context."),
5796c8dc
SS
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
683qualified_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)
c50c785c 688 error (_("`%s' is not defined as an aggregate type."),
5796c8dc
SS
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
698variable: qualified_name
699 | COLONCOLON name
700 {
701 char *name = copy_name ($2);
702 struct symbol *sym;
703 struct minimal_symbol *msymbol;
704
705 sym =
706 lookup_symbol (name, (const struct block *) NULL,
ef5ccd6c 707 VAR_DOMAIN, NULL);
5796c8dc
SS
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_minimal_symbol (name, NULL, NULL);
718 if (msymbol != NULL)
719 write_exp_msymbol (msymbol);
c50c785c
JM
720 else if (!have_full_symbols ()
721 && !have_partial_symbols ())
722 error (_("No symbol table is loaded. "
723 "Use the \"file\" command."));
5796c8dc 724 else
c50c785c
JM
725 error (_("No symbol \"%s\" in current context."),
726 name);
5796c8dc
SS
727 }
728 ;
729
730variable: 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);
c50c785c 767 /* We need type of this. */
a45ae5f8 768 this_val = value_of_this_silent (parse_language);
5796c8dc
SS
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
c50c785c 778 current_type = NULL;
5796c8dc
SS
779 }
780 else
781 {
782 struct minimal_symbol *msymbol;
783 char *arg = copy_name ($1.stoken);
784
785 msymbol =
786 lookup_minimal_symbol (arg, NULL, NULL);
787 if (msymbol != NULL)
788 write_exp_msymbol (msymbol);
c50c785c
JM
789 else if (!have_full_symbols ()
790 && !have_partial_symbols ())
791 error (_("No symbol table is loaded. "
792 "Use the \"file\" command."));
5796c8dc 793 else
c50c785c 794 error (_("No symbol \"%s\" in current context."),
5796c8dc
SS
795 copy_name ($1.stoken));
796 }
797 }
798 ;
799
800
801ptype : 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
812type : ptype
813 ;
814
815typebase /* 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
831name : NAME { $$ = $1.stoken; }
832 | BLOCKNAME { $$ = $1.stoken; }
833 | TYPENAME { $$ = $1.stoken; }
834 | NAME_OR_INT { $$ = $1.stoken; }
835 ;
836
837name_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
856static int
c50c785c 857parse_number (char *p, int len, int parsed_float, YYSTYPE *putithere)
5796c8dc
SS
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 {
c50c785c
JM
882 if (! parse_c_float (parse_gdbarch, p, len,
883 &putithere->typed_val_float.dval,
884 &putithere->typed_val_float.type))
5796c8dc 885 return ERROR;
5796c8dc
SS
886 return FLOAT;
887 }
888
c50c785c 889 /* Handle base-switching prefixes 0x, 0t, 0d, 0. */
5796c8dc
SS
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)
c50c785c 955 return ERROR; /* Invalid digit in this base. */
5796c8dc
SS
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)
c50c785c 961 unsigned_p = 1; /* Try something unsigned. */
5796c8dc
SS
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)
c50c785c 967 {
5796c8dc 968 if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
c50c785c 969 error (_("Numeric constant too large."));
5796c8dc
SS
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
c50c785c 1025 has to be unsigned. */
5796c8dc
SS
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
1040struct type_push
1041{
1042 struct type *stored;
1043 struct type_push *next;
1044};
1045
1046static struct type_push *tp_top = NULL;
1047
1048static void
1049push_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;
c50c785c 1056 tp_top = tpnew;
5796c8dc
SS
1057}
1058
1059static void
1060pop_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
1071struct token
1072{
1073 char *operator;
1074 int token;
1075 enum exp_opcode opcode;
1076};
1077
1078static 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
1091static 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
c50c785c
JM
1100/* Allocate uppercased var: */
1101/* make an uppercased copy of tokstart. */
ef5ccd6c
JM
1102static char *
1103uptok (char *tokstart, int namelen)
5796c8dc
SS
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}
5796c8dc 1117
c50c785c
JM
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. */
1121static int last_was_structop;
1122
1123/* Read one token, getting characters through lexptr. */
5796c8dc
SS
1124
1125static int
c50c785c 1126yylex (void)
5796c8dc
SS
1127{
1128 int c;
1129 int namelen;
1130 unsigned int i;
1131 char *tokstart;
1132 char *uptokstart;
1133 char *tokptr;
5796c8dc
SS
1134 int explen, tempbufindex;
1135 static char *tempbuf;
1136 static int tempbufsize;
c50c785c 1137 int saw_structop = last_was_structop;
5796c8dc 1138
c50c785c 1139 last_was_structop = 0;
5796c8dc
SS
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
c50c785c
JM
1151 || (!isalpha (tokstart[3])
1152 && !isdigit (tokstart[3]) && tokstart[3] != '_')))
5796c8dc
SS
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
c50c785c
JM
1164 || (!isalpha (tokstart[2])
1165 && !isdigit (tokstart[2]) && tokstart[2] != '_')))
5796c8dc
SS
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:
c50c785c
JM
1175 if (saw_structop && search_field)
1176 return COMPLETE;
1177 else
1178 return 0;
5796c8dc
SS
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
c50c785c 1189 for example). */
5796c8dc
SS
1190 lexptr++;
1191 c = *lexptr++;
1192 if (c == '\\')
cf7f2e2d 1193 c = parse_escape (parse_gdbarch, &lexptr);
5796c8dc 1194 else if (c == '\'')
c50c785c 1195 error (_("Empty character constant."));
5796c8dc
SS
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] != '\'')
c50c785c 1208 error (_("Unmatched single quote."));
5796c8dc
SS
1209 namelen -= 2;
1210 tokstart++;
1211 uptokstart = uptok(tokstart,namelen);
1212 goto tryname;
1213 }
c50c785c 1214 error (_("Invalid character constant."));
5796c8dc
SS
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')
c50c785c 1239 {
ef5ccd6c 1240 if (parse_completion)
c50c785c
JM
1241 last_was_structop = 1;
1242 goto symbol; /* Nope, must be a symbol. */
1243 }
1244
5796c8dc
SS
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 }
c50c785c
JM
1268 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1269 || p[1]=='d' || p[1]=='D'))
5796c8dc
SS
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 }
c50c785c
JM
1298 toktype = parse_number (tokstart,
1299 p - tokstart, got_dot | got_e, &yylval);
5796c8dc
SS
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;
c50c785c 1306 error (_("Invalid number \"%s\"."), err_copy);
5796c8dc
SS
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
c50c785c 1344 as strings in other languages) with embedded null bytes. */
5796c8dc
SS
1345
1346 tokptr = ++tokstart;
1347 tempbufindex = 0;
1348
1349 do {
1350 /* Grow the static temp buffer if necessary, including allocating
c50c785c 1351 the first one on demand. */
5796c8dc
SS
1352 if (tempbufindex + 1 >= tempbufsize)
1353 {
1354 tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1355 }
1356
1357 switch (*tokptr)
1358 {
1359 case '\0':
1360 case '"':
c50c785c 1361 /* Do nothing, loop will terminate. */
5796c8dc
SS
1362 break;
1363 case '\\':
1364 tokptr++;
cf7f2e2d 1365 c = parse_escape (parse_gdbarch, &tokptr);
5796c8dc
SS
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 {
c50c785c 1379 error (_("Unterminated string in expression."));
5796c8dc 1380 }
c50c785c 1381 tempbuf[tempbufindex] = '\0'; /* See note above. */
5796c8dc
SS
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. ';'). */
c50c785c 1391 error (_("Invalid character '%c' in expression."), c);
5796c8dc
SS
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
c50c785c 1421 /* do NOT uppercase internals because of registers !!! */
5796c8dc
SS
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 {
c50c785c
JM
1481 /* Here we search for 'this' like
1482 inserted in FPC stabs debug info. */
5796c8dc
SS
1483 static const char this_name[] = "this";
1484
1485 if (lookup_symbol (this_name, expression_context_block,
ef5ccd6c 1486 VAR_DOMAIN, NULL))
5796c8dc
SS
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 {
c50c785c 1502 char c;
5796c8dc
SS
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);
c50c785c
JM
1508 c = tokstart[namelen];
1509 tokstart[namelen] = 0;
1510 intvar = lookup_only_internalvar (++tokstart);
1511 --tokstart;
1512 tokstart[namelen] = c;
5796c8dc
SS
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;
ef5ccd6c 1525 struct field_of_this_result is_a_field_of_this;
5796c8dc
SS
1526 int is_a_field = 0;
1527 int hextype;
1528
1529
1530 if (search_field && current_type)
c50c785c 1531 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
ef5ccd6c 1532 if (is_a_field || parse_completion)
5796c8dc
SS
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). */
ef5ccd6c 1538 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
5796c8dc
SS
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)
c50c785c 1546 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
ef5ccd6c 1547 if (is_a_field || parse_completion)
5796c8dc
SS
1548 sym = NULL;
1549 else
1550 sym = lookup_symbol (tmp, expression_context_block,
1551 VAR_DOMAIN, &is_a_field_of_this);
ef5ccd6c 1552 if (sym || is_a_field_of_this.type != NULL || is_a_field)
5796c8dc
SS
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). */
ef5ccd6c 1560 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
5796c8dc
SS
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)
c50c785c 1574 is_a_field = (lookup_struct_elt_type (current_type, tmp, 1) != NULL);
ef5ccd6c 1575 if (is_a_field || parse_completion)
5796c8dc
SS
1576 sym = NULL;
1577 else
1578 sym = lookup_symbol (tmp, expression_context_block,
1579 VAR_DOMAIN, &is_a_field_of_this);
ef5ccd6c 1580 if (sym || is_a_field_of_this.type != NULL || is_a_field)
5796c8dc
SS
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;
c50c785c 1599 yylval.sval.length = namelen;
5796c8dc
SS
1600 free (uptokstart);
1601 return FIELDNAME;
c50c785c 1602 }
5796c8dc
SS
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;
ef5ccd6c 1610 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
5796c8dc
SS
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,
ef5ccd6c 1676 VAR_DOMAIN, NULL);
5796c8dc
SS
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;
ef5ccd6c 1725 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
5796c8dc
SS
1726 free (uptokstart);
1727 return NAME_OR_INT;
1728 }
1729 }
1730
1731 free(uptokstart);
c50c785c 1732 /* Any other kind of symbol. */
5796c8dc 1733 yylval.ssym.sym = sym;
ef5ccd6c 1734 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
5796c8dc
SS
1735 return NAME;
1736 }
1737}
1738
1739void
ef5ccd6c 1740yyerror (char *msg)
5796c8dc
SS
1741{
1742 if (prev_lexptr)
1743 lexptr = prev_lexptr;
1744
c50c785c 1745 error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
5796c8dc 1746}