Re: [RFC] ada support patch

[Andrew Cagney <ac131313 at ges dot redhat dot com>]

> This patch contains a few changes which are necessary to enable the
> ada-* files to build and turn on ada support.
>
> Unfortunately it causes a few regressions atm, which I need to track
> down. But I figure it's worth throwing this out here so I can make
> sure I'm on the right track.
>
> ChangeLog:
>
> 	* defs.h (languages): Add language_ada to type.
Yes, definitly.

> 	(ada_demangle, ada_attribute_name): Declare here from ada-lang.c.
Create a file called ``ada-lang.h'' and put them in there.  You'll need 
to add ``ada_lang_h = ...'' to Makefile.in (no one maintains Makefile.in 
so that is also fine).  Otherwize, ok.

[Thinking out loud:  Should ada_demangle() live in libiberty and be made 
part of binutils?]

Um, after that, I'm going to get fuzzy.  I'm not sure that I'm the best 
person to be approving some of this.  However, here goes.

> 	* expression.h (exp_opcode): Add BINOP_MBR, TERNOP_MBR,
> 	OP_UNRESOLVED_VALUE, OP_ATTRIBUTE, UNOP_QUAL, UNOP_MBR to type.
> 	(exp_element): Add name member.
Can you substitute MBR with something more meaningful?  Perhaphs 
``OP_ADA_ATTRIBUTE'' as that one is so language specific.  Otherwize ok.

> 	* gdbtypes.h (TYPE_FLAG_FIXED_INSTACE): New type.
> 	(base_type): New function.
> 	* parse.c (name_list): New type.
> 	(temp_name_list): New global.
> 	(add_name_string_cleanup): New function.
>
> 	* parser_defs.h (add_name_string_cleanup): Declare here from parse.c.
>
> 	* valarith.c (base_type): New function.
DanielJ and/or ElenaZ's problem :-)  I think they are the most up on 
language and type stuff.

Andrew


> Patch:
>
> Index: defs.h
> ===================================================================
> RCS file: /cvs/src/src/gdb/defs.h,v
> retrieving revision 1.94
> diff -u -r1.94 defs.h
> --- defs.h	1 Aug 2002 17:18:32 -0000	1.94
> +++ defs.h	13 Sep 2002 00:08:38 -0000
> @@ -214,7 +214,8 @@
>      language_m2,		/* Modula-2 */
>      language_asm,		/* Assembly language */
>      language_scm,    		/* Scheme / Guile */
> -    language_pascal		/* Pascal */
> +    language_pascal,		/* Pascal */
> +    language_ada		/* Ada */
>    };
>  
>  enum precision_type
> @@ -303,6 +304,14 @@
>  /* OBSOLETE From ch-lang.c, for the moment. (FIXME) */
>  
>  /* OBSOLETE extern char *chill_demangle (const char *); */
> +
> +/* From ada-lang.c.  For some reason, it shouldn't be (see 
> +   chill_demangle comment), but I have no idea what's wrong with this 
> +   location for ada_demangle. */
> +
> +extern char *ada_demangle (const char*);
> +
> +extern const char *ada_attribute_name (int);
>  
>  /* From utils.c */
>  
> Index: expression.h
> ===================================================================
> RCS file: /cvs/src/src/gdb/expression.h,v
> retrieving revision 1.4
> diff -u -r1.4 expression.h
> --- expression.h	1 Aug 2002 17:18:32 -0000	1.4
> +++ expression.h	13 Sep 2002 00:08:39 -0000
> @@ -90,6 +90,10 @@
>  
>      /* end of C++.  */
>  
> +    /* Ada:  exp IN exp'RANGE(N).  N is an immediate operand, surrounded by 
> +       BINOP_MBR before and after.  */
> +    BINOP_MBR,
> +
>      /* For Modula-2 integer division DIV */
>      BINOP_INTDIV,
>  
> @@ -131,6 +135,9 @@
>         element OP2. */
>      TERNOP_SLICE_COUNT,
>  
> +    /* Ada: exp IN exp .. exp */
> +    TERNOP_MBR,
> +
>      /* Multidimensional subscript operator, such as Modula-2 x[a,b,...].
>         The dimensionality is encoded in the operator, like the number of
>         function arguments in OP_FUNCALL, I.E. <OP><dimension><OP>.
> @@ -158,6 +165,17 @@
>         executing in that block; if the block is NULL use the selected frame.  */
>      OP_VAR_VALUE,
>  
> +    /* OP_UNRESOLVED_VALUE takes a single struct block* and a char* in the 
> +       following exp_elements, followed by another OP_UNRESOLVED_VALUE.   The
> +       block indicates where to begin looking for matching symbols.
> +       This is for use with overloaded names in Ada, and must 
> +       be resolved into an OP_VAR_VALUE before evaluation in EVAL_NORMAL
> +       mode.  When evaluated in EVAL_AVOID_SIDE_EFFECTS mode, it is
> +       resolved (if possible) to an OP_VAR_VALUE entry, with its block and
> +       symbol entries replaced by the block and symbol from the resolving
> +       entry. */
> +    OP_UNRESOLVED_VALUE,
> +
>      /* OP_LAST is followed by an integer in the next exp_element.
>         The integer is zero for the last value printed,
>         or it is the absolute number of a history element.
> @@ -192,6 +210,14 @@
>         literal. It is followed by exactly two args that are doubles.  */
>      OP_COMPLEX,
>  
> +    /* Ada attribute call.  OP_ATTRIBUTE is followed by an integer in the
> +       next exp_element, which is the number of extra arguments to the attribute
> +       (thus, x'tag would specify 0, whereas x'length would specify 1).  
> +       The integer is followed by another integer indicating the identity of 
> +       the attribute (of type enum ada_attribute, see ada-lang.h), and then
> +       by a repeat of OP_ATTRIBUTE */
> +    OP_ATTRIBUTE,
> +
>      /* OP_STRING represents a string constant.
>         Its format is the same as that of a STRUCTOP, but the string
>         data is just made into a string constant when the operation
> @@ -220,6 +246,10 @@
>         It casts the value of the following subexpression.  */
>      UNOP_CAST,
>  
> +    /* UNOP_QUAL is Ada type qualification.  It is encoded as for
> +       UNOP_CAST, above, and denotes the TYPE'(EXPR) construct. */
> +    UNOP_QUAL,
> +
>      /* UNOP_MEMVAL is followed by a type pointer in the next exp_element
>         With another UNOP_MEMVAL at the end, this makes three exp_elements.
>         It casts the contents of the word addressed by the value of the
> @@ -256,6 +286,10 @@
>      /* (OBSOLETE) Chill (OBSOLETE) builtin functions. */
>      UNOP_LOWER, UNOP_UPPER, UNOP_LENGTH, UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN,
>  
> +    /* Ada: exp IN type.  The `type' argument is immediate, with UNOP_MBR 
> +       before and after it. */
> +    UNOP_MBR,
> +
>      OP_BOOL,			/* Modula-2 builtin BOOLEAN type */
>      OP_M2_STRING,		/* Modula-2 string constants */
>  
> @@ -320,6 +354,7 @@
>      struct type *type;
>      struct internalvar *internalvar;
>      struct block *block;
> +    char* name;
>    };
>  
>  struct expression
> Index: gdbtypes.h
> ===================================================================
> RCS file: /cvs/src/src/gdb/gdbtypes.h,v
> retrieving revision 1.35
> diff -u -r1.35 gdbtypes.h
> --- gdbtypes.h	10 Aug 2002 05:12:40 -0000	1.35
> +++ gdbtypes.h	13 Sep 2002 00:08:44 -0000
> @@ -197,7 +197,6 @@
>  #define TYPE_FLAG_VOLATILE	(1 << 6)
>  #define TYPE_VOLATILE(t)	(TYPE_INSTANCE_FLAGS (t) & TYPE_FLAG_VOLATILE)
>  
> -
>  /* This is a function type which appears to have a prototype.  We need this
>     for function calls in order to tell us if it's necessary to coerce the args,
>     or to just do the standard conversions.  This is used with a short field. */
> @@ -253,6 +252,12 @@
>  #define TYPE_FLAG_VECTOR	(1 << 12)
>  #define TYPE_VECTOR(t)		(TYPE_FLAGS (t) & TYPE_FLAG_VECTOR)
>  
> +/* Marks a type that has been created from a template for a
> +   dynamically sized type (e.g., GNAT arrays whose bounds are runtime
> +   quantities).  Optionally marks an ordinary, fixed-size GDB type. */
> +
> +#define TYPE_FLAG_FIXED_INSTANCE (1 << 13)
> +
>  struct main_type
>  {
>    /* Code for kind of type */
> @@ -335,6 +340,9 @@
>       For a function or method type, describes the type of the return value.
>       For a range type, describes the type of the full range.
>       For a complex type, describes the type of each coordinate.
> +     For a special record or union type encoding a dynamic-sized type
> +     in GNAT, a memoized pointer to a corresponding static version of
> +     the type.
>       Unused otherwise.  */
>  
>    struct type *target_type;
> @@ -394,7 +402,10 @@
>         says how many bytes the field occupies.
>         A value of -1 or -2 indicates a static field;  -1 means the location
>         is specified by the label loc.physname;  -2 means that loc.physaddr
> -       specifies the actual address. */
> +       specifies the actual address.
> +       If non-zero in an array type, indicates the element size in
> +       bits (used only in Ada at the moment).	 
> +    */
>  
>      int bitsize;
>  
> @@ -1249,5 +1260,8 @@
>  extern int is_integral_type (struct type *);
>  
>  extern void maintenance_print_type (char *, int);
> +/* valarith.c */
> + 
> +extern struct type* base_type (struct type*);
>  
>  #endif /* GDBTYPES_H */
> Index: parse.c
> ===================================================================
> RCS file: /cvs/src/src/gdb/parse.c,v
> retrieving revision 1.25
> diff -u -r1.25 parse.c
> --- parse.c	21 Jun 2002 14:32:10 -0000	1.25
> +++ parse.c	13 Sep 2002 00:08:51 -0000
> @@ -106,6 +106,15 @@
>  
>  static struct funcall *funcall_chain;
>  
> +/* List of strings. */
> +
> +struct name_list {
> +  struct name_list* next;
> +  char* name;
> +};
> +
> +static struct name_list *temp_name_list;
> +
>  /* The generic method for targets to specify how their registers are
>     named.  The mapping can be derived from two sources: REGISTER_NAME;
>     or builtin regs.  */
> @@ -432,6 +441,20 @@
>      }
>    write_exp_elt_opcode (UNOP_MEMVAL);
>  }
> +
> +/* Add S to the list of strings that will eventually have to be 
> +   released after parsing and must also be released on error. */
> +void
> +add_name_string_cleanup (char* s)
> +{
> +  struct name_list* elt = 
> +    (struct name_list*) xmalloc (sizeof (struct name_list));
> +
> +  elt -> name = s;
> +  elt -> next = temp_name_list;
> +  temp_name_list = elt;
> +}
> +
>  
>  /* Recognize tokens that start with '$'.  These include:
>  
> Index: parser-defs.h
> ===================================================================
> RCS file: /cvs/src/src/gdb/parser-defs.h,v
> retrieving revision 1.11
> diff -u -r1.11 parser-defs.h
> --- parser-defs.h	24 Jul 2002 03:03:52 -0000	1.11
> +++ parser-defs.h	13 Sep 2002 00:08:52 -0000
> @@ -101,6 +101,8 @@
>  extern union type_stack_elt *type_stack;
>  extern int type_stack_depth, type_stack_size;
>  
> +extern void add_name_string_cleanup (char*);
> +
>  extern void write_exp_elt (union exp_element);
>  
>  extern void write_exp_elt_opcode (enum exp_opcode);
> Index: valarith.c
> ===================================================================
> RCS file: /cvs/src/src/gdb/valarith.c,v
> retrieving revision 1.16
> diff -u -r1.16 valarith.c
> --- valarith.c	1 Aug 2002 17:18:33 -0000	1.16
> +++ valarith.c	13 Sep 2002 00:08:56 -0000
> @@ -1162,6 +1162,22 @@
>    return val;
>  }
>  
> +/* The identity on non-range types.  For range types, the underlying */
> +/* non-range scalar type. */  
> +
> +struct type*
> +base_type (struct type* type)
> +{
> +  while (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE)
> +    {
> +      if (type == TYPE_TARGET_TYPE (type) 
> +	  || TYPE_TARGET_TYPE (type) == NULL)	
> +	return type;
> +      type = TYPE_TARGET_TYPE (type);
> +    }
> + return type;
> +}
> +
>  /* Simulate the C operator ! -- return 1 if ARG1 contains zero.  */
>  
>  int
>
>
> - Aidan
>
> -- aidan@velvet.net http://www.velvet.net/~aidan/ aim:aidans42 http://www.livejournal.com/users/aidan_skinner/ finger for pgp key: 01AA 1594 2DB0 09E3 B850 C2D0 9A2C 4CC9 3EC4 75E1