OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-6.8/] [gdb/] [ada-exp.y] - Blame information for rev 404

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

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

powered by: WebSVN 2.1.0

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