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 */
97 #define yysslim ada_yysslim
98 #define yyssp ada_yyssp
99 #define yystacksize ada_yystacksize
100 #define yyvs ada_yyvs
101 #define yyvsp ada_yyvsp
104 #define YYDEBUG 1 /* Default to yydebug support */
107 #define YYFPRINTF parser_fprintf
111 struct minimal_symbol *msym;
112 const struct block *block;
113 struct stoken stoken;
116 /* The state of the parser, used internally when we are parsing the
119 static struct parser_state *pstate = NULL;
121 static struct stoken empty_stoken = { "", 0 };
123 /* If expression is in the context of TYPE'(...), then TYPE, else
125 static struct type *type_qualifier;
129 static int yylex (void);
131 void yyerror (char *);
133 static void write_int (struct parser_state *, LONGEST, struct type *);
135 static void write_object_renaming (struct parser_state *,
136 const struct block *, const char *, int,
139 static struct type* write_var_or_type (struct parser_state *,
140 const struct block *, struct stoken);
142 static void write_name_assoc (struct parser_state *, struct stoken);
144 static void write_exp_op_with_string (struct parser_state *, enum exp_opcode,
147 static const struct block *block_lookup (const struct block *, const char *);
149 static LONGEST convert_char_literal (struct type *, LONGEST);
151 static void write_ambiguous_var (struct parser_state *,
152 const struct block *, char *, int);
154 static struct type *type_int (struct parser_state *);
156 static struct type *type_long (struct parser_state *);
158 static struct type *type_long_long (struct parser_state *);
160 static struct type *type_float (struct parser_state *);
162 static struct type *type_double (struct parser_state *);
164 static struct type *type_long_double (struct parser_state *);
166 static struct type *type_char (struct parser_state *);
168 static struct type *type_boolean (struct parser_state *);
170 static struct type *type_system_address (struct parser_state *);
187 const struct block *bval;
188 struct internalvar *ivar;
191 %type <lval> positional_list component_groups component_associations
192 %type <lval> aggregate_component_list
193 %type <tval> var_or_type
195 %token <typed_val> INT NULL_PTR CHARLIT
196 %token <typed_val_float> FLOAT
197 %token TRUEKEYWORD FALSEKEYWORD
199 %token <sval> STRING NAME DOT_ID
201 %type <lval> arglist tick_arglist
203 %type <tval> save_qualifier
207 /* Special type cases, put in to allow the parser to distinguish different
209 %token <sval> SPECIAL_VARIABLE
212 %left _AND_ OR XOR THEN ELSE
213 %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
217 %left '*' '/' MOD REM
218 %right STARSTAR ABS NOT
220 /* Artificial token to give NAME => ... and NAME | priority over reducing
221 NAME to <primary> and to give <primary>' priority over reducing <primary>
227 %right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
228 %right TICK_MAX TICK_MIN TICK_MODULUS
229 %right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
230 /* The following are right-associative only so that reductions at this
231 precedence have lower precedence than '.' and '('. The syntax still
232 forces a.b.c, e.g., to be LEFT-associated. */
233 %right '.' '(' '[' DOT_ID DOT_ALL
243 /* Expressions, including the sequencing operator. */
246 { write_exp_elt_opcode (pstate, BINOP_COMMA); }
247 | primary ASSIGN exp /* Extension for convenience */
248 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
251 /* Expressions, not including the sequencing operator. */
252 primary : primary DOT_ALL
253 { write_exp_elt_opcode (pstate, UNOP_IND); }
256 primary : primary DOT_ID
257 { write_exp_op_with_string (pstate, STRUCTOP_STRUCT,
261 primary : primary '(' arglist ')'
263 write_exp_elt_opcode (pstate, OP_FUNCALL);
264 write_exp_elt_longcst (pstate, $3);
265 write_exp_elt_opcode (pstate, OP_FUNCALL);
267 | var_or_type '(' arglist ')'
272 error (_("Invalid conversion"));
273 write_exp_elt_opcode (pstate, UNOP_CAST);
274 write_exp_elt_type (pstate, $1);
275 write_exp_elt_opcode (pstate, UNOP_CAST);
279 write_exp_elt_opcode (pstate, OP_FUNCALL);
280 write_exp_elt_longcst (pstate, $3);
281 write_exp_elt_opcode (pstate, OP_FUNCALL);
286 primary : var_or_type '\'' save_qualifier { type_qualifier = $1; }
290 error (_("Type required for qualification"));
291 write_exp_elt_opcode (pstate, UNOP_QUAL);
292 write_exp_elt_type (pstate, $1);
293 write_exp_elt_opcode (pstate, UNOP_QUAL);
298 save_qualifier : { $$ = type_qualifier; }
302 primary '(' simple_exp DOTDOT simple_exp ')'
303 { write_exp_elt_opcode (pstate, TERNOP_SLICE); }
304 | var_or_type '(' simple_exp DOTDOT simple_exp ')'
306 write_exp_elt_opcode (pstate, TERNOP_SLICE);
308 error (_("Cannot slice a type"));
312 primary : '(' exp1 ')' { }
315 /* The following rule causes a conflict with the type conversion
317 To get around it, we give '(' higher priority and add bridge rules for
318 var_or_type (exp, exp, ...)
319 var_or_type (exp .. exp)
320 We also have the action for var_or_type(exp) generate a function call
321 when the first symbol does not denote a type. */
323 primary : var_or_type %prec VAR
326 write_exp_elt_opcode (pstate, OP_TYPE);
327 write_exp_elt_type (pstate, $1);
328 write_exp_elt_opcode (pstate, OP_TYPE);
333 primary : SPECIAL_VARIABLE /* Various GDB extensions */
334 { write_dollar_variable (pstate, $1); }
343 simple_exp : '-' simple_exp %prec UNARY
344 { write_exp_elt_opcode (pstate, UNOP_NEG); }
347 simple_exp : '+' simple_exp %prec UNARY
348 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
351 simple_exp : NOT simple_exp %prec UNARY
352 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
355 simple_exp : ABS simple_exp %prec UNARY
356 { write_exp_elt_opcode (pstate, UNOP_ABS); }
359 arglist : { $$ = 0; }
368 | arglist ',' NAME ARROW exp
372 primary : '{' var_or_type '}' primary %prec '.'
376 error (_("Type required within braces in coercion"));
377 write_exp_elt_opcode (pstate, UNOP_MEMVAL);
378 write_exp_elt_type (pstate, $2);
379 write_exp_elt_opcode (pstate, UNOP_MEMVAL);
383 /* Binary operators in order of decreasing precedence. */
385 simple_exp : simple_exp STARSTAR simple_exp
386 { write_exp_elt_opcode (pstate, BINOP_EXP); }
389 simple_exp : simple_exp '*' simple_exp
390 { write_exp_elt_opcode (pstate, BINOP_MUL); }
393 simple_exp : simple_exp '/' simple_exp
394 { write_exp_elt_opcode (pstate, BINOP_DIV); }
397 simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
398 { write_exp_elt_opcode (pstate, BINOP_REM); }
401 simple_exp : simple_exp MOD simple_exp
402 { write_exp_elt_opcode (pstate, BINOP_MOD); }
405 simple_exp : simple_exp '@' simple_exp /* GDB extension */
406 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
409 simple_exp : simple_exp '+' simple_exp
410 { write_exp_elt_opcode (pstate, BINOP_ADD); }
413 simple_exp : simple_exp '&' simple_exp
414 { write_exp_elt_opcode (pstate, BINOP_CONCAT); }
417 simple_exp : simple_exp '-' simple_exp
418 { write_exp_elt_opcode (pstate, BINOP_SUB); }
421 relation : simple_exp
424 relation : simple_exp '=' simple_exp
425 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
428 relation : simple_exp NOTEQUAL simple_exp
429 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
432 relation : simple_exp LEQ simple_exp
433 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
436 relation : simple_exp IN simple_exp DOTDOT simple_exp
437 { write_exp_elt_opcode (pstate, TERNOP_IN_RANGE); }
438 | simple_exp IN primary TICK_RANGE tick_arglist
439 { write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
440 write_exp_elt_longcst (pstate, (LONGEST) $5);
441 write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
443 | simple_exp IN var_or_type %prec TICK_ACCESS
446 error (_("Right operand of 'in' must be type"));
447 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
448 write_exp_elt_type (pstate, $3);
449 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
451 | simple_exp NOT IN simple_exp DOTDOT simple_exp
452 { write_exp_elt_opcode (pstate, TERNOP_IN_RANGE);
453 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
455 | simple_exp NOT IN primary TICK_RANGE tick_arglist
456 { write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
457 write_exp_elt_longcst (pstate, (LONGEST) $6);
458 write_exp_elt_opcode (pstate, BINOP_IN_BOUNDS);
459 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
461 | simple_exp NOT IN var_or_type %prec TICK_ACCESS
464 error (_("Right operand of 'in' must be type"));
465 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
466 write_exp_elt_type (pstate, $4);
467 write_exp_elt_opcode (pstate, UNOP_IN_RANGE);
468 write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT);
472 relation : simple_exp GEQ simple_exp
473 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
476 relation : simple_exp '<' simple_exp
477 { write_exp_elt_opcode (pstate, BINOP_LESS); }
480 relation : simple_exp '>' simple_exp
481 { write_exp_elt_opcode (pstate, BINOP_GTR); }
493 relation _AND_ relation
494 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
495 | and_exp _AND_ relation
496 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
500 relation _AND_ THEN relation
501 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
502 | and_then_exp _AND_ THEN relation
503 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
508 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
510 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
514 relation OR ELSE relation
515 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
516 | or_else_exp OR ELSE relation
517 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
520 xor_exp : relation XOR relation
521 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
522 | xor_exp XOR relation
523 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
526 /* Primaries can denote types (OP_TYPE). In cases such as
527 primary TICK_ADDRESS, where a type would be invalid, it will be
528 caught when evaluate_subexp in ada-lang.c tries to evaluate the
529 primary, expecting a value. Precedence rules resolve the ambiguity
530 in NAME TICK_ACCESS in favor of shifting to form a var_or_type. A
531 construct such as aType'access'access will again cause an error when
532 aType'access evaluates to a type that evaluate_subexp attempts to
534 primary : primary TICK_ACCESS
535 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
536 | primary TICK_ADDRESS
537 { write_exp_elt_opcode (pstate, UNOP_ADDR);
538 write_exp_elt_opcode (pstate, UNOP_CAST);
539 write_exp_elt_type (pstate,
540 type_system_address (pstate));
541 write_exp_elt_opcode (pstate, UNOP_CAST);
543 | primary TICK_FIRST tick_arglist
544 { write_int (pstate, $3, type_int (pstate));
545 write_exp_elt_opcode (pstate, OP_ATR_FIRST); }
546 | primary TICK_LAST tick_arglist
547 { write_int (pstate, $3, type_int (pstate));
548 write_exp_elt_opcode (pstate, OP_ATR_LAST); }
549 | primary TICK_LENGTH tick_arglist
550 { write_int (pstate, $3, type_int (pstate));
551 write_exp_elt_opcode (pstate, OP_ATR_LENGTH); }
553 { write_exp_elt_opcode (pstate, OP_ATR_SIZE); }
555 { write_exp_elt_opcode (pstate, OP_ATR_TAG); }
556 | opt_type_prefix TICK_MIN '(' exp ',' exp ')'
557 { write_exp_elt_opcode (pstate, OP_ATR_MIN); }
558 | opt_type_prefix TICK_MAX '(' exp ',' exp ')'
559 { write_exp_elt_opcode (pstate, OP_ATR_MAX); }
560 | opt_type_prefix TICK_POS '(' exp ')'
561 { write_exp_elt_opcode (pstate, OP_ATR_POS); }
562 | type_prefix TICK_VAL '(' exp ')'
563 { write_exp_elt_opcode (pstate, OP_ATR_VAL); }
564 | type_prefix TICK_MODULUS
565 { write_exp_elt_opcode (pstate, OP_ATR_MODULUS); }
568 tick_arglist : %prec '('
578 error (_("Prefix must be type"));
579 write_exp_elt_opcode (pstate, OP_TYPE);
580 write_exp_elt_type (pstate, $1);
581 write_exp_elt_opcode (pstate, OP_TYPE); }
587 { write_exp_elt_opcode (pstate, OP_TYPE);
588 write_exp_elt_type (pstate,
589 parse_type (pstate)->builtin_void);
590 write_exp_elt_opcode (pstate, OP_TYPE); }
595 { write_int (pstate, (LONGEST) $1.val, $1.type); }
600 convert_char_literal (type_qualifier, $1.val),
601 (type_qualifier == NULL)
602 ? $1.type : type_qualifier);
607 { write_exp_elt_opcode (pstate, OP_DOUBLE);
608 write_exp_elt_type (pstate, $1.type);
609 write_exp_elt_dblcst (pstate, $1.dval);
610 write_exp_elt_opcode (pstate, OP_DOUBLE);
615 { write_int (pstate, 0, type_int (pstate)); }
620 write_exp_op_with_string (pstate, OP_STRING, $1);
624 primary : TRUEKEYWORD
625 { write_int (pstate, 1, type_boolean (pstate)); }
627 { write_int (pstate, 0, type_boolean (pstate)); }
631 { error (_("NEW not implemented.")); }
634 var_or_type: NAME %prec VAR
635 { $$ = write_var_or_type (pstate, NULL, $1); }
636 | block NAME %prec VAR
637 { $$ = write_var_or_type (pstate, $1, $2); }
640 $$ = write_var_or_type (pstate, NULL, $1);
642 write_exp_elt_opcode (pstate, UNOP_ADDR);
644 $$ = lookup_pointer_type ($$);
646 | block NAME TICK_ACCESS
648 $$ = write_var_or_type (pstate, $1, $2);
650 write_exp_elt_opcode (pstate, UNOP_ADDR);
652 $$ = lookup_pointer_type ($$);
657 block : NAME COLONCOLON
658 { $$ = block_lookup (NULL, $1.ptr); }
659 | block NAME COLONCOLON
660 { $$ = block_lookup ($1, $2.ptr); }
664 '(' aggregate_component_list ')'
666 write_exp_elt_opcode (pstate, OP_AGGREGATE);
667 write_exp_elt_longcst (pstate, $2);
668 write_exp_elt_opcode (pstate, OP_AGGREGATE);
672 aggregate_component_list :
673 component_groups { $$ = $1; }
674 | positional_list exp
675 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
676 write_exp_elt_longcst (pstate, $1);
677 write_exp_elt_opcode (pstate, OP_POSITIONAL);
680 | positional_list component_groups
686 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
687 write_exp_elt_longcst (pstate, 0);
688 write_exp_elt_opcode (pstate, OP_POSITIONAL);
691 | positional_list exp ','
692 { write_exp_elt_opcode (pstate, OP_POSITIONAL);
693 write_exp_elt_longcst (pstate, $1);
694 write_exp_elt_opcode (pstate, OP_POSITIONAL);
701 | component_group { $$ = 1; }
702 | component_group ',' component_groups
706 others : OTHERS ARROW exp
707 { write_exp_elt_opcode (pstate, OP_OTHERS); }
711 component_associations
713 write_exp_elt_opcode (pstate, OP_CHOICES);
714 write_exp_elt_longcst (pstate, $1);
715 write_exp_elt_opcode (pstate, OP_CHOICES);
719 /* We use this somewhat obscure definition in order to handle NAME => and
720 NAME | differently from exp => and exp |. ARROW and '|' have a precedence
721 above that of the reduction of NAME to var_or_type. By delaying
722 decisions until after the => or '|', we convert the ambiguity to a
723 resolved shift/reduce conflict. */
724 component_associations :
726 { write_name_assoc (pstate, $1); }
728 | simple_exp ARROW exp
730 | simple_exp DOTDOT simple_exp ARROW
731 { write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE);
732 write_exp_op_with_string (pstate, OP_NAME,
737 { write_name_assoc (pstate, $1); }
738 component_associations { $$ = $4 + 1; }
740 component_associations { $$ = $3 + 1; }
741 | simple_exp DOTDOT simple_exp '|'
742 { write_exp_elt_opcode (pstate, OP_DISCRETE_RANGE); }
743 component_associations { $$ = $6 + 1; }
746 /* Some extensions borrowed from C, for the benefit of those who find they
747 can't get used to Ada notation in GDB. */
749 primary : '*' primary %prec '.'
750 { write_exp_elt_opcode (pstate, UNOP_IND); }
751 | '&' primary %prec '.'
752 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
753 | primary '[' exp ']'
754 { write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); }
759 /* yylex defined in ada-lex.c: Reads one token, getting characters */
760 /* through lexptr. */
762 /* Remap normal flex interface names (yylex) as well as gratuitiously */
763 /* global symbol names, so we can have multiple flex-generated parsers */
766 /* (See note above on previous definitions for YACC.) */
768 #define yy_create_buffer ada_yy_create_buffer
769 #define yy_delete_buffer ada_yy_delete_buffer
770 #define yy_init_buffer ada_yy_init_buffer
771 #define yy_load_buffer_state ada_yy_load_buffer_state
772 #define yy_switch_to_buffer ada_yy_switch_to_buffer
773 #define yyrestart ada_yyrestart
774 #define yytext ada_yytext
775 #define yywrap ada_yywrap
777 static struct obstack temp_parse_space;
779 /* The following kludge was found necessary to prevent conflicts between */
780 /* defs.h and non-standard stdlib.h files. */
781 #define qsort __qsort__dummy
785 ada_parse (struct parser_state *par_state)
788 struct cleanup *c = make_cleanup_clear_parser_state (&pstate);
790 /* Setting up the parser state. */
791 gdb_assert (par_state != NULL);
794 lexer_init (yyin); /* (Re-)initialize lexer. */
795 type_qualifier = NULL;
796 obstack_free (&temp_parse_space, NULL);
797 obstack_init (&temp_parse_space);
807 error (_("Error in expression, near `%s'."), lexptr);
810 /* Emit expression to access an instance of SYM, in block BLOCK (if
811 * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
813 write_var_from_sym (struct parser_state *par_state,
814 const struct block *orig_left_context,
815 const struct block *block,
818 if (orig_left_context == NULL && symbol_read_needs_frame (sym))
820 if (innermost_block == 0
821 || contained_in (block, innermost_block))
822 innermost_block = block;
825 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
826 write_exp_elt_block (par_state, block);
827 write_exp_elt_sym (par_state, sym);
828 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
831 /* Write integer or boolean constant ARG of type TYPE. */
834 write_int (struct parser_state *par_state, LONGEST arg, struct type *type)
836 write_exp_elt_opcode (par_state, OP_LONG);
837 write_exp_elt_type (par_state, type);
838 write_exp_elt_longcst (par_state, arg);
839 write_exp_elt_opcode (par_state, OP_LONG);
842 /* Write an OPCODE, string, OPCODE sequence to the current expression. */
844 write_exp_op_with_string (struct parser_state *par_state,
845 enum exp_opcode opcode, struct stoken token)
847 write_exp_elt_opcode (par_state, opcode);
848 write_exp_string (par_state, token);
849 write_exp_elt_opcode (par_state, opcode);
852 /* Emit expression corresponding to the renamed object named
853 * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
854 * context of ORIG_LEFT_CONTEXT, to which is applied the operations
855 * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of
856 * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it
857 * defaults to the currently selected block. ORIG_SYMBOL is the
858 * symbol that originally encoded the renaming. It is needed only
859 * because its prefix also qualifies any index variables used to index
860 * or slice an array. It should not be necessary once we go to the
861 * new encoding entirely (FIXME pnh 7/20/2007). */
864 write_object_renaming (struct parser_state *par_state,
865 const struct block *orig_left_context,
866 const char *renamed_entity, int renamed_entity_len,
867 const char *renaming_expr, int max_depth)
870 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
871 struct block_symbol sym_info;
874 error (_("Could not find renamed symbol"));
876 if (orig_left_context == NULL)
877 orig_left_context = get_selected_block (NULL);
879 name = (char *) obstack_copy0 (&temp_parse_space, renamed_entity,
881 ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, &sym_info);
882 if (sym_info.symbol == NULL)
883 error (_("Could not find renamed variable: %s"), ada_decode (name));
884 else if (SYMBOL_CLASS (sym_info.symbol) == LOC_TYPEDEF)
885 /* We have a renaming of an old-style renaming symbol. Don't
886 trust the block information. */
887 sym_info.block = orig_left_context;
890 const char *inner_renamed_entity;
891 int inner_renamed_entity_len;
892 const char *inner_renaming_expr;
894 switch (ada_parse_renaming (sym_info.symbol, &inner_renamed_entity,
895 &inner_renamed_entity_len,
896 &inner_renaming_expr))
898 case ADA_NOT_RENAMING:
899 write_var_from_sym (par_state, orig_left_context, sym_info.block,
902 case ADA_OBJECT_RENAMING:
903 write_object_renaming (par_state, sym_info.block,
904 inner_renamed_entity, inner_renamed_entity_len,
905 inner_renaming_expr, max_depth - 1);
912 slice_state = SIMPLE_INDEX;
913 while (*renaming_expr == 'X')
917 switch (*renaming_expr) {
920 write_exp_elt_opcode (par_state, UNOP_IND);
923 slice_state = LOWER_BOUND;
927 if (isdigit (*renaming_expr))
930 long val = strtol (renaming_expr, &next, 10);
931 if (next == renaming_expr)
933 renaming_expr = next;
934 write_exp_elt_opcode (par_state, OP_LONG);
935 write_exp_elt_type (par_state, type_int (par_state));
936 write_exp_elt_longcst (par_state, (LONGEST) val);
937 write_exp_elt_opcode (par_state, OP_LONG);
943 struct block_symbol index_sym_info;
945 end = strchr (renaming_expr, 'X');
947 end = renaming_expr + strlen (renaming_expr);
950 = (char *) obstack_copy0 (&temp_parse_space, renaming_expr,
951 end - renaming_expr);
954 ada_lookup_encoded_symbol (index_name, NULL, VAR_DOMAIN,
956 if (index_sym_info.symbol == NULL)
957 error (_("Could not find %s"), index_name);
958 else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF)
959 /* Index is an old-style renaming symbol. */
960 index_sym_info.block = orig_left_context;
961 write_var_from_sym (par_state, NULL, index_sym_info.block,
962 index_sym_info.symbol);
964 if (slice_state == SIMPLE_INDEX)
966 write_exp_elt_opcode (par_state, OP_FUNCALL);
967 write_exp_elt_longcst (par_state, (LONGEST) 1);
968 write_exp_elt_opcode (par_state, OP_FUNCALL);
970 else if (slice_state == LOWER_BOUND)
971 slice_state = UPPER_BOUND;
972 else if (slice_state == UPPER_BOUND)
974 write_exp_elt_opcode (par_state, TERNOP_SLICE);
975 slice_state = SIMPLE_INDEX;
981 struct stoken field_name;
987 if (slice_state != SIMPLE_INDEX)
989 end = strchr (renaming_expr, 'X');
991 end = renaming_expr + strlen (renaming_expr);
992 field_name.length = end - renaming_expr;
993 buf = (char *) malloc (end - renaming_expr + 1);
994 field_name.ptr = buf;
995 strncpy (buf, renaming_expr, end - renaming_expr);
996 buf[end - renaming_expr] = '\000';
998 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
1006 if (slice_state == SIMPLE_INDEX)
1010 error (_("Internal error in encoding of renaming declaration"));
1013 static const struct block*
1014 block_lookup (const struct block *context, const char *raw_name)
1017 struct block_symbol *syms;
1019 struct symtab *symtab;
1021 if (raw_name[0] == '\'')
1027 name = ada_encode (raw_name);
1029 nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
1031 && (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK))
1032 symtab = lookup_symtab (name);
1037 return BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (symtab), STATIC_BLOCK);
1038 else if (nsyms == 0 || SYMBOL_CLASS (syms[0].symbol) != LOC_BLOCK)
1040 if (context == NULL)
1041 error (_("No file or function \"%s\"."), raw_name);
1043 error (_("No function \"%s\" in specified context."), raw_name);
1048 warning (_("Function name \"%s\" ambiguous here"), raw_name);
1049 return SYMBOL_BLOCK_VALUE (syms[0].symbol);
1053 static struct symbol*
1054 select_possible_type_sym (struct block_symbol *syms, int nsyms)
1057 int preferred_index;
1058 struct type *preferred_type;
1060 preferred_index = -1; preferred_type = NULL;
1061 for (i = 0; i < nsyms; i += 1)
1062 switch (SYMBOL_CLASS (syms[i].symbol))
1065 if (ada_prefer_type (SYMBOL_TYPE (syms[i].symbol), preferred_type))
1067 preferred_index = i;
1068 preferred_type = SYMBOL_TYPE (syms[i].symbol);
1074 case LOC_REGPARM_ADDR:
1081 if (preferred_type == NULL)
1083 return syms[preferred_index].symbol;
1087 find_primitive_type (struct parser_state *par_state, char *name)
1090 type = language_lookup_primitive_type (parse_language (par_state),
1091 parse_gdbarch (par_state),
1093 if (type == NULL && strcmp ("system__address", name) == 0)
1094 type = type_system_address (par_state);
1098 /* Check to see if we have a regular definition of this
1099 type that just didn't happen to have been read yet. */
1101 char *expanded_name =
1102 (char *) alloca (strlen (name) + sizeof ("standard__"));
1103 strcpy (expanded_name, "standard__");
1104 strcat (expanded_name, name);
1105 sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL).symbol;
1106 if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1107 type = SYMBOL_TYPE (sym);
1114 chop_selector (char *name, int end)
1117 for (i = end - 1; i > 0; i -= 1)
1118 if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1123 /* If NAME is a string beginning with a separator (either '__', or
1124 '.'), chop this separator and return the result; else, return
1128 chop_separator (char *name)
1133 if (name[0] == '_' && name[1] == '_')
1139 /* Given that SELS is a string of the form (<sep><identifier>)*, where
1140 <sep> is '__' or '.', write the indicated sequence of
1141 STRUCTOP_STRUCT expression operators. */
1143 write_selectors (struct parser_state *par_state, char *sels)
1145 while (*sels != '\0')
1147 struct stoken field_name;
1148 char *p = chop_separator (sels);
1150 while (*sels != '\0' && *sels != '.'
1151 && (sels[0] != '_' || sels[1] != '_'))
1153 field_name.length = sels - p;
1155 write_exp_op_with_string (par_state, STRUCTOP_STRUCT, field_name);
1159 /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1160 NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes
1161 a temporary symbol that is valid until the next call to ada_parse.
1164 write_ambiguous_var (struct parser_state *par_state,
1165 const struct block *block, char *name, int len)
1167 struct symbol *sym = XOBNEW (&temp_parse_space, struct symbol);
1169 memset (sym, 0, sizeof (struct symbol));
1170 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1171 SYMBOL_LINKAGE_NAME (sym)
1172 = (const char *) obstack_copy0 (&temp_parse_space, name, len);
1173 SYMBOL_LANGUAGE (sym) = language_ada;
1175 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1176 write_exp_elt_block (par_state, block);
1177 write_exp_elt_sym (par_state, sym);
1178 write_exp_elt_opcode (par_state, OP_VAR_VALUE);
1181 /* A convenient wrapper around ada_get_field_index that takes
1182 a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1183 of a NUL-terminated field name. */
1186 ada_nget_field_index (const struct type *type, const char *field_name0,
1187 int field_name_len, int maybe_missing)
1189 char *field_name = (char *) alloca ((field_name_len + 1) * sizeof (char));
1191 strncpy (field_name, field_name0, field_name_len);
1192 field_name[field_name_len] = '\0';
1193 return ada_get_field_index (type, field_name, maybe_missing);
1196 /* If encoded_field_name is the name of a field inside symbol SYM,
1197 then return the type of that field. Otherwise, return NULL.
1199 This function is actually recursive, so if ENCODED_FIELD_NAME
1200 doesn't match one of the fields of our symbol, then try to see
1201 if ENCODED_FIELD_NAME could not be a succession of field names
1202 (in other words, the user entered an expression of the form
1203 TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1204 each field name sequentially to obtain the desired field type.
1205 In case of failure, we return NULL. */
1207 static struct type *
1208 get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1210 char *field_name = encoded_field_name;
1211 char *subfield_name;
1212 struct type *type = SYMBOL_TYPE (sym);
1215 if (type == NULL || field_name == NULL)
1217 type = check_typedef (type);
1219 while (field_name[0] != '\0')
1221 field_name = chop_separator (field_name);
1223 fieldno = ada_get_field_index (type, field_name, 1);
1225 return TYPE_FIELD_TYPE (type, fieldno);
1227 subfield_name = field_name;
1228 while (*subfield_name != '\0' && *subfield_name != '.'
1229 && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1232 if (subfield_name[0] == '\0')
1235 fieldno = ada_nget_field_index (type, field_name,
1236 subfield_name - field_name, 1);
1240 type = TYPE_FIELD_TYPE (type, fieldno);
1241 field_name = subfield_name;
1247 /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
1248 expression_block_context if NULL). If it denotes a type, return
1249 that type. Otherwise, write expression code to evaluate it as an
1250 object and return NULL. In this second case, NAME0 will, in general,
1251 have the form <name>(.<selector_name>)*, where <name> is an object
1252 or renaming encoded in the debugging data. Calls error if no
1253 prefix <name> matches a name in the debugging data (i.e., matches
1254 either a complete name or, as a wild-card match, the final
1258 write_var_or_type (struct parser_state *par_state,
1259 const struct block *block, struct stoken name0)
1266 block = expression_context_block;
1268 encoded_name = ada_encode (name0.ptr);
1269 name_len = strlen (encoded_name);
1271 = (char *) obstack_copy0 (&temp_parse_space, encoded_name, name_len);
1272 for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1276 tail_index = name_len;
1277 while (tail_index > 0)
1280 struct block_symbol *syms;
1281 struct symbol *type_sym;
1282 struct symbol *renaming_sym;
1283 const char* renaming;
1285 const char* renaming_expr;
1286 int terminator = encoded_name[tail_index];
1288 encoded_name[tail_index] = '\0';
1289 nsyms = ada_lookup_symbol_list (encoded_name, block,
1291 encoded_name[tail_index] = terminator;
1293 /* A single symbol may rename a package or object. */
1295 /* This should go away when we move entirely to new version.
1296 FIXME pnh 7/20/2007. */
1299 struct symbol *ren_sym =
1300 ada_find_renaming_symbol (syms[0].symbol, syms[0].block);
1302 if (ren_sym != NULL)
1303 syms[0].symbol = ren_sym;
1306 type_sym = select_possible_type_sym (syms, nsyms);
1308 if (type_sym != NULL)
1309 renaming_sym = type_sym;
1310 else if (nsyms == 1)
1311 renaming_sym = syms[0].symbol;
1313 renaming_sym = NULL;
1315 switch (ada_parse_renaming (renaming_sym, &renaming,
1316 &renaming_len, &renaming_expr))
1318 case ADA_NOT_RENAMING:
1320 case ADA_PACKAGE_RENAMING:
1321 case ADA_EXCEPTION_RENAMING:
1322 case ADA_SUBPROGRAM_RENAMING:
1324 int alloc_len = renaming_len + name_len - tail_index + 1;
1326 = (char *) obstack_alloc (&temp_parse_space, alloc_len);
1327 strncpy (new_name, renaming, renaming_len);
1328 strcpy (new_name + renaming_len, encoded_name + tail_index);
1329 encoded_name = new_name;
1330 name_len = renaming_len + name_len - tail_index;
1331 goto TryAfterRenaming;
1333 case ADA_OBJECT_RENAMING:
1334 write_object_renaming (par_state, block, renaming, renaming_len,
1335 renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1336 write_selectors (par_state, encoded_name + tail_index);
1339 internal_error (__FILE__, __LINE__,
1340 _("impossible value from ada_parse_renaming"));
1343 if (type_sym != NULL)
1345 struct type *field_type;
1347 if (tail_index == name_len)
1348 return SYMBOL_TYPE (type_sym);
1350 /* We have some extraneous characters after the type name.
1351 If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1352 then try to get the type of FIELDN. */
1354 = get_symbol_field_type (type_sym, encoded_name + tail_index);
1355 if (field_type != NULL)
1358 error (_("Invalid attempt to select from type: \"%s\"."),
1361 else if (tail_index == name_len && nsyms == 0)
1363 struct type *type = find_primitive_type (par_state,
1372 write_var_from_sym (par_state, block, syms[0].block,
1374 write_selectors (par_state, encoded_name + tail_index);
1377 else if (nsyms == 0)
1379 struct bound_minimal_symbol msym
1380 = ada_lookup_simple_minsym (encoded_name);
1381 if (msym.minsym != NULL)
1383 write_exp_msymbol (par_state, msym);
1384 /* Maybe cause error here rather than later? FIXME? */
1385 write_selectors (par_state, encoded_name + tail_index);
1389 if (tail_index == name_len
1390 && strncmp (encoded_name, "standard__",
1391 sizeof ("standard__") - 1) == 0)
1392 error (_("No definition of \"%s\" found."), name0.ptr);
1394 tail_index = chop_selector (encoded_name, tail_index);
1398 write_ambiguous_var (par_state, block, encoded_name,
1400 write_selectors (par_state, encoded_name + tail_index);
1405 if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1406 error (_("No symbol table is loaded. Use the \"file\" command."));
1407 if (block == expression_context_block)
1408 error (_("No definition of \"%s\" in current context."), name0.ptr);
1410 error (_("No definition of \"%s\" in specified context."), name0.ptr);
1415 error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1419 /* Write a left side of a component association (e.g., NAME in NAME =>
1420 exp). If NAME has the form of a selected component, write it as an
1421 ordinary expression. If it is a simple variable that unambiguously
1422 corresponds to exactly one symbol that does not denote a type or an
1423 object renaming, also write it normally as an OP_VAR_VALUE.
1424 Otherwise, write it as an OP_NAME.
1426 Unfortunately, we don't know at this point whether NAME is supposed
1427 to denote a record component name or the value of an array index.
1428 Therefore, it is not appropriate to disambiguate an ambiguous name
1429 as we normally would, nor to replace a renaming with its referent.
1430 As a result, in the (one hopes) rare case that one writes an
1431 aggregate such as (R => 42) where R renames an object or is an
1432 ambiguous name, one must write instead ((R) => 42). */
1435 write_name_assoc (struct parser_state *par_state, struct stoken name)
1437 if (strchr (name.ptr, '.') == NULL)
1439 struct block_symbol *syms;
1440 int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
1443 if (nsyms != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF)
1444 write_exp_op_with_string (par_state, OP_NAME, name);
1446 write_var_from_sym (par_state, NULL, syms[0].block, syms[0].symbol);
1449 if (write_var_or_type (par_state, NULL, name) != NULL)
1450 error (_("Invalid use of type."));
1453 /* Convert the character literal whose ASCII value would be VAL to the
1454 appropriate value of type TYPE, if there is a translation.
1455 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
1456 the literal 'A' (VAL == 65), returns 0. */
1459 convert_char_literal (struct type *type, LONGEST val)
1466 type = check_typedef (type);
1467 if (TYPE_CODE (type) != TYPE_CODE_ENUM)
1470 xsnprintf (name, sizeof (name), "QU%02x", (int) val);
1471 for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1473 if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
1474 return TYPE_FIELD_ENUMVAL (type, f);
1479 static struct type *
1480 type_int (struct parser_state *par_state)
1482 return parse_type (par_state)->builtin_int;
1485 static struct type *
1486 type_long (struct parser_state *par_state)
1488 return parse_type (par_state)->builtin_long;
1491 static struct type *
1492 type_long_long (struct parser_state *par_state)
1494 return parse_type (par_state)->builtin_long_long;
1497 static struct type *
1498 type_float (struct parser_state *par_state)
1500 return parse_type (par_state)->builtin_float;
1503 static struct type *
1504 type_double (struct parser_state *par_state)
1506 return parse_type (par_state)->builtin_double;
1509 static struct type *
1510 type_long_double (struct parser_state *par_state)
1512 return parse_type (par_state)->builtin_long_double;
1515 static struct type *
1516 type_char (struct parser_state *par_state)
1518 return language_string_char_type (parse_language (par_state),
1519 parse_gdbarch (par_state));
1522 static struct type *
1523 type_boolean (struct parser_state *par_state)
1525 return parse_type (par_state)->builtin_bool;
1528 static struct type *
1529 type_system_address (struct parser_state *par_state)
1532 = language_lookup_primitive_type (parse_language (par_state),
1533 parse_gdbarch (par_state),
1535 return type != NULL ? type : parse_type (par_state)->builtin_data_ptr;
1538 /* Provide a prototype to silence -Wmissing-prototypes. */
1539 extern initialize_file_ftype _initialize_ada_exp;
1542 _initialize_ada_exp (void)
1544 obstack_init (&temp_parse_space);