[binutils.git] / gdb / p-lang.c

/* Pascal language support routines for GDB, the GNU debugger.
   Copyright 2000 Free Software Foundation, Inc.

   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 2 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, write to the Free Software
   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */

/* This file is derived from p-lang.c */

#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "parser-defs.h"
#include "language.h"
#include "p-lang.h"
#include "valprint.h"

extern void _initialize_pascal_language (void);
static void pascal_one_char (int, struct ui_file *, int *);

/* Print the character C on STREAM as part of the contents of a literal
   string.
   In_quotes is reset to 0 if a char is written with #4 notation */

static void
pascal_one_char (register int c, struct ui_file *stream, int *in_quotes)
{

  c &= 0xFF;			/* Avoid sign bit follies */

  if ((c == '\'') || (PRINT_LITERAL_FORM (c)))
    {
      if (!(*in_quotes))
	fputs_filtered ("'", stream);
      *in_quotes = 1;
      if (c == '\'')
	{
	  fputs_filtered ("''", stream);
	}
      else
	fprintf_filtered (stream, "%c", c);
    }
  else
    {
      if (*in_quotes)
	fputs_filtered ("'", stream);
      *in_quotes = 0;
      fprintf_filtered (stream, "#%d", (unsigned int) c);
    }
}

static void pascal_emit_char (int c, struct ui_file *stream, int quoter);

/* 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. */

static void
pascal_emit_char (register int c, struct ui_file *stream, int quoter)
{
  int in_quotes = 0;
  pascal_one_char (c, stream, &in_quotes);
  if (in_quotes)
    fputs_filtered ("'", stream);
}

void
pascal_printchar (int c, struct ui_file *stream)
{
  int in_quotes = 0;
  pascal_one_char (c, stream, &in_quotes);
  if (in_quotes)
    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.  */

void
pascal_printstr (struct ui_file *stream, char *string, unsigned int length,
		 int width, int force_ellipses)
{
  register unsigned int i;
  unsigned int things_printed = 0;
  int in_quotes = 0;
  int need_comma = 0;
  extern int inspect_it;

  /* If the string was not truncated due to `set print elements', and
     the last byte of it is a null, we don't print that, in traditional C
     style.  */
  if ((!force_ellipses) && length > 0 && string[length - 1] == '\0')
    length--;

  if (length == 0)
    {
      fputs_filtered ("''", stream);
      return;
    }

  for (i = 0; i < length && things_printed < print_max; ++i)
    {
      /* Position of the character we are examining
         to see whether it is repeated.  */
      unsigned int rep1;
      /* Number of repetitions we have detected so far.  */
      unsigned int reps;

      QUIT;

      if (need_comma)
	{
	  fputs_filtered (", ", stream);
	  need_comma = 0;
	}

      rep1 = i + 1;
      reps = 1;
      while (rep1 < length && string[rep1] == string[i])
	{
	  ++rep1;
	  ++reps;
	}

      if (reps > repeat_count_threshold)
	{
	  if (in_quotes)
	    {
	      if (inspect_it)
		fputs_filtered ("\\', ", stream);
	      else
		fputs_filtered ("', ", stream);
	      in_quotes = 0;
	    }
	  pascal_printchar (string[i], stream);
	  fprintf_filtered (stream, " <repeats %u times>", reps);
	  i = rep1 - 1;
	  things_printed += repeat_count_threshold;
	  need_comma = 1;
	}
      else
	{
	  int c = string[i];
	  if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
	    {
	      if (inspect_it)
		fputs_filtered ("\\'", stream);
	      else
		fputs_filtered ("'", stream);
	      in_quotes = 1;
	    }
	  pascal_one_char (c, stream, &in_quotes);
	  ++things_printed;
	}
    }

  /* Terminate the quotes if necessary.  */
  if (in_quotes)
    {
      if (inspect_it)
	fputs_filtered ("\\'", stream);
      else
	fputs_filtered ("'", stream);
    }

  if (force_ellipses || i < length)
    fputs_filtered ("...", stream);
}

/* Create a fundamental Pascal type using default reasonable for the current
   target machine.

   Some object/debugging file formats (DWARF version 1, COFF, etc) do not
   define fundamental types such as "int" or "double".  Others (stabs or
   DWARF version 2, etc) do define fundamental types.  For the formats which
   don't provide fundamental types, gdb can create such types using this
   function.

   FIXME:  Some compilers distinguish explicitly signed integral types
   (signed short, signed int, signed long) from "regular" integral types
   (short, int, long) in the debugging information.  There is some dis-
   agreement as to how useful this feature is.  In particular, gcc does
   not support this.  Also, only some debugging formats allow the
   distinction to be passed on to a debugger.  For now, we always just
   use "short", "int", or "long" as the type name, for both the implicit
   and explicitly signed types.  This also makes life easier for the
   gdb test suite since we don't have to account for the differences
   in output depending upon what the compiler and debugging format
   support.  We will probably have to re-examine the issue when gdb
   starts taking it's fundamental type information directly from the
   debugging information supplied by the compiler.  [email protected] */

/* Note there might be some discussion about the choosen correspondance
   because it mainly reflects Free Pascal Compiler setup for now PM */


struct type *
pascal_create_fundamental_type (struct objfile *objfile, int typeid)
{
  register struct type *type = NULL;

  switch (typeid)
    {
    default:
      /* FIXME:  For now, if we are asked to produce a type not in this
         language, create the equivalent of a C integer type with the
         name "<?type?>".  When all the dust settles from the type
         reconstruction work, this should probably become an error. */
      type = init_type (TYPE_CODE_INT,
			TARGET_INT_BIT / TARGET_CHAR_BIT,
			0, "<?type?>", objfile);
      warning ("internal error: no Pascal fundamental type %d", typeid);
      break;
    case FT_VOID:
      type = init_type (TYPE_CODE_VOID,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			0, "void", objfile);
      break;
    case FT_CHAR:
      type = init_type (TYPE_CODE_INT,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			0, "char", objfile);
      break;
    case FT_SIGNED_CHAR:
      type = init_type (TYPE_CODE_INT,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			0, "shortint", objfile);
      break;
    case FT_UNSIGNED_CHAR:
      type = init_type (TYPE_CODE_INT,
			TARGET_CHAR_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "byte", objfile);
      break;
    case FT_SHORT:
      type = init_type (TYPE_CODE_INT,
			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
			0, "integer", objfile);
      break;
    case FT_SIGNED_SHORT:
      type = init_type (TYPE_CODE_INT,
			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
			0, "integer", objfile);		/* FIXME-fnf */
      break;
    case FT_UNSIGNED_SHORT:
      type = init_type (TYPE_CODE_INT,
			TARGET_SHORT_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "word", objfile);
      break;
    case FT_INTEGER:
      type = init_type (TYPE_CODE_INT,
			TARGET_INT_BIT / TARGET_CHAR_BIT,
			0, "longint", objfile);
      break;
    case FT_SIGNED_INTEGER:
      type = init_type (TYPE_CODE_INT,
			TARGET_INT_BIT / TARGET_CHAR_BIT,
			0, "longint", objfile);		/* FIXME -fnf */
      break;
    case FT_UNSIGNED_INTEGER:
      type = init_type (TYPE_CODE_INT,
			TARGET_INT_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "cardinal", objfile);
      break;
    case FT_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_BIT / TARGET_CHAR_BIT,
			0, "long", objfile);
      break;
    case FT_SIGNED_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_BIT / TARGET_CHAR_BIT,
			0, "long", objfile);	/* FIXME -fnf */
      break;
    case FT_UNSIGNED_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
      break;
    case FT_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
			0, "long long", objfile);
      break;
    case FT_SIGNED_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
			0, "signed long long", objfile);
      break;
    case FT_UNSIGNED_LONG_LONG:
      type = init_type (TYPE_CODE_INT,
			TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
			TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
      break;
    case FT_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
			0, "float", objfile);
      break;
    case FT_DBL_PREC_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
			0, "double", objfile);
      break;
    case FT_EXT_PREC_FLOAT:
      type = init_type (TYPE_CODE_FLT,
			TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
			0, "extended", objfile);
      break;
    }
  return (type);
}
\f

/* Table mapping opcodes into strings for printing operators
   and precedences of the operators.  */

const struct op_print pascal_op_print_tab[] =
{
  {",", BINOP_COMMA, PREC_COMMA, 0},
  {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
  {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0},
  {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0},
  {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0},
  {"=", BINOP_EQUAL, PREC_EQUAL, 0},
  {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
  {"<=", BINOP_LEQ, PREC_ORDER, 0},
  {">=", BINOP_GEQ, PREC_ORDER, 0},
  {">", BINOP_GTR, PREC_ORDER, 0},
  {"<", BINOP_LESS, PREC_ORDER, 0},
  {"shr", BINOP_RSH, PREC_SHIFT, 0},
  {"shl", BINOP_LSH, PREC_SHIFT, 0},
  {"+", BINOP_ADD, PREC_ADD, 0},
  {"-", BINOP_SUB, PREC_ADD, 0},
  {"*", BINOP_MUL, PREC_MUL, 0},
  {"/", BINOP_DIV, PREC_MUL, 0},
  {"div", BINOP_INTDIV, PREC_MUL, 0},
  {"mod", BINOP_REM, PREC_MUL, 0},
  {"@", BINOP_REPEAT, PREC_REPEAT, 0},
  {"-", UNOP_NEG, PREC_PREFIX, 0},
  {"not", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
  {"^", UNOP_IND, PREC_SUFFIX, 1},
  {"@", UNOP_ADDR, PREC_PREFIX, 0},
  {"sizeof", UNOP_SIZEOF, PREC_PREFIX, 0},
  {NULL, 0, 0, 0}
};
\f
struct type **const /* CONST_PTR v 4.17 */ (pascal_builtin_types[]) =
{
  &builtin_type_int,
    &builtin_type_long,
    &builtin_type_short,
    &builtin_type_char,
    &builtin_type_float,
    &builtin_type_double,
    &builtin_type_void,
    &builtin_type_long_long,
    &builtin_type_signed_char,
    &builtin_type_unsigned_char,
    &builtin_type_unsigned_short,
    &builtin_type_unsigned_int,
    &builtin_type_unsigned_long,
    &builtin_type_unsigned_long_long,
    &builtin_type_long_double,
    &builtin_type_complex,
    &builtin_type_double_complex,
    0
};

const struct language_defn pascal_language_defn =
{
  "pascal",			/* Language name */
  language_pascal,
  pascal_builtin_types,
  range_check_on,
  type_check_on,
  case_sensitive_on,
  pascal_parse,
  pascal_error,
  evaluate_subexp_standard,
  pascal_printchar,		/* Print a character constant */
  pascal_printstr,		/* Function to print string constant */
  pascal_emit_char,		/* Print a single char */
  pascal_create_fundamental_type,	/* Create fundamental type in this language */
  pascal_print_type,		/* Print a type using appropriate syntax */
  pascal_val_print,		/* Print a value using appropriate syntax */
  pascal_value_print,		/* Print a top-level value */
  {"", "%", "b", ""},		/* Binary format info */
  {"0%lo", "0", "o", ""},	/* Octal format info */
  {"%ld", "", "d", ""},		/* Decimal format info */
  {"$%lx", "$", "x", ""},	/* Hex format info */
  pascal_op_print_tab,		/* expression operators for printing */
  1,				/* c-style arrays */
  0,				/* String lower bound */
  &builtin_type_char,		/* Type of string elements */
  LANG_MAGIC
};

void
_initialize_pascal_language (void)
{
  add_language (&pascal_language_defn);
}
Commit	Line	Data
373a8247 PM	1	/* Pascal language support routines for GDB, the GNU debugger.
	2	Copyright 2000 Free Software Foundation, Inc.
	3
	4	This file is part of GDB.
	5
	6	This program is free software; you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
	8	the Free Software Foundation; either version 2 of the License, or
	9	(at your option) any later version.
	10
	11	This program is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
	16	You should have received a copy of the GNU General Public License
	17	along with this program; if not, write to the Free Software
	18	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
	19
	20	/* This file is derived from p-lang.c */
	21
	22	#include "defs.h"
	23	#include "symtab.h"
	24	#include "gdbtypes.h"
	25	#include "expression.h"
	26	#include "parser-defs.h"
	27	#include "language.h"
	28	#include "p-lang.h"
	29	#include "valprint.h"
	30
	31	extern void _initialize_pascal_language (void);
	32	static void pascal_one_char (int, struct ui_file , int );
	33
	34	/* Print the character C on STREAM as part of the contents of a literal
	35	string.
	36	In_quotes is reset to 0 if a char is written with #4 notation */
	37
	38	static void
fba45db2	39	pascal_one_char (register int c, struct ui_file stream, int in_quotes)
373a8247 PM	40	{
	41
	42	c &= 0xFF; /* Avoid sign bit follies */
	43
	44	if ((c == '\'') \|\| (PRINT_LITERAL_FORM (c)))
	45	{
	46	if (!(*in_quotes))
	47	fputs_filtered ("'", stream);
	48	*in_quotes = 1;
	49	if (c == '\'')
	50	{
	51	fputs_filtered ("''", stream);
	52	}
	53	else
	54	fprintf_filtered (stream, "%c", c);
	55	}
	56	else
	57	{
	58	if (*in_quotes)
	59	fputs_filtered ("'", stream);
	60	*in_quotes = 0;
	61	fprintf_filtered (stream, "#%d", (unsigned int) c);
	62	}
	63	}
	64
	65	static void pascal_emit_char (int c, struct ui_file *stream, int quoter);
	66
	67	/* Print the character C on STREAM as part of the contents of a literal
	68	string whose delimiter is QUOTER. Note that that format for printing
	69	characters and strings is language specific. */
	70
	71	static void
fba45db2	72	pascal_emit_char (register int c, struct ui_file *stream, int quoter)
373a8247 PM	73	{
	74	int in_quotes = 0;
	75	pascal_one_char (c, stream, &in_quotes);
	76	if (in_quotes)
	77	fputs_filtered ("'", stream);
	78	}
	79
	80	void
fba45db2	81	pascal_printchar (int c, struct ui_file *stream)
373a8247 PM	82	{
	83	int in_quotes = 0;
	84	pascal_one_char (c, stream, &in_quotes);
	85	if (in_quotes)
	86	fputs_filtered ("'", stream);
	87	}
	88
	89	/* Print the character string STRING, printing at most LENGTH characters.
	90	Printing stops early if the number hits print_max; repeat counts
	91	are printed as appropriate. Print ellipses at the end if we
	92	had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
	93
	94	void
fba45db2 KB	95	pascal_printstr (struct ui_file stream, char string, unsigned int length,
fba45db2 KB	96	int width, int force_ellipses)
373a8247 PM	97	{
	98	register unsigned int i;
	99	unsigned int things_printed = 0;
	100	int in_quotes = 0;
	101	int need_comma = 0;
	102	extern int inspect_it;
	103
	104	/* If the string was not truncated due to `set print elements', and
	105	the last byte of it is a null, we don't print that, in traditional C
	106	style. */
	107	if ((!force_ellipses) && length > 0 && string[length - 1] == '\0')
	108	length--;
	109
	110	if (length == 0)
	111	{
	112	fputs_filtered ("''", stream);
	113	return;
	114	}
	115
	116	for (i = 0; i < length && things_printed < print_max; ++i)
	117	{
	118	/* Position of the character we are examining
	119	to see whether it is repeated. */
	120	unsigned int rep1;
	121	/* Number of repetitions we have detected so far. */
	122	unsigned int reps;
	123
	124	QUIT;
	125
	126	if (need_comma)
	127	{
	128	fputs_filtered (", ", stream);
	129	need_comma = 0;
	130	}
	131
	132	rep1 = i + 1;
	133	reps = 1;
	134	while (rep1 < length && string[rep1] == string[i])
	135	{
	136	++rep1;
	137	++reps;
	138	}
	139
	140	if (reps > repeat_count_threshold)
	141	{
	142	if (in_quotes)
	143	{
	144	if (inspect_it)
	145	fputs_filtered ("\\', ", stream);
	146	else
	147	fputs_filtered ("', ", stream);
	148	in_quotes = 0;
	149	}
	150	pascal_printchar (string[i], stream);
	151	fprintf_filtered (stream, " <repeats %u times>", reps);
	152	i = rep1 - 1;
	153	things_printed += repeat_count_threshold;
	154	need_comma = 1;
	155	}
	156	else
	157	{
	158	int c = string[i];
	159	if ((!in_quotes) && (PRINT_LITERAL_FORM (c)))
	160	{
161	if (inspect_it)
162	fputs_filtered ("\\'", stream);
163	else
164	fputs_filtered ("'", stream);
165	in_quotes = 1;
166	}
167	pascal_one_char (c, stream, &in_quotes);
168	++things_printed;
169	}
170	}
171
172	/* Terminate the quotes if necessary. */
173	if (in_quotes)
174	{
175	if (inspect_it)
176	fputs_filtered ("\\'", stream);
177	else
178	fputs_filtered ("'", stream);
179	}
180
181	if (force_ellipses \|\| i < length)
182	fputs_filtered ("...", stream);
183	}
184
185	/* Create a fundamental Pascal type using default reasonable for the current
186	target machine.
187
188	Some object/debugging file formats (DWARF version 1, COFF, etc) do not
189	define fundamental types such as "int" or "double". Others (stabs or
190	DWARF version 2, etc) do define fundamental types. For the formats which
191	don't provide fundamental types, gdb can create such types using this
192	function.
193
194	FIXME: Some compilers distinguish explicitly signed integral types
195	(signed short, signed int, signed long) from "regular" integral types
196	(short, int, long) in the debugging information. There is some dis-
197	agreement as to how useful this feature is. In particular, gcc does
198	not support this. Also, only some debugging formats allow the
199	distinction to be passed on to a debugger. For now, we always just
200	use "short", "int", or "long" as the type name, for both the implicit
201	and explicitly signed types. This also makes life easier for the
202	gdb test suite since we don't have to account for the differences
203	in output depending upon what the compiler and debugging format
204	support. We will probably have to re-examine the issue when gdb
205	starts taking it's fundamental type information directly from the
206	debugging information supplied by the compiler. [email protected] */
207
208	/* Note there might be some discussion about the choosen correspondance
209	because it mainly reflects Free Pascal Compiler setup for now PM */
210
211
212	struct type *
fba45db2	213	pascal_create_fundamental_type (struct objfile *objfile, int typeid)
373a8247 PM	214	{
	215	register struct type *type = NULL;
	216
	217	switch (typeid)
	218	{
	219	default:
	220	/* FIXME: For now, if we are asked to produce a type not in this
	221	language, create the equivalent of a C integer type with the
	222	name "<?type?>". When all the dust settles from the type
	223	reconstruction work, this should probably become an error. */
	224	type = init_type (TYPE_CODE_INT,
	225	TARGET_INT_BIT / TARGET_CHAR_BIT,
	226	0, "<?type?>", objfile);
	227	warning ("internal error: no Pascal fundamental type %d", typeid);
	228	break;
	229	case FT_VOID:
	230	type = init_type (TYPE_CODE_VOID,
	231	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	232	0, "void", objfile);
	233	break;
	234	case FT_CHAR:
	235	type = init_type (TYPE_CODE_INT,
	236	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	237	0, "char", objfile);
	238	break;
	239	case FT_SIGNED_CHAR:
	240	type = init_type (TYPE_CODE_INT,
	241	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	242	0, "shortint", objfile);
	243	break;
	244	case FT_UNSIGNED_CHAR:
	245	type = init_type (TYPE_CODE_INT,
	246	TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	247	TYPE_FLAG_UNSIGNED, "byte", objfile);
	248	break;
	249	case FT_SHORT:
	250	type = init_type (TYPE_CODE_INT,
	251	TARGET_SHORT_BIT / TARGET_CHAR_BIT,
	252	0, "integer", objfile);
	253	break;
	254	case FT_SIGNED_SHORT:
	255	type = init_type (TYPE_CODE_INT,
	256	TARGET_SHORT_BIT / TARGET_CHAR_BIT,
	257	0, "integer", objfile); /* FIXME-fnf */
	258	break;
	259	case FT_UNSIGNED_SHORT:
	260	type = init_type (TYPE_CODE_INT,
	261	TARGET_SHORT_BIT / TARGET_CHAR_BIT,
	262	TYPE_FLAG_UNSIGNED, "word", objfile);
	263	break;
	264	case FT_INTEGER:
	265	type = init_type (TYPE_CODE_INT,
	266	TARGET_INT_BIT / TARGET_CHAR_BIT,
	267	0, "longint", objfile);
	268	break;
	269	case FT_SIGNED_INTEGER:
	270	type = init_type (TYPE_CODE_INT,
	271	TARGET_INT_BIT / TARGET_CHAR_BIT,
	272	0, "longint", objfile); /* FIXME -fnf */
	273	break;
	274	case FT_UNSIGNED_INTEGER:
	275	type = init_type (TYPE_CODE_INT,
	276	TARGET_INT_BIT / TARGET_CHAR_BIT,
	277	TYPE_FLAG_UNSIGNED, "cardinal", objfile);
278	break;
279	case FT_LONG:
280	type = init_type (TYPE_CODE_INT,
281	TARGET_LONG_BIT / TARGET_CHAR_BIT,
282	0, "long", objfile);
283	break;
284	case FT_SIGNED_LONG:
285	type = init_type (TYPE_CODE_INT,
286	TARGET_LONG_BIT / TARGET_CHAR_BIT,
287	0, "long", objfile); /* FIXME -fnf */
288	break;
289	case FT_UNSIGNED_LONG:
290	type = init_type (TYPE_CODE_INT,
291	TARGET_LONG_BIT / TARGET_CHAR_BIT,
292	TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
293	break;
294	case FT_LONG_LONG:
295	type = init_type (TYPE_CODE_INT,
296	TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
297	0, "long long", objfile);
298	break;
299	case FT_SIGNED_LONG_LONG:
300	type = init_type (TYPE_CODE_INT,
301	TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
302	0, "signed long long", objfile);
303	break;
304	case FT_UNSIGNED_LONG_LONG:
305	type = init_type (TYPE_CODE_INT,
306	TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
307	TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
308	break;
309	case FT_FLOAT:
310	type = init_type (TYPE_CODE_FLT,
311	TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
312	0, "float", objfile);
313	break;
314	case FT_DBL_PREC_FLOAT:
315	type = init_type (TYPE_CODE_FLT,
316	TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
317	0, "double", objfile);
318	break;
319	case FT_EXT_PREC_FLOAT:
320	type = init_type (TYPE_CODE_FLT,
321	TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
322	0, "extended", objfile);
323	break;
324	}
325	return (type);
326	}
327	\f
328
329	/* Table mapping opcodes into strings for printing operators
330	and precedences of the operators. */
331
332	const struct op_print pascal_op_print_tab[] =
333	{
334	{",", BINOP_COMMA, PREC_COMMA, 0},
335	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
336	{"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0},
337	{"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0},
338	{"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0},
339	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
340	{"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
341	{"<=", BINOP_LEQ, PREC_ORDER, 0},
342	{">=", BINOP_GEQ, PREC_ORDER, 0},
343	{">", BINOP_GTR, PREC_ORDER, 0},
344	{"<", BINOP_LESS, PREC_ORDER, 0},
345	{"shr", BINOP_RSH, PREC_SHIFT, 0},
346	{"shl", BINOP_LSH, PREC_SHIFT, 0},
347	{"+", BINOP_ADD, PREC_ADD, 0},
348	{"-", BINOP_SUB, PREC_ADD, 0},
349	{"*", BINOP_MUL, PREC_MUL, 0},
350	{"/", BINOP_DIV, PREC_MUL, 0},
351	{"div", BINOP_INTDIV, PREC_MUL, 0},
352	{"mod", BINOP_REM, PREC_MUL, 0},
353	{"@", BINOP_REPEAT, PREC_REPEAT, 0},
354	{"-", UNOP_NEG, PREC_PREFIX, 0},
355	{"not", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
356	{"^", UNOP_IND, PREC_SUFFIX, 1},
357	{"@", UNOP_ADDR, PREC_PREFIX, 0},
358	{"sizeof", UNOP_SIZEOF, PREC_PREFIX, 0},
359	{NULL, 0, 0, 0}
360	};
361	\f
362	struct type *const / CONST_PTR v 4.17 */ (pascal_builtin_types[]) =
363	{
364	&builtin_type_int,
365	&builtin_type_long,
366	&builtin_type_short,
367	&builtin_type_char,
368	&builtin_type_float,
369	&builtin_type_double,
370	&builtin_type_void,
371	&builtin_type_long_long,
372	&builtin_type_signed_char,
373	&builtin_type_unsigned_char,
374	&builtin_type_unsigned_short,
375	&builtin_type_unsigned_int,
376	&builtin_type_unsigned_long,
377	&builtin_type_unsigned_long_long,
378	&builtin_type_long_double,
379	&builtin_type_complex,
380	&builtin_type_double_complex,
381	0
382	};
383
384	const struct language_defn pascal_language_defn =
385	{
386	"pascal", /* Language name */
387	language_pascal,
388	pascal_builtin_types,
389	range_check_on,
390	type_check_on,
63872f9d	391	case_sensitive_on,
373a8247 PM	392	pascal_parse,
	393	pascal_error,
	394	evaluate_subexp_standard,
	395	pascal_printchar, /* Print a character constant */
	396	pascal_printstr, /* Function to print string constant */
	397	pascal_emit_char, /* Print a single char */
	398	pascal_create_fundamental_type, /* Create fundamental type in this language */
	399	pascal_print_type, /* Print a type using appropriate syntax */
	400	pascal_val_print, /* Print a value using appropriate syntax */
	401	pascal_value_print, /* Print a top-level value */
	402	{"", "%", "b", ""}, /* Binary format info */
	403	{"0%lo", "0", "o", ""}, /* Octal format info */
	404	{"%ld", "", "d", ""}, /* Decimal format info */
	405	{"$%lx", "$", "x", ""}, /* Hex format info */
	406	pascal_op_print_tab, /* expression operators for printing */
	407	1, /* c-style arrays */
	408	0, /* String lower bound */
	409	&builtin_type_char, /* Type of string elements */
	410	LANG_MAGIC
	411	};
	412
	413	void
fba45db2	414	_initialize_pascal_language (void)
373a8247 PM	415	{
	416	add_language (&pascal_language_defn);
	417	}