* archures.c: Update copyright.
[deliverable/binutils-gdb.git] / gdb / ada-lang.c
index 198ef62c72041844a86c901cda072cc35e50a8a3..7880645fc4dc4873a433715b39dc358f93ebf603 100644 (file)
@@ -1875,7 +1875,8 @@ decode_packed_array (struct value *arr)
       return NULL;
     }
 
-  if (BITS_BIG_ENDIAN && ada_is_modular_type (value_type (arr)))
+  if (gdbarch_bits_big_endian (current_gdbarch)
+      && ada_is_modular_type (value_type (arr)))
     {
        /* This is a (right-justified) modular type representing a packed
         array with no wrapper.  In order to interpret the value through
@@ -1998,7 +1999,7 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
   int len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
   /* Transmit bytes from least to most significant; delta is the direction
      the indices move.  */
-  int delta = BITS_BIG_ENDIAN ? -1 : 1;
+  int delta = gdbarch_bits_big_endian (current_gdbarch) ? -1 : 1;
 
   type = ada_check_typedef (type);
 
@@ -2047,7 +2048,7 @@ ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
       memset (unpacked, 0, TYPE_LENGTH (type));
       return v;
     }
-  else if (BITS_BIG_ENDIAN)
+  else if (gdbarch_bits_big_endian (current_gdbarch))
     {
       src = len - 1;
       if (has_negatives (type)
@@ -2141,7 +2142,7 @@ move_bits (gdb_byte *target, int targ_offset, const gdb_byte *source,
   targ_offset %= HOST_CHAR_BIT;
   source += src_offset / HOST_CHAR_BIT;
   src_offset %= HOST_CHAR_BIT;
-  if (BITS_BIG_ENDIAN)
+  if (gdbarch_bits_big_endian (current_gdbarch))
     {
       accum = (unsigned char) *source;
       source += 1;
@@ -2229,7 +2230,7 @@ ada_value_assign (struct value *toval, struct value *fromval)
         fromval = value_cast (type, fromval);
 
       read_memory (to_addr, buffer, len);
-      if (BITS_BIG_ENDIAN)
+      if (gdbarch_bits_big_endian (current_gdbarch))
         move_bits (buffer, value_bitpos (toval),
                    value_contents (fromval),
                    TYPE_LENGTH (value_type (fromval)) * TARGET_CHAR_BIT -
@@ -2276,7 +2277,7 @@ value_assign_to_component (struct value *container, struct value *component,
   else
     bits = value_bitsize (component);
 
-  if (BITS_BIG_ENDIAN)
+  if (gdbarch_bits_big_endian (current_gdbarch))
     move_bits (value_contents_writeable (container) + offset_in_container, 
               value_bitpos (container) + bit_offset_in_container,
               value_contents (val),
@@ -3822,6 +3823,7 @@ ensure_lval (struct value *val, CORE_ADDR *sp)
          if (gdbarch_frame_align_p (current_gdbarch))
            *sp = gdbarch_frame_align (current_gdbarch, *sp);
        }
+      VALUE_LVAL (val) = lval_memory;
 
       write_memory (VALUE_ADDRESS (val), value_contents_raw (val), len);
     }
@@ -3834,9 +3836,9 @@ ensure_lval (struct value *val, CORE_ADDR *sp)
    allocating any necessary descriptors (fat pointers), or copies of
    values not residing in memory, updating it as needed.  */
 
-static struct value *
-convert_actual (struct value *actual, struct type *formal_type0,
-                CORE_ADDR *sp)
+struct value *
+ada_convert_actual (struct value *actual, struct type *formal_type0,
+                    CORE_ADDR *sp)
 {
   struct type *actual_type = ada_check_typedef (value_type (actual));
   struct type *formal_type = ada_check_typedef (formal_type0);
@@ -3850,11 +3852,13 @@ convert_actual (struct value *actual, struct type *formal_type0,
   if (ada_is_array_descriptor_type (formal_target)
       && TYPE_CODE (actual_target) == TYPE_CODE_ARRAY)
     return make_array_descriptor (formal_type, actual, sp);
-  else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR)
+  else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR
+          || TYPE_CODE (formal_type) == TYPE_CODE_REF)
     {
+      struct value *result;
       if (TYPE_CODE (formal_target) == TYPE_CODE_ARRAY
           && ada_is_array_descriptor_type (actual_target))
-        return desc_data (actual);
+       result = desc_data (actual);
       else if (TYPE_CODE (actual_type) != TYPE_CODE_PTR)
         {
           if (VALUE_LVAL (actual) != lval_memory)
@@ -3867,8 +3871,11 @@ convert_actual (struct value *actual, struct type *formal_type0,
                       TYPE_LENGTH (actual_type));
               actual = ensure_lval (val, sp);
             }
-          return value_addr (actual);
+          result = value_addr (actual);
         }
+      else
+       return actual;
+      return value_cast_pointers (formal_type, result);
     }
   else if (TYPE_CODE (actual_type) == TYPE_CODE_PTR)
     return ada_value_ind (actual);
@@ -3923,30 +3930,6 @@ make_array_descriptor (struct type *type, struct value *arr, CORE_ADDR *sp)
   else
     return descriptor;
 }
-
-
-/* Assuming a dummy frame has been established on the target, perform any
-   conversions needed for calling function FUNC on the NARGS actual
-   parameters in ARGS, other than standard C conversions.  Does
-   nothing if FUNC does not have Ada-style prototype data, or if NARGS
-   does not match the number of arguments expected.  Use *SP as a
-   stack pointer for additional data that must be pushed, updating its
-   value as needed.  */
-
-void
-ada_convert_actuals (struct value *func, int nargs, struct value *args[],
-                     CORE_ADDR *sp)
-{
-  int i;
-
-  if (TYPE_NFIELDS (value_type (func)) == 0
-      || nargs != TYPE_NFIELDS (value_type (func)))
-    return;
-
-  for (i = 0; i < nargs; i += 1)
-    args[i] =
-      convert_actual (args[i], TYPE_FIELD_TYPE (value_type (func), i), sp);
-}
 \f
 /* Dummy definitions for an experimental caching module that is not
  * used in the public sources. */
@@ -4934,12 +4917,14 @@ ada_lookup_symbol_nonlocal (const char *name,
    names (e.g., XVE) are not included here.  Currently, the possible suffixes
    are given by either of the regular expression:
 
-   (__[0-9]+)?[.$][0-9]+  [nested subprogram suffix, on platforms such 
-                           as GNU/Linux]
-   ___[0-9]+            [nested subprogram suffix, on platforms such as HP/UX]
-   _E[0-9]+[bs]$          [protected object entry suffixes]
+   [.$][0-9]+       [nested subprogram suffix, on platforms such as GNU/Linux]
+   ___[0-9]+        [nested subprogram suffix, on platforms such as HP/UX]
+   _E[0-9]+[bs]$    [protected object entry suffixes]
    (X[nb]*)?((\$|__)[0-9](_?[0-9]+)|___(JM|LJM|X([FDBUP].*|R[^T]?)))?$
- */
+
+   Also, any leading "__[0-9]+" sequence is skipped before the suffix
+   match is performed.  This sequence is used to differentiate homonyms,
+   is an optional part of a valid name suffix.  */
 
 static int
 is_name_suffix (const char *str)
@@ -4948,20 +4933,20 @@ is_name_suffix (const char *str)
   const char *matching;
   const int len = strlen (str);
 
-  /* (__[0-9]+)?\.[0-9]+ */
-  matching = str;
+  /* Skip optional leading __[0-9]+.  */
+
   if (len > 3 && str[0] == '_' && str[1] == '_' && isdigit (str[2]))
     {
-      matching += 3;
-      while (isdigit (matching[0]))
-        matching += 1;
-      if (matching[0] == '\0')
-        return 1;
+      str += 3;
+      while (isdigit (str[0]))
+        str += 1;
     }
+  
+  /* [.$][0-9]+ */
 
-  if (matching[0] == '.' || matching[0] == '$')
+  if (str[0] == '.' || str[0] == '$')
     {
-      matching += 1;
+      matching = str + 1;
       while (isdigit (matching[0]))
         matching += 1;
       if (matching[0] == '\0')
@@ -4969,6 +4954,7 @@ is_name_suffix (const char *str)
     }
 
   /* ___[0-9]+ */
+
   if (len > 3 && str[0] == '_' && str[1] == '_' && str[2] == '_')
     {
       matching = str + 3;
@@ -5021,8 +5007,10 @@ is_name_suffix (const char *str)
           str += 1;
         }
     }
+
   if (str[0] == '\000')
     return 1;
+
   if (str[0] == '_')
     {
       if (str[1] != '_' || str[2] == '\000')
@@ -6279,17 +6267,16 @@ ada_which_variant_applies (struct type *var_type, struct type *outer_type,
 {
   int others_clause;
   int i;
-  int disp;
-  struct type *discrim_type;
   char *discrim_name = ada_variant_discrim_name (var_type);
+  struct value *outer;
+  struct value *discrim;
   LONGEST discrim_val;
 
-  disp = 0;
-  discrim_type =
-    ada_lookup_struct_elt_type (outer_type, discrim_name, 1, 1, &disp);
-  if (discrim_type == NULL)
+  outer = value_from_contents_and_address (outer_type, outer_valaddr, 0);
+  discrim = ada_value_struct_elt (outer, discrim_name, 1);
+  if (discrim == NULL)
     return -1;
-  discrim_val = unpack_long (discrim_type, outer_valaddr + disp);
+  discrim_val = value_as_long (discrim);
 
   others_clause = -1;
   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
This page took 0.028562 seconds and 4 git commands to generate.