1 /* YACC parser for Ada expressions, for GDB.
2 Copyright (C) 1986-2017 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 (parse_gdbarch (ps))
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 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_float (struct parser_state *);
111 static struct type *type_double (struct parser_state *);
113 static struct type *type_long_double (struct parser_state *);
115 static struct type *type_char (struct parser_state *);
117 static struct type *type_boolean (struct parser_state *);
119 static struct type *type_system_address (struct parser_state *);
136 const struct block *bval;
137 struct internalvar *ivar;
140 %type <lval> positional_list component_groups component_associations
141 %type <lval> aggregate_component_list
142 %type <tval> var_or_type
144 %token <typed_val> INT NULL_PTR CHARLIT
145 %token <typed_val_float> FLOAT
146 %token TRUEKEYWORD FALSEKEYWORD
148 %token <sval> STRING NAME DOT_ID
150 %type <lval> arglist tick_arglist
152 %type <tval> save_qualifier
156 /* Special type cases, put in to allow the parser to distinguish different
158 %token <sval> SPECIAL_VARIABLE
161 %left _AND_ OR XOR THEN ELSE
162 %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
166 %left '*' '/' MOD REM
167 %right STARSTAR ABS NOT
169 /* Artificial token to give NAME => ... and NAME | priority over reducing
170 NAME to <primary> and to give <primary>' priority over reducing <primary>
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
192 /* Expressions, including the sequencing operator. */
195 { write_exp_elt_opcode (pstate, BINOP_COMMA); }
196 | primary ASSIGN exp /* Extension for convenience */
197 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
200 /* Expressions, not including the sequencing operator. */
201 primary : primary DOT_ALL
202 { write_exp_elt_opcode (pstate, UNOP_IND); }
205 primary : primary DOT_ID
206 { write_exp_op_with_string (pstate, STRUCTOP_STRUCT,
210 primary : primary '(' arglist ')'
212 write_exp_elt_opcode (pstate, OP_FUNCALL);
213 write_exp_elt_longcst (pstate, $3);
214 write_exp_elt_opcode (pstate, OP_FUNCALL);
216 | var_or_type '(' arglist ')'
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);
228 write_exp_elt_opcode (pstate, OP_FUNCALL);
229 write_exp_elt_longcst (pstate, $3);
230 write_exp_elt_opcode (pstate, OP_FUNCALL);
235 primary : var_or_type '\'' save_qualifier { type_qualifier = $1; }
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);
247 save_qualifier : { $$ = type_qualifier; }
251 primary '(' simple_exp DOTDOT simple_exp ')'
252 { write_exp_elt_opcode (pstate, TERNOP_SLICE); }
253 | var_or_type '(' simple_exp DOTDOT simple_exp ')'
255 write_exp_elt_opcode (pstate, TERNOP_SLICE);
257 error (_("Cannot slice a type"));
261 primary : '(' exp1 ')' { }
264 /* The following rule causes a conflict with the type conversion
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. */
272 primary : var_or_type %prec VAR
275 write_exp_elt_opcode (pstate, OP_TYPE);
276 write_exp_elt_type (pstate, $1);
277 write_exp_elt_opcode (pstate, OP_TYPE);
282 primary : SPECIAL_VARIABLE /* Various GDB extensions */
283 { write_dollar_variable (pstate, $1); }
292 simple_exp : '-' simple_exp %prec UNARY
293 { write_exp_elt_opcode (pstate, UNOP_NEG); }
296 simple_exp : '+' simple_exp %prec UNARY
297 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
300 simple_exp : NOT simple_exp %prec UNARY
301 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
304 simple_exp : ABS simple_exp %prec UNARY
305 { write_exp_elt_opcode (pstate, UNOP_ABS); }
308 arglist : { $$ = 0; }
317 | arglist ',' NAME ARROW exp
321 primary : '{' var_or_type '}' primary %prec '.'
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);
332 /* Binary operators in order of decreasing precedence. */
334 simple_exp : simple_exp STARSTAR simple_exp
335 { write_exp_elt_opcode (pstate, BINOP_EXP); }
338 simple_exp : simple_exp '*' simple_exp
339 { write_exp_elt_opcode (pstate, BINOP_MUL); }
342 simple_exp : simple_exp '/' simple_exp
343 { write_exp_elt_opcode (pstate, BINOP_DIV); }
346 simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
347 { write_exp_elt_opcode (pstate, BINOP_REM); }
350 simple_exp : simple_exp MOD simple_exp
351 { write_exp_elt_opcode (pstate, BINOP_MOD); }
354 simple_exp : simple_exp '@' simple_exp /* GDB extension */
355 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
358 simple_exp : simple_exp '+' simple_exp
359 { write_exp_elt_opcode (pstate, BINOP_ADD); }
362 simple_exp : simple_exp '&' simple_exp
363 { write_exp_elt_opcode (pstate, BINOP_CONCAT); }
366 simple_exp : simple_exp '-' simple_exp
367 { write_exp_elt_opcode (pstate, BINOP_SUB); }
370 relation : simple_exp
373 relation : simple_exp '=' simple_exp
374 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
377 relation : simple_exp NOTEQUAL simple_exp
378 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
381 relation : simple_exp LEQ simple_exp
382 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
385 relation : 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);
392 | simple_exp IN var_or_type %prec TICK_ACCESS
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);
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);
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);
410 | simple_exp NOT IN var_or_type %prec TICK_ACCESS
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);
421 relation : simple_exp GEQ simple_exp
422 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
425 relation : simple_exp '<' simple_exp
426 { write_exp_elt_opcode (pstate, BINOP_LESS); }
429 relation : simple_exp '>' simple_exp
430 { write_exp_elt_opcode (pstate, BINOP_GTR); }
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); }
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); }
457 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
459 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
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); }
469 xor_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); }
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
483 primary : 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);
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); }
502 { write_exp_elt_opcode (pstate, OP_ATR_SIZE); }
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); }
517 tick_arglist : %prec '('
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); }
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); }
544 { write_int (pstate, (LONGEST) $1.val, $1.type); }
549 convert_char_literal (type_qualifier, $1.val),
550 (type_qualifier == NULL)
551 ? $1.type : type_qualifier);
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);
564 { write_int (pstate, 0, type_int (pstate)); }
569 write_exp_op_with_string (pstate, OP_STRING, $1);
573 primary : TRUEKEYWORD
574 { write_int (pstate, 1, type_boolean (pstate)); }
576 { write_int (pstate, 0, type_boolean (pstate)); }
580 { error (_("NEW not implemented.")); }
583 var_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); }
589 $$ = write_var_or_type (pstate, NULL, $1);
591 write_exp_elt_opcode (pstate, UNOP_ADDR);
593 $$ = lookup_pointer_type ($$);
595 | block NAME TICK_ACCESS
597 $$ = write_var_or_type (pstate, $1, $2);
599 write_exp_elt_opcode (pstate, UNOP_ADDR);
601 $$ = lookup_pointer_type ($$);
606 block : NAME COLONCOLON
607 { $$ = block_lookup (NULL, $1.ptr); }
608 | block NAME COLONCOLON
609 { $$ = block_lookup ($1, $2.ptr); }
613 '(' aggregate_component_list ')'
615 write_exp_elt_opcode (pstate, OP_AGGREGATE);
616 write_exp_elt_longcst (pstate, $2);
617 write_exp_elt_opcode (pstate, OP_AGGREGATE);
621 aggregate_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);
629 | positional_list component_groups
635 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
636 write_exp_elt_longcst (pstate, 0);
637 write_exp_elt_opcode (pstate, OP_POSITIONAL);
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);
650 | component_group { $$ = 1; }
651 | component_group ',' component_groups
655 others : OTHERS ARROW exp
656 { write_exp_elt_opcode (pstate, OP_OTHERS); }
660 component_associations
662 write_exp_elt_opcode (pstate, OP_CHOICES);
663 write_exp_elt_longcst (pstate, $1);
664 write_exp_elt_opcode (pstate, OP_CHOICES);
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. */
673 component_associations :
675 { write_name_assoc (pstate, $1); }
677 | simple_exp ARROW exp
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,
686 { write_name_assoc (pstate, $1); }
687 component_associations { $$ = $4 + 1; }
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; }
695 /* Some extensions borrowed from C, for the benefit of those who find they
696 can't get used to Ada notation in GDB. */
698 primary : '*' 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); }
708 /* yylex defined in ada-lex.c: Reads one token, getting characters */
709 /* through lexptr. */
711 /* Remap normal flex interface names (yylex) as well as gratuitiously */
712 /* global symbol names, so we can have multiple flex-generated parsers */
715 /* (See note above on previous definitions for YACC.) */
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
726 static struct obstack temp_parse_space;
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
734 ada_parse (struct parser_state *par_state)
736 /* Setting up the parser state. */
737 scoped_restore pstate_restore = make_scoped_restore (&pstate);
738 gdb_assert (par_state != NULL);
741 lexer_init (yyin); /* (Re-)initialize lexer. */
742 type_qualifier = NULL;
743 obstack_free (&temp_parse_space, NULL);
744 obstack_init (&temp_parse_space);
750 yyerror (const char *msg)
752 error (_("Error in expression, near `%s'."), lexptr);
755 /* Emit expression to access an instance of SYM, in block BLOCK (if
756 * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
758 write_var_from_sym (struct parser_state *par_state,
759 const struct block *orig_left_context,
760 const struct block *block,
763 if (orig_left_context == NULL && symbol_read_needs_frame (sym))
765 if (innermost_block == 0
766 || contained_in (block, innermost_block))
767 innermost_block = block;
770 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
771 write_exp_elt_block (par_state, block);
772 write_exp_elt_sym (par_state, sym);
773 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
776 /* Write integer or boolean constant ARG of type TYPE. */
779 write_int (struct parser_state *par_state, LONGEST arg, struct type *type)
781 write_exp_elt_opcode (par_state, OP_LONG);
782 write_exp_elt_type (par_state, type);
783 write_exp_elt_longcst (par_state, arg);
784 write_exp_elt_opcode (par_state, OP_LONG);
787 /* Write an OPCODE, string, OPCODE sequence to the current expression. */
789 write_exp_op_with_string (struct parser_state *par_state,
790 enum exp_opcode opcode, struct stoken token)
792 write_exp_elt_opcode (par_state, opcode);
793 write_exp_string (par_state, token);
794 write_exp_elt_opcode (par_state, opcode);
797 /* Emit expression corresponding to the renamed object named
798 * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
799 * context of ORIG_LEFT_CONTEXT, to which is applied the operations
800 * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of
801 * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it
802 * defaults to the currently selected block. ORIG_SYMBOL is the
803 * symbol that originally encoded the renaming. It is needed only
804 * because its prefix also qualifies any index variables used to index
805 * or slice an array. It should not be necessary once we go to the
806 * new encoding entirely (FIXME pnh 7/20/2007). */
809 write_object_renaming (struct parser_state *par_state,
810 const struct block *orig_left_context,
811 const char *renamed_entity, int renamed_entity_len,
812 const char *renaming_expr, int max_depth)
815 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
816 struct block_symbol sym_info;
819 error (_("Could not find renamed symbol"));
821 if (orig_left_context == NULL)
822 orig_left_context = get_selected_block (NULL);
824 name = (char *) obstack_copy0 (&temp_parse_space, renamed_entity,
826 ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, &sym_info);
827 if (sym_info.symbol == NULL)
828 error (_("Could not find renamed variable: %s"), ada_decode (name));
829 else if (SYMBOL_CLASS (sym_info.symbol) == LOC_TYPEDEF)
830 /* We have a renaming of an old-style renaming symbol. Don't
831 trust the block information. */
832 sym_info.block = orig_left_context;
835 const char *inner_renamed_entity;
836 int inner_renamed_entity_len;
837 const char *inner_renaming_expr;
839 switch (ada_parse_renaming (sym_info.symbol, &inner_renamed_entity,
840 &inner_renamed_entity_len,
841 &inner_renaming_expr))
843 case ADA_NOT_RENAMING:
844 write_var_from_sym (par_state, orig_left_context, sym_info.block,
847 case ADA_OBJECT_RENAMING:
848 write_object_renaming (par_state, sym_info.block,
849 inner_renamed_entity, inner_renamed_entity_len,
850 inner_renaming_expr, max_depth - 1);
857 slice_state = SIMPLE_INDEX;
858 while (*renaming_expr == 'X')
862 switch (*renaming_expr) {
865 write_exp_elt_opcode (par_state, UNOP_IND);
868 slice_state = LOWER_BOUND;
872 if (isdigit (*renaming_expr))
875 long val = strtol (renaming_expr, &next, 10);
876 if (next == renaming_expr)
878 renaming_expr = next;
879 write_exp_elt_opcode (par_state, OP_LONG);
880 write_exp_elt_type (par_state, type_int (par_state));
881 write_exp_elt_longcst (par_state, (LONGEST) val);
882 write_exp_elt_opcode (par_state, OP_LONG);
888 struct block_symbol index_sym_info;
890 end = strchr (renaming_expr, 'X');
892 end = renaming_expr + strlen (renaming_expr);
895 = (char *) obstack_copy0 (&temp_parse_space, renaming_expr,
896 end - renaming_expr);
899 ada_lookup_encoded_symbol (index_name, NULL, VAR_DOMAIN,
901 if (index_sym_info.symbol == NULL)
902 error (_("Could not find %s"), index_name);
903 else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF)
904 /* Index is an old-style renaming symbol. */
905 index_sym_info.block = orig_left_context;
906 write_var_from_sym (par_state, NULL, index_sym_info.block,
907 index_sym_info.symbol);
909 if (slice_state == SIMPLE_INDEX)
911 write_exp_elt_opcode (par_state, OP_FUNCALL);
912 write_exp_elt_longcst (par_state, (LONGEST) 1);
913 write_exp_elt_opcode (par_state, OP_FUNCALL);
915 else if (slice_state == LOWER_BOUND)
916 slice_state = UPPER_BOUND;
917 else if (slice_state == UPPER_BOUND)
919 write_exp_elt_opcode (par_state, TERNOP_SLICE);
920 slice_state = SIMPLE_INDEX;
926 struct stoken field_name;
932 if (slice_state != SIMPLE_INDEX)
934 end = strchr (renaming_expr, 'X');
936 end = renaming_expr + strlen (renaming_expr);
937 field_name.length = end - renaming_expr;
938 buf = (char *) malloc (end - renaming_expr + 1);
939 field_name.ptr = buf;
940 strncpy (buf, renaming_expr, end - renaming_expr);
941 buf[end - renaming_expr] = '\000';
943 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
951 if (slice_state == SIMPLE_INDEX)
955 error (_("Internal error in encoding of renaming declaration"));
958 static const struct block*
959 block_lookup (const struct block *context, const char *raw_name)
962 struct block_symbol *syms;
964 struct symtab *symtab;
966 if (raw_name[0] == '\'')
972 name = ada_encode (raw_name);
974 nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
976 && (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK))
977 symtab = lookup_symtab (name);
982 return BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symtab), STATIC_BLOCK);
983 else if (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK)
986 error (_("No file or function \"%s\"."), raw_name);
988 error (_("No function \"%s\" in specified context."), raw_name);
993 warning (_("Function name \"%s\" ambiguous here"), raw_name);
994 return SYMBOL_BLOCK_VALUE (syms[0].symbol);
998 static struct symbol*
999 select_possible_type_sym (struct block_symbol *syms, int nsyms)
1002 int preferred_index;
1003 struct type *preferred_type;
1005 preferred_index = -1; preferred_type = NULL;
1006 for (i = 0; i < nsyms; i += 1)
1007 switch (SYMBOL_CLASS (syms[i].symbol))
1010 if (ada_prefer_type (SYMBOL_TYPE (syms[i].symbol), preferred_type))
1012 preferred_index = i;
1013 preferred_type = SYMBOL_TYPE (syms[i].symbol);
1019 case LOC_REGPARM_ADDR:
1026 if (preferred_type == NULL)
1028 return syms[preferred_index].symbol;
1032 find_primitive_type (struct parser_state *par_state, char *name)
1035 type = language_lookup_primitive_type (parse_language (par_state),
1036 parse_gdbarch (par_state),
1038 if (type == NULL && strcmp ("system__address", name) == 0)
1039 type = type_system_address (par_state);
1043 /* Check to see if we have a regular definition of this
1044 type that just didn't happen to have been read yet. */
1046 char *expanded_name =
1047 (char *) alloca (strlen (name) + sizeof ("standard__"));
1048 strcpy (expanded_name, "standard__");
1049 strcat (expanded_name, name);
1050 sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL).symbol;
1051 if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1052 type = SYMBOL_TYPE (sym);
1059 chop_selector (char *name, int end)
1062 for (i = end - 1; i > 0; i -= 1)
1063 if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1068 /* If NAME is a string beginning with a separator (either '__', or
1069 '.'), chop this separator and return the result; else, return
1073 chop_separator (char *name)
1078 if (name[0] == '_' && name[1] == '_')
1084 /* Given that SELS is a string of the form (<sep><identifier>)*, where
1085 <sep> is '__' or '.', write the indicated sequence of
1086 STRUCTOP_STRUCT expression operators. */
1088 write_selectors (struct parser_state *par_state, char *sels)
1090 while (*sels != '\0')
1092 struct stoken field_name;
1093 char *p = chop_separator (sels);
1095 while (*sels != '\0' && *sels != '.'
1096 && (sels[0] != '_' || sels[1] != '_'))
1098 field_name.length = sels - p;
1100 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
1104 /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1105 NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes
1106 a temporary symbol that is valid until the next call to ada_parse.
1109 write_ambiguous_var (struct parser_state *par_state,
1110 const struct block *block, char *name, int len)
1112 struct symbol *sym = XOBNEW (&temp_parse_space, struct symbol);
1114 memset (sym, 0, sizeof (struct symbol));
1115 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1116 SYMBOL_LINKAGE_NAME (sym)
1117 = (const char *) obstack_copy0 (&temp_parse_space, name, len);
1118 SYMBOL_LANGUAGE (sym) = language_ada;
1120 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1121 write_exp_elt_block (par_state, block);
1122 write_exp_elt_sym (par_state, sym);
1123 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1126 /* A convenient wrapper around ada_get_field_index that takes
1127 a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1128 of a NUL-terminated field name. */
1131 ada_nget_field_index (const struct type *type, const char *field_name0,
1132 int field_name_len, int maybe_missing)
1134 char *field_name = (char *) alloca ((field_name_len + 1) * sizeof (char));
1136 strncpy (field_name, field_name0, field_name_len);
1137 field_name[field_name_len] = '\0';
1138 return ada_get_field_index (type, field_name, maybe_missing);
1141 /* If encoded_field_name is the name of a field inside symbol SYM,
1142 then return the type of that field. Otherwise, return NULL.
1144 This function is actually recursive, so if ENCODED_FIELD_NAME
1145 doesn't match one of the fields of our symbol, then try to see
1146 if ENCODED_FIELD_NAME could not be a succession of field names
1147 (in other words, the user entered an expression of the form
1148 TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1149 each field name sequentially to obtain the desired field type.
1150 In case of failure, we return NULL. */
1152 static struct type *
1153 get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1155 char *field_name = encoded_field_name;
1156 char *subfield_name;
1157 struct type *type = SYMBOL_TYPE (sym);
1160 if (type == NULL || field_name == NULL)
1162 type = check_typedef (type);
1164 while (field_name[0] != '\0')
1166 field_name = chop_separator (field_name);
1168 fieldno = ada_get_field_index (type, field_name, 1);
1170 return TYPE_FIELD_TYPE (type, fieldno);
1172 subfield_name = field_name;
1173 while (*subfield_name != '\0' && *subfield_name != '.'
1174 && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1177 if (subfield_name[0] == '\0')
1180 fieldno = ada_nget_field_index (type, field_name,
1181 subfield_name - field_name, 1);
1185 type = TYPE_FIELD_TYPE (type, fieldno);
1186 field_name = subfield_name;
1192 /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
1193 expression_block_context if NULL). If it denotes a type, return
1194 that type. Otherwise, write expression code to evaluate it as an
1195 object and return NULL. In this second case, NAME0 will, in general,
1196 have the form <name>(.<selector_name>)*, where <name> is an object
1197 or renaming encoded in the debugging data. Calls error if no
1198 prefix <name> matches a name in the debugging data (i.e., matches
1199 either a complete name or, as a wild-card match, the final
1203 write_var_or_type (struct parser_state *par_state,
1204 const struct block *block, struct stoken name0)
1211 block = expression_context_block;
1213 encoded_name = ada_encode (name0.ptr);
1214 name_len = strlen (encoded_name);
1216 = (char *) obstack_copy0 (&temp_parse_space, encoded_name, name_len);
1217 for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1221 tail_index = name_len;
1222 while (tail_index > 0)
1225 struct block_symbol *syms;
1226 struct symbol *type_sym;
1227 struct symbol *renaming_sym;
1228 const char* renaming;
1230 const char* renaming_expr;
1231 int terminator = encoded_name[tail_index];
1233 encoded_name[tail_index] = '\0';
1234 nsyms = ada_lookup_symbol_list (encoded_name, block,
1236 encoded_name[tail_index] = terminator;
1238 /* A single symbol may rename a package or object. */
1240 /* This should go away when we move entirely to new version.
1241 FIXME pnh 7/20/2007. */
1244 struct symbol *ren_sym =
1245 ada_find_renaming_symbol (syms[0].symbol, syms[0].block);
1247 if (ren_sym != NULL)
1248 syms[0].symbol = ren_sym;
1251 type_sym = select_possible_type_sym (syms, nsyms);
1253 if (type_sym != NULL)
1254 renaming_sym = type_sym;
1255 else if (nsyms == 1)
1256 renaming_sym = syms[0].symbol;
1258 renaming_sym = NULL;
1260 switch (ada_parse_renaming (renaming_sym, &renaming,
1261 &renaming_len, &renaming_expr))
1263 case ADA_NOT_RENAMING:
1265 case ADA_PACKAGE_RENAMING:
1266 case ADA_EXCEPTION_RENAMING:
1267 case ADA_SUBPROGRAM_RENAMING:
1269 int alloc_len = renaming_len + name_len - tail_index + 1;
1271 = (char *) obstack_alloc (&temp_parse_space, alloc_len);
1272 strncpy (new_name, renaming, renaming_len);
1273 strcpy (new_name + renaming_len, encoded_name + tail_index);
1274 encoded_name = new_name;
1275 name_len = renaming_len + name_len - tail_index;
1276 goto TryAfterRenaming;
1278 case ADA_OBJECT_RENAMING:
1279 write_object_renaming (par_state, block, renaming, renaming_len,
1280 renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1281 write_selectors (par_state, encoded_name + tail_index);
1284 internal_error (__FILE__, __LINE__,
1285 _("impossible value from ada_parse_renaming"));
1288 if (type_sym != NULL)
1290 struct type *field_type;
1292 if (tail_index == name_len)
1293 return SYMBOL_TYPE (type_sym);
1295 /* We have some extraneous characters after the type name.
1296 If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1297 then try to get the type of FIELDN. */
1299 = get_symbol_field_type (type_sym, encoded_name + tail_index);
1300 if (field_type != NULL)
1303 error (_("Invalid attempt to select from type: \"%s\"."),
1306 else if (tail_index == name_len && nsyms == 0)
1308 struct type *type = find_primitive_type (par_state,
1317 write_var_from_sym (par_state, block, syms[0].block,
1319 write_selectors (par_state, encoded_name + tail_index);
1322 else if (nsyms == 0)
1324 struct bound_minimal_symbol msym
1325 = ada_lookup_simple_minsym (encoded_name);
1326 if (msym.minsym != NULL)
1328 write_exp_msymbol (par_state, msym);
1329 /* Maybe cause error here rather than later? FIXME? */
1330 write_selectors (par_state, encoded_name + tail_index);
1334 if (tail_index == name_len
1335 && strncmp (encoded_name, "standard__",
1336 sizeof ("standard__") - 1) == 0)
1337 error (_("No definition of \"%s\" found."), name0.ptr);
1339 tail_index = chop_selector (encoded_name, tail_index);
1343 write_ambiguous_var (par_state, block, encoded_name,
1345 write_selectors (par_state, encoded_name + tail_index);
1350 if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1351 error (_("No symbol table is loaded. Use the \"file\" command."));
1352 if (block == expression_context_block)
1353 error (_("No definition of \"%s\" in current context."), name0.ptr);
1355 error (_("No definition of \"%s\" in specified context."), name0.ptr);
1360 error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1364 /* Write a left side of a component association (e.g., NAME in NAME =>
1365 exp). If NAME has the form of a selected component, write it as an
1366 ordinary expression. If it is a simple variable that unambiguously
1367 corresponds to exactly one symbol that does not denote a type or an
1368 object renaming, also write it normally as an OP_VAR_VALUE.
1369 Otherwise, write it as an OP_NAME.
1371 Unfortunately, we don't know at this point whether NAME is supposed
1372 to denote a record component name or the value of an array index.
1373 Therefore, it is not appropriate to disambiguate an ambiguous name
1374 as we normally would, nor to replace a renaming with its referent.
1375 As a result, in the (one hopes) rare case that one writes an
1376 aggregate such as (R => 42) where R renames an object or is an
1377 ambiguous name, one must write instead ((R) => 42). */
1380 write_name_assoc (struct parser_state *par_state, struct stoken name)
1382 if (strchr (name.ptr, '.') == NULL)
1384 struct block_symbol *syms;
1385 int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
1388 if (nsyms != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF)
1389 write_exp_op_with_string (par_state, OP_NAME, name);
1391 write_var_from_sym (par_state, NULL, syms[0].block, syms[0].symbol);
1394 if (write_var_or_type (par_state, NULL, name) != NULL)
1395 error (_("Invalid use of type."));
1398 /* Convert the character literal whose ASCII value would be VAL to the
1399 appropriate value of type TYPE, if there is a translation.
1400 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
1401 the literal 'A' (VAL == 65), returns 0. */
1404 convert_char_literal (struct type *type, LONGEST val)
1411 type = check_typedef (type);
1412 if (TYPE_CODE (type) != TYPE_CODE_ENUM)
1415 xsnprintf (name, sizeof (name), "QU%02x", (int) val);
1416 for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1418 if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
1419 return TYPE_FIELD_ENUMVAL (type, f);
1424 static struct type *
1425 type_int (struct parser_state *par_state)
1427 return parse_type (par_state)->builtin_int;
1430 static struct type *
1431 type_long (struct parser_state *par_state)
1433 return parse_type (par_state)->builtin_long;
1436 static struct type *
1437 type_long_long (struct parser_state *par_state)
1439 return parse_type (par_state)->builtin_long_long;
1442 static struct type *
1443 type_float (struct parser_state *par_state)
1445 return parse_type (par_state)->builtin_float;
1448 static struct type *
1449 type_double (struct parser_state *par_state)
1451 return parse_type (par_state)->builtin_double;
1454 static struct type *
1455 type_long_double (struct parser_state *par_state)
1457 return parse_type (par_state)->builtin_long_double;
1460 static struct type *
1461 type_char (struct parser_state *par_state)
1463 return language_string_char_type (parse_language (par_state),
1464 parse_gdbarch (par_state));
1467 static struct type *
1468 type_boolean (struct parser_state *par_state)
1470 return parse_type (par_state)->builtin_bool;
1473 static struct type *
1474 type_system_address (struct parser_state *par_state)
1477 = language_lookup_primitive_type (parse_language (par_state),
1478 parse_gdbarch (par_state),
1480 return type != NULL ? type : parse_type (par_state)->builtin_data_ptr;
1484 _initialize_ada_exp (void)
1486 obstack_init (&temp_parse_space);