Add base ada language files

1 files changed, 962 insertions, 0 deletions

diff --git a/gdb/ada-exp.y b/gdb/ada-exp.y
new file mode 100644
index 00000000000..7d46dd2cf8b
--- /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;
+}