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