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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gdb-7.2/] [gdb/] [ada-exp.y] - Blame information for rev 859

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

Line No. Rev Author Line
1 330 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
      struct symbol *sym;
1095
      char *expanded_name =
1096
        (char *) alloca (strlen (name) + sizeof ("standard__"));
1097
      strcpy (expanded_name, "standard__");
1098
      strcat (expanded_name, name);
1099
      sym = ada_lookup_symbol (expanded_name, NULL, VAR_DOMAIN, NULL);
1100
      if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1101
        type = SYMBOL_TYPE (sym);
1102
    }
1103
 
1104
  return type;
1105
}
1106
 
1107
static int
1108
chop_selector (char *name, int end)
1109
{
1110
  int i;
1111
  for (i = end - 1; i > 0; i -= 1)
1112
    if (name[i] == '.' || (name[i] == '_' && name[i+1] == '_'))
1113
      return i;
1114
  return -1;
1115
}
1116
 
1117
/* If NAME is a string beginning with a separator (either '__', or
1118
   '.'), chop this separator and return the result; else, return
1119
   NAME.  */
1120
 
1121
static char *
1122
chop_separator (char *name)
1123
{
1124
  if (*name == '.')
1125
   return name + 1;
1126
 
1127
  if (name[0] == '_' && name[1] == '_')
1128
    return name + 2;
1129
 
1130
  return name;
1131
}
1132
 
1133
/* Given that SELS is a string of the form ()*, where
1134
    is '__' or '.', write the indicated sequence of
1135
   STRUCTOP_STRUCT expression operators. */
1136
static void
1137
write_selectors (char *sels)
1138
{
1139
  while (*sels != '\0')
1140
    {
1141
      struct stoken field_name;
1142
      char *p = chop_separator (sels);
1143
      sels = p;
1144
      while (*sels != '\0' && *sels != '.'
1145
             && (sels[0] != '_' || sels[1] != '_'))
1146
        sels += 1;
1147
      field_name.length = sels - p;
1148
      field_name.ptr = p;
1149
      write_exp_op_with_string (STRUCTOP_STRUCT, field_name);
1150
    }
1151
}
1152
 
1153
/* Write a variable access (OP_VAR_VALUE) to ambiguous encoded name
1154
   NAME[0..LEN-1], in block context BLOCK, to be resolved later.  Writes
1155
   a temporary symbol that is valid until the next call to ada_parse.
1156
   */
1157
static void
1158
write_ambiguous_var (struct block *block, char *name, int len)
1159
{
1160
  struct symbol *sym =
1161
    obstack_alloc (&temp_parse_space, sizeof (struct symbol));
1162
  memset (sym, 0, sizeof (struct symbol));
1163
  SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN;
1164
  SYMBOL_LINKAGE_NAME (sym) = obsavestring (name, len, &temp_parse_space);
1165
  SYMBOL_LANGUAGE (sym) = language_ada;
1166
 
1167
  write_exp_elt_opcode (OP_VAR_VALUE);
1168
  write_exp_elt_block (block);
1169
  write_exp_elt_sym (sym);
1170
  write_exp_elt_opcode (OP_VAR_VALUE);
1171
}
1172
 
1173
/* A convenient wrapper around ada_get_field_index that takes
1174
   a non NUL-terminated FIELD_NAME0 and a FIELD_NAME_LEN instead
1175
   of a NUL-terminated field name.  */
1176
 
1177
static int
1178
ada_nget_field_index (const struct type *type, const char *field_name0,
1179
                      int field_name_len, int maybe_missing)
1180
{
1181
  char *field_name = alloca ((field_name_len + 1) * sizeof (char));
1182
 
1183
  strncpy (field_name, field_name0, field_name_len);
1184
  field_name[field_name_len] = '\0';
1185
  return ada_get_field_index (type, field_name, maybe_missing);
1186
}
1187
 
1188
/* If encoded_field_name is the name of a field inside symbol SYM,
1189
   then return the type of that field.  Otherwise, return NULL.
1190
 
1191
   This function is actually recursive, so if ENCODED_FIELD_NAME
1192
   doesn't match one of the fields of our symbol, then try to see
1193
   if ENCODED_FIELD_NAME could not be a succession of field names
1194
   (in other words, the user entered an expression of the form
1195
   TYPE_NAME.FIELD1.FIELD2.FIELD3), in which case we evaluate
1196
   each field name sequentially to obtain the desired field type.
1197
   In case of failure, we return NULL.  */
1198
 
1199
static struct type *
1200
get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
1201
{
1202
  char *field_name = encoded_field_name;
1203
  char *subfield_name;
1204
  struct type *type = SYMBOL_TYPE (sym);
1205
  int fieldno;
1206
 
1207
  if (type == NULL || field_name == NULL)
1208
    return NULL;
1209
  type = check_typedef (type);
1210
 
1211
  while (field_name[0] != '\0')
1212
    {
1213
      field_name = chop_separator (field_name);
1214
 
1215
      fieldno = ada_get_field_index (type, field_name, 1);
1216
      if (fieldno >= 0)
1217
        return TYPE_FIELD_TYPE (type, fieldno);
1218
 
1219
      subfield_name = field_name;
1220
      while (*subfield_name != '\0' && *subfield_name != '.'
1221
             && (subfield_name[0] != '_' || subfield_name[1] != '_'))
1222
        subfield_name += 1;
1223
 
1224
      if (subfield_name[0] == '\0')
1225
        return NULL;
1226
 
1227
      fieldno = ada_nget_field_index (type, field_name,
1228
                                      subfield_name - field_name, 1);
1229
      if (fieldno < 0)
1230
        return NULL;
1231
 
1232
      type = TYPE_FIELD_TYPE (type, fieldno);
1233
      field_name = subfield_name;
1234
    }
1235
 
1236
  return NULL;
1237
}
1238
 
1239
/* Look up NAME0 (an unencoded identifier or dotted name) in BLOCK (or
1240
   expression_block_context if NULL).  If it denotes a type, return
1241
   that type.  Otherwise, write expression code to evaluate it as an
1242
   object and return NULL. In this second case, NAME0 will, in general,
1243
   have the form (.)*, where  is an object
1244
   or renaming encoded in the debugging data.  Calls error if no
1245
   prefix  matches a name in the debugging data (i.e., matches
1246
   either a complete name or, as a wild-card match, the final
1247
   identifier).  */
1248
 
1249
static struct type*
1250
write_var_or_type (struct block *block, struct stoken name0)
1251
{
1252
  int depth;
1253
  char *encoded_name;
1254
  int name_len;
1255
 
1256
  if (block == NULL)
1257
    block = expression_context_block;
1258
 
1259
  encoded_name = ada_encode (name0.ptr);
1260
  name_len = strlen (encoded_name);
1261
  encoded_name = obsavestring (encoded_name, name_len, &temp_parse_space);
1262
  for (depth = 0; depth < MAX_RENAMING_CHAIN_LENGTH; depth += 1)
1263
    {
1264
      int tail_index;
1265
 
1266
      tail_index = name_len;
1267
      while (tail_index > 0)
1268
        {
1269
          int nsyms;
1270
          struct ada_symbol_info *syms;
1271
          struct symbol *type_sym;
1272
          struct symbol *renaming_sym;
1273
          const char* renaming;
1274
          int renaming_len;
1275
          const char* renaming_expr;
1276
          int terminator = encoded_name[tail_index];
1277
 
1278
          encoded_name[tail_index] = '\0';
1279
          nsyms = ada_lookup_symbol_list (encoded_name, block,
1280
                                          VAR_DOMAIN, &syms);
1281
          encoded_name[tail_index] = terminator;
1282
 
1283
          /* A single symbol may rename a package or object. */
1284
 
1285
          /* This should go away when we move entirely to new version.
1286
             FIXME pnh 7/20/2007. */
1287
          if (nsyms == 1)
1288
            {
1289
              struct symbol *renaming =
1290
                ada_find_renaming_symbol (SYMBOL_LINKAGE_NAME (syms[0].sym),
1291
                                          syms[0].block);
1292
 
1293
              if (renaming != NULL)
1294
                syms[0].sym = renaming;
1295
            }
1296
 
1297
          type_sym = select_possible_type_sym (syms, nsyms);
1298
 
1299
          if (type_sym != NULL)
1300
            renaming_sym = type_sym;
1301
          else if (nsyms == 1)
1302
            renaming_sym = syms[0].sym;
1303
          else
1304
            renaming_sym = NULL;
1305
 
1306
          switch (ada_parse_renaming (renaming_sym, &renaming,
1307
                                      &renaming_len, &renaming_expr))
1308
            {
1309
            case ADA_NOT_RENAMING:
1310
              break;
1311
            case ADA_PACKAGE_RENAMING:
1312
            case ADA_EXCEPTION_RENAMING:
1313
            case ADA_SUBPROGRAM_RENAMING:
1314
              {
1315
                char *new_name
1316
                  = obstack_alloc (&temp_parse_space,
1317
                                   renaming_len + name_len - tail_index + 1);
1318
                strncpy (new_name, renaming, renaming_len);
1319
                strcpy (new_name + renaming_len, encoded_name + tail_index);
1320
                encoded_name = new_name;
1321
                name_len = renaming_len + name_len - tail_index;
1322
                goto TryAfterRenaming;
1323
              }
1324
            case ADA_OBJECT_RENAMING:
1325
              write_object_renaming (block, renaming, renaming_len,
1326
                                     renaming_expr, MAX_RENAMING_CHAIN_LENGTH);
1327
              write_selectors (encoded_name + tail_index);
1328
              return NULL;
1329
            default:
1330
              internal_error (__FILE__, __LINE__,
1331
                              _("impossible value from ada_parse_renaming"));
1332
            }
1333
 
1334
          if (type_sym != NULL)
1335
            {
1336
              struct type *field_type;
1337
 
1338
              if (tail_index == name_len)
1339
                return SYMBOL_TYPE (type_sym);
1340
 
1341
              /* We have some extraneous characters after the type name.
1342
                 If this is an expression "TYPE_NAME.FIELD0.[...].FIELDN",
1343
                 then try to get the type of FIELDN.  */
1344
              field_type
1345
                = get_symbol_field_type (type_sym, encoded_name + tail_index);
1346
              if (field_type != NULL)
1347
                return field_type;
1348
              else
1349
                error (_("Invalid attempt to select from type: \"%s\"."),
1350
                       name0.ptr);
1351
            }
1352
          else if (tail_index == name_len && nsyms == 0)
1353
            {
1354
              struct type *type = find_primitive_type (encoded_name);
1355
 
1356
              if (type != NULL)
1357
                return type;
1358
            }
1359
 
1360
          if (nsyms == 1)
1361
            {
1362
              write_var_from_sym (block, syms[0].block, syms[0].sym);
1363
              write_selectors (encoded_name + tail_index);
1364
              return NULL;
1365
            }
1366
          else if (nsyms == 0)
1367
            {
1368
              struct minimal_symbol *msym
1369
                = ada_lookup_simple_minsym (encoded_name);
1370
              if (msym != NULL)
1371
                {
1372
                  write_exp_msymbol (msym);
1373
                  /* Maybe cause error here rather than later? FIXME? */
1374
                  write_selectors (encoded_name + tail_index);
1375
                  return NULL;
1376
                }
1377
 
1378
              if (tail_index == name_len
1379
                  && strncmp (encoded_name, "standard__",
1380
                              sizeof ("standard__") - 1) == 0)
1381
                error (_("No definition of \"%s\" found."), name0.ptr);
1382
 
1383
              tail_index = chop_selector (encoded_name, tail_index);
1384
            }
1385
          else
1386
            {
1387
              write_ambiguous_var (block, encoded_name, tail_index);
1388
              write_selectors (encoded_name + tail_index);
1389
              return NULL;
1390
            }
1391
        }
1392
 
1393
      if (!have_full_symbols () && !have_partial_symbols () && block == NULL)
1394
        error (_("No symbol table is loaded.  Use the \"file\" command."));
1395
      if (block == expression_context_block)
1396
        error (_("No definition of \"%s\" in current context."), name0.ptr);
1397
      else
1398
        error (_("No definition of \"%s\" in specified context."), name0.ptr);
1399
 
1400
    TryAfterRenaming: ;
1401
    }
1402
 
1403
  error (_("Could not find renamed symbol \"%s\""), name0.ptr);
1404
 
1405
}
1406
 
1407
/* Write a left side of a component association (e.g., NAME in NAME =>
1408
   exp).  If NAME has the form of a selected component, write it as an
1409
   ordinary expression.  If it is a simple variable that unambiguously
1410
   corresponds to exactly one symbol that does not denote a type or an
1411
   object renaming, also write it normally as an OP_VAR_VALUE.
1412
   Otherwise, write it as an OP_NAME.
1413
 
1414
   Unfortunately, we don't know at this point whether NAME is supposed
1415
   to denote a record component name or the value of an array index.
1416
   Therefore, it is not appropriate to disambiguate an ambiguous name
1417
   as we normally would, nor to replace a renaming with its referent.
1418
   As a result, in the (one hopes) rare case that one writes an
1419
   aggregate such as (R => 42) where R renames an object or is an
1420
   ambiguous name, one must write instead ((R) => 42). */
1421
 
1422
static void
1423
write_name_assoc (struct stoken name)
1424
{
1425
  if (strchr (name.ptr, '.') == NULL)
1426
    {
1427
      struct ada_symbol_info *syms;
1428
      int nsyms = ada_lookup_symbol_list (name.ptr, expression_context_block,
1429
                                          VAR_DOMAIN, &syms);
1430
      if (nsyms != 1 || SYMBOL_CLASS (syms[0].sym) == LOC_TYPEDEF)
1431
        write_exp_op_with_string (OP_NAME, name);
1432
      else
1433
        write_var_from_sym (NULL, syms[0].block, syms[0].sym);
1434
    }
1435
  else
1436
    if (write_var_or_type (NULL, name) != NULL)
1437
      error (_("Invalid use of type."));
1438
}
1439
 
1440
/* Convert the character literal whose ASCII value would be VAL to the
1441
   appropriate value of type TYPE, if there is a translation.
1442
   Otherwise return VAL.  Hence, in an enumeration type ('A', 'B'),
1443
   the literal 'A' (VAL == 65), returns 0.  */
1444
 
1445
static LONGEST
1446
convert_char_literal (struct type *type, LONGEST val)
1447
{
1448
  char name[7];
1449
  int f;
1450
 
1451
  if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM)
1452
    return val;
1453
  xsnprintf (name, sizeof (name), "QU%02x", (int) val);
1454
  for (f = 0; f < TYPE_NFIELDS (type); f += 1)
1455
    {
1456
      if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0)
1457
        return TYPE_FIELD_BITPOS (type, f);
1458
    }
1459
  return val;
1460
}
1461
 
1462
static struct type *
1463
type_int (void)
1464
{
1465
  return parse_type->builtin_int;
1466
}
1467
 
1468
static struct type *
1469
type_long (void)
1470
{
1471
  return parse_type->builtin_long;
1472
}
1473
 
1474
static struct type *
1475
type_long_long (void)
1476
{
1477
  return parse_type->builtin_long_long;
1478
}
1479
 
1480
static struct type *
1481
type_float (void)
1482
{
1483
  return parse_type->builtin_float;
1484
}
1485
 
1486
static struct type *
1487
type_double (void)
1488
{
1489
  return parse_type->builtin_double;
1490
}
1491
 
1492
static struct type *
1493
type_long_double (void)
1494
{
1495
  return parse_type->builtin_long_double;
1496
}
1497
 
1498
static struct type *
1499
type_char (void)
1500
{
1501
  return language_string_char_type (parse_language, parse_gdbarch);
1502
}
1503
 
1504
static struct type *
1505
type_boolean (void)
1506
{
1507
  return parse_type->builtin_bool;
1508
}
1509
 
1510
static struct type *
1511
type_system_address (void)
1512
{
1513
  struct type *type
1514
    = language_lookup_primitive_type_by_name (parse_language,
1515
                                              parse_gdbarch,
1516
                                              "system__address");
1517
  return  type != NULL ? type : parse_type->builtin_data_ptr;
1518
}
1519
 
1520
/* Provide a prototype to silence -Wmissing-prototypes.  */
1521
extern initialize_file_ftype _initialize_ada_exp;
1522
 
1523
void
1524
_initialize_ada_exp (void)
1525
{
1526
  obstack_init (&temp_parse_space);
1527
}
1528
 
1529
/* FIXME: hilfingr/2004-10-05: Hack to remove warning.  The function
1530
   string_to_operator is supposed to be used for cases where one
1531
   calls an operator function with prefix notation, as in
1532
   "+" (a, b), but at some point, this code seems to have gone
1533
   missing. */
1534
 
1535
struct stoken (*dummy_string_to_ada_operator) (struct stoken)
1536
     = string_to_operator;

powered by: WebSVN 2.1.0

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