gdb-ada-update2b.patch

   1 From gdb-patches-return-33536-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com Wed Jun 02 10:17:17 2004
   2 Return-Path: <gdb-patches-return-33536-listarch-gdb-patches=sources dot redhat dot com at sources dot redhat dot com>
   3 Delivered-To: listarch-gdb-patches at sources dot redhat dot com
   4 Received: (qmail 11944 invoked by alias); 2 Jun 2004 10:17:15 -0000
   5 Mailing-List: contact gdb-patches-help at sources dot redhat dot com; run by ezmlm
   6 Precedence: bulk
   7 List-Subscribe: <mailto:gdb-patches-subscribe at sources dot redhat dot com>
   8 List-Archive: <http://sources.redhat.com/ml/gdb-patches/>
   9 List-Post: <mailto:gdb-patches at sources dot redhat dot com>
  10 List-Help: <mailto:gdb-patches-help at sources dot redhat dot com>, <http://sources dot redhat dot com/ml/#faqs>
  11 Sender: gdb-patches-owner at sources dot redhat dot com
  12 Delivered-To: mailing list gdb-patches at sources dot redhat dot com
  13 Received: (qmail 11801 invoked from network); 2 Jun 2004 10:16:55 -0000
  14 Received: from unknown (HELO nile.gnat.com) (205.232.38.5)
  15   by sourceware dot org with SMTP; 2 Jun 2004 10:16:55 -0000
  16 Received: from localhost (localhost [127.0.0.1])
  17         by nile dot gnat dot com (Postfix) with ESMTP id E93EEF28CC
  18         for <gdb-patches at sources dot redhat dot com>; Wed,  2 Jun 2004 06:16:49 -0400 (EDT)
  19 Received: from nile.gnat.com ([127.0.0.1])
  20  by localhost (nile dot gnat dot com [127 dot 0 dot 0 dot 1]) (amavisd-new, port 10024) with LMTP
  21  id 16597-01-4 for <gdb-patches at sources dot redhat dot com>;
  22  Wed,  2 Jun 2004 06:16:49 -0400 (EDT)
  23 Received: by nile.gnat.com (Postfix, from userid 1345)
  24         id 1C85DF28D3; Wed,  2 Jun 2004 06:16:49 -0400 (EDT)
  25 From: Paul Hilfinger <hilfingr at gnat dot com>
  26 To: gdb-patches at sources dot redhat dot com
  27 Subject: [PATCH]: Updates to Ada sources, part 2b (long)
  28 Message-Id: <20040602101649.1C85DF28D3@nile.gnat.com>
  29 Date: Wed,  2 Jun 2004 06:16:49 -0400 (EDT)
  30 X-Virus-Scanned: by amavisd-new at nile.gnat.com
  31
  32
  33
  34
  35 Index: gdb/ada-lang.c
  36 ===================================================================
  37 RCS file: /cvs/src/src/gdb/ada-lang.c,v
  38 retrieving revision 1.35
  39 diff -u -p -r1.35 ada-lang.c
  40 --- gdb/ada-lang.c      23 Jan 2004 23:03:28 -0000      1.35
  41 +++ gdb/ada-lang.c      2 Jun 2004 09:52:56 -0000
  42 @@ -6573,26 +8293,25 @@ ada_is_string_type (struct type *type)
  43
  44  /* True if TYPE is a struct type introduced by the compiler to force the
  45     alignment of a value.  Such types have a single field with a
  46 -   distinctive name. */
  47 +   distinctive name.  */
  48
  49  int
  50  ada_is_aligner_type (struct type *type)
  51  {
  52    CHECK_TYPEDEF (type);
  53    return (TYPE_CODE (type) == TYPE_CODE_STRUCT
  54 -         && TYPE_NFIELDS (type) == 1
  55 -         && DEPRECATED_STREQ (TYPE_FIELD_NAME (type, 0), "F"));
  56 +          && TYPE_NFIELDS (type) == 1
  57 +          && strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
  58  }
  59
  60  /* If there is an ___XVS-convention type parallel to SUBTYPE, return
  61 -   the parallel type. */
  62 +   the parallel type.  */
  63
  64  struct type *
  65  ada_get_base_type (struct type *raw_type)
  66  {
  67    struct type *real_type_namer;
  68    struct type *raw_real_type;
  69 -  struct type *real_type;
  70
  71    if (raw_type == NULL || TYPE_CODE (raw_type) != TYPE_CODE_STRUCT)
  72      return raw_type;
  73 @@ -6610,7 +8329,7 @@ ada_get_base_type (struct type *raw_type
  74      return raw_real_type;
  75  }
  76
  77 -/* The type of value designated by TYPE, with all aligners removed. */
  78 +/* The type of value designated by TYPE, with all aligners removed.  */
  79
  80  struct type *
  81  ada_aligned_type (struct type *type)
  82 @@ -6623,82 +8342,110 @@ ada_aligned_type (struct type *type)
  83
  84
  85  /* The address of the aligned value in an object at address VALADDR
  86 -   having type TYPE.  Assumes ada_is_aligner_type (TYPE). */
  87 +   having type TYPE.  Assumes ada_is_aligner_type (TYPE).  */
  88
  89  char *
  90  ada_aligned_value_addr (struct type *type, char *valaddr)
  91  {
  92    if (ada_is_aligner_type (type))
  93      return ada_aligned_value_addr (TYPE_FIELD_TYPE (type, 0),
  94 -                                  valaddr +
  95 -                                  TYPE_FIELD_BITPOS (type,
  96 -                                                     0) / TARGET_CHAR_BIT);
  97 +                                   valaddr +
  98 +                                   TYPE_FIELD_BITPOS (type,
  99 +                                                      0) / TARGET_CHAR_BIT);
 100    else
 101      return valaddr;
 102  }
 103
 104 +
 105 +
 106  /* The printed representation of an enumeration literal with encoded
 107 -   name NAME. The value is good to the next call of ada_enum_name. */
 108 +   name NAME.  The value is good to the next call of ada_enum_name.  */
 109  const char *
 110  ada_enum_name (const char *name)
 111  {
 112 +  static char *result;
 113 +  static size_t result_len = 0;
 114    char *tmp;
 115
 116 -  while (1)
 117 -    {
 118 -      if ((tmp = strstr (name, "__")) != NULL)
 119 -       name = tmp + 2;
 120 -      else if ((tmp = strchr (name, '.')) != NULL)
 121 -       name = tmp + 1;
 122 -      else
 123 -       break;
 124 +  /* First, unqualify the enumeration name:
 125 +     1. Search for the last '.' character.  If we find one, then skip
 126 +        all the preceeding characters, the unqualified name starts
 127 +        right after that dot.
 128 +     2. Otherwise, we may be debugging on a target where the compiler
 129 +        translates dots into "__".  Search forward for double underscores,
 130 +        but stop searching when we hit an overloading suffix, which is
 131 +        of the form "__" followed by digits.  */
 132 +
 133 +  if ((tmp = strrchr (name, '.')) != NULL)
 134 +    name = tmp + 1;
 135 +  else
 136 +    {
 137 +      while ((tmp = strstr (name, "__")) != NULL)
 138 +        {
 139 +          if (isdigit (tmp[2]))
 140 +            break;
 141 +          else
 142 +            name = tmp + 2;
 143 +        }
 144      }
 145
 146    if (name[0] == 'Q')
 147      {
 148 -      static char result[16];
 149        int v;
 150        if (name[1] == 'U' || name[1] == 'W')
 151 -       {
 152 -         if (sscanf (name + 2, "%x", &v) != 1)
 153 -           return name;
 154 -       }
 155 +        {
 156 +          if (sscanf (name + 2, "%x", &v) != 1)
 157 +            return name;
 158 +        }
 159        else
 160 -       return name;
 161 +        return name;
 162
 163 +      GROW_VECT (result, result_len, 16);
 164        if (isascii (v) && isprint (v))
 165 -       sprintf (result, "'%c'", v);
 166 +        sprintf (result, "'%c'", v);
 167        else if (name[1] == 'U')
 168 -       sprintf (result, "[\"%02x\"]", v);
 169 +        sprintf (result, "[\"%02x\"]", v);
 170        else
 171 -       sprintf (result, "[\"%04x\"]", v);
 172 +        sprintf (result, "[\"%04x\"]", v);
 173
 174        return result;
 175      }
 176    else
 177 -    return name;
 178 +    {
 179 +      if ((tmp = strstr (name, "__")) != NULL
 180 +          || (tmp = strstr (name, "$")) != NULL)
 181 +        {
 182 +          GROW_VECT (result, result_len, tmp - name + 1);
 183 +          strncpy (result, name, tmp - name);
 184 +          result[tmp - name] = '\0';
 185 +          return result;
 186 +        }
 187 +
 188 +      return name;
 189 +    }
 190  }
 191
 192  static struct value *
 193  evaluate_subexp (struct type *expect_type, struct expression *exp, int *pos,
 194 -                enum noside noside)
 195 +                 enum noside noside)
 196  {
 197 -  return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
 198 +  return (*exp->language_defn->la_exp_desc->evaluate_exp)
 199 +    (expect_type, exp, pos, noside);
 200  }
 201
 202  /* Evaluate the subexpression of EXP starting at *POS as for
 203     evaluate_type, updating *POS to point just past the evaluated
 204 -   expression. */
 205 +   expression.  */
 206
 207  static struct value *
 208  evaluate_subexp_type (struct expression *exp, int *pos)
 209  {
 210 -  return (*exp->language_defn->evaluate_exp)
 211 +  return (*exp->language_defn->la_exp_desc->evaluate_exp)
 212      (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
 213  }
 214
 215  /* If VAL is wrapped in an aligner or subtype wrapper, return the
 216 -   value it wraps. */
 217 +   value it wraps.  */
 218
 219  static struct value *
 220  unwrap_value (struct value *val)
 221 @@ -6707,26 +8454,26 @@ unwrap_value (struct value *val)
 222    if (ada_is_aligner_type (type))
 223      {
 224        struct value *v = value_struct_elt (&val, NULL, "F",
 225 -                                         NULL, "internal structure");
 226 +                                          NULL, "internal structure");
 227        struct type *val_type = check_typedef (VALUE_TYPE (v));
 228        if (ada_type_name (val_type) == NULL)
 229 -       TYPE_NAME (val_type) = ada_type_name (type);
 230 +        TYPE_NAME (val_type) = ada_type_name (type);
 231
 232        return unwrap_value (v);
 233      }
 234    else
 235      {
 236        struct type *raw_real_type =
 237 -       ada_completed_type (ada_get_base_type (type));
 238 +        ada_completed_type (ada_get_base_type (type));
 239
 240        if (type == raw_real_type)
 241 -       return val;
 242 +        return val;
 243
 244        return
 245 -       coerce_unspec_val_to_type
 246 -       (val, 0, ada_to_fixed_type (raw_real_type, 0,
 247 -                                   VALUE_ADDRESS (val) + VALUE_OFFSET (val),
 248 -                                   NULL));
 249 +        coerce_unspec_val_to_type
 250 +        (val, ada_to_fixed_type (raw_real_type, 0,
 251 +                                 VALUE_ADDRESS (val) + VALUE_OFFSET (val),
 252 +                                 NULL));
 253      }
 254  }
 255
 256 @@ -6739,12 +8486,12 @@ cast_to_fixed (struct type *type, struct
 257      return arg;
 258    else if (ada_is_fixed_point_type (VALUE_TYPE (arg)))
 259      val = ada_float_to_fixed (type,
 260 -                             ada_fixed_to_float (VALUE_TYPE (arg),
 261 -                                                 value_as_long (arg)));
 262 +                              ada_fixed_to_float (VALUE_TYPE (arg),
 263 +                                                  value_as_long (arg)));
 264    else
 265      {
 266        DOUBLEST argd =
 267 -       value_as_double (value_cast (builtin_type_double, value_copy (arg)));
 268 +        value_as_double (value_cast (builtin_type_double, value_copy (arg)));
 269        val = ada_float_to_fixed (type, argd);
 270      }
 271
 272 @@ -6755,12 +8502,13 @@ static struct value *
 273  cast_from_fixed_to_double (struct value *arg)
 274  {
 275    DOUBLEST val = ada_fixed_to_float (VALUE_TYPE (arg),
 276 -                                    value_as_long (arg));
 277 +                                     value_as_long (arg));
 278    return value_from_double (builtin_type_double, val);
 279  }
 280
 281 -/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
 282 - * return the converted value. */
 283 +/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
 284 +   return the converted value.  */
 285 +
 286  static struct value *
 287  coerce_for_assign (struct type *type, struct value *val)
 288  {
 289 @@ -6782,20 +8530,98 @@ coerce_for_assign (struct type *type, st
 290        && TYPE_CODE (type) == TYPE_CODE_ARRAY)
 291      {
 292        if (TYPE_LENGTH (type2) != TYPE_LENGTH (type)
 293 -         || TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
 294 -         != TYPE_LENGTH (TYPE_TARGET_TYPE (type2)))
 295 -       error ("Incompatible types in assignment");
 296 +          || TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
 297 +          != TYPE_LENGTH (TYPE_TARGET_TYPE (type2)))
 298 +        error ("Incompatible types in assignment");
 299        VALUE_TYPE (val) = type;
 300      }
 301    return val;
 302  }
 303
 304 +static struct value *
 305 +ada_value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
 306 +{
 307 +  struct value *val;
 308 +  struct type *type1, *type2;
 309 +  LONGEST v, v1, v2;
 310 +
 311 +  COERCE_REF (arg1);
 312 +  COERCE_REF (arg2);
 313 +  type1 = base_type (check_typedef (VALUE_TYPE (arg1)));
 314 +  type2 = base_type (check_typedef (VALUE_TYPE (arg2)));
 315 +
 316 +  if (TYPE_CODE (type1) != TYPE_CODE_INT || TYPE_CODE (type2) != TYPE_CODE_INT)
 317 +    return value_binop (arg1, arg2, op);
 318 +
 319 +  switch (op)
 320 +    {
 321 +    case BINOP_MOD:
 322 +    case BINOP_DIV:
 323 +    case BINOP_REM:
 324 +      break;
 325 +    default:
 326 +      return value_binop (arg1, arg2, op);
 327 +    }
 328 +
 329 +  v2 = value_as_long (arg2);
 330 +  if (v2 == 0)
 331 +    error ("second operand of %s must not be zero.", op_string (op));
 332 +
 333 +  if (TYPE_UNSIGNED (type1) || op == BINOP_MOD)
 334 +    return value_binop (arg1, arg2, op);
 335 +
 336 +  v1 = value_as_long (arg1);
 337 +  switch (op)
 338 +    {
 339 +    case BINOP_DIV:
 340 +      v = v1 / v2;
 341 +      if (! TRUNCATION_TOWARDS_ZERO && v1 * (v1%v2) < 0)
 342 +       v += v > 0 ? -1 : 1;
 343 +      break;
 344 +    case BINOP_REM:
 345 +      v = v1 % v2;
 346 +      if (v*v1 < 0)
 347 +       v -= v2;
 348 +      break;
 349 +    default:
 350 +      /* Should not reach this point.  */
 351 +      v = 0;
 352 +    }
 353 +
 354 +  val = allocate_value (type1);
 355 +  store_unsigned_integer (VALUE_CONTENTS_RAW (val),
 356 +                         TYPE_LENGTH (VALUE_TYPE (val)),
 357 +                         v);
 358 +  return val;
 359 +}
 360 +
 361 +static int
 362 +ada_value_equal (struct value *arg1, struct value *arg2)
 363 +{
 364 +  if (ada_is_direct_array_type (VALUE_TYPE (arg1))
 365 +      || ada_is_direct_array_type (VALUE_TYPE (arg2)))
 366 +    {
 367 +      arg1 = ada_coerce_to_simple_array (arg1);
 368 +      arg2 = ada_coerce_to_simple_array (arg2);
 369 +      if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_ARRAY
 370 +         || TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_ARRAY)
 371 +       error ("Attempt to compare array with non-array");
 372 +      /* FIXME: The following works only for types whose
 373 +        representations use all bits (no padding or undefined bits)
 374 +        and do not have user-defined equality.  */
 375 +      return
 376 +       TYPE_LENGTH (VALUE_TYPE (arg1)) == TYPE_LENGTH (VALUE_TYPE (arg2))
 377 +       && memcmp (VALUE_CONTENTS (arg1), VALUE_CONTENTS (arg2),
 378 +                  TYPE_LENGTH (VALUE_TYPE (arg1))) == 0;
 379 +    }
 380 +  return value_equal (arg1, arg2);
 381 +}
 382 +
 383  struct value *
 384  ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
 385 -                    int *pos, enum noside noside)
 386 +                     int *pos, enum noside noside)
 387  {
 388    enum exp_opcode op;
 389 -  enum ada_attribute atr;
 390    int tem, tem2, tem3;
 391    int pc;
 392    struct value *arg1 = NULL, *arg2 = NULL, *arg3;
 393 @@ -6812,752 +8638,734 @@ ada_evaluate_subexp (struct type *expect
 394      default:
 395        *pos -= 1;
 396        return
 397 -       unwrap_value (evaluate_subexp_standard
 398 -                     (expect_type, exp, pos, noside));
 399 +        unwrap_value (evaluate_subexp_standard
 400 +                      (expect_type, exp, pos, noside));
 401 +
 402 +    case OP_STRING:
 403 +      {
 404 +       struct value *result;
 405 +       *pos -= 1;
 406 +       result = evaluate_subexp_standard (expect_type, exp, pos, noside);
 407 +       /* The result type will have code OP_STRING, bashed there from
 408 +          OP_ARRAY.  Bash it back.  */
 409 +       if (TYPE_CODE (VALUE_TYPE (result)) == TYPE_CODE_STRING)
 410 +         TYPE_CODE (VALUE_TYPE (result)) = TYPE_CODE_ARRAY;
 411 +       return result;
 412 +      }
 413
 414      case UNOP_CAST:
 415        (*pos) += 2;
 416        type = exp->elts[pc + 1].type;
 417        arg1 = evaluate_subexp (type, exp, pos, noside);
 418        if (noside == EVAL_SKIP)
 419 -       goto nosideret;
 420 +        goto nosideret;
 421        if (type != check_typedef (VALUE_TYPE (arg1)))
 422 -       {
 423 -         if (ada_is_fixed_point_type (type))
 424 -           arg1 = cast_to_fixed (type, arg1);
 425 -         else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
 426 -           arg1 = value_cast (type, cast_from_fixed_to_double (arg1));
 427 -         else if (VALUE_LVAL (arg1) == lval_memory)
 428 -           {
 429 -             /* This is in case of the really obscure (and undocumented,
 430 -                but apparently expected) case of (Foo) Bar.all, where Bar
 431 -                is an integer constant and Foo is a dynamic-sized type.
 432 -                If we don't do this, ARG1 will simply be relabeled with
 433 -                TYPE. */
 434 -             if (noside == EVAL_AVOID_SIDE_EFFECTS)
 435 -               return value_zero (to_static_fixed_type (type), not_lval);
 436 -             arg1 =
 437 -               ada_to_fixed_value
 438 -               (type, 0, VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1), 0);
 439 -           }
 440 -         else
 441 -           arg1 = value_cast (type, arg1);
 442 -       }
 443 +        {
 444 +          if (ada_is_fixed_point_type (type))
 445 +            arg1 = cast_to_fixed (type, arg1);
 446 +          else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
 447 +            arg1 = value_cast (type, cast_from_fixed_to_double (arg1));
 448 +          else if (VALUE_LVAL (arg1) == lval_memory)
 449 +            {
 450 +              /* This is in case of the really obscure (and undocumented,
 451 +                 but apparently expected) case of (Foo) Bar.all, where Bar
 452 +                 is an integer constant and Foo is a dynamic-sized type.
 453 +                 If we don't do this, ARG1 will simply be relabeled with
 454 +                 TYPE.  */
 455 +              if (noside == EVAL_AVOID_SIDE_EFFECTS)
 456 +                return value_zero (to_static_fixed_type (type), not_lval);
 457 +              arg1 =
 458 +                ada_to_fixed_value_create
 459 +                (type, VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1), 0);
 460 +            }
 461 +          else
 462 +            arg1 = value_cast (type, arg1);
 463 +        }
 464        return arg1;
 465
 466 -      /* FIXME:  UNOP_QUAL should be defined in expression.h */
 467 -      /*    case UNOP_QUAL:
 468 -         (*pos) += 2;
 469 -         type = exp->elts[pc + 1].type;
 470 -         return ada_evaluate_subexp (type, exp, pos, noside);
 471 -       */
 472 +    case UNOP_QUAL:
 473 +      (*pos) += 2;
 474 +      type = exp->elts[pc + 1].type;
 475 +      return ada_evaluate_subexp (type, exp, pos, noside);
 476 +
 477      case BINOP_ASSIGN:
 478        arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 479        arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
 480        if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
 481 -       return arg1;
 482 -      if (binop_user_defined_p (op, arg1, arg2))
 483 -       return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
 484 +        return arg1;
 485 +      if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
 486 +       arg2 = cast_to_fixed (VALUE_TYPE (arg1), arg2);
 487 +      else if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
 488 +       error
 489 +         ("Fixed-point values must be assigned to fixed-point variables");
 490        else
 491 -       {
 492 -         if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
 493 -           arg2 = cast_to_fixed (VALUE_TYPE (arg1), arg2);
 494 -         else if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
 495 -           error
 496 -             ("Fixed-point values must be assigned to fixed-point variables");
 497 -         else
 498 -           arg2 = coerce_for_assign (VALUE_TYPE (arg1), arg2);
 499 -         return ada_value_assign (arg1, arg2);
 500 -       }
 501 +       arg2 = coerce_for_assign (VALUE_TYPE (arg1), arg2);
 502 +      return ada_value_assign (arg1, arg2);
 503
 504      case BINOP_ADD:
 505        arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 506        arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 507        if (noside == EVAL_SKIP)
 508 -       goto nosideret;
 509 -      if (binop_user_defined_p (op, arg1, arg2))
 510 -       return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
 511 -      else
 512 -       {
 513 -         if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
 514 -              || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
 515 -             && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
 516 -           error
 517 -             ("Operands of fixed-point addition must have the same type");
 518 -         return value_cast (VALUE_TYPE (arg1), value_add (arg1, arg2));
 519 -       }
 520 +        goto nosideret;
 521 +      if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
 522 +          || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
 523 +         && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
 524 +       error
 525 +         ("Operands of fixed-point addition must have the same type");
 526 +      return value_cast (VALUE_TYPE (arg1), value_add (arg1, arg2));
 527
 528      case BINOP_SUB:
 529        arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 530        arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 531        if (noside == EVAL_SKIP)
 532 -       goto nosideret;
 533 -      if (binop_user_defined_p (op, arg1, arg2))
 534 -       return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
 535 -      else
 536 -       {
 537 -         if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
 538 -              || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
 539 -             && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
 540 -           error
 541 -             ("Operands of fixed-point subtraction must have the same type");
 542 -         return value_cast (VALUE_TYPE (arg1), value_sub (arg1, arg2));
 543 -       }
 544 +        goto nosideret;
 545 +      if ((ada_is_fixed_point_type (VALUE_TYPE (arg1))
 546 +          || ada_is_fixed_point_type (VALUE_TYPE (arg2)))
 547 +         && VALUE_TYPE (arg1) != VALUE_TYPE (arg2))
 548 +       error
 549 +         ("Operands of fixed-point subtraction must have the same type");
 550 +      return value_cast (VALUE_TYPE (arg1), value_sub (arg1, arg2));
 551
 552      case BINOP_MUL:
 553      case BINOP_DIV:
 554        arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 555        arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 556        if (noside == EVAL_SKIP)
 557 +        goto nosideret;
 558 +      else if (noside == EVAL_AVOID_SIDE_EFFECTS
 559 +              && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
 560 +        return value_zero (VALUE_TYPE (arg1), not_lval);
 561 +      else
 562 +        {
 563 +          if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
 564 +            arg1 = cast_from_fixed_to_double (arg1);
 565 +          if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
 566 +            arg2 = cast_from_fixed_to_double (arg2);
 567 +          return ada_value_binop (arg1, arg2, op);
 568 +        }
 569 +
 570 +    case BINOP_REM:
 571 +    case BINOP_MOD:
 572 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 573 +      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 574 +      if (noside == EVAL_SKIP)
 575         goto nosideret;
 576 -      if (binop_user_defined_p (op, arg1, arg2))
 577 -       return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
 578 -      else
 579 -       if (noside == EVAL_AVOID_SIDE_EFFECTS
 580 -           && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
 581 +      else if (noside == EVAL_AVOID_SIDE_EFFECTS
 582 +              && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
 583         return value_zero (VALUE_TYPE (arg1), not_lval);
 584        else
 585 -       {
 586 -         if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
 587 -           arg1 = cast_from_fixed_to_double (arg1);
 588 -         if (ada_is_fixed_point_type (VALUE_TYPE (arg2)))
 589 -           arg2 = cast_from_fixed_to_double (arg2);
 590 -         return value_binop (arg1, arg2, op);
 591 -       }
 592 +       return ada_value_binop (arg1, arg2, op);
 593
 594 -    case UNOP_NEG:
 595 +    case BINOP_EQUAL:
 596 +    case BINOP_NOTEQUAL:
 597        arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 598 +      arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
 599        if (noside == EVAL_SKIP)
 600         goto nosideret;
 601 -      if (unop_user_defined_p (op, arg1))
 602 -       return value_x_unop (arg1, op, EVAL_NORMAL);
 603 +      if (noside == EVAL_AVOID_SIDE_EFFECTS)
 604 +       tem = 0;
 605 +      else
 606 +       tem = ada_value_equal (arg1, arg2);
 607 +      if (op == BINOP_NOTEQUAL)
 608 +       tem = ! tem;
 609 +      return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
 610 +
 611 +    case UNOP_NEG:
 612 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 613 +      if (noside == EVAL_SKIP)
 614 +        goto nosideret;
 615        else if (ada_is_fixed_point_type (VALUE_TYPE (arg1)))
 616 -       return value_cast (VALUE_TYPE (arg1), value_neg (arg1));
 617 +        return value_cast (VALUE_TYPE (arg1), value_neg (arg1));
 618        else
 619 -       return value_neg (arg1);
 620 +        return value_neg (arg1);
 621
 622 -      /* FIXME:  OP_UNRESOLVED_VALUE should be defined in expression.h */
 623 -      /*    case OP_UNRESOLVED_VALUE:
 624 -         /* Only encountered when an unresolved symbol occurs in a
 625 -         context other than a function call, in which case, it is
 626 -   illegal. *//*
 627 -   (*pos) += 3;
 628 -   if (noside == EVAL_SKIP)
 629 -   goto nosideret;
 630 -   else
 631 -   error ("Unexpected unresolved symbol, %s, during evaluation",
 632 -   ada_demangle (exp->elts[pc + 2].name));
 633 - */
 634      case OP_VAR_VALUE:
 635        *pos -= 1;
 636        if (noside == EVAL_SKIP)
 637 -       {
 638 -         *pos += 4;
 639 -         goto nosideret;
 640 -       }
 641 +        {
 642 +          *pos += 4;
 643 +          goto nosideret;
 644 +        }
 645 +      else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
 646 +       /* Only encountered when an unresolved symbol occurs in a
 647 +          context other than a function call, in which case, it is
 648 +          illegal.  */
 649 +        error ("Unexpected unresolved symbol, %s, during evaluation",
 650 +               SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
 651        else if (noside == EVAL_AVOID_SIDE_EFFECTS)
 652 -       {
 653 -         *pos += 4;
 654 -         return value_zero
 655 -           (to_static_fixed_type
 656 -            (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
 657 -            not_lval);
 658 -       }
 659 -      else
 660 -       {
 661 -         arg1 =
 662 -           unwrap_value (evaluate_subexp_standard
 663 -                         (expect_type, exp, pos, noside));
 664 -         return ada_to_fixed_value (VALUE_TYPE (arg1), 0,
 665 -                                    VALUE_ADDRESS (arg1) +
 666 -                                    VALUE_OFFSET (arg1), arg1);
 667 -       }
 668 +        {
 669 +          *pos += 4;
 670 +          return value_zero
 671 +            (to_static_fixed_type
 672 +             (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
 673 +             not_lval);
 674 +        }
 675 +      else
 676 +        {
 677 +          arg1 =
 678 +            unwrap_value (evaluate_subexp_standard
 679 +                          (expect_type, exp, pos, noside));
 680 +          return ada_to_fixed_value (arg1);
 681 +        }
 682 +
 683 +    case OP_FUNCALL:
 684 +      (*pos) += 2;
 685 +
 686 +      /* Allocate arg vector, including space for the function to be
 687 +         called in argvec[0] and a terminating NULL.  */
 688 +      nargs = longest_to_int (exp->elts[pc + 1].longconst);
 689 +      argvec =
 690 +        (struct value **) alloca (sizeof (struct value *) * (nargs + 2));
 691 +
 692 +      if (exp->elts[*pos].opcode == OP_VAR_VALUE
 693 +         && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
 694 +        error ("Unexpected unresolved symbol, %s, during evaluation",
 695 +               SYMBOL_PRINT_NAME (exp->elts[pc + 5].symbol));
 696 +      else
 697 +        {
 698 +          for (tem = 0; tem <= nargs; tem += 1)
 699 +            argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 700 +          argvec[tem] = 0;
 701 +
 702 +          if (noside == EVAL_SKIP)
 703 +            goto nosideret;
 704 +        }
 705 +
 706 +      if (ada_is_packed_array_type (desc_base_type (VALUE_TYPE (argvec[0]))))
 707 +        argvec[0] = ada_coerce_to_simple_array (argvec[0]);
 708 +      else if (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_REF
 709 +          || (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_ARRAY
 710 +              && VALUE_LVAL (argvec[0]) == lval_memory))
 711 +        argvec[0] = value_addr (argvec[0]);
 712 +
 713 +      type = check_typedef (VALUE_TYPE (argvec[0]));
 714 +      if (TYPE_CODE (type) == TYPE_CODE_PTR)
 715 +        {
 716 +          switch (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (type))))
 717 +            {
 718 +            case TYPE_CODE_FUNC:
 719 +              type = check_typedef (TYPE_TARGET_TYPE (type));
 720 +              break;
 721 +            case TYPE_CODE_ARRAY:
 722 +              break;
 723 +            case TYPE_CODE_STRUCT:
 724 +              if (noside != EVAL_AVOID_SIDE_EFFECTS)
 725 +                argvec[0] = ada_value_ind (argvec[0]);
 726 +              type = check_typedef (TYPE_TARGET_TYPE (type));
 727 +              break;
 728 +            default:
 729 +              error ("cannot subscript or call something of type `%s'",
 730 +                     ada_type_name (VALUE_TYPE (argvec[0])));
 731 +              break;
 732 +            }
 733 +        }
 734 +
 735 +      switch (TYPE_CODE (type))
 736 +        {
 737 +        case TYPE_CODE_FUNC:
 738 +          if (noside == EVAL_AVOID_SIDE_EFFECTS)
 739 +            return allocate_value (TYPE_TARGET_TYPE (type));
 740 +          return call_function_by_hand (argvec[0], nargs, argvec + 1);
 741 +        case TYPE_CODE_STRUCT:
 742 +          {
 743 +            int arity;
 744 +
 745 +            /* Make sure to use the parallel ___XVS type if any.
 746 +               Otherwise, we won't be able to find the array arity
 747 +               and element type.  */
 748 +            type = ada_get_base_type (type);
 749 +
 750 +            arity = ada_array_arity (type);
 751 +            type = ada_array_element_type (type, nargs);
 752 +            if (type == NULL)
 753 +              error ("cannot subscript or call a record");
 754 +            if (arity != nargs)
 755 +              error ("wrong number of subscripts; expecting %d", arity);
 756 +            if (noside == EVAL_AVOID_SIDE_EFFECTS)
 757 +              return allocate_value (ada_aligned_type (type));
 758 +            return
 759 +              unwrap_value (ada_value_subscript
 760 +                            (argvec[0], nargs, argvec + 1));
 761 +          }
 762 +        case TYPE_CODE_ARRAY:
 763 +          if (noside == EVAL_AVOID_SIDE_EFFECTS)
 764 +            {
 765 +              type = ada_array_element_type (type, nargs);
 766 +              if (type == NULL)
 767 +                error ("element type of array unknown");
 768 +              else
 769 +                return allocate_value (ada_aligned_type (type));
 770 +            }
 771 +          return
 772 +            unwrap_value (ada_value_subscript
 773 +                          (ada_coerce_to_simple_array (argvec[0]),
 774 +                           nargs, argvec + 1));
 775 +        case TYPE_CODE_PTR:     /* Pointer to array */
 776 +          type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
 777 +          if (noside == EVAL_AVOID_SIDE_EFFECTS)
 778 +            {
 779 +              type = ada_array_element_type (type, nargs);
 780 +              if (type == NULL)
 781 +                error ("element type of array unknown");
 782 +              else
 783 +                return allocate_value (ada_aligned_type (type));
 784 +            }
 785 +          return
 786 +            unwrap_value (ada_value_ptr_subscript (argvec[0], type,
 787 +                                                   nargs, argvec + 1));
 788 +
 789 +        default:
 790 +          error ("Internal error in evaluate_subexp");
 791 +        }
 792 +
 793 +    case TERNOP_SLICE:
 794 +      {
 795 +        struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 796 +        struct value *low_bound_val =
 797 +          evaluate_subexp (NULL_TYPE, exp, pos, noside);
 798 +        LONGEST low_bound = pos_atr (low_bound_val);
 799 +        LONGEST high_bound
 800 +          = pos_atr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
 801 +        if (noside == EVAL_SKIP)
 802 +          goto nosideret;
 803 +
 804 +        /* If this is a reference type or a pointer type, and
 805 +           the target type has an XVS parallel type, then get
 806 +           the real target type.  */
 807 +        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
 808 +            || TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR)
 809 +          TYPE_TARGET_TYPE (VALUE_TYPE (array)) =
 810 +            ada_get_base_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)));
 811 +
 812 +        /* If this is a reference to an aligner type, then remove all
 813 +           the aligners.  */
 814 +        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
 815 +            && ada_is_aligner_type (TYPE_TARGET_TYPE (VALUE_TYPE (array))))
 816 +          TYPE_TARGET_TYPE (VALUE_TYPE (array)) =
 817 +            ada_aligned_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)));
 818 +
 819 +       if (ada_is_packed_array_type (VALUE_TYPE (array)))
 820 +         error ("cannot slice a packed array");
 821 +
 822 +        /* If this is a reference to an array or an array lvalue,
 823 +           convert to a pointer.  */
 824 +        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
 825 +            || (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_ARRAY
 826 +                && VALUE_LVAL (array) == lval_memory))
 827 +          array = value_addr (array);
 828 +
 829 +        if (noside == EVAL_AVOID_SIDE_EFFECTS &&
 830 +            ada_is_array_descriptor_type (check_typedef (VALUE_TYPE (array))))
 831 +          {
 832 +            /* Try dereferencing the array, in case it is an access
 833 +               to array.  */
 834 +            struct type *arrType = ada_type_of_array (array, 0);
 835 +            if (arrType != NULL)
 836 +              array = value_at_lazy (arrType, 0, NULL);
 837 +          }
 838 +
 839 +        array = ada_coerce_to_simple_array_ptr (array);
 840 +
 841 +        /* When EVAL_AVOID_SIDE_EFFECTS, we may get the bounds wrong,
 842 +           but only in contexts where the value is not being requested
 843 +           (FIXME?).  */
 844 +        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR)
 845 +          {
 846 +            if (noside == EVAL_AVOID_SIDE_EFFECTS)
 847 +              return ada_value_ind (array);
 848 +            else if (high_bound < low_bound)
 849 +              return empty_array (TYPE_TARGET_TYPE (VALUE_TYPE (array)),
 850 +                                  low_bound);
 851 +            else
 852 +              {
 853 +                struct type *arr_type0 =
 854 +                  to_fixed_array_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)),
 855 +                                       NULL, 1);
 856 +                struct value *item0 =
 857 +                  ada_value_ptr_subscript (array, arr_type0, 1,
 858 +                                           &low_bound_val);
 859 +                struct value *slice =
 860 +                  value_repeat (item0, high_bound - low_bound + 1);
 861 +                struct type *arr_type1 = VALUE_TYPE (slice);
 862 +                TYPE_LOW_BOUND (TYPE_INDEX_TYPE (arr_type1)) = low_bound;
 863 +                TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (arr_type1)) += low_bound;
 864 +                return slice;
 865 +              }
 866 +          }
 867 +        else if (noside == EVAL_AVOID_SIDE_EFFECTS)
 868 +          return array;
 869 +        else if (high_bound < low_bound)
 870 +          return empty_array (VALUE_TYPE (array), low_bound);
 871 +        else
 872 +          return value_slice (array, low_bound, high_bound - low_bound + 1);
 873 +      }
 874 +
 875 +    case UNOP_IN_RANGE:
 876 +      (*pos) += 2;
 877 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 878 +      type = exp->elts[pc + 1].type;
 879 +
 880 +      if (noside == EVAL_SKIP)
 881 +        goto nosideret;
 882 +
 883 +      switch (TYPE_CODE (type))
 884 +        {
 885 +        default:
 886 +          lim_warning ("Membership test incompletely implemented; "
 887 +                       "always returns true", 0);
 888 +          return value_from_longest (builtin_type_int, (LONGEST) 1);
 889 +
 890 +        case TYPE_CODE_RANGE:
 891 +          arg2 = value_from_longest (builtin_type_int,
 892 +                                     TYPE_LOW_BOUND (type));
 893 +          arg3 = value_from_longest (builtin_type_int,
 894 +                                     TYPE_HIGH_BOUND (type));
 895 +          return
 896 +            value_from_longest (builtin_type_int,
 897 +                                (value_less (arg1, arg3)
 898 +                                 || value_equal (arg1, arg3))
 899 +                                && (value_less (arg2, arg1)
 900 +                                    || value_equal (arg2, arg1)));
 901 +        }
 902
 903 -    case OP_ARRAY:
 904 -      (*pos) += 3;
 905 -      tem2 = longest_to_int (exp->elts[pc + 1].longconst);
 906 -      tem3 = longest_to_int (exp->elts[pc + 2].longconst);
 907 -      nargs = tem3 - tem2 + 1;
 908 -      type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
 909 +    case BINOP_IN_BOUNDS:
 910 +      (*pos) += 2;
 911 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 912 +      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 913
 914 -      argvec =
 915 -       (struct value * *) alloca (sizeof (struct value *) * (nargs + 1));
 916 -      for (tem = 0; tem == 0 || tem < nargs; tem += 1)
 917 -       /* At least one element gets inserted for the type */
 918 -       {
 919 -         /* Ensure that array expressions are coerced into pointer objects. */
 920 -         argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
 921 -       }
 922        if (noside == EVAL_SKIP)
 923 -       goto nosideret;
 924 -      return value_array (tem2, tem3, argvec);
 925 +        goto nosideret;
 926
 927 -    case OP_FUNCALL:
 928 -      (*pos) += 2;
 929 +      if (noside == EVAL_AVOID_SIDE_EFFECTS)
 930 +        return value_zero (builtin_type_int, not_lval);
 931
 932 -      /* Allocate arg vector, including space for the function to be
 933 -         called in argvec[0] and a terminating NULL */
 934 -      nargs = longest_to_int (exp->elts[pc + 1].longconst);
 935 -      argvec =
 936 -       (struct value * *) alloca (sizeof (struct value *) * (nargs + 2));
 937 +      tem = longest_to_int (exp->elts[pc + 1].longconst);
 938
 939 -      /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
 940 -      /* FIXME: name should be defined in expresion.h */
 941 -      /*      if (exp->elts[*pos].opcode == OP_UNRESOLVED_VALUE)
 942 -         error ("Unexpected unresolved symbol, %s, during evaluation",
 943 -         ada_demangle (exp->elts[pc + 5].name));
 944 -       */
 945 -      if (0)
 946 -       {
 947 -         error ("unexpected code path, FIXME");
 948 -       }
 949 -      else
 950 -       {
 951 -         for (tem = 0; tem <= nargs; tem += 1)
 952 -           argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 953 -         argvec[tem] = 0;
 954 +      if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg2)))
 955 +        error ("invalid dimension number to '%s", "range");
 956
 957 -         if (noside == EVAL_SKIP)
 958 -           goto nosideret;
 959 -       }
 960 +      arg3 = ada_array_bound (arg2, tem, 1);
 961 +      arg2 = ada_array_bound (arg2, tem, 0);
 962
 963 -      if (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_REF)
 964 -       argvec[0] = value_addr (argvec[0]);
 965 +      return
 966 +        value_from_longest (builtin_type_int,
 967 +                            (value_less (arg1, arg3)
 968 +                             || value_equal (arg1, arg3))
 969 +                            && (value_less (arg2, arg1)
 970 +                                || value_equal (arg2, arg1)));
 971
 972 -      if (ada_is_packed_array_type (VALUE_TYPE (argvec[0])))
 973 -       argvec[0] = ada_coerce_to_simple_array (argvec[0]);
 974 +    case TERNOP_IN_RANGE:
 975 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 976 +      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 977 +      arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
 978
 979 -      type = check_typedef (VALUE_TYPE (argvec[0]));
 980 -      if (TYPE_CODE (type) == TYPE_CODE_PTR)
 981 -       {
 982 -         switch (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (type))))
 983 -           {
 984 -           case TYPE_CODE_FUNC:
 985 -             type = check_typedef (TYPE_TARGET_TYPE (type));
 986 -             break;
 987 -           case TYPE_CODE_ARRAY:
 988 -             break;
 989 -           case TYPE_CODE_STRUCT:
 990 -             if (noside != EVAL_AVOID_SIDE_EFFECTS)
 991 -               argvec[0] = ada_value_ind (argvec[0]);
 992 -             type = check_typedef (TYPE_TARGET_TYPE (type));
 993 -             break;
 994 -           default:
 995 -             error ("cannot subscript or call something of type `%s'",
 996 -                    ada_type_name (VALUE_TYPE (argvec[0])));
 997 -             break;
 998 -           }
 999 -       }
1000 +      if (noside == EVAL_SKIP)
1001 +        goto nosideret;
1002
1003 -      switch (TYPE_CODE (type))
1004 -       {
1005 -       case TYPE_CODE_FUNC:
1006 -         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1007 -           return allocate_value (TYPE_TARGET_TYPE (type));
1008 -         return call_function_by_hand (argvec[0], nargs, argvec + 1);
1009 -       case TYPE_CODE_STRUCT:
1010 +      return
1011 +        value_from_longest (builtin_type_int,
1012 +                            (value_less (arg1, arg3)
1013 +                             || value_equal (arg1, arg3))
1014 +                            && (value_less (arg2, arg1)
1015 +                                || value_equal (arg2, arg1)));
1016 +
1017 +    case OP_ATR_FIRST:
1018 +    case OP_ATR_LAST:
1019 +    case OP_ATR_LENGTH:
1020 +      {
1021 +       struct type *type_arg;
1022 +       if (exp->elts[*pos].opcode == OP_TYPE)
1023           {
1024 -           int arity = ada_array_arity (type);
1025 -           type = ada_array_element_type (type, nargs);
1026 -           if (type == NULL)
1027 -             error ("cannot subscript or call a record");
1028 -           if (arity != nargs)
1029 -             error ("wrong number of subscripts; expecting %d", arity);
1030 -           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1031 -             return allocate_value (ada_aligned_type (type));
1032 -           return
1033 -             unwrap_value (ada_value_subscript
1034 -                           (argvec[0], nargs, argvec + 1));
1035 +           evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1036 +           arg1 = NULL;
1037 +           type_arg = exp->elts[pc + 2].type;
1038 +         }
1039 +       else
1040 +         {
1041 +           arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1042 +           type_arg = NULL;
1043           }
1044 -       case TYPE_CODE_ARRAY:
1045 -         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1046 -           {
1047 -             type = ada_array_element_type (type, nargs);
1048 -             if (type == NULL)
1049 -               error ("element type of array unknown");
1050 -             else
1051 -               return allocate_value (ada_aligned_type (type));
1052 -           }
1053 -         return
1054 -           unwrap_value (ada_value_subscript
1055 -                         (ada_coerce_to_simple_array (argvec[0]),
1056 -                          nargs, argvec + 1));
1057 -       case TYPE_CODE_PTR:     /* Pointer to array */
1058 -         type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
1059 -         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1060 -           {
1061 -             type = ada_array_element_type (type, nargs);
1062 -             if (type == NULL)
1063 -               error ("element type of array unknown");
1064 -             else
1065 -               return allocate_value (ada_aligned_type (type));
1066 -           }
1067 -         return
1068 -           unwrap_value (ada_value_ptr_subscript (argvec[0], type,
1069 -                                                  nargs, argvec + 1));
1070
1071 -       default:
1072 -         error ("Internal error in evaluate_subexp");
1073 -       }
1074 +       if (exp->elts[*pos].opcode != OP_LONG)
1075 +         error ("illegal operand to '%s", ada_attribute_name (op));
1076 +       tem = longest_to_int (exp->elts[*pos + 2].longconst);
1077 +       *pos += 4;
1078
1079 -    case TERNOP_SLICE:
1080 -      {
1081 -       struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1082 -       int lowbound
1083 -         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1084 -       int upper
1085 -         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
1086         if (noside == EVAL_SKIP)
1087           goto nosideret;
1088
1089 -       /* If this is a reference to an array, then dereference it */
1090 -       if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
1091 -           && TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL
1092 -           && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) ==
1093 -           TYPE_CODE_ARRAY
1094 -           && !ada_is_array_descriptor (check_typedef (VALUE_TYPE (array))))
1095 +       if (type_arg == NULL)
1096           {
1097 -           array = ada_coerce_ref (array);
1098 -         }
1099 +           arg1 = ada_coerce_ref (arg1);
1100
1101 -       if (noside == EVAL_AVOID_SIDE_EFFECTS &&
1102 -           ada_is_array_descriptor (check_typedef (VALUE_TYPE (array))))
1103 -         {
1104 -           /* Try to dereference the array, in case it is an access to array */
1105 -           struct type *arrType = ada_type_of_array (array, 0);
1106 -           if (arrType != NULL)
1107 -             array = value_at_lazy (arrType, 0, NULL);
1108 -         }
1109 -       if (ada_is_array_descriptor (VALUE_TYPE (array)))
1110 -         array = ada_coerce_to_simple_array (array);
1111 +           if (ada_is_packed_array_type (VALUE_TYPE (arg1)))
1112 +             arg1 = ada_coerce_to_simple_array (arg1);
1113 +
1114 +           if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg1)))
1115 +             error ("invalid dimension number to '%s",
1116 +                    ada_attribute_name (op));
1117 +
1118 +           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1119 +             {
1120 +               type = ada_index_type (VALUE_TYPE (arg1), tem);
1121 +               if (type == NULL)
1122 +                 error
1123 +                   ("attempt to take bound of something that is not an array");
1124 +               return allocate_value (type);
1125 +             }
1126
1127 -       /* If at this point we have a pointer to an array, it means that
1128 -          it is a pointer to a simple (non-ada) array. We just then
1129 -          dereference it */
1130 -       if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR
1131 -           && TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL
1132 -           && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) ==
1133 -           TYPE_CODE_ARRAY)
1134 +           switch (op)
1135 +             {
1136 +             default: /* Should never happen.  */
1137 +               error ("unexpected attribute encountered");
1138 +             case OP_ATR_FIRST:
1139 +               return ada_array_bound (arg1, tem, 0);
1140 +             case OP_ATR_LAST:
1141 +               return ada_array_bound (arg1, tem, 1);
1142 +             case OP_ATR_LENGTH:
1143 +               return ada_array_length (arg1, tem);
1144 +             }
1145 +         }
1146 +       else if (discrete_type_p (type_arg))
1147           {
1148 -           array = ada_value_ind (array);
1149 +           struct type *range_type;
1150 +           char *name = ada_type_name (type_arg);
1151 +           range_type = NULL;
1152 +           if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
1153 +             range_type =
1154 +               to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
1155 +           if (range_type == NULL)
1156 +             range_type = type_arg;
1157 +           switch (op)
1158 +             {
1159 +             default:
1160 +               error ("unexpected attribute encountered");
1161 +             case OP_ATR_FIRST:
1162 +               return discrete_type_low_bound (range_type);
1163 +             case OP_ATR_LAST:
1164 +               return discrete_type_high_bound (range_type);
1165 +             case OP_ATR_LENGTH:
1166 +               error ("the 'length attribute applies only to array types");
1167 +             }
1168           }
1169 -
1170 -       if (noside == EVAL_AVOID_SIDE_EFFECTS)
1171 -         /* The following will get the bounds wrong, but only in contexts
1172 -            where the value is not being requested (FIXME?). */
1173 -         return array;
1174 +       else if (TYPE_CODE (type_arg) == TYPE_CODE_FLT)
1175 +         error ("unimplemented type attribute");
1176         else
1177 -         return value_slice (array, lowbound, upper - lowbound + 1);
1178 +         {
1179 +           LONGEST low, high;
1180 +
1181 +           if (ada_is_packed_array_type (type_arg))
1182 +             type_arg = decode_packed_array_type (type_arg);
1183 +
1184 +           if (tem < 1 || tem > ada_array_arity (type_arg))
1185 +             error ("invalid dimension number to '%s",
1186 +                    ada_attribute_name (op));
1187 +
1188 +           type = ada_index_type (type_arg, tem);
1189 +           if (type == NULL)
1190 +             error ("attempt to take bound of something that is not an array");
1191 +           if (noside == EVAL_AVOID_SIDE_EFFECTS)
1192 +             return allocate_value (type);
1193 +
1194 +           switch (op)
1195 +             {
1196 +             default:
1197 +               error ("unexpected attribute encountered");
1198 +             case OP_ATR_FIRST:
1199 +               low = ada_array_bound_from_type (type_arg, tem, 0, &type);
1200 +               return value_from_longest (type, low);
1201 +             case OP_ATR_LAST:
1202 +               high =
1203 +                 ada_array_bound_from_type (type_arg, tem, 1, &type);
1204 +               return value_from_longest (type, high);
1205 +             case OP_ATR_LENGTH:
1206 +               low = ada_array_bound_from_type (type_arg, tem, 0, &type);
1207 +               high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
1208 +               return value_from_longest (type, high - low + 1);
1209 +             }
1210 +         }
1211        }
1212
1213 -      /* FIXME: UNOP_MBR should be defined in expression.h */
1214 -      /*    case UNOP_MBR:
1215 -         (*pos) += 2;
1216 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1217 -         type = exp->elts[pc + 1].type;
1218 -
1219 -         if (noside == EVAL_SKIP)
1220 -         goto nosideret;
1221 -
1222 -         switch (TYPE_CODE (type))
1223 -         {
1224 -         default:
1225 -         warning ("Membership test incompletely implemented; always returns true");
1226 -         return value_from_longest (builtin_type_int, (LONGEST) 1);
1227 -
1228 -         case TYPE_CODE_RANGE:
1229 -         arg2 = value_from_longest (builtin_type_int,
1230 -         (LONGEST) TYPE_LOW_BOUND (type));
1231 -         arg3 = value_from_longest (builtin_type_int,
1232 -         (LONGEST) TYPE_HIGH_BOUND (type));
1233 -         return
1234 -         value_from_longest (builtin_type_int,
1235 -         (value_less (arg1,arg3)
1236 -         || value_equal (arg1,arg3))
1237 -         && (value_less (arg2,arg1)
1238 -         || value_equal (arg2,arg1)));
1239 -         }
1240 -       */
1241 -      /* FIXME: BINOP_MBR should be defined in expression.h */
1242 -      /*    case BINOP_MBR:
1243 -         (*pos) += 2;
1244 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1245 -         arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1246 -
1247 -         if (noside == EVAL_SKIP)
1248 -         goto nosideret;
1249 -
1250 -         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1251 -         return value_zero (builtin_type_int, not_lval);
1252 -
1253 -         tem = longest_to_int (exp->elts[pc + 1].longconst);
1254 -
1255 -         if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg2)))
1256 -         error ("invalid dimension number to '%s", "range");
1257 -
1258 -         arg3 = ada_array_bound (arg2, tem, 1);
1259 -         arg2 = ada_array_bound (arg2, tem, 0);
1260 -
1261 -         return
1262 -         value_from_longest (builtin_type_int,
1263 -         (value_less (arg1,arg3)
1264 -         || value_equal (arg1,arg3))
1265 -         && (value_less (arg2,arg1)
1266 -         || value_equal (arg2,arg1)));
1267 -       */
1268 -      /* FIXME: TERNOP_MBR should be defined in expression.h */
1269 -      /*    case TERNOP_MBR:
1270 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1271 -         arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1272 -         arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1273 -
1274 -         if (noside == EVAL_SKIP)
1275 -         goto nosideret;
1276 -
1277 -         return
1278 -         value_from_longest (builtin_type_int,
1279 -         (value_less (arg1,arg3)
1280 -         || value_equal (arg1,arg3))
1281 -         && (value_less (arg2,arg1)
1282 -         || value_equal (arg2,arg1)));
1283 -       */
1284 -      /* FIXME: OP_ATTRIBUTE should be defined in expression.h */
1285 -      /*    case OP_ATTRIBUTE:
1286 -         *pos += 3;
1287 -         atr = (enum ada_attribute) longest_to_int (exp->elts[pc + 2].longconst);
1288 -         switch (atr)
1289 -         {
1290 -         default:
1291 -         error ("unexpected attribute encountered");
1292 -
1293 -         case ATR_FIRST:
1294 -         case ATR_LAST:
1295 -         case ATR_LENGTH:
1296 -         {
1297 -         struct type* type_arg;
1298 -         if (exp->elts[*pos].opcode == OP_TYPE)
1299 -         {
1300 -         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1301 -         arg1 = NULL;
1302 -         type_arg = exp->elts[pc + 5].type;
1303 -         }
1304 -         else
1305 -         {
1306 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1307 -         type_arg = NULL;
1308 -         }
1309 -
1310 -         if (exp->elts[*pos].opcode != OP_LONG)
1311 -         error ("illegal operand to '%s", ada_attribute_name (atr));
1312 -         tem = longest_to_int (exp->elts[*pos+2].longconst);
1313 -         *pos += 4;
1314 -
1315 -         if (noside == EVAL_SKIP)
1316 -         goto nosideret;
1317 -
1318 -         if (type_arg == NULL)
1319 -         {
1320 -         arg1 = ada_coerce_ref (arg1);
1321 -
1322 -         if (ada_is_packed_array_type (VALUE_TYPE (arg1)))
1323 -         arg1 = ada_coerce_to_simple_array (arg1);
1324 -
1325 -         if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg1)))
1326 -         error ("invalid dimension number to '%s",
1327 -         ada_attribute_name (atr));
1328 -
1329 -         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1330 -         {
1331 -         type = ada_index_type (VALUE_TYPE (arg1), tem);
1332 -         if (type == NULL)
1333 -         error ("attempt to take bound of something that is not an array");
1334 -         return allocate_value (type);
1335 -         }
1336 -
1337 -         switch (atr)
1338 -         {
1339 -         default:
1340 -         error ("unexpected attribute encountered");
1341 -         case ATR_FIRST:
1342 -         return ada_array_bound (arg1, tem, 0);
1343 -         case ATR_LAST:
1344 -         return ada_array_bound (arg1, tem, 1);
1345 -         case ATR_LENGTH:
1346 -         return ada_array_length (arg1, tem);
1347 -         }
1348 -         }
1349 -         else if (TYPE_CODE (type_arg) == TYPE_CODE_RANGE
1350 -         || TYPE_CODE (type_arg) == TYPE_CODE_INT)
1351 -         {
1352 -         struct type* range_type;
1353 -         char* name = ada_type_name (type_arg);
1354 -         if (name == NULL)
1355 -         {
1356 -         if (TYPE_CODE (type_arg) == TYPE_CODE_RANGE)
1357 -         range_type = type_arg;
1358 -         else
1359 -         error ("unimplemented type attribute");
1360 -         }
1361 -         else
1362 -         range_type =
1363 -         to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
1364 -         switch (atr)
1365 -         {
1366 -         default:
1367 -         error ("unexpected attribute encountered");
1368 -         case ATR_FIRST:
1369 -         return value_from_longest (TYPE_TARGET_TYPE (range_type),
1370 -         TYPE_LOW_BOUND (range_type));
1371 -         case ATR_LAST:
1372 -         return value_from_longest (TYPE_TARGET_TYPE (range_type),
1373 -         TYPE_HIGH_BOUND (range_type));
1374 -         }
1375 -         }
1376 -         else if (TYPE_CODE (type_arg) == TYPE_CODE_ENUM)
1377 -         {
1378 -         switch (atr)
1379 -         {
1380 -         default:
1381 -         error ("unexpected attribute encountered");
1382 -         case ATR_FIRST:
1383 -         return value_from_longest
1384 -         (type_arg, TYPE_FIELD_BITPOS (type_arg, 0));
1385 -         case ATR_LAST:
1386 -         return value_from_longest
1387 -         (type_arg,
1388 -         TYPE_FIELD_BITPOS (type_arg,
1389 -         TYPE_NFIELDS (type_arg) - 1));
1390 -         }
1391 -         }
1392 -         else if (TYPE_CODE (type_arg) == TYPE_CODE_FLT)
1393 -         error ("unimplemented type attribute");
1394 -         else
1395 -         {
1396 -         LONGEST low, high;
1397 -
1398 -         if (ada_is_packed_array_type (type_arg))
1399 -         type_arg = decode_packed_array_type (type_arg);
1400 -
1401 -         if (tem < 1 || tem > ada_array_arity (type_arg))
1402 -         error ("invalid dimension number to '%s",
1403 -         ada_attribute_name (atr));
1404 -
1405 -         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1406 -         {
1407 -         type = ada_index_type (type_arg, tem);
1408 -         if (type == NULL)
1409 -         error ("attempt to take bound of something that is not an array");
1410 -         return allocate_value (type);
1411 -         }
1412 -
1413 -         switch (atr)
1414 -         {
1415 -         default:
1416 -         error ("unexpected attribute encountered");
1417 -         case ATR_FIRST:
1418 -         low = ada_array_bound_from_type (type_arg, tem, 0, &type);
1419 -         return value_from_longest (type, low);
1420 -         case ATR_LAST:
1421 -         high = ada_array_bound_from_type (type_arg, tem, 1, &type);
1422 -         return value_from_longest (type, high);
1423 -         case ATR_LENGTH:
1424 -         low = ada_array_bound_from_type (type_arg, tem, 0, &type);
1425 -         high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
1426 -         return value_from_longest (type, high-low+1);
1427 -         }
1428 -         }
1429 -         }
1430 -
1431 -         case ATR_TAG:
1432 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1433 -         if (noside == EVAL_SKIP)
1434 -         goto nosideret;
1435 -
1436 -         if (noside == EVAL_AVOID_SIDE_EFFECTS)
1437 -         return
1438 -         value_zero (ada_tag_type (arg1), not_lval);
1439 -
1440 -         return ada_value_tag (arg1);
1441 -
1442 -         case ATR_MIN:
1443 -         case ATR_MAX:
1444 -         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1445 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1446 -         arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1447 -         if (noside == EVAL_SKIP)
1448 -         goto nosideret;
1449 -         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1450 -         return value_zero (VALUE_TYPE (arg1), not_lval);
1451 -         else
1452 -         return value_binop (arg1, arg2,
1453 -         atr == ATR_MIN ? BINOP_MIN : BINOP_MAX);
1454 -
1455 -         case ATR_MODULUS:
1456 -         {
1457 -         struct type* type_arg = exp->elts[pc + 5].type;
1458 -         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1459 -         *pos += 4;
1460 -
1461 -         if (noside == EVAL_SKIP)
1462 -         goto nosideret;
1463 -
1464 -         if (! ada_is_modular_type (type_arg))
1465 -         error ("'modulus must be applied to modular type");
1466 -
1467 -         return value_from_longest (TYPE_TARGET_TYPE (type_arg),
1468 -         ada_modulus (type_arg));
1469 -         }
1470 -
1471 -
1472 -         case ATR_POS:
1473 -         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1474 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1475 -         if (noside == EVAL_SKIP)
1476 -         goto nosideret;
1477 -         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1478 -         return value_zero (builtin_type_ada_int, not_lval);
1479 -         else
1480 -         return value_pos_atr (arg1);
1481 -
1482 -         case ATR_SIZE:
1483 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1484 -         if (noside == EVAL_SKIP)
1485 -         goto nosideret;
1486 -         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1487 -         return value_zero (builtin_type_ada_int, not_lval);
1488 -         else
1489 -         return value_from_longest (builtin_type_ada_int,
1490 -         TARGET_CHAR_BIT
1491 -         * TYPE_LENGTH (VALUE_TYPE (arg1)));
1492 -
1493 -         case ATR_VAL:
1494 -         evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1495 -         arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1496 -         type = exp->elts[pc + 5].type;
1497 -         if (noside == EVAL_SKIP)
1498 -         goto nosideret;
1499 -         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1500 -         return value_zero (type, not_lval);
1501 -         else
1502 -         return value_val_atr (type, arg1);
1503 -         } */
1504 -    case BINOP_EXP:
1505 +    case OP_ATR_TAG:
1506 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1507 +      if (noside == EVAL_SKIP)
1508 +       goto nosideret;
1509 +
1510 +      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1511 +       return value_zero (ada_tag_type (arg1), not_lval);
1512 +
1513 +      return ada_value_tag (arg1);
1514 +
1515 +    case OP_ATR_MIN:
1516 +    case OP_ATR_MAX:
1517 +      evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1518        arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1519        arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1520        if (noside == EVAL_SKIP)
1521         goto nosideret;
1522 -      if (binop_user_defined_p (op, arg1, arg2))
1523 -       return unwrap_value (value_x_binop (arg1, arg2, op, OP_NULL,
1524 -                                           EVAL_NORMAL));
1525        else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1526         return value_zero (VALUE_TYPE (arg1), not_lval);
1527        else
1528 -       return value_binop (arg1, arg2, op);
1529 +       return value_binop (arg1, arg2,
1530 +                           op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
1531
1532 -    case UNOP_PLUS:
1533 +    case OP_ATR_MODULUS:
1534 +      {
1535 +       struct type *type_arg = exp->elts[pc + 2].type;
1536 +       evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1537 +
1538 +       if (noside == EVAL_SKIP)
1539 +         goto nosideret;
1540 +
1541 +       if (!ada_is_modular_type (type_arg))
1542 +         error ("'modulus must be applied to modular type");
1543 +
1544 +       return value_from_longest (TYPE_TARGET_TYPE (type_arg),
1545 +                                  ada_modulus (type_arg));
1546 +      }
1547 +
1548 +
1549 +    case OP_ATR_POS:
1550 +      evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1551        arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1552        if (noside == EVAL_SKIP)
1553         goto nosideret;
1554 -      if (unop_user_defined_p (op, arg1))
1555 -       return unwrap_value (value_x_unop (arg1, op, EVAL_NORMAL));
1556 +      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1557 +       return value_zero (builtin_type_ada_int, not_lval);
1558        else
1559 -       return arg1;
1560 +       return value_pos_atr (arg1);
1561
1562 -    case UNOP_ABS:
1563 +    case OP_ATR_SIZE:
1564 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1565 +      if (noside == EVAL_SKIP)
1566 +       goto nosideret;
1567 +      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1568 +       return value_zero (builtin_type_ada_int, not_lval);
1569 +      else
1570 +       return value_from_longest (builtin_type_ada_int,
1571 +                                  TARGET_CHAR_BIT
1572 +                                  * TYPE_LENGTH (VALUE_TYPE (arg1)));
1573 +
1574 +    case OP_ATR_VAL:
1575 +      evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
1576        arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1577 +      type = exp->elts[pc + 2].type;
1578        if (noside == EVAL_SKIP)
1579         goto nosideret;
1580 +      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1581 +       return value_zero (type, not_lval);
1582 +      else
1583 +       return value_val_atr (type, arg1);
1584 +
1585 +    case BINOP_EXP:
1586 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1587 +      arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1588 +      if (noside == EVAL_SKIP)
1589 +        goto nosideret;
1590 +      else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1591 +        return value_zero (VALUE_TYPE (arg1), not_lval);
1592 +      else
1593 +        return value_binop (arg1, arg2, op);
1594 +
1595 +    case UNOP_PLUS:
1596 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1597 +      if (noside == EVAL_SKIP)
1598 +        goto nosideret;
1599 +      else
1600 +        return arg1;
1601 +
1602 +    case UNOP_ABS:
1603 +      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1604 +      if (noside == EVAL_SKIP)
1605 +        goto nosideret;
1606        if (value_less (arg1, value_zero (VALUE_TYPE (arg1), not_lval)))
1607 -       return value_neg (arg1);
1608 +        return value_neg (arg1);
1609        else
1610 -       return arg1;
1611 +        return arg1;
1612
1613      case UNOP_IND:
1614        if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
1615 -       expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1616 +        expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type));
1617        arg1 = evaluate_subexp (expect_type, exp, pos, noside);
1618        if (noside == EVAL_SKIP)
1619 -       goto nosideret;
1620 +        goto nosideret;
1621        type = check_typedef (VALUE_TYPE (arg1));
1622        if (noside == EVAL_AVOID_SIDE_EFFECTS)
1623 -       {
1624 -         if (ada_is_array_descriptor (type))
1625 -           /* GDB allows dereferencing GNAT array descriptors. */
1626 -           {
1627 -             struct type *arrType = ada_type_of_array (arg1, 0);
1628 -             if (arrType == NULL)
1629 -               error ("Attempt to dereference null array pointer.");
1630 -             return value_at_lazy (arrType, 0, NULL);
1631 -           }
1632 -         else if (TYPE_CODE (type) == TYPE_CODE_PTR
1633 -                  || TYPE_CODE (type) == TYPE_CODE_REF
1634 -                  /* In C you can dereference an array to get the 1st elt.  */
1635 -                  || TYPE_CODE (type) == TYPE_CODE_ARRAY)
1636 -           return
1637 -             value_zero
1638 -             (to_static_fixed_type
1639 -              (ada_aligned_type (check_typedef (TYPE_TARGET_TYPE (type)))),
1640 -              lval_memory);
1641 -         else if (TYPE_CODE (type) == TYPE_CODE_INT)
1642 -           /* GDB allows dereferencing an int.  */
1643 -           return value_zero (builtin_type_int, lval_memory);
1644 -         else
1645 -           error ("Attempt to take contents of a non-pointer value.");
1646 -       }
1647 -      arg1 = ada_coerce_ref (arg1);
1648 +        {
1649 +          if (ada_is_array_descriptor_type (type))
1650 +            /* GDB allows dereferencing GNAT array descriptors.  */
1651 +            {
1652 +              struct type *arrType = ada_type_of_array (arg1, 0);
1653 +              if (arrType == NULL)
1654 +                error ("Attempt to dereference null array pointer.");
1655 +              return value_at_lazy (arrType, 0, NULL);
1656 +            }
1657 +          else if (TYPE_CODE (type) == TYPE_CODE_PTR
1658 +                   || TYPE_CODE (type) == TYPE_CODE_REF
1659 +                   /* In C you can dereference an array to get the 1st elt.  */
1660 +                   || TYPE_CODE (type) == TYPE_CODE_ARRAY)
1661 +            return
1662 +              value_zero
1663 +              (to_static_fixed_type
1664 +               (ada_aligned_type (check_typedef (TYPE_TARGET_TYPE (type)))),
1665 +               lval_memory);
1666 +          else if (TYPE_CODE (type) == TYPE_CODE_INT)
1667 +            /* GDB allows dereferencing an int.  */
1668 +            return value_zero (builtin_type_int, lval_memory);
1669 +          else
1670 +            error ("Attempt to take contents of a non-pointer value.");
1671 +        }
1672 +      arg1 = ada_coerce_ref (arg1);  /* FIXME: What is this for?? */
1673        type = check_typedef (VALUE_TYPE (arg1));
1674
1675 -      if (ada_is_array_descriptor (type))
1676 -       /* GDB allows dereferencing GNAT array descriptors. */
1677 -       return ada_coerce_to_simple_array (arg1);
1678 +      if (ada_is_array_descriptor_type (type))
1679 +        /* GDB allows dereferencing GNAT array descriptors.  */
1680 +        return ada_coerce_to_simple_array (arg1);
1681        else
1682 -       return ada_value_ind (arg1);
1683 +        return ada_value_ind (arg1);
1684
1685      case STRUCTOP_STRUCT:
1686        tem = longest_to_int (exp->elts[pc + 1].longconst);
1687        (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1688        arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1689        if (noside == EVAL_SKIP)
1690 -       goto nosideret;
1691 +        goto nosideret;
1692        if (noside == EVAL_AVOID_SIDE_EFFECTS)
1693 -       return value_zero (ada_aligned_type
1694 -                          (ada_lookup_struct_elt_type (VALUE_TYPE (arg1),
1695 -                                                       &exp->elts[pc +
1696 -                                                                  2].string,
1697 -                                                       0, NULL)),
1698 -                          lval_memory);
1699 -      else
1700 -       return unwrap_value (ada_value_struct_elt (arg1,
1701 -                                                  &exp->elts[pc + 2].string,
1702 -                                                  "record"));
1703 +       {
1704 +         struct type *type1 = VALUE_TYPE (arg1);
1705 +         if (ada_is_tagged_type (type1, 1))
1706 +           {
1707 +             type = ada_lookup_struct_elt_type (type1,
1708 +                                                &exp->elts[pc + 2].string,
1709 +                                                1, 1, NULL);
1710 +             if (type == NULL)
1711 +           /* In this case, we assume that the field COULD exist
1712 +              in some extension of the type.  Return an object of
1713 +              "type" void, which will match any formal
1714 +              (see ada_type_match). */
1715 +               return value_zero (builtin_type_void, lval_memory);
1716 +           }
1717 +         else
1718 +           type = ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string,
1719 +                                              1, 0, NULL);
1720 +
1721 +         return value_zero (ada_aligned_type (type), lval_memory);
1722 +       }
1723 +      else
1724 +        return
1725 +         ada_to_fixed_value (unwrap_value
1726 +                             (ada_value_struct_elt
1727 +                              (arg1, &exp->elts[pc + 2].string, "record")));
1728      case OP_TYPE:
1729 -      /* The value is not supposed to be used. This is here to make it
1730 -         easier to accommodate expressions that contain types. */
1731 +      /* The value is not supposed to be used.  This is here to make it
1732 +         easier to accommodate expressions that contain types.  */
1733        (*pos) += 2;
1734        if (noside == EVAL_SKIP)
1735 -       goto nosideret;
1736 +        goto nosideret;
1737        else if (noside == EVAL_AVOID_SIDE_EFFECTS)
1738 -       return allocate_value (builtin_type_void);
1739 +        return allocate_value (builtin_type_void);
1740        else
1741 -       error ("Attempt to use a type name as an expression");
1742 -
1743 -    case STRUCTOP_PTR:
1744 -      tem = longest_to_int (exp->elts[pc + 1].longconst);
1745 -      (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
1746 -      arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
1747 -      if (noside == EVAL_SKIP)
1748 -       goto nosideret;
1749 -      if (noside == EVAL_AVOID_SIDE_EFFECTS)
1750 -       return value_zero (ada_aligned_type
1751 -                          (ada_lookup_struct_elt_type (VALUE_TYPE (arg1),
1752 -                                                       &exp->elts[pc +
1753 -                                                                  2].string,
1754 -                                                       0, NULL)),
1755 -                          lval_memory);
1756 -      else
1757 -       return unwrap_value (ada_value_struct_elt (arg1,
1758 -                                                  &exp->elts[pc + 2].string,
1759 -                                                  "record access"));
1760 +        error ("Attempt to use a type name as an expression");
1761      }
1762
1763  nosideret:
1764 @@ -7565,11 +9373,11 @@ nosideret:
1765  }
1766  \f
1767
1768 -                               /* Fixed point */
1769 +                                /* Fixed point */
1770
1771  /* If TYPE encodes an Ada fixed-point type, return the suffix of the
1772     type name that encodes the 'small and 'delta information.
1773 -   Otherwise, return NULL. */
1774 +   Otherwise, return NULL.  */
1775
1776  static const char *
1777  fixed_type_info (struct type *type)
1778 @@ -7581,9 +9389,9 @@ fixed_type_info (struct type *type)
1779      {
1780        const char *tail = strstr (name, "___XF_");
1781        if (tail == NULL)
1782 -       return NULL;
1783 +        return NULL;
1784        else
1785 -       return tail + 5;
1786 +        return tail + 5;
1787      }
1788    else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type)
1789      return fixed_type_info (TYPE_TARGET_TYPE (type));
1790 @@ -7591,7 +9399,7 @@ fixed_type_info (struct type *type)
1791      return NULL;
1792  }
1793
1794 -/* Returns non-zero iff TYPE represents an Ada fixed-point type. */
1795 +/* Returns non-zero iff TYPE represents an Ada fixed-point type.  */
1796
1797  int
1798  ada_is_fixed_point_type (struct type *type)
1799 @@ -7599,9 +9407,18 @@ ada_is_fixed_point_type (struct type *ty
1800    return fixed_type_info (type) != NULL;
1801  }
1802
1803 +/* Return non-zero iff TYPE represents a System.Address type.  */
1804 +
1805 +int
1806 +ada_is_system_address_type (struct type *type)
1807 +{
1808 +  return (TYPE_NAME (type)
1809 +          && strcmp (TYPE_NAME (type), "system__address") == 0);
1810 +}
1811 +
1812  /* Assuming that TYPE is the representation of an Ada fixed-point
1813     type, return its delta, or -1 if the type is malformed and the
1814 -   delta cannot be determined. */
1815 +   delta cannot be determined.  */
1816
1817  DOUBLEST
1818  ada_delta (struct type *type)
1819 @@ -7616,7 +9433,7 @@ ada_delta (struct type *type)
1820  }
1821
1822  /* Assuming that ada_is_fixed_point_type (TYPE), return the scaling
1823 -   factor ('SMALL value) associated with the type. */
1824 +   factor ('SMALL value) associated with the type.  */
1825
1826  static DOUBLEST
1827  scaling_factor (struct type *type)
1828 @@ -7637,7 +9454,7 @@ scaling_factor (struct type *type)
1829
1830
1831  /* Assuming that X is the representation of a value of fixed-point
1832 -   type TYPE, return its floating-point equivalent. */
1833 +   type TYPE, return its floating-point equivalent.  */
1834
1835  DOUBLEST
1836  ada_fixed_to_float (struct type *type, LONGEST x)
1837 @@ -7645,8 +9462,8 @@ ada_fixed_to_float (struct type *type, L
1838    return (DOUBLEST) x *scaling_factor (type);
1839  }
1840
1841 -/* The representation of a fixed-point value of type TYPE
1842 -   corresponding to the value X. */
1843 +/* The representation of a fixed-point value of type TYPE
1844 +   corresponding to the value X.  */
1845
1846  LONGEST
1847  ada_float_to_fixed (struct type *type, DOUBLEST x)
1848 @@ -7655,10 +9472,11 @@ ada_float_to_fixed (struct type *type, D
1849  }
1850
1851
1852 -                               /* VAX floating formats */
1853 +                                /* VAX floating formats */
1854
1855  /* Non-zero iff TYPE represents one of the special VAX floating-point
1856 -   types. */
1857 +   types.  */
1858 +
1859  int
1860  ada_is_vax_floating_type (struct type *type)
1861  {
1862 @@ -7667,21 +9485,23 @@ ada_is_vax_floating_type (struct type *t
1863    return
1864      name_len > 6
1865      && (TYPE_CODE (type) == TYPE_CODE_INT
1866 -       || TYPE_CODE (type) == TYPE_CODE_RANGE)
1867 -    && DEPRECATED_STREQN (ada_type_name (type) + name_len - 6, "___XF", 5);
1868 +        || TYPE_CODE (type) == TYPE_CODE_RANGE)
1869 +    && strncmp (ada_type_name (type) + name_len - 6, "___XF", 5) == 0;
1870  }
1871
1872  /* The type of special VAX floating-point type this is, assuming
1873 -   ada_is_vax_floating_point */
1874 +   ada_is_vax_floating_point.  */
1875 +
1876  int
1877  ada_vax_float_type_suffix (struct type *type)
1878  {
1879    return ada_type_name (type)[strlen (ada_type_name (type)) - 1];
1880  }
1881
1882 -/* A value representing the special debugging function that outputs
1883 +/* A value representing the special debugging function that outputs
1884     VAX floating-point values of the type represented by TYPE.  Assumes
1885 -   ada_is_vax_floating_type (TYPE). */
1886 +   ada_is_vax_floating_type (TYPE).  */
1887 +
1888  struct value *
1889  ada_vax_float_print_function (struct type *type)
1890  {
1891 @@ -7699,13 +9519,13 @@ ada_vax_float_print_function (struct typ
1892  }
1893  \f
1894
1895 -                               /* Range types */
1896 +                                /* Range types */
1897
1898  /* Scan STR beginning at position K for a discriminant name, and
1899     return the value of that discriminant field of DVAL in *PX.  If
1900     PNEW_K is not null, put the position of the character beyond the
1901     name scanned in *PNEW_K.  Return 1 if successful; return 0 and do
1902 -   not alter *PX and *PNEW_K if unsuccessful. */
1903 +   not alter *PX and *PNEW_K if unsuccessful.  */
1904
1905  static int
1906  scan_discrim_bound (char *str, int k, struct value *dval, LONGEST * px,
1907 @@ -7747,47 +9567,47 @@ scan_discrim_bound (char *str, int k, st
1908
1909  /* Value of variable named NAME in the current environment.  If
1910     no such variable found, then if ERR_MSG is null, returns 0, and
1911 -   otherwise causes an error with message ERR_MSG. */
1912 +   otherwise causes an error with message ERR_MSG.  */
1913 +
1914  static struct value *
1915  get_var_value (char *name, char *err_msg)
1916  {
1917 -  struct symbol **syms;
1918 -  struct block **blocks;
1919 +  struct ada_symbol_info *syms;
1920    int nsyms;
1921
1922 -  nsyms =
1923 -    ada_lookup_symbol_list (name, get_selected_block (NULL), VAR_DOMAIN,
1924 -                           &syms, &blocks);
1925 +  nsyms = ada_lookup_symbol_list (name, get_selected_block (0), VAR_DOMAIN,
1926 +                                  &syms);
1927
1928    if (nsyms != 1)
1929      {
1930        if (err_msg == NULL)
1931 -       return 0;
1932 +        return 0;
1933        else
1934 -       error ("%s", err_msg);
1935 +        error ("%s", err_msg);
1936      }
1937
1938 -  return value_of_variable (syms[0], blocks[0]);
1939 +  return value_of_variable (syms[0].sym, syms[0].block);
1940  }
1941
1942  /* Value of integer variable named NAME in the current environment.  If
1943 -   no such variable found, then if ERR_MSG is null, returns 0, and sets
1944 -   *FLAG to 0.  If successful, sets *FLAG to 1. */
1945 +   no such variable found, returns 0, and sets *FLAG to 0.  If
1946 +   successful, sets *FLAG to 1.  */
1947 +
1948  LONGEST
1949 -get_int_var_value (char *name, char *err_msg, int *flag)
1950 +get_int_var_value (char *name, int *flag)
1951  {
1952 -  struct value *var_val = get_var_value (name, err_msg);
1953 +  struct value *var_val = get_var_value (name, 0);
1954
1955    if (var_val == 0)
1956      {
1957        if (flag != NULL)
1958 -       *flag = 0;
1959 +        *flag = 0;
1960        return 0;
1961      }
1962    else
1963      {
1964        if (flag != NULL)
1965 -       *flag = 1;
1966 +        *flag = 1;
1967        return value_as_long (var_val);
1968      }
1969  }
1970 @@ -7795,18 +9615,17 @@ get_int_var_value (char *name, char *err
1971
1972  /* Return a range type whose base type is that of the range type named
1973     NAME in the current environment, and whose bounds are calculated
1974 -   from NAME according to the GNAT range encoding conventions.
1975 +   from NAME according to the GNAT range encoding conventions.
1976     Extract discriminant values, if needed, from DVAL.  If a new type
1977     must be created, allocate in OBJFILE's space.  The bounds
1978     information, in general, is encoded in NAME, the base type given in
1979 -   the named range type. */
1980 +   the named range type.  */
1981
1982  static struct type *
1983  to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
1984  {
1985    struct type *raw_type = ada_find_any_type (name);
1986    struct type *base_type;
1987 -  LONGEST low, high;
1988    char *subtype_info;
1989
1990    if (raw_type == NULL)
1991 @@ -7838,43 +9657,56 @@ to_fixed_range_type (char *name, struct
1992        n = 1;
1993
1994        if (*subtype_info == 'L')
1995 -       {
1996 -         if (!ada_scan_number (bounds_str, n, &L, &n)
1997 -             && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
1998 -           return raw_type;
1999 -         if (bounds_str[n] == '_')
2000 -           n += 2;
2001 -         else if (bounds_str[n] == '.')        /* FIXME? SGI Workshop kludge. */
2002 -           n += 1;
2003 -         subtype_info += 1;
2004 -       }
2005 -      else
2006 -       {
2007 -         strcpy (name_buf + prefix_len, "___L");
2008 -         L = get_int_var_value (name_buf, "Index bound unknown.", NULL);
2009 -       }
2010 +        {
2011 +          if (!ada_scan_number (bounds_str, n, &L, &n)
2012 +              && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
2013 +            return raw_type;
2014 +          if (bounds_str[n] == '_')
2015 +            n += 2;
2016 +          else if (bounds_str[n] == '.')        /* FIXME? SGI Workshop kludge.  */
2017 +            n += 1;
2018 +          subtype_info += 1;
2019 +        }
2020 +      else
2021 +        {
2022 +          int ok;
2023 +          strcpy (name_buf + prefix_len, "___L");
2024 +          L = get_int_var_value (name_buf, &ok);
2025 +          if (!ok)
2026 +            {
2027 +              lim_warning ("Unknown lower bound, using 1.", 1);
2028 +              L = 1;
2029 +            }
2030 +        }
2031
2032        if (*subtype_info == 'U')
2033 -       {
2034 -         if (!ada_scan_number (bounds_str, n, &U, &n)
2035 -             && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
2036 -           return raw_type;
2037 -       }
2038 -      else
2039 -       {
2040 -         strcpy (name_buf + prefix_len, "___U");
2041 -         U = get_int_var_value (name_buf, "Index bound unknown.", NULL);
2042 -       }
2043 +        {
2044 +          if (!ada_scan_number (bounds_str, n, &U, &n)
2045 +              && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
2046 +            return raw_type;
2047 +        }
2048 +      else
2049 +        {
2050 +          int ok;
2051 +          strcpy (name_buf + prefix_len, "___U");
2052 +          U = get_int_var_value (name_buf, &ok);
2053 +          if (!ok)
2054 +            {
2055 +              lim_warning ("Unknown upper bound, using %ld.", (long) L);
2056 +              U = L;
2057 +            }
2058 +        }
2059
2060        if (objfile == NULL)
2061 -       objfile = TYPE_OBJFILE (base_type);
2062 +        objfile = TYPE_OBJFILE (base_type);
2063        type = create_range_type (alloc_type (objfile), base_type, L, U);
2064        TYPE_NAME (type) = name;
2065        return type;
2066      }
2067  }
2068
2069 -/* True iff NAME is the name of a range type. */
2070 +/* True iff NAME is the name of a range type.  */
2071 +
2072  int
2073  ada_is_range_type_name (const char *name)
2074  {
2075 @@ -7882,31 +9714,246 @@ ada_is_range_type_name (const char *name
2076  }
2077  \f
2078
2079 -                               /* Modular types */
2080 +                                /* Modular types */
2081 +
2082 +/* True iff TYPE is an Ada modular type.  */
2083
2084 -/* True iff TYPE is an Ada modular type. */
2085  int
2086  ada_is_modular_type (struct type *type)
2087  {
2088 -  /* FIXME: base_type should be declared in gdbtypes.h, implemented in
2089 -     valarith.c */
2090 -  struct type *subranged_type; /* = base_type (type); */
2091 +  struct type *subranged_type = base_type (type);
2092
2093    return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
2094 -         && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
2095 -         && TYPE_UNSIGNED (subranged_type));
2096 +          && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
2097 +          && TYPE_UNSIGNED (subranged_type));
2098  }
2099
2100 -/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
2101 +/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE.  */
2102 +
2103  LONGEST
2104  ada_modulus (struct type * type)
2105  {
2106    return TYPE_HIGH_BOUND (type) + 1;
2107  }
2108  \f
2109 +                                /* Operators */
2110 +/* Information about operators given special treatment in functions
2111 +   below.  */
2112 +/* Format: OP_DEFN (<operator>, <operator length>, <# args>, <binop>).  */
2113 +
2114 +#define ADA_OPERATORS \
2115 +    OP_DEFN (OP_VAR_VALUE, 4, 0, 0) \
2116 +    OP_DEFN (BINOP_IN_BOUNDS, 3, 2, 0) \
2117 +    OP_DEFN (TERNOP_IN_RANGE, 1, 3, 0) \
2118 +    OP_DEFN (OP_ATR_FIRST, 1, 2, 0) \
2119 +    OP_DEFN (OP_ATR_LAST, 1, 2, 0) \
2120 +    OP_DEFN (OP_ATR_LENGTH, 1, 2, 0) \
2121 +    OP_DEFN (OP_ATR_IMAGE, 1, 2, 0) \
2122 +    OP_DEFN (OP_ATR_MAX, 1, 3, 0) \
2123 +    OP_DEFN (OP_ATR_MIN, 1, 3, 0) \
2124 +    OP_DEFN (OP_ATR_MODULUS, 1, 1, 0) \
2125 +    OP_DEFN (OP_ATR_POS, 1, 2, 0) \
2126 +    OP_DEFN (OP_ATR_SIZE, 1, 1, 0) \
2127 +    OP_DEFN (OP_ATR_TAG, 1, 1, 0) \
2128 +    OP_DEFN (OP_ATR_VAL, 1, 2, 0) \
2129 +    OP_DEFN (UNOP_QUAL, 3, 1, 0) \
2130 +    OP_DEFN (UNOP_IN_RANGE, 3, 1, 0)
2131 +
2132 +static void
2133 +ada_operator_length (struct expression *exp, int pc, int *oplenp, int *argsp)
2134 +{
2135 +  switch (exp->elts[pc - 1].opcode)
2136 +    {
2137 +    default:
2138 +      operator_length_standard (exp, pc, oplenp, argsp);
2139 +      break;
2140 +
2141 +#define OP_DEFN(op, len, args, binop) \
2142 +    case op: *oplenp = len; *argsp = args; break;
2143 +      ADA_OPERATORS;
2144 +#undef OP_DEFN
2145 +    }
2146 +}
2147 +
2148 +static char *
2149 +ada_op_name (enum exp_opcode opcode)
2150 +{
2151 +  switch (opcode)
2152 +    {
2153 +    default:
2154 +      return op_name_standard (opcode);
2155 +#define OP_DEFN(op, len, args, binop) case op: return #op;
2156 +      ADA_OPERATORS;
2157 +#undef OP_DEFN
2158 +    }
2159 +}
2160 +
2161 +/* As for operator_length, but assumes PC is pointing at the first
2162 +   element of the operator, and gives meaningful results only for the
2163 +   Ada-specific operators.  */
2164 +
2165 +static void
2166 +ada_forward_operator_length (struct expression *exp, int pc,
2167 +                            int *oplenp, int *argsp)
2168 +{
2169 +  switch (exp->elts[pc].opcode)
2170 +    {
2171 +    default:
2172 +      *oplenp = *argsp = 0;
2173 +      break;
2174 +#define OP_DEFN(op, len, args, binop) \
2175 +    case op: *oplenp = len; *argsp = args; break;
2176 +      ADA_OPERATORS;
2177 +#undef OP_DEFN
2178 +    }
2179 +}
2180 +
2181 +static int
2182 +ada_dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
2183 +{
2184 +  enum exp_opcode op = exp->elts[elt].opcode;
2185 +  int oplen, nargs;
2186 +  int pc = elt;
2187 +  int i;
2188 +
2189 +  ada_forward_operator_length (exp, elt, &oplen, &nargs);
2190 +
2191 +  switch (op)
2192 +    {
2193 +    /* Ada attributes ('Foo).  */
2194 +    case OP_ATR_FIRST:
2195 +    case OP_ATR_LAST:
2196 +    case OP_ATR_LENGTH:
2197 +    case OP_ATR_IMAGE:
2198 +    case OP_ATR_MAX:
2199 +    case OP_ATR_MIN:
2200 +    case OP_ATR_MODULUS:
2201 +    case OP_ATR_POS:
2202 +    case OP_ATR_SIZE:
2203 +    case OP_ATR_TAG:
2204 +    case OP_ATR_VAL:
2205 +      break;
2206 +
2207 +    case UNOP_IN_RANGE:
2208 +    case UNOP_QUAL:
2209 +      fprintf_filtered (stream, "Type @");
2210 +      gdb_print_host_address (exp->elts[pc + 1].type, stream);
2211 +      fprintf_filtered (stream, " (");
2212 +      type_print (exp->elts[pc + 1].type, NULL, stream, 0);
2213 +      fprintf_filtered (stream, ")");
2214 +      break;
2215 +    case BINOP_IN_BOUNDS:
2216 +      fprintf_filtered (stream, " (%d)", (int) exp->elts[pc + 2].longconst);
2217 +      break;
2218 +    case TERNOP_IN_RANGE:
2219 +      break;
2220 +
2221 +    default:
2222 +      return dump_subexp_body_standard (exp, stream, elt);
2223 +    }
2224 +
2225 +  elt += oplen;
2226 +  for (i = 0; i < nargs; i += 1)
2227 +    elt = dump_subexp (exp, stream, elt);
2228 +
2229 +  return elt;
2230 +}
2231
2232 +/* The Ada extension of print_subexp (q.v.).  */
2233 +
2234 +static void
2235 +ada_print_subexp (struct expression *exp, int *pos,
2236 +                 struct ui_file *stream, enum precedence prec)
2237 +{
2238 +  int oplen, nargs;
2239 +  int pc = *pos;
2240 +  enum exp_opcode op = exp->elts[pc].opcode;
2241 +
2242 +  ada_forward_operator_length (exp, pc, &oplen, &nargs);
2243 +
2244 +  switch (op)
2245 +    {
2246 +    default:
2247 +      print_subexp_standard (exp, pos, stream, prec);
2248 +      return;
2249 +
2250 +    case OP_VAR_VALUE:
2251 +      *pos += oplen;
2252 +      fputs_filtered (SYMBOL_NATURAL_NAME (exp->elts[pc + 2].symbol), stream);
2253 +      return;
2254 +
2255 +    case BINOP_IN_BOUNDS:
2256 +      *pos += oplen;
2257 +      print_subexp (exp, pos, stream, PREC_SUFFIX);
2258 +      fputs_filtered (" in ", stream);
2259 +      print_subexp (exp, pos, stream, PREC_SUFFIX);
2260 +      fputs_filtered ("'range", stream);
2261 +      if (exp->elts[pc + 1].longconst > 1)
2262 +       fprintf_filtered (stream, "(%ld)", (long) exp->elts[pc + 1].longconst);
2263 +      return;
2264 +
2265 +    case TERNOP_IN_RANGE:
2266 +      *pos += oplen;
2267 +      if (prec >= PREC_EQUAL)
2268 +       fputs_filtered ("(", stream);
2269 +      print_subexp (exp, pos, stream, PREC_SUFFIX);
2270 +      fputs_filtered (" in ", stream);
2271 +      print_subexp (exp, pos, stream, PREC_EQUAL);
2272 +      fputs_filtered (" .. ", stream);
2273 +      print_subexp (exp, pos, stream, PREC_EQUAL);
2274 +      if (prec >= PREC_EQUAL)
2275 +       fputs_filtered (")", stream);
2276 +      return;
2277 +
2278 +    case OP_ATR_FIRST:
2279 +    case OP_ATR_LAST:
2280 +    case OP_ATR_LENGTH:
2281 +    case OP_ATR_IMAGE:
2282 +    case OP_ATR_MAX:
2283 +    case OP_ATR_MIN:
2284 +    case OP_ATR_MODULUS:
2285 +    case OP_ATR_POS:
2286 +    case OP_ATR_SIZE:
2287 +    case OP_ATR_TAG:
2288 +    case OP_ATR_VAL:
2289 +      *pos += oplen;
2290 +      if (exp->elts[*pos].opcode == OP_TYPE)
2291 +       {
2292 +         if (TYPE_CODE (exp->elts[*pos + 1].type) != TYPE_CODE_VOID)
2293 +           LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0);
2294 +         *pos += 3;
2295 +       }
2296 +      else
2297 +       print_subexp (exp, pos, stream, PREC_SUFFIX);
2298 +      fprintf_filtered (stream, "'%s", ada_attribute_name (op));
2299 +      if (nargs > 1)
2300 +       {
2301 +         int tem;
2302 +         for (tem = 1; tem < nargs; tem += 1)
2303 +           {
2304 +             fputs_filtered ( (tem == 1) ? " (" : ", ", stream);
2305 +             print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
2306 +           }
2307 +         fputs_filtered (")", stream);
2308 +       }
2309 +      return;
2310
2311 -                               /* Operators */
2312 +    case UNOP_QUAL:
2313 +      *pos += oplen;
2314 +      type_print (exp->elts[pc + 1].type, "", stream, 0);
2315 +      fputs_filtered ("'(", stream);
2316 +      print_subexp (exp, pos, stream, PREC_PREFIX);
2317 +      fputs_filtered (")", stream);
2318 +      return;
2319 +
2320 +    case UNOP_IN_RANGE:
2321 +      *pos += oplen;
2322 +      print_subexp (exp, pos, stream, PREC_SUFFIX);
2323 +      fputs_filtered (" in ", stream);
2324 +      LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0);
2325 +      return;
2326 +    }
2327 +}
2328
2329  /* Table mapping opcodes into strings for printing operators
2330     and precedences of the operators.  */
2331 @@ -7940,12 +9987,13 @@ static const struct op_print ada_op_prin
2332    {"not ", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
2333    {"not ", UNOP_COMPLEMENT, PREC_PREFIX, 0},
2334    {"abs ", UNOP_ABS, PREC_PREFIX, 0},
2335 -  {".all", UNOP_IND, PREC_SUFFIX, 1},  /* FIXME: postfix .ALL */
2336 -  {"'access", UNOP_ADDR, PREC_SUFFIX, 1},      /* FIXME: postfix 'ACCESS */
2337 +  {".all", UNOP_IND, PREC_SUFFIX, 1},
2338 +  {"'access", UNOP_ADDR, PREC_SUFFIX, 1},
2339 +  {"'size", OP_ATR_SIZE, PREC_SUFFIX, 1},
2340    {NULL, 0, 0, 0}
2341  };
2342  \f
2343 -                       /* Assorted Types and Interfaces */
2344 +                        /* Assorted Types and Interfaces */
2345
2346  struct type *builtin_type_ada_int;
2347  struct type *builtin_type_ada_short;
2348 @@ -7961,54 +10009,76 @@ struct type *builtin_type_ada_system_add
2349
2350  struct type **const (ada_builtin_types[]) =
2351  {
2352 -
2353    &builtin_type_ada_int,
2354 -    &builtin_type_ada_long,
2355 -    &builtin_type_ada_short,
2356 -    &builtin_type_ada_char,
2357 -    &builtin_type_ada_float,
2358 -    &builtin_type_ada_double,
2359 -    &builtin_type_ada_long_long,
2360 -    &builtin_type_ada_long_double,
2361 -    &builtin_type_ada_natural, &builtin_type_ada_positive,
2362 -    /* The following types are carried over from C for convenience. */
2363 -&builtin_type_int,
2364 -    &builtin_type_long,
2365 -    &builtin_type_short,
2366 -    &builtin_type_char,
2367 -    &builtin_type_float,
2368 -    &builtin_type_double,
2369 -    &builtin_type_long_long,
2370 -    &builtin_type_void,
2371 -    &builtin_type_signed_char,
2372 -    &builtin_type_unsigned_char,
2373 -    &builtin_type_unsigned_short,
2374 -    &builtin_type_unsigned_int,
2375 -    &builtin_type_unsigned_long,
2376 -    &builtin_type_unsigned_long_long,
2377 -    &builtin_type_long_double,
2378 -    &builtin_type_complex, &builtin_type_double_complex, 0};
2379 +  &builtin_type_ada_long,
2380 +  &builtin_type_ada_short,
2381 +  &builtin_type_ada_char,
2382 +  &builtin_type_ada_float,
2383 +  &builtin_type_ada_double,
2384 +  &builtin_type_ada_long_long,
2385 +  &builtin_type_ada_long_double,
2386 +  &builtin_type_ada_natural, &builtin_type_ada_positive,
2387 +  /* The following types are carried over from C for convenience.  */
2388 +  &builtin_type_int,
2389 +  &builtin_type_long,
2390 +  &builtin_type_short,
2391 +  &builtin_type_char,
2392 +  &builtin_type_float,
2393 +  &builtin_type_double,
2394 +  &builtin_type_long_long,
2395 +  &builtin_type_void,
2396 +  &builtin_type_signed_char,
2397 +  &builtin_type_unsigned_char,
2398 +  &builtin_type_unsigned_short,
2399 +  &builtin_type_unsigned_int,
2400 +  &builtin_type_unsigned_long,
2401 +  &builtin_type_unsigned_long_long,
2402 +  &builtin_type_long_double,
2403 +  &builtin_type_complex,
2404 +  &builtin_type_double_complex,
2405 +  0
2406 +};
2407 +
2408 +/* Not really used, but needed in the ada_language_defn.  */
2409
2410 -/* Not really used, but needed in the ada_language_defn. */
2411  static void
2412  emit_char (int c, struct ui_file *stream, int quoter)
2413  {
2414    ada_emit_char (c, stream, quoter, 1);
2415  }
2416
2417 +static int
2418 +parse ()
2419 +{
2420 +  warnings_issued = 0;
2421 +  return ada_parse ();
2422 +}
2423 +
2424 +static const struct exp_descriptor ada_exp_descriptor =
2425 +{
2426 +  ada_print_subexp,
2427 +  ada_operator_length,
2428 +  ada_op_name,
2429 +  ada_dump_subexp_body,
2430 +  ada_evaluate_subexp
2431 +};
2432 +
2433  const struct language_defn ada_language_defn = {
2434 -  "ada",                       /* Language name */
2435 -  /*  language_ada, */
2436 -  language_unknown,
2437 -  /* FIXME: language_ada should be defined in defs.h */
2438 +  "ada",                        /* Language name */
2439 +  language_ada,
2440    ada_builtin_types,
2441    range_check_off,
2442    type_check_off,
2443 -  case_sensitive_on,           /* Yes, Ada is case-insensitive, but
2444 -                                * that's not quite what this means. */
2445 -  ada_parse,
2446 +  case_sensitive_on,            /* Yes, Ada is case-insensitive, but
2447 +                                   that's not quite what this means.  */
2448 +#ifdef GNAT_GDB
2449 +  ada_lookup_symbol,
2450 +  ada_lookup_minimal_symbol,
2451 +#endif
2452 +  &ada_exp_descriptor,
2453 +  parse,
2454    ada_error,
2455 -  ada_evaluate_subexp,
2456 +  resolve,
2457    ada_printchar,               /* Print a character constant */
2458    ada_printstr,                        /* Function to print string constant */
2459    emit_char,                   /* Function to print single char (not used) */
2460 @@ -8017,84 +10087,97 @@ const struct language_defn ada_language_
2461    ada_val_print,               /* Print a value using appropriate syntax */
2462    ada_value_print,             /* Print a top-level value */
2463    NULL,                                /* Language specific skip_trampoline */
2464 -  value_of_this,               /* value_of_this */
2465 -  basic_lookup_symbol_nonlocal,        /* lookup_symbol_nonlocal  */
2466 +  NULL,                                /* value_of_this */
2467 +  ada_lookup_symbol_nonlocal,   /* Looking up non-local symbols.  */
2468    basic_lookup_transparent_type,/* lookup_transparent_type */
2469 -  NULL,                                /* Language specific symbol demangler */
2470 +  ada_la_decode,               /* Language specific symbol demangler */
2471    {"", "", "", ""},            /* Binary format info */
2472  #if 0
2473 -  {"8#%lo#", "8#", "o", "#"},  /* Octal format info */
2474 -  {"%ld", "", "d", ""},                /* Decimal format info */
2475 -  {"16#%lx#", "16#", "x", "#"},        /* Hex format info */
2476 +  {"8#%lo#", "8#", "o", "#"},   /* Octal format info */
2477 +  {"%ld", "", "d", ""},         /* Decimal format info */
2478 +  {"16#%lx#", "16#", "x", "#"}, /* Hex format info */
2479  #else
2480 -  /* Copied from c-lang.c. */
2481 -  {"0%lo", "0", "o", ""},      /* Octal format info */
2482 -  {"%ld", "", "d", ""},                /* Decimal format info */
2483 -  {"0x%lx", "0x", "x", ""},    /* Hex format info */
2484 +  /* Copied from c-lang.c.  */
2485 +  {"0%lo", "0", "o", ""},       /* Octal format info */
2486 +  {"%ld", "", "d", ""},         /* Decimal format info */
2487 +  {"0x%lx", "0x", "x", ""},     /* Hex format info */
2488  #endif
2489 -  ada_op_print_tab,            /* expression operators for printing */
2490 -  1,                           /* c-style arrays (FIXME?) */
2491 -  0,                           /* String lower bound (FIXME?) */
2492 +  ada_op_print_tab,             /* expression operators for printing */
2493 +  0,                            /* c-style arrays */
2494 +  1,                            /* String lower bound */
2495    &builtin_type_ada_char,
2496 -  default_word_break_characters,
2497 +  ada_get_gdb_completer_word_break_characters,
2498 +#ifdef GNAT_GDB
2499 +  ada_translate_error_message,  /* Substitute Ada-specific terminology
2500 +                                  in errors and warnings.  */
2501 +#endif
2502    LANG_MAGIC
2503  };
2504
2505 -void
2506 -_initialize_ada_language (void)
2507 -{
2508 +static void
2509 +build_ada_types (void) {
2510    builtin_type_ada_int =
2511      init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
2512 -              0, "integer", (struct objfile *) NULL);
2513 +               0, "integer", (struct objfile *) NULL);
2514    builtin_type_ada_long =
2515      init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
2516 -              0, "long_integer", (struct objfile *) NULL);
2517 +               0, "long_integer", (struct objfile *) NULL);
2518    builtin_type_ada_short =
2519      init_type (TYPE_CODE_INT, TARGET_SHORT_BIT / TARGET_CHAR_BIT,
2520 -              0, "short_integer", (struct objfile *) NULL);
2521 +               0, "short_integer", (struct objfile *) NULL);
2522    builtin_type_ada_char =
2523      init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2524 -              0, "character", (struct objfile *) NULL);
2525 +               0, "character", (struct objfile *) NULL);
2526    builtin_type_ada_float =
2527      init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
2528 -              0, "float", (struct objfile *) NULL);
2529 +               0, "float", (struct objfile *) NULL);
2530    builtin_type_ada_double =
2531      init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
2532 -              0, "long_float", (struct objfile *) NULL);
2533 +               0, "long_float", (struct objfile *) NULL);
2534    builtin_type_ada_long_long =
2535      init_type (TYPE_CODE_INT, TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
2536 -              0, "long_long_integer", (struct objfile *) NULL);
2537 +               0, "long_long_integer", (struct objfile *) NULL);
2538    builtin_type_ada_long_double =
2539      init_type (TYPE_CODE_FLT, TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
2540 -              0, "long_long_float", (struct objfile *) NULL);
2541 +               0, "long_long_float", (struct objfile *) NULL);
2542    builtin_type_ada_natural =
2543      init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
2544 -              0, "natural", (struct objfile *) NULL);
2545 +               0, "natural", (struct objfile *) NULL);
2546    builtin_type_ada_positive =
2547      init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
2548 -              0, "positive", (struct objfile *) NULL);
2549 +               0, "positive", (struct objfile *) NULL);
2550
2551
2552    builtin_type_ada_system_address =
2553      lookup_pointer_type (init_type (TYPE_CODE_VOID, 1, 0, "void",
2554 -                                   (struct objfile *) NULL));
2555 +                                    (struct objfile *) NULL));
2556    TYPE_NAME (builtin_type_ada_system_address) = "system__address";
2557 +}
2558 +
2559 +void
2560 +_initialize_ada_language (void)
2561 +{
2562
2563 +  build_ada_types ();
2564 +  deprecated_register_gdbarch_swap (NULL, 0, build_ada_types);
2565    add_language (&ada_language_defn);
2566
2567 +#ifdef GNAT_GDB
2568    add_show_from_set
2569      (add_set_cmd ("varsize-limit", class_support, var_uinteger,
2570 -                 (char *) &varsize_limit,
2571 -                 "Set maximum bytes in dynamic-sized object.",
2572 -                 &setlist), &showlist);
2573 +                  (char *) &varsize_limit,
2574 +                  "Set maximum bytes in dynamic-sized object.",
2575 +                  &setlist), &showlist);
2576 +#endif
2577    varsize_limit = 65536;
2578
2579 -  add_com ("begin", class_breakpoint, begin_command,
2580 -          "Start the debugged program, stopping at the beginning of the\n\
2581 -main program.  You may specify command-line arguments to give it, as for\n\
2582 -the \"run\" command (q.v.).");
2583 -}
2584 +  obstack_init (&symbol_list_obstack);
2585 +  obstack_init (&cache_space);
2586
2587 +  decoded_names_store = htab_create_alloc_ex
2588 +    (256, htab_hash_string, (int (*) (const void *, const void *)) streq,
2589 +     NULL, NULL, xmcalloc, xmfree);
2590 +}
2591
2592  /* Create a fundamental Ada type using default reasonable for the current
2593     target machine.
2594 @@ -8130,104 +10213,104 @@ ada_create_fundamental_type (struct objf
2595        /* FIXME:  For now, if we are asked to produce a type not in this
2596           language, create the equivalent of a C integer type with the
2597           name "<?type?>".  When all the dust settles from the type
2598 -         reconstruction work, this should probably become an error. */
2599 +         reconstruction work, this should probably become an error.  */
2600        type = init_type (TYPE_CODE_INT,
2601 -                       TARGET_INT_BIT / TARGET_CHAR_BIT,
2602 -                       0, "<?type?>", objfile);
2603 +                        TARGET_INT_BIT / TARGET_CHAR_BIT,
2604 +                        0, "<?type?>", objfile);
2605        warning ("internal error: no Ada fundamental type %d", typeid);
2606        break;
2607      case FT_VOID:
2608        type = init_type (TYPE_CODE_VOID,
2609 -                       TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2610 -                       0, "void", objfile);
2611 +                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2612 +                        0, "void", objfile);
2613        break;
2614      case FT_CHAR:
2615        type = init_type (TYPE_CODE_INT,
2616 -                       TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2617 -                       0, "character", objfile);
2618 +                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2619 +                        0, "character", objfile);
2620        break;
2621      case FT_SIGNED_CHAR:
2622        type = init_type (TYPE_CODE_INT,
2623 -                       TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2624 -                       0, "signed char", objfile);
2625 +                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2626 +                        0, "signed char", objfile);
2627        break;
2628      case FT_UNSIGNED_CHAR:
2629        type = init_type (TYPE_CODE_INT,
2630 -                       TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2631 -                       TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
2632 +                        TARGET_CHAR_BIT / TARGET_CHAR_BIT,
2633 +                        TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
2634        break;
2635      case FT_SHORT:
2636        type = init_type (TYPE_CODE_INT,
2637 -                       TARGET_SHORT_BIT / TARGET_CHAR_BIT,
2638 -                       0, "short_integer", objfile);
2639 +                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,
2640 +                        0, "short_integer", objfile);
2641        break;
2642      case FT_SIGNED_SHORT:
2643        type = init_type (TYPE_CODE_INT,
2644 -                       TARGET_SHORT_BIT / TARGET_CHAR_BIT,
2645 -                       0, "short_integer", objfile);
2646 +                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,
2647 +                        0, "short_integer", objfile);
2648        break;
2649      case FT_UNSIGNED_SHORT:
2650        type = init_type (TYPE_CODE_INT,
2651 -                       TARGET_SHORT_BIT / TARGET_CHAR_BIT,
2652 -                       TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
2653 +                        TARGET_SHORT_BIT / TARGET_CHAR_BIT,
2654 +                        TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
2655        break;
2656      case FT_INTEGER:
2657        type = init_type (TYPE_CODE_INT,
2658 -                       TARGET_INT_BIT / TARGET_CHAR_BIT,
2659 -                       0, "integer", objfile);
2660 +                        TARGET_INT_BIT / TARGET_CHAR_BIT,
2661 +                        0, "integer", objfile);
2662        break;
2663      case FT_SIGNED_INTEGER:
2664 -      type = init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 0, "integer", objfile);       /* FIXME -fnf */
2665 +      type = init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 0, "integer", objfile);        /* FIXME -fnf */
2666        break;
2667      case FT_UNSIGNED_INTEGER:
2668        type = init_type (TYPE_CODE_INT,
2669 -                       TARGET_INT_BIT / TARGET_CHAR_BIT,
2670 -                       TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
2671 +                        TARGET_INT_BIT / TARGET_CHAR_BIT,
2672 +                        TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
2673        break;
2674      case FT_LONG:
2675        type = init_type (TYPE_CODE_INT,
2676 -                       TARGET_LONG_BIT / TARGET_CHAR_BIT,
2677 -                       0, "long_integer", objfile);
2678 +                        TARGET_LONG_BIT / TARGET_CHAR_BIT,
2679 +                        0, "long_integer", objfile);
2680        break;
2681      case FT_SIGNED_LONG:
2682        type = init_type (TYPE_CODE_INT,
2683 -                       TARGET_LONG_BIT / TARGET_CHAR_BIT,
2684 -                       0, "long_integer", objfile);
2685 +                        TARGET_LONG_BIT / TARGET_CHAR_BIT,
2686 +                        0, "long_integer", objfile);
2687        break;
2688      case FT_UNSIGNED_LONG:
2689        type = init_type (TYPE_CODE_INT,
2690 -                       TARGET_LONG_BIT / TARGET_CHAR_BIT,
2691 -                       TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
2692 +                        TARGET_LONG_BIT / TARGET_CHAR_BIT,
2693 +                        TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
2694        break;
2695      case FT_LONG_LONG:
2696        type = init_type (TYPE_CODE_INT,
2697 -                       TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
2698 -                       0, "long_long_integer", objfile);
2699 +                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
2700 +                        0, "long_long_integer", objfile);
2701        break;
2702      case FT_SIGNED_LONG_LONG:
2703        type = init_type (TYPE_CODE_INT,
2704 -                       TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
2705 -                       0, "long_long_integer", objfile);
2706 +                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
2707 +                        0, "long_long_integer", objfile);
2708        break;
2709      case FT_UNSIGNED_LONG_LONG:
2710        type = init_type (TYPE_CODE_INT,
2711 -                       TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
2712 -                       TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
2713 +                        TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
2714 +                        TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
2715        break;
2716      case FT_FLOAT:
2717        type = init_type (TYPE_CODE_FLT,
2718 -                       TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
2719 -                       0, "float", objfile);
2720 +                        TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
2721 +                        0, "float", objfile);
2722        break;
2723      case FT_DBL_PREC_FLOAT:
2724        type = init_type (TYPE_CODE_FLT,
2725 -                       TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
2726 -                       0, "long_float", objfile);
2727 +                        TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
2728 +                        0, "long_float", objfile);
2729        break;
2730      case FT_EXT_PREC_FLOAT:
2731        type = init_type (TYPE_CODE_FLT,
2732 -                       TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
2733 -                       0, "long_long_float", objfile);
2734 +                        TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
2735 +                        0, "long_long_float", objfile);
2736        break;
2737      }
2738    return (type);
2739 @@ -8239,16 +10322,16 @@ ada_dump_symtab (struct symtab *s)
2740    int i;
2741    fprintf (stderr, "New symtab: [\n");
2742    fprintf (stderr, "  Name: %s/%s;\n",
2743 -          s->dirname ? s->dirname : "?", s->filename ? s->filename : "?");
2744 +           s->dirname ? s->dirname : "?", s->filename ? s->filename : "?");
2745    fprintf (stderr, "  Format: %s;\n", s->debugformat);
2746    if (s->linetable != NULL)
2747      {
2748        fprintf (stderr, "  Line table (section %d):\n", s->block_line_section);
2749        for (i = 0; i < s->linetable->nitems; i += 1)
2750 -       {
2751 -         struct linetable_entry *e = s->linetable->item + i;
2752 -         fprintf (stderr, "    %4ld: %8lx\n", (long) e->line, (long) e->pc);
2753 -       }
2754 +        {
2755 +          struct linetable_entry *e = s->linetable->item + i;
2756 +          fprintf (stderr, "    %4ld: %8lx\n", (long) e->line, (long) e->pc);
2757 +        }
2758      }
2759    fprintf (stderr, "]\n");
2760  }
2761 Index: gdb/ada-lang.h
2762 ===================================================================
2763 RCS file: /cvs/src/src/gdb/ada-lang.h,v
2764 retrieving revision 1.6
2765 diff -u -p -r1.6 ada-lang.h
2766 --- gdb/ada-lang.h      24 May 2003 03:21:42 -0000      1.6
2767 +++ gdb/ada-lang.h      2 Jun 2004 09:52:56 -0000
2768 @@ -1,5 +1,6 @@
2769  /* Ada language support definitions for GDB, the GNU debugger.
2770 -   Copyright 1992, 1997 Free Software Foundation, Inc.
2771 +   Copyright 1992, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
2772 +   Free Software Foundation, Inc.
2773
2774  This file is part of GDB.
2775
2776 @@ -24,130 +25,103 @@ struct partial_symbol;
2777
2778  #include "value.h"
2779  #include "gdbtypes.h"
2780 +#include "breakpoint.h"
2781
2782 -struct block;
2783 +/* Names of specific files known to be part of the runtime
2784 +   system and that might consider (confusing) debugging information.
2785 +   Each name (a basic regular expression string) is followed by a
2786 +   comma.  FIXME: Should be part of a configuration file. */
2787 +#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
2788 +#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
2789 +   "^[agis]-.*\\.ad[bs]$", \
2790 +   "/usr/shlib/libpthread\\.so",
2791 +#elif defined (__linux__)
2792 +#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
2793 +   "^[agis]-.*\\.ad[bs]$", \
2794 +   "/lib.*/libpthread\\.so[.0-9]*$", "/lib.*/libpthread\\.a$", \
2795 +   "/lib.*/libc\\.so[.0-9]*$", "/lib.*/libc\\.a$",
2796 +#endif
2797 +
2798 +#if !defined (ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS)
2799 +#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS \
2800 +   "^[agis]-.*\\.ad[bs]$",
2801 +#endif
2802
2803 -/* A macro to reorder the bytes of an address depending on the
2804 -   endiannes of the target.  */
2805 -#define EXTRACT_ADDRESS(x) ((void *) extract_unsigned_integer (&(x), sizeof (x)))
2806 -/* A macro to reorder the bytes of an int depending on the endiannes
2807 -   of the target */
2808 -#define EXTRACT_INT(x) ((int) extract_signed_integer (&(x), sizeof (x)))
2809 -
2810 -/* Chain of cleanups for arguments of OP_UNRESOLVED_VALUE names.  Created in
2811 -   yyparse and freed in ada_resolve. */
2812 -extern struct cleanup *unresolved_names;
2813 +/* Names of compiler-generated auxiliary functions probably of no
2814 +   interest to users. Each name (a basic regular expression string)
2815 +   is followed by a comma. */
2816 +#define ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS \
2817 +   "___clean[.a-zA-Z0-9_]*$",
2818 +
2819 +/* The maximum number of frame levels searched for non-local,
2820 + * non-global symbols.  This limit exists as a precaution to prevent
2821 + * infinite search loops when the stack is screwed up. */
2822 +#define MAX_ENCLOSING_FRAME_LEVELS 7
2823 +
2824 +/* Maximum number of steps followed in looking for the ultimate
2825 +   referent of a renaming.  This prevents certain infinite loops that
2826 +   can otherwise result. */
2827 +#define MAX_RENAMING_CHAIN_LENGTH 10
2828
2829 -/* Corresponding mangled/demangled names and opcodes for Ada user-definable
2830 +struct block;
2831 +
2832 +/* Corresponding encoded/decoded names and opcodes for Ada user-definable
2833     operators. */
2834  struct ada_opname_map
2835  {
2836 -  const char *mangled;
2837 -  const char *demangled;
2838 +  const char *encoded;
2839 +  const char *decoded;
2840    enum exp_opcode op;
2841  };
2842
2843 -/* Table of Ada operators in mangled and demangled forms. */
2844 +/* Table of Ada operators in encoded and decoded forms. */
2845  /* Defined in ada-lang.c */
2846  extern const struct ada_opname_map ada_opname_table[];
2847
2848 -/* The maximum number of tasks known to the Ada runtime */
2849 -extern const int MAX_NUMBER_OF_KNOWN_TASKS;
2850 -
2851 -/* Identifiers for Ada attributes that need special processing.  Be sure
2852 -   to update the table attribute_names in ada-lang.c whenever you change this.
2853 -   */
2854 -
2855 -enum ada_attribute
2856 -{
2857 -  /* Invalid attribute for error checking. */
2858 -  ATR_INVALID,
2859 -
2860 -  ATR_FIRST,
2861 -  ATR_LAST,
2862 -  ATR_LENGTH,
2863 -  ATR_IMAGE,
2864 -  ATR_IMG,
2865 -  ATR_MAX,
2866 -  ATR_MIN,
2867 -  ATR_MODULUS,
2868 -  ATR_POS,
2869 -  ATR_SIZE,
2870 -  ATR_TAG,
2871 -  ATR_VAL,
2872 -
2873 -  /* Dummy last attribute. */
2874 -  ATR_END
2875 -};
2876 -
2877 -enum task_states
2878 -{
2879 -  Unactivated,
2880 -  Runnable,
2881 -  Terminated,
2882 -  Activator_Sleep,
2883 -  Acceptor_Sleep,
2884 -  Entry_Caller_Sleep,
2885 -  Async_Select_Sleep,
2886 -  Delay_Sleep,
2887 -  Master_Completion_Sleep,
2888 -  Master_Phase_2_Sleep
2889 -};
2890 -
2891 -extern char *ada_task_states[];
2892 -
2893 -typedef struct
2894 -{
2895 -  char *P_ARRAY;
2896 -  int *P_BOUNDS;
2897 -}
2898 -fat_string;
2899 -
2900 -typedef struct entry_call
2901 -{
2902 -  void *self;
2903 -}
2904 - *entry_call_link;
2905 -
2906 -struct task_fields
2907 -{
2908 -  int entry_num;
2909 -#if (defined (VXWORKS_TARGET) || !defined (i386)) \
2910 -    && !(defined (VXWORKS_TARGET) && defined (M68K_TARGET))
2911 -  int pad1;
2912 -#endif
2913 -  char state;
2914 -#if (defined (VXWORKS_TARGET) && defined (M68K_TARGET))
2915 -  char pad_8bits;
2916 -#endif
2917 -  void *parent;
2918 -  int priority;
2919 -  int current_priority;
2920 -  fat_string image;
2921 -  entry_call_link call;
2922 -#if (defined (sun) && defined (__SVR4)) && !defined (VXWORKS_TARGET)
2923 -  int pad2;
2924 -  unsigned thread;
2925 -  unsigned lwp;
2926 -#else
2927 -  void *thread;
2928 -  void *lwp;
2929 -#endif
2930 -}
2931 -#if (defined (VXWORKS_TARGET) && defined (M68K_TARGET))
2932 -__attribute__ ((packed))
2933 -#endif
2934 -  ;
2935 -
2936 -struct task_entry
2937 -{
2938 -  void *task_id;
2939 -  int task_num;
2940 -  int known_tasks_index;
2941 -  struct task_entry *next_task;
2942 -  void *thread;
2943 -  void *lwp;
2944 -  int stack_per;
2945 +enum ada_operator
2946 +  {
2947 +    /* X IN A'RANGE(N).  N is an immediate operand, surrounded by
2948 +       BINOP_IN_BOUNDS before and after.  A is an array, X an index
2949 +       value.  Evaluates to true iff X is within range of the Nth
2950 +       dimension (1-based) of A.  (A multi-dimensional array
2951 +       type is represented as array of array of ...) */
2952 +    BINOP_IN_BOUNDS = OP_EXTENDED0,
2953 +
2954 +    /* X IN L .. U.  True iff L <= X <= U.  */
2955 +    TERNOP_IN_RANGE,
2956 +
2957 +    /* Ada attributes ('Foo). */
2958 +    OP_ATR_FIRST,
2959 +    OP_ATR_LAST,
2960 +    OP_ATR_LENGTH,
2961 +    OP_ATR_IMAGE,
2962 +    OP_ATR_MAX,
2963 +    OP_ATR_MIN,
2964 +    OP_ATR_MODULUS,
2965 +    OP_ATR_POS,
2966 +    OP_ATR_SIZE,
2967 +    OP_ATR_TAG,
2968 +    OP_ATR_VAL,
2969 +
2970 +    /* Ada type qualification.  It is encoded as for UNOP_CAST, above,
2971 +       and denotes the TYPE'(EXPR) construct. */
2972 +    UNOP_QUAL,
2973 +
2974 +    /* X IN TYPE.  The `TYPE' argument is immediate, with
2975 +       UNOP_IN_RANGE before and after it. True iff X is a member of
2976 +       type TYPE (typically a subrange). */
2977 +    UNOP_IN_RANGE,
2978 +
2979 +    /* End marker */
2980 +    OP_ADA_LAST
2981 +  };
2982 +
2983 +/* A triple, (symbol, block, symtab), representing one instance of a
2984 + * symbol-lookup operation. */
2985 +struct ada_symbol_info {
2986 +  struct symbol* sym;
2987 +  struct block* block;
2988 +  struct symtab* symtab;
2989  };
2990
2991  extern struct type *builtin_type_ada_int;
2992 @@ -162,33 +136,40 @@ extern struct type *builtin_type_ada_nat
2993  extern struct type *builtin_type_ada_positive;
2994  extern struct type *builtin_type_ada_system_address;
2995
2996 -/* Assuming V points to an array of S objects,  make sure that it contains at
2997 +/* The maximum number of tasks known to the Ada runtime */
2998 +extern const int MAX_NUMBER_OF_KNOWN_TASKS;
2999 +
3000 +/* Assuming V points to an array of S objects,  make sure that it contains at
3001     least M objects, updating V and S as necessary. */
3002
3003 -#define GROW_VECT(v, s, m)                                             \
3004 +#define GROW_VECT(v, s, m)                                              \
3005     if ((s) < (m)) grow_vect ((void**) &(v), &(s), (m), sizeof(*(v)));
3006
3007  extern void grow_vect (void **, size_t *, size_t, int);
3008
3009 -extern int ada_parse (void);   /* Defined in ada-exp.y */
3010 +extern int ada_get_field_index (const struct type *type,
3011 +                                const char *field_name,
3012 +                                int maybe_missing);
3013 +
3014 +extern int ada_parse (void);    /* Defined in ada-exp.y */
3015
3016 -extern void ada_error (char *);        /* Defined in ada-exp.y */
3017 +extern void ada_error (char *); /* Defined in ada-exp.y */
3018
3019 -                       /* Defined in ada-typeprint.c */
3020 +                        /* Defined in ada-typeprint.c */
3021  extern void ada_print_type (struct type *, char *, struct ui_file *, int,
3022 -                           int);
3023 +                            int);
3024
3025  extern int ada_val_print (struct type *, char *, int, CORE_ADDR,
3026 -                         struct ui_file *, int, int, int,
3027 -                         enum val_prettyprint);
3028 +                          struct ui_file *, int, int, int,
3029 +                          enum val_prettyprint);
3030
3031  extern int ada_value_print (struct value *, struct ui_file *, int,
3032 -                           enum val_prettyprint);
3033 +                            enum val_prettyprint);
3034
3035 -                               /* Defined in ada-lang.c */
3036 +                                /* Defined in ada-lang.c */
3037
3038  extern struct value *value_from_contents_and_address (struct type *, char *,
3039 -                                                     CORE_ADDR);
3040 +                                                      CORE_ADDR);
3041
3042  extern void ada_emit_char (int, struct ui_file *, int, int);
3043
3044 @@ -197,10 +178,10 @@ extern void ada_printchar (int, struct u
3045  extern void ada_printstr (struct ui_file *, char *, unsigned int, int, int);
3046
3047  extern void ada_convert_actuals (struct value *, int, struct value **,
3048 -                                CORE_ADDR *);
3049 +                                 CORE_ADDR *);
3050
3051  extern struct value *ada_value_subscript (struct value *, int,
3052 -                                         struct value **);
3053 +                                          struct value **);
3054
3055  extern struct type *ada_array_element_type (struct type *, int);
3056
3057 @@ -208,13 +189,11 @@ extern int ada_array_arity (struct type
3058
3059  struct type *ada_type_of_array (struct value *, int);
3060
3061 -extern struct value *ada_coerce_to_simple_array (struct value *);
3062 -
3063  extern struct value *ada_coerce_to_simple_array_ptr (struct value *);
3064
3065 -extern int ada_is_simple_array (struct type *);
3066 +extern int ada_is_simple_array_type (struct type *);
3067
3068 -extern int ada_is_array_descriptor (struct type *);
3069 +extern int ada_is_array_descriptor_type (struct type *);
3070
3071  extern int ada_is_bogus_array_descriptor (struct type *);
3072
3073 @@ -222,34 +201,43 @@ extern struct type *ada_index_type (stru
3074
3075  extern struct value *ada_array_bound (struct value *, int, int);
3076
3077 -extern int ada_lookup_symbol_list (const char *, struct block *,
3078 -                                  domain_enum, struct symbol ***,
3079 -                                  struct block ***);
3080 +extern char *ada_decode_symbol (const struct general_symbol_info*);
3081
3082 -extern char *ada_fold_name (const char *);
3083 +extern const char *ada_decode (const char*);
3084 +
3085 +extern enum language ada_update_initial_language (enum language,
3086 +                                                 struct partial_symtab*);
3087
3088 -extern struct symbol *ada_lookup_symbol (const char *, struct block *,
3089 -                                        domain_enum);
3090 +extern void clear_ada_sym_cache (void);
3091
3092 -extern struct minimal_symbol *ada_lookup_minimal_symbol (const char *);
3093 +extern char **ada_make_symbol_completion_list (const char *text0,
3094 +                                               const char *word);
3095
3096 -extern void ada_resolve (struct expression **, struct type *);
3097 +extern int ada_lookup_symbol_list (const char *, const struct block *,
3098 +                                   domain_enum, struct ada_symbol_info**);
3099 +
3100 +extern char *ada_fold_name (const char *);
3101
3102 -extern int ada_resolve_function (struct symbol **, struct block **, int,
3103 -                                struct value **, int, const char *,
3104 -                                struct type *);
3105 +extern struct symbol *ada_lookup_symbol (const char *, const struct block *,
3106 +                                         domain_enum, int *,
3107 +                                        struct symtab **);
3108 +
3109 +extern struct minimal_symbol *ada_lookup_simple_minsym (const char *);
3110
3111  extern void ada_fill_in_ada_prototype (struct symbol *);
3112
3113 -extern int user_select_syms (struct symbol **, struct block **, int, int);
3114 +extern int user_select_syms (struct ada_symbol_info *, int, int);
3115
3116  extern int get_selections (int *, int, int, int, char *);
3117
3118  extern char *ada_start_decode_line_1 (char *);
3119
3120  extern struct symtabs_and_lines ada_finish_decode_line_1 (char **,
3121 -                                                         struct symtab *,
3122 -                                                         int, char ***);
3123 +                                                          struct symtab *,
3124 +                                                          int, char ***);
3125 +
3126 +extern struct symtabs_and_lines ada_sals_for_line (const char*, int,
3127 +                                                  int, char***, int);
3128
3129  extern int ada_scan_number (const char *, int, LONGEST *, int *);
3130
3131 @@ -260,8 +248,8 @@ extern int ada_is_ignored_field (struct
3132  extern int ada_is_packed_array_type (struct type *);
3133
3134  extern struct value *ada_value_primitive_packed_val (struct value *, char *,
3135 -                                                    long, int, int,
3136 -                                                    struct type *);
3137 +                                                     long, int, int,
3138 +                                                     struct type *);
3139
3140  extern struct type *ada_coerce_to_simple_array_type (struct type *);
3141
3142 @@ -269,12 +257,16 @@ extern int ada_is_character_type (struct
3143
3144  extern int ada_is_string_type (struct type *);
3145
3146 -extern int ada_is_tagged_type (struct type *);
3147 +extern int ada_is_tagged_type (struct type *, int);
3148 +
3149 +extern int ada_is_tag_type (struct type *);
3150
3151  extern struct type *ada_tag_type (struct value *);
3152
3153  extern struct value *ada_value_tag (struct value *);
3154
3155 +extern const char *ada_tag_name (struct value *);
3156 +
3157  extern int ada_is_parent_field (struct type *, int);
3158
3159  extern int ada_is_wrapper_field (struct type *, int);
3160 @@ -289,24 +281,20 @@ extern int ada_in_variant (LONGEST, stru
3161
3162  extern char *ada_variant_discrim_name (struct type *);
3163
3164 -extern struct type *ada_lookup_struct_elt_type (struct type *, char *, int,
3165 -                                               int *);
3166 -
3167  extern struct value *ada_value_struct_elt (struct value *, char *, char *);
3168
3169 -extern struct value *ada_search_struct_field (char *, struct value *, int,
3170 -                                             struct type *);
3171 -
3172  extern int ada_is_aligner_type (struct type *);
3173
3174  extern struct type *ada_aligned_type (struct type *);
3175
3176  extern char *ada_aligned_value_addr (struct type *, char *);
3177
3178 -extern const char *ada_attribute_name (int);
3179 +extern const char *ada_attribute_name (enum exp_opcode);
3180
3181  extern int ada_is_fixed_point_type (struct type *);
3182
3183 +extern int ada_is_system_address_type (struct type *);
3184 +
3185  extern DOUBLEST ada_delta (struct type *);
3186
3187  extern DOUBLEST ada_fixed_to_float (struct type *, LONGEST);
3188 @@ -323,30 +311,37 @@ extern struct type *ada_system_address_t
3189
3190  extern int ada_which_variant_applies (struct type *, struct type *, char *);
3191
3192 -extern struct value *ada_to_fixed_value (struct type *, char *, CORE_ADDR,
3193 -                                        struct value *);
3194 -
3195  extern struct type *ada_to_fixed_type (struct type *, char *, CORE_ADDR,
3196 -                                      struct value *);
3197 +                                       struct value *);
3198 +
3199 +extern struct type *
3200 +  ada_template_to_fixed_record_type_1 (struct type *type, char *valaddr,
3201 +                                       CORE_ADDR address, struct value *dval0,
3202 +                                       int keep_dynamic_fields);
3203
3204  extern int ada_name_prefix_len (const char *);
3205
3206  extern char *ada_type_name (struct type *);
3207
3208  extern struct type *ada_find_parallel_type (struct type *,
3209 -                                           const char *suffix);
3210 +                                            const char *suffix);
3211 +
3212 +extern LONGEST get_int_var_value (char *, int *);
3213
3214 -extern LONGEST get_int_var_value (char *, char *, int *);
3215 +extern struct symbol *ada_find_any_symbol (const char *name);
3216
3217  extern struct type *ada_find_any_type (const char *name);
3218
3219 +extern struct symbol *ada_find_renaming_symbol (const char *name,
3220 +                                                struct block *block);
3221 +
3222  extern int ada_prefer_type (struct type *, struct type *);
3223
3224  extern struct type *ada_get_base_type (struct type *);
3225
3226  extern struct type *ada_completed_type (struct type *);
3227
3228 -extern char *ada_mangle (const char *);
3229 +extern char *ada_encode (const char *);
3230
3231  extern const char *ada_enum_name (const char *);
3232
3233 @@ -364,29 +359,38 @@ extern const char *ada_renaming_type (st
3234
3235  extern int ada_is_object_renaming (struct symbol *);
3236
3237 -extern const char *ada_simple_renamed_entity (struct symbol *);
3238 +extern char *ada_simple_renamed_entity (struct symbol *);
3239
3240  extern char *ada_breakpoint_rewrite (char *, int *);
3241
3242 +extern char *ada_main_name (void);
3243 +
3244  /* Tasking-related: ada-tasks.c */
3245
3246  extern int valid_task_id (int);
3247
3248 -extern int get_current_task (void);
3249 -
3250  extern void init_task_list (void);
3251
3252 -extern void *get_self_id (void);
3253 +extern int ada_is_exception_breakpoint (bpstat bs);
3254 +
3255 +extern void ada_adjust_exception_stop (bpstat bs);
3256
3257 -extern int get_current_task (void);
3258 +extern void ada_print_exception_stop (bpstat bs);
3259
3260 -extern int get_entry_number (void *);
3261 +extern int ada_get_current_task (ptid_t);
3262
3263 -extern void ada_report_exception_break (struct breakpoint *);
3264 +extern int breakpoint_ada_task_match (CORE_ADDR, ptid_t);
3265 +
3266 +extern int ada_print_exception_breakpoint_nontask (struct breakpoint *);
3267 +
3268 +extern void ada_print_exception_breakpoint_task (struct breakpoint *);
3269
3270  extern int ada_maybe_exception_partial_symbol (struct partial_symbol *sym);
3271
3272  extern int ada_is_exception_sym (struct symbol *sym);
3273
3274 +extern void ada_find_printable_frame (struct frame_info *fi);
3275 +
3276 +extern void ada_reset_thread_registers (void);
3277
3278  #endif
3279