Upgrade GDB from 7.4.1 to 7.6.1 on the vendor branch
[dragonfly.git] / contrib / gdb-7 / gdb / ada-exp.y
1 /* YACC parser for Ada expressions, for GDB.
2    Copyright (C) 1986-2013 Free Software Foundation, Inc.
3
4    This file is part of GDB.
5
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.
10
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.
15
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/>.  */
18
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.
27
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.  */
35
36 %{
37
38 #include "defs.h"
39 #include "gdb_string.h"
40 #include <ctype.h>
41 #include "expression.h"
42 #include "value.h"
43 #include "parser-defs.h"
44 #include "language.h"
45 #include "ada-lang.h"
46 #include "bfd.h" /* Required by objfiles.h.  */
47 #include "symfile.h" /* Required by objfiles.h.  */
48 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
49 #include "frame.h"
50 #include "block.h"
51
52 #define parse_type builtin_type (parse_gdbarch)
53
54 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
55    as well as gratuitiously global symbol names, so we can have multiple
56    yacc generated parsers in gdb.  These are only the variables
57    produced by yacc.  If other parser generators (bison, byacc, etc) produce
58    additional global names that conflict at link time, then those parser
59    generators need to be fixed instead of adding those names to this list.  */
60
61 /* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix
62    options.  I presume we are maintaining it to accommodate systems
63    without BISON?  (PNH) */
64
65 #define yymaxdepth ada_maxdepth
66 #define yyparse _ada_parse      /* ada_parse calls this after  initialization */
67 #define yylex   ada_lex
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
73 #define yyr1    ada_r1
74 #define yyr2    ada_r2
75 #define yydef   ada_def
76 #define yychk   ada_chk
77 #define yypgo   ada_pgo
78 #define yyact   ada_act
79 #define yyexca  ada_exca
80 #define yyerrflag ada_errflag
81 #define yynerrs ada_nerrs
82 #define yyps    ada_ps
83 #define yypv    ada_pv
84 #define yys     ada_s
85 #define yy_yys  ada_yys
86 #define yystate ada_state
87 #define yytmp   ada_tmp
88 #define yyv     ada_v
89 #define yy_yyv  ada_yyv
90 #define yyval   ada_val
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 yyss    ada_yyss
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
102
103 #ifndef YYDEBUG
104 #define YYDEBUG 1               /* Default to yydebug support */
105 #endif
106
107 #define YYFPRINTF parser_fprintf
108
109 struct name_info {
110   struct symbol *sym;
111   struct minimal_symbol *msym;
112   struct block *block;
113   struct stoken stoken;
114 };
115
116 static struct stoken empty_stoken = { "", 0 };
117
118 /* If expression is in the context of TYPE'(...), then TYPE, else
119  * NULL.  */
120 static struct type *type_qualifier;
121
122 int yyparse (void);
123
124 static int yylex (void);
125
126 void yyerror (char *);
127
128 static struct stoken string_to_operator (struct stoken);
129
130 static void write_int (LONGEST, struct type *);
131
132 static void write_object_renaming (const struct block *, const char *, int,
133                                    const char *, int);
134
135 static struct type* write_var_or_type (const struct block *, struct stoken);
136
137 static void write_name_assoc (struct stoken);
138
139 static void write_exp_op_with_string (enum exp_opcode, struct stoken);
140
141 static struct block *block_lookup (struct block *, char *);
142
143 static LONGEST convert_char_literal (struct type *, LONGEST);
144
145 static void write_ambiguous_var (const struct block *, char *, int);
146
147 static struct type *type_int (void);
148
149 static struct type *type_long (void);
150
151 static struct type *type_long_long (void);
152
153 static struct type *type_float (void);
154
155 static struct type *type_double (void);
156
157 static struct type *type_long_double (void);
158
159 static struct type *type_char (void);
160
161 static struct type *type_boolean (void);
162
163 static struct type *type_system_address (void);
164
165 %}
166
167 %union
168   {
169     LONGEST lval;
170     struct {
171       LONGEST val;
172       struct type *type;
173     } typed_val;
174     struct {
175       DOUBLEST dval;
176       struct type *type;
177     } typed_val_float;
178     struct type *tval;
179     struct stoken sval;
180     struct block *bval;
181     struct internalvar *ivar;
182   }
183
184 %type <lval> positional_list component_groups component_associations
185 %type <lval> aggregate_component_list 
186 %type <tval> var_or_type
187
188 %token <typed_val> INT NULL_PTR CHARLIT
189 %token <typed_val_float> FLOAT
190 %token TRUEKEYWORD FALSEKEYWORD
191 %token COLONCOLON
192 %token <sval> STRING NAME DOT_ID 
193 %type <bval> block
194 %type <lval> arglist tick_arglist
195
196 %type <tval> save_qualifier
197
198 %token DOT_ALL
199
200 /* Special type cases, put in to allow the parser to distinguish different
201    legal basetypes.  */
202 %token <sval> SPECIAL_VARIABLE
203
204 %nonassoc ASSIGN
205 %left _AND_ OR XOR THEN ELSE
206 %left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
207 %left '@'
208 %left '+' '-' '&'
209 %left UNARY
210 %left '*' '/' MOD REM
211 %right STARSTAR ABS NOT
212
213 /* Artificial token to give NAME => ... and NAME | priority over reducing 
214    NAME to <primary> and to give <primary>' priority over reducing <primary>
215    to <simple_exp>. */
216 %nonassoc VAR
217
218 %nonassoc ARROW '|'
219
220 %right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
221 %right TICK_MAX TICK_MIN TICK_MODULUS
222 %right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
223  /* The following are right-associative only so that reductions at this
224     precedence have lower precedence than '.' and '('.  The syntax still
225     forces a.b.c, e.g., to be LEFT-associated.  */
226 %right '.' '(' '[' DOT_ID DOT_ALL
227
228 %token NEW OTHERS
229
230 \f
231 %%
232
233 start   :       exp1
234         ;
235
236 /* Expressions, including the sequencing operator.  */
237 exp1    :       exp
238         |       exp1 ';' exp
239                         { write_exp_elt_opcode (BINOP_COMMA); }
240         |       primary ASSIGN exp   /* Extension for convenience */
241                         { write_exp_elt_opcode (BINOP_ASSIGN); }
242         ;
243
244 /* Expressions, not including the sequencing operator.  */
245 primary :       primary DOT_ALL
246                         { write_exp_elt_opcode (UNOP_IND); }
247         ;
248
249 primary :       primary DOT_ID
250                         { write_exp_op_with_string (STRUCTOP_STRUCT, $2); }
251         ;
252
253 primary :       primary '(' arglist ')'
254                         {
255                           write_exp_elt_opcode (OP_FUNCALL);
256                           write_exp_elt_longcst ($3);
257                           write_exp_elt_opcode (OP_FUNCALL);
258                         }
259         |       var_or_type '(' arglist ')'
260                         {
261                           if ($1 != NULL)
262                             {
263                               if ($3 != 1)
264                                 error (_("Invalid conversion"));
265                               write_exp_elt_opcode (UNOP_CAST);
266                               write_exp_elt_type ($1);
267                               write_exp_elt_opcode (UNOP_CAST);
268                             }
269                           else
270                             {
271                               write_exp_elt_opcode (OP_FUNCALL);
272                               write_exp_elt_longcst ($3);
273                               write_exp_elt_opcode (OP_FUNCALL);
274                             }
275                         }
276         ;
277
278 primary :       var_or_type '\'' save_qualifier { type_qualifier = $1; } 
279                    '(' exp ')'
280                         {
281                           if ($1 == NULL)
282                             error (_("Type required for qualification"));
283                           write_exp_elt_opcode (UNOP_QUAL);
284                           write_exp_elt_type ($1);
285                           write_exp_elt_opcode (UNOP_QUAL);
286                           type_qualifier = $3;
287                         }
288         ;
289
290 save_qualifier :        { $$ = type_qualifier; }
291         ;
292
293 primary :
294                 primary '(' simple_exp DOTDOT simple_exp ')'
295                         { write_exp_elt_opcode (TERNOP_SLICE); }
296         |       var_or_type '(' simple_exp DOTDOT simple_exp ')'
297                         { if ($1 == NULL) 
298                             write_exp_elt_opcode (TERNOP_SLICE);
299                           else
300                             error (_("Cannot slice a type"));
301                         }
302         ;
303
304 primary :       '(' exp1 ')'    { }
305         ;
306
307 /* The following rule causes a conflict with the type conversion
308        var_or_type (exp)
309    To get around it, we give '(' higher priority and add bridge rules for 
310        var_or_type (exp, exp, ...)
311        var_or_type (exp .. exp)
312    We also have the action for  var_or_type(exp) generate a function call
313    when the first symbol does not denote a type. */
314
315 primary :       var_or_type     %prec VAR
316                         { if ($1 != NULL)
317                             {
318                               write_exp_elt_opcode (OP_TYPE);
319                               write_exp_elt_type ($1);
320                               write_exp_elt_opcode (OP_TYPE);
321                             }
322                         }
323         ;
324
325 primary :       SPECIAL_VARIABLE /* Various GDB extensions */
326                         { write_dollar_variable ($1); }
327         ;
328
329 primary :       aggregate
330         ;        
331
332 simple_exp :    primary
333         ;
334
335 simple_exp :    '-' simple_exp    %prec UNARY
336                         { write_exp_elt_opcode (UNOP_NEG); }
337         ;
338
339 simple_exp :    '+' simple_exp    %prec UNARY
340                         { write_exp_elt_opcode (UNOP_PLUS); }
341         ;
342
343 simple_exp :    NOT simple_exp    %prec UNARY
344                         { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
345         ;
346
347 simple_exp :    ABS simple_exp     %prec UNARY
348                         { write_exp_elt_opcode (UNOP_ABS); }
349         ;
350
351 arglist :               { $$ = 0; }
352         ;
353
354 arglist :       exp
355                         { $$ = 1; }
356         |       NAME ARROW exp
357                         { $$ = 1; }
358         |       arglist ',' exp
359                         { $$ = $1 + 1; }
360         |       arglist ',' NAME ARROW exp
361                         { $$ = $1 + 1; }
362         ;
363
364 primary :       '{' var_or_type '}' primary  %prec '.'
365                 /* GDB extension */
366                         { 
367                           if ($2 == NULL)
368                             error (_("Type required within braces in coercion"));
369                           write_exp_elt_opcode (UNOP_MEMVAL);
370                           write_exp_elt_type ($2);
371                           write_exp_elt_opcode (UNOP_MEMVAL);
372                         }
373         ;
374
375 /* Binary operators in order of decreasing precedence.  */
376
377 simple_exp      :       simple_exp STARSTAR simple_exp
378                         { write_exp_elt_opcode (BINOP_EXP); }
379         ;
380
381 simple_exp      :       simple_exp '*' simple_exp
382                         { write_exp_elt_opcode (BINOP_MUL); }
383         ;
384
385 simple_exp      :       simple_exp '/' simple_exp
386                         { write_exp_elt_opcode (BINOP_DIV); }
387         ;
388
389 simple_exp      :       simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
390                         { write_exp_elt_opcode (BINOP_REM); }
391         ;
392
393 simple_exp      :       simple_exp MOD simple_exp
394                         { write_exp_elt_opcode (BINOP_MOD); }
395         ;
396
397 simple_exp      :       simple_exp '@' simple_exp       /* GDB extension */
398                         { write_exp_elt_opcode (BINOP_REPEAT); }
399         ;
400
401 simple_exp      :       simple_exp '+' simple_exp
402                         { write_exp_elt_opcode (BINOP_ADD); }
403         ;
404
405 simple_exp      :       simple_exp '&' simple_exp
406                         { write_exp_elt_opcode (BINOP_CONCAT); }
407         ;
408
409 simple_exp      :       simple_exp '-' simple_exp
410                         { write_exp_elt_opcode (BINOP_SUB); }
411         ;
412
413 relation :      simple_exp
414         ;
415
416 relation :      simple_exp '=' simple_exp
417                         { write_exp_elt_opcode (BINOP_EQUAL); }
418         ;
419
420 relation :      simple_exp NOTEQUAL simple_exp
421                         { write_exp_elt_opcode (BINOP_NOTEQUAL); }
422         ;
423
424 relation :      simple_exp LEQ simple_exp
425                         { write_exp_elt_opcode (BINOP_LEQ); }
426         ;
427
428 relation :      simple_exp IN simple_exp DOTDOT simple_exp
429                         { write_exp_elt_opcode (TERNOP_IN_RANGE); }
430         |       simple_exp IN primary TICK_RANGE tick_arglist
431                         { write_exp_elt_opcode (BINOP_IN_BOUNDS);
432                           write_exp_elt_longcst ((LONGEST) $5);
433                           write_exp_elt_opcode (BINOP_IN_BOUNDS);
434                         }
435         |       simple_exp IN var_or_type       %prec TICK_ACCESS
436                         { 
437                           if ($3 == NULL)
438                             error (_("Right operand of 'in' must be type"));
439                           write_exp_elt_opcode (UNOP_IN_RANGE);
440                           write_exp_elt_type ($3);
441                           write_exp_elt_opcode (UNOP_IN_RANGE);
442                         }
443         |       simple_exp NOT IN simple_exp DOTDOT simple_exp
444                         { write_exp_elt_opcode (TERNOP_IN_RANGE);
445                           write_exp_elt_opcode (UNOP_LOGICAL_NOT);
446                         }
447         |       simple_exp NOT IN primary TICK_RANGE tick_arglist
448                         { write_exp_elt_opcode (BINOP_IN_BOUNDS);
449                           write_exp_elt_longcst ((LONGEST) $6);
450                           write_exp_elt_opcode (BINOP_IN_BOUNDS);
451                           write_exp_elt_opcode (UNOP_LOGICAL_NOT);
452                         }
453         |       simple_exp NOT IN var_or_type   %prec TICK_ACCESS
454                         { 
455                           if ($4 == NULL)
456                             error (_("Right operand of 'in' must be type"));
457                           write_exp_elt_opcode (UNOP_IN_RANGE);
458                           write_exp_elt_type ($4);
459                           write_exp_elt_opcode (UNOP_IN_RANGE);
460                           write_exp_elt_opcode (UNOP_LOGICAL_NOT);
461                         }
462         ;
463
464 relation :      simple_exp GEQ simple_exp
465                         { write_exp_elt_opcode (BINOP_GEQ); }
466         ;
467
468 relation :      simple_exp '<' simple_exp
469                         { write_exp_elt_opcode (BINOP_LESS); }
470         ;
471
472 relation :      simple_exp '>' simple_exp
473                         { write_exp_elt_opcode (BINOP_GTR); }
474         ;
475
476 exp     :       relation
477         |       and_exp
478         |       and_then_exp
479         |       or_exp
480         |       or_else_exp
481         |       xor_exp
482         ;
483
484 and_exp :
485                 relation _AND_ relation 
486                         { write_exp_elt_opcode (BINOP_BITWISE_AND); }
487         |       and_exp _AND_ relation
488                         { write_exp_elt_opcode (BINOP_BITWISE_AND); }
489         ;
490
491 and_then_exp :
492                relation _AND_ THEN relation
493                         { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
494         |       and_then_exp _AND_ THEN relation
495                         { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
496         ;
497
498 or_exp :
499                 relation OR relation 
500                         { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
501         |       or_exp OR relation
502                         { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
503         ;
504
505 or_else_exp :
506                relation OR ELSE relation
507                         { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
508         |      or_else_exp OR ELSE relation
509                         { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
510         ;
511
512 xor_exp :       relation XOR relation
513                         { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
514         |       xor_exp XOR relation
515                         { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
516         ;
517
518 /* Primaries can denote types (OP_TYPE).  In cases such as 
519    primary TICK_ADDRESS, where a type would be invalid, it will be
520    caught when evaluate_subexp in ada-lang.c tries to evaluate the
521    primary, expecting a value.  Precedence rules resolve the ambiguity
522    in NAME TICK_ACCESS in favor of shifting to form a var_or_type.  A
523    construct such as aType'access'access will again cause an error when
524    aType'access evaluates to a type that evaluate_subexp attempts to 
525    evaluate. */
526 primary :       primary TICK_ACCESS
527                         { write_exp_elt_opcode (UNOP_ADDR); }
528         |       primary TICK_ADDRESS
529                         { write_exp_elt_opcode (UNOP_ADDR);
530                           write_exp_elt_opcode (UNOP_CAST);
531                           write_exp_elt_type (type_system_address ());
532                           write_exp_elt_opcode (UNOP_CAST);
533                         }
534         |       primary TICK_FIRST tick_arglist
535                         { write_int ($3, type_int ());
536                           write_exp_elt_opcode (OP_ATR_FIRST); }
537         |       primary TICK_LAST tick_arglist
538                         { write_int ($3, type_int ());
539                           write_exp_elt_opcode (OP_ATR_LAST); }
540         |       primary TICK_LENGTH tick_arglist
541                         { write_int ($3, type_int ());
542                           write_exp_elt_opcode (OP_ATR_LENGTH); }
543         |       primary TICK_SIZE
544                         { write_exp_elt_opcode (OP_ATR_SIZE); }
545         |       primary TICK_TAG
546                         { write_exp_elt_opcode (OP_ATR_TAG); }
547         |       opt_type_prefix TICK_MIN '(' exp ',' exp ')'
548                         { write_exp_elt_opcode (OP_ATR_MIN); }
549         |       opt_type_prefix TICK_MAX '(' exp ',' exp ')'
550                         { write_exp_elt_opcode (OP_ATR_MAX); }
551         |       opt_type_prefix TICK_POS '(' exp ')'
552                         { write_exp_elt_opcode (OP_ATR_POS); }
553         |       type_prefix TICK_VAL '(' exp ')'
554                         { write_exp_elt_opcode (OP_ATR_VAL); }
555         |       type_prefix TICK_MODULUS
556                         { write_exp_elt_opcode (OP_ATR_MODULUS); }
557         ;
558
559 tick_arglist :                  %prec '('
560                         { $$ = 1; }
561         |       '(' INT ')'
562                         { $$ = $2.val; }
563         ;
564
565 type_prefix :
566                 var_or_type
567                         { 
568                           if ($1 == NULL)
569                             error (_("Prefix must be type"));
570                           write_exp_elt_opcode (OP_TYPE);
571                           write_exp_elt_type ($1);
572                           write_exp_elt_opcode (OP_TYPE); }
573         ;
574
575 opt_type_prefix :
576                 type_prefix
577         |       /* EMPTY */
578                         { write_exp_elt_opcode (OP_TYPE);
579                           write_exp_elt_type (parse_type->builtin_void);
580                           write_exp_elt_opcode (OP_TYPE); }
581         ;
582
583
584 primary :       INT
585                         { write_int ((LONGEST) $1.val, $1.type); }
586         ;
587
588 primary :       CHARLIT
589                   { write_int (convert_char_literal (type_qualifier, $1.val),
590                                (type_qualifier == NULL) 
591                                ? $1.type : type_qualifier);
592                   }
593         ;
594
595 primary :       FLOAT
596                         { write_exp_elt_opcode (OP_DOUBLE);
597                           write_exp_elt_type ($1.type);
598                           write_exp_elt_dblcst ($1.dval);
599                           write_exp_elt_opcode (OP_DOUBLE);
600                         }
601         ;
602
603 primary :       NULL_PTR
604                         { write_int (0, type_int ()); }
605         ;
606
607 primary :       STRING
608                         { 
609                           write_exp_op_with_string (OP_STRING, $1);
610                         }
611         ;
612
613 primary :       TRUEKEYWORD
614                         { write_int (1, type_boolean ()); }
615         |       FALSEKEYWORD
616                         { write_int (0, type_boolean ()); }
617         ;
618
619 primary :       NEW NAME
620                         { error (_("NEW not implemented.")); }
621         ;
622
623 var_or_type:    NAME        %prec VAR
624                                 { $$ = write_var_or_type (NULL, $1); } 
625         |       block NAME  %prec VAR
626                                 { $$ = write_var_or_type ($1, $2); }
627         |       NAME TICK_ACCESS 
628                         { 
629                           $$ = write_var_or_type (NULL, $1);
630                           if ($$ == NULL)
631                             write_exp_elt_opcode (UNOP_ADDR);
632                           else
633                             $$ = lookup_pointer_type ($$);
634                         }
635         |       block NAME TICK_ACCESS
636                         { 
637                           $$ = write_var_or_type ($1, $2);
638                           if ($$ == NULL)
639                             write_exp_elt_opcode (UNOP_ADDR);
640                           else
641                             $$ = lookup_pointer_type ($$);
642                         }
643         ;
644
645 /* GDB extension */
646 block   :       NAME COLONCOLON
647                         { $$ = block_lookup (NULL, $1.ptr); }
648         |       block NAME COLONCOLON
649                         { $$ = block_lookup ($1, $2.ptr); }
650         ;
651
652 aggregate :
653                 '(' aggregate_component_list ')'  
654                         {
655                           write_exp_elt_opcode (OP_AGGREGATE);
656                           write_exp_elt_longcst ($2);
657                           write_exp_elt_opcode (OP_AGGREGATE);
658                         }
659         ;
660
661 aggregate_component_list :
662                 component_groups         { $$ = $1; }
663         |       positional_list exp
664                         { write_exp_elt_opcode (OP_POSITIONAL);
665                           write_exp_elt_longcst ($1);
666                           write_exp_elt_opcode (OP_POSITIONAL);
667                           $$ = $1 + 1;
668                         }
669         |       positional_list component_groups
670                                          { $$ = $1 + $2; }
671         ;
672
673 positional_list :
674                 exp ','
675                         { write_exp_elt_opcode (OP_POSITIONAL);
676                           write_exp_elt_longcst (0);
677                           write_exp_elt_opcode (OP_POSITIONAL);
678                           $$ = 1;
679                         } 
680         |       positional_list exp ','
681                         { write_exp_elt_opcode (OP_POSITIONAL);
682                           write_exp_elt_longcst ($1);
683                           write_exp_elt_opcode (OP_POSITIONAL);
684                           $$ = $1 + 1; 
685                         }
686         ;
687
688 component_groups:
689                 others                   { $$ = 1; }
690         |       component_group          { $$ = 1; }
691         |       component_group ',' component_groups
692                                          { $$ = $3 + 1; }
693         ;
694
695 others  :       OTHERS ARROW exp
696                         { write_exp_elt_opcode (OP_OTHERS); }
697         ;
698
699 component_group :
700                 component_associations
701                         {
702                           write_exp_elt_opcode (OP_CHOICES);
703                           write_exp_elt_longcst ($1);
704                           write_exp_elt_opcode (OP_CHOICES);
705                         }
706         ;
707
708 /* We use this somewhat obscure definition in order to handle NAME => and
709    NAME | differently from exp => and exp |.  ARROW and '|' have a precedence
710    above that of the reduction of NAME to var_or_type.  By delaying 
711    decisions until after the => or '|', we convert the ambiguity to a 
712    resolved shift/reduce conflict. */
713 component_associations :
714                 NAME ARROW 
715                         { write_name_assoc ($1); }
716                     exp { $$ = 1; }
717         |       simple_exp ARROW exp
718                         { $$ = 1; }
719         |       simple_exp DOTDOT simple_exp ARROW 
720                         { write_exp_elt_opcode (OP_DISCRETE_RANGE);
721                           write_exp_op_with_string (OP_NAME, empty_stoken);
722                         }
723                     exp { $$ = 1; }
724         |       NAME '|' 
725                         { write_name_assoc ($1); }
726                     component_associations  { $$ = $4 + 1; }
727         |       simple_exp '|'  
728                     component_associations  { $$ = $3 + 1; }
729         |       simple_exp DOTDOT simple_exp '|'
730                         { write_exp_elt_opcode (OP_DISCRETE_RANGE); }
731                     component_associations  { $$ = $6 + 1; }
732         ;
733
734 /* Some extensions borrowed from C, for the benefit of those who find they
735    can't get used to Ada notation in GDB.  */
736
737 primary :       '*' primary             %prec '.'
738                         { write_exp_elt_opcode (UNOP_IND); }
739         |       '&' primary             %prec '.'
740                         { write_exp_elt_opcode (UNOP_ADDR); }
741         |       primary '[' exp ']'
742                         { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
743         ;
744
745 %%
746
747 /* yylex defined in ada-lex.c: Reads one token, getting characters */
748 /* through lexptr.  */
749
750 /* Remap normal flex interface names (yylex) as well as gratuitiously */
751 /* global symbol names, so we can have multiple flex-generated parsers */
752 /* in gdb.  */
753
754 /* (See note above on previous definitions for YACC.) */
755
756 #define yy_create_buffer ada_yy_create_buffer
757 #define yy_delete_buffer ada_yy_delete_buffer
758 #define yy_init_buffer ada_yy_init_buffer
759 #define yy_load_buffer_state ada_yy_load_buffer_state
760 #define yy_switch_to_buffer ada_yy_switch_to_buffer
761 #define yyrestart ada_yyrestart
762 #define yytext ada_yytext
763 #define yywrap ada_yywrap
764
765 static struct obstack temp_parse_space;
766
767 /* The following kludge was found necessary to prevent conflicts between */
768 /* defs.h and non-standard stdlib.h files.  */
769 #define qsort __qsort__dummy
770 #include "ada-lex.c"
771
772 int
773 ada_parse (void)
774 {
775   lexer_init (yyin);            /* (Re-)initialize lexer.  */
776   type_qualifier = NULL;
777   obstack_free (&temp_parse_space, NULL);
778   obstack_init (&temp_parse_space);
779
780   return _ada_parse ();
781 }
782
783 void
784 yyerror (char *msg)
785 {
786   error (_("Error in expression, near `%s'."), lexptr);
787 }
788
789 /* The operator name corresponding to operator symbol STRING (adds
790    quotes and maps to lower-case).  Destroys the previous contents of
791    the array pointed to by STRING.ptr.  Error if STRING does not match
792    a valid Ada operator.  Assumes that STRING.ptr points to a
793    null-terminated string and that, if STRING is a valid operator
794    symbol, the array pointed to by STRING.ptr contains at least
795    STRING.length+3 characters.  */
796
797 static struct stoken
798 string_to_operator (struct stoken string)
799 {
800   int i;
801
802   for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
803     {
804       if (string.length == strlen (ada_opname_table[i].decoded)-2
805           && strncasecmp (string.ptr, ada_opname_table[i].decoded+1,
806                           string.length) == 0)
807         {
808           strncpy (string.ptr, ada_opname_table[i].decoded,
809                    string.length+2);
810           string.length += 2;
811           return string;
812         }
813     }
814   error (_("Invalid operator symbol `%s'"), string.ptr);
815 }
816
817 /* Emit expression to access an instance of SYM, in block BLOCK (if
818  * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT.  */
819 static void
820 write_var_from_sym (const struct block *orig_left_context,
821                     const struct block *block,
822                     struct symbol *sym)
823 {
824   if (orig_left_context == NULL && symbol_read_needs_frame (sym))
825     {
826       if (innermost_block == 0
827           || contained_in (block, innermost_block))
828         innermost_block = block;
829     }
830
831   write_exp_elt_opcode (OP_VAR_VALUE);
832   write_exp_elt_block (block);
833   write_exp_elt_sym (sym);
834   write_exp_elt_opcode (OP_VAR_VALUE);
835 }
836
837 /* Write integer or boolean constant ARG of type TYPE.  */
838
839 static void
840 write_int (LONGEST arg, struct type *type)
841 {
842   write_exp_elt_opcode (OP_LONG);
843   write_exp_elt_type (type);
844   write_exp_elt_longcst (arg);
845   write_exp_elt_opcode (OP_LONG);
846 }
847
848 /* Write an OPCODE, string, OPCODE sequence to the current expression.  */
849 static void
850 write_exp_op_with_string (enum exp_opcode opcode, struct stoken token)
851 {
852   write_exp_elt_opcode (opcode);
853   write_exp_string (token);
854   write_exp_elt_opcode (opcode);
855 }
856   
857 /* Emit expression corresponding to the renamed object named 
858  * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
859  * context of ORIG_LEFT_CONTEXT, to which is applied the operations
860  * encoded by RENAMING_EXPR.  MAX_DEPTH is the maximum number of
861  * cascaded renamings to allow.  If ORIG_LEFT_CONTEXT is null, it
862  * defaults to the currently selected block. ORIG_SYMBOL is the 
863  * symbol that originally encoded the renaming.  It is needed only
864  * because its prefix also qualifies any index variables used to index
865  * or slice an array.  It should not be necessary once we go to the
866  * new encoding entirely (FIXME pnh 7/20/2007).  */
867
868 static void
869 write_object_renaming (const struct block *orig_left_context,
870                        const char *renamed_entity, int renamed_entity_len,
871                        const char *renaming_expr, int max_depth)
872 {
873   char *name;
874   enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
875   struct ada_symbol_info sym_info;
876
877   if (max_depth <= 0)
878     error (_("Could not find renamed symbol"));
879
880   if (orig_left_context == NULL)
881     orig_left_context = get_selected_block (NULL);
882
883   name = obstack_copy0 (&temp_parse_space, renamed_entity, renamed_entity_len);
884   ada_lookup_encoded_symbol (name, orig_left_context, VAR_DOMAIN, &sym_info);
885   if (sym_info.sym == NULL)
886     error (_("Could not find renamed variable: %s"), ada_decode (name));
887   else if (SYMBOL_CLASS (sym_info.sym) == LOC_TYPEDEF)
888     /* We have a renaming of an old-style renaming symbol.  Don't
889        trust the block information.  */
890     sym_info.block = orig_left_context;
891
892   {
893     const char *inner_renamed_entity;
894     int inner_renamed_entity_len;
895     const char *inner_renaming_expr;
896
897     switch (ada_parse_renaming (sym_info.sym, &inner_renamed_entity,
898                                 &inner_renamed_entity_len,
899                                 &inner_renaming_expr))
900       {
901       case ADA_NOT_RENAMING:
902         write_var_from_sym (orig_left_context, sym_info.block, sym_info.sym);
903         break;
904       case ADA_OBJECT_RENAMING:
905         write_object_renaming (sym_info.block,
906                                inner_renamed_entity, inner_renamed_entity_len,
907                                inner_renaming_expr, max_depth - 1);
908         break;
909       default:
910         goto BadEncoding;
911       }
912   }
913
914   slice_state = SIMPLE_INDEX;
915   while (*renaming_expr == 'X')
916     {
917       renaming_expr += 1;
918
919       switch (*renaming_expr) {
920       case 'A':
921         renaming_expr += 1;
922         write_exp_elt_opcode (UNOP_IND);
923         break;
924       case 'L':
925         slice_state = LOWER_BOUND;
926         /* FALLTHROUGH */
927       case 'S':
928         renaming_expr += 1;
929         if (isdigit (*renaming_expr))
930           {
931             char *next;
932             long val = strtol (renaming_expr, &next, 10);
933             if (next == renaming_expr)
934               goto BadEncoding;
935             renaming_expr = next;
936             write_exp_elt_opcode (OP_LONG);
937             write_exp_elt_type (type_int ());
938             write_exp_elt_longcst ((LONGEST) val);
939             write_exp_elt_opcode (OP_LONG);
940           }
941         else
942           {
943             const char *end;
944             char *index_name;
945             struct ada_symbol_info index_sym_info;
946
947             end = strchr (renaming_expr, 'X');
948             if (end == NULL)
949               end = renaming_expr + strlen (renaming_expr);
950
951             index_name =
952               obstack_copy0 (&temp_parse_space, renaming_expr,
953                              end - renaming_expr);
954             renaming_expr = end;
955
956             ada_lookup_encoded_symbol (index_name, NULL, VAR_DOMAIN,
957                                        &index_sym_info);
958             if (index_sym_info.sym == NULL)
959               error (_("Could not find %s"), index_name);
960             else if (SYMBOL_CLASS (index_sym_info.sym) == LOC_TYPEDEF)
961               /* Index is an old-style renaming symbol.  */
962               index_sym_info.block = orig_left_context;
963             write_var_from_sym (NULL, index_sym_info.block,
964                                 index_sym_info.sym);
965           }
966         if (slice_state == SIMPLE_INDEX)
967           {
968             write_exp_elt_opcode (OP_FUNCALL);
969             write_exp_elt_longcst ((LONGEST) 1);
970             write_exp_elt_opcode (OP_FUNCALL);
971           }
972         else if (slice_state == LOWER_BOUND)
973           slice_state = UPPER_BOUND;
974         else if (slice_state == UPPER_BOUND)
975           {
976             write_exp_elt_opcode (TERNOP_SLICE);
977             slice_state = SIMPLE_INDEX;
978           }
979         break;
980
981       case 'R':
982         {
983           struct stoken field_name;
984           const char *end;
985           renaming_expr += 1;
986
987           if (slice_state != SIMPLE_INDEX)
988             goto BadEncoding;
989           end = strchr (renaming_expr, 'X');
990           if (end == NULL)
991             end = renaming_expr + strlen (renaming_expr);
992           field_name.length = end - renaming_expr;
993           field_name.ptr = malloc (end - renaming_expr + 1);
994           strncpy (field_name.ptr, renaming_expr, end - renaming_expr);
995           field_name.ptr[end - renaming_expr] = '\000';
996           renaming_expr = end;
997           write_exp_op_with_string (STRUCTOP_STRUCT, field_name);
998           break;
999         }
1000
1001       default:
1002         goto BadEncoding;
1003       }
1004     }
1005   if (slice_state == SIMPLE_INDEX)
1006     return;
1007
1008  BadEncoding:
1009   error (_("Internal error in encoding of renaming declaration"));
1010 }
1011
1012 static struct block*
1013 block_lookup (struct block *context, char *raw_name)
1014 {
1015   char *name;
1016   struct ada_symbol_info *syms;
1017   int nsyms;
1018   struct symtab *symtab;
1019
1020   if (raw_name[0] == '\'')
1021     {
1022       raw_name += 1;
1023       name = raw_name;
1024     }
1025   else
1026     name = ada_encode (raw_name);
1027
1028   nsyms = ada_lookup_symbol_list (name, context, VAR_DOMAIN, &syms);
1029   if (context == NULL
1030       && (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK))
1031     symtab = lookup_symtab (name);
1032   else
1033     symtab = NULL;
1034
1035   if (symtab != NULL)
1036     return BLOCKVECTOR_BLOCK (BLOCKVECTOR (symtab), STATIC_BLOCK);
1037   else if (nsyms == 0 || SYMBOL_CLASS (syms[0].sym) != LOC_BLOCK)
1038     {
1039       if (context == NULL)
1040         error (_("No file or function \"%s\"."), raw_name);
1041       else
1042         error (_("No function \"%s\" in specified context."), raw_name);
1043     }
1044   else
1045     {
1046       if (nsyms > 1)
1047         warning (_("Function name \"%s\" ambiguous here"), raw_name);
1048       return SYMBOL_BLOCK_VALUE (syms[0].sym);
1049     }
1050 }
1051
1052 static struct symbol*
1053 select_possible_type_sym (struct ada_symbol_info *syms, int nsyms)
1054 {
1055   int i;
1056   int preferred_index;
1057   struct type *preferred_type;
1058           
1059   preferred_index = -1; preferred_type = NULL;
1060   for (i = 0; i < nsyms; i += 1)
1061     switch (SYMBOL_CLASS (syms[i].sym))
1062       {
1063       case LOC_TYPEDEF:
1064         if (ada_prefer_type (SYMBOL_TYPE (syms[i].sym), preferred_type))
1065           {
1066             preferred_index = i;
1067             preferred_type = SYMBOL_TYPE (syms[i].sym);
1068           }
1069         break;
1070       case LOC_REGISTER:
1071       case LOC_ARG:
1072       case LOC_REF_ARG:
1073       case LOC_REGPARM_ADDR:
1074       case LOC_LOCAL:
1075       case LOC_COMPUTED:
1076         return NULL;
1077       default:
1078         break;
1079       }
1080   if (preferred_type == NULL)
1081     return NULL;
1082   return syms[preferred_index].sym;
1083 }
1084
1085 static struct type*
1086 find_primitive_type (char *name)
1087 {
1088   struct type *type;
1089   type = language_lookup_primitive_type_by_name (parse_language,
1090                                                  parse_gdbarch,
1091                                                  name);
1092   if (type == NULL && strcmp ("system__address", name) == 0)
1093     type = type_system_address ();
1094
1095   if (type != NULL)
1096     {
1097       /* Check to see if we have a regular definition of this
1098          type that just didn't happen to have been read yet.  */
1099       struct symbol *sym;
1100       char *expanded_name = 
1101         (char *) alloca (strlen (name) + sizeof ("standard__"));
1102       strcpy (expanded_name, "standard__");
1103       strcat (expanded_name, name);
1104       sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL);
1105       if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1106         type = SYMBOL_TYPE (sym);
1107     }
1108
1109   return type;
1110 }
1111
1112 static int
1113 chop_selector (char *name, int end)
1114 {
1115   int i;
1116   for (i = end - 1; i > 0; i -= 1)
1117     if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1118       return i;
1119   return -1;
1120 }
1121
1122 /* If NAME is a string beginning with a separator (either '__', or
1123    '.'), chop this separator and return the result; else, return
1124    NAME.  */
1125
1126 static char *
1127 chop_separator (char *name)
1128 {
1129   if (*name == '.')
1130    return name + 1;
1131
1132   if (name[0] == '_' && name[1] == '_')
1133     return name + 2;
1134
1135   return name;
1136 }
1137
1138 /* Given that SELS is a string of the form (<sep><identifier>)*, where
1139    <sep> is '__' or '.', write the indicated sequence of
1140    STRUCTOP_STRUCT expression operators. */
1141 static void
1142 write_selectors (char *sels)
1143 {
1144   while (*sels != '\0')
1145     {
1146       struct stoken field_name;
1147       char *p = chop_separator (sels);
1148       sels = p;
1149       while (*sels != '\0' && *sels != '.' 
1150              && (sels[0] != '_' || sels[1] != '_'))
1151         sels += 1;
1152       field_name.length = sels - p;
1153       field_name.ptr = p;
1154       write_exp_op_with_string (STRUCTOP_STRUCT, field_name);
1155     }
1156 }
1157
1158 /* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1159    NAME[0..LEN-1], in block context BLOCK, to be resolved later.  Writes
1160    a temporary symbol that is valid until the next call to ada_parse.
1161    */
1162 static void
1163 write_ambiguous_var (const struct block *block, char *name, int len)
1164 {
1165   struct symbol *sym =
1166     obstack_alloc (&temp_parse_space, sizeof (struct symbol));
1167   memset (sym, 0, sizeof (struct symbol));
1168   SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1169   SYMBOL_LINKAGE_NAME (sym) = obstack_copy0 (&temp_parse_space, name, len);
1170   SYMBOL_LANGUAGE (sym) = language_ada;
1171
1172   write_exp_elt_opcode (OP_VAR_VALUE);
1173   write_exp_elt_block (block);
1174   write_exp_elt_sym (sym);
1175   write_exp_elt_opcode (OP_VAR_VALUE);
1176 }
1177
1178 /* A convenient wrapper around ada_get_field_index that takes
1179    a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1180    of a NUL-terminated field name.  */
1181
1182 static int
1183 ada_nget_field_index (const struct type *type, const char *field_name0,
1184                       int field_name_len, int maybe_missing)
1185 {
1186   char *field_name = alloca ((field_name_len + 1) * sizeof (char));
1187
1188   strncpy (field_name, field_name0, field_name_len);
1189   field_name[field_name_len] = '\0';
1190   return ada_get_field_index (type, field_name, maybe_missing);
1191 }
1192
1193 /* If encoded_field_name is the name of a field inside symbol SYM,
1194    then return the type of that field.  Otherwise, return NULL.
1195
1196    This function is actually recursive, so if ENCODED_FIELD_NAME
1197    doesn't match one of the fields of our symbol, then try to see
1198    if ENCODED_FIELD_NAME could not be a succession of field names
1199    (in other words, the user entered an expression of the form
1200    TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1201    each field name sequentially to obtain the desired field type.
1202    In case of failure, we return NULL.  */
1203
1204 static struct type *
1205 get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1206 {
1207   char *field_name = encoded_field_name;
1208   char *subfield_name;
1209   struct type *type = SYMBOL_TYPE (sym);
1210   int fieldno;
1211
1212   if (type == NULL || field_name == NULL)
1213     return NULL;
1214   type = check_typedef (type);
1215
1216   while (field_name[0] != '\0')
1217     {
1218       field_name = chop_separator (field_name);
1219
1220       fieldno = ada_get_field_index (type, field_name, 1);
1221       if (fieldno >= 0)
1222         return TYPE_FIELD_TYPE (type, fieldno);
1223
1224       subfield_name = field_name;
1225       while (*subfield_name != '\0' && *subfield_name != '.' 
1226              && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1227         subfield_name += 1;
1228
1229       if (subfield_name[0] == '\0')
1230         return NULL;
1231
1232       fieldno = ada_nget_field_index (type, field_name,
1233                                       subfield_name - field_name, 1);
1234       if (fieldno < 0)
1235         return NULL;
1236
1237       type = TYPE_FIELD_TYPE (type, fieldno);
1238       field_name = subfield_name;
1239     }
1240
1241   return NULL;
1242 }
1243
1244 /* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or 
1245    expression_block_context if NULL).  If it denotes a type, return
1246    that type.  Otherwise, write expression code to evaluate it as an
1247    object and return NULL. In this second case, NAME0 will, in general,
1248    have the form <name>(.<selector_name>)*, where <name> is an object
1249    or renaming encoded in the debugging data.  Calls error if no
1250    prefix <name> matches a name in the debugging data (i.e., matches
1251    either a complete name or, as a wild-card match, the final 
1252    identifier).  */
1253
1254 static struct type*
1255 write_var_or_type (const struct block *block, struct stoken name0)
1256 {
1257   int depth;
1258   char *encoded_name;
1259   int name_len;
1260
1261   if (block == NULL)
1262     block = expression_context_block;
1263
1264   encoded_name = ada_encode (name0.ptr);
1265   name_len = strlen (encoded_name);
1266   encoded_name = obstack_copy0 (&temp_parse_space, encoded_name, name_len);
1267   for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1268     {
1269       int tail_index;
1270       
1271       tail_index = name_len;
1272       while (tail_index > 0)
1273         {
1274           int nsyms;
1275           struct ada_symbol_info *syms;
1276           struct symbol *type_sym;
1277           struct symbol *renaming_sym;
1278           const char* renaming;
1279           int renaming_len;
1280           const char* renaming_expr;
1281           int terminator = encoded_name[tail_index];
1282
1283           encoded_name[tail_index] = '\0';
1284           nsyms = ada_lookup_symbol_list (encoded_name, block,
1285                                           VAR_DOMAIN, &syms);
1286           encoded_name[tail_index] = terminator;
1287
1288           /* A single symbol may rename a package or object. */
1289
1290           /* This should go away when we move entirely to new version.
1291              FIXME pnh 7/20/2007. */
1292           if (nsyms == 1)
1293             {
1294               struct symbol *ren_sym =
1295                 ada_find_renaming_symbol (syms[0].sym, syms[0].block);
1296
1297               if (ren_sym != NULL)
1298                 syms[0].sym = ren_sym;
1299             }
1300
1301           type_sym = select_possible_type_sym (syms, nsyms);
1302
1303           if (type_sym != NULL)
1304             renaming_sym = type_sym;
1305           else if (nsyms == 1)
1306             renaming_sym = syms[0].sym;
1307           else 
1308             renaming_sym = NULL;
1309
1310           switch (ada_parse_renaming (renaming_sym, &renaming,
1311                                       &renaming_len, &renaming_expr))
1312             {
1313             case ADA_NOT_RENAMING:
1314               break;
1315             case ADA_PACKAGE_RENAMING:
1316             case ADA_EXCEPTION_RENAMING:
1317             case ADA_SUBPROGRAM_RENAMING:
1318               {
1319                 char *new_name
1320                   = obstack_alloc (&temp_parse_space,
1321                                    renaming_len + name_len - tail_index + 1);
1322                 strncpy (new_name, renaming, renaming_len);
1323                 strcpy (new_name + renaming_len, encoded_name + tail_index);
1324                 encoded_name = new_name;
1325                 name_len = renaming_len + name_len - tail_index;
1326                 goto TryAfterRenaming;
1327               } 
1328             case ADA_OBJECT_RENAMING:
1329               write_object_renaming (block, renaming, renaming_len, 
1330                                      renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1331               write_selectors (encoded_name + tail_index);
1332               return NULL;
1333             default:
1334               internal_error (__FILE__, __LINE__,
1335                               _("impossible value from ada_parse_renaming"));
1336             }
1337
1338           if (type_sym != NULL)
1339             {
1340               struct type *field_type;
1341               
1342               if (tail_index == name_len)
1343                 return SYMBOL_TYPE (type_sym);
1344
1345               /* We have some extraneous characters after the type name.
1346                  If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1347                  then try to get the type of FIELDN.  */
1348               field_type
1349                 = get_symbol_field_type (type_sym, encoded_name + tail_index);
1350               if (field_type != NULL)
1351                 return field_type;
1352               else 
1353                 error (_("Invalid attempt to select from type: \"%s\"."),
1354                        name0.ptr);
1355             }
1356           else if (tail_index == name_len && nsyms == 0)
1357             {
1358               struct type *type = find_primitive_type (encoded_name);
1359
1360               if (type != NULL)
1361                 return type;
1362             }
1363
1364           if (nsyms == 1)
1365             {
1366               write_var_from_sym (block, syms[0].block, syms[0].sym);
1367               write_selectors (encoded_name + tail_index);
1368               return NULL;
1369             }
1370           else if (nsyms == 0) 
1371             {
1372               struct minimal_symbol *msym 
1373                 = ada_lookup_simple_minsym (encoded_name);
1374               if (msym != NULL)
1375                 {
1376                   write_exp_msymbol (msym);
1377                   /* Maybe cause error here rather than later? FIXME? */
1378                   write_selectors (encoded_name + tail_index);
1379                   return NULL;
1380                 }
1381
1382               if (tail_index == name_len
1383                   && strncmp (encoded_name, "standard__", 
1384                               sizeof ("standard__") - 1) == 0)
1385                 error (_("No definition of \"%s\" found."), name0.ptr);
1386
1387               tail_index = chop_selector (encoded_name, tail_index);
1388             } 
1389           else
1390             {
1391               write_ambiguous_var (block, encoded_name, tail_index);
1392               write_selectors (encoded_name + tail_index);
1393               return NULL;
1394             }
1395         }
1396
1397       if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1398         error (_("No symbol table is loaded.  Use the \"file\" command."));
1399       if (block == expression_context_block)
1400         error (_("No definition of \"%s\" in current context."), name0.ptr);
1401       else
1402         error (_("No definition of \"%s\" in specified context."), name0.ptr);
1403       
1404     TryAfterRenaming: ;
1405     }
1406
1407   error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1408
1409 }
1410
1411 /* Write a left side of a component association (e.g., NAME in NAME =>
1412    exp).  If NAME has the form of a selected component, write it as an
1413    ordinary expression.  If it is a simple variable that unambiguously
1414    corresponds to exactly one symbol that does not denote a type or an
1415    object renaming, also write it normally as an OP_VAR_VALUE.
1416    Otherwise, write it as an OP_NAME.
1417
1418    Unfortunately, we don't know at this point whether NAME is supposed
1419    to denote a record component name or the value of an array index.
1420    Therefore, it is not appropriate to disambiguate an ambiguous name
1421    as we normally would, nor to replace a renaming with its referent.
1422    As a result, in the (one hopes) rare case that one writes an
1423    aggregate such as (R => 42) where R renames an object or is an
1424    ambiguous name, one must write instead ((R) => 42). */
1425    
1426 static void
1427 write_name_assoc (struct stoken name)
1428 {
1429   if (strchr (name.ptr, '.') == NULL)
1430     {
1431       struct ada_symbol_info *syms;
1432       int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
1433                                           VAR_DOMAIN, &syms);
1434       if (nsyms != 1 || SYMBOL_CLASS (syms[0].sym) == LOC_TYPEDEF)
1435         write_exp_op_with_string (OP_NAME, name);
1436       else
1437         write_var_from_sym (NULL, syms[0].block, syms[0].sym);
1438     }
1439   else
1440     if (write_var_or_type (NULL, name) != NULL)
1441       error (_("Invalid use of type."));
1442 }
1443
1444 /* Convert the character literal whose ASCII value would be VAL to the
1445    appropriate value of type TYPE, if there is a translation.
1446    Otherwise return VAL.  Hence, in an enumeration type ('A', 'B'),
1447    the literal 'A' (VAL == 65), returns 0.  */
1448
1449 static LONGEST
1450 convert_char_literal (struct type *type, LONGEST val)
1451 {
1452   char name[7];
1453   int f;
1454
1455   if (type == NULL)
1456     return val;
1457   type = check_typedef (type);
1458   if (TYPE_CODE (type) != TYPE_CODE_ENUM)
1459     return val;
1460
1461   xsnprintf (name, sizeof (name), "QU%02x", (int) val);
1462   for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1463     {
1464       if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
1465         return TYPE_FIELD_ENUMVAL (type, f);
1466     }
1467   return val;
1468 }
1469
1470 static struct type *
1471 type_int (void)
1472 {
1473   return parse_type->builtin_int;
1474 }
1475
1476 static struct type *
1477 type_long (void)
1478 {
1479   return parse_type->builtin_long;
1480 }
1481
1482 static struct type *
1483 type_long_long (void)
1484 {
1485   return parse_type->builtin_long_long;
1486 }
1487
1488 static struct type *
1489 type_float (void)
1490 {
1491   return parse_type->builtin_float;
1492 }
1493
1494 static struct type *
1495 type_double (void)
1496 {
1497   return parse_type->builtin_double;
1498 }
1499
1500 static struct type *
1501 type_long_double (void)
1502 {
1503   return parse_type->builtin_long_double;
1504 }
1505
1506 static struct type *
1507 type_char (void)
1508 {
1509   return language_string_char_type (parse_language, parse_gdbarch);
1510 }
1511
1512 static struct type *
1513 type_boolean (void)
1514 {
1515   return parse_type->builtin_bool;
1516 }
1517
1518 static struct type *
1519 type_system_address (void)
1520 {
1521   struct type *type 
1522     = language_lookup_primitive_type_by_name (parse_language,
1523                                               parse_gdbarch,
1524                                               "system__address");
1525   return  type != NULL ? type : parse_type->builtin_data_ptr;
1526 }
1527
1528 /* Provide a prototype to silence -Wmissing-prototypes.  */
1529 extern initialize_file_ftype _initialize_ada_exp;
1530
1531 void
1532 _initialize_ada_exp (void)
1533 {
1534   obstack_init (&temp_parse_space);
1535 }
1536
1537 /* FIXME: hilfingr/2004-10-05: Hack to remove warning.  The function
1538    string_to_operator is supposed to be used for cases where one
1539    calls an operator function with prefix notation, as in 
1540    "+" (a, b), but at some point, this code seems to have gone
1541    missing. */
1542
1543 struct stoken (*dummy_string_to_ada_operator) (struct stoken) 
1544      = string_to_operator;