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