1 /* YACC parser for Ada expressions, for GDB.
2 Copyright (C) 1986-2016 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, etc),
54 as well as gratuitiously global symbol names, so we can have multiple
55 yacc generated parsers in gdb. These are only the variables
56 produced by yacc. If other parser generators (bison, byacc, etc) produce
57 additional global names that conflict at link time, then those parser
58 generators need to be fixed instead of adding those names to this list. */
60 /* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix
61 options. I presume we are maintaining it to accommodate systems
62 without BISON? (PNH) */
64 #define yymaxdepth ada_maxdepth
65 /* ada_parse calls this after initialization */
66 #define yyparse ada_parse_internal
68 #define yyerror ada_error
69 #define yylval ada_lval
70 #define yychar ada_char
71 #define yydebug ada_debug
72 #define yypact ada_pact
79 #define yyexca ada_exca
80 #define yyerrflag ada_errflag
81 #define yynerrs ada_nerrs
85 #define yy_yys ada_yys
86 #define yystate ada_state
89 #define yy_yyv ada_yyv
91 #define yylloc ada_lloc
92 #define yyreds ada_reds /* With YYDEBUG defined */
93 #define yytoks ada_toks /* With YYDEBUG defined */
94 #define yyname ada_name /* With YYDEBUG defined */
95 #define yyrule ada_rule /* With YYDEBUG defined */
96 #define yydefred ada_yydefred
98 #define yysslim ada_yysslim
99 #define yyssp ada_yyssp
100 #define yystacksize ada_yystacksize
101 #define yyvs ada_yyvs
102 #define yyvsp ada_yyvsp
105 #define YYDEBUG 1 /* Default to yydebug support */
108 #define YYFPRINTF parser_fprintf
112 struct minimal_symbol *msym;
113 const struct block *block;
114 struct stoken stoken;
117 /* The state of the parser, used internally when we are parsing the
120 static struct parser_state *pstate = NULL;
122 static struct stoken empty_stoken = { "", 0 };
124 /* If expression is in the context of TYPE'(...), then TYPE, else
126 static struct type *type_qualifier;
130 static int yylex (void);
132 void yyerror (char *);
134 static void write_int (struct parser_state *, LONGEST, struct type *);
136 static void write_object_renaming (struct parser_state *,
137 const struct block *, const char *, int,
140 static struct type* write_var_or_type (struct parser_state *,
141 const struct block *, struct stoken);
143 static void write_name_assoc (struct parser_state *, struct stoken);
145 static void write_exp_op_with_string (struct parser_state *, enum exp_opcode,
148 static const struct block *block_lookup (const struct block *, const char *);
150 static LONGEST convert_char_literal (struct type *, LONGEST);
152 static void write_ambiguous_var (struct parser_state *,
153 const struct block *, char *, int);
155 static struct type *type_int (struct parser_state *);
157 static struct type *type_long (struct parser_state *);
159 static struct type *type_long_long (struct parser_state *);
161 static struct type *type_float (struct parser_state *);
163 static struct type *type_double (struct parser_state *);
165 static struct type *type_long_double (struct parser_state *);
167 static struct type *type_char (struct parser_state *);
169 static struct type *type_boolean (struct parser_state *);
171 static struct type *type_system_address (struct parser_state *);
188 const struct block *bval;
189 struct internalvar *ivar;
192 %type <lval> positional_list component_groups component_associations
193 %type <lval> aggregate_component_list
194 %type <tval> var_or_type
196 %token <typed_val> INT NULL_PTR CHARLIT
197 %token <typed_val_float> FLOAT
198 %token TRUEKEYWORD FALSEKEYWORD
200 %token <sval> STRING NAME DOT_ID
202 %type <lval> arglist tick_arglist
204 %type <tval> save_qualifier
208 /* Special type cases, put in to allow the parser to distinguish different
210 %token <sval> SPECIAL_VARIABLE
213 %left _AND_ OR XOR THEN ELSE
214 %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
218 %left '*' '/' MOD REM
219 %right STARSTAR ABS NOT
221 /* Artificial token to give NAME => ... and NAME | priority over reducing
222 NAME to <primary> and to give <primary>' priority over reducing <primary>
228 %right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
229 %right TICK_MAX TICK_MIN TICK_MODULUS
230 %right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
231 /* The following are right-associative only so that reductions at this
232 precedence have lower precedence than '.' and '('. The syntax still
233 forces a.b.c, e.g., to be LEFT-associated. */
234 %right '.' '(' '[' DOT_ID DOT_ALL
244 /* Expressions, including the sequencing operator. */
247 { write_exp_elt_opcode (pstate, BINOP_COMMA); }
248 | primary ASSIGN exp /* Extension for convenience */
249 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
252 /* Expressions, not including the sequencing operator. */
253 primary : primary DOT_ALL
254 { write_exp_elt_opcode (pstate, UNOP_IND); }
257 primary : primary DOT_ID
258 { write_exp_op_with_string (pstate, STRUCTOP_STRUCT,
262 primary : primary '(' arglist ')'
264 write_exp_elt_opcode (pstate, OP_FUNCALL);
265 write_exp_elt_longcst (pstate, $3);
266 write_exp_elt_opcode (pstate, OP_FUNCALL);
268 | var_or_type '(' arglist ')'
273 error (_("Invalid conversion"));
274 write_exp_elt_opcode (pstate, UNOP_CAST);
275 write_exp_elt_type (pstate, $1);
276 write_exp_elt_opcode (pstate, UNOP_CAST);
280 write_exp_elt_opcode (pstate, OP_FUNCALL);
281 write_exp_elt_longcst (pstate, $3);
282 write_exp_elt_opcode (pstate, OP_FUNCALL);
287 primary : var_or_type '\'' save_qualifier { type_qualifier = $1; }
291 error (_("Type required for qualification"));
292 write_exp_elt_opcode (pstate, UNOP_QUAL);
293 write_exp_elt_type (pstate, $1);
294 write_exp_elt_opcode (pstate, UNOP_QUAL);
299 save_qualifier : { $$ = type_qualifier; }
303 primary '(' simple_exp DOTDOT simple_exp ')'
304 { write_exp_elt_opcode (pstate, TERNOP_SLICE); }
305 | var_or_type '(' simple_exp DOTDOT simple_exp ')'
307 write_exp_elt_opcode (pstate, TERNOP_SLICE);
309 error (_("Cannot slice a type"));
313 primary : '(' exp1 ')' { }
316 /* The following rule causes a conflict with the type conversion
318 To get around it, we give '(' higher priority and add bridge rules for
319 var_or_type (exp, exp, ...)
320 var_or_type (exp .. exp)
321 We also have the action for var_or_type(exp) generate a function call
322 when the first symbol does not denote a type. */
324 primary : var_or_type %prec VAR
327 write_exp_elt_opcode (pstate, OP_TYPE);
328 write_exp_elt_type (pstate, $1);
329 write_exp_elt_opcode (pstate, OP_TYPE);
334 primary : SPECIAL_VARIABLE /* Various GDB extensions */
335 { write_dollar_variable (pstate, $1); }
344 simple_exp : '-' simple_exp %prec UNARY
345 { write_exp_elt_opcode (pstate, UNOP_NEG); }
348 simple_exp : '+' simple_exp %prec UNARY
349 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
352 simple_exp : NOT simple_exp %prec UNARY
353 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
356 simple_exp : ABS simple_exp %prec UNARY
357 { write_exp_elt_opcode (pstate, UNOP_ABS); }
360 arglist : { $$ = 0; }
369 | arglist ',' NAME ARROW exp
373 primary : '{' var_or_type '}' primary %prec '.'
377 error (_("Type required within braces in coercion"));
378 write_exp_elt_opcode (pstate, UNOP_MEMVAL);
379 write_exp_elt_type (pstate, $2);
380 write_exp_elt_opcode (pstate, UNOP_MEMVAL);
384 /* Binary operators in order of decreasing precedence. */
386 simple_exp : simple_exp STARSTAR simple_exp
387 { write_exp_elt_opcode (pstate, BINOP_EXP); }
390 simple_exp : simple_exp '*' simple_exp
391 { write_exp_elt_opcode (pstate, BINOP_MUL); }
394 simple_exp : simple_exp '/' simple_exp
395 { write_exp_elt_opcode (pstate, BINOP_DIV); }
398 simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
399 { write_exp_elt_opcode (pstate, BINOP_REM); }
402 simple_exp : simple_exp MOD simple_exp
403 { write_exp_elt_opcode (pstate, BINOP_MOD); }
406 simple_exp : simple_exp '@' simple_exp /* GDB extension */
407 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
410 simple_exp : simple_exp '+' simple_exp
411 { write_exp_elt_opcode (pstate, BINOP_ADD); }
414 simple_exp : simple_exp '&' simple_exp
415 { write_exp_elt_opcode (pstate, BINOP_CONCAT); }
418 simple_exp : simple_exp '-' simple_exp
419 { write_exp_elt_opcode (pstate, BINOP_SUB); }
422 relation : simple_exp
425 relation : simple_exp '=' simple_exp
426 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
429 relation : simple_exp NOTEQUAL simple_exp
430 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
433 relation : simple_exp LEQ simple_exp
434 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
437 relation : simple_exp IN simple_exp DOTDOT simple_exp
438 { write_exp_elt_opcode (pstate, TERNOP_IN_RANGE); }
439 | simple_exp IN primary TICK_RANGE tick_arglist
440 { write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
441 write_exp_elt_longcst (pstate, (LONGEST) $5);
442 write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
444 | simple_exp IN var_or_type %prec TICK_ACCESS
447 error (_("Right operand of 'in' must be type"));
448 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
449 write_exp_elt_type (pstate, $3);
450 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
452 | simple_exp NOT IN simple_exp DOTDOT simple_exp
453 { write_exp_elt_opcode (pstate, TERNOP_IN_RANGE);
454 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
456 | simple_exp NOT IN primary TICK_RANGE tick_arglist
457 { write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
458 write_exp_elt_longcst (pstate, (LONGEST) $6);
459 write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
460 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
462 | simple_exp NOT IN var_or_type %prec TICK_ACCESS
465 error (_("Right operand of 'in' must be type"));
466 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
467 write_exp_elt_type (pstate, $4);
468 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
469 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
473 relation : simple_exp GEQ simple_exp
474 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
477 relation : simple_exp '<' simple_exp
478 { write_exp_elt_opcode (pstate, BINOP_LESS); }
481 relation : simple_exp '>' simple_exp
482 { write_exp_elt_opcode (pstate, BINOP_GTR); }
494 relation _AND_ relation
495 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
496 | and_exp _AND_ relation
497 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
501 relation _AND_ THEN relation
502 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
503 | and_then_exp _AND_ THEN relation
504 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
509 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
511 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
515 relation OR ELSE relation
516 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
517 | or_else_exp OR ELSE relation
518 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
521 xor_exp : relation XOR relation
522 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
523 | xor_exp XOR relation
524 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
527 /* Primaries can denote types (OP_TYPE). In cases such as
528 primary TICK_ADDRESS, where a type would be invalid, it will be
529 caught when evaluate_subexp in ada-lang.c tries to evaluate the
530 primary, expecting a value. Precedence rules resolve the ambiguity
531 in NAME TICK_ACCESS in favor of shifting to form a var_or_type. A
532 construct such as aType'access'access will again cause an error when
533 aType'access evaluates to a type that evaluate_subexp attempts to
535 primary : primary TICK_ACCESS
536 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
537 | primary TICK_ADDRESS
538 { write_exp_elt_opcode (pstate, UNOP_ADDR);
539 write_exp_elt_opcode (pstate, UNOP_CAST);
540 write_exp_elt_type (pstate,
541 type_system_address (pstate));
542 write_exp_elt_opcode (pstate, UNOP_CAST);
544 | primary TICK_FIRST tick_arglist
545 { write_int (pstate, $3, type_int (pstate));
546 write_exp_elt_opcode (pstate, OP_ATR_FIRST); }
547 | primary TICK_LAST tick_arglist
548 { write_int (pstate, $3, type_int (pstate));
549 write_exp_elt_opcode (pstate, OP_ATR_LAST); }
550 | primary TICK_LENGTH tick_arglist
551 { write_int (pstate, $3, type_int (pstate));
552 write_exp_elt_opcode (pstate, OP_ATR_LENGTH); }
554 { write_exp_elt_opcode (pstate, OP_ATR_SIZE); }
556 { write_exp_elt_opcode (pstate, OP_ATR_TAG); }
557 | opt_type_prefix TICK_MIN '(' exp ',' exp ')'
558 { write_exp_elt_opcode (pstate, OP_ATR_MIN); }
559 | opt_type_prefix TICK_MAX '(' exp ',' exp ')'
560 { write_exp_elt_opcode (pstate, OP_ATR_MAX); }
561 | opt_type_prefix TICK_POS '(' exp ')'
562 { write_exp_elt_opcode (pstate, OP_ATR_POS); }
563 | type_prefix TICK_VAL '(' exp ')'
564 { write_exp_elt_opcode (pstate, OP_ATR_VAL); }
565 | type_prefix TICK_MODULUS
566 { write_exp_elt_opcode (pstate, OP_ATR_MODULUS); }
569 tick_arglist : %prec '('
579 error (_("Prefix must be type"));
580 write_exp_elt_opcode (pstate, OP_TYPE);
581 write_exp_elt_type (pstate, $1);
582 write_exp_elt_opcode (pstate, OP_TYPE); }
588 { write_exp_elt_opcode (pstate, OP_TYPE);
589 write_exp_elt_type (pstate,
590 parse_type (pstate)->builtin_void);
591 write_exp_elt_opcode (pstate, OP_TYPE); }
596 { write_int (pstate, (LONGEST) $1.val, $1.type); }
601 convert_char_literal (type_qualifier, $1.val),
602 (type_qualifier == NULL)
603 ? $1.type : type_qualifier);
608 { write_exp_elt_opcode (pstate, OP_DOUBLE);
609 write_exp_elt_type (pstate, $1.type);
610 write_exp_elt_dblcst (pstate, $1.dval);
611 write_exp_elt_opcode (pstate, OP_DOUBLE);
616 { write_int (pstate, 0, type_int (pstate)); }
621 write_exp_op_with_string (pstate, OP_STRING, $1);
625 primary : TRUEKEYWORD
626 { write_int (pstate, 1, type_boolean (pstate)); }
628 { write_int (pstate, 0, type_boolean (pstate)); }
632 { error (_("NEW not implemented.")); }
635 var_or_type: NAME %prec VAR
636 { $$ = write_var_or_type (pstate, NULL, $1); }
637 | block NAME %prec VAR
638 { $$ = write_var_or_type (pstate, $1, $2); }
641 $$ = write_var_or_type (pstate, NULL, $1);
643 write_exp_elt_opcode (pstate, UNOP_ADDR);
645 $$ = lookup_pointer_type ($$);
647 | block NAME TICK_ACCESS
649 $$ = write_var_or_type (pstate, $1, $2);
651 write_exp_elt_opcode (pstate, UNOP_ADDR);
653 $$ = lookup_pointer_type ($$);
658 block : NAME COLONCOLON
659 { $$ = block_lookup (NULL, $1.ptr); }
660 | block NAME COLONCOLON
661 { $$ = block_lookup ($1, $2.ptr); }
665 '(' aggregate_component_list ')'
667 write_exp_elt_opcode (pstate, OP_AGGREGATE);
668 write_exp_elt_longcst (pstate, $2);
669 write_exp_elt_opcode (pstate, OP_AGGREGATE);
673 aggregate_component_list :
674 component_groups { $$ = $1; }
675 | positional_list exp
676 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
677 write_exp_elt_longcst (pstate, $1);
678 write_exp_elt_opcode (pstate, OP_POSITIONAL);
681 | positional_list component_groups
687 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
688 write_exp_elt_longcst (pstate, 0);
689 write_exp_elt_opcode (pstate, OP_POSITIONAL);
692 | positional_list exp ','
693 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
694 write_exp_elt_longcst (pstate, $1);
695 write_exp_elt_opcode (pstate, OP_POSITIONAL);
702 | component_group { $$ = 1; }
703 | component_group ',' component_groups
707 others : OTHERS ARROW exp
708 { write_exp_elt_opcode (pstate, OP_OTHERS); }
712 component_associations
714 write_exp_elt_opcode (pstate, OP_CHOICES);
715 write_exp_elt_longcst (pstate, $1);
716 write_exp_elt_opcode (pstate, OP_CHOICES);
720 /* We use this somewhat obscure definition in order to handle NAME => and
721 NAME | differently from exp => and exp |. ARROW and '|' have a precedence
722 above that of the reduction of NAME to var_or_type. By delaying
723 decisions until after the => or '|', we convert the ambiguity to a
724 resolved shift/reduce conflict. */
725 component_associations :
727 { write_name_assoc (pstate, $1); }
729 | simple_exp ARROW exp
731 | simple_exp DOTDOT simple_exp ARROW
732 { write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE);
733 write_exp_op_with_string (pstate, OP_NAME,
738 { write_name_assoc (pstate, $1); }
739 component_associations { $$ = $4 + 1; }
741 component_associations { $$ = $3 + 1; }
742 | simple_exp DOTDOT simple_exp '|'
743 { write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE); }
744 component_associations { $$ = $6 + 1; }
747 /* Some extensions borrowed from C, for the benefit of those who find they
748 can't get used to Ada notation in GDB. */
750 primary : '*' primary %prec '.'
751 { write_exp_elt_opcode (pstate, UNOP_IND); }
752 | '&' primary %prec '.'
753 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
754 | primary '[' exp ']'
755 { write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); }
760 /* yylex defined in ada-lex.c: Reads one token, getting characters */
761 /* through lexptr. */
763 /* Remap normal flex interface names (yylex) as well as gratuitiously */
764 /* global symbol names, so we can have multiple flex-generated parsers */
767 /* (See note above on previous definitions for YACC.) */
769 #define yy_create_buffer ada_yy_create_buffer
770 #define yy_delete_buffer ada_yy_delete_buffer
771 #define yy_init_buffer ada_yy_init_buffer
772 #define yy_load_buffer_state ada_yy_load_buffer_state
773 #define yy_switch_to_buffer ada_yy_switch_to_buffer
774 #define yyrestart ada_yyrestart
775 #define yytext ada_yytext
776 #define yywrap ada_yywrap
778 static struct obstack temp_parse_space;
780 /* The following kludge was found necessary to prevent conflicts between */
781 /* defs.h and non-standard stdlib.h files. */
782 #define qsort __qsort__dummy
786 ada_parse (struct parser_state *par_state)
789 struct cleanup *c = make_cleanup_clear_parser_state (&pstate);
791 /* Setting up the parser state. */
792 gdb_assert (par_state != NULL);
795 lexer_init (yyin); /* (Re-)initialize lexer. */
796 type_qualifier = NULL;
797 obstack_free (&temp_parse_space, NULL);
798 obstack_init (&temp_parse_space);
808 error (_("Error in expression, near `%s'."), lexptr);
811 /* Emit expression to access an instance of SYM, in block BLOCK (if
812 * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
814 write_var_from_sym (struct parser_state *par_state,
815 const struct block *orig_left_context,
816 const struct block *block,
819 if (orig_left_context == NULL && symbol_read_needs_frame (sym))
821 if (innermost_block == 0
822 || contained_in (block, innermost_block))
823 innermost_block = block;
826 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
827 write_exp_elt_block (par_state, block);
828 write_exp_elt_sym (par_state, sym);
829 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
832 /* Write integer or boolean constant ARG of type TYPE. */
835 write_int (struct parser_state *par_state, LONGEST arg, struct type *type)
837 write_exp_elt_opcode (par_state, OP_LONG);
838 write_exp_elt_type (par_state, type);
839 write_exp_elt_longcst (par_state, arg);
840 write_exp_elt_opcode (par_state, OP_LONG);
843 /* Write an OPCODE, string, OPCODE sequence to the current expression. */
845 write_exp_op_with_string (struct parser_state *par_state,
846 enum exp_opcode opcode, struct stoken token)
848 write_exp_elt_opcode (par_state, opcode);
849 write_exp_string (par_state, token);
850 write_exp_elt_opcode (par_state, opcode);
853 /* Emit expression corresponding to the renamed object named
854 * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
855 * context of ORIG_LEFT_CONTEXT, to which is applied the operations
856 * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of
857 * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it
858 * defaults to the currently selected block. ORIG_SYMBOL is the
859 * symbol that originally encoded the renaming. It is needed only
860 * because its prefix also qualifies any index variables used to index
861 * or slice an array. It should not be necessary once we go to the
862 * new encoding entirely (FIXME pnh 7/20/2007). */
865 write_object_renaming (struct parser_state *par_state,
866 const struct block *orig_left_context,
867 const char *renamed_entity, int renamed_entity_len,
868 const char *renaming_expr, int max_depth)
871 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
872 struct block_symbol sym_info;
875 error (_("Could not find renamed symbol"));
877 if (orig_left_context == NULL)
878 orig_left_context = get_selected_block (NULL);
880 name = (char *) obstack_copy0 (&temp_parse_space, renamed_entity,
882 ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, &sym_info);
883 if (sym_info.symbol == NULL)
884 error (_("Could not find renamed variable: %s"), ada_decode (name));
885 else if (SYMBOL_CLASS (sym_info.symbol) == LOC_TYPEDEF)
886 /* We have a renaming of an old-style renaming symbol. Don't
887 trust the block information. */
888 sym_info.block = orig_left_context;
891 const char *inner_renamed_entity;
892 int inner_renamed_entity_len;
893 const char *inner_renaming_expr;
895 switch (ada_parse_renaming (sym_info.symbol, &inner_renamed_entity,
896 &inner_renamed_entity_len,
897 &inner_renaming_expr))
899 case ADA_NOT_RENAMING:
900 write_var_from_sym (par_state, orig_left_context, sym_info.block,
903 case ADA_OBJECT_RENAMING:
904 write_object_renaming (par_state, sym_info.block,
905 inner_renamed_entity, inner_renamed_entity_len,
906 inner_renaming_expr, max_depth - 1);
913 slice_state = SIMPLE_INDEX;
914 while (*renaming_expr == 'X')
918 switch (*renaming_expr) {
921 write_exp_elt_opcode (par_state, UNOP_IND);
924 slice_state = LOWER_BOUND;
928 if (isdigit (*renaming_expr))
931 long val = strtol (renaming_expr, &next, 10);
932 if (next == renaming_expr)
934 renaming_expr = next;
935 write_exp_elt_opcode (par_state, OP_LONG);
936 write_exp_elt_type (par_state, type_int (par_state));
937 write_exp_elt_longcst (par_state, (LONGEST) val);
938 write_exp_elt_opcode (par_state, OP_LONG);
944 struct block_symbol index_sym_info;
946 end = strchr (renaming_expr, 'X');
948 end = renaming_expr + strlen (renaming_expr);
951 = (char *) obstack_copy0 (&temp_parse_space, renaming_expr,
952 end - renaming_expr);
955 ada_lookup_encoded_symbol (index_name, NULL, VAR_DOMAIN,
957 if (index_sym_info.symbol == NULL)
958 error (_("Could not find %s"), index_name);
959 else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF)
960 /* Index is an old-style renaming symbol. */
961 index_sym_info.block = orig_left_context;
962 write_var_from_sym (par_state, NULL, index_sym_info.block,
963 index_sym_info.symbol);
965 if (slice_state == SIMPLE_INDEX)
967 write_exp_elt_opcode (par_state, OP_FUNCALL);
968 write_exp_elt_longcst (par_state, (LONGEST) 1);
969 write_exp_elt_opcode (par_state, OP_FUNCALL);
971 else if (slice_state == LOWER_BOUND)
972 slice_state = UPPER_BOUND;
973 else if (slice_state == UPPER_BOUND)
975 write_exp_elt_opcode (par_state, TERNOP_SLICE);
976 slice_state = SIMPLE_INDEX;
982 struct stoken field_name;
988 if (slice_state != SIMPLE_INDEX)
990 end = strchr (renaming_expr, 'X');
992 end = renaming_expr + strlen (renaming_expr);
993 field_name.length = end - renaming_expr;
994 buf = (char *) malloc (end - renaming_expr + 1);
995 field_name.ptr = buf;
996 strncpy (buf, renaming_expr, end - renaming_expr);
997 buf[end - renaming_expr] = '\000';
999 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
1007 if (slice_state == SIMPLE_INDEX)
1011 error (_("Internal error in encoding of renaming declaration"));
1014 static const struct block*
1015 block_lookup (const struct block *context, const char *raw_name)
1018 struct block_symbol *syms;
1020 struct symtab *symtab;
1022 if (raw_name[0] == '\'')
1028 name = ada_encode (raw_name);
1030 nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
1032 && (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK))
1033 symtab = lookup_symtab (name);
1038 return BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symtab), STATIC_BLOCK);
1039 else if (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK)
1041 if (context == NULL)
1042 error (_("No file or function \"%s\"."), raw_name);
1044 error (_("No function \"%s\" in specified context."), raw_name);
1049 warning (_("Function name \"%s\" ambiguous here"), raw_name);
1050 return SYMBOL_BLOCK_VALUE (syms[0].symbol);
1054 static struct symbol*
1055 select_possible_type_sym (struct block_symbol *syms, int nsyms)
1058 int preferred_index;
1059 struct type *preferred_type;
1061 preferred_index = -1; preferred_type = NULL;
1062 for (i = 0; i < nsyms; i += 1)
1063 switch (SYMBOL_CLASS (syms[i].symbol))
1066 if (ada_prefer_type (SYMBOL_TYPE (syms[i].symbol), preferred_type))
1068 preferred_index = i;
1069 preferred_type = SYMBOL_TYPE (syms[i].symbol);
1075 case LOC_REGPARM_ADDR:
1082 if (preferred_type == NULL)
1084 return syms[preferred_index].symbol;
1088 find_primitive_type (struct parser_state *par_state, char *name)
1091 type = language_lookup_primitive_type (parse_language (par_state),
1092 parse_gdbarch (par_state),
1094 if (type == NULL && strcmp ("system__address", name) == 0)
1095 type = type_system_address (par_state);
1099 /* Check to see if we have a regular definition of this
1100 type that just didn't happen to have been read yet. */
1102 char *expanded_name =
1103 (char *) alloca (strlen (name) + sizeof ("standard__"));
1104 strcpy (expanded_name, "standard__");
1105 strcat (expanded_name, name);
1106 sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL).symbol;
1107 if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1108 type = SYMBOL_TYPE (sym);
1115 chop_selector (char *name, int end)
1118 for (i = end - 1; i > 0; i -= 1)
1119 if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1124 /* If NAME is a string beginning with a separator (either '__', or
1125 '.'), chop this separator and return the result; else, return
1129 chop_separator (char *name)
1134 if (name[0] == '_' && name[1] == '_')
1140 /* Given that SELS is a string of the form (<sep><identifier>)*, where
1141 <sep> is '__' or '.', write the indicated sequence of
1142 STRUCTOP_STRUCT expression operators. */
1144 write_selectors (struct parser_state *par_state, char *sels)
1146 while (*sels != '\0')
1148 struct stoken field_name;
1149 char *p = chop_separator (sels);
1151 while (*sels != '\0' && *sels != '.'
1152 && (sels[0] != '_' || sels[1] != '_'))
1154 field_name.length = sels - p;
1156 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
1160 /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1161 NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes
1162 a temporary symbol that is valid until the next call to ada_parse.
1165 write_ambiguous_var (struct parser_state *par_state,
1166 const struct block *block, char *name, int len)
1168 struct symbol *sym = XOBNEW (&temp_parse_space, struct symbol);
1170 memset (sym, 0, sizeof (struct symbol));
1171 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1172 SYMBOL_LINKAGE_NAME (sym)
1173 = (const char *) obstack_copy0 (&temp_parse_space, name, len);
1174 SYMBOL_LANGUAGE (sym) = language_ada;
1176 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1177 write_exp_elt_block (par_state, block);
1178 write_exp_elt_sym (par_state, sym);
1179 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1182 /* A convenient wrapper around ada_get_field_index that takes
1183 a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1184 of a NUL-terminated field name. */
1187 ada_nget_field_index (const struct type *type, const char *field_name0,
1188 int field_name_len, int maybe_missing)
1190 char *field_name = (char *) alloca ((field_name_len + 1) * sizeof (char));
1192 strncpy (field_name, field_name0, field_name_len);
1193 field_name[field_name_len] = '\0';
1194 return ada_get_field_index (type, field_name, maybe_missing);
1197 /* If encoded_field_name is the name of a field inside symbol SYM,
1198 then return the type of that field. Otherwise, return NULL.
1200 This function is actually recursive, so if ENCODED_FIELD_NAME
1201 doesn't match one of the fields of our symbol, then try to see
1202 if ENCODED_FIELD_NAME could not be a succession of field names
1203 (in other words, the user entered an expression of the form
1204 TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1205 each field name sequentially to obtain the desired field type.
1206 In case of failure, we return NULL. */
1208 static struct type *
1209 get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1211 char *field_name = encoded_field_name;
1212 char *subfield_name;
1213 struct type *type = SYMBOL_TYPE (sym);
1216 if (type == NULL || field_name == NULL)
1218 type = check_typedef (type);
1220 while (field_name[0] != '\0')
1222 field_name = chop_separator (field_name);
1224 fieldno = ada_get_field_index (type, field_name, 1);
1226 return TYPE_FIELD_TYPE (type, fieldno);
1228 subfield_name = field_name;
1229 while (*subfield_name != '\0' && *subfield_name != '.'
1230 && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1233 if (subfield_name[0] == '\0')
1236 fieldno = ada_nget_field_index (type, field_name,
1237 subfield_name - field_name, 1);
1241 type = TYPE_FIELD_TYPE (type, fieldno);
1242 field_name = subfield_name;
1248 /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
1249 expression_block_context if NULL). If it denotes a type, return
1250 that type. Otherwise, write expression code to evaluate it as an
1251 object and return NULL. In this second case, NAME0 will, in general,
1252 have the form <name>(.<selector_name>)*, where <name> is an object
1253 or renaming encoded in the debugging data. Calls error if no
1254 prefix <name> matches a name in the debugging data (i.e., matches
1255 either a complete name or, as a wild-card match, the final
1259 write_var_or_type (struct parser_state *par_state,
1260 const struct block *block, struct stoken name0)
1267 block = expression_context_block;
1269 encoded_name = ada_encode (name0.ptr);
1270 name_len = strlen (encoded_name);
1272 = (char *) obstack_copy0 (&temp_parse_space, encoded_name, name_len);
1273 for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1277 tail_index = name_len;
1278 while (tail_index > 0)
1281 struct block_symbol *syms;
1282 struct symbol *type_sym;
1283 struct symbol *renaming_sym;
1284 const char* renaming;
1286 const char* renaming_expr;
1287 int terminator = encoded_name[tail_index];
1289 encoded_name[tail_index] = '\0';
1290 nsyms = ada_lookup_symbol_list (encoded_name, block,
1292 encoded_name[tail_index] = terminator;
1294 /* A single symbol may rename a package or object. */
1296 /* This should go away when we move entirely to new version.
1297 FIXME pnh 7/20/2007. */
1300 struct symbol *ren_sym =
1301 ada_find_renaming_symbol (syms[0].symbol, syms[0].block);
1303 if (ren_sym != NULL)
1304 syms[0].symbol = ren_sym;
1307 type_sym = select_possible_type_sym (syms, nsyms);
1309 if (type_sym != NULL)
1310 renaming_sym = type_sym;
1311 else if (nsyms == 1)
1312 renaming_sym = syms[0].symbol;
1314 renaming_sym = NULL;
1316 switch (ada_parse_renaming (renaming_sym, &renaming,
1317 &renaming_len, &renaming_expr))
1319 case ADA_NOT_RENAMING:
1321 case ADA_PACKAGE_RENAMING:
1322 case ADA_EXCEPTION_RENAMING:
1323 case ADA_SUBPROGRAM_RENAMING:
1325 int alloc_len = renaming_len + name_len - tail_index + 1;
1327 = (char *) obstack_alloc (&temp_parse_space, alloc_len);
1328 strncpy (new_name, renaming, renaming_len);
1329 strcpy (new_name + renaming_len, encoded_name + tail_index);
1330 encoded_name = new_name;
1331 name_len = renaming_len + name_len - tail_index;
1332 goto TryAfterRenaming;
1334 case ADA_OBJECT_RENAMING:
1335 write_object_renaming (par_state, block, renaming, renaming_len,
1336 renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1337 write_selectors (par_state, encoded_name + tail_index);
1340 internal_error (__FILE__, __LINE__,
1341 _("impossible value from ada_parse_renaming"));
1344 if (type_sym != NULL)
1346 struct type *field_type;
1348 if (tail_index == name_len)
1349 return SYMBOL_TYPE (type_sym);
1351 /* We have some extraneous characters after the type name.
1352 If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1353 then try to get the type of FIELDN. */
1355 = get_symbol_field_type (type_sym, encoded_name + tail_index);
1356 if (field_type != NULL)
1359 error (_("Invalid attempt to select from type: \"%s\"."),
1362 else if (tail_index == name_len && nsyms == 0)
1364 struct type *type = find_primitive_type (par_state,
1373 write_var_from_sym (par_state, block, syms[0].block,
1375 write_selectors (par_state, encoded_name + tail_index);
1378 else if (nsyms == 0)
1380 struct bound_minimal_symbol msym
1381 = ada_lookup_simple_minsym (encoded_name);
1382 if (msym.minsym != NULL)
1384 write_exp_msymbol (par_state, msym);
1385 /* Maybe cause error here rather than later? FIXME? */
1386 write_selectors (par_state, encoded_name + tail_index);
1390 if (tail_index == name_len
1391 && strncmp (encoded_name, "standard__",
1392 sizeof ("standard__") - 1) == 0)
1393 error (_("No definition of \"%s\" found."), name0.ptr);
1395 tail_index = chop_selector (encoded_name, tail_index);
1399 write_ambiguous_var (par_state, block, encoded_name,
1401 write_selectors (par_state, encoded_name + tail_index);
1406 if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1407 error (_("No symbol table is loaded. Use the \"file\" command."));
1408 if (block == expression_context_block)
1409 error (_("No definition of \"%s\" in current context."), name0.ptr);
1411 error (_("No definition of \"%s\" in specified context."), name0.ptr);
1416 error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1420 /* Write a left side of a component association (e.g., NAME in NAME =>
1421 exp). If NAME has the form of a selected component, write it as an
1422 ordinary expression. If it is a simple variable that unambiguously
1423 corresponds to exactly one symbol that does not denote a type or an
1424 object renaming, also write it normally as an OP_VAR_VALUE.
1425 Otherwise, write it as an OP_NAME.
1427 Unfortunately, we don't know at this point whether NAME is supposed
1428 to denote a record component name or the value of an array index.
1429 Therefore, it is not appropriate to disambiguate an ambiguous name
1430 as we normally would, nor to replace a renaming with its referent.
1431 As a result, in the (one hopes) rare case that one writes an
1432 aggregate such as (R => 42) where R renames an object or is an
1433 ambiguous name, one must write instead ((R) => 42). */
1436 write_name_assoc (struct parser_state *par_state, struct stoken name)
1438 if (strchr (name.ptr, '.') == NULL)
1440 struct block_symbol *syms;
1441 int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
1444 if (nsyms != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF)
1445 write_exp_op_with_string (par_state, OP_NAME, name);
1447 write_var_from_sym (par_state, NULL, syms[0].block, syms[0].symbol);
1450 if (write_var_or_type (par_state, NULL, name) != NULL)
1451 error (_("Invalid use of type."));
1454 /* Convert the character literal whose ASCII value would be VAL to the
1455 appropriate value of type TYPE, if there is a translation.
1456 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
1457 the literal 'A' (VAL == 65), returns 0. */
1460 convert_char_literal (struct type *type, LONGEST val)
1467 type = check_typedef (type);
1468 if (TYPE_CODE (type) != TYPE_CODE_ENUM)
1471 xsnprintf (name, sizeof (name), "QU%02x", (int) val);
1472 for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1474 if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
1475 return TYPE_FIELD_ENUMVAL (type, f);
1480 static struct type *
1481 type_int (struct parser_state *par_state)
1483 return parse_type (par_state)->builtin_int;
1486 static struct type *
1487 type_long (struct parser_state *par_state)
1489 return parse_type (par_state)->builtin_long;
1492 static struct type *
1493 type_long_long (struct parser_state *par_state)
1495 return parse_type (par_state)->builtin_long_long;
1498 static struct type *
1499 type_float (struct parser_state *par_state)
1501 return parse_type (par_state)->builtin_float;
1504 static struct type *
1505 type_double (struct parser_state *par_state)
1507 return parse_type (par_state)->builtin_double;
1510 static struct type *
1511 type_long_double (struct parser_state *par_state)
1513 return parse_type (par_state)->builtin_long_double;
1516 static struct type *
1517 type_char (struct parser_state *par_state)
1519 return language_string_char_type (parse_language (par_state),
1520 parse_gdbarch (par_state));
1523 static struct type *
1524 type_boolean (struct parser_state *par_state)
1526 return parse_type (par_state)->builtin_bool;
1529 static struct type *
1530 type_system_address (struct parser_state *par_state)
1533 = language_lookup_primitive_type (parse_language (par_state),
1534 parse_gdbarch (par_state),
1536 return type != NULL ? type : parse_type (par_state)->builtin_data_ptr;
1539 /* Provide a prototype to silence -Wmissing-prototypes. */
1540 extern initialize_file_ftype _initialize_ada_exp;
1543 _initialize_ada_exp (void)
1545 obstack_init (&temp_parse_space);