*** empty log message ***

[deliverable/binutils-gdb.git] / gdb / f-valprint.c

diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index a777edd0ae17a60aa26f148ddb7154de8acb9593..26aa83b31bad7b470814d81a6d3b7a713ae0d316 100644 (file)
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -99,10 +99,11 @@ f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
       current_frame_addr = get_frame_base (frame);
       if (current_frame_addr > 0)
        {
+         struct gdbarch *arch = get_frame_arch (frame);
          ptr_to_lower_bound =
            read_memory_typed_address (current_frame_addr +
                                       TYPE_ARRAY_LOWER_BOUND_VALUE (type),
-                                      builtin_type_void_data_ptr);
+                                      builtin_type (arch)->builtin_data_ptr);
          *lower_bound = read_memory_integer (ptr_to_lower_bound, 4);
        }
       else
@@ -165,10 +166,11 @@ f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
       current_frame_addr = get_frame_base (frame);
       if (current_frame_addr > 0)
        {
+         struct gdbarch *arch = get_frame_arch (frame);
          ptr_to_upper_bound =
            read_memory_typed_address (current_frame_addr +
                                       TYPE_ARRAY_UPPER_BOUND_VALUE (type),
-                                      builtin_type_void_data_ptr);
+                                      builtin_type (arch)->builtin_data_ptr);
          *upper_bound = read_memory_integer (ptr_to_upper_bound, 4);
        }
       else
@@ -308,7 +310,8 @@ f77_print_array_1 (int nss, int ndimensions, struct type *type,
                     valaddr + i * F77_DIM_OFFSET (ndimensions),
                     0,
                     address + i * F77_DIM_OFFSET (ndimensions),
-                    stream, format, deref_ref, recurse, pretty);
+                    stream, format, deref_ref, recurse, pretty,
+                    current_language);
 
          if (i != (F77_DIM_SIZE (nss) - 1))
            fprintf_filtered (stream, ", ");
@@ -407,7 +410,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
            }
 
          if (addressprint && format != 's')
-           deprecated_print_address_numeric (addr, 1, stream);
+           fputs_filtered (paddress (addr), stream);
 
          /* For a pointer to char or unsigned char, also print the string
             pointed to, unless pointer is null.  */
@@ -431,7 +434,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
          CORE_ADDR addr
            = extract_typed_address (valaddr + embedded_offset, type);
          fprintf_filtered (stream, "@");
-         deprecated_print_address_numeric (addr, 1, stream);
+         fputs_filtered (paddress (addr), stream);
          if (deref_ref)
            fputs_filtered (": ", stream);
        }
@@ -443,10 +446,9 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
              struct value *deref_val =
              value_at
              (TYPE_TARGET_TYPE (type),
-              unpack_pointer (lookup_pointer_type (builtin_type_void),
-                              valaddr + embedded_offset));
+              unpack_pointer (type, valaddr + embedded_offset));
              common_val_print (deref_val, stream, format, deref_ref, recurse,
-                               pretty);
+                               pretty, current_language);
            }
          else
            fputs_filtered ("???", stream);
@@ -521,26 +523,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
        print_scalar_formatted (valaddr, type, format, 0, stream);
       else
        {
-         val = 0;
-         switch (TYPE_LENGTH (type))
-           {
-           case 1:
-             val = unpack_long (builtin_type_f_logical_s1, valaddr);
-             break;
-
-           case 2:
-             val = unpack_long (builtin_type_f_logical_s2, valaddr);
-             break;
-
-           case 4:
-             val = unpack_long (builtin_type_f_logical, valaddr);
-             break;
-
-           default:
-             error (_("Logicals of length %d bytes not supported"),
-                    TYPE_LENGTH (type));
-
-           }
+         val = extract_unsigned_integer (valaddr, TYPE_LENGTH (type));
 
          if (val == 0)
            fprintf_filtered (stream, ".FALSE.");
@@ -560,20 +543,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
       break;
 
     case TYPE_CODE_COMPLEX:
-      switch (TYPE_LENGTH (type))
-       {
-       case 8:
-         type = builtin_type_f_real;
-         break;
-       case 16:
-         type = builtin_type_f_real_s8;
-         break;
-       case 32:
-         type = builtin_type_f_real_s16;
-         break;
-       default:
-         error (_("Cannot print out complex*%d variables"), TYPE_LENGTH (type));
-       }
+      type = TYPE_TARGET_TYPE (type);
       fputs_filtered ("(", stream);
       print_floating (valaddr, type, stream);
       fputs_filtered (",", stream);
@@ -589,9 +559,10 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
       break;
 
     case TYPE_CODE_STRUCT:
+    case TYPE_CODE_UNION:
       /* Starting from the Fortran 90 standard, Fortran supports derived
          types.  */
-      fprintf_filtered (stream, "{ ");
+      fprintf_filtered (stream, "( ");
       for (index = 0; index < TYPE_NFIELDS (type); index++)
         {
           int offset = TYPE_FIELD_BITPOS (type, index) / 8;
@@ -601,7 +572,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
           if (index != TYPE_NFIELDS (type) - 1)
             fputs_filtered (", ", stream);
         }
-      fprintf_filtered (stream, "}");
+      fprintf_filtered (stream, " )");
       break;     
 
     default:
@@ -675,9 +646,9 @@ info_common_command (char *comname, int from_tty)
       if (msymbol != NULL
          && (SYMBOL_VALUE_ADDRESS (msymbol)
              > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
-       funname = DEPRECATED_SYMBOL_NAME (msymbol);
+       funname = SYMBOL_LINKAGE_NAME (msymbol);
       else
-       funname = DEPRECATED_SYMBOL_NAME (func);
+       funname = SYMBOL_LINKAGE_NAME (func);
     }
   else
     {
@@ -685,7 +656,7 @@ info_common_command (char *comname, int from_tty)
       lookup_minimal_symbol_by_pc (get_frame_pc (fi));
 
       if (msymbol != NULL)
-       funname = DEPRECATED_SYMBOL_NAME (msymbol);
+       funname = SYMBOL_LINKAGE_NAME (msymbol);
       else /* Got no 'funname', code below will fail.  */
        error (_("No function found for frame."));
     }
@@ -713,7 +684,7 @@ info_common_command (char *comname, int from_tty)
 
       while (entry != NULL)
        {
-         printf_filtered ("%s = ", DEPRECATED_SYMBOL_NAME (entry->symbol));
+         printf_filtered ("%s = ", SYMBOL_PRINT_NAME (entry->symbol));
          print_variable_value (entry->symbol, fi, gdb_stdout);
          printf_filtered ("\n");
          entry = entry->next;
@@ -766,9 +737,9 @@ there_is_a_visible_common_named (char *comname)
       if (msymbol != NULL
          && (SYMBOL_VALUE_ADDRESS (msymbol)
              > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
-       funname = DEPRECATED_SYMBOL_NAME (msymbol);
+       funname = SYMBOL_LINKAGE_NAME (msymbol);
       else
-       funname = DEPRECATED_SYMBOL_NAME (func);
+       funname = SYMBOL_LINKAGE_NAME (func);
     }
   else
     {
@@ -776,7 +747,7 @@ there_is_a_visible_common_named (char *comname)
       lookup_minimal_symbol_by_pc (fi->pc);
 
       if (msymbol != NULL)
-       funname = DEPRECATED_SYMBOL_NAME (msymbol);
+       funname = SYMBOL_LINKAGE_NAME (msymbol);
     }
 
   the_common = find_common_for_function (comname, funname);