This is the mail archive of the gdb-patches@sources.redhat.com mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH]: Updates to Ada sources, part 2b (long)




Index: gdb/ada-lang.c
===================================================================
RCS file: /cvs/src/src/gdb/ada-lang.c,v
retrieving revision 1.35
diff -u -p -r1.35 ada-lang.c
--- gdb/ada-lang.c	23 Jan 2004 23:03:28 -0000	1.35
+++ gdb/ada-lang.c	2 Jun 2004 09:52:56 -0000
@@ -6573,26 +8293,25 @@ ada_is_string_type (struct type *type)
 
 /* True if TYPE is a struct type introduced by the compiler to force the
    alignment of a value.  Such types have a single field with a
-   distinctive name. */
+   distinctive name.  */
 
 int
 ada_is_aligner_type (struct type *type)
 {
   CHECK_TYPEDEF (type);
   return (TYPE_CODE (type) == TYPE_CODE_STRUCT
-	  && TYPE_NFIELDS (type) == 1
-	  && DEPRECATED_STREQ (TYPE_FIELD_NAME (type, 0), "F"));
+          && TYPE_NFIELDS (type) == 1
+          && strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
 }
 
 /* If there is an ___XVS-convention type parallel to SUBTYPE, return
-   the parallel type. */
+   the parallel type.  */
 
 struct type *
 ada_get_base_type (struct type *raw_type)
 {
   struct type *real_type_namer;
   struct type *raw_real_type;
-  struct type *real_type;
 
   if (raw_type == NULL || TYPE_CODE (raw_type) != TYPE_CODE_STRUCT)
     return raw_type;
@@ -6610,7 +8329,7 @@ ada_get_base_type (struct type *raw_type
     return raw_real_type;
 }
 
-/* The type of value designated by TYPE, with all aligners removed. */
+/* The type of value designated by TYPE, with all aligners removed.  */
 
 struct type *
 ada_aligned_type (struct type *type)
@@ -6623,82 +8342,110 @@ ada_aligned_type (struct type *type)
 
 
 /* The address of the aligned value in an object at address VALADDR
-   having type TYPE.  Assumes ada_is_aligner_type (TYPE). */
+   having type TYPE.  Assumes ada_is_aligner_type (TYPE).  */
 
 char *
 ada_aligned_value_addr (struct type *type, char *valaddr)
 {
   if (ada_is_aligner_type (type))
     return ada_aligned_value_addr (TYPE_FIELD_TYPE (type, 0),
-				   valaddr +
-				   TYPE_FIELD_BITPOS (type,
-						      0) / TARGET_CHAR_BIT);
+                                   valaddr +
+                                   TYPE_FIELD_BITPOS (type,
+                                                      0) / TARGET_CHAR_BIT);
   else
     return valaddr;
 }
 
+
+
 /* The printed representation of an enumeration literal with encoded
-   name NAME. The value is good to the next call of ada_enum_name. */
+   name NAME.  The value is good to the next call of ada_enum_name.  */
 const char *
 ada_enum_name (const char *name)
 {
+  static char *result;
+  static size_t result_len = 0;
   char *tmp;
 
-  while (1)
-    {
-      if ((tmp = strstr (name, "__")) != NULL)
-	name = tmp + 2;
-      else if ((tmp = strchr (name, '.')) != NULL)
-	name = tmp + 1;
-      else
-	break;
+  /* First, unqualify the enumeration name:
+     1. Search for the last '.' character.  If we find one, then skip
+        all the preceeding characters, the unqualified name starts
+        right after that dot.
+     2. Otherwise, we may be debugging on a target where the compiler
+        translates dots into "__".  Search forward for double underscores,
+        but stop searching when we hit an overloading suffix, which is
+        of the form "__" followed by digits.  */
+
+  if ((tmp = strrchr (name, '.')) != NULL)
+    name = tmp + 1;
+  else
+    {
+      while ((tmp = strstr (name, "__")) != NULL)
+        {
+          if (isdigit (tmp[2]))
+            break;
+          else
+            name = tmp + 2;
+        }
     }
 
   if (name[0] == 'Q')
     {
-      static char result[16];
       int v;
       if (name[1] == 'U' || name[1] == 'W')
-	{
-	  if (sscanf (name + 2, "%x", &v) != 1)
-	    return name;
-	}
+        {
+          if (sscanf (name + 2, "%x", &v) != 1)
+            return name;
+        }
       else
-	return name;
+        return name;
 
+      GROW_VECT (result, result_len, 16);
       if (isascii (v) && isprint (v))
-	sprintf (result, "'%c'", v);
+        sprintf (result, "'%c'", v);
       else if (name[1] == 'U')
-	sprintf (result, "[\"%02x\"]", v);
+        sprintf (result, "[\"%02x\"]", v);
       else
-	sprintf (result, "[\"%04x\"]", v);
+        sprintf (result, "[\"%04x\"]", v);
 
       return result;
     }
   else
-    return name;
+    {
+      if ((tmp = strstr (name, "__")) != NULL
+          || (tmp = strstr (name, "$")) != NULL)
+        {
+          GROW_VECT (result, result_len, tmp - name + 1);
+          strncpy (result, name, tmp - name);
+          result[tmp - name] = '\0';
+          return result;
+        }
+
+      return name;
+    }
 }
 
 static struct value *
 evaluate_subexp (struct type *expect_type, struct expression *exp, int *pos,
-		 enum noside noside)
+                 enum noside noside)
 {
-  return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
+  return (*exp->language_defn->la_exp_desc->evaluate_exp) 
+    (expect_type, exp, pos, noside);
 }
 
 /* Evaluate the subexpression of EXP starting at *POS as for
    evaluate_type, updating *POS to point just past the evaluated
-   expression. */
+   expression.  */
 
 static struct value *
 evaluate_subexp_type (struct expression *exp, int *pos)
 {
-  return (*exp->language_defn->evaluate_exp)
+  return (*exp->language_defn->la_exp_desc->evaluate_exp)
     (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
 }
 
 /* If VAL is wrapped in an aligner or subtype wrapper, return the
-   value it wraps. */
+   value it wraps.  */
 
 static struct value *
 unwrap_value (struct value *val)
@@ -6707,26 +8454,26 @@ unwrap_value (struct value *val)
   if (ada_is_aligner_type (type))
     {
       struct value *v = value_struct_elt (&val, NULL, "F",
-					  NULL, "internal structure");
+                                          NULL, "internal structure");
       struct type *val_type = check_typedef (VALUE_TYPE (v));
       if (ada_type_name (val_type) == NULL)
-	TYPE_NAME (val_type) = ada_type_name (type);
+        TYPE_NAME (val_type) = ada_type_name (type);
 
       return unwrap_value (v);
     }
   else
     {
       struct type *raw_real_type =
-	ada_completed_type (ada_get_base_type (type));
+        ada_completed_type (ada_get_base_type (type));
 
       if (type == raw_real_type)
-	return val;
+        return val;
 
       return
-	coerce_unspec_val_to_type
-	(val, 0, ada_to_fixed_type (raw_real_type, 0,
-				    VALUE_ADDRESS (val) + VALUE_OFFSET (val),
-				    NULL));
+        coerce_unspec_val_to_type
+        (val, ada_to_fixed_type (raw_real_type, 0,
+                                 VALUE_ADDRESS (val) + VALUE_OFFSET (val),
+                                 NULL));
     }
 }
 
@@ -6739,12 +8486,12 @@ cast_to_fixed (struct type *type, struct
     return arg;
   else if (ada_is_fixed_point_type (VALUE_TYPE (arg)))
     val = ada_float_to_fixed (type,
-			      ada_fixed_to_float (VALUE_TYPE (arg),
-						  value_as_long (arg)));
+                              ada_fixed_to_float (VALUE_TYPE (arg),
+                                                  value_as_long (arg)));
   else
     {
       DOUBLEST argd =
-	value_as_double (value_cast (builtin_type_double, value_copy (arg)));
+        value_as_double (value_cast (builtin_type_double, value_copy (arg)));
       val = ada_float_to_fixed (type, argd);
     }
 
@@ -6755,12 +8502,13 @@ static struct value *
 cast_from_fixed_to_double (struct value *arg)
 {
   DOUBLEST val = ada_fixed_to_float (VALUE_TYPE (arg),
-				     value_as_long (arg));
+                                     value_as_long (arg));
   return value_from_double (builtin_type_double, val);
 }
 
-/* Coerce VAL as necessary for assignment to an lval of type TYPE, and 
- * return the converted value. */
+/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
+   return the converted value.  */
+
 static struct value *
 coerce_for_assign (struct type *type, struct value *val)
 {
@@ -6782,20 +8530,98 @@ coerce_for_assign (struct type *type, st
       && TYPE_CODE (type) == TYPE_CODE_ARRAY)
     {
       if (TYPE_LENGTH (type2) != TYPE_LENGTH (type)
-	  || TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
-	  != TYPE_LENGTH (TYPE_TARGET_TYPE (type2)))
-	error ("Incompatible types in assignment");
+          || TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
+          != TYPE_LENGTH (TYPE_TARGET_TYPE (type2)))
+        error ("Incompatible types in assignment");
       VALUE_TYPE (val) = type;
     }
   return val;
 }
 
+static struct value *
+ada_value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
+{
+  struct value *val;
+  struct type *type1, *type2;
+  LONGEST v, v1, v2;
+
+  COERCE_REF (arg1);
+  COERCE_REF (arg2);
+  type1 = base_type (check_typedef (VALUE_TYPE (arg1)));
+  type2 = base_type (check_typedef (VALUE_TYPE (arg2)));
+
+  if (TYPE_CODE (type1) != TYPE_CODE_INT || TYPE_CODE (type2) != TYPE_CODE_INT)
+    return value_binop (arg1, arg2, op);
+
+  switch (op) 
+    {
+    case BINOP_MOD:
+    case BINOP_DIV:
+    case BINOP_REM:
+      break;
+    default:
+      return value_binop (arg1, arg2, op);
+    }
+
+  v2 = value_as_long (arg2);
+  if (v2 == 0)
+    error ("second operand of %s must not be zero.", op_string (op));
+
+  if (TYPE_UNSIGNED (type1) || op == BINOP_MOD)
+    return value_binop (arg1, arg2, op);
+
+  v1 = value_as_long (arg1);
+  switch (op)
+    {
+    case BINOP_DIV:
+      v = v1 / v2;
+      if (! TRUNCATION_TOWARDS_ZERO && v1 * (v1%v2) < 0)
+	v += v > 0 ? -1 : 1;
+      break;
+    case BINOP_REM:
+      v = v1 % v2;
+      if (v*v1 < 0)
+	v -= v2;
+      break;
+    default:
+      /* Should not reach this point.  */
+      v = 0;
+    }
+
+  val = allocate_value (type1);
+  store_unsigned_integer (VALUE_CONTENTS_RAW (val),
+			  TYPE_LENGTH (VALUE_TYPE (val)),
+			  v);
+  return val;
+}
+
+static int
+ada_value_equal (struct value *arg1, struct value *arg2)
+{
+  if (ada_is_direct_array_type (VALUE_TYPE (arg1)) 
+      || ada_is_direct_array_type (VALUE_TYPE (arg2)))
+    {
+      arg1 = ada_coerce_to_simple_array (arg1);
+      arg2 = ada_coerce_to_simple_array (arg2);
+      if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_ARRAY
+	  || TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_ARRAY)
+	error ("Attempt to compare array with non-array");
+      /* FIXME: The following works only for types whose
+	 representations use all bits (no padding or undefined bits)
+	 and do not have user-defined equality.  */
+      return 
+	TYPE_LENGTH (VALUE_TYPE (arg1)) == TYPE_LENGTH (VALUE_TYPE (arg2))
+	&& memcmp (VALUE_CONTENTS (arg1), VALUE_CONTENTS (arg2), 
+		   TYPE_LENGTH (VALUE_TYPE (arg1))) == 0;
+    }
+  return value_equal (arg1, arg2);
+}
+
 struct value *
 ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
-		     int *pos, enum noside noside)
+                     int *pos, enum noside noside)
 {
   enum exp_opcode op;
-  enum ada_attribute atr;
   int tem, tem2, tem3;
   int pc;
   struct value *arg1 = NULL, *arg2 = NULL, *arg3;
@@ -6812,752 +8638,734 @@ ada_evaluate_subexp (struct type *expect
     default:
       *pos -= 1;
       return
-	unwrap_value (evaluate_subexp_standard
-		      (expect_type, exp, pos, noside));
+        unwrap_value (evaluate_subexp_standard
+                      (expect_type, exp, pos, noside));
+
+    case OP_STRING:
+      {
+	struct value *result;
+	*pos -= 1;
+	result = evaluate_subexp_standard (expect_type, exp, pos, noside);
+	/* The result type will have code OP_STRING, bashed there from 
+	   OP_ARRAY.  Bash it back.  */
+	if (TYPE_CODE (VALUE_TYPE (result)) == TYPE_CODE_STRING)
+	  TYPE_CODE (VALUE_TYPE (result)) = TYPE_CODE_ARRAY;
+	return result;
+      }
 
     case UNOP_CAST:
       (*pos) += 2;
       type = exp->elts[pc + 1].type;
       arg1 = evaluate_subexp (type, exp, pos, noside);
       if (noside == EVAL_SKIP)
-	goto nosideret;
+        goto nosideret;
       if (type != check_typedef (VALUE_TYPE (arg1)))
-	{
-	  if (ada_is_fixed_point_type (type))
-	    arg1 = cast_to_fixed (type, arg1);
-	  else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-	    arg1 = value_cast (type, cast_from_fixed_to_double (arg1));
-	  else if (VALUE_LVAL (arg1) == lval_memory)
-	    {
-	      /* This is in case of the really obscure (and undocumented,
-	         but apparently expected) case of (Foo) Bar.all, where Bar 
-	         is an integer constant and Foo is a dynamic-sized type.
-	         If we don't do this, ARG1 will simply be relabeled with
-	         TYPE. */
-	      if (noside == EVAL_AVOID_SIDE_EFFECTS)
-		return value_zero (to_static_fixed_type (type), not_lval);
-	      arg1 =
-		ada_to_fixed_value
-		(type, 0, VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1), 0);
-	    }
-	  else
-	    arg1 = value_cast (type, arg1);
-	}
+        {
+          if (ada_is_fixed_point_type (type))
+            arg1 = cast_to_fixed (type, arg1);
+          else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
+            arg1 = value_cast (type, cast_from_fixed_to_double (arg1));
+          else if (VALUE_LVAL (arg1) == lval_memory)
+            {
+              /* This is in case of the really obscure (and undocumented,
+                 but apparently expected) case of (Foo) Bar.all, where Bar
+                 is an integer constant and Foo is a dynamic-sized type.
+                 If we don't do this, ARG1 will simply be relabeled with
+                 TYPE.  */
+              if (noside == EVAL_AVOID_SIDE_EFFECTS)
+                return value_zero (to_static_fixed_type (type), not_lval);
+              arg1 =
+                ada_to_fixed_value_create
+                (type, VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1), 0);
+            }
+          else
+            arg1 = value_cast (type, arg1);
+        }
       return arg1;
 
-      /* FIXME:  UNOP_QUAL should be defined in expression.h */
-      /*    case UNOP_QUAL:
-         (*pos) += 2;
-         type = exp->elts[pc + 1].type;
-         return ada_evaluate_subexp (type, exp, pos, noside);
-       */
+    case UNOP_QUAL:
+      (*pos) += 2;
+      type = exp->elts[pc + 1].type;
+      return ada_evaluate_subexp (type, exp, pos, noside);
+
     case BINOP_ASSIGN:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
-	return arg1;
-      if (binop_user_defined_p (op, arg1, arg2))
-	return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
+        return arg1;
+      if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
+	arg2 = cast_to_fixed (VALUE_TYPE (arg1), arg2);
+      else if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
+	error
+	  ("Fixed-point values must be assigned to fixed-point variables");
       else
-	{
-	  if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-	    arg2 = cast_to_fixed (VALUE_TYPE (arg1), arg2);
-	  else if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-	    error
-	      ("Fixed-point values must be assigned to fixed-point variables");
-	  else
-	    arg2 = coerce_for_assign (VALUE_TYPE (arg1), arg2);
-	  return ada_value_assign (arg1, arg2);
-	}
+	arg2 = coerce_for_assign (VALUE_TYPE (arg1), arg2);
+      return ada_value_assign (arg1, arg2);
 
     case BINOP_ADD:
       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
       if (noside == EVAL_SKIP)
-	goto nosideret;
-      if (binop_user_defined_p (op, arg1, arg2))
-	return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
-      else
-	{
-	  if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
-	       || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-	      && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
-	    error
-	      ("Operands of fixed-point addition must have the same type");
-	  return value_cast (VALUE_TYPE (arg1), value_add (arg1, arg2));
-	}
+        goto nosideret;
+      if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
+	   || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
+	  && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
+	error
+	  ("Operands of fixed-point addition must have the same type");
+      return value_cast (VALUE_TYPE (arg1), value_add (arg1, arg2));
 
     case BINOP_SUB:
       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
       if (noside == EVAL_SKIP)
-	goto nosideret;
-      if (binop_user_defined_p (op, arg1, arg2))
-	return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
-      else
-	{
-	  if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
-	       || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-	      && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
-	    error
-	      ("Operands of fixed-point subtraction must have the same type");
-	  return value_cast (VALUE_TYPE (arg1), value_sub (arg1, arg2));
-	}
+        goto nosideret;
+      if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
+	   || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
+	  && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
+	error
+	  ("Operands of fixed-point subtraction must have the same type");
+      return value_cast (VALUE_TYPE (arg1), value_sub (arg1, arg2));
 
     case BINOP_MUL:
     case BINOP_DIV:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
+        goto nosideret;
+      else if (noside == EVAL_AVOID_SIDE_EFFECTS
+	       && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
+        return value_zero (VALUE_TYPE (arg1), not_lval);
+      else
+        {
+          if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
+            arg1 = cast_from_fixed_to_double (arg1);
+          if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
+            arg2 = cast_from_fixed_to_double (arg2);
+          return ada_value_binop (arg1, arg2, op);
+        }
+
+    case BINOP_REM:
+    case BINOP_MOD:
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      if (noside == EVAL_SKIP)
 	goto nosideret;
-      if (binop_user_defined_p (op, arg1, arg2))
-	return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
-      else
-	if (noside == EVAL_AVOID_SIDE_EFFECTS
-	    && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
+      else if (noside == EVAL_AVOID_SIDE_EFFECTS
+	       && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
 	return value_zero (VALUE_TYPE (arg1), not_lval);
       else
-	{
-	  if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-	    arg1 = cast_from_fixed_to_double (arg1);
-	  if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
-	    arg2 = cast_from_fixed_to_double (arg2);
-	  return value_binop (arg1, arg2, op);
-	}
+	return ada_value_binop (arg1, arg2, op);
 
-    case UNOP_NEG:
+    case BINOP_EQUAL:
+    case BINOP_NOTEQUAL:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
       if (noside == EVAL_SKIP)
 	goto nosideret;
-      if (unop_user_defined_p (op, arg1))
-	return value_x_unop (arg1, op, EVAL_NORMAL);
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	tem = 0;
+      else
+	tem = ada_value_equal (arg1, arg2);
+      if (op == BINOP_NOTEQUAL)
+	tem = ! tem;
+      return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
+
+    case UNOP_NEG:
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      if (noside == EVAL_SKIP)
+        goto nosideret;
       else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
-	return value_cast (VALUE_TYPE (arg1), value_neg (arg1));
+        return value_cast (VALUE_TYPE (arg1), value_neg (arg1));
       else
-	return value_neg (arg1);
+        return value_neg (arg1);
 
-      /* FIXME:  OP_UNRESOLVED_VALUE should be defined in expression.h */
-      /*    case OP_UNRESOLVED_VALUE:
-         /* Only encountered when an unresolved symbol occurs in a
-         context other than a function call, in which case, it is
-   illegal. *//*
-   (*pos) += 3;
-   if (noside == EVAL_SKIP)
-   goto nosideret;
-   else 
-   error ("Unexpected unresolved symbol, %s, during evaluation",
-   ada_demangle (exp->elts[pc + 2].name));
- */
     case OP_VAR_VALUE:
       *pos -= 1;
       if (noside == EVAL_SKIP)
-	{
-	  *pos += 4;
-	  goto nosideret;
-	}
+        {
+          *pos += 4;
+          goto nosideret;
+        }
+      else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
+	/* Only encountered when an unresolved symbol occurs in a
+	   context other than a function call, in which case, it is
+	   illegal.  */
+        error ("Unexpected unresolved symbol, %s, during evaluation",
+               SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	{
-	  *pos += 4;
-	  return value_zero
-	    (to_static_fixed_type
-	     (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
-	     not_lval);
-	}
-      else
-	{
-	  arg1 =
-	    unwrap_value (evaluate_subexp_standard
-			  (expect_type, exp, pos, noside));
-	  return ada_to_fixed_value (VALUE_TYPE (arg1), 0,
-				     VALUE_ADDRESS (arg1) +
-				     VALUE_OFFSET (arg1), arg1);
-	}
+        {
+          *pos += 4;
+          return value_zero
+            (to_static_fixed_type
+             (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
+             not_lval);
+        }
+      else
+        {
+          arg1 =
+            unwrap_value (evaluate_subexp_standard
+                          (expect_type, exp, pos, noside));
+          return ada_to_fixed_value (arg1);
+        }
+
+    case OP_FUNCALL:
+      (*pos) += 2;
+
+      /* Allocate arg vector, including space for the function to be
+         called in argvec[0] and a terminating NULL.  */
+      nargs = longest_to_int (exp->elts[pc + 1].longconst);
+      argvec =
+        (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
+
+      if (exp->elts[*pos].opcode == OP_VAR_VALUE
+	  && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
+        error ("Unexpected unresolved symbol, %s, during evaluation",
+               SYMBOL_PRINT_NAME (exp->elts[pc + 5].symbol));
+      else
+        {
+          for (tem = 0; tem <= nargs; tem += 1)
+            argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+          argvec[tem] = 0;
+
+          if (noside == EVAL_SKIP)
+            goto nosideret;
+        }
+
+      if (ada_is_packed_array_type (desc_base_type (VALUE_TYPE (argvec[0]))))
+        argvec[0] = ada_coerce_to_simple_array (argvec[0]);
+      else if (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_REF
+          || (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_ARRAY
+              && VALUE_LVAL (argvec[0]) == lval_memory))
+        argvec[0] = value_addr (argvec[0]);
+
+      type = check_typedef (VALUE_TYPE (argvec[0]));
+      if (TYPE_CODE (type) == TYPE_CODE_PTR)
+        {
+          switch (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (type))))
+            {
+            case TYPE_CODE_FUNC:
+              type = check_typedef (TYPE_TARGET_TYPE (type));
+              break;
+            case TYPE_CODE_ARRAY:
+              break;
+            case TYPE_CODE_STRUCT:
+              if (noside != EVAL_AVOID_SIDE_EFFECTS)
+                argvec[0] = ada_value_ind (argvec[0]);
+              type = check_typedef (TYPE_TARGET_TYPE (type));
+              break;
+            default:
+              error ("cannot subscript or call something of type `%s'",
+                     ada_type_name (VALUE_TYPE (argvec[0])));
+              break;
+            }
+        }
+
+      switch (TYPE_CODE (type))
+        {
+        case TYPE_CODE_FUNC:
+          if (noside == EVAL_AVOID_SIDE_EFFECTS)
+            return allocate_value (TYPE_TARGET_TYPE (type));
+          return call_function_by_hand (argvec[0], nargs, argvec + 1);
+        case TYPE_CODE_STRUCT:
+          {
+            int arity;
+
+            /* Make sure to use the parallel ___XVS type if any.
+               Otherwise, we won't be able to find the array arity
+               and element type.  */
+            type = ada_get_base_type (type);
+
+            arity = ada_array_arity (type);
+            type = ada_array_element_type (type, nargs);
+            if (type == NULL)
+              error ("cannot subscript or call a record");
+            if (arity != nargs)
+              error ("wrong number of subscripts; expecting %d", arity);
+            if (noside == EVAL_AVOID_SIDE_EFFECTS)
+              return allocate_value (ada_aligned_type (type));
+            return
+              unwrap_value (ada_value_subscript
+                            (argvec[0], nargs, argvec + 1));
+          }
+        case TYPE_CODE_ARRAY:
+          if (noside == EVAL_AVOID_SIDE_EFFECTS)
+            {
+              type = ada_array_element_type (type, nargs);
+              if (type == NULL)
+                error ("element type of array unknown");
+              else
+                return allocate_value (ada_aligned_type (type));
+            }
+          return
+            unwrap_value (ada_value_subscript
+                          (ada_coerce_to_simple_array (argvec[0]),
+                           nargs, argvec + 1));
+        case TYPE_CODE_PTR:     /* Pointer to array */
+          type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
+          if (noside == EVAL_AVOID_SIDE_EFFECTS)
+            {
+              type = ada_array_element_type (type, nargs);
+              if (type == NULL)
+                error ("element type of array unknown");
+              else
+                return allocate_value (ada_aligned_type (type));
+            }
+          return
+            unwrap_value (ada_value_ptr_subscript (argvec[0], type,
+                                                   nargs, argvec + 1));
+
+        default:
+          error ("Internal error in evaluate_subexp");
+        }
+
+    case TERNOP_SLICE:
+      {
+        struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+        struct value *low_bound_val =
+          evaluate_subexp (NULL_TYPE, exp, pos, noside);
+        LONGEST low_bound = pos_atr (low_bound_val);
+        LONGEST high_bound
+          = pos_atr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+        if (noside == EVAL_SKIP)
+          goto nosideret;
+
+        /* If this is a reference type or a pointer type, and
+           the target type has an XVS parallel type, then get
+           the real target type.  */
+        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
+            || TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR)
+          TYPE_TARGET_TYPE (VALUE_TYPE (array)) =
+            ada_get_base_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)));
+
+        /* If this is a reference to an aligner type, then remove all
+           the aligners.  */
+        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
+            && ada_is_aligner_type (TYPE_TARGET_TYPE (VALUE_TYPE (array))))
+          TYPE_TARGET_TYPE (VALUE_TYPE (array)) =
+            ada_aligned_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)));
+
+	if (ada_is_packed_array_type (VALUE_TYPE (array)))
+	  error ("cannot slice a packed array");
+
+        /* If this is a reference to an array or an array lvalue,
+           convert to a pointer.  */
+        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
+            || (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_ARRAY
+                && VALUE_LVAL (array) == lval_memory))
+          array = value_addr (array);
+
+        if (noside == EVAL_AVOID_SIDE_EFFECTS &&
+            ada_is_array_descriptor_type (check_typedef (VALUE_TYPE (array))))
+          {
+            /* Try dereferencing the array, in case it is an access
+               to array.  */
+            struct type *arrType = ada_type_of_array (array, 0);
+            if (arrType != NULL)
+              array = value_at_lazy (arrType, 0, NULL);
+          }
+
+        array = ada_coerce_to_simple_array_ptr (array);
+
+        /* When EVAL_AVOID_SIDE_EFFECTS, we may get the bounds wrong,
+           but only in contexts where the value is not being requested
+           (FIXME?).  */
+        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR)
+          {
+            if (noside == EVAL_AVOID_SIDE_EFFECTS)
+              return ada_value_ind (array);
+            else if (high_bound < low_bound)
+              return empty_array (TYPE_TARGET_TYPE (VALUE_TYPE (array)),
+                                  low_bound);
+            else
+              {
+                struct type *arr_type0 =
+                  to_fixed_array_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)),
+                                       NULL, 1);
+                struct value *item0 =
+                  ada_value_ptr_subscript (array, arr_type0, 1,
+                                           &low_bound_val);
+                struct value *slice =
+                  value_repeat (item0, high_bound - low_bound + 1);
+                struct type *arr_type1 = VALUE_TYPE (slice);
+                TYPE_LOW_BOUND (TYPE_INDEX_TYPE (arr_type1)) = low_bound;
+                TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (arr_type1)) += low_bound;
+                return slice;
+              }
+          }
+        else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+          return array;
+        else if (high_bound < low_bound)
+          return empty_array (VALUE_TYPE (array), low_bound);
+        else
+          return value_slice (array, low_bound, high_bound - low_bound + 1);
+      }
+
+    case UNOP_IN_RANGE:
+      (*pos) += 2;
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      type = exp->elts[pc + 1].type;
+
+      if (noside == EVAL_SKIP)
+        goto nosideret;
+
+      switch (TYPE_CODE (type))
+        {
+        default:
+          lim_warning ("Membership test incompletely implemented; "
+                       "always returns true", 0);
+          return value_from_longest (builtin_type_int, (LONGEST) 1);
+
+        case TYPE_CODE_RANGE:
+          arg2 = value_from_longest (builtin_type_int,
+                                     TYPE_LOW_BOUND (type));
+          arg3 = value_from_longest (builtin_type_int,
+                                     TYPE_HIGH_BOUND (type));
+          return
+            value_from_longest (builtin_type_int,
+                                (value_less (arg1, arg3)
+                                 || value_equal (arg1, arg3))
+                                && (value_less (arg2, arg1)
+                                    || value_equal (arg2, arg1)));
+        }
 
-    case OP_ARRAY:
-      (*pos) += 3;
-      tem2 = longest_to_int (exp->elts[pc + 1].longconst);
-      tem3 = longest_to_int (exp->elts[pc + 2].longconst);
-      nargs = tem3 - tem2 + 1;
-      type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
+    case BINOP_IN_BOUNDS:
+      (*pos) += 2;
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 
-      argvec =
-	(struct value * *) alloca (sizeof (struct value *) * (nargs + 1));
-      for (tem = 0; tem == 0 || tem < nargs; tem += 1)
-	/* At least one element gets inserted for the type */
-	{
-	  /* Ensure that array expressions are coerced into pointer objects. */
-	  argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
-	}
       if (noside == EVAL_SKIP)
-	goto nosideret;
-      return value_array (tem2, tem3, argvec);
+        goto nosideret;
 
-    case OP_FUNCALL:
-      (*pos) += 2;
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+        return value_zero (builtin_type_int, not_lval);
 
-      /* Allocate arg vector, including space for the function to be
-         called in argvec[0] and a terminating NULL */
-      nargs = longest_to_int (exp->elts[pc + 1].longconst);
-      argvec =
-	(struct value * *) alloca (sizeof (struct value *) * (nargs + 2));
+      tem = longest_to_int (exp->elts[pc + 1].longconst);
 
-      /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
-      /* FIXME: name should be defined in expresion.h */
-      /*      if (exp->elts[*pos].opcode == OP_UNRESOLVED_VALUE)
-         error ("Unexpected unresolved symbol, %s, during evaluation",
-         ada_demangle (exp->elts[pc + 5].name));
-       */
-      if (0)
-	{
-	  error ("unexpected code path, FIXME");
-	}
-      else
-	{
-	  for (tem = 0; tem <= nargs; tem += 1)
-	    argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-	  argvec[tem] = 0;
+      if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg2)))
+        error ("invalid dimension number to '%s", "range");
 
-	  if (noside == EVAL_SKIP)
-	    goto nosideret;
-	}
+      arg3 = ada_array_bound (arg2, tem, 1);
+      arg2 = ada_array_bound (arg2, tem, 0);
 
-      if (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_REF)
-	argvec[0] = value_addr (argvec[0]);
+      return
+        value_from_longest (builtin_type_int,
+                            (value_less (arg1, arg3)
+                             || value_equal (arg1, arg3))
+                            && (value_less (arg2, arg1)
+                                || value_equal (arg2, arg1)));
 
-      if (ada_is_packed_array_type (VALUE_TYPE (argvec[0])))
-	argvec[0] = ada_coerce_to_simple_array (argvec[0]);
+    case TERNOP_IN_RANGE:
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 
-      type = check_typedef (VALUE_TYPE (argvec[0]));
-      if (TYPE_CODE (type) == TYPE_CODE_PTR)
-	{
-	  switch (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (type))))
-	    {
-	    case TYPE_CODE_FUNC:
-	      type = check_typedef (TYPE_TARGET_TYPE (type));
-	      break;
-	    case TYPE_CODE_ARRAY:
-	      break;
-	    case TYPE_CODE_STRUCT:
-	      if (noside != EVAL_AVOID_SIDE_EFFECTS)
-		argvec[0] = ada_value_ind (argvec[0]);
-	      type = check_typedef (TYPE_TARGET_TYPE (type));
-	      break;
-	    default:
-	      error ("cannot subscript or call something of type `%s'",
-		     ada_type_name (VALUE_TYPE (argvec[0])));
-	      break;
-	    }
-	}
+      if (noside == EVAL_SKIP)
+        goto nosideret;
 
-      switch (TYPE_CODE (type))
-	{
-	case TYPE_CODE_FUNC:
-	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	    return allocate_value (TYPE_TARGET_TYPE (type));
-	  return call_function_by_hand (argvec[0], nargs, argvec + 1);
-	case TYPE_CODE_STRUCT:
+      return
+        value_from_longest (builtin_type_int,
+                            (value_less (arg1, arg3)
+                             || value_equal (arg1, arg3))
+                            && (value_less (arg2, arg1)
+                                || value_equal (arg2, arg1)));
+
+    case OP_ATR_FIRST:
+    case OP_ATR_LAST:
+    case OP_ATR_LENGTH:
+      {
+	struct type *type_arg;
+	if (exp->elts[*pos].opcode == OP_TYPE)
 	  {
-	    int arity = ada_array_arity (type);
-	    type = ada_array_element_type (type, nargs);
-	    if (type == NULL)
-	      error ("cannot subscript or call a record");
-	    if (arity != nargs)
-	      error ("wrong number of subscripts; expecting %d", arity);
-	    if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	      return allocate_value (ada_aligned_type (type));
-	    return
-	      unwrap_value (ada_value_subscript
-			    (argvec[0], nargs, argvec + 1));
+	    evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
+	    arg1 = NULL;
+	    type_arg = exp->elts[pc + 2].type;
+	  }
+	else
+	  {
+	    arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+	    type_arg = NULL;
 	  }
-	case TYPE_CODE_ARRAY:
-	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	    {
-	      type = ada_array_element_type (type, nargs);
-	      if (type == NULL)
-		error ("element type of array unknown");
-	      else
-		return allocate_value (ada_aligned_type (type));
-	    }
-	  return
-	    unwrap_value (ada_value_subscript
-			  (ada_coerce_to_simple_array (argvec[0]),
-			   nargs, argvec + 1));
-	case TYPE_CODE_PTR:	/* Pointer to array */
-	  type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
-	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	    {
-	      type = ada_array_element_type (type, nargs);
-	      if (type == NULL)
-		error ("element type of array unknown");
-	      else
-		return allocate_value (ada_aligned_type (type));
-	    }
-	  return
-	    unwrap_value (ada_value_ptr_subscript (argvec[0], type,
-						   nargs, argvec + 1));
 
-	default:
-	  error ("Internal error in evaluate_subexp");
-	}
+	if (exp->elts[*pos].opcode != OP_LONG)
+	  error ("illegal operand to '%s", ada_attribute_name (op));
+	tem = longest_to_int (exp->elts[*pos + 2].longconst);
+	*pos += 4;
 
-    case TERNOP_SLICE:
-      {
-	struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-	int lowbound
-	  = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
-	int upper
-	  = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 	if (noside == EVAL_SKIP)
 	  goto nosideret;
 
-	/* If this is a reference to an array, then dereference it */
-	if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
-	    && TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL
-	    && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) ==
-	    TYPE_CODE_ARRAY
-	    && !ada_is_array_descriptor (check_typedef (VALUE_TYPE (array))))
+	if (type_arg == NULL)
 	  {
-	    array = ada_coerce_ref (array);
-	  }
+	    arg1 = ada_coerce_ref (arg1);
 
-	if (noside == EVAL_AVOID_SIDE_EFFECTS &&
-	    ada_is_array_descriptor (check_typedef (VALUE_TYPE (array))))
-	  {
-	    /* Try to dereference the array, in case it is an access to array */
-	    struct type *arrType = ada_type_of_array (array, 0);
-	    if (arrType != NULL)
-	      array = value_at_lazy (arrType, 0, NULL);
-	  }
-	if (ada_is_array_descriptor (VALUE_TYPE (array)))
-	  array = ada_coerce_to_simple_array (array);
+	    if (ada_is_packed_array_type (VALUE_TYPE (arg1)))
+	      arg1 = ada_coerce_to_simple_array (arg1);
+
+	    if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg1)))
+	      error ("invalid dimension number to '%s",
+		     ada_attribute_name (op));
+
+	    if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	      {
+		type = ada_index_type (VALUE_TYPE (arg1), tem);
+		if (type == NULL)
+		  error
+		    ("attempt to take bound of something that is not an array");
+		return allocate_value (type);
+	      }
 
-	/* If at this point we have a pointer to an array, it means that
-	   it is a pointer to a simple (non-ada) array. We just then
-	   dereference it */
-	if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR
-	    && TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL
-	    && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) ==
-	    TYPE_CODE_ARRAY)
+	    switch (op)
+	      {
+	      default: /* Should never happen.  */
+		error ("unexpected attribute encountered");
+	      case OP_ATR_FIRST:
+		return ada_array_bound (arg1, tem, 0);
+	      case OP_ATR_LAST:
+		return ada_array_bound (arg1, tem, 1);
+	      case OP_ATR_LENGTH:
+		return ada_array_length (arg1, tem);
+	      }
+	  }
+	else if (discrete_type_p (type_arg))
 	  {
-	    array = ada_value_ind (array);
+	    struct type *range_type;
+	    char *name = ada_type_name (type_arg);
+	    range_type = NULL;
+	    if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
+	      range_type =
+		to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
+	    if (range_type == NULL)
+	      range_type = type_arg;
+	    switch (op)
+	      {
+	      default:
+		error ("unexpected attribute encountered");
+	      case OP_ATR_FIRST:
+		return discrete_type_low_bound (range_type);
+	      case OP_ATR_LAST:
+		return discrete_type_high_bound (range_type);
+	      case OP_ATR_LENGTH:
+		error ("the 'length attribute applies only to array types");
+	      }
 	  }
-
-	if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	  /* The following will get the bounds wrong, but only in contexts
-	     where the value is not being requested (FIXME?). */
-	  return array;
+	else if (TYPE_CODE (type_arg) == TYPE_CODE_FLT)
+	  error ("unimplemented type attribute");
 	else
-	  return value_slice (array, lowbound, upper - lowbound + 1);
+	  {
+	    LONGEST low, high;
+
+	    if (ada_is_packed_array_type (type_arg))
+	      type_arg = decode_packed_array_type (type_arg);
+
+	    if (tem < 1 || tem > ada_array_arity (type_arg))
+	      error ("invalid dimension number to '%s",
+		     ada_attribute_name (op));
+
+	    type = ada_index_type (type_arg, tem);
+	    if (type == NULL)
+	      error ("attempt to take bound of something that is not an array");
+	    if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	      return allocate_value (type);
+
+	    switch (op)
+	      {
+	      default:
+		error ("unexpected attribute encountered");
+	      case OP_ATR_FIRST:
+		low = ada_array_bound_from_type (type_arg, tem, 0, &type);
+		return value_from_longest (type, low);
+	      case OP_ATR_LAST:
+		high =
+		  ada_array_bound_from_type (type_arg, tem, 1, &type);
+		return value_from_longest (type, high);
+	      case OP_ATR_LENGTH:
+		low = ada_array_bound_from_type (type_arg, tem, 0, &type);
+		high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
+		return value_from_longest (type, high - low + 1);
+	      }
+	  }
       }
 
-      /* FIXME: UNOP_MBR should be defined in expression.h */
-      /*    case UNOP_MBR:
-         (*pos) += 2;
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         type = exp->elts[pc + 1].type;
-
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-
-         switch (TYPE_CODE (type)) 
-         {
-         default:
-         warning ("Membership test incompletely implemented; always returns true");
-         return value_from_longest (builtin_type_int, (LONGEST) 1);
-
-         case TYPE_CODE_RANGE:
-         arg2 = value_from_longest (builtin_type_int, 
-         (LONGEST) TYPE_LOW_BOUND (type));
-         arg3 = value_from_longest (builtin_type_int, 
-         (LONGEST) TYPE_HIGH_BOUND (type));
-         return 
-         value_from_longest (builtin_type_int,
-         (value_less (arg1,arg3) 
-         || value_equal (arg1,arg3))
-         && (value_less (arg2,arg1)
-         || value_equal (arg2,arg1)));
-         }
-       */
-      /* FIXME: BINOP_MBR should be defined in expression.h */
-      /*    case BINOP_MBR:
-         (*pos) += 2;
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-
-         if (noside == EVAL_AVOID_SIDE_EFFECTS)
-         return value_zero (builtin_type_int, not_lval);
-
-         tem = longest_to_int (exp->elts[pc + 1].longconst);
-
-         if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg2)))
-         error ("invalid dimension number to '%s", "range");
-
-         arg3 = ada_array_bound (arg2, tem, 1);
-         arg2 = ada_array_bound (arg2, tem, 0);
-
-         return 
-         value_from_longest (builtin_type_int,
-         (value_less (arg1,arg3) 
-         || value_equal (arg1,arg3))
-         && (value_less (arg2,arg1)
-         || value_equal (arg2,arg1)));
-       */
-      /* FIXME: TERNOP_MBR should be defined in expression.h */
-      /*    case TERNOP_MBR:
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-
-         return 
-         value_from_longest (builtin_type_int,
-         (value_less (arg1,arg3) 
-         || value_equal (arg1,arg3))
-         && (value_less (arg2,arg1)
-         || value_equal (arg2,arg1)));
-       */
-      /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
-      /*    case OP_ATTRIBUTE:
-         *pos += 3;
-         atr = (enum ada_attribute) longest_to_int (exp->elts[pc + 2].longconst);
-         switch (atr) 
-         {
-         default:
-         error ("unexpected attribute encountered");
-
-         case ATR_FIRST:
-         case ATR_LAST:
-         case ATR_LENGTH:
-         {
-         struct type* type_arg;
-         if (exp->elts[*pos].opcode == OP_TYPE)
-         {
-         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-         arg1 = NULL;
-         type_arg = exp->elts[pc + 5].type;
-         }
-         else
-         {
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         type_arg = NULL;
-         }
-
-         if (exp->elts[*pos].opcode != OP_LONG) 
-         error ("illegal operand to '%s", ada_attribute_name (atr));
-         tem = longest_to_int (exp->elts[*pos+2].longconst);
-         *pos += 4;
-
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-
-         if (type_arg == NULL)
-         {
-         arg1 = ada_coerce_ref (arg1);
-
-         if (ada_is_packed_array_type (VALUE_TYPE (arg1)))
-         arg1 = ada_coerce_to_simple_array (arg1);
-
-         if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg1)))
-         error ("invalid dimension number to '%s", 
-         ada_attribute_name (atr));
-
-         if (noside == EVAL_AVOID_SIDE_EFFECTS)
-         {
-         type = ada_index_type (VALUE_TYPE (arg1), tem);
-         if (type == NULL) 
-         error ("attempt to take bound of something that is not an array");
-         return allocate_value (type);
-         }
-
-         switch (atr) 
-         {
-         default: 
-         error ("unexpected attribute encountered");
-         case ATR_FIRST:
-         return ada_array_bound (arg1, tem, 0);
-         case ATR_LAST:
-         return ada_array_bound (arg1, tem, 1);
-         case ATR_LENGTH:
-         return ada_array_length (arg1, tem);
-         }
-         }
-         else if (TYPE_CODE (type_arg) == TYPE_CODE_RANGE
-         || TYPE_CODE (type_arg) == TYPE_CODE_INT) 
-         {
-         struct type* range_type;
-         char* name = ada_type_name (type_arg);
-         if (name == NULL)
-         {
-         if (TYPE_CODE (type_arg) == TYPE_CODE_RANGE) 
-         range_type = type_arg;
-         else
-         error ("unimplemented type attribute");
-         }
-         else 
-         range_type = 
-         to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
-         switch (atr) 
-         {
-         default: 
-         error ("unexpected attribute encountered");
-         case ATR_FIRST:
-         return value_from_longest (TYPE_TARGET_TYPE (range_type),
-         TYPE_LOW_BOUND (range_type));
-         case ATR_LAST:
-         return value_from_longest (TYPE_TARGET_TYPE (range_type),
-         TYPE_HIGH_BOUND (range_type));
-         }
-         }              
-         else if (TYPE_CODE (type_arg) == TYPE_CODE_ENUM)
-         {
-         switch (atr) 
-         {
-         default: 
-         error ("unexpected attribute encountered");
-         case ATR_FIRST:
-         return value_from_longest 
-         (type_arg, TYPE_FIELD_BITPOS (type_arg, 0));
-         case ATR_LAST:
-         return value_from_longest 
-         (type_arg, 
-         TYPE_FIELD_BITPOS (type_arg,
-         TYPE_NFIELDS (type_arg) - 1));
-         }
-         }
-         else if (TYPE_CODE (type_arg) == TYPE_CODE_FLT)
-         error ("unimplemented type attribute");
-         else 
-         {
-         LONGEST low, high;
-
-         if (ada_is_packed_array_type (type_arg))
-         type_arg = decode_packed_array_type (type_arg);
-
-         if (tem < 1 || tem > ada_array_arity (type_arg))
-         error ("invalid dimension number to '%s", 
-         ada_attribute_name (atr));
-
-         if (noside == EVAL_AVOID_SIDE_EFFECTS)
-         {
-         type = ada_index_type (type_arg, tem);
-         if (type == NULL) 
-         error ("attempt to take bound of something that is not an array");
-         return allocate_value (type);
-         }
-
-         switch (atr) 
-         {
-         default: 
-         error ("unexpected attribute encountered");
-         case ATR_FIRST:
-         low = ada_array_bound_from_type (type_arg, tem, 0, &type);
-         return value_from_longest (type, low);
-         case ATR_LAST:
-         high = ada_array_bound_from_type (type_arg, tem, 1, &type);
-         return value_from_longest (type, high);
-         case ATR_LENGTH:
-         low = ada_array_bound_from_type (type_arg, tem, 0, &type);
-         high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
-         return value_from_longest (type, high-low+1);
-         }
-         }
-         }
-
-         case ATR_TAG:
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-
-         if (noside == EVAL_AVOID_SIDE_EFFECTS)
-         return         
-         value_zero (ada_tag_type (arg1), not_lval);
-
-         return ada_value_tag (arg1);
-
-         case ATR_MIN:
-         case ATR_MAX:
-         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-         return value_zero (VALUE_TYPE (arg1), not_lval);
-         else
-         return value_binop (arg1, arg2, 
-         atr == ATR_MIN ? BINOP_MIN : BINOP_MAX);
-
-         case ATR_MODULUS:
-         {
-         struct type* type_arg = exp->elts[pc + 5].type;
-         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-         *pos += 4;
-
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-
-         if (! ada_is_modular_type (type_arg))
-         error ("'modulus must be applied to modular type");
-
-         return value_from_longest (TYPE_TARGET_TYPE (type_arg),
-         ada_modulus (type_arg));
-         }
-
-
-         case ATR_POS:
-         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-         return value_zero (builtin_type_ada_int, not_lval);
-         else 
-         return value_pos_atr (arg1);
-
-         case ATR_SIZE:
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-         return value_zero (builtin_type_ada_int, not_lval);
-         else
-         return value_from_longest (builtin_type_ada_int,
-         TARGET_CHAR_BIT 
-         * TYPE_LENGTH (VALUE_TYPE (arg1)));
-
-         case ATR_VAL:
-         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
-         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-         type = exp->elts[pc + 5].type;
-         if (noside == EVAL_SKIP)
-         goto nosideret;
-         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-         return value_zero (type, not_lval);
-         else 
-         return value_val_atr (type, arg1);
-         } */
-    case BINOP_EXP:
+    case OP_ATR_TAG:
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      if (noside == EVAL_SKIP)
+	goto nosideret;
+
+      if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	return value_zero (ada_tag_type (arg1), not_lval);
+
+      return ada_value_tag (arg1);
+
+    case OP_ATR_MIN:
+    case OP_ATR_MAX:
+      evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
 	goto nosideret;
-      if (binop_user_defined_p (op, arg1, arg2))
-	return unwrap_value (value_x_binop (arg1, arg2, op, OP_NULL,
-					    EVAL_NORMAL));
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
 	return value_zero (VALUE_TYPE (arg1), not_lval);
       else
-	return value_binop (arg1, arg2, op);
+	return value_binop (arg1, arg2,
+			    op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
 
-    case UNOP_PLUS:
+    case OP_ATR_MODULUS:
+      {
+	struct type *type_arg = exp->elts[pc + 2].type;
+	evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
+
+	if (noside == EVAL_SKIP)
+	  goto nosideret;
+
+	if (!ada_is_modular_type (type_arg))
+	  error ("'modulus must be applied to modular type");
+
+	return value_from_longest (TYPE_TARGET_TYPE (type_arg),
+				   ada_modulus (type_arg));
+      }
+
+
+    case OP_ATR_POS:
+      evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
 	goto nosideret;
-      if (unop_user_defined_p (op, arg1))
-	return unwrap_value (value_x_unop (arg1, op, EVAL_NORMAL));
+      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	return value_zero (builtin_type_ada_int, not_lval);
       else
-	return arg1;
+	return value_pos_atr (arg1);
 
-    case UNOP_ABS:
+    case OP_ATR_SIZE:
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      if (noside == EVAL_SKIP)
+	goto nosideret;
+      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	return value_zero (builtin_type_ada_int, not_lval);
+      else
+	return value_from_longest (builtin_type_ada_int,
+				   TARGET_CHAR_BIT
+				   * TYPE_LENGTH (VALUE_TYPE (arg1)));
+
+    case OP_ATR_VAL:
+      evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      type = exp->elts[pc + 2].type;
       if (noside == EVAL_SKIP)
 	goto nosideret;
+      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	return value_zero (type, not_lval);
+      else
+	return value_val_atr (type, arg1);
+
+    case BINOP_EXP:
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      if (noside == EVAL_SKIP)
+        goto nosideret;
+      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+        return value_zero (VALUE_TYPE (arg1), not_lval);
+      else
+        return value_binop (arg1, arg2, op);
+
+    case UNOP_PLUS:
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      if (noside == EVAL_SKIP)
+        goto nosideret;
+      else
+        return arg1;
+
+    case UNOP_ABS:
+      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+      if (noside == EVAL_SKIP)
+        goto nosideret;
       if (value_less (arg1, value_zero (VALUE_TYPE (arg1), not_lval)))
-	return value_neg (arg1);
+        return value_neg (arg1);
       else
-	return arg1;
+        return arg1;
 
     case UNOP_IND:
       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
-	expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
+        expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
       if (noside == EVAL_SKIP)
-	goto nosideret;
+        goto nosideret;
       type = check_typedef (VALUE_TYPE (arg1));
       if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	{
-	  if (ada_is_array_descriptor (type))
-	    /* GDB allows dereferencing GNAT array descriptors. */
-	    {
-	      struct type *arrType = ada_type_of_array (arg1, 0);
-	      if (arrType == NULL)
-		error ("Attempt to dereference null array pointer.");
-	      return value_at_lazy (arrType, 0, NULL);
-	    }
-	  else if (TYPE_CODE (type) == TYPE_CODE_PTR
-		   || TYPE_CODE (type) == TYPE_CODE_REF
-		   /* In C you can dereference an array to get the 1st elt.  */
-		   || TYPE_CODE (type) == TYPE_CODE_ARRAY)
-	    return
-	      value_zero
-	      (to_static_fixed_type
-	       (ada_aligned_type (check_typedef (TYPE_TARGET_TYPE (type)))),
-	       lval_memory);
-	  else if (TYPE_CODE (type) == TYPE_CODE_INT)
-	    /* GDB allows dereferencing an int.  */
-	    return value_zero (builtin_type_int, lval_memory);
-	  else
-	    error ("Attempt to take contents of a non-pointer value.");
-	}
-      arg1 = ada_coerce_ref (arg1);
+        {
+          if (ada_is_array_descriptor_type (type))
+            /* GDB allows dereferencing GNAT array descriptors.  */
+            {
+              struct type *arrType = ada_type_of_array (arg1, 0);
+              if (arrType == NULL)
+                error ("Attempt to dereference null array pointer.");
+              return value_at_lazy (arrType, 0, NULL);
+            }
+          else if (TYPE_CODE (type) == TYPE_CODE_PTR
+                   || TYPE_CODE (type) == TYPE_CODE_REF
+                   /* In C you can dereference an array to get the 1st elt.  */
+                   || TYPE_CODE (type) == TYPE_CODE_ARRAY)
+            return
+              value_zero
+              (to_static_fixed_type
+               (ada_aligned_type (check_typedef (TYPE_TARGET_TYPE (type)))),
+               lval_memory);
+          else if (TYPE_CODE (type) == TYPE_CODE_INT)
+            /* GDB allows dereferencing an int.  */
+            return value_zero (builtin_type_int, lval_memory);
+          else
+            error ("Attempt to take contents of a non-pointer value.");
+        }
+      arg1 = ada_coerce_ref (arg1);  /* FIXME: What is this for?? */
       type = check_typedef (VALUE_TYPE (arg1));
 
-      if (ada_is_array_descriptor (type))
-	/* GDB allows dereferencing GNAT array descriptors. */
-	return ada_coerce_to_simple_array (arg1);
+      if (ada_is_array_descriptor_type (type))
+        /* GDB allows dereferencing GNAT array descriptors.  */
+        return ada_coerce_to_simple_array (arg1);
       else
-	return ada_value_ind (arg1);
+        return ada_value_ind (arg1);
 
     case STRUCTOP_STRUCT:
       tem = longest_to_int (exp->elts[pc + 1].longconst);
       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)
-	goto nosideret;
+        goto nosideret;
       if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	return value_zero (ada_aligned_type
-			   (ada_lookup_struct_elt_type (VALUE_TYPE (arg1),
-							&exp->elts[pc +
-								   2].string,
-							0, NULL)),
-			   lval_memory);
-      else
-	return unwrap_value (ada_value_struct_elt (arg1,
-						   &exp->elts[pc + 2].string,
-						   "record"));
+	{
+	  struct type *type1 = VALUE_TYPE (arg1);
+	  if (ada_is_tagged_type (type1, 1)) 
+	    {
+	      type = ada_lookup_struct_elt_type (type1, 
+						 &exp->elts[pc + 2].string,
+						 1, 1, NULL);
+	      if (type == NULL)
+	    /* In this case, we assume that the field COULD exist
+	       in some extension of the type.  Return an object of 
+	       "type" void, which will match any formal 
+	       (see ada_type_match). */
+		return value_zero (builtin_type_void, lval_memory);
+	    }
+	  else
+	    type = ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string,
+					       1, 0, NULL);
+
+	  return value_zero (ada_aligned_type (type), lval_memory);
+	}
+      else
+        return 
+	  ada_to_fixed_value (unwrap_value 
+			      (ada_value_struct_elt
+			       (arg1, &exp->elts[pc + 2].string, "record")));
     case OP_TYPE:
-      /* The value is not supposed to be used. This is here to make it
-         easier to accommodate expressions that contain types. */
+      /* The value is not supposed to be used.  This is here to make it
+         easier to accommodate expressions that contain types.  */
       (*pos) += 2;
       if (noside == EVAL_SKIP)
-	goto nosideret;
+        goto nosideret;
       else if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	return allocate_value (builtin_type_void);
+        return allocate_value (builtin_type_void);
       else
-	error ("Attempt to use a type name as an expression");
-
-    case STRUCTOP_PTR:
-      tem = longest_to_int (exp->elts[pc + 1].longconst);
-      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
-      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
-      if (noside == EVAL_SKIP)
-	goto nosideret;
-      if (noside == EVAL_AVOID_SIDE_EFFECTS)
-	return value_zero (ada_aligned_type
-			   (ada_lookup_struct_elt_type (VALUE_TYPE (arg1),
-							&exp->elts[pc +
-								   2].string,
-							0, NULL)),
-			   lval_memory);
-      else
-	return unwrap_value (ada_value_struct_elt (arg1,
-						   &exp->elts[pc + 2].string,
-						   "record access"));
+        error ("Attempt to use a type name as an expression");
     }
 
 nosideret:
@@ -7565,11 +9373,11 @@ nosideret:
 }
 
 
-				/* Fixed point */
+                                /* Fixed point */
 
 /* If TYPE encodes an Ada fixed-point type, return the suffix of the
    type name that encodes the 'small and 'delta information.
-   Otherwise, return NULL. */
+   Otherwise, return NULL.  */
 
 static const char *
 fixed_type_info (struct type *type)
@@ -7581,9 +9389,9 @@ fixed_type_info (struct type *type)
     {
       const char *tail = strstr (name, "___XF_");
       if (tail == NULL)
-	return NULL;
+        return NULL;
       else
-	return tail + 5;
+        return tail + 5;
     }
   else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type)
     return fixed_type_info (TYPE_TARGET_TYPE (type));
@@ -7591,7 +9399,7 @@ fixed_type_info (struct type *type)
     return NULL;
 }
 
-/* Returns non-zero iff TYPE represents an Ada fixed-point type. */
+/* Returns non-zero iff TYPE represents an Ada fixed-point type.  */
 
 int
 ada_is_fixed_point_type (struct type *type)
@@ -7599,9 +9407,18 @@ ada_is_fixed_point_type (struct type *ty
   return fixed_type_info (type) != NULL;
 }
 
+/* Return non-zero iff TYPE represents a System.Address type.  */
+
+int
+ada_is_system_address_type (struct type *type)
+{
+  return (TYPE_NAME (type)
+          && strcmp (TYPE_NAME (type), "system__address") == 0);
+}
+
 /* Assuming that TYPE is the representation of an Ada fixed-point
    type, return its delta, or -1 if the type is malformed and the
-   delta cannot be determined. */
+   delta cannot be determined.  */
 
 DOUBLEST
 ada_delta (struct type *type)
@@ -7616,7 +9433,7 @@ ada_delta (struct type *type)
 }
 
 /* Assuming that ada_is_fixed_point_type (TYPE), return the scaling
-   factor ('SMALL value) associated with the type. */
+   factor ('SMALL value) associated with the type.  */
 
 static DOUBLEST
 scaling_factor (struct type *type)
@@ -7637,7 +9454,7 @@ scaling_factor (struct type *type)
 
 
 /* Assuming that X is the representation of a value of fixed-point
-   type TYPE, return its floating-point equivalent. */
+   type TYPE, return its floating-point equivalent.  */
 
 DOUBLEST
 ada_fixed_to_float (struct type *type, LONGEST x)
@@ -7645,8 +9462,8 @@ ada_fixed_to_float (struct type *type, L
   return (DOUBLEST) x *scaling_factor (type);
 }
 
-/* The representation of a fixed-point value of type TYPE 
-   corresponding to the value X. */
+/* The representation of a fixed-point value of type TYPE
+   corresponding to the value X.  */
 
 LONGEST
 ada_float_to_fixed (struct type *type, DOUBLEST x)
@@ -7655,10 +9472,11 @@ ada_float_to_fixed (struct type *type, D
 }
 
 
-				/* VAX floating formats */
+                                /* VAX floating formats */
 
 /* Non-zero iff TYPE represents one of the special VAX floating-point
-   types. */
+   types.  */
+
 int
 ada_is_vax_floating_type (struct type *type)
 {
@@ -7667,21 +9485,23 @@ ada_is_vax_floating_type (struct type *t
   return
     name_len > 6
     && (TYPE_CODE (type) == TYPE_CODE_INT
-	|| TYPE_CODE (type) == TYPE_CODE_RANGE)
-    && DEPRECATED_STREQN (ada_type_name (type) + name_len - 6, "___XF", 5);
+        || TYPE_CODE (type) == TYPE_CODE_RANGE)
+    && strncmp (ada_type_name (type) + name_len - 6, "___XF", 5) == 0;
 }
 
 /* The type of special VAX floating-point type this is, assuming
-   ada_is_vax_floating_point */
+   ada_is_vax_floating_point.  */
+
 int
 ada_vax_float_type_suffix (struct type *type)
 {
   return ada_type_name (type)[strlen (ada_type_name (type)) - 1];
 }
 
-/* A value representing the special debugging function that outputs 
+/* A value representing the special debugging function that outputs
    VAX floating-point values of the type represented by TYPE.  Assumes
-   ada_is_vax_floating_type (TYPE). */
+   ada_is_vax_floating_type (TYPE).  */
+
 struct value *
 ada_vax_float_print_function (struct type *type)
 {
@@ -7699,13 +9519,13 @@ ada_vax_float_print_function (struct typ
 }
 
 
-				/* Range types */
+                                /* Range types */
 
 /* Scan STR beginning at position K for a discriminant name, and
    return the value of that discriminant field of DVAL in *PX.  If
    PNEW_K is not null, put the position of the character beyond the
    name scanned in *PNEW_K.  Return 1 if successful; return 0 and do
-   not alter *PX and *PNEW_K if unsuccessful. */
+   not alter *PX and *PNEW_K if unsuccessful.  */
 
 static int
 scan_discrim_bound (char *str, int k, struct value *dval, LONGEST * px,
@@ -7747,47 +9567,47 @@ scan_discrim_bound (char *str, int k, st
 
 /* Value of variable named NAME in the current environment.  If
    no such variable found, then if ERR_MSG is null, returns 0, and
-   otherwise causes an error with message ERR_MSG. */
+   otherwise causes an error with message ERR_MSG.  */
+
 static struct value *
 get_var_value (char *name, char *err_msg)
 {
-  struct symbol **syms;
-  struct block **blocks;
+  struct ada_symbol_info *syms;
   int nsyms;
 
-  nsyms =
-    ada_lookup_symbol_list (name, get_selected_block (NULL), VAR_DOMAIN,
-			    &syms, &blocks);
+  nsyms = ada_lookup_symbol_list (name, get_selected_block (0), VAR_DOMAIN,
+                                  &syms);
 
   if (nsyms != 1)
     {
       if (err_msg == NULL)
-	return 0;
+        return 0;
       else
-	error ("%s", err_msg);
+        error ("%s", err_msg);
     }
 
-  return value_of_variable (syms[0], blocks[0]);
+  return value_of_variable (syms[0].sym, syms[0].block);
 }
 
 /* Value of integer variable named NAME in the current environment.  If
-   no such variable found, then if ERR_MSG is null, returns 0, and sets
-   *FLAG to 0.  If successful, sets *FLAG to 1. */
+   no such variable found, returns 0, and sets *FLAG to 0.  If
+   successful, sets *FLAG to 1.  */
+
 LONGEST
-get_int_var_value (char *name, char *err_msg, int *flag)
+get_int_var_value (char *name, int *flag)
 {
-  struct value *var_val = get_var_value (name, err_msg);
+  struct value *var_val = get_var_value (name, 0);
 
   if (var_val == 0)
     {
       if (flag != NULL)
-	*flag = 0;
+        *flag = 0;
       return 0;
     }
   else
     {
       if (flag != NULL)
-	*flag = 1;
+        *flag = 1;
       return value_as_long (var_val);
     }
 }
@@ -7795,18 +9615,17 @@ get_int_var_value (char *name, char *err
 
 /* Return a range type whose base type is that of the range type named
    NAME in the current environment, and whose bounds are calculated
-   from NAME according to the GNAT range encoding conventions. 
+   from NAME according to the GNAT range encoding conventions.
    Extract discriminant values, if needed, from DVAL.  If a new type
    must be created, allocate in OBJFILE's space.  The bounds
    information, in general, is encoded in NAME, the base type given in
-   the named range type. */
+   the named range type.  */
 
 static struct type *
 to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
 {
   struct type *raw_type = ada_find_any_type (name);
   struct type *base_type;
-  LONGEST low, high;
   char *subtype_info;
 
   if (raw_type == NULL)
@@ -7838,43 +9657,56 @@ to_fixed_range_type (char *name, struct 
       n = 1;
 
       if (*subtype_info == 'L')
-	{
-	  if (!ada_scan_number (bounds_str, n, &L, &n)
-	      && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
-	    return raw_type;
-	  if (bounds_str[n] == '_')
-	    n += 2;
-	  else if (bounds_str[n] == '.')	/* FIXME? SGI Workshop kludge. */
-	    n += 1;
-	  subtype_info += 1;
-	}
-      else
-	{
-	  strcpy (name_buf + prefix_len, "___L");
-	  L = get_int_var_value (name_buf, "Index bound unknown.", NULL);
-	}
+        {
+          if (!ada_scan_number (bounds_str, n, &L, &n)
+              && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
+            return raw_type;
+          if (bounds_str[n] == '_')
+            n += 2;
+          else if (bounds_str[n] == '.')        /* FIXME? SGI Workshop kludge.  */
+            n += 1;
+          subtype_info += 1;
+        }
+      else
+        {
+          int ok;
+          strcpy (name_buf + prefix_len, "___L");
+          L = get_int_var_value (name_buf, &ok);
+          if (!ok)
+            {
+              lim_warning ("Unknown lower bound, using 1.", 1);
+              L = 1;
+            }
+        }
 
       if (*subtype_info == 'U')
-	{
-	  if (!ada_scan_number (bounds_str, n, &U, &n)
-	      && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
-	    return raw_type;
-	}
-      else
-	{
-	  strcpy (name_buf + prefix_len, "___U");
-	  U = get_int_var_value (name_buf, "Index bound unknown.", NULL);
-	}
+        {
+          if (!ada_scan_number (bounds_str, n, &U, &n)
+              && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
+            return raw_type;
+        }
+      else
+        {
+          int ok;
+          strcpy (name_buf + prefix_len, "___U");
+          U = get_int_var_value (name_buf, &ok);
+          if (!ok)
+            {
+              lim_warning ("Unknown upper bound, using %ld.", (long) L);
+              U = L;
+            }
+        }
 
       if (objfile == NULL)
-	objfile = TYPE_OBJFILE (base_type);
+        objfile = TYPE_OBJFILE (base_type);
       type = create_range_type (alloc_type (objfile), base_type, L, U);
       TYPE_NAME (type) = name;
       return type;
     }
 }
 
-/* True iff NAME is the name of a range type. */
+/* True iff NAME is the name of a range type.  */
+
 int
 ada_is_range_type_name (const char *name)
 {
@@ -7882,31 +9714,246 @@ ada_is_range_type_name (const char *name
 }
 
 
-				/* Modular types */
+                                /* Modular types */
+
+/* True iff TYPE is an Ada modular type.  */
 
-/* True iff TYPE is an Ada modular type. */
 int
 ada_is_modular_type (struct type *type)
 {
-  /* FIXME: base_type should be declared in gdbtypes.h, implemented in
-     valarith.c */
-  struct type *subranged_type;	/* = base_type (type); */
+  struct type *subranged_type = base_type (type);
 
   return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
-	  && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
-	  && TYPE_UNSIGNED (subranged_type));
+          && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
+          && TYPE_UNSIGNED (subranged_type));
 }
 
-/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
+/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE.  */
+
 LONGEST
 ada_modulus (struct type * type)
 {
   return TYPE_HIGH_BOUND (type) + 1;
 }
 
+                                /* Operators */
+/* Information about operators given special treatment in functions
+   below.  */
+/* Format: OP_DEFN (<operator>, <operator length>, <# args>, <binop>).  */
+
+#define ADA_OPERATORS \
+    OP_DEFN (OP_VAR_VALUE, 4, 0, 0) \
+    OP_DEFN (BINOP_IN_BOUNDS, 3, 2, 0) \
+    OP_DEFN (TERNOP_IN_RANGE, 1, 3, 0) \
+    OP_DEFN (OP_ATR_FIRST, 1, 2, 0) \
+    OP_DEFN (OP_ATR_LAST, 1, 2, 0) \
+    OP_DEFN (OP_ATR_LENGTH, 1, 2, 0) \
+    OP_DEFN (OP_ATR_IMAGE, 1, 2, 0) \
+    OP_DEFN (OP_ATR_MAX, 1, 3, 0) \
+    OP_DEFN (OP_ATR_MIN, 1, 3, 0) \
+    OP_DEFN (OP_ATR_MODULUS, 1, 1, 0) \
+    OP_DEFN (OP_ATR_POS, 1, 2, 0) \
+    OP_DEFN (OP_ATR_SIZE, 1, 1, 0) \
+    OP_DEFN (OP_ATR_TAG, 1, 1, 0) \
+    OP_DEFN (OP_ATR_VAL, 1, 2, 0) \
+    OP_DEFN (UNOP_QUAL, 3, 1, 0) \
+    OP_DEFN (UNOP_IN_RANGE, 3, 1, 0)
+
+static void
+ada_operator_length (struct expression *exp, int pc, int *oplenp, int *argsp)
+{
+  switch (exp->elts[pc - 1].opcode)
+    {
+    default: 
+      operator_length_standard (exp, pc, oplenp, argsp);
+      break;
+
+#define OP_DEFN(op, len, args, binop) \
+    case op: *oplenp = len; *argsp = args; break;
+      ADA_OPERATORS;
+#undef OP_DEFN
+    }
+}
+
+static char *
+ada_op_name (enum exp_opcode opcode)
+{
+  switch (opcode)
+    {
+    default: 
+      return op_name_standard (opcode);
+#define OP_DEFN(op, len, args, binop) case op: return #op;
+      ADA_OPERATORS;
+#undef OP_DEFN
+    }
+}
+
+/* As for operator_length, but assumes PC is pointing at the first
+   element of the operator, and gives meaningful results only for the 
+   Ada-specific operators.  */
+
+static void
+ada_forward_operator_length (struct expression *exp, int pc, 
+			     int *oplenp, int *argsp)
+{
+  switch (exp->elts[pc].opcode) 
+    {
+    default:
+      *oplenp = *argsp = 0;
+      break;
+#define OP_DEFN(op, len, args, binop) \
+    case op: *oplenp = len; *argsp = args; break;
+      ADA_OPERATORS;
+#undef OP_DEFN
+    }
+}
+
+static int
+ada_dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
+{
+  enum exp_opcode op = exp->elts[elt].opcode;
+  int oplen, nargs;
+  int pc = elt;
+  int i;
+  
+  ada_forward_operator_length (exp, elt, &oplen, &nargs);
+
+  switch (op) 
+    {
+    /* Ada attributes ('Foo).  */
+    case OP_ATR_FIRST:
+    case OP_ATR_LAST:
+    case OP_ATR_LENGTH:
+    case OP_ATR_IMAGE:
+    case OP_ATR_MAX:
+    case OP_ATR_MIN:
+    case OP_ATR_MODULUS:
+    case OP_ATR_POS:
+    case OP_ATR_SIZE:
+    case OP_ATR_TAG:
+    case OP_ATR_VAL:
+      break;
+
+    case UNOP_IN_RANGE:
+    case UNOP_QUAL:
+      fprintf_filtered (stream, "Type @");
+      gdb_print_host_address (exp->elts[pc + 1].type, stream);
+      fprintf_filtered (stream, " (");
+      type_print (exp->elts[pc + 1].type, NULL, stream, 0);
+      fprintf_filtered (stream, ")");
+      break;
+    case BINOP_IN_BOUNDS:
+      fprintf_filtered (stream, " (%d)", (int) exp->elts[pc + 2].longconst);
+      break;
+    case TERNOP_IN_RANGE:
+      break;
+
+    default:
+      return dump_subexp_body_standard (exp, stream, elt);
+    }
+
+  elt += oplen;
+  for (i = 0; i < nargs; i += 1)
+    elt = dump_subexp (exp, stream, elt);
+
+  return elt;
+}
 
+/* The Ada extension of print_subexp (q.v.).  */
+
+static void 
+ada_print_subexp (struct expression *exp, int *pos, 
+		  struct ui_file *stream, enum precedence prec)
+{
+  int oplen, nargs;
+  int pc = *pos;
+  enum exp_opcode op = exp->elts[pc].opcode;
+
+  ada_forward_operator_length (exp, pc, &oplen, &nargs);
+
+  switch (op)
+    {
+    default:
+      print_subexp_standard (exp, pos, stream, prec);
+      return;
+
+    case OP_VAR_VALUE:
+      *pos += oplen;
+      fputs_filtered (SYMBOL_NATURAL_NAME (exp->elts[pc + 2].symbol), stream);
+      return;
+
+    case BINOP_IN_BOUNDS:
+      *pos += oplen;
+      print_subexp (exp, pos, stream, PREC_SUFFIX);
+      fputs_filtered (" in ", stream);
+      print_subexp (exp, pos, stream, PREC_SUFFIX);
+      fputs_filtered ("'range", stream);
+      if (exp->elts[pc + 1].longconst > 1)
+	fprintf_filtered (stream, "(%ld)", (long) exp->elts[pc + 1].longconst);
+      return;
+
+    case TERNOP_IN_RANGE:
+      *pos += oplen;
+      if (prec >= PREC_EQUAL)
+	fputs_filtered ("(", stream);
+      print_subexp (exp, pos, stream, PREC_SUFFIX);
+      fputs_filtered (" in ", stream);
+      print_subexp (exp, pos, stream, PREC_EQUAL);
+      fputs_filtered (" .. ", stream);
+      print_subexp (exp, pos, stream, PREC_EQUAL);
+      if (prec >= PREC_EQUAL)
+	fputs_filtered (")", stream);
+      return;      
+
+    case OP_ATR_FIRST:
+    case OP_ATR_LAST:
+    case OP_ATR_LENGTH:
+    case OP_ATR_IMAGE:
+    case OP_ATR_MAX:
+    case OP_ATR_MIN:
+    case OP_ATR_MODULUS:
+    case OP_ATR_POS:
+    case OP_ATR_SIZE:
+    case OP_ATR_TAG:
+    case OP_ATR_VAL:
+      *pos += oplen;
+      if (exp->elts[*pos].opcode == OP_TYPE)
+	{
+	  if (TYPE_CODE (exp->elts[*pos + 1].type) != TYPE_CODE_VOID)
+	    LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0);
+	  *pos += 3;
+	}
+      else
+	print_subexp (exp, pos, stream, PREC_SUFFIX);
+      fprintf_filtered (stream, "'%s", ada_attribute_name (op));
+      if (nargs > 1)
+	{
+	  int tem;
+	  for (tem = 1; tem < nargs; tem += 1)
+	    {
+	      fputs_filtered ( (tem == 1) ? " (" : ", ", stream);
+	      print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
+	    }
+	  fputs_filtered (")", stream);
+	}
+      return;
 
-				/* Operators */
+    case UNOP_QUAL:
+      *pos += oplen;
+      type_print (exp->elts[pc + 1].type, "", stream, 0);
+      fputs_filtered ("'(", stream);
+      print_subexp (exp, pos, stream, PREC_PREFIX);
+      fputs_filtered (")", stream);
+      return;
+
+    case UNOP_IN_RANGE:
+      *pos += oplen;
+      print_subexp (exp, pos, stream, PREC_SUFFIX);
+      fputs_filtered (" in ", stream);
+      LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0);
+      return;
+    }
+}
 
 /* Table mapping opcodes into strings for printing operators
    and precedences of the operators.  */
@@ -7940,12 +9987,13 @@ static const struct op_print ada_op_prin
   {"not ", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
   {"not ", UNOP_COMPLEMENT, PREC_PREFIX, 0},
   {"abs ", UNOP_ABS, PREC_PREFIX, 0},
-  {".all", UNOP_IND, PREC_SUFFIX, 1},	/* FIXME: postfix .ALL */
-  {"'access", UNOP_ADDR, PREC_SUFFIX, 1},	/* FIXME: postfix 'ACCESS */
+  {".all", UNOP_IND, PREC_SUFFIX, 1},
+  {"'access", UNOP_ADDR, PREC_SUFFIX, 1},
+  {"'size", OP_ATR_SIZE, PREC_SUFFIX, 1},
   {NULL, 0, 0, 0}
 };
 
-			/* Assorted Types and Interfaces */
+                        /* Assorted Types and Interfaces */
 
 struct type *builtin_type_ada_int;
 struct type *builtin_type_ada_short;
@@ -7961,54 +10009,76 @@ struct type *builtin_type_ada_system_add
 
 struct type **const (ada_builtin_types[]) =
 {
-
   &builtin_type_ada_int,
-    &builtin_type_ada_long,
-    &builtin_type_ada_short,
-    &builtin_type_ada_char,
-    &builtin_type_ada_float,
-    &builtin_type_ada_double,
-    &builtin_type_ada_long_long,
-    &builtin_type_ada_long_double,
-    &builtin_type_ada_natural, &builtin_type_ada_positive,
-    /* The following types are carried over from C for convenience. */
-&builtin_type_int,
-    &builtin_type_long,
-    &builtin_type_short,
-    &builtin_type_char,
-    &builtin_type_float,
-    &builtin_type_double,
-    &builtin_type_long_long,
-    &builtin_type_void,
-    &builtin_type_signed_char,
-    &builtin_type_unsigned_char,
-    &builtin_type_unsigned_short,
-    &builtin_type_unsigned_int,
-    &builtin_type_unsigned_long,
-    &builtin_type_unsigned_long_long,
-    &builtin_type_long_double,
-    &builtin_type_complex, &builtin_type_double_complex, 0};
+  &builtin_type_ada_long,
+  &builtin_type_ada_short,
+  &builtin_type_ada_char,
+  &builtin_type_ada_float,
+  &builtin_type_ada_double,
+  &builtin_type_ada_long_long,
+  &builtin_type_ada_long_double,
+  &builtin_type_ada_natural, &builtin_type_ada_positive,
+  /* The following types are carried over from C for convenience.  */
+  &builtin_type_int,
+  &builtin_type_long,
+  &builtin_type_short,
+  &builtin_type_char,
+  &builtin_type_float,
+  &builtin_type_double,
+  &builtin_type_long_long,
+  &builtin_type_void,
+  &builtin_type_signed_char,
+  &builtin_type_unsigned_char,
+  &builtin_type_unsigned_short,
+  &builtin_type_unsigned_int,
+  &builtin_type_unsigned_long,
+  &builtin_type_unsigned_long_long,
+  &builtin_type_long_double,
+  &builtin_type_complex,
+  &builtin_type_double_complex,
+  0
+};
+
+/* Not really used, but needed in the ada_language_defn.  */
 
-/* Not really used, but needed in the ada_language_defn. */
 static void
 emit_char (int c, struct ui_file *stream, int quoter)
 {
   ada_emit_char (c, stream, quoter, 1);
 }
 
+static int
+parse ()
+{
+  warnings_issued = 0;
+  return ada_parse ();
+}
+
+static const struct exp_descriptor ada_exp_descriptor = 
+{
+  ada_print_subexp,
+  ada_operator_length,
+  ada_op_name,
+  ada_dump_subexp_body,
+  ada_evaluate_subexp
+};
+
 const struct language_defn ada_language_defn = {
-  "ada",			/* Language name */
-  /*  language_ada, */
-  language_unknown,
-  /* FIXME: language_ada should be defined in defs.h */
+  "ada",                        /* Language name */
+  language_ada,
   ada_builtin_types,
   range_check_off,
   type_check_off,
-  case_sensitive_on,		/* Yes, Ada is case-insensitive, but
-				 * that's not quite what this means. */
-  ada_parse,
+  case_sensitive_on,            /* Yes, Ada is case-insensitive, but
+                                   that's not quite what this means.  */
+#ifdef GNAT_GDB
+  ada_lookup_symbol,
+  ada_lookup_minimal_symbol,
+#endif
+  &ada_exp_descriptor,
+  parse,
   ada_error,
-  ada_evaluate_subexp,
+  resolve,
   ada_printchar,		/* Print a character constant */
   ada_printstr,			/* Function to print string constant */
   emit_char,			/* Function to print single char (not used) */
@@ -8017,84 +10087,97 @@ const struct language_defn ada_language_
   ada_val_print,		/* Print a value using appropriate syntax */
   ada_value_print,		/* Print a top-level value */
   NULL,				/* Language specific skip_trampoline */
-  value_of_this,		/* value_of_this */
-  basic_lookup_symbol_nonlocal,	/* lookup_symbol_nonlocal  */
+  NULL,				/* value_of_this */
+  ada_lookup_symbol_nonlocal,   /* Looking up non-local symbols.  */
   basic_lookup_transparent_type,/* lookup_transparent_type */
-  NULL,				/* Language specific symbol demangler */
+  ada_la_decode,		/* Language specific symbol demangler */
   {"", "", "", ""},		/* Binary format info */
 #if 0
-  {"8#%lo#", "8#", "o", "#"},	/* Octal format info */
-  {"%ld", "", "d", ""},		/* Decimal format info */
-  {"16#%lx#", "16#", "x", "#"},	/* Hex format info */
+  {"8#%lo#", "8#", "o", "#"},   /* Octal format info */
+  {"%ld", "", "d", ""},         /* Decimal format info */
+  {"16#%lx#", "16#", "x", "#"}, /* Hex format info */
 #else
-  /* Copied from c-lang.c. */
-  {"0%lo", "0", "o", ""},	/* Octal format info */
-  {"%ld", "", "d", ""},		/* Decimal format info */
-  {"0x%lx", "0x", "x", ""},	/* Hex format info */
+  /* Copied from c-lang.c.  */
+  {"0%lo", "0", "o", ""},       /* Octal format info */
+  {"%ld", "", "d", ""},         /* Decimal format info */
+  {"0x%lx", "0x", "x", ""},     /* Hex format info */
 #endif
-  ada_op_print_tab,		/* expression operators for printing */
-  1,				/* c-style arrays (FIXME?) */
-  0,				/* String lower bound (FIXME?) */
+  ada_op_print_tab,             /* expression operators for printing */
+  0,                            /* c-style arrays */
+  1,                            /* String lower bound */
   &builtin_type_ada_char,
-  default_word_break_characters,
+  ada_get_gdb_completer_word_break_characters,
+#ifdef GNAT_GDB
+  ada_translate_error_message,  /* Substitute Ada-specific terminology
+				   in errors and warnings.  */
+#endif
   LANG_MAGIC
 };
 
-void
-_initialize_ada_language (void)
-{
+static void
+build_ada_types (void) {
   builtin_type_ada_int =
     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
-	       0, "integer", (struct objfile *) NULL);
+               0, "integer", (struct objfile *) NULL);
   builtin_type_ada_long =
     init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
-	       0, "long_integer", (struct objfile *) NULL);
+               0, "long_integer", (struct objfile *) NULL);
   builtin_type_ada_short =
     init_type (TYPE_CODE_INT, TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-	       0, "short_integer", (struct objfile *) NULL);
+               0, "short_integer", (struct objfile *) NULL);
   builtin_type_ada_char =
     init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-	       0, "character", (struct objfile *) NULL);
+               0, "character", (struct objfile *) NULL);
   builtin_type_ada_float =
     init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-	       0, "float", (struct objfile *) NULL);
+               0, "float", (struct objfile *) NULL);
   builtin_type_ada_double =
     init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-	       0, "long_float", (struct objfile *) NULL);
+               0, "long_float", (struct objfile *) NULL);
   builtin_type_ada_long_long =
     init_type (TYPE_CODE_INT, TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-	       0, "long_long_integer", (struct objfile *) NULL);
+               0, "long_long_integer", (struct objfile *) NULL);
   builtin_type_ada_long_double =
     init_type (TYPE_CODE_FLT, TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-	       0, "long_long_float", (struct objfile *) NULL);
+               0, "long_long_float", (struct objfile *) NULL);
   builtin_type_ada_natural =
     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
-	       0, "natural", (struct objfile *) NULL);
+               0, "natural", (struct objfile *) NULL);
   builtin_type_ada_positive =
     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
-	       0, "positive", (struct objfile *) NULL);
+               0, "positive", (struct objfile *) NULL);
 
 
   builtin_type_ada_system_address =
     lookup_pointer_type (init_type (TYPE_CODE_VOID, 1, 0, "void",
-				    (struct objfile *) NULL));
+                                    (struct objfile *) NULL));
   TYPE_NAME (builtin_type_ada_system_address) = "system__address";
+}
+
+void
+_initialize_ada_language (void)
+{
 
+  build_ada_types ();
+  deprecated_register_gdbarch_swap (NULL, 0, build_ada_types);
   add_language (&ada_language_defn);
 
+#ifdef GNAT_GDB
   add_show_from_set
     (add_set_cmd ("varsize-limit", class_support, var_uinteger,
-		  (char *) &varsize_limit,
-		  "Set maximum bytes in dynamic-sized object.",
-		  &setlist), &showlist);
+                  (char *) &varsize_limit,
+                  "Set maximum bytes in dynamic-sized object.",
+                  &setlist), &showlist);
+#endif
   varsize_limit = 65536;
 
-  add_com ("begin", class_breakpoint, begin_command,
-	   "Start the debugged program, stopping at the beginning of the\n\
-main program.  You may specify command-line arguments to give it, as for\n\
-the \"run\" command (q.v.).");
-}
+  obstack_init (&symbol_list_obstack);
+  obstack_init (&cache_space);
 
+  decoded_names_store = htab_create_alloc_ex 
+    (256, htab_hash_string, (int (*) (const void *, const void *)) streq,
+     NULL, NULL, xmcalloc, xmfree);
+}
 
 /* Create a fundamental Ada type using default reasonable for the current
    target machine.
@@ -8130,104 +10213,104 @@ ada_create_fundamental_type (struct objf
       /* FIXME:  For now, if we are asked to produce a type not in this
          language, create the equivalent of a C integer type with the
          name "<?type?>".  When all the dust settles from the type
-         reconstruction work, this should probably become an error. */
+         reconstruction work, this should probably become an error.  */
       type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "<?type?>", objfile);
+                        TARGET_INT_BIT / TARGET_CHAR_BIT,
+                        0, "<?type?>", objfile);
       warning ("internal error: no Ada fundamental type %d", typeid);
       break;
     case FT_VOID:
       type = init_type (TYPE_CODE_VOID,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "void", objfile);
+                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+                        0, "void", objfile);
       break;
     case FT_CHAR:
       type = init_type (TYPE_CODE_INT,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "character", objfile);
+                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+                        0, "character", objfile);
       break;
     case FT_SIGNED_CHAR:
       type = init_type (TYPE_CODE_INT,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			0, "signed char", objfile);
+                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+                        0, "signed char", objfile);
       break;
     case FT_UNSIGNED_CHAR:
       type = init_type (TYPE_CODE_INT,
-			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
+                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
+                        TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
       break;
     case FT_SHORT:
       type = init_type (TYPE_CODE_INT,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			0, "short_integer", objfile);
+                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+                        0, "short_integer", objfile);
       break;
     case FT_SIGNED_SHORT:
       type = init_type (TYPE_CODE_INT,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			0, "short_integer", objfile);
+                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+                        0, "short_integer", objfile);
       break;
     case FT_UNSIGNED_SHORT:
       type = init_type (TYPE_CODE_INT,
-			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
+                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,
+                        TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
       break;
     case FT_INTEGER:
       type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			0, "integer", objfile);
+                        TARGET_INT_BIT / TARGET_CHAR_BIT,
+                        0, "integer", objfile);
       break;
     case FT_SIGNED_INTEGER:
-      type = init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 0, "integer", objfile);	/* FIXME -fnf */
+      type = init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 0, "integer", objfile);        /* FIXME -fnf */
       break;
     case FT_UNSIGNED_INTEGER:
       type = init_type (TYPE_CODE_INT,
-			TARGET_INT_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
+                        TARGET_INT_BIT / TARGET_CHAR_BIT,
+                        TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
       break;
     case FT_LONG:
       type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long_integer", objfile);
+                        TARGET_LONG_BIT / TARGET_CHAR_BIT,
+                        0, "long_integer", objfile);
       break;
     case FT_SIGNED_LONG:
       type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long_integer", objfile);
+                        TARGET_LONG_BIT / TARGET_CHAR_BIT,
+                        0, "long_integer", objfile);
       break;
     case FT_UNSIGNED_LONG:
       type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
+                        TARGET_LONG_BIT / TARGET_CHAR_BIT,
+                        TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
       break;
     case FT_LONG_LONG:
       type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long_long_integer", objfile);
+                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+                        0, "long_long_integer", objfile);
       break;
     case FT_SIGNED_LONG_LONG:
       type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			0, "long_long_integer", objfile);
+                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+                        0, "long_long_integer", objfile);
       break;
     case FT_UNSIGNED_LONG_LONG:
       type = init_type (TYPE_CODE_INT,
-			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
-			TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
+                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
+                        TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
       break;
     case FT_FLOAT:
       type = init_type (TYPE_CODE_FLT,
-			TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
-			0, "float", objfile);
+                        TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
+                        0, "float", objfile);
       break;
     case FT_DBL_PREC_FLOAT:
       type = init_type (TYPE_CODE_FLT,
-			TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "long_float", objfile);
+                        TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
+                        0, "long_float", objfile);
       break;
     case FT_EXT_PREC_FLOAT:
       type = init_type (TYPE_CODE_FLT,
-			TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
-			0, "long_long_float", objfile);
+                        TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
+                        0, "long_long_float", objfile);
       break;
     }
   return (type);
@@ -8239,16 +10322,16 @@ ada_dump_symtab (struct symtab *s)
   int i;
   fprintf (stderr, "New symtab: [\n");
   fprintf (stderr, "  Name: %s/%s;\n",
-	   s->dirname ? s->dirname : "?", s->filename ? s->filename : "?");
+           s->dirname ? s->dirname : "?", s->filename ? s->filename : "?");
   fprintf (stderr, "  Format: %s;\n", s->debugformat);
   if (s->linetable != NULL)
     {
       fprintf (stderr, "  Line table (section %d):\n", s->block_line_section);
       for (i = 0; i < s->linetable->nitems; i += 1)
-	{
-	  struct linetable_entry *e = s->linetable->item + i;
-	  fprintf (stderr, "    %4ld: %8lx\n", (long) e->line, (long) e->pc);
-	}
+        {
+          struct linetable_entry *e = s->linetable->item + i;
+          fprintf (stderr, "    %4ld: %8lx\n", (long) e->line, (long) e->pc);
+        }
     }
   fprintf (stderr, "]\n");
 }
Index: gdb/ada-lang.h
===================================================================
RCS file: /cvs/src/src/gdb/ada-lang.h,v
retrieving revision 1.6
diff -u -p -r1.6 ada-lang.h
--- gdb/ada-lang.h	24 May 2003 03:21:42 -0000	1.6
+++ gdb/ada-lang.h	2 Jun 2004 09:52:56 -0000
@@ -1,5 +1,6 @@
 /* Ada language support definitions for GDB, the GNU debugger.
-   Copyright 1992, 1997 Free Software Foundation, Inc.
+   Copyright 1992, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
+   Free Software Foundation, Inc.
 
 This file is part of GDB.
 
@@ -24,130 +25,103 @@ struct partial_symbol;
 
 #include "value.h"
 #include "gdbtypes.h"
+#include "breakpoint.h"
 
-struct block;
+/* Names of specific files known to be part of the runtime
+   system and that might consider (confusing) debugging information.
+   Each name (a basic regular expression string) is followed by a
+   comma.  FIXME: Should be part of a configuration file. */
+#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
+#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
+   "^[agis]-.*\\.ad[bs]$", \
+   "/usr/shlib/libpthread\\.so",
+#elif defined (__linux__)
+#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
+   "^[agis]-.*\\.ad[bs]$", \
+   "/lib.*/libpthread\\.so[.0-9]*$", "/lib.*/libpthread\\.a$", \
+   "/lib.*/libc\\.so[.0-9]*$", "/lib.*/libc\\.a$",
+#endif
+
+#if !defined (ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS)
+#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
+   "^[agis]-.*\\.ad[bs]$",
+#endif
 
-/* A macro to reorder the bytes of an address depending on the
-   endiannes of the target.  */
-#define EXTRACT_ADDRESS(x) ((void *) extract_unsigned_integer (&(x), sizeof (x)))
-/* A macro to reorder the bytes of an int depending on the endiannes
-   of the target */
-#define EXTRACT_INT(x) ((int) extract_signed_integer (&(x), sizeof (x)))
-
-/* Chain of cleanups for arguments of OP_UNRESOLVED_VALUE names.  Created in
-   yyparse and freed in ada_resolve. */
-extern struct cleanup *unresolved_names;
+/* Names of compiler-generated auxiliary functions probably of no
+   interest to users. Each name (a basic regular expression string)
+   is followed by a comma. */
+#define ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS \
+   "___clean[.a-zA-Z0-9_]*$",
+
+/* The maximum number of frame levels searched for non-local,
+ * non-global symbols.  This limit exists as a precaution to prevent
+ * infinite search loops when the stack is screwed up. */
+#define MAX_ENCLOSING_FRAME_LEVELS 7
+
+/* Maximum number of steps followed in looking for the ultimate
+   referent of a renaming.  This prevents certain infinite loops that
+   can otherwise result. */
+#define MAX_RENAMING_CHAIN_LENGTH 10
 
-/* Corresponding mangled/demangled names and opcodes for Ada user-definable 
+struct block;
+
+/* Corresponding encoded/decoded names and opcodes for Ada user-definable
    operators. */
 struct ada_opname_map
 {
-  const char *mangled;
-  const char *demangled;
+  const char *encoded;
+  const char *decoded;
   enum exp_opcode op;
 };
 
-/* Table of Ada operators in mangled and demangled forms. */
+/* Table of Ada operators in encoded and decoded forms. */
 /* Defined in ada-lang.c */
 extern const struct ada_opname_map ada_opname_table[];
 
-/* The maximum number of tasks known to the Ada runtime */
-extern const int MAX_NUMBER_OF_KNOWN_TASKS;
-
-/* Identifiers for Ada attributes that need special processing.  Be sure 
-   to update the table attribute_names in ada-lang.c whenever you change this.
-   */
-
-enum ada_attribute
-{
-  /* Invalid attribute for error checking. */
-  ATR_INVALID,
-
-  ATR_FIRST,
-  ATR_LAST,
-  ATR_LENGTH,
-  ATR_IMAGE,
-  ATR_IMG,
-  ATR_MAX,
-  ATR_MIN,
-  ATR_MODULUS,
-  ATR_POS,
-  ATR_SIZE,
-  ATR_TAG,
-  ATR_VAL,
-
-  /* Dummy last attribute. */
-  ATR_END
-};
-
-enum task_states
-{
-  Unactivated,
-  Runnable,
-  Terminated,
-  Activator_Sleep,
-  Acceptor_Sleep,
-  Entry_Caller_Sleep,
-  Async_Select_Sleep,
-  Delay_Sleep,
-  Master_Completion_Sleep,
-  Master_Phase_2_Sleep
-};
-
-extern char *ada_task_states[];
-
-typedef struct
-{
-  char *P_ARRAY;
-  int *P_BOUNDS;
-}
-fat_string;
-
-typedef struct entry_call
-{
-  void *self;
-}
- *entry_call_link;
-
-struct task_fields
-{
-  int entry_num;
-#if (defined (VXWORKS_TARGET) || !defined (i386)) \
-    && !(defined (VXWORKS_TARGET) && defined (M68K_TARGET))
-  int pad1;
-#endif
-  char state;
-#if (defined (VXWORKS_TARGET) && defined (M68K_TARGET))
-  char pad_8bits;
-#endif
-  void *parent;
-  int priority;
-  int current_priority;
-  fat_string image;
-  entry_call_link call;
-#if (defined (sun) && defined (__SVR4)) && !defined (VXWORKS_TARGET)
-  int pad2;
-  unsigned thread;
-  unsigned lwp;
-#else
-  void *thread;
-  void *lwp;
-#endif
-}
-#if (defined (VXWORKS_TARGET) && defined (M68K_TARGET))
-__attribute__ ((packed))
-#endif
-  ;
-
-struct task_entry
-{
-  void *task_id;
-  int task_num;
-  int known_tasks_index;
-  struct task_entry *next_task;
-  void *thread;
-  void *lwp;
-  int stack_per;
+enum ada_operator 
+  {
+    /* X IN A'RANGE(N).  N is an immediate operand, surrounded by 
+       BINOP_IN_BOUNDS before and after.  A is an array, X an index 
+       value.  Evaluates to true iff X is within range of the Nth
+       dimension (1-based) of A.  (A multi-dimensional array
+       type is represented as array of array of ...) */
+    BINOP_IN_BOUNDS = OP_EXTENDED0,
+
+    /* X IN L .. U.  True iff L <= X <= U.  */
+    TERNOP_IN_RANGE,
+
+    /* Ada attributes ('Foo). */
+    OP_ATR_FIRST,
+    OP_ATR_LAST,
+    OP_ATR_LENGTH,
+    OP_ATR_IMAGE,
+    OP_ATR_MAX,
+    OP_ATR_MIN,
+    OP_ATR_MODULUS,
+    OP_ATR_POS,
+    OP_ATR_SIZE,
+    OP_ATR_TAG,
+    OP_ATR_VAL,
+
+    /* Ada type qualification.  It is encoded as for UNOP_CAST, above, 
+       and denotes the TYPE'(EXPR) construct. */
+    UNOP_QUAL,
+
+    /* X IN TYPE.  The `TYPE' argument is immediate, with 
+       UNOP_IN_RANGE before and after it. True iff X is a member of 
+       type TYPE (typically a subrange). */
+    UNOP_IN_RANGE,
+
+    /* End marker */
+    OP_ADA_LAST
+  };
+
+/* A triple, (symbol, block, symtab), representing one instance of a 
+ * symbol-lookup operation. */
+struct ada_symbol_info {
+  struct symbol* sym;
+  struct block* block;
+  struct symtab* symtab;
 };
 
 extern struct type *builtin_type_ada_int;
@@ -162,33 +136,40 @@ extern struct type *builtin_type_ada_nat
 extern struct type *builtin_type_ada_positive;
 extern struct type *builtin_type_ada_system_address;
 
-/* Assuming V points to an array of S objects,  make sure that it contains at 
+/* The maximum number of tasks known to the Ada runtime */
+extern const int MAX_NUMBER_OF_KNOWN_TASKS;
+
+/* Assuming V points to an array of S objects,  make sure that it contains at
    least M objects, updating V and S as necessary. */
 
-#define GROW_VECT(v, s, m) 						\
+#define GROW_VECT(v, s, m)                                              \
    if ((s) < (m)) grow_vect ((void**) &(v), &(s), (m), sizeof(*(v)));
 
 extern void grow_vect (void **, size_t *, size_t, int);
 
-extern int ada_parse (void);	/* Defined in ada-exp.y */
+extern int ada_get_field_index (const struct type *type,
+                                const char *field_name,
+                                int maybe_missing);
+
+extern int ada_parse (void);    /* Defined in ada-exp.y */
 
-extern void ada_error (char *);	/* Defined in ada-exp.y */
+extern void ada_error (char *); /* Defined in ada-exp.y */
 
-			/* Defined in ada-typeprint.c */
+                        /* Defined in ada-typeprint.c */
 extern void ada_print_type (struct type *, char *, struct ui_file *, int,
-			    int);
+                            int);
 
 extern int ada_val_print (struct type *, char *, int, CORE_ADDR,
-			  struct ui_file *, int, int, int,
-			  enum val_prettyprint);
+                          struct ui_file *, int, int, int,
+                          enum val_prettyprint);
 
 extern int ada_value_print (struct value *, struct ui_file *, int,
-			    enum val_prettyprint);
+                            enum val_prettyprint);
 
-				/* Defined in ada-lang.c */
+                                /* Defined in ada-lang.c */
 
 extern struct value *value_from_contents_and_address (struct type *, char *,
-						      CORE_ADDR);
+                                                      CORE_ADDR);
 
 extern void ada_emit_char (int, struct ui_file *, int, int);
 
@@ -197,10 +178,10 @@ extern void ada_printchar (int, struct u
 extern void ada_printstr (struct ui_file *, char *, unsigned int, int, int);
 
 extern void ada_convert_actuals (struct value *, int, struct value **,
-				 CORE_ADDR *);
+                                 CORE_ADDR *);
 
 extern struct value *ada_value_subscript (struct value *, int,
-					  struct value **);
+                                          struct value **);
 
 extern struct type *ada_array_element_type (struct type *, int);
 
@@ -208,13 +189,11 @@ extern int ada_array_arity (struct type 
 
 struct type *ada_type_of_array (struct value *, int);
 
-extern struct value *ada_coerce_to_simple_array (struct value *);
-
 extern struct value *ada_coerce_to_simple_array_ptr (struct value *);
 
-extern int ada_is_simple_array (struct type *);
+extern int ada_is_simple_array_type (struct type *);
 
-extern int ada_is_array_descriptor (struct type *);
+extern int ada_is_array_descriptor_type (struct type *);
 
 extern int ada_is_bogus_array_descriptor (struct type *);
 
@@ -222,34 +201,43 @@ extern struct type *ada_index_type (stru
 
 extern struct value *ada_array_bound (struct value *, int, int);
 
-extern int ada_lookup_symbol_list (const char *, struct block *,
-				   domain_enum, struct symbol ***,
-				   struct block ***);
+extern char *ada_decode_symbol (const struct general_symbol_info*);
 
-extern char *ada_fold_name (const char *);
+extern const char *ada_decode (const char*);
+
+extern enum language ada_update_initial_language (enum language, 
+						  struct partial_symtab*);
 
-extern struct symbol *ada_lookup_symbol (const char *, struct block *,
-					 domain_enum);
+extern void clear_ada_sym_cache (void);
 
-extern struct minimal_symbol *ada_lookup_minimal_symbol (const char *);
+extern char **ada_make_symbol_completion_list (const char *text0,
+                                               const char *word);
 
-extern void ada_resolve (struct expression **, struct type *);
+extern int ada_lookup_symbol_list (const char *, const struct block *,
+                                   domain_enum, struct ada_symbol_info**);
+
+extern char *ada_fold_name (const char *);
 
-extern int ada_resolve_function (struct symbol **, struct block **, int,
-				 struct value **, int, const char *,
-				 struct type *);
+extern struct symbol *ada_lookup_symbol (const char *, const struct block *,
+                                         domain_enum, int *, 
+					 struct symtab **);
+
+extern struct minimal_symbol *ada_lookup_simple_minsym (const char *);
 
 extern void ada_fill_in_ada_prototype (struct symbol *);
 
-extern int user_select_syms (struct symbol **, struct block **, int, int);
+extern int user_select_syms (struct ada_symbol_info *, int, int);
 
 extern int get_selections (int *, int, int, int, char *);
 
 extern char *ada_start_decode_line_1 (char *);
 
 extern struct symtabs_and_lines ada_finish_decode_line_1 (char **,
-							  struct symtab *,
-							  int, char ***);
+                                                          struct symtab *,
+                                                          int, char ***);
+
+extern struct symtabs_and_lines ada_sals_for_line (const char*, int,
+						   int, char***, int);
 
 extern int ada_scan_number (const char *, int, LONGEST *, int *);
 
@@ -260,8 +248,8 @@ extern int ada_is_ignored_field (struct 
 extern int ada_is_packed_array_type (struct type *);
 
 extern struct value *ada_value_primitive_packed_val (struct value *, char *,
-						     long, int, int,
-						     struct type *);
+                                                     long, int, int,
+                                                     struct type *);
 
 extern struct type *ada_coerce_to_simple_array_type (struct type *);
 
@@ -269,12 +257,16 @@ extern int ada_is_character_type (struct
 
 extern int ada_is_string_type (struct type *);
 
-extern int ada_is_tagged_type (struct type *);
+extern int ada_is_tagged_type (struct type *, int);
+
+extern int ada_is_tag_type (struct type *);
 
 extern struct type *ada_tag_type (struct value *);
 
 extern struct value *ada_value_tag (struct value *);
 
+extern const char *ada_tag_name (struct value *);
+
 extern int ada_is_parent_field (struct type *, int);
 
 extern int ada_is_wrapper_field (struct type *, int);
@@ -289,24 +281,20 @@ extern int ada_in_variant (LONGEST, stru
 
 extern char *ada_variant_discrim_name (struct type *);
 
-extern struct type *ada_lookup_struct_elt_type (struct type *, char *, int,
-						int *);
-
 extern struct value *ada_value_struct_elt (struct value *, char *, char *);
 
-extern struct value *ada_search_struct_field (char *, struct value *, int,
-					      struct type *);
-
 extern int ada_is_aligner_type (struct type *);
 
 extern struct type *ada_aligned_type (struct type *);
 
 extern char *ada_aligned_value_addr (struct type *, char *);
 
-extern const char *ada_attribute_name (int);
+extern const char *ada_attribute_name (enum exp_opcode);
 
 extern int ada_is_fixed_point_type (struct type *);
 
+extern int ada_is_system_address_type (struct type *);
+
 extern DOUBLEST ada_delta (struct type *);
 
 extern DOUBLEST ada_fixed_to_float (struct type *, LONGEST);
@@ -323,30 +311,37 @@ extern struct type *ada_system_address_t
 
 extern int ada_which_variant_applies (struct type *, struct type *, char *);
 
-extern struct value *ada_to_fixed_value (struct type *, char *, CORE_ADDR,
-					 struct value *);
-
 extern struct type *ada_to_fixed_type (struct type *, char *, CORE_ADDR,
-				       struct value *);
+                                       struct value *);
+
+extern struct type *
+  ada_template_to_fixed_record_type_1 (struct type *type, char *valaddr,
+                                       CORE_ADDR address, struct value *dval0,
+                                       int keep_dynamic_fields);
 
 extern int ada_name_prefix_len (const char *);
 
 extern char *ada_type_name (struct type *);
 
 extern struct type *ada_find_parallel_type (struct type *,
-					    const char *suffix);
+                                            const char *suffix);
+
+extern LONGEST get_int_var_value (char *, int *);
 
-extern LONGEST get_int_var_value (char *, char *, int *);
+extern struct symbol *ada_find_any_symbol (const char *name);
 
 extern struct type *ada_find_any_type (const char *name);
 
+extern struct symbol *ada_find_renaming_symbol (const char *name,
+                                                struct block *block);
+
 extern int ada_prefer_type (struct type *, struct type *);
 
 extern struct type *ada_get_base_type (struct type *);
 
 extern struct type *ada_completed_type (struct type *);
 
-extern char *ada_mangle (const char *);
+extern char *ada_encode (const char *);
 
 extern const char *ada_enum_name (const char *);
 
@@ -364,29 +359,38 @@ extern const char *ada_renaming_type (st
 
 extern int ada_is_object_renaming (struct symbol *);
 
-extern const char *ada_simple_renamed_entity (struct symbol *);
+extern char *ada_simple_renamed_entity (struct symbol *);
 
 extern char *ada_breakpoint_rewrite (char *, int *);
 
+extern char *ada_main_name (void);
+
 /* Tasking-related: ada-tasks.c */
 
 extern int valid_task_id (int);
 
-extern int get_current_task (void);
-
 extern void init_task_list (void);
 
-extern void *get_self_id (void);
+extern int ada_is_exception_breakpoint (bpstat bs);
+
+extern void ada_adjust_exception_stop (bpstat bs);
 
-extern int get_current_task (void);
+extern void ada_print_exception_stop (bpstat bs);
 
-extern int get_entry_number (void *);
+extern int ada_get_current_task (ptid_t);
 
-extern void ada_report_exception_break (struct breakpoint *);
+extern int breakpoint_ada_task_match (CORE_ADDR, ptid_t);
+
+extern int ada_print_exception_breakpoint_nontask (struct breakpoint *);
+
+extern void ada_print_exception_breakpoint_task (struct breakpoint *);
 
 extern int ada_maybe_exception_partial_symbol (struct partial_symbol *sym);
 
 extern int ada_is_exception_sym (struct symbol *sym);
 
+extern void ada_find_printable_frame (struct frame_info *fi);
+
+extern void ada_reset_thread_registers (void);
 
 #endif


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]