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