projects / deliverable / binutils-gdb.git / blame_incremental
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
-Wwrite-strings: More Solaris
[deliverable/binutils-gdb.git] / gdb / ada-exp.y
... / ...
CommitLineData
1/* YACC parser for Ada expressions, for GDB.
2 Copyright (C) 1986-2017 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/* Parse an Ada expression from text in a string,
20 and return the result as a struct expression pointer.
21 That structure contains arithmetic operations in reverse polish,
22 with constants represented by operations that are followed by special data.
23 See expression.h for the details of the format.
24 What is important here is that it can be built up sequentially
25 during the process of parsing; the lower levels of the tree always
26 come first in the result.
27
28 malloc's and realloc's in this file are transformed to
29 xmalloc and xrealloc respectively by the same sed command in the
30 makefile that remaps any other malloc/realloc inserted by the parser
31 generator. Doing this with #defines and trying to control the interaction
32 with include files (<malloc.h> and <stdlib.h> for example) just became
33 too messy, particularly when such includes can be inserted at random
34 times by the parser generator. */
35
36%{
37
38#include "defs.h"
39#include <ctype.h>
40#include "expression.h"
41#include "value.h"
42#include "parser-defs.h"
43#include "language.h"
44#include "ada-lang.h"
45#include "bfd.h" /* Required by objfiles.h. */
46#include "symfile.h" /* Required by objfiles.h. */
47#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
48#include "frame.h"
49#include "block.h"
50
51#define parse_type(ps) builtin_type (parse_gdbarch (ps))
52
53/* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
54 etc). */
55#define GDB_YY_REMAP_PREFIX ada_
56#include "yy-remap.h"
57
58struct name_info {
59 struct symbol *sym;
60 struct minimal_symbol *msym;
61 const struct block *block;
62 struct stoken stoken;
63};
64
65/* The state of the parser, used internally when we are parsing the
66 expression. */
67
68static struct parser_state *pstate = NULL;
69
70static struct stoken empty_stoken = { "", 0 };
71
72/* If expression is in the context of TYPE'(...), then TYPE, else
73 * NULL. */
74static struct type *type_qualifier;
75
76int yyparse (void);
77
78static int yylex (void);
79
80void yyerror (char *);
81
82static void write_int (struct parser_state *, LONGEST, struct type *);
83
84static void write_object_renaming (struct parser_state *,
85 const struct block *, const char *, int,
86 const char *, int);
87
88static struct type* write_var_or_type (struct parser_state *,
89 const struct block *, struct stoken);
90
91static void write_name_assoc (struct parser_state *, struct stoken);
92
93static void write_exp_op_with_string (struct parser_state *, enum exp_opcode,
94 struct stoken);
95
96static const struct block *block_lookup (const struct block *, const char *);
97
98static LONGEST convert_char_literal (struct type *, LONGEST);
99
100static void write_ambiguous_var (struct parser_state *,
101 const struct block *, char *, int);
102
103static struct type *type_int (struct parser_state *);
104
105static struct type *type_long (struct parser_state *);
106
107static struct type *type_long_long (struct parser_state *);
108
109static struct type *type_float (struct parser_state *);
110
111static struct type *type_double (struct parser_state *);
112
113static struct type *type_long_double (struct parser_state *);
114
115static struct type *type_char (struct parser_state *);
116
117static struct type *type_boolean (struct parser_state *);
118
119static struct type *type_system_address (struct parser_state *);
120
121%}
122
123%union
124 {
125 LONGEST lval;
126 struct {
127 LONGEST val;
128 struct type *type;
129 } typed_val;
130 struct {
131 DOUBLEST dval;
132 struct type *type;
133 } typed_val_float;
134 struct type *tval;
135 struct stoken sval;
136 const struct block *bval;
137 struct internalvar *ivar;
138 }
139
140%type <lval> positional_list component_groups component_associations
141%type <lval> aggregate_component_list
142%type <tval> var_or_type
143
144%token <typed_val> INT NULL_PTR CHARLIT
145%token <typed_val_float> FLOAT
146%token TRUEKEYWORD FALSEKEYWORD
147%token COLONCOLON
148%token <sval> STRING NAME DOT_ID
149%type <bval> block
150%type <lval> arglist tick_arglist
151
152%type <tval> save_qualifier
153
154%token DOT_ALL
155
156/* Special type cases, put in to allow the parser to distinguish different
157 legal basetypes. */
158%token <sval> SPECIAL_VARIABLE
159
160%nonassoc ASSIGN
161%left _AND_ OR XOR THEN ELSE
162%left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
163%left '@'
164%left '+' '-' '&'
165%left UNARY
166%left '*' '/' MOD REM
167%right STARSTAR ABS NOT
168
169/* Artificial token to give NAME => ... and NAME | priority over reducing
170 NAME to <primary> and to give <primary>' priority over reducing <primary>
171 to <simple_exp>. */
172%nonassoc VAR
173
174%nonassoc ARROW '|'
175
176%right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
177%right TICK_MAX TICK_MIN TICK_MODULUS
178%right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
179 /* The following are right-associative only so that reductions at this
180 precedence have lower precedence than '.' and '('. The syntax still
181 forces a.b.c, e.g., to be LEFT-associated. */
182%right '.' '(' '[' DOT_ID DOT_ALL
183
184%token NEW OTHERS
185
186\f
187%%
188
189start : exp1
190 ;
191
192/* Expressions, including the sequencing operator. */
193exp1 : exp
194 | exp1 ';' exp
195 { write_exp_elt_opcode (pstate, BINOP_COMMA); }
196 | primary ASSIGN exp /* Extension for convenience */
197 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
198 ;
199
200/* Expressions, not including the sequencing operator. */
201primary : primary DOT_ALL
202 { write_exp_elt_opcode (pstate, UNOP_IND); }
203 ;
204
205primary : primary DOT_ID
206 { write_exp_op_with_string (pstate, STRUCTOP_STRUCT,
207 $2); }
208 ;
209
210primary : primary '(' arglist ')'
211 {
212 write_exp_elt_opcode (pstate, OP_FUNCALL);
213 write_exp_elt_longcst (pstate, $3);
214 write_exp_elt_opcode (pstate, OP_FUNCALL);
215 }
216 | var_or_type '(' arglist ')'
217 {
218 if ($1 != NULL)
219 {
220 if ($3 != 1)
221 error (_("Invalid conversion"));
222 write_exp_elt_opcode (pstate, UNOP_CAST);
223 write_exp_elt_type (pstate, $1);
224 write_exp_elt_opcode (pstate, UNOP_CAST);
225 }
226 else
227 {
228 write_exp_elt_opcode (pstate, OP_FUNCALL);
229 write_exp_elt_longcst (pstate, $3);
230 write_exp_elt_opcode (pstate, OP_FUNCALL);
231 }
232 }
233 ;
234
235primary : var_or_type '\'' save_qualifier { type_qualifier = $1; }
236 '(' exp ')'
237 {
238 if ($1 == NULL)
239 error (_("Type required for qualification"));
240 write_exp_elt_opcode (pstate, UNOP_QUAL);
241 write_exp_elt_type (pstate, $1);
242 write_exp_elt_opcode (pstate, UNOP_QUAL);
243 type_qualifier = $3;
244 }
245 ;
246
247save_qualifier : { $$ = type_qualifier; }
248 ;
249
250primary :
251 primary '(' simple_exp DOTDOT simple_exp ')'
252 { write_exp_elt_opcode (pstate, TERNOP_SLICE); }
253 | var_or_type '(' simple_exp DOTDOT simple_exp ')'
254 { if ($1 == NULL)
255 write_exp_elt_opcode (pstate, TERNOP_SLICE);
256 else
257 error (_("Cannot slice a type"));
258 }
259 ;
260
261primary : '(' exp1 ')' { }
262 ;
263
264/* The following rule causes a conflict with the type conversion
265 var_or_type (exp)
266 To get around it, we give '(' higher priority and add bridge rules for
267 var_or_type (exp, exp, ...)
268 var_or_type (exp .. exp)
269 We also have the action for var_or_type(exp) generate a function call
270 when the first symbol does not denote a type. */
271
272primary : var_or_type %prec VAR
273 { if ($1 != NULL)
274 {
275 write_exp_elt_opcode (pstate, OP_TYPE);
276 write_exp_elt_type (pstate, $1);
277 write_exp_elt_opcode (pstate, OP_TYPE);
278 }
279 }
280 ;
281
282primary : SPECIAL_VARIABLE /* Various GDB extensions */
283 { write_dollar_variable (pstate, $1); }
284 ;
285
286primary : aggregate
287 ;
288
289simple_exp : primary
290 ;
291
292simple_exp : '-' simple_exp %prec UNARY
293 { write_exp_elt_opcode (pstate, UNOP_NEG); }
294 ;
295
296simple_exp : '+' simple_exp %prec UNARY
297 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
298 ;
299
300simple_exp : NOT simple_exp %prec UNARY
301 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
302 ;
303
304simple_exp : ABS simple_exp %prec UNARY
305 { write_exp_elt_opcode (pstate, UNOP_ABS); }
306 ;
307
308arglist : { $$ = 0; }
309 ;
310
311arglist : exp
312 { $$ = 1; }
313 | NAME ARROW exp
314 { $$ = 1; }
315 | arglist ',' exp
316 { $$ = $1 + 1; }
317 | arglist ',' NAME ARROW exp
318 { $$ = $1 + 1; }
319 ;
320
321primary : '{' var_or_type '}' primary %prec '.'
322 /* GDB extension */
323 {
324 if ($2 == NULL)
325 error (_("Type required within braces in coercion"));
326 write_exp_elt_opcode (pstate, UNOP_MEMVAL);
327 write_exp_elt_type (pstate, $2);
328 write_exp_elt_opcode (pstate, UNOP_MEMVAL);
329 }
330 ;
331
332/* Binary operators in order of decreasing precedence. */
333
334simple_exp : simple_exp STARSTAR simple_exp
335 { write_exp_elt_opcode (pstate, BINOP_EXP); }
336 ;
337
338simple_exp : simple_exp '*' simple_exp
339 { write_exp_elt_opcode (pstate, BINOP_MUL); }
340 ;
341
342simple_exp : simple_exp '/' simple_exp
343 { write_exp_elt_opcode (pstate, BINOP_DIV); }
344 ;
345
346simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
347 { write_exp_elt_opcode (pstate, BINOP_REM); }
348 ;
349
350simple_exp : simple_exp MOD simple_exp
351 { write_exp_elt_opcode (pstate, BINOP_MOD); }
352 ;
353
354simple_exp : simple_exp '@' simple_exp /* GDB extension */
355 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
356 ;
357
358simple_exp : simple_exp '+' simple_exp
359 { write_exp_elt_opcode (pstate, BINOP_ADD); }
360 ;
361
362simple_exp : simple_exp '&' simple_exp
363 { write_exp_elt_opcode (pstate, BINOP_CONCAT); }
364 ;
365
366simple_exp : simple_exp '-' simple_exp
367 { write_exp_elt_opcode (pstate, BINOP_SUB); }
368 ;
369
370relation : simple_exp
371 ;
372
373relation : simple_exp '=' simple_exp
374 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
375 ;
376
377relation : simple_exp NOTEQUAL simple_exp
378 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
379 ;
380
381relation : simple_exp LEQ simple_exp
382 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
383 ;
384
385relation : simple_exp IN simple_exp DOTDOT simple_exp
386 { write_exp_elt_opcode (pstate, TERNOP_IN_RANGE); }
387 | simple_exp IN primary TICK_RANGE tick_arglist
388 { write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
389 write_exp_elt_longcst (pstate, (LONGEST) $5);
390 write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
391 }
392 | simple_exp IN var_or_type %prec TICK_ACCESS
393 {
394 if ($3 == NULL)
395 error (_("Right operand of 'in' must be type"));
396 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
397 write_exp_elt_type (pstate, $3);
398 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
399 }
400 | simple_exp NOT IN simple_exp DOTDOT simple_exp
401 { write_exp_elt_opcode (pstate, TERNOP_IN_RANGE);
402 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
403 }
404 | simple_exp NOT IN primary TICK_RANGE tick_arglist
405 { write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
406 write_exp_elt_longcst (pstate, (LONGEST) $6);
407 write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
408 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
409 }
410 | simple_exp NOT IN var_or_type %prec TICK_ACCESS
411 {
412 if ($4 == NULL)
413 error (_("Right operand of 'in' must be type"));
414 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
415 write_exp_elt_type (pstate, $4);
416 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
417 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
418 }
419 ;
420
421relation : simple_exp GEQ simple_exp
422 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
423 ;
424
425relation : simple_exp '<' simple_exp
426 { write_exp_elt_opcode (pstate, BINOP_LESS); }
427 ;
428
429relation : simple_exp '>' simple_exp
430 { write_exp_elt_opcode (pstate, BINOP_GTR); }
431 ;
432
433exp : relation
434 | and_exp
435 | and_then_exp
436 | or_exp
437 | or_else_exp
438 | xor_exp
439 ;
440
441and_exp :
442 relation _AND_ relation
443 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
444 | and_exp _AND_ relation
445 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
446 ;
447
448and_then_exp :
449 relation _AND_ THEN relation
450 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
451 | and_then_exp _AND_ THEN relation
452 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
453 ;
454
455or_exp :
456 relation OR relation
457 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
458 | or_exp OR relation
459 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
460 ;
461
462or_else_exp :
463 relation OR ELSE relation
464 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
465 | or_else_exp OR ELSE relation
466 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
467 ;
468
469xor_exp : relation XOR relation
470 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
471 | xor_exp XOR relation
472 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
473 ;
474
475/* Primaries can denote types (OP_TYPE). In cases such as
476 primary TICK_ADDRESS, where a type would be invalid, it will be
477 caught when evaluate_subexp in ada-lang.c tries to evaluate the
478 primary, expecting a value. Precedence rules resolve the ambiguity
479 in NAME TICK_ACCESS in favor of shifting to form a var_or_type. A
480 construct such as aType'access'access will again cause an error when
481 aType'access evaluates to a type that evaluate_subexp attempts to
482 evaluate. */
483primary : primary TICK_ACCESS
484 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
485 | primary TICK_ADDRESS
486 { write_exp_elt_opcode (pstate, UNOP_ADDR);
487 write_exp_elt_opcode (pstate, UNOP_CAST);
488 write_exp_elt_type (pstate,
489 type_system_address (pstate));
490 write_exp_elt_opcode (pstate, UNOP_CAST);
491 }
492 | primary TICK_FIRST tick_arglist
493 { write_int (pstate, $3, type_int (pstate));
494 write_exp_elt_opcode (pstate, OP_ATR_FIRST); }
495 | primary TICK_LAST tick_arglist
496 { write_int (pstate, $3, type_int (pstate));
497 write_exp_elt_opcode (pstate, OP_ATR_LAST); }
498 | primary TICK_LENGTH tick_arglist
499 { write_int (pstate, $3, type_int (pstate));
500 write_exp_elt_opcode (pstate, OP_ATR_LENGTH); }
501 | primary TICK_SIZE
502 { write_exp_elt_opcode (pstate, OP_ATR_SIZE); }
503 | primary TICK_TAG
504 { write_exp_elt_opcode (pstate, OP_ATR_TAG); }
505 | opt_type_prefix TICK_MIN '(' exp ',' exp ')'
506 { write_exp_elt_opcode (pstate, OP_ATR_MIN); }
507 | opt_type_prefix TICK_MAX '(' exp ',' exp ')'
508 { write_exp_elt_opcode (pstate, OP_ATR_MAX); }
509 | opt_type_prefix TICK_POS '(' exp ')'
510 { write_exp_elt_opcode (pstate, OP_ATR_POS); }
511 | type_prefix TICK_VAL '(' exp ')'
512 { write_exp_elt_opcode (pstate, OP_ATR_VAL); }
513 | type_prefix TICK_MODULUS
514 { write_exp_elt_opcode (pstate, OP_ATR_MODULUS); }
515 ;
516
517tick_arglist : %prec '('
518 { $$ = 1; }
519 | '(' INT ')'
520 { $$ = $2.val; }
521 ;
522
523type_prefix :
524 var_or_type
525 {
526 if ($1 == NULL)
527 error (_("Prefix must be type"));
528 write_exp_elt_opcode (pstate, OP_TYPE);
529 write_exp_elt_type (pstate, $1);
530 write_exp_elt_opcode (pstate, OP_TYPE); }
531 ;
532
533opt_type_prefix :
534 type_prefix
535 | /* EMPTY */
536 { write_exp_elt_opcode (pstate, OP_TYPE);
537 write_exp_elt_type (pstate,
538 parse_type (pstate)->builtin_void);
539 write_exp_elt_opcode (pstate, OP_TYPE); }
540 ;
541
542
543primary : INT
544 { write_int (pstate, (LONGEST) $1.val, $1.type); }
545 ;
546
547primary : CHARLIT
548 { write_int (pstate,
549 convert_char_literal (type_qualifier, $1.val),
550 (type_qualifier == NULL)
551 ? $1.type : type_qualifier);
552 }
553 ;
554
555primary : FLOAT
556 { write_exp_elt_opcode (pstate, OP_DOUBLE);
557 write_exp_elt_type (pstate, $1.type);
558 write_exp_elt_dblcst (pstate, $1.dval);
559 write_exp_elt_opcode (pstate, OP_DOUBLE);
560 }
561 ;
562
563primary : NULL_PTR
564 { write_int (pstate, 0, type_int (pstate)); }
565 ;
566
567primary : STRING
568 {
569 write_exp_op_with_string (pstate, OP_STRING, $1);
570 }
571 ;
572
573primary : TRUEKEYWORD
574 { write_int (pstate, 1, type_boolean (pstate)); }
575 | FALSEKEYWORD
576 { write_int (pstate, 0, type_boolean (pstate)); }
577 ;
578
579primary : NEW NAME
580 { error (_("NEW not implemented.")); }
581 ;
582
583var_or_type: NAME %prec VAR
584 { $$ = write_var_or_type (pstate, NULL, $1); }
585 | block NAME %prec VAR
586 { $$ = write_var_or_type (pstate, $1, $2); }
587 | NAME TICK_ACCESS
588 {
589 $$ = write_var_or_type (pstate, NULL, $1);
590 if ($$ == NULL)
591 write_exp_elt_opcode (pstate, UNOP_ADDR);
592 else
593 $$ = lookup_pointer_type ($$);
594 }
595 | block NAME TICK_ACCESS
596 {
597 $$ = write_var_or_type (pstate, $1, $2);
598 if ($$ == NULL)
599 write_exp_elt_opcode (pstate, UNOP_ADDR);
600 else
601 $$ = lookup_pointer_type ($$);
602 }
603 ;
604
605/* GDB extension */
606block : NAME COLONCOLON
607 { $$ = block_lookup (NULL, $1.ptr); }
608 | block NAME COLONCOLON
609 { $$ = block_lookup ($1, $2.ptr); }
610 ;
611
612aggregate :
613 '(' aggregate_component_list ')'
614 {
615 write_exp_elt_opcode (pstate, OP_AGGREGATE);
616 write_exp_elt_longcst (pstate, $2);
617 write_exp_elt_opcode (pstate, OP_AGGREGATE);
618 }
619 ;
620
621aggregate_component_list :
622 component_groups { $$ = $1; }
623 | positional_list exp
624 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
625 write_exp_elt_longcst (pstate, $1);
626 write_exp_elt_opcode (pstate, OP_POSITIONAL);
627 $$ = $1 + 1;
628 }
629 | positional_list component_groups
630 { $$ = $1 + $2; }
631 ;
632
633positional_list :
634 exp ','
635 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
636 write_exp_elt_longcst (pstate, 0);
637 write_exp_elt_opcode (pstate, OP_POSITIONAL);
638 $$ = 1;
639 }
640 | positional_list exp ','
641 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
642 write_exp_elt_longcst (pstate, $1);
643 write_exp_elt_opcode (pstate, OP_POSITIONAL);
644 $$ = $1 + 1;
645 }
646 ;
647
648component_groups:
649 others { $$ = 1; }
650 | component_group { $$ = 1; }
651 | component_group ',' component_groups
652 { $$ = $3 + 1; }
653 ;
654
655others : OTHERS ARROW exp
656 { write_exp_elt_opcode (pstate, OP_OTHERS); }
657 ;
658
659component_group :
660 component_associations
661 {
662 write_exp_elt_opcode (pstate, OP_CHOICES);
663 write_exp_elt_longcst (pstate, $1);
664 write_exp_elt_opcode (pstate, OP_CHOICES);
665 }
666 ;
667
668/* We use this somewhat obscure definition in order to handle NAME => and
669 NAME | differently from exp => and exp |. ARROW and '|' have a precedence
670 above that of the reduction of NAME to var_or_type. By delaying
671 decisions until after the => or '|', we convert the ambiguity to a
672 resolved shift/reduce conflict. */
673component_associations :
674 NAME ARROW
675 { write_name_assoc (pstate, $1); }
676 exp { $$ = 1; }
677 | simple_exp ARROW exp
678 { $$ = 1; }
679 | simple_exp DOTDOT simple_exp ARROW
680 { write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE);
681 write_exp_op_with_string (pstate, OP_NAME,
682 empty_stoken);
683 }
684 exp { $$ = 1; }
685 | NAME '|'
686 { write_name_assoc (pstate, $1); }
687 component_associations { $$ = $4 + 1; }
688 | simple_exp '|'
689 component_associations { $$ = $3 + 1; }
690 | simple_exp DOTDOT simple_exp '|'
691 { write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE); }
692 component_associations { $$ = $6 + 1; }
693 ;
694
695/* Some extensions borrowed from C, for the benefit of those who find they
696 can't get used to Ada notation in GDB. */
697
698primary : '*' primary %prec '.'
699 { write_exp_elt_opcode (pstate, UNOP_IND); }
700 | '&' primary %prec '.'
701 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
702 | primary '[' exp ']'
703 { write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); }
704 ;
705
706%%
707
708/* yylex defined in ada-lex.c: Reads one token, getting characters */
709/* through lexptr. */
710
711/* Remap normal flex interface names (yylex) as well as gratuitiously */
712/* global symbol names, so we can have multiple flex-generated parsers */
713/* in gdb. */
714
715/* (See note above on previous definitions for YACC.) */
716
717#define yy_create_buffer ada_yy_create_buffer
718#define yy_delete_buffer ada_yy_delete_buffer
719#define yy_init_buffer ada_yy_init_buffer
720#define yy_load_buffer_state ada_yy_load_buffer_state
721#define yy_switch_to_buffer ada_yy_switch_to_buffer
722#define yyrestart ada_yyrestart
723#define yytext ada_yytext
724#define yywrap ada_yywrap
725
726static struct obstack temp_parse_space;
727
728/* The following kludge was found necessary to prevent conflicts between */
729/* defs.h and non-standard stdlib.h files. */
730#define qsort __qsort__dummy
731#include "ada-lex.c"
732
733int
734ada_parse (struct parser_state *par_state)
735{
736 int result;
737 struct cleanup *c = make_cleanup_clear_parser_state (&pstate);
738
739 /* Setting up the parser state. */
740 gdb_assert (par_state != NULL);
741 pstate = par_state;
742
743 lexer_init (yyin); /* (Re-)initialize lexer. */
744 type_qualifier = NULL;
745 obstack_free (&temp_parse_space, NULL);
746 obstack_init (&temp_parse_space);
747
748 result = yyparse ();
749 do_cleanups (c);
750 return result;
751}
752
753void
754yyerror (char *msg)
755{
756 error (_("Error in expression, near `%s'."), lexptr);
757}
758
759/* Emit expression to access an instance of SYM, in block BLOCK (if
760 * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
761static void
762write_var_from_sym (struct parser_state *par_state,
763 const struct block *orig_left_context,
764 const struct block *block,
765 struct symbol *sym)
766{
767 if (orig_left_context == NULL && symbol_read_needs_frame (sym))
768 {
769 if (innermost_block == 0
770 || contained_in (block, innermost_block))
771 innermost_block = block;
772 }
773
774 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
775 write_exp_elt_block (par_state, block);
776 write_exp_elt_sym (par_state, sym);
777 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
778}
779
780/* Write integer or boolean constant ARG of type TYPE. */
781
782static void
783write_int (struct parser_state *par_state, LONGEST arg, struct type *type)
784{
785 write_exp_elt_opcode (par_state, OP_LONG);
786 write_exp_elt_type (par_state, type);
787 write_exp_elt_longcst (par_state, arg);
788 write_exp_elt_opcode (par_state, OP_LONG);
789}
790
791/* Write an OPCODE, string, OPCODE sequence to the current expression. */
792static void
793write_exp_op_with_string (struct parser_state *par_state,
794 enum exp_opcode opcode, struct stoken token)
795{
796 write_exp_elt_opcode (par_state, opcode);
797 write_exp_string (par_state, token);
798 write_exp_elt_opcode (par_state, opcode);
799}
800
801/* Emit expression corresponding to the renamed object named
802 * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
803 * context of ORIG_LEFT_CONTEXT, to which is applied the operations
804 * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of
805 * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it
806 * defaults to the currently selected block. ORIG_SYMBOL is the
807 * symbol that originally encoded the renaming. It is needed only
808 * because its prefix also qualifies any index variables used to index
809 * or slice an array. It should not be necessary once we go to the
810 * new encoding entirely (FIXME pnh 7/20/2007). */
811
812static void
813write_object_renaming (struct parser_state *par_state,
814 const struct block *orig_left_context,
815 const char *renamed_entity, int renamed_entity_len,
816 const char *renaming_expr, int max_depth)
817{
818 char *name;
819 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
820 struct block_symbol sym_info;
821
822 if (max_depth <= 0)
823 error (_("Could not find renamed symbol"));
824
825 if (orig_left_context == NULL)
826 orig_left_context = get_selected_block (NULL);
827
828 name = (char *) obstack_copy0 (&temp_parse_space, renamed_entity,
829 renamed_entity_len);
830 ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, &sym_info);
831 if (sym_info.symbol == NULL)
832 error (_("Could not find renamed variable: %s"), ada_decode (name));
833 else if (SYMBOL_CLASS (sym_info.symbol) == LOC_TYPEDEF)
834 /* We have a renaming of an old-style renaming symbol. Don't
835 trust the block information. */
836 sym_info.block = orig_left_context;
837
838 {
839 const char *inner_renamed_entity;
840 int inner_renamed_entity_len;
841 const char *inner_renaming_expr;
842
843 switch (ada_parse_renaming (sym_info.symbol, &inner_renamed_entity,
844 &inner_renamed_entity_len,
845 &inner_renaming_expr))
846 {
847 case ADA_NOT_RENAMING:
848 write_var_from_sym (par_state, orig_left_context, sym_info.block,
849 sym_info.symbol);
850 break;
851 case ADA_OBJECT_RENAMING:
852 write_object_renaming (par_state, sym_info.block,
853 inner_renamed_entity, inner_renamed_entity_len,
854 inner_renaming_expr, max_depth - 1);
855 break;
856 default:
857 goto BadEncoding;
858 }
859 }
860
861 slice_state = SIMPLE_INDEX;
862 while (*renaming_expr == 'X')
863 {
864 renaming_expr += 1;
865
866 switch (*renaming_expr) {
867 case 'A':
868 renaming_expr += 1;
869 write_exp_elt_opcode (par_state, UNOP_IND);
870 break;
871 case 'L':
872 slice_state = LOWER_BOUND;
873 /* FALLTHROUGH */
874 case 'S':
875 renaming_expr += 1;
876 if (isdigit (*renaming_expr))
877 {
878 char *next;
879 long val = strtol (renaming_expr, &next, 10);
880 if (next == renaming_expr)
881 goto BadEncoding;
882 renaming_expr = next;
883 write_exp_elt_opcode (par_state, OP_LONG);
884 write_exp_elt_type (par_state, type_int (par_state));
885 write_exp_elt_longcst (par_state, (LONGEST) val);
886 write_exp_elt_opcode (par_state, OP_LONG);
887 }
888 else
889 {
890 const char *end;
891 char *index_name;
892 struct block_symbol index_sym_info;
893
894 end = strchr (renaming_expr, 'X');
895 if (end == NULL)
896 end = renaming_expr + strlen (renaming_expr);
897
898 index_name
899 = (char *) obstack_copy0 (&temp_parse_space, renaming_expr,
900 end - renaming_expr);
901 renaming_expr = end;
902
903 ada_lookup_encoded_symbol (index_name, NULL, VAR_DOMAIN,
904 &index_sym_info);
905 if (index_sym_info.symbol == NULL)
906 error (_("Could not find %s"), index_name);
907 else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF)
908 /* Index is an old-style renaming symbol. */
909 index_sym_info.block = orig_left_context;
910 write_var_from_sym (par_state, NULL, index_sym_info.block,
911 index_sym_info.symbol);
912 }
913 if (slice_state == SIMPLE_INDEX)
914 {
915 write_exp_elt_opcode (par_state, OP_FUNCALL);
916 write_exp_elt_longcst (par_state, (LONGEST) 1);
917 write_exp_elt_opcode (par_state, OP_FUNCALL);
918 }
919 else if (slice_state == LOWER_BOUND)
920 slice_state = UPPER_BOUND;
921 else if (slice_state == UPPER_BOUND)
922 {
923 write_exp_elt_opcode (par_state, TERNOP_SLICE);
924 slice_state = SIMPLE_INDEX;
925 }
926 break;
927
928 case 'R':
929 {
930 struct stoken field_name;
931 const char *end;
932 char *buf;
933
934 renaming_expr += 1;
935
936 if (slice_state != SIMPLE_INDEX)
937 goto BadEncoding;
938 end = strchr (renaming_expr, 'X');
939 if (end == NULL)
940 end = renaming_expr + strlen (renaming_expr);
941 field_name.length = end - renaming_expr;
942 buf = (char *) malloc (end - renaming_expr + 1);
943 field_name.ptr = buf;
944 strncpy (buf, renaming_expr, end - renaming_expr);
945 buf[end - renaming_expr] = '\000';
946 renaming_expr = end;
947 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
948 break;
949 }
950
951 default:
952 goto BadEncoding;
953 }
954 }
955 if (slice_state == SIMPLE_INDEX)
956 return;
957
958 BadEncoding:
959 error (_("Internal error in encoding of renaming declaration"));
960}
961
962static const struct block*
963block_lookup (const struct block *context, const char *raw_name)
964{
965 const char *name;
966 struct block_symbol *syms;
967 int nsyms;
968 struct symtab *symtab;
969
970 if (raw_name[0] == '\'')
971 {
972 raw_name += 1;
973 name = raw_name;
974 }
975 else
976 name = ada_encode (raw_name);
977
978 nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
979 if (context == NULL
980 && (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK))
981 symtab = lookup_symtab (name);
982 else
983 symtab = NULL;
984
985 if (symtab != NULL)
986 return BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symtab), STATIC_BLOCK);
987 else if (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK)
988 {
989 if (context == NULL)
990 error (_("No file or function \"%s\"."), raw_name);
991 else
992 error (_("No function \"%s\" in specified context."), raw_name);
993 }
994 else
995 {
996 if (nsyms > 1)
997 warning (_("Function name \"%s\" ambiguous here"), raw_name);
998 return SYMBOL_BLOCK_VALUE (syms[0].symbol);
999 }
1000}
1001
1002static struct symbol*
1003select_possible_type_sym (struct block_symbol *syms, int nsyms)
1004{
1005 int i;
1006 int preferred_index;
1007 struct type *preferred_type;
1008
1009 preferred_index = -1; preferred_type = NULL;
1010 for (i = 0; i < nsyms; i += 1)
1011 switch (SYMBOL_CLASS (syms[i].symbol))
1012 {
1013 case LOC_TYPEDEF:
1014 if (ada_prefer_type (SYMBOL_TYPE (syms[i].symbol), preferred_type))
1015 {
1016 preferred_index = i;
1017 preferred_type = SYMBOL_TYPE (syms[i].symbol);
1018 }
1019 break;
1020 case LOC_REGISTER:
1021 case LOC_ARG:
1022 case LOC_REF_ARG:
1023 case LOC_REGPARM_ADDR:
1024 case LOC_LOCAL:
1025 case LOC_COMPUTED:
1026 return NULL;
1027 default:
1028 break;
1029 }
1030 if (preferred_type == NULL)
1031 return NULL;
1032 return syms[preferred_index].symbol;
1033}
1034
1035static struct type*
1036find_primitive_type (struct parser_state *par_state, char *name)
1037{
1038 struct type *type;
1039 type = language_lookup_primitive_type (parse_language (par_state),
1040 parse_gdbarch (par_state),
1041 name);
1042 if (type == NULL && strcmp ("system__address", name) == 0)
1043 type = type_system_address (par_state);
1044
1045 if (type != NULL)
1046 {
1047 /* Check to see if we have a regular definition of this
1048 type that just didn't happen to have been read yet. */
1049 struct symbol *sym;
1050 char *expanded_name =
1051 (char *) alloca (strlen (name) + sizeof ("standard__"));
1052 strcpy (expanded_name, "standard__");
1053 strcat (expanded_name, name);
1054 sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL).symbol;
1055 if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1056 type = SYMBOL_TYPE (sym);
1057 }
1058
1059 return type;
1060}
1061
1062static int
1063chop_selector (char *name, int end)
1064{
1065 int i;
1066 for (i = end - 1; i > 0; i -= 1)
1067 if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1068 return i;
1069 return -1;
1070}
1071
1072/* If NAME is a string beginning with a separator (either '__', or
1073 '.'), chop this separator and return the result; else, return
1074 NAME. */
1075
1076static char *
1077chop_separator (char *name)
1078{
1079 if (*name == '.')
1080 return name + 1;
1081
1082 if (name[0] == '_' && name[1] == '_')
1083 return name + 2;
1084
1085 return name;
1086}
1087
1088/* Given that SELS is a string of the form (<sep><identifier>)*, where
1089 <sep> is '__' or '.', write the indicated sequence of
1090 STRUCTOP_STRUCT expression operators. */
1091static void
1092write_selectors (struct parser_state *par_state, char *sels)
1093{
1094 while (*sels != '\0')
1095 {
1096 struct stoken field_name;
1097 char *p = chop_separator (sels);
1098 sels = p;
1099 while (*sels != '\0' && *sels != '.'
1100 && (sels[0] != '_' || sels[1] != '_'))
1101 sels += 1;
1102 field_name.length = sels - p;
1103 field_name.ptr = p;
1104 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
1105 }
1106}
1107
1108/* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1109 NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes
1110 a temporary symbol that is valid until the next call to ada_parse.
1111 */
1112static void
1113write_ambiguous_var (struct parser_state *par_state,
1114 const struct block *block, char *name, int len)
1115{
1116 struct symbol *sym = XOBNEW (&temp_parse_space, struct symbol);
1117
1118 memset (sym, 0, sizeof (struct symbol));
1119 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1120 SYMBOL_LINKAGE_NAME (sym)
1121 = (const char *) obstack_copy0 (&temp_parse_space, name, len);
1122 SYMBOL_LANGUAGE (sym) = language_ada;
1123
1124 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1125 write_exp_elt_block (par_state, block);
1126 write_exp_elt_sym (par_state, sym);
1127 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1128}
1129
1130/* A convenient wrapper around ada_get_field_index that takes
1131 a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1132 of a NUL-terminated field name. */
1133
1134static int
1135ada_nget_field_index (const struct type *type, const char *field_name0,
1136 int field_name_len, int maybe_missing)
1137{
1138 char *field_name = (char *) alloca ((field_name_len + 1) * sizeof (char));
1139
1140 strncpy (field_name, field_name0, field_name_len);
1141 field_name[field_name_len] = '\0';
1142 return ada_get_field_index (type, field_name, maybe_missing);
1143}
1144
1145/* If encoded_field_name is the name of a field inside symbol SYM,
1146 then return the type of that field. Otherwise, return NULL.
1147
1148 This function is actually recursive, so if ENCODED_FIELD_NAME
1149 doesn't match one of the fields of our symbol, then try to see
1150 if ENCODED_FIELD_NAME could not be a succession of field names
1151 (in other words, the user entered an expression of the form
1152 TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1153 each field name sequentially to obtain the desired field type.
1154 In case of failure, we return NULL. */
1155
1156static struct type *
1157get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1158{
1159 char *field_name = encoded_field_name;
1160 char *subfield_name;
1161 struct type *type = SYMBOL_TYPE (sym);
1162 int fieldno;
1163
1164 if (type == NULL || field_name == NULL)
1165 return NULL;
1166 type = check_typedef (type);
1167
1168 while (field_name[0] != '\0')
1169 {
1170 field_name = chop_separator (field_name);
1171
1172 fieldno = ada_get_field_index (type, field_name, 1);
1173 if (fieldno >= 0)
1174 return TYPE_FIELD_TYPE (type, fieldno);
1175
1176 subfield_name = field_name;
1177 while (*subfield_name != '\0' && *subfield_name != '.'
1178 && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1179 subfield_name += 1;
1180
1181 if (subfield_name[0] == '\0')
1182 return NULL;
1183
1184 fieldno = ada_nget_field_index (type, field_name,
1185 subfield_name - field_name, 1);
1186 if (fieldno < 0)
1187 return NULL;
1188
1189 type = TYPE_FIELD_TYPE (type, fieldno);
1190 field_name = subfield_name;
1191 }
1192
1193 return NULL;
1194}
1195
1196/* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
1197 expression_block_context if NULL). If it denotes a type, return
1198 that type. Otherwise, write expression code to evaluate it as an
1199 object and return NULL. In this second case, NAME0 will, in general,
1200 have the form <name>(.<selector_name>)*, where <name> is an object
1201 or renaming encoded in the debugging data. Calls error if no
1202 prefix <name> matches a name in the debugging data (i.e., matches
1203 either a complete name or, as a wild-card match, the final
1204 identifier). */
1205
1206static struct type*
1207write_var_or_type (struct parser_state *par_state,
1208 const struct block *block, struct stoken name0)
1209{
1210 int depth;
1211 char *encoded_name;
1212 int name_len;
1213
1214 if (block == NULL)
1215 block = expression_context_block;
1216
1217 encoded_name = ada_encode (name0.ptr);
1218 name_len = strlen (encoded_name);
1219 encoded_name
1220 = (char *) obstack_copy0 (&temp_parse_space, encoded_name, name_len);
1221 for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1222 {
1223 int tail_index;
1224
1225 tail_index = name_len;
1226 while (tail_index > 0)
1227 {
1228 int nsyms;
1229 struct block_symbol *syms;
1230 struct symbol *type_sym;
1231 struct symbol *renaming_sym;
1232 const char* renaming;
1233 int renaming_len;
1234 const char* renaming_expr;
1235 int terminator = encoded_name[tail_index];
1236
1237 encoded_name[tail_index] = '\0';
1238 nsyms = ada_lookup_symbol_list (encoded_name, block,
1239 VAR_DOMAIN, &syms);
1240 encoded_name[tail_index] = terminator;
1241
1242 /* A single symbol may rename a package or object. */
1243
1244 /* This should go away when we move entirely to new version.
1245 FIXME pnh 7/20/2007. */
1246 if (nsyms == 1)
1247 {
1248 struct symbol *ren_sym =
1249 ada_find_renaming_symbol (syms[0].symbol, syms[0].block);
1250
1251 if (ren_sym != NULL)
1252 syms[0].symbol = ren_sym;
1253 }
1254
1255 type_sym = select_possible_type_sym (syms, nsyms);
1256
1257 if (type_sym != NULL)
1258 renaming_sym = type_sym;
1259 else if (nsyms == 1)
1260 renaming_sym = syms[0].symbol;
1261 else
1262 renaming_sym = NULL;
1263
1264 switch (ada_parse_renaming (renaming_sym, &renaming,
1265 &renaming_len, &renaming_expr))
1266 {
1267 case ADA_NOT_RENAMING:
1268 break;
1269 case ADA_PACKAGE_RENAMING:
1270 case ADA_EXCEPTION_RENAMING:
1271 case ADA_SUBPROGRAM_RENAMING:
1272 {
1273 int alloc_len = renaming_len + name_len - tail_index + 1;
1274 char *new_name
1275 = (char *) obstack_alloc (&temp_parse_space, alloc_len);
1276 strncpy (new_name, renaming, renaming_len);
1277 strcpy (new_name + renaming_len, encoded_name + tail_index);
1278 encoded_name = new_name;
1279 name_len = renaming_len + name_len - tail_index;
1280 goto TryAfterRenaming;
1281 }
1282 case ADA_OBJECT_RENAMING:
1283 write_object_renaming (par_state, block, renaming, renaming_len,
1284 renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1285 write_selectors (par_state, encoded_name + tail_index);
1286 return NULL;
1287 default:
1288 internal_error (__FILE__, __LINE__,
1289 _("impossible value from ada_parse_renaming"));
1290 }
1291
1292 if (type_sym != NULL)
1293 {
1294 struct type *field_type;
1295
1296 if (tail_index == name_len)
1297 return SYMBOL_TYPE (type_sym);
1298
1299 /* We have some extraneous characters after the type name.
1300 If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1301 then try to get the type of FIELDN. */
1302 field_type
1303 = get_symbol_field_type (type_sym, encoded_name + tail_index);
1304 if (field_type != NULL)
1305 return field_type;
1306 else
1307 error (_("Invalid attempt to select from type: \"%s\"."),
1308 name0.ptr);
1309 }
1310 else if (tail_index == name_len && nsyms == 0)
1311 {
1312 struct type *type = find_primitive_type (par_state,
1313 encoded_name);
1314
1315 if (type != NULL)
1316 return type;
1317 }
1318
1319 if (nsyms == 1)
1320 {
1321 write_var_from_sym (par_state, block, syms[0].block,
1322 syms[0].symbol);
1323 write_selectors (par_state, encoded_name + tail_index);
1324 return NULL;
1325 }
1326 else if (nsyms == 0)
1327 {
1328 struct bound_minimal_symbol msym
1329 = ada_lookup_simple_minsym (encoded_name);
1330 if (msym.minsym != NULL)
1331 {
1332 write_exp_msymbol (par_state, msym);
1333 /* Maybe cause error here rather than later? FIXME? */
1334 write_selectors (par_state, encoded_name + tail_index);
1335 return NULL;
1336 }
1337
1338 if (tail_index == name_len
1339 && strncmp (encoded_name, "standard__",
1340 sizeof ("standard__") - 1) == 0)
1341 error (_("No definition of \"%s\" found."), name0.ptr);
1342
1343 tail_index = chop_selector (encoded_name, tail_index);
1344 }
1345 else
1346 {
1347 write_ambiguous_var (par_state, block, encoded_name,
1348 tail_index);
1349 write_selectors (par_state, encoded_name + tail_index);
1350 return NULL;
1351 }
1352 }
1353
1354 if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1355 error (_("No symbol table is loaded. Use the \"file\" command."));
1356 if (block == expression_context_block)
1357 error (_("No definition of \"%s\" in current context."), name0.ptr);
1358 else
1359 error (_("No definition of \"%s\" in specified context."), name0.ptr);
1360
1361 TryAfterRenaming: ;
1362 }
1363
1364 error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1365
1366}
1367
1368/* Write a left side of a component association (e.g., NAME in NAME =>
1369 exp). If NAME has the form of a selected component, write it as an
1370 ordinary expression. If it is a simple variable that unambiguously
1371 corresponds to exactly one symbol that does not denote a type or an
1372 object renaming, also write it normally as an OP_VAR_VALUE.
1373 Otherwise, write it as an OP_NAME.
1374
1375 Unfortunately, we don't know at this point whether NAME is supposed
1376 to denote a record component name or the value of an array index.
1377 Therefore, it is not appropriate to disambiguate an ambiguous name
1378 as we normally would, nor to replace a renaming with its referent.
1379 As a result, in the (one hopes) rare case that one writes an
1380 aggregate such as (R => 42) where R renames an object or is an
1381 ambiguous name, one must write instead ((R) => 42). */
1382
1383static void
1384write_name_assoc (struct parser_state *par_state, struct stoken name)
1385{
1386 if (strchr (name.ptr, '.') == NULL)
1387 {
1388 struct block_symbol *syms;
1389 int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
1390 VAR_DOMAIN, &syms);
1391
1392 if (nsyms != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF)
1393 write_exp_op_with_string (par_state, OP_NAME, name);
1394 else
1395 write_var_from_sym (par_state, NULL, syms[0].block, syms[0].symbol);
1396 }
1397 else
1398 if (write_var_or_type (par_state, NULL, name) != NULL)
1399 error (_("Invalid use of type."));
1400}
1401
1402/* Convert the character literal whose ASCII value would be VAL to the
1403 appropriate value of type TYPE, if there is a translation.
1404 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
1405 the literal 'A' (VAL == 65), returns 0. */
1406
1407static LONGEST
1408convert_char_literal (struct type *type, LONGEST val)
1409{
1410 char name[7];
1411 int f;
1412
1413 if (type == NULL)
1414 return val;
1415 type = check_typedef (type);
1416 if (TYPE_CODE (type) != TYPE_CODE_ENUM)
1417 return val;
1418
1419 xsnprintf (name, sizeof (name), "QU%02x", (int) val);
1420 for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1421 {
1422 if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
1423 return TYPE_FIELD_ENUMVAL (type, f);
1424 }
1425 return val;
1426}
1427
1428static struct type *
1429type_int (struct parser_state *par_state)
1430{
1431 return parse_type (par_state)->builtin_int;
1432}
1433
1434static struct type *
1435type_long (struct parser_state *par_state)
1436{
1437 return parse_type (par_state)->builtin_long;
1438}
1439
1440static struct type *
1441type_long_long (struct parser_state *par_state)
1442{
1443 return parse_type (par_state)->builtin_long_long;
1444}
1445
1446static struct type *
1447type_float (struct parser_state *par_state)
1448{
1449 return parse_type (par_state)->builtin_float;
1450}
1451
1452static struct type *
1453type_double (struct parser_state *par_state)
1454{
1455 return parse_type (par_state)->builtin_double;
1456}
1457
1458static struct type *
1459type_long_double (struct parser_state *par_state)
1460{
1461 return parse_type (par_state)->builtin_long_double;
1462}
1463
1464static struct type *
1465type_char (struct parser_state *par_state)
1466{
1467 return language_string_char_type (parse_language (par_state),
1468 parse_gdbarch (par_state));
1469}
1470
1471static struct type *
1472type_boolean (struct parser_state *par_state)
1473{
1474 return parse_type (par_state)->builtin_bool;
1475}
1476
1477static struct type *
1478type_system_address (struct parser_state *par_state)
1479{
1480 struct type *type
1481 = language_lookup_primitive_type (parse_language (par_state),
1482 parse_gdbarch (par_state),
1483 "system__address");
1484 return type != NULL ? type : parse_type (par_state)->builtin_data_ptr;
1485}
1486
1487/* Provide a prototype to silence -Wmissing-prototypes. */
1488extern initialize_file_ftype _initialize_ada_exp;
1489
1490void
1491_initialize_ada_exp (void)
1492{
1493 obstack_init (&temp_parse_space);
1494}
GDB Binutils - Deliverables
This page took 0.027319 seconds and 4 git commands to generate.