1/* YACC parser for Ada expressions, for GDB. 2 Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000, 2003 3 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 <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_attribute_call0 (enum ada_attribute); 123 124static void write_attribute_call1 (enum ada_attribute, LONGEST); 125 126static void write_attribute_calln (enum ada_attribute, int); 127 128static void write_object_renaming (struct block*, struct symbol*); 129 130static void write_var_from_name (struct block*, struct name_info); 131 132static LONGEST 133convert_char_literal (struct type*, LONGEST); 134%} 135 136%union 137 { 138 LONGEST lval; 139 struct { 140 LONGEST val; 141 struct type *type; 142 } typed_val; 143 struct { 144 DOUBLEST dval; 145 struct type *type; 146 } typed_val_float; 147 struct type *tval; 148 struct stoken sval; 149 struct name_info ssym; 150 int voidval; 151 struct block *bval; 152 struct internalvar *ivar; 153 154 } 155 156%type <voidval> exp exp1 simple_exp start variable 157%type <tval> type 158 159%token <typed_val> INT NULL_PTR CHARLIT 160%token <typed_val_float> FLOAT 161%token <tval> TYPENAME 162%token <bval> BLOCKNAME 163 164/* Both NAME and TYPENAME tokens represent symbols in the input, 165 and both convey their data as strings. 166 But a TYPENAME is a string that happens to be defined as a typedef 167 or builtin type name (such as int or char) 168 and a NAME is any other symbol. 169 Contexts where this distinction is not important can use the 170 nonterminal "name", which matches either NAME or TYPENAME. */ 171 172%token <sval> STRING 173%token <ssym> NAME DOT_ID OBJECT_RENAMING 174%type <bval> block 175%type <lval> arglist tick_arglist 176 177%type <tval> save_qualifier 178 179%token DOT_ALL 180 181/* Special type cases, put in to allow the parser to distinguish different 182 legal basetypes. */ 183%token <lval> LAST REGNAME 184 185%token <ivar> INTERNAL_VARIABLE 186 187%nonassoc ASSIGN 188%left _AND_ OR XOR THEN ELSE 189%left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT 190%left '@' 191%left '+' '-' '&' 192%left UNARY 193%left '*' '/' MOD REM 194%right STARSTAR ABS NOT 195 /* The following are right-associative only so that reductions at this 196 precedence have lower precedence than '.' and '('. The syntax still 197 forces a.b.c, e.g., to be LEFT-associated. */ 198%right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH 199%right TICK_MAX TICK_MIN TICK_MODULUS 200%right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL 201%right '.' '(' '[' DOT_ID DOT_ALL 202 203%token ARROW NEW 204 205 206%% 207 208start : exp1 209 | type { write_exp_elt_opcode (OP_TYPE); 210 write_exp_elt_type ($1); 211 write_exp_elt_opcode (OP_TYPE); } 212 ; 213 214/* Expressions, including the sequencing operator. */ 215exp1 : exp 216 | exp1 ';' exp 217 { write_exp_elt_opcode (BINOP_COMMA); } 218 ; 219 220/* Expressions, not including the sequencing operator. */ 221simple_exp : simple_exp DOT_ALL 222 { write_exp_elt_opcode (UNOP_IND); } 223 ; 224 225simple_exp : simple_exp DOT_ID 226 { write_exp_elt_opcode (STRUCTOP_STRUCT); 227 write_exp_string ($2.stoken); 228 write_exp_elt_opcode (STRUCTOP_STRUCT); 229 } 230 ; 231 232simple_exp : simple_exp '(' arglist ')' 233 { 234 write_exp_elt_opcode (OP_FUNCALL); 235 write_exp_elt_longcst ($3); 236 write_exp_elt_opcode (OP_FUNCALL); 237 } 238 ; 239 240simple_exp : type '(' exp ')' 241 { 242 write_exp_elt_opcode (UNOP_CAST); 243 write_exp_elt_type ($1); 244 write_exp_elt_opcode (UNOP_CAST); 245 } 246 ; 247 248simple_exp : type '\'' save_qualifier { type_qualifier = $1; } '(' exp ')' 249 { 250 /* write_exp_elt_opcode (UNOP_QUAL); */ 251 /* FIXME: UNOP_QUAL should be defined in expression.h */ 252 write_exp_elt_type ($1); 253 /* write_exp_elt_opcode (UNOP_QUAL); */ 254 /* FIXME: UNOP_QUAL should be defined in expression.h */ 255 type_qualifier = $3; 256 } 257 ; 258 259save_qualifier : { $$ = type_qualifier; } 260 ; 261 262simple_exp : 263 simple_exp '(' exp DOTDOT exp ')' 264 { write_exp_elt_opcode (TERNOP_SLICE); } 265 ; 266 267simple_exp : '(' exp1 ')' { } 268 ; 269 270simple_exp : variable 271 ; 272 273simple_exp: REGNAME /* GDB extension */ 274 { write_exp_elt_opcode (OP_REGISTER); 275 write_exp_elt_longcst ((LONGEST) $1); 276 write_exp_elt_opcode (OP_REGISTER); 277 } 278 ; 279 280simple_exp: INTERNAL_VARIABLE /* GDB extension */ 281 { write_exp_elt_opcode (OP_INTERNALVAR); 282 write_exp_elt_intern ($1); 283 write_exp_elt_opcode (OP_INTERNALVAR); 284 } 285 ; 286 287 288exp : simple_exp 289 ; 290 291simple_exp: LAST 292 { write_exp_elt_opcode (OP_LAST); 293 write_exp_elt_longcst ((LONGEST) $1); 294 write_exp_elt_opcode (OP_LAST); 295 } 296 ; 297 298exp : exp ASSIGN exp /* Extension for convenience */ 299 { write_exp_elt_opcode (BINOP_ASSIGN); } 300 ; 301 302exp : '-' exp %prec UNARY 303 { write_exp_elt_opcode (UNOP_NEG); } 304 ; 305 306exp : '+' exp %prec UNARY 307 { write_exp_elt_opcode (UNOP_PLUS); } 308 ; 309 310exp : NOT exp %prec UNARY 311 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } 312 ; 313 314exp : ABS exp %prec UNARY 315 { write_exp_elt_opcode (UNOP_ABS); } 316 ; 317 318arglist : { $$ = 0; } 319 ; 320 321arglist : exp 322 { $$ = 1; } 323 | any_name ARROW exp 324 { $$ = 1; } 325 | arglist ',' exp 326 { $$ = $1 + 1; } 327 | arglist ',' any_name ARROW exp 328 { $$ = $1 + 1; } 329 ; 330 331exp : '{' type '}' exp %prec '.' 332 /* GDB extension */ 333 { write_exp_elt_opcode (UNOP_MEMVAL); 334 write_exp_elt_type ($2); 335 write_exp_elt_opcode (UNOP_MEMVAL); 336 } 337 ; 338 339/* Binary operators in order of decreasing precedence. */ 340 341exp : exp STARSTAR exp 342 { write_exp_elt_opcode (BINOP_EXP); } 343 ; 344 345exp : exp '*' exp 346 { write_exp_elt_opcode (BINOP_MUL); } 347 ; 348 349exp : exp '/' exp 350 { write_exp_elt_opcode (BINOP_DIV); } 351 ; 352 353exp : exp REM exp /* May need to be fixed to give correct Ada REM */ 354 { write_exp_elt_opcode (BINOP_REM); } 355 ; 356 357exp : exp MOD exp 358 { write_exp_elt_opcode (BINOP_MOD); } 359 ; 360 361exp : exp '@' exp /* GDB extension */ 362 { write_exp_elt_opcode (BINOP_REPEAT); } 363 ; 364 365exp : exp '+' exp 366 { write_exp_elt_opcode (BINOP_ADD); } 367 ; 368 369exp : exp '&' exp 370 { write_exp_elt_opcode (BINOP_CONCAT); } 371 ; 372 373exp : exp '-' exp 374 { write_exp_elt_opcode (BINOP_SUB); } 375 ; 376 377exp : exp '=' exp 378 { write_exp_elt_opcode (BINOP_EQUAL); } 379 ; 380 381exp : exp NOTEQUAL exp 382 { write_exp_elt_opcode (BINOP_NOTEQUAL); } 383 ; 384 385exp : exp LEQ exp 386 { write_exp_elt_opcode (BINOP_LEQ); } 387 ; 388 389exp : exp IN exp DOTDOT exp 390 { /*write_exp_elt_opcode (TERNOP_MBR); */ } 391 /* FIXME: TERNOP_MBR should be defined in 392 expression.h */ 393 | exp IN exp TICK_RANGE tick_arglist 394 { /*write_exp_elt_opcode (BINOP_MBR); */ 395 /* FIXME: BINOP_MBR should be defined in expression.h */ 396 write_exp_elt_longcst ((LONGEST) $5); 397 /*write_exp_elt_opcode (BINOP_MBR); */ 398 } 399 | exp IN TYPENAME %prec TICK_ACCESS 400 { /*write_exp_elt_opcode (UNOP_MBR); */ 401 /* FIXME: UNOP_QUAL should be defined in expression.h */ 402 write_exp_elt_type ($3); 403 /* write_exp_elt_opcode (UNOP_MBR); */ 404 /* FIXME: UNOP_MBR should be defined in expression.h */ 405 } 406 | exp NOT IN exp DOTDOT exp 407 { /*write_exp_elt_opcode (TERNOP_MBR); */ 408 /* FIXME: TERNOP_MBR should be defined in expression.h */ 409 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 410 } 411 | exp NOT IN exp TICK_RANGE tick_arglist 412 { /* write_exp_elt_opcode (BINOP_MBR); */ 413 /* FIXME: BINOP_MBR should be defined in expression.h */ 414 write_exp_elt_longcst ((LONGEST) $6); 415 /*write_exp_elt_opcode (BINOP_MBR);*/ 416 /* FIXME: BINOP_MBR should be defined in expression.h */ 417 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 418 } 419 | exp NOT IN TYPENAME %prec TICK_ACCESS 420 { /*write_exp_elt_opcode (UNOP_MBR);*/ 421 /* FIXME: UNOP_MBR should be defined in expression.h */ 422 write_exp_elt_type ($4); 423 /* write_exp_elt_opcode (UNOP_MBR);*/ 424 /* FIXME: UNOP_MBR should be defined in expression.h */ 425 write_exp_elt_opcode (UNOP_LOGICAL_NOT); 426 } 427 ; 428 429exp : exp GEQ exp 430 { write_exp_elt_opcode (BINOP_GEQ); } 431 ; 432 433exp : exp '<' exp 434 { write_exp_elt_opcode (BINOP_LESS); } 435 ; 436 437exp : exp '>' exp 438 { write_exp_elt_opcode (BINOP_GTR); } 439 ; 440 441exp : exp _AND_ exp /* Fix for Ada elementwise AND. */ 442 { write_exp_elt_opcode (BINOP_BITWISE_AND); } 443 ; 444 445exp : exp _AND_ THEN exp %prec _AND_ 446 { write_exp_elt_opcode (BINOP_LOGICAL_AND); } 447 ; 448 449exp : exp OR exp /* Fix for Ada elementwise OR */ 450 { write_exp_elt_opcode (BINOP_BITWISE_IOR); } 451 ; 452 453exp : exp OR ELSE exp 454 { write_exp_elt_opcode (BINOP_LOGICAL_OR); } 455 ; 456 457exp : exp XOR exp /* Fix for Ada elementwise XOR */ 458 { write_exp_elt_opcode (BINOP_BITWISE_XOR); } 459 ; 460 461simple_exp : simple_exp TICK_ACCESS 462 { write_exp_elt_opcode (UNOP_ADDR); } 463 | simple_exp TICK_ADDRESS 464 { write_exp_elt_opcode (UNOP_ADDR); 465 write_exp_elt_opcode (UNOP_CAST); 466 write_exp_elt_type (builtin_type_ada_system_address); 467 write_exp_elt_opcode (UNOP_CAST); 468 } 469 | simple_exp TICK_FIRST tick_arglist 470 { write_attribute_call1 (ATR_FIRST, $3); } 471 | simple_exp TICK_LAST tick_arglist 472 { write_attribute_call1 (ATR_LAST, $3); } 473 | simple_exp TICK_LENGTH tick_arglist 474 { write_attribute_call1 (ATR_LENGTH, $3); } 475 | simple_exp TICK_SIZE 476 { write_attribute_call0 (ATR_SIZE); } 477 | simple_exp TICK_TAG 478 { write_attribute_call0 (ATR_TAG); } 479 | opt_type_prefix TICK_MIN '(' exp ',' exp ')' 480 { write_attribute_calln (ATR_MIN, 2); } 481 | opt_type_prefix TICK_MAX '(' exp ',' exp ')' 482 { write_attribute_calln (ATR_MAX, 2); } 483 | opt_type_prefix TICK_POS '(' exp ')' 484 { write_attribute_calln (ATR_POS, 1); } 485 | type_prefix TICK_FIRST tick_arglist 486 { write_attribute_call1 (ATR_FIRST, $3); } 487 | type_prefix TICK_LAST tick_arglist 488 { write_attribute_call1 (ATR_LAST, $3); } 489 | type_prefix TICK_LENGTH tick_arglist 490 { write_attribute_call1 (ATR_LENGTH, $3); } 491 | type_prefix TICK_VAL '(' exp ')' 492 { write_attribute_calln (ATR_VAL, 1); } 493 | type_prefix TICK_MODULUS 494 { write_attribute_call0 (ATR_MODULUS); } 495 ; 496 497tick_arglist : %prec '(' 498 { $$ = 1; } 499 | '(' INT ')' 500 { $$ = $2.val; } 501 ; 502 503type_prefix : 504 TYPENAME 505 { write_exp_elt_opcode (OP_TYPE); 506 write_exp_elt_type ($1); 507 write_exp_elt_opcode (OP_TYPE); } 508 ; 509 510opt_type_prefix : 511 type_prefix 512 | /* EMPTY */ 513 { write_exp_elt_opcode (OP_TYPE); 514 write_exp_elt_type (builtin_type_void); 515 write_exp_elt_opcode (OP_TYPE); } 516 ; 517 518 519exp : INT 520 { write_exp_elt_opcode (OP_LONG); 521 write_exp_elt_type ($1.type); 522 write_exp_elt_longcst ((LONGEST)($1.val)); 523 write_exp_elt_opcode (OP_LONG); 524 } 525 ; 526 527exp : CHARLIT 528 { write_exp_elt_opcode (OP_LONG); 529 if (type_qualifier == NULL) 530 write_exp_elt_type ($1.type); 531 else 532 write_exp_elt_type (type_qualifier); 533 write_exp_elt_longcst 534 (convert_char_literal (type_qualifier, $1.val)); 535 write_exp_elt_opcode (OP_LONG); 536 } 537 ; 538 539exp : FLOAT 540 { write_exp_elt_opcode (OP_DOUBLE); 541 write_exp_elt_type ($1.type); 542 write_exp_elt_dblcst ($1.dval); 543 write_exp_elt_opcode (OP_DOUBLE); 544 } 545 ; 546 547exp : NULL_PTR 548 { write_exp_elt_opcode (OP_LONG); 549 write_exp_elt_type (builtin_type_int); 550 write_exp_elt_longcst ((LONGEST)(0)); 551 write_exp_elt_opcode (OP_LONG); 552 } 553 ; 554 555exp : STRING 556 { /* Ada strings are converted into array constants 557 a lower bound of 1. Thus, the array upper bound 558 is the string length. */ 559 char *sp = $1.ptr; int count; 560 if ($1.length == 0) 561 { /* One dummy character for the type */ 562 write_exp_elt_opcode (OP_LONG); 563 write_exp_elt_type (builtin_type_ada_char); 564 write_exp_elt_longcst ((LONGEST)(0)); 565 write_exp_elt_opcode (OP_LONG); 566 } 567 for (count = $1.length; count > 0; count -= 1) 568 { 569 write_exp_elt_opcode (OP_LONG); 570 write_exp_elt_type (builtin_type_ada_char); 571 write_exp_elt_longcst ((LONGEST)(*sp)); 572 sp += 1; 573 write_exp_elt_opcode (OP_LONG); 574 } 575 write_exp_elt_opcode (OP_ARRAY); 576 write_exp_elt_longcst ((LONGEST) 1); 577 write_exp_elt_longcst ((LONGEST) ($1.length)); 578 write_exp_elt_opcode (OP_ARRAY); 579 } 580 ; 581 582exp : NEW TYPENAME 583 { error ("NEW not implemented."); } 584 ; 585 586variable: NAME { write_var_from_name (NULL, $1); } 587 | block NAME /* GDB extension */ 588 { write_var_from_name ($1, $2); } 589 | OBJECT_RENAMING { write_object_renaming (NULL, $1.sym); } 590 | block OBJECT_RENAMING 591 { write_object_renaming ($1, $2.sym); } 592 ; 593 594any_name : NAME { } 595 | TYPENAME { } 596 | OBJECT_RENAMING { } 597 ; 598 599block : BLOCKNAME /* GDB extension */ 600 { $$ = $1; } 601 | block BLOCKNAME /* GDB extension */ 602 { $$ = $2; } 603 ; 604 605 606type : TYPENAME { $$ = $1; } 607 | block TYPENAME { $$ = $2; } 608 | TYPENAME TICK_ACCESS 609 { $$ = lookup_pointer_type ($1); } 610 | block TYPENAME TICK_ACCESS 611 { $$ = lookup_pointer_type ($2); } 612 ; 613 614/* Some extensions borrowed from C, for the benefit of those who find they 615 can't get used to Ada notation in GDB. */ 616 617exp : '*' exp %prec '.' 618 { write_exp_elt_opcode (UNOP_IND); } 619 | '&' exp %prec '.' 620 { write_exp_elt_opcode (UNOP_ADDR); } 621 | exp '[' exp ']' 622 { write_exp_elt_opcode (BINOP_SUBSCRIPT); } 623 ; 624 625%% 626 627/* yylex defined in ada-lex.c: Reads one token, getting characters */ 628/* through lexptr. */ 629 630/* Remap normal flex interface names (yylex) as well as gratuitiously */ 631/* global symbol names, so we can have multiple flex-generated parsers */ 632/* in gdb. */ 633 634/* (See note above on previous definitions for YACC.) */ 635 636#define yy_create_buffer ada_yy_create_buffer 637#define yy_delete_buffer ada_yy_delete_buffer 638#define yy_init_buffer ada_yy_init_buffer 639#define yy_load_buffer_state ada_yy_load_buffer_state 640#define yy_switch_to_buffer ada_yy_switch_to_buffer 641#define yyrestart ada_yyrestart 642#define yytext ada_yytext 643#define yywrap ada_yywrap 644 645/* The following kludge was found necessary to prevent conflicts between */ 646/* defs.h and non-standard stdlib.h files. */ 647#define qsort __qsort__dummy 648#include "ada-lex.c" 649 650int 651ada_parse () 652{ 653 lexer_init (yyin); /* (Re-)initialize lexer. */ 654 left_block_context = NULL; 655 type_qualifier = NULL; 656 657 return _ada_parse (); 658} 659 660void 661yyerror (msg) 662 char *msg; 663{ 664 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr); 665} 666 667/* The operator name corresponding to operator symbol STRING (adds 668 quotes and maps to lower-case). Destroys the previous contents of 669 the array pointed to by STRING.ptr. Error if STRING does not match 670 a valid Ada operator. Assumes that STRING.ptr points to a 671 null-terminated string and that, if STRING is a valid operator 672 symbol, the array pointed to by STRING.ptr contains at least 673 STRING.length+3 characters. */ 674 675static struct stoken 676string_to_operator (string) 677 struct stoken string; 678{ 679 int i; 680 681 for (i = 0; ada_opname_table[i].mangled != NULL; i += 1) 682 { 683 if (string.length == strlen (ada_opname_table[i].demangled)-2 684 && strncasecmp (string.ptr, ada_opname_table[i].demangled+1, 685 string.length) == 0) 686 { 687 strncpy (string.ptr, ada_opname_table[i].demangled, 688 string.length+2); 689 string.length += 2; 690 return string; 691 } 692 } 693 error ("Invalid operator symbol `%s'", string.ptr); 694} 695 696/* Emit expression to access an instance of SYM, in block BLOCK (if 697 * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */ 698static void 699write_var_from_sym (orig_left_context, block, sym) 700 struct block* orig_left_context; 701 struct block* block; 702 struct symbol* sym; 703{ 704 if (orig_left_context == NULL && symbol_read_needs_frame (sym)) 705 { 706 if (innermost_block == 0 || 707 contained_in (block, innermost_block)) 708 innermost_block = block; 709 } 710 711 write_exp_elt_opcode (OP_VAR_VALUE); 712 /* We want to use the selected frame, not another more inner frame 713 which happens to be in the same block */ 714 write_exp_elt_block (NULL); 715 write_exp_elt_sym (sym); 716 write_exp_elt_opcode (OP_VAR_VALUE); 717} 718 719/* Emit expression to access an instance of NAME. */ 720static void 721write_var_from_name (orig_left_context, name) 722 struct block* orig_left_context; 723 struct name_info name; 724{ 725 if (name.msym != NULL) 726 { 727 write_exp_msymbol (name.msym, 728 lookup_function_type (builtin_type_int), 729 builtin_type_int); 730 } 731 else if (name.sym == NULL) 732 { 733 /* Multiple matches: record name and starting block for later 734 resolution by ada_resolve. */ 735 /* write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */ 736 /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ 737 write_exp_elt_block (name.block); 738 /* write_exp_elt_name (name.stoken.ptr); */ 739 /* FIXME: write_exp_elt_name should be defined in defs.h, located in parse.c */ 740 /* write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */ 741 /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ 742 } 743 else 744 write_var_from_sym (orig_left_context, name.block, name.sym); 745} 746 747/* Write a call on parameterless attribute ATR. */ 748 749static void 750write_attribute_call0 (atr) 751 enum ada_attribute atr; 752{ 753 /* write_exp_elt_opcode (OP_ATTRIBUTE); */ 754 /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ 755 write_exp_elt_longcst ((LONGEST) 0); 756 write_exp_elt_longcst ((LONGEST) atr); 757 /* write_exp_elt_opcode (OP_ATTRIBUTE); */ 758 /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ 759} 760 761/* Write a call on an attribute ATR with one constant integer 762 * parameter. */ 763 764static void 765write_attribute_call1 (atr, arg) 766 enum ada_attribute atr; 767 LONGEST arg; 768{ 769 write_exp_elt_opcode (OP_LONG); 770 write_exp_elt_type (builtin_type_int); 771 write_exp_elt_longcst (arg); 772 write_exp_elt_opcode (OP_LONG); 773 /*write_exp_elt_opcode (OP_ATTRIBUTE);*/ 774 /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ 775 write_exp_elt_longcst ((LONGEST) 1); 776 write_exp_elt_longcst ((LONGEST) atr); 777 /*write_exp_elt_opcode (OP_ATTRIBUTE);*/ 778 /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ 779} 780 781/* Write a call on an attribute ATR with N parameters, whose code must have 782 * been generated previously. */ 783 784static void 785write_attribute_calln (atr, n) 786 enum ada_attribute atr; 787 int n; 788{ 789 /*write_exp_elt_opcode (OP_ATTRIBUTE);*/ 790 /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ 791 write_exp_elt_longcst ((LONGEST) n); 792 write_exp_elt_longcst ((LONGEST) atr); 793 /* write_exp_elt_opcode (OP_ATTRIBUTE);*/ 794 /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ 795} 796 797/* Emit expression corresponding to the renamed object designated by 798 * the type RENAMING, which must be the referent of an object renaming 799 * type, in the context of ORIG_LEFT_CONTEXT (?). */ 800static void 801write_object_renaming (orig_left_context, renaming) 802 struct block* orig_left_context; 803 struct symbol* renaming; 804{ 805 const char* qualification = DEPRECATED_SYMBOL_NAME (renaming); 806 const char* simple_tail; 807 const char* expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0); 808 const char* suffix; 809 char* name; 810 struct symbol* sym; 811 enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state; 812 813 /* if orig_left_context is null, then use the currently selected 814 block, otherwise we might fail our symbol lookup below */ 815 if (orig_left_context == NULL) 816 orig_left_context = get_selected_block (NULL); 817 818 for (simple_tail = qualification + strlen (qualification); 819 simple_tail != qualification; simple_tail -= 1) 820 { 821 if (*simple_tail == '.') 822 { 823 simple_tail += 1; 824 break; 825 } 826 else if (DEPRECATED_STREQN (simple_tail, "__", 2)) 827 { 828 simple_tail += 2; 829 break; 830 } 831 } 832 833 suffix = strstr (expr, "___XE"); 834 if (suffix == NULL) 835 goto BadEncoding; 836 837 name = (char*) malloc (suffix - expr + 1); 838 /* add_name_string_cleanup (name); */ 839 /* FIXME: add_name_string_cleanup should be defined in 840 parser-defs.h, implemented in parse.c */ 841 strncpy (name, expr, suffix-expr); 842 name[suffix-expr] = '\000'; 843 sym = lookup_symbol (name, orig_left_context, VAR_DOMAIN, 0, NULL); 844 /* if (sym == NULL) 845 error ("Could not find renamed variable: %s", ada_demangle (name)); 846 */ 847 /* FIXME: ada_demangle should be defined in defs.h, implemented in ada-lang.c */ 848 write_var_from_sym (orig_left_context, block_found, sym); 849 850 suffix += 5; 851 slice_state = SIMPLE_INDEX; 852 while (*suffix == 'X') 853 { 854 suffix += 1; 855 856 switch (*suffix) { 857 case 'L': 858 slice_state = LOWER_BOUND; 859 case 'S': 860 suffix += 1; 861 if (isdigit (*suffix)) 862 { 863 char* next; 864 long val = strtol (suffix, &next, 10); 865 if (next == suffix) 866 goto BadEncoding; 867 suffix = next; 868 write_exp_elt_opcode (OP_LONG); 869 write_exp_elt_type (builtin_type_ada_int); 870 write_exp_elt_longcst ((LONGEST) val); 871 write_exp_elt_opcode (OP_LONG); 872 } 873 else 874 { 875 const char* end; 876 char* index_name; 877 int index_len; 878 struct symbol* index_sym; 879 880 end = strchr (suffix, 'X'); 881 if (end == NULL) 882 end = suffix + strlen (suffix); 883 884 index_len = simple_tail - qualification + 2 + (suffix - end) + 1; 885 index_name = (char*) malloc (index_len); 886 memset (index_name, '\000', index_len); 887 /* add_name_string_cleanup (index_name);*/ 888 /* FIXME: add_name_string_cleanup should be defined in 889 parser-defs.h, implemented in parse.c */ 890 strncpy (index_name, qualification, simple_tail - qualification); 891 index_name[simple_tail - qualification] = '\000'; 892 strncat (index_name, suffix, suffix-end); 893 suffix = end; 894 895 index_sym = 896 lookup_symbol (index_name, NULL, VAR_DOMAIN, 0, NULL); 897 if (index_sym == NULL) 898 error ("Could not find %s", index_name); 899 write_var_from_sym (NULL, block_found, sym); 900 } 901 if (slice_state == SIMPLE_INDEX) 902 { 903 write_exp_elt_opcode (OP_FUNCALL); 904 write_exp_elt_longcst ((LONGEST) 1); 905 write_exp_elt_opcode (OP_FUNCALL); 906 } 907 else if (slice_state == LOWER_BOUND) 908 slice_state = UPPER_BOUND; 909 else if (slice_state == UPPER_BOUND) 910 { 911 write_exp_elt_opcode (TERNOP_SLICE); 912 slice_state = SIMPLE_INDEX; 913 } 914 break; 915 916 case 'R': 917 { 918 struct stoken field_name; 919 const char* end; 920 suffix += 1; 921 922 if (slice_state != SIMPLE_INDEX) 923 goto BadEncoding; 924 end = strchr (suffix, 'X'); 925 if (end == NULL) 926 end = suffix + strlen (suffix); 927 field_name.length = end - suffix; 928 field_name.ptr = (char*) malloc (end - suffix + 1); 929 strncpy (field_name.ptr, suffix, end - suffix); 930 field_name.ptr[end - suffix] = '\000'; 931 suffix = end; 932 write_exp_elt_opcode (STRUCTOP_STRUCT); 933 write_exp_string (field_name); 934 write_exp_elt_opcode (STRUCTOP_STRUCT); 935 break; 936 } 937 938 default: 939 goto BadEncoding; 940 } 941 } 942 if (slice_state == SIMPLE_INDEX) 943 return; 944 945 BadEncoding: 946 error ("Internal error in encoding of renaming declaration: %s", 947 DEPRECATED_SYMBOL_NAME (renaming)); 948} 949 950/* Convert the character literal whose ASCII value would be VAL to the 951 appropriate value of type TYPE, if there is a translation. 952 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'), 953 the literal 'A' (VAL == 65), returns 0. */ 954static LONGEST 955convert_char_literal (struct type* type, LONGEST val) 956{ 957 char name[7]; 958 int f; 959 960 if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM) 961 return val; 962 sprintf (name, "QU%02x", (int) val); 963 for (f = 0; f < TYPE_NFIELDS (type); f += 1) 964 { 965 if (DEPRECATED_STREQ (name, TYPE_FIELD_NAME (type, f))) 966 return TYPE_FIELD_BITPOS (type, f); 967 } 968 return val; 969} 970