diff options
Diffstat (limited to 'gdb/ada-exp.y')
| -rw-r--r-- | gdb/ada-exp.y | 962 |
1 files changed, 962 insertions, 0 deletions
diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y new file mode 100644 index 0000000..7d46dd2 --- /dev/null +++ b/gdb/ada-exp.y @@ -0,0 +1,962 @@ +/* YACC parser for Ada expressions, for GDB. + Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000 + Free Software Foundation, Inc. + +This file is part of GDB. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ + +/* Parse an Ada expression from text in a string, + and return the result as a struct expression pointer. + That structure contains arithmetic operations in reverse polish, + with constants represented by operations that are followed by special data. + See expression.h for the details of the format. + What is important here is that it can be built up sequentially + during the process of parsing; the lower levels of the tree always + come first in the result. + + malloc's and realloc's in this file are transformed to + xmalloc and xrealloc respectively by the same sed command in the + makefile that remaps any other malloc/realloc inserted by the parser + generator. Doing this with #defines and trying to control the interaction + with include files (<malloc.h> and <stdlib.h> for example) just became + too messy, particularly when such includes can be inserted at random + times by the parser generator. */ + +%{ + +#include "defs.h" +#include <string.h> +#include <ctype.h> +#include "expression.h" +#include "value.h" +#include "parser-defs.h" +#include "language.h" +#include "ada-lang.h" +#include "bfd.h" /* Required by objfiles.h. */ +#include "symfile.h" /* Required by objfiles.h. */ +#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */ +#include "frame.h" + +/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc), + as well as gratuitiously global symbol names, so we can have multiple + yacc generated parsers in gdb. These are only the variables + produced by yacc. If other parser generators (bison, byacc, etc) produce + additional global names that conflict at link time, then those parser + generators need to be fixed instead of adding those names to this list. */ + +/* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix + options. I presume we are maintaining it to accommodate systems + without BISON? (PNH) */ + +#define yymaxdepth ada_maxdepth +#define yyparse _ada_parse /* ada_parse calls this after initialization */ +#define yylex ada_lex +#define yyerror ada_error +#define yylval ada_lval +#define yychar ada_char +#define yydebug ada_debug +#define yypact ada_pact +#define yyr1 ada_r1 +#define yyr2 ada_r2 +#define yydef ada_def +#define yychk ada_chk +#define yypgo ada_pgo +#define yyact ada_act +#define yyexca ada_exca +#define yyerrflag ada_errflag +#define yynerrs ada_nerrs +#define yyps ada_ps +#define yypv ada_pv +#define yys ada_s +#define yy_yys ada_yys +#define yystate ada_state +#define yytmp ada_tmp +#define yyv ada_v +#define yy_yyv ada_yyv +#define yyval ada_val +#define yylloc ada_lloc +#define yyreds ada_reds /* With YYDEBUG defined */ +#define yytoks ada_toks /* With YYDEBUG defined */ + +#ifndef YYDEBUG +#define YYDEBUG 0 /* Default to no yydebug support */ +#endif + +struct name_info { + struct symbol* sym; + struct minimal_symbol* msym; + struct block* block; + struct stoken stoken; +}; + +/* If expression is in the context of TYPE'(...), then TYPE, else + * NULL. */ +static struct type* type_qualifier; + +int yyparse (void); + +static int yylex (void); + +void yyerror (char *); + +static struct stoken string_to_operator (struct stoken); + +static void write_attribute_call0 (enum ada_attribute); + +static void write_attribute_call1 (enum ada_attribute, LONGEST); + +static void write_attribute_calln (enum ada_attribute, int); + +static void write_object_renaming (struct block*, struct symbol*); + +static void write_var_from_name (struct block*, struct name_info); + +static LONGEST +convert_char_literal (struct type*, LONGEST); +%} + +%union + { + LONGEST lval; + struct { + LONGEST val; + struct type *type; + } typed_val; + struct { + DOUBLEST dval; + struct type *type; + } typed_val_float; + struct type *tval; + struct stoken sval; + struct name_info ssym; + int voidval; + struct block *bval; + struct internalvar *ivar; + + } + +%type <voidval> exp exp1 simple_exp start variable +%type <tval> type + +%token <typed_val> INT NULL_PTR CHARLIT +%token <typed_val_float> FLOAT +%token <tval> TYPENAME +%token <bval> BLOCKNAME + +/* Both NAME and TYPENAME tokens represent symbols in the input, + and both convey their data as strings. + But a TYPENAME is a string that happens to be defined as a typedef + or builtin type name (such as int or char) + and a NAME is any other symbol. + Contexts where this distinction is not important can use the + nonterminal "name", which matches either NAME or TYPENAME. */ + +%token <sval> STRING +%token <ssym> NAME DOT_ID OBJECT_RENAMING +%type <bval> block +%type <lval> arglist tick_arglist + +%type <tval> save_qualifier + +%token DOT_ALL + +/* Special type cases, put in to allow the parser to distinguish different + legal basetypes. */ +%token <lval> LAST REGNAME + +%token <ivar> INTERNAL_VARIABLE + +%nonassoc ASSIGN +%left _AND_ OR XOR THEN ELSE +%left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT +%left '@' +%left '+' '-' '&' +%left UNARY +%left '*' '/' MOD REM +%right STARSTAR ABS NOT + /* The following are right-associative only so that reductions at this + precedence have lower precedence than '.' and '('. The syntax still + forces a.b.c, e.g., to be LEFT-associated. */ +%right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH +%right TICK_MAX TICK_MIN TICK_MODULUS +%right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL +%right '.' '(' '[' DOT_ID DOT_ALL + +%token ARROW NEW + + +%% + +start : exp1 + | type { write_exp_elt_opcode (OP_TYPE); + write_exp_elt_type ($1); + write_exp_elt_opcode (OP_TYPE); } + ; + +/* Expressions, including the sequencing operator. */ +exp1 : exp + | exp1 ';' exp + { write_exp_elt_opcode (BINOP_COMMA); } + ; + +/* Expressions, not including the sequencing operator. */ +simple_exp : simple_exp DOT_ALL + { write_exp_elt_opcode (UNOP_IND); } + ; + +simple_exp : simple_exp DOT_ID + { write_exp_elt_opcode (STRUCTOP_STRUCT); + write_exp_string ($2.stoken); + write_exp_elt_opcode (STRUCTOP_STRUCT); + } + ; + +simple_exp : simple_exp '(' arglist ')' + { + write_exp_elt_opcode (OP_FUNCALL); + write_exp_elt_longcst ($3); + write_exp_elt_opcode (OP_FUNCALL); + } + ; + +simple_exp : type '(' exp ')' + { + write_exp_elt_opcode (UNOP_CAST); + write_exp_elt_type ($1); + write_exp_elt_opcode (UNOP_CAST); + } + ; + +simple_exp : type '\'' save_qualifier { type_qualifier = $1; } '(' exp ')' + { + /* write_exp_elt_opcode (UNOP_QUAL); */ + /* FIXME: UNOP_QUAL should be defined in expression.h */ + write_exp_elt_type ($1); + /* write_exp_elt_opcode (UNOP_QUAL); */ + /* FIXME: UNOP_QUAL should be defined in expression.h */ + type_qualifier = $3; + } + ; + +save_qualifier : { $$ = type_qualifier; } + +simple_exp : + simple_exp '(' exp DOTDOT exp ')' + { write_exp_elt_opcode (TERNOP_SLICE); } + ; + +simple_exp : '(' exp1 ')' { } + ; + +simple_exp : variable + ; + +simple_exp: REGNAME /* GDB extension */ + { write_exp_elt_opcode (OP_REGISTER); + write_exp_elt_longcst ((LONGEST) $1); + write_exp_elt_opcode (OP_REGISTER); + } + ; + +simple_exp: INTERNAL_VARIABLE /* GDB extension */ + { write_exp_elt_opcode (OP_INTERNALVAR); + write_exp_elt_intern ($1); + write_exp_elt_opcode (OP_INTERNALVAR); + } + ; + + +exp : simple_exp + ; + +simple_exp: LAST + { write_exp_elt_opcode (OP_LAST); + write_exp_elt_longcst ((LONGEST) $1); + write_exp_elt_opcode (OP_LAST); + } + ; + +exp : exp ASSIGN exp /* Extension for convenience */ + { write_exp_elt_opcode (BINOP_ASSIGN); } + ; + +exp : '-' exp %prec UNARY + { write_exp_elt_opcode (UNOP_NEG); } + ; + +exp : '+' exp %prec UNARY + { write_exp_elt_opcode (UNOP_PLUS); } + ; + +exp : NOT exp %prec UNARY + { write_exp_elt_opcode (UNOP_LOGICAL_NOT); } + ; + +exp : ABS exp %prec UNARY + { write_exp_elt_opcode (UNOP_ABS); } + ; + +arglist : { $$ = 0; } + ; + +arglist : exp + { $$ = 1; } + | any_name ARROW exp + { $$ = 1; } + | arglist ',' exp + { $$ = $1 + 1; } + | arglist ',' any_name ARROW exp + { $$ = $1 + 1; } + ; + +exp : '{' type '}' exp %prec '.' + /* GDB extension */ + { write_exp_elt_opcode (UNOP_MEMVAL); + write_exp_elt_type ($2); + write_exp_elt_opcode (UNOP_MEMVAL); + } + ; + +/* Binary operators in order of decreasing precedence. */ + +exp : exp STARSTAR exp + { write_exp_elt_opcode (BINOP_EXP); } + ; + +exp : exp '*' exp + { write_exp_elt_opcode (BINOP_MUL); } + ; + +exp : exp '/' exp + { write_exp_elt_opcode (BINOP_DIV); } + ; + +exp : exp REM exp /* May need to be fixed to give correct Ada REM */ + { write_exp_elt_opcode (BINOP_REM); } + ; + +exp : exp MOD exp + { write_exp_elt_opcode (BINOP_MOD); } + ; + +exp : exp '@' exp /* GDB extension */ + { write_exp_elt_opcode (BINOP_REPEAT); } + ; + +exp : exp '+' exp + { write_exp_elt_opcode (BINOP_ADD); } + ; + +exp : exp '&' exp + { write_exp_elt_opcode (BINOP_CONCAT); } + ; + +exp : exp '-' exp + { write_exp_elt_opcode (BINOP_SUB); } + ; + +exp : exp '=' exp + { write_exp_elt_opcode (BINOP_EQUAL); } + ; + +exp : exp NOTEQUAL exp + { write_exp_elt_opcode (BINOP_NOTEQUAL); } + ; + +exp : exp LEQ exp + { write_exp_elt_opcode (BINOP_LEQ); } + ; + +exp : exp IN exp DOTDOT exp + { /*write_exp_elt_opcode (TERNOP_MBR); */ } + /* FIXME: TERNOP_MBR should be defined in + expression.h */ + | exp IN exp TICK_RANGE tick_arglist + { /*write_exp_elt_opcode (BINOP_MBR); */ + /* FIXME: BINOP_MBR should be defined in expression.h */ + write_exp_elt_longcst ((LONGEST) $5); + /*write_exp_elt_opcode (BINOP_MBR); */ + } + | exp IN TYPENAME %prec TICK_ACCESS + { /*write_exp_elt_opcode (UNOP_MBR); */ + /* FIXME: UNOP_QUAL should be defined in expression.h */ + write_exp_elt_type ($3); + /* write_exp_elt_opcode (UNOP_MBR); */ + /* FIXME: UNOP_MBR should be defined in expression.h */ + } + | exp NOT IN exp DOTDOT exp + { /*write_exp_elt_opcode (TERNOP_MBR); */ + /* FIXME: TERNOP_MBR should be defined in expression.h */ + write_exp_elt_opcode (UNOP_LOGICAL_NOT); + } + | exp NOT IN exp TICK_RANGE tick_arglist + { /* write_exp_elt_opcode (BINOP_MBR); */ + /* FIXME: BINOP_MBR should be defined in expression.h */ + write_exp_elt_longcst ((LONGEST) $6); + /*write_exp_elt_opcode (BINOP_MBR);*/ + /* FIXME: BINOP_MBR should be defined in expression.h */ + write_exp_elt_opcode (UNOP_LOGICAL_NOT); + } + | exp NOT IN TYPENAME %prec TICK_ACCESS + { /*write_exp_elt_opcode (UNOP_MBR);*/ + /* FIXME: UNOP_MBR should be defined in expression.h */ + write_exp_elt_type ($4); + /* write_exp_elt_opcode (UNOP_MBR);*/ + /* FIXME: UNOP_MBR should be defined in expression.h */ + write_exp_elt_opcode (UNOP_LOGICAL_NOT); + } + ; + +exp : exp GEQ exp + { write_exp_elt_opcode (BINOP_GEQ); } + ; + +exp : exp '<' exp + { write_exp_elt_opcode (BINOP_LESS); } + ; + +exp : exp '>' exp + { write_exp_elt_opcode (BINOP_GTR); } + ; + +exp : exp _AND_ exp /* Fix for Ada elementwise AND. */ + { write_exp_elt_opcode (BINOP_BITWISE_AND); } + ; + +exp : exp _AND_ THEN exp %prec _AND_ + { write_exp_elt_opcode (BINOP_LOGICAL_AND); } + ; + +exp : exp OR exp /* Fix for Ada elementwise OR */ + { write_exp_elt_opcode (BINOP_BITWISE_IOR); } + ; + +exp : exp OR ELSE exp + { write_exp_elt_opcode (BINOP_LOGICAL_OR); } + ; + +exp : exp XOR exp /* Fix for Ada elementwise XOR */ + { write_exp_elt_opcode (BINOP_BITWISE_XOR); } + ; + +simple_exp : simple_exp TICK_ACCESS + { write_exp_elt_opcode (UNOP_ADDR); } + | simple_exp TICK_ADDRESS + { write_exp_elt_opcode (UNOP_ADDR); + write_exp_elt_opcode (UNOP_CAST); + write_exp_elt_type (builtin_type_ada_system_address); + write_exp_elt_opcode (UNOP_CAST); + } + | simple_exp TICK_FIRST tick_arglist + { write_attribute_call1 (ATR_FIRST, $3); } + | simple_exp TICK_LAST tick_arglist + { write_attribute_call1 (ATR_LAST, $3); } + | simple_exp TICK_LENGTH tick_arglist + { write_attribute_call1 (ATR_LENGTH, $3); } + | simple_exp TICK_SIZE + { write_attribute_call0 (ATR_SIZE); } + | simple_exp TICK_TAG + { write_attribute_call0 (ATR_TAG); } + | opt_type_prefix TICK_MIN '(' exp ',' exp ')' + { write_attribute_calln (ATR_MIN, 2); } + | opt_type_prefix TICK_MAX '(' exp ',' exp ')' + { write_attribute_calln (ATR_MAX, 2); } + | opt_type_prefix TICK_POS '(' exp ')' + { write_attribute_calln (ATR_POS, 1); } + | type_prefix TICK_FIRST tick_arglist + { write_attribute_call1 (ATR_FIRST, $3); } + | type_prefix TICK_LAST tick_arglist + { write_attribute_call1 (ATR_LAST, $3); } + | type_prefix TICK_LENGTH tick_arglist + { write_attribute_call1 (ATR_LENGTH, $3); } + | type_prefix TICK_VAL '(' exp ')' + { write_attribute_calln (ATR_VAL, 1); } + | type_prefix TICK_MODULUS + { write_attribute_call0 (ATR_MODULUS); } + ; + +tick_arglist : %prec '(' + { $$ = 1; } + | '(' INT ')' + { $$ = $2.val; } + ; + +type_prefix : + TYPENAME + { write_exp_elt_opcode (OP_TYPE); + write_exp_elt_type ($1); + write_exp_elt_opcode (OP_TYPE); } + ; + +opt_type_prefix : + type_prefix + | /* EMPTY */ + { write_exp_elt_opcode (OP_TYPE); + write_exp_elt_type (builtin_type_void); + write_exp_elt_opcode (OP_TYPE); } + ; + + +exp : INT + { write_exp_elt_opcode (OP_LONG); + write_exp_elt_type ($1.type); + write_exp_elt_longcst ((LONGEST)($1.val)); + write_exp_elt_opcode (OP_LONG); + } + ; + +exp : CHARLIT + { write_exp_elt_opcode (OP_LONG); + if (type_qualifier == NULL) + write_exp_elt_type ($1.type); + else + write_exp_elt_type (type_qualifier); + write_exp_elt_longcst + (convert_char_literal (type_qualifier, $1.val)); + write_exp_elt_opcode (OP_LONG); + } + + +exp : FLOAT + { write_exp_elt_opcode (OP_DOUBLE); + write_exp_elt_type ($1.type); + write_exp_elt_dblcst ($1.dval); + write_exp_elt_opcode (OP_DOUBLE); + } + ; + +exp : NULL_PTR + { write_exp_elt_opcode (OP_LONG); + write_exp_elt_type (builtin_type_int); + write_exp_elt_longcst ((LONGEST)(0)); + write_exp_elt_opcode (OP_LONG); + } + +exp : STRING + { /* Ada strings are converted into array constants + a lower bound of 1. Thus, the array upper bound + is the string length. */ + char *sp = $1.ptr; int count; + if ($1.length == 0) + { /* One dummy character for the type */ + write_exp_elt_opcode (OP_LONG); + write_exp_elt_type (builtin_type_ada_char); + write_exp_elt_longcst ((LONGEST)(0)); + write_exp_elt_opcode (OP_LONG); + } + for (count = $1.length; count > 0; count -= 1) + { + write_exp_elt_opcode (OP_LONG); + write_exp_elt_type (builtin_type_ada_char); + write_exp_elt_longcst ((LONGEST)(*sp)); + sp += 1; + write_exp_elt_opcode (OP_LONG); + } + write_exp_elt_opcode (OP_ARRAY); + write_exp_elt_longcst ((LONGEST) 1); + write_exp_elt_longcst ((LONGEST) ($1.length)); + write_exp_elt_opcode (OP_ARRAY); + } + ; + +exp : NEW TYPENAME + { error ("NEW not implemented."); } + ; + +variable: NAME { write_var_from_name (NULL, $1); } + | block NAME /* GDB extension */ + { write_var_from_name ($1, $2); } + | OBJECT_RENAMING { write_object_renaming (NULL, $1.sym); } + | block OBJECT_RENAMING + { write_object_renaming ($1, $2.sym); } + ; + +any_name : NAME { } + | TYPENAME { } + | OBJECT_RENAMING { } + ; + +block : BLOCKNAME /* GDB extension */ + { $$ = $1; } + | block BLOCKNAME /* GDB extension */ + { $$ = $2; } + ; + + +type : TYPENAME { $$ = $1; } + | block TYPENAME { $$ = $2; } + | TYPENAME TICK_ACCESS + { $$ = lookup_pointer_type ($1); } + | block TYPENAME TICK_ACCESS + { $$ = lookup_pointer_type ($2); } + ; + +/* Some extensions borrowed from C, for the benefit of those who find they + can't get used to Ada notation in GDB. */ + +exp : '*' exp %prec '.' + { write_exp_elt_opcode (UNOP_IND); } + | '&' exp %prec '.' + { write_exp_elt_opcode (UNOP_ADDR); } + | exp '[' exp ']' + { write_exp_elt_opcode (BINOP_SUBSCRIPT); } + ; + +%% + +/* yylex defined in ada-lex.c: Reads one token, getting characters */ +/* through lexptr. */ + +/* Remap normal flex interface names (yylex) as well as gratuitiously */ +/* global symbol names, so we can have multiple flex-generated parsers */ +/* in gdb. */ + +/* (See note above on previous definitions for YACC.) */ + +#define yy_create_buffer ada_yy_create_buffer +#define yy_delete_buffer ada_yy_delete_buffer +#define yy_init_buffer ada_yy_init_buffer +#define yy_load_buffer_state ada_yy_load_buffer_state +#define yy_switch_to_buffer ada_yy_switch_to_buffer +#define yyrestart ada_yyrestart +#define yytext ada_yytext +#define yywrap ada_yywrap + +/* The following kludge was found necessary to prevent conflicts between */ +/* defs.h and non-standard stdlib.h files. */ +#define qsort __qsort__dummy +#include "ada-lex.c" + +int +ada_parse () +{ + lexer_init (yyin); /* (Re-)initialize lexer. */ + left_block_context = NULL; + type_qualifier = NULL; + + return _ada_parse (); +} + +void +yyerror (msg) + char *msg; +{ + error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr); +} + +/* The operator name corresponding to operator symbol STRING (adds + quotes and maps to lower-case). Destroys the previous contents of + the array pointed to by STRING.ptr. Error if STRING does not match + a valid Ada operator. Assumes that STRING.ptr points to a + null-terminated string and that, if STRING is a valid operator + symbol, the array pointed to by STRING.ptr contains at least + STRING.length+3 characters. */ + +static struct stoken +string_to_operator (string) + struct stoken string; +{ + int i; + + for (i = 0; ada_opname_table[i].mangled != NULL; i += 1) + { + if (string.length == strlen (ada_opname_table[i].demangled)-2 + && strncasecmp (string.ptr, ada_opname_table[i].demangled+1, + string.length) == 0) + { + strncpy (string.ptr, ada_opname_table[i].demangled, + string.length+2); + string.length += 2; + return string; + } + } + error ("Invalid operator symbol `%s'", string.ptr); +} + +/* Emit expression to access an instance of SYM, in block BLOCK (if + * non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */ +static void +write_var_from_sym (orig_left_context, block, sym) + struct block* orig_left_context; + struct block* block; + struct symbol* sym; +{ + if (orig_left_context == NULL && symbol_read_needs_frame (sym)) + { + if (innermost_block == 0 || + contained_in (block, innermost_block)) + innermost_block = block; + } + + write_exp_elt_opcode (OP_VAR_VALUE); + /* We want to use the selected frame, not another more inner frame + which happens to be in the same block */ + write_exp_elt_block (NULL); + write_exp_elt_sym (sym); + write_exp_elt_opcode (OP_VAR_VALUE); +} + +/* Emit expression to access an instance of NAME. */ +static void +write_var_from_name (orig_left_context, name) + struct block* orig_left_context; + struct name_info name; +{ + if (name.msym != NULL) + { + write_exp_msymbol (name.msym, + lookup_function_type (builtin_type_int), + builtin_type_int); + } + else if (name.sym == NULL) + { + /* Multiple matches: record name and starting block for later + resolution by ada_resolve. */ + /* write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */ + /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ + write_exp_elt_block (name.block); + /* write_exp_elt_name (name.stoken.ptr); */ + /* FIXME: write_exp_elt_name should be defined in defs.h, located in parse.c */ + /* write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */ + /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ + } + else + write_var_from_sym (orig_left_context, name.block, name.sym); +} + +/* Write a call on parameterless attribute ATR. */ + +static void +write_attribute_call0 (atr) + enum ada_attribute atr; +{ + /* write_exp_elt_opcode (OP_ATTRIBUTE); */ + /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ + write_exp_elt_longcst ((LONGEST) 0); + write_exp_elt_longcst ((LONGEST) atr); + /* write_exp_elt_opcode (OP_ATTRIBUTE); */ + /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ +} + +/* Write a call on an attribute ATR with one constant integer + * parameter. */ + +static void +write_attribute_call1 (atr, arg) + enum ada_attribute atr; + LONGEST arg; +{ + write_exp_elt_opcode (OP_LONG); + write_exp_elt_type (builtin_type_int); + write_exp_elt_longcst (arg); + write_exp_elt_opcode (OP_LONG); + /*write_exp_elt_opcode (OP_ATTRIBUTE);*/ + /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ + write_exp_elt_longcst ((LONGEST) 1); + write_exp_elt_longcst ((LONGEST) atr); + /*write_exp_elt_opcode (OP_ATTRIBUTE);*/ + /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ +} + +/* Write a call on an attribute ATR with N parameters, whose code must have + * been generated previously. */ + +static void +write_attribute_calln (atr, n) + enum ada_attribute atr; + int n; +{ + /*write_exp_elt_opcode (OP_ATTRIBUTE);*/ + /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ + write_exp_elt_longcst ((LONGEST) n); + write_exp_elt_longcst ((LONGEST) atr); + /* write_exp_elt_opcode (OP_ATTRIBUTE);*/ + /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ +} + +/* Emit expression corresponding to the renamed object designated by + * the type RENAMING, which must be the referent of an object renaming + * type, in the context of ORIG_LEFT_CONTEXT (?). */ +static void +write_object_renaming (orig_left_context, renaming) + struct block* orig_left_context; + struct symbol* renaming; +{ + const char* qualification = SYMBOL_NAME (renaming); + const char* simple_tail; + const char* expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0); + const char* suffix; + char* name; + struct symbol* sym; + enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state; + + /* if orig_left_context is null, then use the currently selected + block, otherwise we might fail our symbol lookup below */ + if (orig_left_context == NULL) + orig_left_context = get_selected_block (NULL); + + for (simple_tail = qualification + strlen (qualification); + simple_tail != qualification; simple_tail -= 1) + { + if (*simple_tail == '.') + { + simple_tail += 1; + break; + } + else if (STREQN (simple_tail, "__", 2)) + { + simple_tail += 2; + break; + } + } + + suffix = strstr (expr, "___XE"); + if (suffix == NULL) + goto BadEncoding; + + name = (char*) malloc (suffix - expr + 1); + /* add_name_string_cleanup (name); */ + /* FIXME: add_name_string_cleanup should be defined in + parser-defs.h, implemented in parse.c */ + strncpy (name, expr, suffix-expr); + name[suffix-expr] = '\000'; + sym = lookup_symbol (name, orig_left_context, VAR_NAMESPACE, 0, NULL); + /* if (sym == NULL) + error ("Could not find renamed variable: %s", ada_demangle (name)); + */ + /* FIXME: ada_demangle should be defined in defs.h, implemented in ada-lang.c */ + write_var_from_sym (orig_left_context, block_found, sym); + + suffix += 5; + slice_state = SIMPLE_INDEX; + while (*suffix == 'X') + { + suffix += 1; + + switch (*suffix) { + case 'L': + slice_state = LOWER_BOUND; + case 'S': + suffix += 1; + if (isdigit (*suffix)) + { + char* next; + long val = strtol (suffix, &next, 10); + if (next == suffix) + goto BadEncoding; + suffix = next; + write_exp_elt_opcode (OP_LONG); + write_exp_elt_type (builtin_type_ada_int); + write_exp_elt_longcst ((LONGEST) val); + write_exp_elt_opcode (OP_LONG); + } + else + { + const char* end; + char* index_name; + int index_len; + struct symbol* index_sym; + + end = strchr (suffix, 'X'); + if (end == NULL) + end = suffix + strlen (suffix); + + index_len = simple_tail - qualification + 2 + (suffix - end) + 1; + index_name = (char*) malloc (index_len); + memset (index_name, '\000', index_len); + /* add_name_string_cleanup (index_name);*/ + /* FIXME: add_name_string_cleanup should be defined in + parser-defs.h, implemented in parse.c */ + strncpy (index_name, qualification, simple_tail - qualification); + index_name[simple_tail - qualification] = '\000'; + strncat (index_name, suffix, suffix-end); + suffix = end; + + index_sym = + lookup_symbol (index_name, NULL, VAR_NAMESPACE, 0, NULL); + if (index_sym == NULL) + error ("Could not find %s", index_name); + write_var_from_sym (NULL, block_found, sym); + } + if (slice_state == SIMPLE_INDEX) + { + write_exp_elt_opcode (OP_FUNCALL); + write_exp_elt_longcst ((LONGEST) 1); + write_exp_elt_opcode (OP_FUNCALL); + } + else if (slice_state == LOWER_BOUND) + slice_state = UPPER_BOUND; + else if (slice_state == UPPER_BOUND) + { + write_exp_elt_opcode (TERNOP_SLICE); + slice_state = SIMPLE_INDEX; + } + break; + + case 'R': + { + struct stoken field_name; + const char* end; + suffix += 1; + + if (slice_state != SIMPLE_INDEX) + goto BadEncoding; + end = strchr (suffix, 'X'); + if (end == NULL) + end = suffix + strlen (suffix); + field_name.length = end - suffix; + field_name.ptr = (char*) malloc (end - suffix + 1); + strncpy (field_name.ptr, suffix, end - suffix); + field_name.ptr[end - suffix] = '\000'; + suffix = end; + write_exp_elt_opcode (STRUCTOP_STRUCT); + write_exp_string (field_name); + write_exp_elt_opcode (STRUCTOP_STRUCT); + break; + } + + default: + goto BadEncoding; + } + } + if (slice_state == SIMPLE_INDEX) + return; + + BadEncoding: + error ("Internal error in encoding of renaming declaration: %s", + SYMBOL_NAME (renaming)); +} + +/* Convert the character literal whose ASCII value would be VAL to the + appropriate value of type TYPE, if there is a translation. + Otherwise return VAL. Hence, in an enumeration type ('A', 'B'), + the literal 'A' (VAL == 65), returns 0. */ +static LONGEST +convert_char_literal (struct type* type, LONGEST val) +{ + char name[7]; + int f; + + if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM) + return val; + sprintf (name, "QU%02x", (int) val); + for (f = 0; f < TYPE_NFIELDS (type); f += 1) + { + if (STREQ (name, TYPE_FIELD_NAME (type, f))) + return TYPE_FIELD_BITPOS (type, f); + } + return val; +} |