2004-09-14 Andrew Cagney <cagney@gnu.org>
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index 2d9aa35814c46b8f78df46a9305594ff718eea26..51c5fb7ed1e5ef6a0a3b4a2ebe3252a6fedb4dda 100644 (file)
@@ -623,30 +623,51 @@ ada_translate_error_message (const char *string)
     return string;
 }
 
+/* Note: would have used MAX_OF_TYPE and MIN_OF_TYPE macros from
+   gdbtypes.h, but some of the necessary definitions in that file
+   seem to have gone missing. */
+
+/* Maximum value of a SIZE-byte signed integer type. */
 static LONGEST
-MAX_OF_SIZE (int size)
+max_of_size (int size)
 {
   LONGEST top_bit = (LONGEST) 1 << (size * 8 - 2);
   return top_bit | (top_bit - 1);
 }
 
+/* Minimum value of a SIZE-byte signed integer type. */
 static LONGEST
-MIN_OF_SIZE (int size)
+min_of_size (int size)
 {
-  return -MAX_OF_SIZE (size) - 1;
+  return -max_of_size (size) - 1;
 }
 
+/* Maximum value of a SIZE-byte unsigned integer type. */
 static ULONGEST
-UMAX_OF_SIZE (int size)
+umax_of_size (int size)
 {
   ULONGEST top_bit = (ULONGEST) 1 << (size * 8 - 1);
   return top_bit | (top_bit - 1);
 }
 
-static ULONGEST
-UMIN_OF_SIZE (int size)
+/* Maximum value of integral type T, as a signed quantity. */
+static LONGEST
+max_of_type (struct type *t)
 {
-  return 0;
+  if (TYPE_UNSIGNED (t))
+    return (LONGEST) umax_of_size (TYPE_LENGTH (t));
+  else
+    return max_of_size (TYPE_LENGTH (t));
+}
+
+/* Minimum value of integral type T, as a signed quantity. */
+static LONGEST
+min_of_type (struct type *t)
+{
+  if (TYPE_UNSIGNED (t)) 
+    return 0;
+  else
+    return min_of_size (TYPE_LENGTH (t));
 }
 
 /* The largest value in the domain of TYPE, a discrete type, as an integer.  */
@@ -664,7 +685,7 @@ discrete_type_high_bound (struct type *type)
                             TYPE_FIELD_BITPOS (type,
                                                TYPE_NFIELDS (type) - 1));
     case TYPE_CODE_INT:
-      return value_from_longest (type, MAX_OF_TYPE (type));
+      return value_from_longest (type, max_of_type (type));
     default:
       error ("Unexpected type in discrete_type_high_bound.");
     }
@@ -682,7 +703,7 @@ discrete_type_low_bound (struct type *type)
     case TYPE_CODE_ENUM:
       return value_from_longest (type, TYPE_FIELD_BITPOS (type, 0));
     case TYPE_CODE_INT:
-      return value_from_longest (type, MIN_OF_TYPE (type));
+      return value_from_longest (type, min_of_type (type));
     default:
       error ("Unexpected type in discrete_type_low_bound.");
     }
@@ -2170,6 +2191,37 @@ ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
   return value_ind (arr);
 }
 
+/* Given that ARRAY_PTR is a pointer or reference to an array of type TYPE (the
+   actual type of ARRAY_PTR is ignored), returns a reference to
+   the Ada slice of HIGH-LOW+1 elements starting at index LOW.  The lower
+   bound of this array is LOW, as per Ada rules. */
+static struct value *
+ada_value_slice_ptr (struct value *array_ptr, struct type *type, 
+                     int low, int high)
+{
+  CORE_ADDR base = value_as_address (array_ptr) 
+    + ((low - TYPE_LOW_BOUND (TYPE_INDEX_TYPE (type)))
+       * TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
+  struct type *index_type = 
+    create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type)), 
+                       low, high);
+  struct type *slice_type = 
+    create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
+  return value_from_pointer (lookup_reference_type (slice_type), base);
+}
+
+
+static struct value *
+ada_value_slice (struct value *array, int low, int high)
+{
+  struct type *type = VALUE_TYPE (array);
+  struct type *index_type = 
+    create_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
+  struct type *slice_type = 
+    create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
+  return value_cast (slice_type, value_slice (array, low, high-low+1));
+}
+
 /* If type is a record type in the form of a standard GNAT array
    descriptor, returns the number of dimensions for type.  If arr is a
    simple array, returns the number of "array of"s that prefix its
@@ -2400,8 +2452,11 @@ ada_array_length (struct value *arr, int n)
 static struct value *
 empty_array (struct type *arr_type, int low)
 {
-  return allocate_value (create_range_type (NULL, TYPE_INDEX_TYPE (arr_type),
-                                            low, low - 1));
+  struct type *index_type = 
+    create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type)),
+                       low, low - 1);
+  struct type *elt_type = ada_array_element_type (arr_type, 1);
+  return allocate_value (create_array_type (NULL, elt_type, index_type));
 }
 \f
 
@@ -3410,8 +3465,8 @@ possible_user_operator_p (enum exp_opcode op, struct value *args[])
               || TYPE_CODE (TYPE_TARGET_TYPE (type0)) != TYPE_CODE_ARRAY))
          || (TYPE_CODE (type1) != TYPE_CODE_ARRAY
              && (TYPE_CODE (type1) != TYPE_CODE_PTR
-                 || (TYPE_CODE (TYPE_TARGET_TYPE (type1)) !=
-                     TYPE_CODE_ARRAY))));
+                 || (TYPE_CODE (TYPE_TARGET_TYPE (type1)) 
+                    != TYPE_CODE_ARRAY))));
 
     case BINOP_EXP:
       return (!(numeric_type_p (type0) && integer_type_p (type1)));
@@ -3501,24 +3556,36 @@ ada_simple_renamed_entity (struct symbol *sym)
 static struct value *
 ensure_lval (struct value *val, CORE_ADDR *sp)
 {
-  CORE_ADDR old_sp = *sp;
-
-  if (VALUE_LVAL (val))
-    return val;
-
-  if (DEPRECATED_STACK_ALIGN_P ())
-    *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
-                      DEPRECATED_STACK_ALIGN
-                      (TYPE_LENGTH (check_typedef (VALUE_TYPE (val)))));
-  else
-    *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
-                      TYPE_LENGTH (check_typedef (VALUE_TYPE (val))));
+  if (! VALUE_LVAL (val))
+    {
+      int len = TYPE_LENGTH (check_typedef (VALUE_TYPE (val)));
+
+      /* The following is taken from the structure-return code in
+        call_function_by_hand. FIXME: Therefore, some refactoring seems 
+        indicated. */
+      if (INNER_THAN (1, 2))
+       {
+         /* Stack grows downward.  Align SP and VALUE_ADDRESS (val) after
+            reserving sufficient space. */
+         *sp -= len;
+         if (gdbarch_frame_align_p (current_gdbarch))
+           *sp = gdbarch_frame_align (current_gdbarch, *sp);
+         VALUE_ADDRESS (val) = *sp;
+       }
+      else
+       {
+         /* Stack grows upward.  Align the frame, allocate space, and
+            then again, re-align the frame. */
+         if (gdbarch_frame_align_p (current_gdbarch))
+           *sp = gdbarch_frame_align (current_gdbarch, *sp);
+         VALUE_ADDRESS (val) = *sp;
+         *sp += len;
+         if (gdbarch_frame_align_p (current_gdbarch))
+           *sp = gdbarch_frame_align (current_gdbarch, *sp);
+       }
 
-  VALUE_LVAL (val) = lval_memory;
-  if (INNER_THAN (1, 2))
-    VALUE_ADDRESS (val) = *sp;
-  else
-    VALUE_ADDRESS (val) = old_sp;
+      write_memory (VALUE_ADDRESS (val), VALUE_CONTENTS_RAW (val), len);
+    }
 
   return val;
 }
@@ -5586,7 +5653,9 @@ ada_finish_decode_line_1 (char **spec, struct symtab *file_table,
           val.section = SYMBOL_BFD_SECTION (msymbol);
           if (funfirstline)
             {
-              val.pc += DEPRECATED_FUNCTION_START_OFFSET;
+              val.pc = gdbarch_convert_from_func_ptr_addr (current_gdbarch,
+                                                          val.pc,
+                                                          &current_target);
               SKIP_PROLOGUE (val.pc);
             }
           selected.sals = (struct symtab_and_line *)
@@ -6701,8 +6770,8 @@ ada_is_variant_part (struct type *type, int field_num)
   struct type *field_type = TYPE_FIELD_TYPE (type, field_num);
   return (TYPE_CODE (field_type) == TYPE_CODE_UNION
           || (is_dynamic_field (type, field_num)
-              && TYPE_CODE (TYPE_TARGET_TYPE (field_type)) ==
-              TYPE_CODE_UNION));
+              && (TYPE_CODE (TYPE_TARGET_TYPE (field_type)) 
+                 == TYPE_CODE_UNION)));
 }
 
 /* Assuming that VAR_TYPE is a variant wrapper (type of the variant part)
@@ -8430,7 +8499,8 @@ ada_enum_name (const char *name)
      but stop searching when we hit an overloading suffix, which is
      of the form "__" followed by digits.  */
 
-  if ((tmp = strrchr (name, '.')) != NULL)
+  tmp = strrchr (name, '.');
+  if (tmp != NULL)
     name = tmp + 1;
   else
     {
@@ -8466,8 +8536,10 @@ ada_enum_name (const char *name)
     }
   else
     {
-      if ((tmp = strstr (name, "__")) != NULL
-          || (tmp = strstr (name, "$")) != NULL)
+      tmp = strstr (name, "__");
+      if (tmp == NULL)
+       tmp = strstr (name, "$");
+      if (tmp != NULL)
         {
           GROW_VECT (result, result_len, tmp - name + 1);
           strncpy (result, name, tmp - name);
@@ -8922,11 +8994,6 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           {
             int arity;
 
-            /* Make sure to use the parallel ___XVS type if any.
-               Otherwise, we won't be able to find the array arity
-               and element type.  */
-            type = ada_get_base_type (type);
-
             arity = ada_array_arity (type);
             type = ada_array_element_type (type, nargs);
             if (type == NULL)
@@ -8981,14 +9048,6 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         if (noside == EVAL_SKIP)
           goto nosideret;
 
-        /* If this is a reference type or a pointer type, and
-           the target type has an XVS parallel type, then get
-           the real target type.  */
-        if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
-            || TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR)
-          TYPE_TARGET_TYPE (VALUE_TYPE (array)) =
-            ada_get_base_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)));
-
         /* If this is a reference to an aligner type, then remove all
            the aligners.  */
         if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
@@ -9007,26 +9066,15 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
           array = value_addr (array);
 
         if (noside == EVAL_AVOID_SIDE_EFFECTS
-            && ada_is_array_descriptor_type
-            (check_typedef (VALUE_TYPE (array))))
-          {
-            /* Try dereferencing the array, in case it is an access
-               to array.  */
-            struct type *arrType = ada_type_of_array (array, 0);
-            if (arrType != NULL)
-              array = value_at_lazy (arrType, 0, NULL);
-          }
+            && ada_is_array_descriptor_type (check_typedef 
+                                            (VALUE_TYPE (array))))
+          return empty_array (ada_type_of_array (array, 0), low_bound);
 
         array = ada_coerce_to_simple_array_ptr (array);
 
-        /* When EVAL_AVOID_SIDE_EFFECTS, we may get the bounds wrong,
-           but only in contexts where the value is not being requested
-           (FIXME?).  */
         if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR)
           {
-            if (noside == EVAL_AVOID_SIDE_EFFECTS)
-              return ada_value_ind (array);
-            else if (high_bound < low_bound)
+            if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
               return empty_array (TYPE_TARGET_TYPE (VALUE_TYPE (array)),
                                   low_bound);
             else
@@ -9034,15 +9082,8 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
                 struct type *arr_type0 =
                   to_fixed_array_type (TYPE_TARGET_TYPE (VALUE_TYPE (array)),
                                        NULL, 1);
-                struct value *item0 =
-                  ada_value_ptr_subscript (array, arr_type0, 1,
-                                           &low_bound_val);
-                struct value *slice =
-                  value_repeat (item0, high_bound - low_bound + 1);
-                struct type *arr_type1 = VALUE_TYPE (slice);
-                TYPE_LOW_BOUND (TYPE_INDEX_TYPE (arr_type1)) = low_bound;
-                TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (arr_type1)) += low_bound;
-                return slice;
+                return ada_value_slice_ptr (array, arr_type0,
+                                            (int) low_bound, (int) high_bound);
               }
           }
         else if (noside == EVAL_AVOID_SIDE_EFFECTS)
@@ -9050,7 +9091,7 @@ ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
         else if (high_bound < low_bound)
           return empty_array (VALUE_TYPE (array), low_bound);
         else
-          return value_slice (array, low_bound, high_bound - low_bound + 1);
+          return ada_value_slice (array, (int) low_bound, (int) high_bound);
       }
 
     case UNOP_IN_RANGE:
@@ -10125,6 +10166,7 @@ const struct language_defn ada_language_defn = {
   ada_lookup_symbol,
   ada_lookup_minimal_symbol,
 #endif /* GNAT_GDB */
+  array_row_major,
   &ada_exp_descriptor,
   parse,
   ada_error,
@@ -10141,17 +10183,7 @@ const struct language_defn ada_language_defn = {
   ada_lookup_symbol_nonlocal,   /* Looking up non-local symbols.  */
   basic_lookup_transparent_type,        /* lookup_transparent_type */
   ada_la_decode,                /* Language specific symbol demangler */
-  {"", "", "", ""},             /* Binary format info */
-#if 0
-  {"8#%lo#", "8#", "o", "#"},   /* Octal format info */
-  {"%ld", "", "d", ""},         /* Decimal format info */
-  {"16#%lx#", "16#", "x", "#"}, /* Hex format info */
-#else
-  /* Copied from c-lang.c.  */
-  {"0%lo", "0", "o", ""},       /* Octal format info */
-  {"%ld", "", "d", ""},         /* Decimal format info */
-  {"0x%lx", "0x", "x", ""},     /* Hex format info */
-#endif
+  NULL,                         /* Language specific class_name_from_physname */
   ada_op_print_tab,             /* expression operators for printing */
   0,                            /* c-style arrays */
   1,                            /* String lower bound */
@@ -10165,7 +10197,7 @@ const struct language_defn ada_language_defn = {
 };
 
 static void
-build_ada_types (void)
+build_ada_types (struct gdbarch *current_gdbarch)
 {
   builtin_type_ada_int =
     init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
@@ -10209,25 +10241,25 @@ void
 _initialize_ada_language (void)
 {
 
-  build_ada_types ();
-  deprecated_register_gdbarch_swap (NULL, 0, build_ada_types);
+  build_ada_types (current_gdbarch);
+  gdbarch_data_register_post_init (build_ada_types);
   add_language (&ada_language_defn);
 
   varsize_limit = 65536;
 #ifdef GNAT_GDB
-  add_show_from_set
-    (add_set_cmd ("varsize-limit", class_support, var_uinteger,
-                  (char *) &varsize_limit,
-                  "Set maximum bytes in dynamic-sized object.",
-                  &setlist), &showlist);
+  add_setshow_uinteger_cmd ("varsize-limit", class_support,
+                           &varsize_limit, "\
+Set the maximum number of bytes allowed in a dynamic-sized object.", "\
+Show the maximum number of bytes allowed in a dynamic-sized object.",
+                           NULL, NULL, &setlist, &showlist);
   obstack_init (&cache_space);
 #endif /* GNAT_GDB */
 
   obstack_init (&symbol_list_obstack);
 
-  decoded_names_store = htab_create_alloc_ex
+  decoded_names_store = htab_create_alloc
     (256, htab_hash_string, (int (*)(const void *, const void *)) streq,
-     NULL, NULL, xmcalloc, xmfree);
+     NULL, xcalloc, xfree);
 }
 
 /* Create a fundamental Ada type using default reasonable for the current
This page took 0.029615 seconds and 4 git commands to generate.