OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gdb-7.1/] [gdb/] [ada-exp.y] - Blame information for rev 853

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.