gdb/f-lang.h

   1 /* Fortran language support definitions for GDB, the GNU debugger.
   2
   3    Copyright (C) 1992-2023 Free Software Foundation, Inc.
   4
   5    Contributed by Motorola.  Adapted from the C definitions by Farooq Butt
   6    (fmbutt@engage.sps.mot.com).
   7
   8    This file is part of GDB.
   9
  10    This program is free software; you can redistribute it and/or modify
  11    it under the terms of the GNU General Public License as published by
  12    the Free Software Foundation; either version 3 of the License, or
  13    (at your option) any later version.
  14
  15    This program is distributed in the hope that it will be useful,
  16    but WITHOUT ANY WARRANTY; without even the implied warranty of
  17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18    GNU General Public License for more details.
  19
  20    You should have received a copy of the GNU General Public License
  21    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  22
  23 #ifndef F_LANG_H
  24 #define F_LANG_H
  25
  26 #include "valprint.h"
  27
  28 struct type_print_options;
  29 struct parser_state;
  30
  31 /* Class representing the Fortran language.  */
  32
  33 class f_language : public language_defn
  34 {
  35 public:
  36   f_language ()
  37     : language_defn (language_fortran)
  38   { /* Nothing.  */ }
  39
  40   /* See language.h.  */
  41
  42   const char *name () const override
  43   { return "fortran"; }
  44
  45   /* See language.h.  */
  46
  47   const char *natural_name () const override
  48   { return "Fortran"; }
  49
  50   /* See language.h.  */
  51
  52   const std::vector<const char *> &filename_extensions () const override
  53   {
  54     static const std::vector<const char *> extensions = {
  55       ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
  56       ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08"
  57     };
  58     return extensions;
  59   }
  60
  61   /* See language.h.  */
  62   void print_array_index (struct type *index_type,
  63                           LONGEST index,
  64                           struct ui_file *stream,
  65                           const value_print_options *options) const override;
  66
  67   /* See language.h.  */
  68   void language_arch_info (struct gdbarch *gdbarch,
  69                            struct language_arch_info *lai) const override;
  70
  71   /* See language.h.  */
  72   unsigned int search_name_hash (const char *name) const override;
  73
  74   /* See language.h.  */
  75
  76   gdb::unique_xmalloc_ptr<char> demangle_symbol (const char *mangled,
  77                                                  int options) const override
  78   {
  79       /* We could support demangling here to provide module namespaces
  80          also for inferiors with only minimal symbol table (ELF symbols).
  81          Just the mangling standard is not standardized across compilers
  82          and there is no DW_AT_producer available for inferiors with only
  83          the ELF symbols to check the mangling kind.  */
  84     return nullptr;
  85   }
  86
  87   /* See language.h.  */
  88
  89   void print_type (struct type *type, const char *varstring,
  90                    struct ui_file *stream, int show, int level,
  91                    const struct type_print_options *flags) const override;
  92
  93   /* See language.h.  This just returns default set of word break
  94      characters but with the modules separator `::' removed.  */
  95
  96   const char *word_break_characters (void) const override
  97   {
  98     static char *retval;
  99
 100     if (!retval)
 101       {
 102         char *s;
 103
 104         retval = xstrdup (language_defn::word_break_characters ());
 105         s = strchr (retval, ':');
 106         if (s)
 107           {
 108             char *last_char = &s[strlen (s) - 1];
 109
 110             *s = *last_char;
 111             *last_char = 0;
 112           }
 113       }
 114     return retval;
 115   }
 116
 117
 118   /* See language.h.  */
 119
 120   void collect_symbol_completion_matches (completion_tracker &tracker,
 121                                           complete_symbol_mode mode,
 122                                           symbol_name_match_type name_match_type,
 123                                           const char *text, const char *word,
 124                                           enum type_code code) const override
 125   {
 126     /* Consider the modules separator :: as a valid symbol name character
 127        class.  */
 128     default_collect_symbol_completion_matches_break_on (tracker, mode,
 129                                                         name_match_type,
 130                                                         text, word, ":",
 131                                                         code);
 132   }
 133
 134   /* See language.h.  */
 135
 136   void value_print_inner
 137         (struct value *val, struct ui_file *stream, int recurse,
 138          const struct value_print_options *options) const override;
 139
 140   /* See language.h.  */
 141
 142   struct block_symbol lookup_symbol_nonlocal
 143         (const char *name, const struct block *block,
 144          const domain_enum domain) const override;
 145
 146   /* See language.h.  */
 147
 148   int parser (struct parser_state *ps) const override;
 149
 150   /* See language.h.  */
 151
 152   void emitchar (int ch, struct type *chtype,
 153                  struct ui_file *stream, int quoter) const override
 154   {
 155     const char *encoding = get_encoding (chtype);
 156     generic_emit_char (ch, chtype, stream, quoter, encoding);
 157   }
 158
 159   /* See language.h.  */
 160
 161   void printchar (int ch, struct type *chtype,
 162                   struct ui_file *stream) const override
 163   {
 164     gdb_puts ("'", stream);
 165     emitchar (ch, chtype, stream, '\'');
 166     gdb_puts ("'", stream);
 167   }
 168
 169   /* See language.h.  */
 170
 171   void printstr (struct ui_file *stream, struct type *elttype,
 172                  const gdb_byte *string, unsigned int length,
 173                  const char *encoding, int force_ellipses,
 174                  const struct value_print_options *options) const override
 175   {
 176     const char *type_encoding = get_encoding (elttype);
 177
 178     if (elttype->length () == 4)
 179       gdb_puts ("4_", stream);
 180
 181     if (!encoding || !*encoding)
 182       encoding = type_encoding;
 183
 184     generic_printstr (stream, elttype, string, length, encoding,
 185                       force_ellipses, '\'', 0, options);
 186   }
 187
 188   /* See language.h.  */
 189
 190   void print_typedef (struct type *type, struct symbol *new_symbol,
 191                       struct ui_file *stream) const override;
 192
 193   /* See language.h.  */
 194
 195   bool is_string_type_p (struct type *type) const override
 196   {
 197     type = check_typedef (type);
 198     return (type->code () == TYPE_CODE_STRING
 199             || (type->code () == TYPE_CODE_ARRAY
 200                 && type->target_type ()->code () == TYPE_CODE_CHAR));
 201   }
 202
 203   /* See language.h.  */
 204
 205   const char *struct_too_deep_ellipsis () const override
 206   { return "(...)"; }
 207
 208   /* See language.h.  */
 209
 210   bool c_style_arrays_p () const override
 211   { return false; }
 212
 213   /* See language.h.  */
 214
 215   bool range_checking_on_by_default () const override
 216   { return true; }
 217
 218   /* See language.h.  */
 219
 220   enum case_sensitivity case_sensitivity () const override
 221   { return case_sensitive_off; }
 222
 223   /* See language.h.  */
 224
 225   enum array_ordering array_ordering () const override
 226   { return array_column_major; }
 227
 228 protected:
 229
 230   /* See language.h.  */
 231
 232   symbol_name_matcher_ftype *get_symbol_name_matcher_inner
 233         (const lookup_name_info &lookup_name) const override;
 234
 235 private:
 236   /* Return the encoding that should be used for the character type
 237      TYPE.  */
 238
 239   static const char *get_encoding (struct type *type);
 240
 241   /* Print any asterisks or open-parentheses needed before the variable
 242      name (to describe its type).
 243
 244      On outermost call, pass 0 for PASSED_A_PTR.
 245      On outermost call, SHOW > 0 means should ignore
 246      any typename for TYPE and show its details.
 247      SHOW is always zero on recursive calls.  */
 248
 249   void f_type_print_varspec_prefix (struct type *type,
 250                                     struct ui_file * stream,
 251                                     int show, int passed_a_ptr) const;
 252
 253   /* Print any array sizes, function arguments or close parentheses needed
 254      after the variable name (to describe its type).  Args work like
 255      c_type_print_varspec_prefix.
 256
 257      PRINT_RANK_ONLY is true when TYPE is an array which should be printed
 258      without the upper and lower bounds being specified, this will occur
 259      when the array is not allocated or not associated and so there are no
 260      known upper or lower bounds.  */
 261
 262   void f_type_print_varspec_suffix (struct type *type,
 263                                     struct ui_file *stream,
 264                                     int show, int passed_a_ptr,
 265                                     int demangled_args,
 266                                     int arrayprint_recurse_level,
 267                                     bool print_rank_only) const;
 268
 269   /* If TYPE is an extended type, then print out derivation information.
 270
 271      A typical output could look like this:
 272      "Type, extends(point) :: waypoint"
 273      "    Type point :: point"
 274      "    real(kind=4) :: angle"
 275      "End Type waypoint".  */
 276
 277   void f_type_print_derivation_info (struct type *type,
 278                                      struct ui_file *stream) const;
 279
 280   /* Print the name of the type (or the ultimate pointer target, function
 281      value or array element), or the description of a structure or union.
 282
 283      SHOW nonzero means don't print this type as just its name;
 284      show its real definition even if it has a name.
 285      SHOW zero means print just typename or struct tag if there is one
 286      SHOW negative means abbreviate structure elements.
 287      SHOW is decremented for printing of structure elements.
 288
 289      LEVEL is the depth to indent by.  We increase it for some recursive
 290      calls.  */
 291
 292   void f_type_print_base (struct type *type, struct ui_file *stream, int show,
 293                           int level) const;
 294 };
 295
 296 /* Language-specific data structures */
 297
 298 /* A common block.  */
 299
 300 struct common_block
 301 {
 302   /* The number of entries in the block.  */
 303   size_t n_entries;
 304
 305   /* The contents of the block, allocated using the struct hack.  All
 306      pointers in the array are non-NULL.  */
 307   struct symbol *contents[1];
 308 };
 309
 310 extern LONGEST f77_get_upperbound (struct type *);
 311
 312 extern LONGEST f77_get_lowerbound (struct type *);
 313
 314 extern int calc_f77_array_dims (struct type *);
 315
 316 /* Fortran (F77) types */
 317
 318 struct builtin_f_type
 319 {
 320   struct type *builtin_character = nullptr;
 321   struct type *builtin_integer_s1 = nullptr;
 322   struct type *builtin_integer_s2 = nullptr;
 323   struct type *builtin_integer = nullptr;
 324   struct type *builtin_integer_s8 = nullptr;
 325   struct type *builtin_logical_s1 = nullptr;
 326   struct type *builtin_logical_s2 = nullptr;
 327   struct type *builtin_logical = nullptr;
 328   struct type *builtin_logical_s8 = nullptr;
 329   struct type *builtin_real = nullptr;
 330   struct type *builtin_real_s8 = nullptr;
 331   struct type *builtin_real_s16 = nullptr;
 332   struct type *builtin_complex = nullptr;
 333   struct type *builtin_complex_s8 = nullptr;
 334   struct type *builtin_complex_s16 = nullptr;
 335   struct type *builtin_void = nullptr;
 336 };
 337
 338 /* Return the Fortran type table for the specified architecture.  */
 339 extern const struct builtin_f_type *builtin_f_type (struct gdbarch *gdbarch);
 340
 341 /* Ensures that function argument TYPE is appropriate to inform the debugger
 342    that ARG should be passed as a pointer.  Returns the potentially updated
 343    argument type.
 344
 345    If ARG is of type pointer then the type of ARG is returned, otherwise
 346    TYPE is returned untouched.
 347
 348    This function exists to augment the types of Fortran function call
 349    parameters to be pointers to the reported value, when the corresponding ARG
 350    has also been wrapped in a pointer (by fortran_argument_convert).  This
 351    informs the debugger that these arguments should be passed as a pointer
 352    rather than as the pointed to type.  */
 353
 354 extern struct type *fortran_preserve_arg_pointer (struct value *arg,
 355                                                   struct type *type);
 356
 357 /* Fortran arrays can have a negative stride.  When this happens it is
 358    often the case that the base address for an object is not the lowest
 359    address occupied by that object.  For example, an array slice (10:1:-1)
 360    will be encoded with lower bound 1, upper bound 10, a stride of
 361    -ELEMENT_SIZE, and have a base address pointer that points at the
 362    element with the highest address in memory.
 363
 364    This really doesn't play well with our current model of value contents,
 365    but could easily require a significant update in order to be supported
 366    "correctly".
 367
 368    For now, we manually force the base address to be the lowest addressed
 369    element here.  Yes, this will break some things, but it fixes other
 370    things.  The hope is that it fixes more than it breaks.  */
 371
 372 extern CORE_ADDR fortran_adjust_dynamic_array_base_address_hack
 373         (struct type *type, CORE_ADDR address);
 374
 375 #endif /* F_LANG_H */