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

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

   Copyright (C) 1993-2013 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 "gdb_string.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "parser-defs.h"
#include "language.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, 0, 0, 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 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 VEC (char_ptr) *
f_make_symbol_completion_list (const char *text, const char *word,
			       enum type_code code)
{
  return default_make_symbol_completion_list_break_on (text, word, ":", code);
}

const struct language_defn f_language_defn =
{
  "fortran",
  language_fortran,
  range_check_on,
  case_sensitive_off,
  array_column_major,
  macro_expansion_no,
  &exp_descriptor_standard,
  f_parse,			/* parser */
  f_error,			/* 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 */
  NULL,				/* Language specific symbol demangler */
  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_make_symbol_completion_list,
  f_language_arch_info,
  default_print_array_index,
  default_pass_by_reference,
  default_get_string,
  NULL,				/* la_get_symbol_name_cmp */
  iterate_over_symbols,
  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", NULL);
  builtin_f_type->builtin_real_s8
    = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
		       "real*8", NULL);
  builtin_f_type->builtin_real_s16
    = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
		       "real*16", NULL);

  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 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
28e7fd62	3	Copyright (C) 1993-2013 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
	23	#include "defs.h"
	24	#include "gdb_string.h"
	25	#include "symtab.h"
	26	#include "gdbtypes.h"
	27	#include "expression.h"
	28	#include "parser-defs.h"
	29	#include "language.h"
	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},
	146	{NULL, 0, 0, 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. */
	205
	206	static char *
	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
49c4e619	231	static VEC (char_ptr) *
6f937416 PA	232	f_make_symbol_completion_list (const char text, const char word,
6f937416 PA	233	enum type_code code)
f55ee35c	234	{
2f68a895	235	return default_make_symbol_completion_list_break_on (text, word, ":", code);
f55ee35c JK	236	}
f55ee35c JK	237
c5aa993b JM	238	const struct language_defn f_language_defn =
c5aa993b JM	239	{
c906108c SS	240	"fortran",
c906108c SS	241	language_fortran,
c906108c	242	range_check_on,
63872f9d	243	case_sensitive_off,
7ca2d3a3	244	array_column_major,
9a044a89	245	macro_expansion_no,
5f9769d1	246	&exp_descriptor_standard,
c906108c SS	247	f_parse, /* parser */
c906108c SS	248	f_error, /* parser error function */
e85c3284	249	null_post_parser,
c906108c SS	250	f_printchar, /* Print character constant */
	251	f_printstr, /* function to print string constant */
	252	f_emit_char, /* Function to print a single character */
c5aa993b	253	f_print_type, /* Print a type using appropriate syntax */
5c6ce71d	254	default_print_typedef, /* Print a typedef using appropriate syntax */
c906108c	255	f_val_print, /* Print a value using appropriate syntax */
c5aa993b	256	c_value_print, /* FIXME */
a5ee536b	257	default_read_var_value, /* la_read_var_value */
f636b87d	258	NULL, /* Language specific skip_trampoline */
2b2d9e11	259	NULL, /* name_of_this */
f55ee35c	260	cp_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
b368761e	261	basic_lookup_transparent_type,/* lookup_transparent_type */
9a3d7dfd	262	NULL, /* Language specific symbol demangler */
3e43a32a MS	263	NULL, /* Language specific
3e43a32a MS	264	class_name_from_physname */
c906108c SS	265	f_op_print_tab, /* expression operators for printing */
	266	0, /* arrays are first-class (not c-style) */
	267	1, /* String lower bound */
f55ee35c JK	268	f_word_break_characters,
f55ee35c JK	269	f_make_symbol_completion_list,
cad351d1	270	f_language_arch_info,
e79af960	271	default_print_array_index,
41f1b697	272	default_pass_by_reference,
ae6a3a4c	273	default_get_string,
1a119f36	274	NULL, /* la_get_symbol_name_cmp */
f8eba3c6	275	iterate_over_symbols,
c906108c	276	LANG_MAGIC
c5aa993b	277	};
c906108c	278
54ef06c7 UW	279	static void *
54ef06c7 UW	280	build_fortran_types (struct gdbarch *gdbarch)
c906108c	281	{
54ef06c7 UW	282	struct builtin_f_type *builtin_f_type
	283	= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
	284
e9bb382b UW	285	builtin_f_type->builtin_void
	286	= arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
	287
	288	builtin_f_type->builtin_character
	289	= arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
	290
	291	builtin_f_type->builtin_logical_s1
	292	= arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
	293
	294	builtin_f_type->builtin_integer_s2
	295	= arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
	296	"integer*2");
	297
	298	builtin_f_type->builtin_logical_s2
	299	= arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
	300	"logical*2");
	301
ce4b0682 SDJ	302	builtin_f_type->builtin_logical_s8
	303	= arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
	304	"logical*8");
	305
e9bb382b UW	306	builtin_f_type->builtin_integer
	307	= arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
	308	"integer");
	309
	310	builtin_f_type->builtin_logical
	311	= arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
	312	"logical*4");
	313
	314	builtin_f_type->builtin_real
	315	= arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
	316	"real", NULL);
	317	builtin_f_type->builtin_real_s8
	318	= arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
	319	"real*8", NULL);
	320	builtin_f_type->builtin_real_s16
	321	= arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
	322	"real*16", NULL);
	323
	324	builtin_f_type->builtin_complex_s8
	325	= arch_complex_type (gdbarch, "complex*8",
	326	builtin_f_type->builtin_real);
	327	builtin_f_type->builtin_complex_s16
	328	= arch_complex_type (gdbarch, "complex*16",
	329	builtin_f_type->builtin_real_s8);
	330	builtin_f_type->builtin_complex_s32
	331	= arch_complex_type (gdbarch, "complex*32",
	332	builtin_f_type->builtin_real_s16);
54ef06c7 UW	333
	334	return builtin_f_type;
	335	}
	336
	337	static struct gdbarch_data *f_type_data;
	338
	339	const struct builtin_f_type *
	340	builtin_f_type (struct gdbarch *gdbarch)
	341	{
	342	return gdbarch_data (gdbarch, f_type_data);
4e845cd3 MS	343	}
	344
	345	void
	346	_initialize_f_language (void)
	347	{
54ef06c7	348	f_type_data = gdbarch_data_register_post_init (build_fortran_types);
c906108c	349
c906108c SS	350	add_language (&f_language_defn);
c906108c SS	351	}