1/* YACC parser for Ada expressions, for GDB. 2 Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000, 2003, 3 2004 Free Software Foundation, Inc. 4 5This file is part of GDB. 6 7This program is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2 of the License, or 10(at your option) any later version. 11 12This program is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with this program; if not, write to the Free Software 19Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ 20 21/* Parse an Ada expression from text in a string, 22 and return the result as a struct expression pointer. 23 That structure contains arithmetic operations in reverse polish, 24 with constants represented by operations that are followed by special data. 25 See expression.h for the details of the format. 26 What is important here is that it can be built up sequentially 27 during the process of parsing; the lower levels of the tree always 28 come first in the result. 29 30 malloc's and realloc's in this file are transformed to 31 xmalloc and xrealloc respectively by the same sed command in the 32 makefile that remaps any other malloc/realloc inserted by the parser 33 generator. Doing this with #defines and trying to control the interaction 34 with include files (<malloc.h> and <stdlib.h> for example) just became 35 too messy, particularly when such includes can be inserted at random 36 times by the parser generator. */ 37 38%{ 39 40#include "defs.h" 41#include "gdb_string.h" 42#include <ctype.h> 43#include "expression.h" 44#include "value.h" 45#include "parser-defs.h" 46#include "language.h" 47#include "ada-lang.h" 48#include "bfd.h" /* Required by objfiles.h. */ 49#include "symfile.h" /* Required by objfiles.h. */ 50#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */ 51#include "frame.h" 52#include "block.h" 53 54/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), 55 as well as gratuitiously global symbol names, so we can have multiple 56 yacc generated parsers in gdb. These are only the variables 57 produced by yacc. If other parser generators (bison, byacc, etc) produce 58 additional global names that conflict at link time, then those parser 59 generators need to be fixed instead of adding those names to this list. */ 60 61/* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix 62 options. I presume we are maintaining it to accommodate systems 63 without BISON? (PNH) */ 64 65#define yymaxdepth ada_maxdepth 66#define yyparse _ada_parse /* ada_parse calls this after initialization */ 67#define yylex ada_lex 68#define yyerror ada_error 69#define yylval ada_lval 70#define yychar ada_char 71#define yydebug ada_debug 72#define yypact ada_pact 73#define yyr1 ada_r1 74#define yyr2 ada_r2 75#define yydef ada_def 76#define yychk ada_chk 77#define yypgo ada_pgo 78#define yyact ada_act 79#define yyexca ada_exca 80#define yyerrflag ada_errflag 81#define yynerrs ada_nerrs 82#define yyps ada_ps 83#define yypv ada_pv 84#define yys ada_s 85#define yy_yys ada_yys 86#define yystate ada_state 87#define yytmp ada_tmp 88#define yyv ada_v 89#define yy_yyv ada_yyv 90#define yyval ada_val 91#define yylloc ada_lloc 92#define yyreds ada_reds /* With YYDEBUG defined */ 93#define yytoks ada_toks /* With YYDEBUG defined */ 94#define yyname ada_name /* With YYDEBUG defined */ 95#define yyrule ada_rule /* With YYDEBUG defined */ 96 97#ifndef YYDEBUG 98#define YYDEBUG 1 /* Default to yydebug support */ 99#endif 100 101#define YYFPRINTF parser_fprintf 102 103struct name_info { 104 struct symbol *sym; 105 struct minimal_symbol *msym; 106 struct block *block; 107 struct stoken stoken; 108}; 109 110/* If expression is in the context of TYPE'(...), then TYPE, else 111 * NULL. */ 112static struct type *type_qualifier; 113 114int yyparse (void); 115 116static int yylex (void); 117 118void yyerror (char *); 119 120static struct stoken string_to_operator (struct stoken); 121 122static void write_int (LONGEST, struct type *); 123 124static void write_object_renaming (struct block *, struct symbol *, int); 125 126static void write_var_from_name (struct block *, struct name_info); 127 128static LONGEST convert_char_literal (struct type *, LONGEST); 129 130static struct type *type_int (void); 131 132static struct type *type_long (void); 133 134static struct type *type_long_long (void); 135 136static struct type *type_float (void); 137 138static struct type *type_double (void); 139 140static struct type *type_long_double (void); 141 142static struct type *type_char (void); 143 144static struct type *type_system_address (void); 145%} 146 147%union 148 { 149 LONGEST lval; 150 struct { 151 LONGEST val; 152 struct type *type; 153 } typed_val; 154 struct { 155 DOUBLEST dval; 156 struct type *type; 157 } typed_val_float; 158 struct type *tval; 159 struct stoken sval; 160 struct name_info ssym; 161 int voidval; 162 struct block *bval; 163 struct internalvar *ivar; 164 165 } 166 167%type <voidval> exp exp1 simple_exp start variable 168%type <tval> type 169 170%token <typed_val> INT NULL_PTR CHARLIT 171%token <typed_val_float> FLOAT 172%token <tval> TYPENAME 173%token <bval> BLOCKNAME 174 175/* Both NAME and TYPENAME tokens represent symbols in the input, 176 and both convey their data as strings. 177 But a TYPENAME is a string that happens to be defined as a typedef 178 or builtin type name (such as int or char) 179 and a NAME is any other symbol. 180 Contexts where this distinction is not important can use the 181 nonterminal "name", which matches either NAME or TYPENAME. */ 182 183%token <sval> STRING 184%token <ssym> NAME DOT_ID OBJECT_RENAMING 185%type <bval> block 186%type <lval> arglist tick_arglist 187 188%type <tval> 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 <sval> 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 /* The following are right-associative only so that reductions at this 205 precedence have lower precedence than '.' and '('. The syntax still 206 forces a.b.c, e.g., to be LEFT-associated. */ 207%right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH 208%right TICK_MAX TICK_MIN TICK_MODULUS 209%right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL 210%right '.' '(' '[' DOT_ID DOT_ALL 211 212%token ARROW NEW 213 214 215%% 216 217start : exp1 218 | type { write_exp_elt_opcode (OP_TYPE); 219 write_exp_elt_type ($1); 220 write_exp_elt_opcode (OP_TYPE); } 221 ; 222 223/* Expressions, including the sequencing operator. */ 224exp1 : exp 225 | exp1 ';' exp 226 { write_exp_elt_opcode (BINOP_COMMA); } 227 ; 228 229/* Expressions, not including the sequencing operator. */ 230simple_exp : simple_exp DOT_ALL 231 { write_exp_elt_opcode (UNOP_IND); } 232 ; 233 234simple_exp : simple_exp DOT_ID 235 { write_exp_elt_opcode (STRUCTOP_STRUCT); 236 write_exp_string ($2.stoken); 237 write_exp_elt_opcode (STRUCTOP_STRUCT); 238 } 239 ; 240 241simple_exp : simple_exp '(' arglist ')' 242 { 243 write_exp_elt_opcode (OP_FUNCALL); 244 write_exp_elt_longcst ($3); 245 write_exp_elt_opcode (OP_FUNCALL); 246 } 247 ; 248 249simple_exp : type '(' exp ')' 250 { 251 write_exp_elt_opcode (UNOP_CAST); 252 write_exp_elt_type ($1); 253 write_exp_elt_opcode (UNOP_CAST); 254 } 255 ; 256 257simple_exp : type '\'' save_qualifier { type_qualifier = $1; } '(' exp ')' 258 { 259 write_exp_elt_opcode (UNOP_QUAL); 260 write_exp_elt_type ($1); 261 write_exp_elt_opcode (UNOP_QUAL); 262 type_qualifier = $3; 263 } 264 ; 265 266save_qualifier : { $$ = type_qualifier; } 267 ; 268 269simple_exp : 270 simple_exp '(' exp DOTDOT exp ')' 271 { write_exp_elt_opcode (TERNOP_SLICE); } 272 ; 273 274simple_exp : '(' exp1 ')' { } 275 ; 276 277simple_exp : variable 278 ; 279 280simple_exp: SPECIAL_VARIABLE /* Various GDB extensions */ 281 { write_dollar_variable ($1); } 282 ; 283 284exp : simple_exp 285 ; 286 287exp : exp ASSIGN exp /* Extension for convenience */ 288 { write_exp_elt_opcode (BINOP_ASSIGN); } 289 ; 290 291exp : '-' exp %prec UNARY 292 { write_exp_elt_opcode (UNOP_NEG); } 293 ; 294 295exp : '+' exp %prec UNARY 296 { write_exp_elt_opcode (UNOP_PLUS); } 297 ; 298 299exp : NOT exp %prec UNARY 300 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } 301 ; 302 303exp : ABS exp %prec UNARY 304 { write_exp_elt_opcode (UNOP_ABS); } 305 ; 306 307arglist : { $$ = 0; } 308 ; 309 310arglist : exp 311 { $$ = 1; } 312 | any_name ARROW exp 313 { $$ = 1; } 314 | arglist ',' exp 315 { $$ = $1 + 1; } 316 | arglist ',' any_name ARROW exp 317 { $$ = $1 + 1; } 318 ; 319 320exp : '{' type '}' exp %prec '.' 321 /* GDB extension */ 322 { write_exp_elt_opcode (UNOP_MEMVAL); 323 write_exp_elt_type ($2); 324 write_exp_elt_opcode (UNOP_MEMVAL); 325 } 326 ; 327 328/* Binary operators in order of decreasing precedence. */ 329 330exp : exp STARSTAR exp 331 { write_exp_elt_opcode (BINOP_EXP); } 332 ; 333 334exp : exp '*' exp 335 { write_exp_elt_opcode (BINOP_MUL); } 336 ; 337 338exp : exp '/' exp 339 { write_exp_elt_opcode (BINOP_DIV); } 340 ; 341 342exp : exp REM exp /* May need to be fixed to give correct Ada REM */ 343 { write_exp_elt_opcode (BINOP_REM); } 344 ; 345 346exp : exp MOD exp 347 { write_exp_elt_opcode (BINOP_MOD); } 348 ; 349 350exp : exp '@' exp /* GDB extension */ 351 { write_exp_elt_opcode (BINOP_REPEAT); } 352 ; 353 354exp : exp '+' exp 355 { write_exp_elt_opcode (BINOP_ADD); } 356 ; 357 358exp : exp '&' exp 359 { write_exp_elt_opcode (BINOP_CONCAT); } 360 ; 361 362exp : exp '-' exp 363 { write_exp_elt_opcode (BINOP_SUB); } 364 ; 365 366exp : exp '=' exp 367 { write_exp_elt_opcode (BINOP_EQUAL); } 368 ; 369 370exp : exp NOTEQUAL exp 371 { write_exp_elt_opcode (BINOP_NOTEQUAL); } 372 ; 373 374exp : exp LEQ exp 375 { write_exp_elt_opcode (BINOP_LEQ); } 376 ; 377 378exp : exp IN exp DOTDOT exp 379 { write_exp_elt_opcode (TERNOP_IN_RANGE); } 380 | exp IN exp TICK_RANGE tick_arglist 381 { write_exp_elt_opcode (BINOP_IN_BOUNDS); 382 write_exp_elt_longcst ((LONGEST) $5); 383 write_exp_elt_opcode (BINOP_IN_BOUNDS); 384 } 385 | exp IN TYPENAME %prec TICK_ACCESS 386 { write_exp_elt_opcode (UNOP_IN_RANGE); 387 write_exp_elt_type ($3); 388 write_exp_elt_opcode (UNOP_IN_RANGE); 389 } 390 | exp NOT IN exp DOTDOT exp 391 { write_exp_elt_opcode (TERNOP_IN_RANGE); 392 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 393 } 394 | exp NOT IN exp TICK_RANGE tick_arglist 395 { write_exp_elt_opcode (BINOP_IN_BOUNDS); 396 write_exp_elt_longcst ((LONGEST) $6); 397 write_exp_elt_opcode (BINOP_IN_BOUNDS); 398 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 399 } 400 | exp NOT IN TYPENAME %prec TICK_ACCESS 401 { write_exp_elt_opcode (UNOP_IN_RANGE); 402 write_exp_elt_type ($4); 403 write_exp_elt_opcode (UNOP_IN_RANGE); 404 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 405 } 406 ; 407 408exp : exp GEQ exp 409 { write_exp_elt_opcode (BINOP_GEQ); } 410 ; 411 412exp : exp '<' exp 413 { write_exp_elt_opcode (BINOP_LESS); } 414 ; 415 416exp : exp '>' exp 417 { write_exp_elt_opcode (BINOP_GTR); } 418 ; 419 420exp : exp _AND_ exp /* Fix for Ada elementwise AND. */ 421 { write_exp_elt_opcode (BINOP_BITWISE_AND); } 422 ; 423 424exp : exp _AND_ THEN exp %prec _AND_ 425 { write_exp_elt_opcode (BINOP_LOGICAL_AND); } 426 ; 427 428exp : exp OR exp /* Fix for Ada elementwise OR */ 429 { write_exp_elt_opcode (BINOP_BITWISE_IOR); } 430 ; 431 432exp : exp OR ELSE exp 433 { write_exp_elt_opcode (BINOP_LOGICAL_OR); } 434 ; 435 436exp : exp XOR exp /* Fix for Ada elementwise XOR */ 437 { write_exp_elt_opcode (BINOP_BITWISE_XOR); } 438 ; 439 440simple_exp : simple_exp TICK_ACCESS 441 { write_exp_elt_opcode (UNOP_ADDR); } 442 | simple_exp TICK_ADDRESS 443 { write_exp_elt_opcode (UNOP_ADDR); 444 write_exp_elt_opcode (UNOP_CAST); 445 write_exp_elt_type (type_system_address ()); 446 write_exp_elt_opcode (UNOP_CAST); 447 } 448 | simple_exp TICK_FIRST tick_arglist 449 { write_int ($3, type_int ()); 450 write_exp_elt_opcode (OP_ATR_FIRST); } 451 | simple_exp TICK_LAST tick_arglist 452 { write_int ($3, type_int ()); 453 write_exp_elt_opcode (OP_ATR_LAST); } 454 | simple_exp TICK_LENGTH tick_arglist 455 { write_int ($3, type_int ()); 456 write_exp_elt_opcode (OP_ATR_LENGTH); } 457 | simple_exp TICK_SIZE 458 { write_exp_elt_opcode (OP_ATR_SIZE); } 459 | simple_exp TICK_TAG 460 { write_exp_elt_opcode (OP_ATR_TAG); } 461 | opt_type_prefix TICK_MIN '(' exp ',' exp ')' 462 { write_exp_elt_opcode (OP_ATR_MIN); } 463 | opt_type_prefix TICK_MAX '(' exp ',' exp ')' 464 { write_exp_elt_opcode (OP_ATR_MAX); } 465 | opt_type_prefix TICK_POS '(' exp ')' 466 { write_exp_elt_opcode (OP_ATR_POS); } 467 | type_prefix TICK_FIRST tick_arglist 468 { write_int ($3, type_int ()); 469 write_exp_elt_opcode (OP_ATR_FIRST); } 470 | type_prefix TICK_LAST tick_arglist 471 { write_int ($3, type_int ()); 472 write_exp_elt_opcode (OP_ATR_LAST); } 473 | type_prefix TICK_LENGTH tick_arglist 474 { write_int ($3, type_int ()); 475 write_exp_elt_opcode (OP_ATR_LENGTH); } 476 | type_prefix TICK_VAL '(' exp ')' 477 { write_exp_elt_opcode (OP_ATR_VAL); } 478 | type_prefix TICK_MODULUS 479 { write_exp_elt_opcode (OP_ATR_MODULUS); } 480 ; 481 482tick_arglist : %prec '(' 483 { $$ = 1; } 484 | '(' INT ')' 485 { $$ = $2.val; } 486 ; 487 488type_prefix : 489 TYPENAME 490 { write_exp_elt_opcode (OP_TYPE); 491 write_exp_elt_type ($1); 492 write_exp_elt_opcode (OP_TYPE); } 493 ; 494 495opt_type_prefix : 496 type_prefix 497 | /* EMPTY */ 498 { write_exp_elt_opcode (OP_TYPE); 499 write_exp_elt_type (builtin_type_void); 500 write_exp_elt_opcode (OP_TYPE); } 501 ; 502 503 504exp : INT 505 { write_int ((LONGEST) $1.val, $1.type); } 506 ; 507 508exp : CHARLIT 509 { write_int (convert_char_literal (type_qualifier, $1.val), 510 (type_qualifier == NULL) 511 ? $1.type : type_qualifier); 512 } 513 ; 514 515exp : FLOAT 516 { write_exp_elt_opcode (OP_DOUBLE); 517 write_exp_elt_type ($1.type); 518 write_exp_elt_dblcst ($1.dval); 519 write_exp_elt_opcode (OP_DOUBLE); 520 } 521 ; 522 523exp : NULL_PTR 524 { write_int (0, type_int ()); } 525 ; 526 527exp : STRING 528 { 529 write_exp_elt_opcode (OP_STRING); 530 write_exp_string ($1); 531 write_exp_elt_opcode (OP_STRING); 532 } 533 ; 534 535exp : NEW TYPENAME 536 { error ("NEW not implemented."); } 537 ; 538 539variable: NAME { write_var_from_name (NULL, $1); } 540 | block NAME /* GDB extension */ 541 { write_var_from_name ($1, $2); } 542 | OBJECT_RENAMING 543 { write_object_renaming (NULL, $1.sym, 544 MAX_RENAMING_CHAIN_LENGTH); } 545 | block OBJECT_RENAMING 546 { write_object_renaming ($1, $2.sym, 547 MAX_RENAMING_CHAIN_LENGTH); } 548 ; 549 550any_name : NAME { } 551 | TYPENAME { } 552 | OBJECT_RENAMING { } 553 ; 554 555block : BLOCKNAME /* GDB extension */ 556 { $$ = $1; } 557 | block BLOCKNAME /* GDB extension */ 558 { $$ = $2; } 559 ; 560 561 562type : TYPENAME { $$ = $1; } 563 | block TYPENAME { $$ = $2; } 564 | TYPENAME TICK_ACCESS 565 { $$ = lookup_pointer_type ($1); } 566 | block TYPENAME TICK_ACCESS 567 { $$ = lookup_pointer_type ($2); } 568 ; 569 570/* Some extensions borrowed from C, for the benefit of those who find they 571 can't get used to Ada notation in GDB. */ 572 573exp : '*' exp %prec '.' 574 { write_exp_elt_opcode (UNOP_IND); } 575 | '&' exp %prec '.' 576 { write_exp_elt_opcode (UNOP_ADDR); } 577 | exp '[' exp ']' 578 { write_exp_elt_opcode (BINOP_SUBSCRIPT); } 579 ; 580 581%% 582 583/* yylex defined in ada-lex.c: Reads one token, getting characters */ 584/* through lexptr. */ 585 586/* Remap normal flex interface names (yylex) as well as gratuitiously */ 587/* global symbol names, so we can have multiple flex-generated parsers */ 588/* in gdb. */ 589 590/* (See note above on previous definitions for YACC.) */ 591 592#define yy_create_buffer ada_yy_create_buffer 593#define yy_delete_buffer ada_yy_delete_buffer 594#define yy_init_buffer ada_yy_init_buffer 595#define yy_load_buffer_state ada_yy_load_buffer_state 596#define yy_switch_to_buffer ada_yy_switch_to_buffer 597#define yyrestart ada_yyrestart 598#define yytext ada_yytext 599#define yywrap ada_yywrap 600 601static struct obstack temp_parse_space; 602 603/* The following kludge was found necessary to prevent conflicts between */ 604/* defs.h and non-standard stdlib.h files. */ 605#define qsort __qsort__dummy 606#include "ada-lex.c" 607 608int 609ada_parse (void) 610{ 611 lexer_init (yyin); /* (Re-)initialize lexer. */ 612 left_block_context = NULL; 613 type_qualifier = NULL; 614 obstack_free (&temp_parse_space, NULL); 615 obstack_init (&temp_parse_space); 616 617 return _ada_parse (); 618} 619 620void 621yyerror (char *msg) 622{ 623 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr); 624} 625 626/* The operator name corresponding to operator symbol STRING (adds 627 quotes and maps to lower-case). Destroys the previous contents of 628 the array pointed to by STRING.ptr. Error if STRING does not match 629 a valid Ada operator. Assumes that STRING.ptr points to a 630 null-terminated string and that, if STRING is a valid operator 631 symbol, the array pointed to by STRING.ptr contains at least 632 STRING.length+3 characters. */ 633 634static struct stoken 635string_to_operator (struct stoken string) 636{ 637 int i; 638 639 for (i = 0; ada_opname_table[i].encoded != NULL; i += 1) 640 { 641 if (string.length == strlen (ada_opname_table[i].decoded)-2 642 && strncasecmp (string.ptr, ada_opname_table[i].decoded+1, 643 string.length) == 0) 644 { 645 strncpy (string.ptr, ada_opname_table[i].decoded, 646 string.length+2); 647 string.length += 2; 648 return string; 649 } 650 } 651 error ("Invalid operator symbol `%s'", string.ptr); 652} 653 654/* Emit expression to access an instance of SYM, in block BLOCK (if 655 * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */ 656static void 657write_var_from_sym (struct block *orig_left_context, 658 struct block *block, 659 struct symbol *sym) 660{ 661 if (orig_left_context == NULL && symbol_read_needs_frame (sym)) 662 { 663 if (innermost_block == 0 664 || contained_in (block, innermost_block)) 665 innermost_block = block; 666 } 667 668 write_exp_elt_opcode (OP_VAR_VALUE); 669 write_exp_elt_block (block); 670 write_exp_elt_sym (sym); 671 write_exp_elt_opcode (OP_VAR_VALUE); 672} 673 674/* Emit expression to access an instance of NAME in :: context 675 * ORIG_LEFT_CONTEXT. If no unique symbol for NAME has been found, 676 * output a dummy symbol (good to the next call of ada_parse) for NAME 677 * in the UNDEF_DOMAIN, for later resolution by ada_resolve. */ 678static void 679write_var_from_name (struct block *orig_left_context, 680 struct name_info name) 681{ 682 if (name.msym != NULL) 683 { 684 write_exp_msymbol (name.msym, 685 lookup_function_type (type_int ()), 686 type_int ()); 687 } 688 else if (name.sym == NULL) 689 { 690 /* Multiple matches: record name and starting block for later 691 resolution by ada_resolve. */ 692 char *encoded_name = ada_encode (name.stoken.ptr); 693 struct symbol *sym = 694 obstack_alloc (&temp_parse_space, sizeof (struct symbol)); 695 memset (sym, 0, sizeof (struct symbol)); 696 SYMBOL_DOMAIN (sym) = UNDEF_DOMAIN; 697 SYMBOL_LINKAGE_NAME (sym) 698 = obsavestring (encoded_name, strlen (encoded_name), &temp_parse_space); 699 SYMBOL_LANGUAGE (sym) = language_ada; 700 701 write_exp_elt_opcode (OP_VAR_VALUE); 702 write_exp_elt_block (name.block); 703 write_exp_elt_sym (sym); 704 write_exp_elt_opcode (OP_VAR_VALUE); 705 } 706 else 707 write_var_from_sym (orig_left_context, name.block, name.sym); 708} 709 710/* Write integer constant ARG of type TYPE. */ 711 712static void 713write_int (LONGEST arg, struct type *type) 714{ 715 write_exp_elt_opcode (OP_LONG); 716 write_exp_elt_type (type); 717 write_exp_elt_longcst (arg); 718 write_exp_elt_opcode (OP_LONG); 719} 720 721/* Emit expression corresponding to the renamed object designated by 722 * the type RENAMING, which must be the referent of an object renaming 723 * type, in the context of ORIG_LEFT_CONTEXT. MAX_DEPTH is the maximum 724 * number of cascaded renamings to allow. */ 725static void 726write_object_renaming (struct block *orig_left_context, 727 struct symbol *renaming, int max_depth) 728{ 729 const char *qualification = SYMBOL_LINKAGE_NAME (renaming); 730 const char *simple_tail; 731 const char *expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0); 732 const char *suffix; 733 char *name; 734 struct symbol *sym; 735 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state; 736 737 if (max_depth <= 0) 738 error ("Could not find renamed symbol"); 739 740 /* if orig_left_context is null, then use the currently selected 741 block; otherwise we might fail our symbol lookup below. */ 742 if (orig_left_context == NULL) 743 orig_left_context = get_selected_block (NULL); 744 745 for (simple_tail = qualification + strlen (qualification); 746 simple_tail != qualification; simple_tail -= 1) 747 { 748 if (*simple_tail == '.') 749 { 750 simple_tail += 1; 751 break; 752 } 753 else if (strncmp (simple_tail, "__", 2) == 0) 754 { 755 simple_tail += 2; 756 break; 757 } 758 } 759 760 suffix = strstr (expr, "___XE"); 761 if (suffix == NULL) 762 goto BadEncoding; 763 764 name = (char *) obstack_alloc (&temp_parse_space, suffix - expr + 1); 765 strncpy (name, expr, suffix-expr); 766 name[suffix-expr] = '\000'; 767 sym = lookup_symbol (name, orig_left_context, VAR_DOMAIN, 0, NULL); 768 if (sym == NULL) 769 error ("Could not find renamed variable: %s", ada_decode (name)); 770 if (ada_is_object_renaming (sym)) 771 write_object_renaming (orig_left_context, sym, max_depth-1); 772 else 773 write_var_from_sym (orig_left_context, block_found, sym); 774 775 suffix += 5; 776 slice_state = SIMPLE_INDEX; 777 while (*suffix == 'X') 778 { 779 suffix += 1; 780 781 switch (*suffix) { 782 case 'A': 783 suffix += 1; 784 write_exp_elt_opcode (UNOP_IND); 785 break; 786 case 'L': 787 slice_state = LOWER_BOUND; 788 case 'S': 789 suffix += 1; 790 if (isdigit (*suffix)) 791 { 792 char *next; 793 long val = strtol (suffix, &next, 10); 794 if (next == suffix) 795 goto BadEncoding; 796 suffix = next; 797 write_exp_elt_opcode (OP_LONG); 798 write_exp_elt_type (type_int ()); 799 write_exp_elt_longcst ((LONGEST) val); 800 write_exp_elt_opcode (OP_LONG); 801 } 802 else 803 { 804 const char *end; 805 char *index_name; 806 int index_len; 807 struct symbol *index_sym; 808 809 end = strchr (suffix, 'X'); 810 if (end == NULL) 811 end = suffix + strlen (suffix); 812 813 index_len = simple_tail - qualification + 2 + (suffix - end) + 1; 814 index_name 815 = (char *) obstack_alloc (&temp_parse_space, index_len); 816 memset (index_name, '\000', index_len); 817 strncpy (index_name, qualification, simple_tail - qualification); 818 index_name[simple_tail - qualification] = '\000'; 819 strncat (index_name, suffix, suffix-end); 820 suffix = end; 821 822 index_sym = 823 lookup_symbol (index_name, NULL, VAR_DOMAIN, 0, NULL); 824 if (index_sym == NULL) 825 error ("Could not find %s", index_name); 826 write_var_from_sym (NULL, block_found, sym); 827 } 828 if (slice_state == SIMPLE_INDEX) 829 { 830 write_exp_elt_opcode (OP_FUNCALL); 831 write_exp_elt_longcst ((LONGEST) 1); 832 write_exp_elt_opcode (OP_FUNCALL); 833 } 834 else if (slice_state == LOWER_BOUND) 835 slice_state = UPPER_BOUND; 836 else if (slice_state == UPPER_BOUND) 837 { 838 write_exp_elt_opcode (TERNOP_SLICE); 839 slice_state = SIMPLE_INDEX; 840 } 841 break; 842 843 case 'R': 844 { 845 struct stoken field_name; 846 const char *end; 847 suffix += 1; 848 849 if (slice_state != SIMPLE_INDEX) 850 goto BadEncoding; 851 end = strchr (suffix, 'X'); 852 if (end == NULL) 853 end = suffix + strlen (suffix); 854 field_name.length = end - suffix; 855 field_name.ptr = xmalloc (end - suffix + 1); 856 strncpy (field_name.ptr, suffix, end - suffix); 857 field_name.ptr[end - suffix] = '\000'; 858 suffix = end; 859 write_exp_elt_opcode (STRUCTOP_STRUCT); 860 write_exp_string (field_name); 861 write_exp_elt_opcode (STRUCTOP_STRUCT); 862 break; 863 } 864 865 default: 866 goto BadEncoding; 867 } 868 } 869 if (slice_state == SIMPLE_INDEX) 870 return; 871 872 BadEncoding: 873 error ("Internal error in encoding of renaming declaration: %s", 874 SYMBOL_LINKAGE_NAME (renaming)); 875} 876 877/* Convert the character literal whose ASCII value would be VAL to the 878 appropriate value of type TYPE, if there is a translation. 879 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'), 880 the literal 'A' (VAL == 65), returns 0. */ 881static LONGEST 882convert_char_literal (struct type *type, LONGEST val) 883{ 884 char name[7]; 885 int f; 886 887 if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM) 888 return val; 889 sprintf (name, "QU%02x", (int) val); 890 for (f = 0; f < TYPE_NFIELDS (type); f += 1) 891 { 892 if (strcmp (name, TYPE_FIELD_NAME (type, f)) == 0) 893 return TYPE_FIELD_BITPOS (type, f); 894 } 895 return val; 896} 897 898static struct type * 899type_int (void) 900{ 901 return builtin_type (current_gdbarch)->builtin_int; 902} 903 904static struct type * 905type_long (void) 906{ 907 return builtin_type (current_gdbarch)->builtin_long; 908} 909 910static struct type * 911type_long_long (void) 912{ 913 return builtin_type (current_gdbarch)->builtin_long_long; 914} 915 916static struct type * 917type_float (void) 918{ 919 return builtin_type (current_gdbarch)->builtin_float; 920} 921 922static struct type * 923type_double (void) 924{ 925 return builtin_type (current_gdbarch)->builtin_double; 926} 927 928static struct type * 929type_long_double (void) 930{ 931 return builtin_type (current_gdbarch)->builtin_long_double; 932} 933 934static struct type * 935type_char (void) 936{ 937 return language_string_char_type (current_language, current_gdbarch); 938} 939 940static struct type * 941type_system_address (void) 942{ 943 struct type *type 944 = language_lookup_primitive_type_by_name (current_language, 945 current_gdbarch, 946 "system__address"); 947 return type != NULL ? type : lookup_pointer_type (builtin_type_void); 948} 949 950void 951_initialize_ada_exp (void) 952{ 953 obstack_init (&temp_parse_space); 954} 955 956/* FIXME: hilfingr/2004-10-05: Hack to remove warning. The function 957 string_to_operator is supposed to be used for cases where one 958 calls an operator function with prefix notation, as in 959 "+" (a, b), but at some point, this code seems to have gone 960 missing. */ 961 962struct stoken (*dummy_string_to_ada_operator) (struct stoken) 963 = string_to_operator; 964 965