gdb/f-lang.h

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