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