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