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

/* Fortran language support routines for GDB, the GNU debugger.

   Copyright (C) 1993-2017 Free Software Foundation, Inc.

   Contributed by Motorola.  Adapted from the C parser by Farooq Butt
   (fmbutt@engage.sps.mot.com).

   This file is part of GDB.

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */

#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "parser-defs.h"
#include "language.h"
#include "varobj.h"
#include "f-lang.h"
#include "valprint.h"
#include "value.h"
#include "cp-support.h"
#include "charset.h"
#include "c-lang.h"


/* Local functions */

extern void _initialize_f_language (void);

static void f_printchar (int c, struct type *type, struct ui_file * stream);
static void f_emit_char (int c, struct type *type,
			 struct ui_file * stream, int quoter);

/* Return the encoding that should be used for the character type
   TYPE.  */

static const char *
f_get_encoding (struct type *type)
{
  const char *encoding;

  switch (TYPE_LENGTH (type))
    {
    case 1:
      encoding = target_charset (get_type_arch (type));
      break;
    case 4:
      if (gdbarch_byte_order (get_type_arch (type)) == BFD_ENDIAN_BIG)
	encoding = "UTF-32BE";
      else
	encoding = "UTF-32LE";
      break;

    default:
      error (_("unrecognized character type"));
    }

  return encoding;
}

/* Print the character C on STREAM as part of the contents of a literal
   string whose delimiter is QUOTER.  Note that that format for printing
   characters and strings is language specific.
   FIXME:  This is a copy of the same function from c-exp.y.  It should
   be replaced with a true F77 version.  */

static void
f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
{
  const char *encoding = f_get_encoding (type);

  generic_emit_char (c, type, stream, quoter, encoding);
}

/* Implementation of la_printchar.  */

static void
f_printchar (int c, struct type *type, struct ui_file *stream)
{
  fputs_filtered ("'", stream);
  LA_EMIT_CHAR (c, type, stream, '\'');
  fputs_filtered ("'", stream);
}

/* Print the character string STRING, printing at most LENGTH characters.
   Printing stops early if the number hits print_max; repeat counts
   are printed as appropriate.  Print ellipses at the end if we
   had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
   FIXME:  This is a copy of the same function from c-exp.y.  It should
   be replaced with a true F77 version.  */

static void
f_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
	    unsigned int length, const char *encoding, int force_ellipses,
	    const struct value_print_options *options)
{
  const char *type_encoding = f_get_encoding (type);

  if (TYPE_LENGTH (type) == 4)
    fputs_filtered ("4_", stream);

  if (!encoding || !*encoding)
    encoding = type_encoding;

  generic_printstr (stream, type, string, length, encoding,
		    force_ellipses, '\'', 0, options);
}
\f

/* Table of operators and their precedences for printing expressions.  */

static const struct op_print f_op_print_tab[] =
{
  {"+", BINOP_ADD, PREC_ADD, 0},
  {"+", UNOP_PLUS, PREC_PREFIX, 0},
  {"-", BINOP_SUB, PREC_ADD, 0},
  {"-", UNOP_NEG, PREC_PREFIX, 0},
  {"*", BINOP_MUL, PREC_MUL, 0},
  {"/", BINOP_DIV, PREC_MUL, 0},
  {"DIV", BINOP_INTDIV, PREC_MUL, 0},
  {"MOD", BINOP_REM, PREC_MUL, 0},
  {"=", BINOP_ASSIGN, PREC_ASSIGN, 1},
  {".OR.", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
  {".AND.", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
  {".NOT.", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
  {".EQ.", BINOP_EQUAL, PREC_EQUAL, 0},
  {".NE.", BINOP_NOTEQUAL, PREC_EQUAL, 0},
  {".LE.", BINOP_LEQ, PREC_ORDER, 0},
  {".GE.", BINOP_GEQ, PREC_ORDER, 0},
  {".GT.", BINOP_GTR, PREC_ORDER, 0},
  {".LT.", BINOP_LESS, PREC_ORDER, 0},
  {"**", UNOP_IND, PREC_PREFIX, 0},
  {"@", BINOP_REPEAT, PREC_REPEAT, 0},
  {NULL, OP_NULL, PREC_REPEAT, 0}
};
\f
enum f_primitive_types {
  f_primitive_type_character,
  f_primitive_type_logical,
  f_primitive_type_logical_s1,
  f_primitive_type_logical_s2,
  f_primitive_type_logical_s8,
  f_primitive_type_integer,
  f_primitive_type_integer_s2,
  f_primitive_type_real,
  f_primitive_type_real_s8,
  f_primitive_type_real_s16,
  f_primitive_type_complex_s8,
  f_primitive_type_complex_s16,
  f_primitive_type_void,
  nr_f_primitive_types
};

static void
f_language_arch_info (struct gdbarch *gdbarch,
		      struct language_arch_info *lai)
{
  const struct builtin_f_type *builtin = builtin_f_type (gdbarch);

  lai->string_char_type = builtin->builtin_character;
  lai->primitive_type_vector
    = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_f_primitive_types + 1,
                              struct type *);

  lai->primitive_type_vector [f_primitive_type_character]
    = builtin->builtin_character;
  lai->primitive_type_vector [f_primitive_type_logical]
    = builtin->builtin_logical;
  lai->primitive_type_vector [f_primitive_type_logical_s1]
    = builtin->builtin_logical_s1;
  lai->primitive_type_vector [f_primitive_type_logical_s2]
    = builtin->builtin_logical_s2;
  lai->primitive_type_vector [f_primitive_type_logical_s8]
    = builtin->builtin_logical_s8;
  lai->primitive_type_vector [f_primitive_type_real]
    = builtin->builtin_real;
  lai->primitive_type_vector [f_primitive_type_real_s8]
    = builtin->builtin_real_s8;
  lai->primitive_type_vector [f_primitive_type_real_s16]
    = builtin->builtin_real_s16;
  lai->primitive_type_vector [f_primitive_type_complex_s8]
    = builtin->builtin_complex_s8;
  lai->primitive_type_vector [f_primitive_type_complex_s16]
    = builtin->builtin_complex_s16;
  lai->primitive_type_vector [f_primitive_type_void]
    = builtin->builtin_void;

  lai->bool_type_symbol = "logical";
  lai->bool_type_default = builtin->builtin_logical_s2;
}

/* Remove the modules separator :: from the default break list.  */

static const char *
f_word_break_characters (void)
{
  static char *retval;

  if (!retval)
    {
      char *s;

      retval = xstrdup (default_word_break_characters ());
      s = strchr (retval, ':');
      if (s)
	{
	  char *last_char = &s[strlen (s) - 1];

	  *s = *last_char;
	  *last_char = 0;
	}
    }
  return retval;
}

/* Consider the modules separator :: as a valid symbol name character
   class.  */

static void
f_collect_symbol_completion_matches (completion_tracker &tracker,
				     const char *text, const char *word,
				     enum type_code code)
{
  default_collect_symbol_completion_matches_break_on (tracker,
						      text, word, ":", code);
}

static const char *f_extensions[] =
{
  ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
  ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08",
  NULL
};

const struct language_defn f_language_defn =
{
  "fortran",
  "Fortran",
  language_fortran,
  range_check_on,
  case_sensitive_off,
  array_column_major,
  macro_expansion_no,
  f_extensions,
  &exp_descriptor_standard,
  f_parse,			/* parser */
  f_yyerror,			/* parser error function */
  null_post_parser,
  f_printchar,			/* Print character constant */
  f_printstr,			/* function to print string constant */
  f_emit_char,			/* Function to print a single character */
  f_print_type,			/* Print a type using appropriate syntax */
  default_print_typedef,	/* Print a typedef using appropriate syntax */
  f_val_print,			/* Print a value using appropriate syntax */
  c_value_print,		/* FIXME */
  default_read_var_value,	/* la_read_var_value */
  NULL,				/* Language specific skip_trampoline */
  NULL,                    	/* name_of_this */
  cp_lookup_symbol_nonlocal,	/* lookup_symbol_nonlocal */
  basic_lookup_transparent_type,/* lookup_transparent_type */

  /* We could support demangling here to provide module namespaces
     also for inferiors with only minimal symbol table (ELF symbols).
     Just the mangling standard is not standardized across compilers
     and there is no DW_AT_producer available for inferiors with only
     the ELF symbols to check the mangling kind.  */
  NULL,				/* Language specific symbol demangler */
  NULL,
  NULL,				/* Language specific
				   class_name_from_physname */
  f_op_print_tab,		/* expression operators for printing */
  0,				/* arrays are first-class (not c-style) */
  1,				/* String lower bound */
  f_word_break_characters,
  f_collect_symbol_completion_matches,
  f_language_arch_info,
  default_print_array_index,
  default_pass_by_reference,
  default_get_string,
  c_watch_location_expression,
  NULL,				/* la_get_symbol_name_cmp */
  iterate_over_symbols,
  &default_varobj_ops,
  NULL,
  NULL,
  LANG_MAGIC
};

static void *
build_fortran_types (struct gdbarch *gdbarch)
{
  struct builtin_f_type *builtin_f_type
    = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);

  builtin_f_type->builtin_void
    = arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");

  builtin_f_type->builtin_character
    = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");

  builtin_f_type->builtin_logical_s1
    = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");

  builtin_f_type->builtin_integer_s2
    = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
			 "integer*2");

  builtin_f_type->builtin_logical_s2
    = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
			 "logical*2");

  builtin_f_type->builtin_logical_s8
    = arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
			 "logical*8");

  builtin_f_type->builtin_integer
    = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
			 "integer");

  builtin_f_type->builtin_logical
    = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
			 "logical*4");

  builtin_f_type->builtin_real
    = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
		       "real", gdbarch_float_format (gdbarch));
  builtin_f_type->builtin_real_s8
    = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
		       "real*8", gdbarch_double_format (gdbarch));
  builtin_f_type->builtin_real_s16
    = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
		       "real*16", gdbarch_long_double_format (gdbarch));

  builtin_f_type->builtin_complex_s8
    = arch_complex_type (gdbarch, "complex*8",
			 builtin_f_type->builtin_real);
  builtin_f_type->builtin_complex_s16
    = arch_complex_type (gdbarch, "complex*16",
			 builtin_f_type->builtin_real_s8);
  builtin_f_type->builtin_complex_s32
    = arch_complex_type (gdbarch, "complex*32",
			 builtin_f_type->builtin_real_s16);

  return builtin_f_type;
}

static struct gdbarch_data *f_type_data;

const struct builtin_f_type *
builtin_f_type (struct gdbarch *gdbarch)
{
  return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
}

void
_initialize_f_language (void)
{
  f_type_data = gdbarch_data_register_post_init (build_fortran_types);

  add_language (&f_language_defn);
}
Commit	Line	Data
c906108c	1	/* Fortran language support routines for GDB, the GNU debugger.
ce27fb25	2
61baf725	3	Copyright (C) 1993-2017 Free Software Foundation, Inc.
ce27fb25	4
c906108c SS	5	Contributed by Motorola. Adapted from the C parser by Farooq Butt
	6	(fmbutt@engage.sps.mot.com).
	7
c5aa993b	8	This file is part of GDB.
c906108c	9
c5aa993b JM	10	This program is free software; you can redistribute it and/or modify
c5aa993b JM	11	it under the terms of the GNU General Public License as published by
a9762ec7	12	the Free Software Foundation; either version 3 of the License, or
c5aa993b	13	(at your option) any later version.
c906108c	14
c5aa993b JM	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.
c906108c	19
c5aa993b	20	You should have received a copy of the GNU General Public License
a9762ec7	21	along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c SS	22
c906108c SS	23	#include "defs.h"
c906108c SS	24	#include "symtab.h"
	25	#include "gdbtypes.h"
	26	#include "expression.h"
	27	#include "parser-defs.h"
	28	#include "language.h"
a53b64ea	29	#include "varobj.h"
c906108c	30	#include "f-lang.h"
745b8ca0	31	#include "valprint.h"
5f9a71c3	32	#include "value.h"
f55ee35c	33	#include "cp-support.h"
3b2b8fea	34	#include "charset.h"
8e069a98	35	#include "c-lang.h"
c906108c	36
c906108c	37
c906108c SS	38	/* Local functions */
c906108c SS	39
a14ed312	40	extern void _initialize_f_language (void);
c906108c	41
6c7a06a3 TT	42	static void f_printchar (int c, struct type type, struct ui_file stream);
	43	static void f_emit_char (int c, struct type *type,
	44	struct ui_file * stream, int quoter);
c906108c	45
3b2b8fea TT	46	/* Return the encoding that should be used for the character type
	47	TYPE. */
	48
	49	static const char *
	50	f_get_encoding (struct type *type)
	51	{
	52	const char *encoding;
	53
	54	switch (TYPE_LENGTH (type))
	55	{
	56	case 1:
	57	encoding = target_charset (get_type_arch (type));
	58	break;
	59	case 4:
	60	if (gdbarch_byte_order (get_type_arch (type)) == BFD_ENDIAN_BIG)
	61	encoding = "UTF-32BE";
	62	else
	63	encoding = "UTF-32LE";
	64	break;
	65
	66	default:
	67	error (_("unrecognized character type"));
	68	}
	69
	70	return encoding;
	71	}
	72
c906108c SS	73	/* Print the character C on STREAM as part of the contents of a literal
	74	string whose delimiter is QUOTER. Note that that format for printing
	75	characters and strings is language specific.
	76	FIXME: This is a copy of the same function from c-exp.y. It should
	77	be replaced with a true F77 version. */
	78
	79	static void
6c7a06a3	80	f_emit_char (int c, struct type type, struct ui_file stream, int quoter)
c906108c	81	{
3b2b8fea	82	const char *encoding = f_get_encoding (type);
c5aa993b	83
3b2b8fea	84	generic_emit_char (c, type, stream, quoter, encoding);
c906108c SS	85	}
c906108c SS	86
3b2b8fea	87	/* Implementation of la_printchar. */
c906108c SS	88
c906108c SS	89	static void
6c7a06a3	90	f_printchar (int c, struct type type, struct ui_file stream)
c906108c SS	91	{
c906108c SS	92	fputs_filtered ("'", stream);
6c7a06a3	93	LA_EMIT_CHAR (c, type, stream, '\'');
c906108c SS	94	fputs_filtered ("'", stream);
	95	}
	96
	97	/* Print the character string STRING, printing at most LENGTH characters.
	98	Printing stops early if the number hits print_max; repeat counts
	99	are printed as appropriate. Print ellipses at the end if we
	100	had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
	101	FIXME: This is a copy of the same function from c-exp.y. It should
0963b4bd	102	be replaced with a true F77 version. */
c906108c SS	103
c906108c SS	104	static void
6c7a06a3	105	f_printstr (struct ui_file stream, struct type type, const gdb_byte *string,
be759fcf	106	unsigned int length, const char *encoding, int force_ellipses,
79a45b7d	107	const struct value_print_options *options)
c906108c	108	{
3b2b8fea	109	const char *type_encoding = f_get_encoding (type);
c5aa993b	110
3b2b8fea TT	111	if (TYPE_LENGTH (type) == 4)
3b2b8fea TT	112	fputs_filtered ("4_", stream);
c5aa993b	113
3b2b8fea TT	114	if (!encoding \|\| !*encoding)
3b2b8fea TT	115	encoding = type_encoding;
c5aa993b	116
3b2b8fea TT	117	generic_printstr (stream, type, string, length, encoding,
3b2b8fea TT	118	force_ellipses, '\'', 0, options);
c906108c	119	}
c906108c	120	\f
c5aa993b	121
c906108c SS	122	/* Table of operators and their precedences for printing expressions. */
c906108c SS	123
c5aa993b JM	124	static const struct op_print f_op_print_tab[] =
	125	{
	126	{"+", BINOP_ADD, PREC_ADD, 0},
	127	{"+", UNOP_PLUS, PREC_PREFIX, 0},
	128	{"-", BINOP_SUB, PREC_ADD, 0},
	129	{"-", UNOP_NEG, PREC_PREFIX, 0},
	130	{"*", BINOP_MUL, PREC_MUL, 0},
	131	{"/", BINOP_DIV, PREC_MUL, 0},
	132	{"DIV", BINOP_INTDIV, PREC_MUL, 0},
	133	{"MOD", BINOP_REM, PREC_MUL, 0},
	134	{"=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	135	{".OR.", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	136	{".AND.", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	137	{".NOT.", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	138	{".EQ.", BINOP_EQUAL, PREC_EQUAL, 0},
	139	{".NE.", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	140	{".LE.", BINOP_LEQ, PREC_ORDER, 0},
	141	{".GE.", BINOP_GEQ, PREC_ORDER, 0},
	142	{".GT.", BINOP_GTR, PREC_ORDER, 0},
	143	{".LT.", BINOP_LESS, PREC_ORDER, 0},
	144	{"**", UNOP_IND, PREC_PREFIX, 0},
	145	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
f486487f	146	{NULL, OP_NULL, PREC_REPEAT, 0}
c906108c SS	147	};
c906108c SS	148	\f
cad351d1 UW	149	enum f_primitive_types {
	150	f_primitive_type_character,
	151	f_primitive_type_logical,
	152	f_primitive_type_logical_s1,
	153	f_primitive_type_logical_s2,
ce4b0682	154	f_primitive_type_logical_s8,
cad351d1 UW	155	f_primitive_type_integer,
	156	f_primitive_type_integer_s2,
	157	f_primitive_type_real,
	158	f_primitive_type_real_s8,
	159	f_primitive_type_real_s16,
	160	f_primitive_type_complex_s8,
	161	f_primitive_type_complex_s16,
	162	f_primitive_type_void,
	163	nr_f_primitive_types
c906108c SS	164	};
c906108c SS	165
cad351d1 UW	166	static void
	167	f_language_arch_info (struct gdbarch *gdbarch,
	168	struct language_arch_info *lai)
	169	{
54ef06c7 UW	170	const struct builtin_f_type *builtin = builtin_f_type (gdbarch);
	171
	172	lai->string_char_type = builtin->builtin_character;
cad351d1 UW	173	lai->primitive_type_vector
	174	= GDBARCH_OBSTACK_CALLOC (gdbarch, nr_f_primitive_types + 1,
	175	struct type *);
	176
	177	lai->primitive_type_vector [f_primitive_type_character]
54ef06c7	178	= builtin->builtin_character;
cad351d1	179	lai->primitive_type_vector [f_primitive_type_logical]
54ef06c7	180	= builtin->builtin_logical;
cad351d1	181	lai->primitive_type_vector [f_primitive_type_logical_s1]
54ef06c7	182	= builtin->builtin_logical_s1;
cad351d1	183	lai->primitive_type_vector [f_primitive_type_logical_s2]
54ef06c7	184	= builtin->builtin_logical_s2;
ce4b0682 SDJ	185	lai->primitive_type_vector [f_primitive_type_logical_s8]
ce4b0682 SDJ	186	= builtin->builtin_logical_s8;
cad351d1	187	lai->primitive_type_vector [f_primitive_type_real]
54ef06c7	188	= builtin->builtin_real;
cad351d1	189	lai->primitive_type_vector [f_primitive_type_real_s8]
54ef06c7	190	= builtin->builtin_real_s8;
cad351d1	191	lai->primitive_type_vector [f_primitive_type_real_s16]
54ef06c7	192	= builtin->builtin_real_s16;
cad351d1	193	lai->primitive_type_vector [f_primitive_type_complex_s8]
54ef06c7	194	= builtin->builtin_complex_s8;
cad351d1	195	lai->primitive_type_vector [f_primitive_type_complex_s16]
54ef06c7	196	= builtin->builtin_complex_s16;
cad351d1	197	lai->primitive_type_vector [f_primitive_type_void]
54ef06c7	198	= builtin->builtin_void;
fbb06eb1 UW	199
	200	lai->bool_type_symbol = "logical";
	201	lai->bool_type_default = builtin->builtin_logical_s2;
cad351d1 UW	202	}
cad351d1 UW	203
f55ee35c JK	204	/* Remove the modules separator :: from the default break list. */
f55ee35c JK	205
67cb5b2d	206	static const char *
f55ee35c JK	207	f_word_break_characters (void)
	208	{
	209	static char *retval;
	210
	211	if (!retval)
	212	{
	213	char *s;
	214
	215	retval = xstrdup (default_word_break_characters ());
	216	s = strchr (retval, ':');
	217	if (s)
	218	{
	219	char *last_char = &s[strlen (s) - 1];
	220
	221	s = last_char;
	222	*last_char = 0;
	223	}
	224	}
	225	return retval;
	226	}
	227
3e43a32a MS	228	/* Consider the modules separator :: as a valid symbol name character
3e43a32a MS	229	class. */
f55ee35c	230
eb3ff9a5 PA	231	static void
	232	f_collect_symbol_completion_matches (completion_tracker &tracker,
	233	const char text, const char word,
	234	enum type_code code)
f55ee35c	235	{
eb3ff9a5 PA	236	default_collect_symbol_completion_matches_break_on (tracker,
eb3ff9a5 PA	237	text, word, ":", code);
f55ee35c JK	238	}
f55ee35c JK	239
56618e20 TT	240	static const char *f_extensions[] =
	241	{
	242	".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
	243	".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08",
	244	NULL
	245	};
	246
c5aa993b JM	247	const struct language_defn f_language_defn =
c5aa993b JM	248	{
c906108c	249	"fortran",
6abde28f	250	"Fortran",
c906108c	251	language_fortran,
c906108c	252	range_check_on,
63872f9d	253	case_sensitive_off,
7ca2d3a3	254	array_column_major,
9a044a89	255	macro_expansion_no,
56618e20	256	f_extensions,
5f9769d1	257	&exp_descriptor_standard,
c906108c	258	f_parse, /* parser */
b3f11165	259	f_yyerror, /* parser error function */
e85c3284	260	null_post_parser,
c906108c SS	261	f_printchar, /* Print character constant */
	262	f_printstr, /* function to print string constant */
	263	f_emit_char, /* Function to print a single character */
c5aa993b	264	f_print_type, /* Print a type using appropriate syntax */
5c6ce71d	265	default_print_typedef, /* Print a typedef using appropriate syntax */
c906108c	266	f_val_print, /* Print a value using appropriate syntax */
c5aa993b	267	c_value_print, /* FIXME */
a5ee536b	268	default_read_var_value, /* la_read_var_value */
f636b87d	269	NULL, /* Language specific skip_trampoline */
2b2d9e11	270	NULL, /* name_of_this */
f55ee35c	271	cp_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	272	basic_lookup_transparent_type,/* lookup_transparent_type */
8b302db8 TT	273
	274	/* We could support demangling here to provide module namespaces
	275	also for inferiors with only minimal symbol table (ELF symbols).
	276	Just the mangling standard is not standardized across compilers
	277	and there is no DW_AT_producer available for inferiors with only
	278	the ELF symbols to check the mangling kind. */
9a3d7dfd	279	NULL, /* Language specific symbol demangler */
8b302db8	280	NULL,
3e43a32a MS	281	NULL, /* Language specific
3e43a32a MS	282	class_name_from_physname */
c906108c SS	283	f_op_print_tab, /* expression operators for printing */
	284	0, /* arrays are first-class (not c-style) */
	285	1, /* String lower bound */
f55ee35c	286	f_word_break_characters,
eb3ff9a5	287	f_collect_symbol_completion_matches,
cad351d1	288	f_language_arch_info,
e79af960	289	default_print_array_index,
41f1b697	290	default_pass_by_reference,
ae6a3a4c	291	default_get_string,
43cc5389	292	c_watch_location_expression,
1a119f36	293	NULL, /* la_get_symbol_name_cmp */
f8eba3c6	294	iterate_over_symbols,
a53b64ea	295	&default_varobj_ops,
bb2ec1b3 TT	296	NULL,
bb2ec1b3 TT	297	NULL,
c906108c	298	LANG_MAGIC
c5aa993b	299	};
c906108c	300
54ef06c7 UW	301	static void *
54ef06c7 UW	302	build_fortran_types (struct gdbarch *gdbarch)
c906108c	303	{
54ef06c7 UW	304	struct builtin_f_type *builtin_f_type
	305	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
	306
e9bb382b UW	307	builtin_f_type->builtin_void
	308	= arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
	309
	310	builtin_f_type->builtin_character
	311	= arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
	312
	313	builtin_f_type->builtin_logical_s1
	314	= arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
	315
	316	builtin_f_type->builtin_integer_s2
	317	= arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
	318	"integer*2");
	319
	320	builtin_f_type->builtin_logical_s2
	321	= arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
	322	"logical*2");
	323
ce4b0682 SDJ	324	builtin_f_type->builtin_logical_s8
	325	= arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
	326	"logical*8");
	327
e9bb382b UW	328	builtin_f_type->builtin_integer
	329	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
	330	"integer");
	331
	332	builtin_f_type->builtin_logical
	333	= arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
	334	"logical*4");
	335
	336	builtin_f_type->builtin_real
	337	= arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
49f190bc	338	"real", gdbarch_float_format (gdbarch));
e9bb382b UW	339	builtin_f_type->builtin_real_s8
e9bb382b UW	340	= arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
49f190bc	341	"real*8", gdbarch_double_format (gdbarch));
e9bb382b UW	342	builtin_f_type->builtin_real_s16
e9bb382b UW	343	= arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
49f190bc	344	"real*16", gdbarch_long_double_format (gdbarch));
e9bb382b UW	345
	346	builtin_f_type->builtin_complex_s8
	347	= arch_complex_type (gdbarch, "complex*8",
	348	builtin_f_type->builtin_real);
	349	builtin_f_type->builtin_complex_s16
	350	= arch_complex_type (gdbarch, "complex*16",
	351	builtin_f_type->builtin_real_s8);
	352	builtin_f_type->builtin_complex_s32
	353	= arch_complex_type (gdbarch, "complex*32",
	354	builtin_f_type->builtin_real_s16);
54ef06c7 UW	355
	356	return builtin_f_type;
	357	}
	358
	359	static struct gdbarch_data *f_type_data;
	360
	361	const struct builtin_f_type *
	362	builtin_f_type (struct gdbarch *gdbarch)
	363	{
9a3c8263	364	return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data);
4e845cd3 MS	365	}
	366
	367	void
	368	_initialize_f_language (void)
	369	{
54ef06c7	370	f_type_data = gdbarch_data_register_post_init (build_fortran_types);
c906108c	371
c906108c SS	372	add_language (&f_language_defn);
c906108c SS	373	}