1 /* YACC parser for Ada expressions, for GDB.
2 Copyright (C) 1986-2019 Free Software Foundation, Inc.
4 This file is part of GDB.
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.
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.
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/>. */
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.
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. */
40 #include "expression.h"
42 #include "parser-defs.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 */
51 #define parse_type(ps) builtin_type (ps->gdbarch ())
53 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
55 #define GDB_YY_REMAP_PREFIX ada_
60 struct minimal_symbol *msym;
61 const struct block *block;
65 /* The state of the parser, used internally when we are parsing the
68 static struct parser_state *pstate = NULL;
70 static struct stoken empty_stoken = { "", 0 };
72 /* If expression is in the context of TYPE'(...), then TYPE, else
74 static struct type *type_qualifier;
78 static int yylex (void);
80 static void yyerror (const char *);
82 static void write_int (struct parser_state *, LONGEST, struct type *);
84 static void write_object_renaming (struct parser_state *,
85 const struct block *, const char *, int,
88 static struct type* write_var_or_type (struct parser_state *,
89 const struct block *, struct stoken);
91 static void write_name_assoc (struct parser_state *, struct stoken);
93 static void write_exp_op_with_string (struct parser_state *, enum exp_opcode,
96 static const struct block *block_lookup (const struct block *, const char *);
98 static LONGEST convert_char_literal (struct type *, LONGEST);
100 static void write_ambiguous_var (struct parser_state *,
101 const struct block *, char *, int);
103 static struct type *type_int (struct parser_state *);
105 static struct type *type_long (struct parser_state *);
107 static struct type *type_long_long (struct parser_state *);
109 static struct type *type_long_double (struct parser_state *);
111 static struct type *type_char (struct parser_state *);
113 static struct type *type_boolean (struct parser_state *);
115 static struct type *type_system_address (struct parser_state *);
132 const struct block *bval;
133 struct internalvar *ivar;
136 %type <lval> positional_list component_groups component_associations
137 %type <lval> aggregate_component_list
138 %type <tval> var_or_type
140 %token <typed_val> INT NULL_PTR CHARLIT
141 %token <typed_val_float> FLOAT
142 %token TRUEKEYWORD FALSEKEYWORD
144 %token <sval> STRING NAME DOT_ID
146 %type <lval> arglist tick_arglist
148 %type <tval> save_qualifier
152 /* Special type cases, put in to allow the parser to distinguish different
154 %token <sval> DOLLAR_VARIABLE
157 %left _AND_ OR XOR THEN ELSE
158 %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
162 %left '*' '/' MOD REM
163 %right STARSTAR ABS NOT
165 /* Artificial token to give NAME => ... and NAME | priority over reducing
166 NAME to <primary> and to give <primary>' priority over reducing <primary>
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
188 /* Expressions, including the sequencing operator. */
191 { write_exp_elt_opcode (pstate, BINOP_COMMA); }
192 | primary ASSIGN exp /* Extension for convenience */
193 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
196 /* Expressions, not including the sequencing operator. */
197 primary : primary DOT_ALL
198 { write_exp_elt_opcode (pstate, UNOP_IND); }
201 primary : primary DOT_ID
202 { write_exp_op_with_string (pstate, STRUCTOP_STRUCT,
206 primary : primary '(' arglist ')'
208 write_exp_elt_opcode (pstate, OP_FUNCALL);
209 write_exp_elt_longcst (pstate, $3);
210 write_exp_elt_opcode (pstate, OP_FUNCALL);
212 | var_or_type '(' arglist ')'
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);
224 write_exp_elt_opcode (pstate, OP_FUNCALL);
225 write_exp_elt_longcst (pstate, $3);
226 write_exp_elt_opcode (pstate, OP_FUNCALL);
231 primary : var_or_type '\'' save_qualifier { type_qualifier = $1; }
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);
243 save_qualifier : { $$ = type_qualifier; }
247 primary '(' simple_exp DOTDOT simple_exp ')'
248 { write_exp_elt_opcode (pstate, TERNOP_SLICE); }
249 | var_or_type '(' simple_exp DOTDOT simple_exp ')'
251 write_exp_elt_opcode (pstate, TERNOP_SLICE);
253 error (_("Cannot slice a type"));
257 primary : '(' exp1 ')' { }
260 /* The following rule causes a conflict with the type conversion
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. */
268 primary : var_or_type %prec VAR
271 write_exp_elt_opcode (pstate, OP_TYPE);
272 write_exp_elt_type (pstate, $1);
273 write_exp_elt_opcode (pstate, OP_TYPE);
278 primary : DOLLAR_VARIABLE /* Various GDB extensions */
279 { write_dollar_variable (pstate, $1); }
288 simple_exp : '-' simple_exp %prec UNARY
289 { write_exp_elt_opcode (pstate, UNOP_NEG); }
292 simple_exp : '+' simple_exp %prec UNARY
293 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
296 simple_exp : NOT simple_exp %prec UNARY
297 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
300 simple_exp : ABS simple_exp %prec UNARY
301 { write_exp_elt_opcode (pstate, UNOP_ABS); }
304 arglist : { $$ = 0; }
313 | arglist ',' NAME ARROW exp
317 primary : '{' var_or_type '}' primary %prec '.'
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);
328 /* Binary operators in order of decreasing precedence. */
330 simple_exp : simple_exp STARSTAR simple_exp
331 { write_exp_elt_opcode (pstate, BINOP_EXP); }
334 simple_exp : simple_exp '*' simple_exp
335 { write_exp_elt_opcode (pstate, BINOP_MUL); }
338 simple_exp : simple_exp '/' simple_exp
339 { write_exp_elt_opcode (pstate, BINOP_DIV); }
342 simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
343 { write_exp_elt_opcode (pstate, BINOP_REM); }
346 simple_exp : simple_exp MOD simple_exp
347 { write_exp_elt_opcode (pstate, BINOP_MOD); }
350 simple_exp : simple_exp '@' simple_exp /* GDB extension */
351 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
354 simple_exp : simple_exp '+' simple_exp
355 { write_exp_elt_opcode (pstate, BINOP_ADD); }
358 simple_exp : simple_exp '&' simple_exp
359 { write_exp_elt_opcode (pstate, BINOP_CONCAT); }
362 simple_exp : simple_exp '-' simple_exp
363 { write_exp_elt_opcode (pstate, BINOP_SUB); }
366 relation : simple_exp
369 relation : simple_exp '=' simple_exp
370 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
373 relation : simple_exp NOTEQUAL simple_exp
374 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
377 relation : simple_exp LEQ simple_exp
378 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
381 relation : 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);
388 | simple_exp IN var_or_type %prec TICK_ACCESS
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);
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);
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);
406 | simple_exp NOT IN var_or_type %prec TICK_ACCESS
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);
417 relation : simple_exp GEQ simple_exp
418 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
421 relation : simple_exp '<' simple_exp
422 { write_exp_elt_opcode (pstate, BINOP_LESS); }
425 relation : simple_exp '>' simple_exp
426 { write_exp_elt_opcode (pstate, BINOP_GTR); }
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); }
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); }
453 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
455 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
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); }
465 xor_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); }
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
479 primary : 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);
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); }
498 { write_exp_elt_opcode (pstate, OP_ATR_SIZE); }
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); }
513 tick_arglist : %prec '('
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); }
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); }
540 { write_int (pstate, (LONGEST) $1.val, $1.type); }
545 convert_char_literal (type_qualifier, $1.val),
546 (type_qualifier == NULL)
547 ? $1.type : type_qualifier);
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);
560 { write_int (pstate, 0, type_int (pstate)); }
565 write_exp_op_with_string (pstate, OP_STRING, $1);
569 primary : TRUEKEYWORD
570 { write_int (pstate, 1, type_boolean (pstate)); }
572 { write_int (pstate, 0, type_boolean (pstate)); }
576 { error (_("NEW not implemented.")); }
579 var_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); }
585 $$ = write_var_or_type (pstate, NULL, $1);
587 write_exp_elt_opcode (pstate, UNOP_ADDR);
589 $$ = lookup_pointer_type ($$);
591 | block NAME TICK_ACCESS
593 $$ = write_var_or_type (pstate, $1, $2);
595 write_exp_elt_opcode (pstate, UNOP_ADDR);
597 $$ = lookup_pointer_type ($$);
602 block : NAME COLONCOLON
603 { $$ = block_lookup (NULL, $1.ptr); }
604 | block NAME COLONCOLON
605 { $$ = block_lookup ($1, $2.ptr); }
609 '(' aggregate_component_list ')'
611 write_exp_elt_opcode (pstate, OP_AGGREGATE);
612 write_exp_elt_longcst (pstate, $2);
613 write_exp_elt_opcode (pstate, OP_AGGREGATE);
617 aggregate_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);
625 | positional_list component_groups
631 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
632 write_exp_elt_longcst (pstate, 0);
633 write_exp_elt_opcode (pstate, OP_POSITIONAL);
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);
646 | component_group { $$ = 1; }
647 | component_group ',' component_groups
651 others : OTHERS ARROW exp
652 { write_exp_elt_opcode (pstate, OP_OTHERS); }
656 component_associations
658 write_exp_elt_opcode (pstate, OP_CHOICES);
659 write_exp_elt_longcst (pstate, $1);
660 write_exp_elt_opcode (pstate, OP_CHOICES);
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. */
669 component_associations :
671 { write_name_assoc (pstate, $1); }
673 | simple_exp ARROW exp
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,
682 { write_name_assoc (pstate, $1); }
683 component_associations { $$ = $4 + 1; }
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; }
691 /* Some extensions borrowed from C, for the benefit of those who find they
692 can't get used to Ada notation in GDB. */
694 primary : '*' 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); }
704 /* yylex defined in ada-lex.c: Reads one token, getting characters */
705 /* through lexptr. */
707 /* Remap normal flex interface names (yylex) as well as gratuitiously */
708 /* global symbol names, so we can have multiple flex-generated parsers */
711 /* (See note above on previous definitions for YACC.) */
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
721 static struct obstack temp_parse_space;
723 /* The following kludge was found necessary to prevent conflicts between */
724 /* defs.h and non-standard stdlib.h files. */
725 #define qsort __qsort__dummy
729 ada_parse (struct parser_state *par_state)
731 /* Setting up the parser state. */
732 scoped_restore pstate_restore = make_scoped_restore (&pstate);
733 gdb_assert (par_state != NULL);
736 lexer_init (yyin); /* (Re-)initialize lexer. */
737 type_qualifier = NULL;
738 obstack_free (&temp_parse_space, NULL);
739 obstack_init (&temp_parse_space);
745 yyerror (const char *msg)
747 error (_("Error in expression, near `%s'."), pstate->lexptr);
750 /* Emit expression to access an instance of SYM, in block BLOCK (if
754 write_var_from_sym (struct parser_state *par_state,
755 const struct block *block,
758 if (symbol_read_needs_frame (sym))
759 par_state->block_tracker->update (block, INNERMOST_BLOCK_FOR_SYMBOLS);
761 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
762 write_exp_elt_block (par_state, block);
763 write_exp_elt_sym (par_state, sym);
764 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
767 /* Write integer or boolean constant ARG of type TYPE. */
770 write_int (struct parser_state *par_state, LONGEST arg, struct type *type)
772 write_exp_elt_opcode (par_state, OP_LONG);
773 write_exp_elt_type (par_state, type);
774 write_exp_elt_longcst (par_state, arg);
775 write_exp_elt_opcode (par_state, OP_LONG);
778 /* Write an OPCODE, string, OPCODE sequence to the current expression. */
780 write_exp_op_with_string (struct parser_state *par_state,
781 enum exp_opcode opcode, struct stoken token)
783 write_exp_elt_opcode (par_state, opcode);
784 write_exp_string (par_state, token);
785 write_exp_elt_opcode (par_state, opcode);
788 /* Emit expression corresponding to the renamed object named
789 * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
790 * context of ORIG_LEFT_CONTEXT, to which is applied the operations
791 * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of
792 * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it
793 * defaults to the currently selected block. ORIG_SYMBOL is the
794 * symbol that originally encoded the renaming. It is needed only
795 * because its prefix also qualifies any index variables used to index
796 * or slice an array. It should not be necessary once we go to the
797 * new encoding entirely (FIXME pnh 7/20/2007). */
800 write_object_renaming (struct parser_state *par_state,
801 const struct block *orig_left_context,
802 const char *renamed_entity, int renamed_entity_len,
803 const char *renaming_expr, int max_depth)
806 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
807 struct block_symbol sym_info;
810 error (_("Could not find renamed symbol"));
812 if (orig_left_context == NULL)
813 orig_left_context = get_selected_block (NULL);
815 name = obstack_strndup (&temp_parse_space, renamed_entity,
817 ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, &sym_info);
818 if (sym_info.symbol == NULL)
819 error (_("Could not find renamed variable: %s"), ada_decode (name));
820 else if (SYMBOL_CLASS (sym_info.symbol) == LOC_TYPEDEF)
821 /* We have a renaming of an old-style renaming symbol. Don't
822 trust the block information. */
823 sym_info.block = orig_left_context;
826 const char *inner_renamed_entity;
827 int inner_renamed_entity_len;
828 const char *inner_renaming_expr;
830 switch (ada_parse_renaming (sym_info.symbol, &inner_renamed_entity,
831 &inner_renamed_entity_len,
832 &inner_renaming_expr))
834 case ADA_NOT_RENAMING:
835 write_var_from_sym (par_state, sym_info.block, sym_info.symbol);
837 case ADA_OBJECT_RENAMING:
838 write_object_renaming (par_state, sym_info.block,
839 inner_renamed_entity, inner_renamed_entity_len,
840 inner_renaming_expr, max_depth - 1);
847 slice_state = SIMPLE_INDEX;
848 while (*renaming_expr == 'X')
852 switch (*renaming_expr) {
855 write_exp_elt_opcode (par_state, UNOP_IND);
858 slice_state = LOWER_BOUND;
862 if (isdigit (*renaming_expr))
865 long val = strtol (renaming_expr, &next, 10);
866 if (next == renaming_expr)
868 renaming_expr = next;
869 write_exp_elt_opcode (par_state, OP_LONG);
870 write_exp_elt_type (par_state, type_int (par_state));
871 write_exp_elt_longcst (par_state, (LONGEST) val);
872 write_exp_elt_opcode (par_state, OP_LONG);
878 struct block_symbol index_sym_info;
880 end = strchr (renaming_expr, 'X');
882 end = renaming_expr + strlen (renaming_expr);
884 index_name = obstack_strndup (&temp_parse_space, renaming_expr,
885 end - renaming_expr);
888 ada_lookup_encoded_symbol (index_name, orig_left_context,
889 VAR_DOMAIN, &index_sym_info);
890 if (index_sym_info.symbol == NULL)
891 error (_("Could not find %s"), index_name);
892 else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF)
893 /* Index is an old-style renaming symbol. */
894 index_sym_info.block = orig_left_context;
895 write_var_from_sym (par_state, index_sym_info.block,
896 index_sym_info.symbol);
898 if (slice_state == SIMPLE_INDEX)
900 write_exp_elt_opcode (par_state, OP_FUNCALL);
901 write_exp_elt_longcst (par_state, (LONGEST) 1);
902 write_exp_elt_opcode (par_state, OP_FUNCALL);
904 else if (slice_state == LOWER_BOUND)
905 slice_state = UPPER_BOUND;
906 else if (slice_state == UPPER_BOUND)
908 write_exp_elt_opcode (par_state, TERNOP_SLICE);
909 slice_state = SIMPLE_INDEX;
915 struct stoken field_name;
921 if (slice_state != SIMPLE_INDEX)
923 end = strchr (renaming_expr, 'X');
925 end = renaming_expr + strlen (renaming_expr);
926 field_name.length = end - renaming_expr;
927 buf = (char *) malloc (end - renaming_expr + 1);
928 field_name.ptr = buf;
929 strncpy (buf, renaming_expr, end - renaming_expr);
930 buf[end - renaming_expr] = '\000';
932 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
940 if (slice_state == SIMPLE_INDEX)
944 error (_("Internal error in encoding of renaming declaration"));
947 static const struct block*
948 block_lookup (const struct block *context, const char *raw_name)
951 std::vector<struct block_symbol> syms;
953 struct symtab *symtab;
954 const struct block *result = NULL;
956 if (raw_name[0] == '\'')
962 name = ada_encode (raw_name);
964 nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
967 && (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK))
968 symtab = lookup_symtab (name);
973 result = BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symtab), STATIC_BLOCK);
974 else if (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK)
977 error (_("No file or function \"%s\"."), raw_name);
979 error (_("No function \"%s\" in specified context."), raw_name);
984 warning (_("Function name \"%s\" ambiguous here"), raw_name);
985 result = SYMBOL_BLOCK_VALUE (syms[0].symbol);
991 static struct symbol*
992 select_possible_type_sym (const std::vector<struct block_symbol> &syms)
996 struct type *preferred_type;
998 preferred_index = -1; preferred_type = NULL;
999 for (i = 0; i < syms.size (); i += 1)
1000 switch (SYMBOL_CLASS (syms[i].symbol))
1003 if (ada_prefer_type (SYMBOL_TYPE (syms[i].symbol), preferred_type))
1005 preferred_index = i;
1006 preferred_type = SYMBOL_TYPE (syms[i].symbol);
1012 case LOC_REGPARM_ADDR:
1019 if (preferred_type == NULL)
1021 return syms[preferred_index].symbol;
1025 find_primitive_type (struct parser_state *par_state, char *name)
1028 type = language_lookup_primitive_type (par_state->language (),
1029 par_state->gdbarch (),
1031 if (type == NULL && strcmp ("system__address", name) == 0)
1032 type = type_system_address (par_state);
1036 /* Check to see if we have a regular definition of this
1037 type that just didn't happen to have been read yet. */
1039 char *expanded_name =
1040 (char *) alloca (strlen (name) + sizeof ("standard__"));
1041 strcpy (expanded_name, "standard__");
1042 strcat (expanded_name, name);
1043 sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN).symbol;
1044 if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1045 type = SYMBOL_TYPE (sym);
1052 chop_selector (char *name, int end)
1055 for (i = end - 1; i > 0; i -= 1)
1056 if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1061 /* If NAME is a string beginning with a separator (either '__', or
1062 '.'), chop this separator and return the result; else, return
1066 chop_separator (char *name)
1071 if (name[0] == '_' && name[1] == '_')
1077 /* Given that SELS is a string of the form (<sep><identifier>)*, where
1078 <sep> is '__' or '.', write the indicated sequence of
1079 STRUCTOP_STRUCT expression operators. */
1081 write_selectors (struct parser_state *par_state, char *sels)
1083 while (*sels != '\0')
1085 struct stoken field_name;
1086 char *p = chop_separator (sels);
1088 while (*sels != '\0' && *sels != '.'
1089 && (sels[0] != '_' || sels[1] != '_'))
1091 field_name.length = sels - p;
1093 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
1097 /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1098 NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes
1099 a temporary symbol that is valid until the next call to ada_parse.
1102 write_ambiguous_var (struct parser_state *par_state,
1103 const struct block *block, char *name, int len)
1105 struct symbol *sym = XOBNEW (&temp_parse_space, struct symbol);
1107 memset (sym, 0, sizeof (struct symbol));
1108 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1109 SYMBOL_LINKAGE_NAME (sym) = obstack_strndup (&temp_parse_space, name, len);
1110 SYMBOL_LANGUAGE (sym) = language_ada;
1112 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1113 write_exp_elt_block (par_state, block);
1114 write_exp_elt_sym (par_state, sym);
1115 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1118 /* A convenient wrapper around ada_get_field_index that takes
1119 a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1120 of a NUL-terminated field name. */
1123 ada_nget_field_index (const struct type *type, const char *field_name0,
1124 int field_name_len, int maybe_missing)
1126 char *field_name = (char *) alloca ((field_name_len + 1) * sizeof (char));
1128 strncpy (field_name, field_name0, field_name_len);
1129 field_name[field_name_len] = '\0';
1130 return ada_get_field_index (type, field_name, maybe_missing);
1133 /* If encoded_field_name is the name of a field inside symbol SYM,
1134 then return the type of that field. Otherwise, return NULL.
1136 This function is actually recursive, so if ENCODED_FIELD_NAME
1137 doesn't match one of the fields of our symbol, then try to see
1138 if ENCODED_FIELD_NAME could not be a succession of field names
1139 (in other words, the user entered an expression of the form
1140 TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1141 each field name sequentially to obtain the desired field type.
1142 In case of failure, we return NULL. */
1144 static struct type *
1145 get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1147 char *field_name = encoded_field_name;
1148 char *subfield_name;
1149 struct type *type = SYMBOL_TYPE (sym);
1152 if (type == NULL || field_name == NULL)
1154 type = check_typedef (type);
1156 while (field_name[0] != '\0')
1158 field_name = chop_separator (field_name);
1160 fieldno = ada_get_field_index (type, field_name, 1);
1162 return TYPE_FIELD_TYPE (type, fieldno);
1164 subfield_name = field_name;
1165 while (*subfield_name != '\0' && *subfield_name != '.'
1166 && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1169 if (subfield_name[0] == '\0')
1172 fieldno = ada_nget_field_index (type, field_name,
1173 subfield_name - field_name, 1);
1177 type = TYPE_FIELD_TYPE (type, fieldno);
1178 field_name = subfield_name;
1184 /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
1185 expression_block_context if NULL). If it denotes a type, return
1186 that type. Otherwise, write expression code to evaluate it as an
1187 object and return NULL. In this second case, NAME0 will, in general,
1188 have the form <name>(.<selector_name>)*, where <name> is an object
1189 or renaming encoded in the debugging data. Calls error if no
1190 prefix <name> matches a name in the debugging data (i.e., matches
1191 either a complete name or, as a wild-card match, the final
1195 write_var_or_type (struct parser_state *par_state,
1196 const struct block *block, struct stoken name0)
1203 block = par_state->expression_context_block;
1205 encoded_name = ada_encode (name0.ptr);
1206 name_len = strlen (encoded_name);
1207 encoded_name = obstack_strndup (&temp_parse_space, encoded_name, name_len);
1208 for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1212 tail_index = name_len;
1213 while (tail_index > 0)
1216 std::vector<struct block_symbol> syms;
1217 struct symbol *type_sym;
1218 struct symbol *renaming_sym;
1219 const char* renaming;
1221 const char* renaming_expr;
1222 int terminator = encoded_name[tail_index];
1224 encoded_name[tail_index] = '\0';
1225 nsyms = ada_lookup_symbol_list (encoded_name, block,
1227 encoded_name[tail_index] = terminator;
1229 type_sym = select_possible_type_sym (syms);
1231 if (type_sym != NULL)
1232 renaming_sym = type_sym;
1233 else if (nsyms == 1)
1234 renaming_sym = syms[0].symbol;
1236 renaming_sym = NULL;
1238 switch (ada_parse_renaming (renaming_sym, &renaming,
1239 &renaming_len, &renaming_expr))
1241 case ADA_NOT_RENAMING:
1243 case ADA_PACKAGE_RENAMING:
1244 case ADA_EXCEPTION_RENAMING:
1245 case ADA_SUBPROGRAM_RENAMING:
1247 int alloc_len = renaming_len + name_len - tail_index + 1;
1249 = (char *) obstack_alloc (&temp_parse_space, alloc_len);
1250 strncpy (new_name, renaming, renaming_len);
1251 strcpy (new_name + renaming_len, encoded_name + tail_index);
1252 encoded_name = new_name;
1253 name_len = renaming_len + name_len - tail_index;
1254 goto TryAfterRenaming;
1256 case ADA_OBJECT_RENAMING:
1257 write_object_renaming (par_state, block, renaming, renaming_len,
1258 renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1259 write_selectors (par_state, encoded_name + tail_index);
1262 internal_error (__FILE__, __LINE__,
1263 _("impossible value from ada_parse_renaming"));
1266 if (type_sym != NULL)
1268 struct type *field_type;
1270 if (tail_index == name_len)
1271 return SYMBOL_TYPE (type_sym);
1273 /* We have some extraneous characters after the type name.
1274 If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1275 then try to get the type of FIELDN. */
1277 = get_symbol_field_type (type_sym, encoded_name + tail_index);
1278 if (field_type != NULL)
1281 error (_("Invalid attempt to select from type: \"%s\"."),
1284 else if (tail_index == name_len && nsyms == 0)
1286 struct type *type = find_primitive_type (par_state,
1295 write_var_from_sym (par_state, syms[0].block, syms[0].symbol);
1296 write_selectors (par_state, encoded_name + tail_index);
1299 else if (nsyms == 0)
1301 struct bound_minimal_symbol msym
1302 = ada_lookup_simple_minsym (encoded_name);
1303 if (msym.minsym != NULL)
1305 write_exp_msymbol (par_state, msym);
1306 /* Maybe cause error here rather than later? FIXME? */
1307 write_selectors (par_state, encoded_name + tail_index);
1311 if (tail_index == name_len
1312 && strncmp (encoded_name, "standard__",
1313 sizeof ("standard__") - 1) == 0)
1314 error (_("No definition of \"%s\" found."), name0.ptr);
1316 tail_index = chop_selector (encoded_name, tail_index);
1320 write_ambiguous_var (par_state, block, encoded_name,
1322 write_selectors (par_state, encoded_name + tail_index);
1327 if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1328 error (_("No symbol table is loaded. Use the \"file\" command."));
1329 if (block == par_state->expression_context_block)
1330 error (_("No definition of \"%s\" in current context."), name0.ptr);
1332 error (_("No definition of \"%s\" in specified context."), name0.ptr);
1337 error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1341 /* Write a left side of a component association (e.g., NAME in NAME =>
1342 exp). If NAME has the form of a selected component, write it as an
1343 ordinary expression. If it is a simple variable that unambiguously
1344 corresponds to exactly one symbol that does not denote a type or an
1345 object renaming, also write it normally as an OP_VAR_VALUE.
1346 Otherwise, write it as an OP_NAME.
1348 Unfortunately, we don't know at this point whether NAME is supposed
1349 to denote a record component name or the value of an array index.
1350 Therefore, it is not appropriate to disambiguate an ambiguous name
1351 as we normally would, nor to replace a renaming with its referent.
1352 As a result, in the (one hopes) rare case that one writes an
1353 aggregate such as (R => 42) where R renames an object or is an
1354 ambiguous name, one must write instead ((R) => 42). */
1357 write_name_assoc (struct parser_state *par_state, struct stoken name)
1359 if (strchr (name.ptr, '.') == NULL)
1361 std::vector<struct block_symbol> syms;
1362 int nsyms = ada_lookup_symbol_list (name.ptr,
1363 par_state->expression_context_block,
1366 if (nsyms != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF)
1367 write_exp_op_with_string (par_state, OP_NAME, name);
1369 write_var_from_sym (par_state, syms[0].block, syms[0].symbol);
1372 if (write_var_or_type (par_state, NULL, name) != NULL)
1373 error (_("Invalid use of type."));
1376 /* Convert the character literal whose ASCII value would be VAL to the
1377 appropriate value of type TYPE, if there is a translation.
1378 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
1379 the literal 'A' (VAL == 65), returns 0. */
1382 convert_char_literal (struct type *type, LONGEST val)
1389 type = check_typedef (type);
1390 if (TYPE_CODE (type) != TYPE_CODE_ENUM)
1393 xsnprintf (name, sizeof (name), "QU%02x", (int) val);
1394 size_t len = strlen (name);
1395 for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1397 /* Check the suffix because an enum constant in a package will
1398 have a name like "pkg__QUxx". This is safe enough because we
1399 already have the correct type, and because mangling means
1400 there can't be clashes. */
1401 const char *ename = TYPE_FIELD_NAME (type, f);
1402 size_t elen = strlen (ename);
1404 if (elen >= len && strcmp (name, ename + elen - len) == 0)
1405 return TYPE_FIELD_ENUMVAL (type, f);
1410 static struct type *
1411 type_int (struct parser_state *par_state)
1413 return parse_type (par_state)->builtin_int;
1416 static struct type *
1417 type_long (struct parser_state *par_state)
1419 return parse_type (par_state)->builtin_long;
1422 static struct type *
1423 type_long_long (struct parser_state *par_state)
1425 return parse_type (par_state)->builtin_long_long;
1428 static struct type *
1429 type_long_double (struct parser_state *par_state)
1431 return parse_type (par_state)->builtin_long_double;
1434 static struct type *
1435 type_char (struct parser_state *par_state)
1437 return language_string_char_type (par_state->language (),
1438 par_state->gdbarch ());
1441 static struct type *
1442 type_boolean (struct parser_state *par_state)
1444 return parse_type (par_state)->builtin_bool;
1447 static struct type *
1448 type_system_address (struct parser_state *par_state)
1451 = language_lookup_primitive_type (par_state->language (),
1452 par_state->gdbarch (),
1454 return type != NULL ? type : parse_type (par_state)->builtin_data_ptr;
1458 _initialize_ada_exp (void)
1460 obstack_init (&temp_parse_space);