1 /* YACC parser for Ada expressions, for GDB.
2 Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000, 2003, 2004,
3 2007, 2008 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Parse an Ada expression from text in a string,
23 and return the result as a struct expression pointer.
24 That structure contains arithmetic operations in reverse polish,
25 with constants represented by operations that are followed by special data.
26 See expression.h for the details of the format.
27 What is important here is that it can be built up sequentially
28 during the process of parsing; the lower levels of the tree always
29 come first in the result.
31 malloc's and realloc's in this file are transformed to
32 xmalloc and xrealloc respectively by the same sed command in the
33 makefile that remaps any other malloc/realloc inserted by the parser
34 generator. Doing this with #defines and trying to control the interaction
35 with include files (<malloc.h> and <stdlib.h> for example) just became
36 too messy, particularly when such includes can be inserted at random
37 times by the parser generator. */
42 #include "gdb_string.h"
44 #include "expression.h"
46 #include "parser-defs.h"
49 #include "bfd.h" /* Required by objfiles.h. */
50 #include "symfile.h" /* Required by objfiles.h. */
51 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
55 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
56 as well as gratuitiously global symbol names, so we can have multiple
57 yacc generated parsers in gdb. These are only the variables
58 produced by yacc. If other parser generators (bison, byacc, etc) produce
59 additional global names that conflict at link time, then those parser
60 generators need to be fixed instead of adding those names to this list. */
62 /* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix
63 options. I presume we are maintaining it to accommodate systems
64 without BISON? (PNH) */
66 #define yymaxdepth ada_maxdepth
67 #define yyparse _ada_parse /* ada_parse calls this after initialization */
69 #define yyerror ada_error
70 #define yylval ada_lval
71 #define yychar ada_char
72 #define yydebug ada_debug
73 #define yypact ada_pact
80 #define yyexca ada_exca
81 #define yyerrflag ada_errflag
82 #define yynerrs ada_nerrs
86 #define yy_yys ada_yys
87 #define yystate ada_state
90 #define yy_yyv ada_yyv
92 #define yylloc ada_lloc
93 #define yyreds ada_reds /* With YYDEBUG defined */
94 #define yytoks ada_toks /* With YYDEBUG defined */
95 #define yyname ada_name /* With YYDEBUG defined */
96 #define yyrule ada_rule /* With YYDEBUG defined */
99 #define YYDEBUG 1 /* Default to yydebug support */
102 #define YYFPRINTF parser_fprintf
106 struct minimal_symbol *msym;
108 struct stoken stoken;
111 static struct stoken empty_stoken = { "", 0 };
113 /* If expression is in the context of TYPE'(...), then TYPE, else
115 static struct type *type_qualifier;
119 static int yylex (void);
121 void yyerror (char *);
123 static struct stoken string_to_operator (struct stoken);
125 static void write_int (LONGEST, struct type *);
127 static void write_object_renaming (struct block *, const char *, int,
130 static struct type* write_var_or_type (struct block *, struct stoken);
132 static void write_name_assoc (struct stoken);
134 static void write_exp_op_with_string (enum exp_opcode, struct stoken);
136 static struct block *block_lookup (struct block *, char *);
138 static LONGEST convert_char_literal (struct type *, LONGEST);
140 static void write_ambiguous_var (struct block *, char *, int);
142 static struct type *type_int (void);
144 static struct type *type_long (void);
146 static struct type *type_long_long (void);
148 static struct type *type_float (void);
150 static struct type *type_double (void);
152 static struct type *type_long_double (void);
154 static struct type *type_char (void);
156 static struct type *type_system_address (void);
174 struct internalvar *ivar;
177 %type <lval> positional_list component_groups component_associations
178 %type <lval> aggregate_component_list
179 %type <tval> var_or_type
181 %token <typed_val> INT NULL_PTR CHARLIT
182 %token <typed_val_float> FLOAT
184 %token <sval> STRING NAME DOT_ID
186 %type <lval> arglist tick_arglist
188 %type <tval> save_qualifier
192 /* Special type cases, put in to allow the parser to distinguish different
194 %token <sval> SPECIAL_VARIABLE
197 %left _AND_ OR XOR THEN ELSE
198 %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
202 %left '*' '/' MOD REM
203 %right STARSTAR ABS NOT
205 /* Artificial token to give NAME => ... and NAME | priority over reducing
206 NAME to <primary> and to give <primary>' priority over reducing <primary>
212 %right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
213 %right TICK_MAX TICK_MIN TICK_MODULUS
214 %right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
215 /* The following are right-associative only so that reductions at this
216 precedence have lower precedence than '.' and '('. The syntax still
217 forces a.b.c, e.g., to be LEFT-associated. */
218 %right '.' '(' '[' DOT_ID DOT_ALL
228 /* Expressions, including the sequencing operator. */
231 { write_exp_elt_opcode (BINOP_COMMA); }
232 | primary ASSIGN exp /* Extension for convenience */
233 { write_exp_elt_opcode (BINOP_ASSIGN); }
236 /* Expressions, not including the sequencing operator. */
237 primary : primary DOT_ALL
238 { write_exp_elt_opcode (UNOP_IND); }
241 primary : primary DOT_ID
242 { write_exp_op_with_string (STRUCTOP_STRUCT, $2); }
245 primary : primary '(' arglist ')'
247 write_exp_elt_opcode (OP_FUNCALL);
248 write_exp_elt_longcst ($3);
249 write_exp_elt_opcode (OP_FUNCALL);
251 | var_or_type '(' arglist ')'
256 error (_("Invalid conversion"));
257 write_exp_elt_opcode (UNOP_CAST);
258 write_exp_elt_type ($1);
259 write_exp_elt_opcode (UNOP_CAST);
263 write_exp_elt_opcode (OP_FUNCALL);
264 write_exp_elt_longcst ($3);
265 write_exp_elt_opcode (OP_FUNCALL);
270 primary : var_or_type '\'' save_qualifier { type_qualifier = $1; }
274 error (_("Type required for qualification"));
275 write_exp_elt_opcode (UNOP_QUAL);
276 write_exp_elt_type ($1);
277 write_exp_elt_opcode (UNOP_QUAL);
282 save_qualifier : { $$ = type_qualifier; }
286 primary '(' simple_exp DOTDOT simple_exp ')'
287 { write_exp_elt_opcode (TERNOP_SLICE); }
288 | var_or_type '(' simple_exp DOTDOT simple_exp ')'
290 write_exp_elt_opcode (TERNOP_SLICE);
292 error (_("Cannot slice a type"));
296 primary : '(' exp1 ')' { }
299 /* The following rule causes a conflict with the type conversion
301 To get around it, we give '(' higher priority and add bridge rules for
302 var_or_type (exp, exp, ...)
303 var_or_type (exp .. exp)
304 We also have the action for var_or_type(exp) generate a function call
305 when the first symbol does not denote a type. */
307 primary : var_or_type %prec VAR
310 write_exp_elt_opcode (OP_TYPE);
311 write_exp_elt_type ($1);
312 write_exp_elt_opcode (OP_TYPE);
317 primary : SPECIAL_VARIABLE /* Various GDB extensions */
318 { write_dollar_variable ($1); }
327 simple_exp : '-' simple_exp %prec UNARY
328 { write_exp_elt_opcode (UNOP_NEG); }
331 simple_exp : '+' simple_exp %prec UNARY
332 { write_exp_elt_opcode (UNOP_PLUS); }
335 simple_exp : NOT simple_exp %prec UNARY
336 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
339 simple_exp : ABS simple_exp %prec UNARY
340 { write_exp_elt_opcode (UNOP_ABS); }
343 arglist : { $$ = 0; }
352 | arglist ',' NAME ARROW exp
356 primary : '{' var_or_type '}' primary %prec '.'
360 error (_("Type required within braces in coercion"));
361 write_exp_elt_opcode (UNOP_MEMVAL);
362 write_exp_elt_type ($2);
363 write_exp_elt_opcode (UNOP_MEMVAL);
367 /* Binary operators in order of decreasing precedence. */
369 simple_exp : simple_exp STARSTAR simple_exp
370 { write_exp_elt_opcode (BINOP_EXP); }
373 simple_exp : simple_exp '*' simple_exp
374 { write_exp_elt_opcode (BINOP_MUL); }
377 simple_exp : simple_exp '/' simple_exp
378 { write_exp_elt_opcode (BINOP_DIV); }
381 simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
382 { write_exp_elt_opcode (BINOP_REM); }
385 simple_exp : simple_exp MOD simple_exp
386 { write_exp_elt_opcode (BINOP_MOD); }
389 simple_exp : simple_exp '@' simple_exp /* GDB extension */
390 { write_exp_elt_opcode (BINOP_REPEAT); }
393 simple_exp : simple_exp '+' simple_exp
394 { write_exp_elt_opcode (BINOP_ADD); }
397 simple_exp : simple_exp '&' simple_exp
398 { write_exp_elt_opcode (BINOP_CONCAT); }
401 simple_exp : simple_exp '-' simple_exp
402 { write_exp_elt_opcode (BINOP_SUB); }
405 relation : simple_exp
408 relation : simple_exp '=' simple_exp
409 { write_exp_elt_opcode (BINOP_EQUAL); }
412 relation : simple_exp NOTEQUAL simple_exp
413 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
416 relation : simple_exp LEQ simple_exp
417 { write_exp_elt_opcode (BINOP_LEQ); }
420 relation : simple_exp IN simple_exp DOTDOT simple_exp
421 { write_exp_elt_opcode (TERNOP_IN_RANGE); }
422 | simple_exp IN primary TICK_RANGE tick_arglist
423 { write_exp_elt_opcode (BINOP_IN_BOUNDS);
424 write_exp_elt_longcst ((LONGEST) $5);
425 write_exp_elt_opcode (BINOP_IN_BOUNDS);
427 | simple_exp IN var_or_type %prec TICK_ACCESS
430 error (_("Right operand of 'in' must be type"));
431 write_exp_elt_opcode (UNOP_IN_RANGE);
432 write_exp_elt_type ($3);
433 write_exp_elt_opcode (UNOP_IN_RANGE);
435 | simple_exp NOT IN simple_exp DOTDOT simple_exp
436 { write_exp_elt_opcode (TERNOP_IN_RANGE);
437 write_exp_elt_opcode (UNOP_LOGICAL_NOT);
439 | simple_exp NOT IN primary TICK_RANGE tick_arglist
440 { write_exp_elt_opcode (BINOP_IN_BOUNDS);
441 write_exp_elt_longcst ((LONGEST) $6);
442 write_exp_elt_opcode (BINOP_IN_BOUNDS);
443 write_exp_elt_opcode (UNOP_LOGICAL_NOT);
445 | simple_exp NOT IN var_or_type %prec TICK_ACCESS
448 error (_("Right operand of 'in' must be type"));
449 write_exp_elt_opcode (UNOP_IN_RANGE);
450 write_exp_elt_type ($4);
451 write_exp_elt_opcode (UNOP_IN_RANGE);
452 write_exp_elt_opcode (UNOP_LOGICAL_NOT);
456 relation : simple_exp GEQ simple_exp
457 { write_exp_elt_opcode (BINOP_GEQ); }
460 relation : simple_exp '<' simple_exp
461 { write_exp_elt_opcode (BINOP_LESS); }
464 relation : simple_exp '>' simple_exp
465 { write_exp_elt_opcode (BINOP_GTR); }
477 relation _AND_ relation
478 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
479 | and_exp _AND_ relation
480 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
484 relation _AND_ THEN relation
485 { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
486 | and_then_exp _AND_ THEN relation
487 { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
492 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
494 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
498 relation OR ELSE relation
499 { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
500 | or_else_exp OR ELSE relation
501 { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
504 xor_exp : relation XOR relation
505 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
506 | xor_exp XOR relation
507 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
510 /* Primaries can denote types (OP_TYPE). In cases such as
511 primary TICK_ADDRESS, where a type would be invalid, it will be
512 caught when evaluate_subexp in ada-lang.c tries to evaluate the
513 primary, expecting a value. Precedence rules resolve the ambiguity
514 in NAME TICK_ACCESS in favor of shifting to form a var_or_type. A
515 construct such as aType'access'access will again cause an error when
516 aType'access evaluates to a type that evaluate_subexp attempts to
518 primary : primary TICK_ACCESS
519 { write_exp_elt_opcode (UNOP_ADDR); }
520 | primary TICK_ADDRESS
521 { write_exp_elt_opcode (UNOP_ADDR);
522 write_exp_elt_opcode (UNOP_CAST);
523 write_exp_elt_type (type_system_address ());
524 write_exp_elt_opcode (UNOP_CAST);
526 | primary TICK_FIRST tick_arglist
527 { write_int ($3, type_int ());
528 write_exp_elt_opcode (OP_ATR_FIRST); }
529 | primary TICK_LAST tick_arglist
530 { write_int ($3, type_int ());
531 write_exp_elt_opcode (OP_ATR_LAST); }
532 | primary TICK_LENGTH tick_arglist
533 { write_int ($3, type_int ());
534 write_exp_elt_opcode (OP_ATR_LENGTH); }
536 { write_exp_elt_opcode (OP_ATR_SIZE); }
538 { write_exp_elt_opcode (OP_ATR_TAG); }
539 | opt_type_prefix TICK_MIN '(' exp ',' exp ')'
540 { write_exp_elt_opcode (OP_ATR_MIN); }
541 | opt_type_prefix TICK_MAX '(' exp ',' exp ')'
542 { write_exp_elt_opcode (OP_ATR_MAX); }
543 | opt_type_prefix TICK_POS '(' exp ')'
544 { write_exp_elt_opcode (OP_ATR_POS); }
545 | type_prefix TICK_VAL '(' exp ')'
546 { write_exp_elt_opcode (OP_ATR_VAL); }
547 | type_prefix TICK_MODULUS
548 { write_exp_elt_opcode (OP_ATR_MODULUS); }
551 tick_arglist : %prec '('
561 error (_("Prefix must be type"));
562 write_exp_elt_opcode (OP_TYPE);
563 write_exp_elt_type ($1);
564 write_exp_elt_opcode (OP_TYPE); }
570 { write_exp_elt_opcode (OP_TYPE);
571 write_exp_elt_type (builtin_type_void);
572 write_exp_elt_opcode (OP_TYPE); }
577 { write_int ((LONGEST) $1.val, $1.type); }
581 { write_int (convert_char_literal (type_qualifier, $1.val),
582 (type_qualifier == NULL)
583 ? $1.type : type_qualifier);
588 { write_exp_elt_opcode (OP_DOUBLE);
589 write_exp_elt_type ($1.type);
590 write_exp_elt_dblcst ($1.dval);
591 write_exp_elt_opcode (OP_DOUBLE);
596 { write_int (0, type_int ()); }
601 write_exp_op_with_string (OP_STRING, $1);
606 { error (_("NEW not implemented.")); }
609 var_or_type: NAME %prec VAR
610 { $$ = write_var_or_type (NULL, $1); }
611 | block NAME %prec VAR
612 { $$ = write_var_or_type ($1, $2); }
615 $$ = write_var_or_type (NULL, $1);
617 write_exp_elt_opcode (UNOP_ADDR);
619 $$ = lookup_pointer_type ($$);
621 | block NAME TICK_ACCESS
623 $$ = write_var_or_type ($1, $2);
625 write_exp_elt_opcode (UNOP_ADDR);
627 $$ = lookup_pointer_type ($$);
632 block : NAME COLONCOLON
633 { $$ = block_lookup (NULL, $1.ptr); }
634 | block NAME COLONCOLON
635 { $$ = block_lookup ($1, $2.ptr); }
639 '(' aggregate_component_list ')'
641 write_exp_elt_opcode (OP_AGGREGATE);
642 write_exp_elt_longcst ($2);
643 write_exp_elt_opcode (OP_AGGREGATE);
647 aggregate_component_list :
648 component_groups { $$ = $1; }
649 | positional_list exp
650 { write_exp_elt_opcode (OP_POSITIONAL);
651 write_exp_elt_longcst ($1);
652 write_exp_elt_opcode (OP_POSITIONAL);
655 | positional_list component_groups
661 { write_exp_elt_opcode (OP_POSITIONAL);
662 write_exp_elt_longcst (0);
663 write_exp_elt_opcode (OP_POSITIONAL);
666 | positional_list exp ','
667 { write_exp_elt_opcode (OP_POSITIONAL);
668 write_exp_elt_longcst ($1);
669 write_exp_elt_opcode (OP_POSITIONAL);
676 | component_group { $$ = 1; }
677 | component_group ',' component_groups
681 others : OTHERS ARROW exp
682 { write_exp_elt_opcode (OP_OTHERS); }
686 component_associations
688 write_exp_elt_opcode (OP_CHOICES);
689 write_exp_elt_longcst ($1);
690 write_exp_elt_opcode (OP_CHOICES);
694 /* We use this somewhat obscure definition in order to handle NAME => and
695 NAME | differently from exp => and exp |. ARROW and '|' have a precedence
696 above that of the reduction of NAME to var_or_type. By delaying
697 decisions until after the => or '|', we convert the ambiguity to a
698 resolved shift/reduce conflict. */
699 component_associations :
701 { write_name_assoc ($1); }
703 | simple_exp ARROW exp
705 | simple_exp DOTDOT simple_exp ARROW
706 { write_exp_elt_opcode (OP_DISCRETE_RANGE);
707 write_exp_op_with_string (OP_NAME, empty_stoken);
711 { write_name_assoc ($1); }
712 component_associations { $$ = $4 + 1; }
714 component_associations { $$ = $3 + 1; }
715 | simple_exp DOTDOT simple_exp '|'
716 { write_exp_elt_opcode (OP_DISCRETE_RANGE); }
717 component_associations { $$ = $6 + 1; }
720 /* Some extensions borrowed from C, for the benefit of those who find they
721 can't get used to Ada notation in GDB. */
723 primary : '*' primary %prec '.'
724 { write_exp_elt_opcode (UNOP_IND); }
725 | '&' primary %prec '.'
726 { write_exp_elt_opcode (UNOP_ADDR); }
727 | primary '[' exp ']'
728 { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
733 /* yylex defined in ada-lex.c: Reads one token, getting characters */
734 /* through lexptr. */
736 /* Remap normal flex interface names (yylex) as well as gratuitiously */
737 /* global symbol names, so we can have multiple flex-generated parsers */
740 /* (See note above on previous definitions for YACC.) */
742 #define yy_create_buffer ada_yy_create_buffer
743 #define yy_delete_buffer ada_yy_delete_buffer
744 #define yy_init_buffer ada_yy_init_buffer
745 #define yy_load_buffer_state ada_yy_load_buffer_state
746 #define yy_switch_to_buffer ada_yy_switch_to_buffer
747 #define yyrestart ada_yyrestart
748 #define yytext ada_yytext
749 #define yywrap ada_yywrap
751 static struct obstack temp_parse_space;
753 /* The following kludge was found necessary to prevent conflicts between */
754 /* defs.h and non-standard stdlib.h files. */
755 #define qsort __qsort__dummy
761 lexer_init (yyin); /* (Re-)initialize lexer. */
762 type_qualifier = NULL;
763 obstack_free (&temp_parse_space, NULL);
764 obstack_init (&temp_parse_space);
766 return _ada_parse ();
772 error (_("Error in expression, near `%s'."), lexptr);
775 /* The operator name corresponding to operator symbol STRING (adds
776 quotes and maps to lower-case). Destroys the previous contents of
777 the array pointed to by STRING.ptr. Error if STRING does not match
778 a valid Ada operator. Assumes that STRING.ptr points to a
779 null-terminated string and that, if STRING is a valid operator
780 symbol, the array pointed to by STRING.ptr contains at least
781 STRING.length+3 characters. */
784 string_to_operator (struct stoken string)
788 for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
790 if (string.length == strlen (ada_opname_table[i].decoded)-2
791 && strncasecmp (string.ptr, ada_opname_table[i].decoded+1,
794 strncpy (string.ptr, ada_opname_table[i].decoded,
800 error (_("Invalid operator symbol `%s'"), string.ptr);
803 /* Emit expression to access an instance of SYM, in block BLOCK (if
804 * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
806 write_var_from_sym (struct block *orig_left_context,
810 if (orig_left_context == NULL && symbol_read_needs_frame (sym))
812 if (innermost_block == 0
813 || contained_in (block, innermost_block))
814 innermost_block = block;
817 write_exp_elt_opcode (OP_VAR_VALUE);
818 write_exp_elt_block (block);
819 write_exp_elt_sym (sym);
820 write_exp_elt_opcode (OP_VAR_VALUE);
823 /* Write integer constant ARG of type TYPE. */
826 write_int (LONGEST arg, struct type *type)
828 write_exp_elt_opcode (OP_LONG);
829 write_exp_elt_type (type);
830 write_exp_elt_longcst (arg);
831 write_exp_elt_opcode (OP_LONG);
834 /* Write an OPCODE, string, OPCODE sequence to the current expression. */
836 write_exp_op_with_string (enum exp_opcode opcode, struct stoken token)
838 write_exp_elt_opcode (opcode);
839 write_exp_string (token);
840 write_exp_elt_opcode (opcode);
843 /* Emit expression corresponding to the renamed object named
844 * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
845 * context of ORIG_LEFT_CONTEXT, to which is applied the operations
846 * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of
847 * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it
848 * defaults to the currently selected block. ORIG_SYMBOL is the
849 * symbol that originally encoded the renaming. It is needed only
850 * because its prefix also qualifies any index variables used to index
851 * or slice an array. It should not be necessary once we go to the
852 * new encoding entirely (FIXME pnh 7/20/2007). */
855 write_object_renaming (struct block *orig_left_context,
856 const char *renamed_entity, int renamed_entity_len,
857 const char *renaming_expr, int max_depth)
860 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
865 error (_("Could not find renamed symbol"));
867 if (orig_left_context == NULL)
868 orig_left_context = get_selected_block (NULL);
870 name = obsavestring (renamed_entity, renamed_entity_len, &temp_parse_space);
871 sym = ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN,
874 error (_("Could not find renamed variable: %s"), ada_decode (name));
875 else if (SYMBOL_CLASS (sym) == LOC_TYPEDEF)
876 /* We have a renaming of an old-style renaming symbol. Don't
877 trust the block information. */
878 block = orig_left_context;
881 const char *inner_renamed_entity;
882 int inner_renamed_entity_len;
883 const char *inner_renaming_expr;
885 switch (ada_parse_renaming (sym, &inner_renamed_entity,
886 &inner_renamed_entity_len,
887 &inner_renaming_expr))
889 case ADA_NOT_RENAMING:
890 write_var_from_sym (orig_left_context, block, sym);
892 case ADA_OBJECT_RENAMING:
893 write_object_renaming (block,
894 inner_renamed_entity, inner_renamed_entity_len,
895 inner_renaming_expr, max_depth - 1);
902 slice_state = SIMPLE_INDEX;
903 while (*renaming_expr == 'X')
907 switch (*renaming_expr) {
910 write_exp_elt_opcode (UNOP_IND);
913 slice_state = LOWER_BOUND;
916 if (isdigit (*renaming_expr))
919 long val = strtol (renaming_expr, &next, 10);
920 if (next == renaming_expr)
922 renaming_expr = next;
923 write_exp_elt_opcode (OP_LONG);
924 write_exp_elt_type (type_int ());
925 write_exp_elt_longcst ((LONGEST) val);
926 write_exp_elt_opcode (OP_LONG);
932 struct symbol *index_sym;
934 end = strchr (renaming_expr, 'X');
936 end = renaming_expr + strlen (renaming_expr);
939 obsavestring (renaming_expr, end - renaming_expr,
943 index_sym = ada_lookup_encoded_symbol (index_name, NULL,
945 if (index_sym == NULL)
946 error (_("Could not find %s"), index_name);
947 else if (SYMBOL_CLASS (index_sym) == LOC_TYPEDEF)
948 /* Index is an old-style renaming symbol. */
949 block = orig_left_context;
950 write_var_from_sym (NULL, block, index_sym);
952 if (slice_state == SIMPLE_INDEX)
954 write_exp_elt_opcode (OP_FUNCALL);
955 write_exp_elt_longcst ((LONGEST) 1);
956 write_exp_elt_opcode (OP_FUNCALL);
958 else if (slice_state == LOWER_BOUND)
959 slice_state = UPPER_BOUND;
960 else if (slice_state == UPPER_BOUND)
962 write_exp_elt_opcode (TERNOP_SLICE);
963 slice_state = SIMPLE_INDEX;
969 struct stoken field_name;
973 if (slice_state != SIMPLE_INDEX)
975 end = strchr (renaming_expr, 'X');
977 end = renaming_expr + strlen (renaming_expr);
978 field_name.length = end - renaming_expr;
979 field_name.ptr = xmalloc (end - renaming_expr + 1);
980 strncpy (field_name.ptr, renaming_expr, end - renaming_expr);
981 field_name.ptr[end - renaming_expr] = '\000';
983 write_exp_op_with_string (STRUCTOP_STRUCT, field_name);
991 if (slice_state == SIMPLE_INDEX)
995 error (_("Internal error in encoding of renaming declaration"));
999 block_lookup (struct block *context, char *raw_name)
1002 struct ada_symbol_info *syms;
1004 struct symtab *symtab;
1006 if (raw_name[0] == '\'')
1012 name = ada_encode (raw_name);
1014 nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
1015 if (context == NULL &&
1016 (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK))
1017 symtab = lookup_symtab (name);
1022 return BLOCKVECTOR_BLOCK (BLOCKVECTOR (symtab), STATIC_BLOCK);
1023 else if (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK)
1025 if (context == NULL)
1026 error (_("No file or function \"%s\"."), raw_name);
1028 error (_("No function \"%s\" in specified context."), raw_name);
1033 warning (_("Function name \"%s\" ambiguous here"), raw_name);
1034 return SYMBOL_BLOCK_VALUE (syms[0].sym);
1038 static struct symbol*
1039 select_possible_type_sym (struct ada_symbol_info *syms, int nsyms)
1042 int preferred_index;
1043 struct type *preferred_type;
1045 preferred_index = -1; preferred_type = NULL;
1046 for (i = 0; i < nsyms; i += 1)
1047 switch (SYMBOL_CLASS (syms[i].sym))
1050 if (ada_prefer_type (SYMBOL_TYPE (syms[i].sym), preferred_type))
1052 preferred_index = i;
1053 preferred_type = SYMBOL_TYPE (syms[i].sym);
1060 case LOC_REGPARM_ADDR:
1063 case LOC_BASEREG_ARG:
1065 case LOC_COMPUTED_ARG:
1070 if (preferred_type == NULL)
1072 return syms[preferred_index].sym;
1076 find_primitive_type (char *name)
1079 type = language_lookup_primitive_type_by_name (current_language,
1082 if (type == NULL && strcmp ("system__address", name) == 0)
1083 type = type_system_address ();
1087 /* Check to see if we have a regular definition of this
1088 type that just didn't happen to have been read yet. */
1091 char *expanded_name =
1092 (char *) alloca (strlen (name) + sizeof ("standard__"));
1093 strcpy (expanded_name, "standard__");
1094 strcat (expanded_name, name);
1095 sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL);
1096 if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1097 type = SYMBOL_TYPE (sym);
1104 chop_selector (char *name, int end)
1107 for (i = end - 1; i > 0; i -= 1)
1108 if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1113 /* If NAME is a string beginning with a separator (either '__', or
1114 '.'), chop this separator and return the result; else, return
1118 chop_separator (char *name)
1123 if (name[0] == '_' && name[1] == '_')
1129 /* Given that SELS is a string of the form (<sep><identifier>)*, where
1130 <sep> is '__' or '.', write the indicated sequence of
1131 STRUCTOP_STRUCT expression operators. */
1133 write_selectors (char *sels)
1135 while (*sels != '\0')
1137 struct stoken field_name;
1138 char *p = chop_separator (sels);
1140 while (*sels != '\0' && *sels != '.'
1141 && (sels[0] != '_' || sels[1] != '_'))
1143 field_name.length = sels - p;
1145 write_exp_op_with_string (STRUCTOP_STRUCT, field_name);
1149 /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1150 NAME[0..LEN-1], in block context BLOCK, to be resolved later. Writes
1151 a temporary symbol that is valid until the next call to ada_parse.
1154 write_ambiguous_var (struct block *block, char *name, int len)
1156 struct symbol *sym =
1157 obstack_alloc (&temp_parse_space, sizeof (struct symbol));
1158 memset (sym, 0, sizeof (struct symbol));
1159 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1160 SYMBOL_LINKAGE_NAME (sym) = obsavestring (name, len, &temp_parse_space);
1161 SYMBOL_LANGUAGE (sym) = language_ada;
1163 write_exp_elt_opcode (OP_VAR_VALUE);
1164 write_exp_elt_block (block);
1165 write_exp_elt_sym (sym);
1166 write_exp_elt_opcode (OP_VAR_VALUE);
1169 /* A convenient wrapper around ada_get_field_index that takes
1170 a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1171 of a NUL-terminated field name. */
1174 ada_nget_field_index (const struct type *type, const char *field_name0,
1175 int field_name_len, int maybe_missing)
1177 char *field_name = alloca ((field_name_len + 1) * sizeof (char));
1179 strncpy (field_name, field_name0, field_name_len);
1180 field_name[field_name_len] = '\0';
1181 return ada_get_field_index (type, field_name, maybe_missing);
1184 /* If encoded_field_name is the name of a field inside symbol SYM,
1185 then return the type of that field. Otherwise, return NULL.
1187 This function is actually recursive, so if ENCODED_FIELD_NAME
1188 doesn't match one of the fields of our symbol, then try to see
1189 if ENCODED_FIELD_NAME could not be a succession of field names
1190 (in other words, the user entered an expression of the form
1191 TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1192 each field name sequentially to obtain the desired field type.
1193 In case of failure, we return NULL. */
1195 static struct type *
1196 get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1198 char *field_name = encoded_field_name;
1199 char *subfield_name;
1200 struct type *type = SYMBOL_TYPE (sym);
1203 if (type == NULL || field_name == NULL)
1206 while (field_name[0] != '\0')
1208 field_name = chop_separator (field_name);
1210 fieldno = ada_get_field_index (type, field_name, 1);
1212 return TYPE_FIELD_TYPE (type, fieldno);
1214 subfield_name = field_name;
1215 while (*subfield_name != '\0' && *subfield_name != '.'
1216 && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1219 if (subfield_name[0] == '\0')
1222 fieldno = ada_nget_field_index (type, field_name,
1223 subfield_name - field_name, 1);
1227 type = TYPE_FIELD_TYPE (type, fieldno);
1228 field_name = subfield_name;
1234 /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
1235 expression_block_context if NULL). If it denotes a type, return
1236 that type. Otherwise, write expression code to evaluate it as an
1237 object and return NULL. In this second case, NAME0 will, in general,
1238 have the form <name>(.<selector_name>)*, where <name> is an object
1239 or renaming encoded in the debugging data. Calls error if no
1240 prefix <name> matches a name in the debugging data (i.e., matches
1241 either a complete name or, as a wild-card match, the final
1245 write_var_or_type (struct block *block, struct stoken name0)
1252 block = expression_context_block;
1254 encoded_name = ada_encode (name0.ptr);
1255 name_len = strlen (encoded_name);
1256 encoded_name = obsavestring (encoded_name, name_len, &temp_parse_space);
1257 for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1261 tail_index = name_len;
1262 while (tail_index > 0)
1265 struct ada_symbol_info *syms;
1266 struct symbol *type_sym;
1267 struct symbol *renaming_sym;
1268 const char* renaming;
1270 const char* renaming_expr;
1271 int terminator = encoded_name[tail_index];
1273 encoded_name[tail_index] = '\0';
1274 nsyms = ada_lookup_symbol_list (encoded_name, block,
1276 encoded_name[tail_index] = terminator;
1278 /* A single symbol may rename a package or object. */
1280 /* This should go away when we move entirely to new version.
1281 FIXME pnh 7/20/2007. */
1284 struct symbol *renaming =
1285 ada_find_renaming_symbol (SYMBOL_LINKAGE_NAME (syms[0].sym),
1288 if (renaming != NULL)
1289 syms[0].sym = renaming;
1292 type_sym = select_possible_type_sym (syms, nsyms);
1294 if (type_sym != NULL)
1295 renaming_sym = type_sym;
1296 else if (nsyms == 1)
1297 renaming_sym = syms[0].sym;
1299 renaming_sym = NULL;
1301 switch (ada_parse_renaming (renaming_sym, &renaming,
1302 &renaming_len, &renaming_expr))
1304 case ADA_NOT_RENAMING:
1306 case ADA_PACKAGE_RENAMING:
1307 case ADA_EXCEPTION_RENAMING:
1308 case ADA_SUBPROGRAM_RENAMING:
1311 = obstack_alloc (&temp_parse_space,
1312 renaming_len + name_len - tail_index + 1);
1313 strncpy (new_name, renaming, renaming_len);
1314 strcpy (new_name + renaming_len, encoded_name + tail_index);
1315 encoded_name = new_name;
1316 name_len = renaming_len + name_len - tail_index;
1317 goto TryAfterRenaming;
1319 case ADA_OBJECT_RENAMING:
1320 write_object_renaming (block, renaming, renaming_len,
1321 renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1322 write_selectors (encoded_name + tail_index);
1325 internal_error (__FILE__, __LINE__,
1326 _("impossible value from ada_parse_renaming"));
1329 if (type_sym != NULL)
1331 struct type *field_type;
1333 if (tail_index == name_len)
1334 return SYMBOL_TYPE (type_sym);
1336 /* We have some extraneous characters after the type name.
1337 If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1338 then try to get the type of FIELDN. */
1340 = get_symbol_field_type (type_sym, encoded_name + tail_index);
1341 if (field_type != NULL)
1344 error (_("Invalid attempt to select from type: \"%s\"."),
1347 else if (tail_index == name_len && nsyms == 0)
1349 struct type *type = find_primitive_type (encoded_name);
1357 write_var_from_sym (block, syms[0].block, syms[0].sym);
1358 write_selectors (encoded_name + tail_index);
1361 else if (nsyms == 0)
1364 struct minimal_symbol *msym
1365 = ada_lookup_simple_minsym (encoded_name);
1368 write_exp_msymbol (msym, lookup_function_type (type_int ()),
1370 /* Maybe cause error here rather than later? FIXME? */
1371 write_selectors (encoded_name + tail_index);
1375 if (tail_index == name_len
1376 && strncmp (encoded_name, "standard__",
1377 sizeof ("standard__") - 1) == 0)
1378 error (_("No definition of \"%s\" found."), name0.ptr);
1380 tail_index = chop_selector (encoded_name, tail_index);
1384 write_ambiguous_var (block, encoded_name, tail_index);
1385 write_selectors (encoded_name + tail_index);
1390 if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1391 error (_("No symbol table is loaded. Use the \"file\" command."));
1392 if (block == expression_context_block)
1393 error (_("No definition of \"%s\" in current context."), name0.ptr);
1395 error (_("No definition of \"%s\" in specified context."), name0.ptr);
1400 error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1404 /* Write a left side of a component association (e.g., NAME in NAME =>
1405 exp). If NAME has the form of a selected component, write it as an
1406 ordinary expression. If it is a simple variable that unambiguously
1407 corresponds to exactly one symbol that does not denote a type or an
1408 object renaming, also write it normally as an OP_VAR_VALUE.
1409 Otherwise, write it as an OP_NAME.
1411 Unfortunately, we don't know at this point whether NAME is supposed
1412 to denote a record component name or the value of an array index.
1413 Therefore, it is not appropriate to disambiguate an ambiguous name
1414 as we normally would, nor to replace a renaming with its referent.
1415 As a result, in the (one hopes) rare case that one writes an
1416 aggregate such as (R => 42) where R renames an object or is an
1417 ambiguous name, one must write instead ((R) => 42). */
1420 write_name_assoc (struct stoken name)
1422 if (strchr (name.ptr, '.') == NULL)
1424 struct ada_symbol_info *syms;
1425 int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
1427 if (nsyms != 1 || SYMBOL_CLASS (syms[0].sym) == LOC_TYPEDEF)
1428 write_exp_op_with_string (OP_NAME, name);
1430 write_var_from_sym (NULL, syms[0].block, syms[0].sym);
1433 if (write_var_or_type (NULL, name) != NULL)
1434 error (_("Invalid use of type."));
1437 /* Convert the character literal whose ASCII value would be VAL to the
1438 appropriate value of type TYPE, if there is a translation.
1439 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
1440 the literal 'A' (VAL == 65), returns 0. */
1443 convert_char_literal (struct type *type, LONGEST val)
1448 if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM)
1450 sprintf (name, "QU%02x", (int) val);
1451 for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1453 if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
1454 return TYPE_FIELD_BITPOS (type, f);
1459 static struct type *
1462 return builtin_type (current_gdbarch)->builtin_int;
1465 static struct type *
1468 return builtin_type (current_gdbarch)->builtin_long;
1471 static struct type *
1472 type_long_long (void)
1474 return builtin_type (current_gdbarch)->builtin_long_long;
1477 static struct type *
1480 return builtin_type (current_gdbarch)->builtin_float;
1483 static struct type *
1486 return builtin_type (current_gdbarch)->builtin_double;
1489 static struct type *
1490 type_long_double (void)
1492 return builtin_type (current_gdbarch)->builtin_long_double;
1495 static struct type *
1498 return language_string_char_type (current_language, current_gdbarch);
1501 static struct type *
1502 type_system_address (void)
1505 = language_lookup_primitive_type_by_name (current_language,
1508 return type != NULL ? type : lookup_pointer_type (builtin_type_void);
1512 _initialize_ada_exp (void)
1514 obstack_init (&temp_parse_space);
1517 /* FIXME: hilfingr/2004-10-05: Hack to remove warning. The function
1518 string_to_operator is supposed to be used for cases where one
1519 calls an operator function with prefix notation, as in
1520 "+" (a, b), but at some point, this code seems to have gone
1523 struct stoken (*dummy_string_to_ada_operator) (struct stoken)
1524 = string_to_operator;