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

/* Chill language support routines for GDB, the GNU debugger.
   Copyright 1992, 1993, 1994, 1995, 1996, 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.  */

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

extern void _initialize_chill_language (void);

static value_ptr
evaluate_subexp_chill (struct type *, struct expression *, int *,
		       enum noside);

static value_ptr value_chill_max_min (enum exp_opcode, value_ptr);

static value_ptr value_chill_card (value_ptr);

static value_ptr value_chill_length (value_ptr);

static struct type *chill_create_fundamental_type (struct objfile *, int);

static void chill_printstr (struct ui_file * stream, char *string,
			    unsigned int length, int width,
			    int force_ellipses);

static void chill_printchar (int, struct ui_file *);

/* For now, Chill uses a simple mangling algorithm whereby you simply
   discard everything after the occurance of two successive CPLUS_MARKER
   characters to derive the demangled form. */

char *
chill_demangle (const char *mangled)
{
  const char *joiner = NULL;
  char *demangled;
  const char *cp = mangled;

  while (*cp)
    {
      if (is_cplus_marker (*cp))
	{
	  joiner = cp;
	  break;
	}
      cp++;
    }
  if (joiner != NULL && *(joiner + 1) == *joiner)
    {
      demangled = savestring (mangled, joiner - mangled);
    }
  else
    {
      demangled = NULL;
    }
  return (demangled);
}

static void
chill_printchar (register int c, struct ui_file *stream)
{
  c &= 0xFF;			/* Avoid sign bit follies */

  if (PRINT_LITERAL_FORM (c))
    {
      if (c == '\'' || c == '^')
	fprintf_filtered (stream, "'%c%c'", c, c);
      else
	fprintf_filtered (stream, "'%c'", c);
    }
  else
    {
      fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
    }
}

/* 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.
   Note that gdb maintains the length of strings without counting the
   terminating null byte, while chill strings are typically written with
   an explicit null byte.  So we always assume an implied null byte
   until gdb is able to maintain non-null terminated strings as well
   as null terminated strings (FIXME).
 */

static void
chill_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_literal_form = 0;
  int in_control_form = 0;
  int need_slashslash = 0;
  unsigned int c;

  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_slashslash)
	{
	  fputs_filtered ("//", stream);
	  need_slashslash = 0;
	}

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

      c = string[i];
      if (reps > repeat_count_threshold)
	{
	  if (in_control_form || in_literal_form)
	    {
	      if (in_control_form)
		fputs_filtered (")", stream);
	      fputs_filtered ("\"//", stream);
	      in_control_form = in_literal_form = 0;
	    }
	  chill_printchar (c, stream);
	  fprintf_filtered (stream, "<repeats %u times>", reps);
	  i = rep1 - 1;
	  things_printed += repeat_count_threshold;
	  need_slashslash = 1;
	}
      else
	{
	  if (!in_literal_form && !in_control_form)
	    fputs_filtered ("\"", stream);
	  if (PRINT_LITERAL_FORM (c))
	    {
	      if (!in_literal_form)
		{
		  if (in_control_form)
		    {
		      fputs_filtered (")", stream);
		      in_control_form = 0;
		    }
		  in_literal_form = 1;
		}
	      fprintf_filtered (stream, "%c", c);
	      if (c == '"' || c == '^')
		/* duplicate this one as must be done at input */
		fprintf_filtered (stream, "%c", c);
	    }
	  else
	    {
	      if (!in_control_form)
		{
		  if (in_literal_form)
		    {
		      in_literal_form = 0;
		    }
		  fputs_filtered ("^(", stream);
		  in_control_form = 1;
		}
	      else
		fprintf_filtered (stream, ",");
	      c = c & 0xff;
	      fprintf_filtered (stream, "%u", (unsigned int) c);
	    }
	  ++things_printed;
	}
    }

  /* Terminate the quotes if necessary.  */
  if (in_control_form)
    {
      fputs_filtered (")", stream);
    }
  if (in_literal_form || in_control_form)
    {
      fputs_filtered ("\"", stream);
    }
  if (force_ellipses || (i < length))
    {
      fputs_filtered ("...", stream);
    }
}

static struct type *
chill_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, 2, 0, "<?type?>", objfile);
      warning ("internal error: no chill fundamental type %d", typeid);
      break;
    case FT_VOID:
      /* FIXME:  Currently the GNU Chill compiler emits some DWARF entries for
         typedefs, unrelated to anything directly in the code being compiled,
         that have some FT_VOID types.  Just fake it for now. */
      type = init_type (TYPE_CODE_VOID, 0, 0, "<?VOID?>", objfile);
      break;
    case FT_BOOLEAN:
      type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
      break;
    case FT_CHAR:
      type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
      break;
    case FT_SIGNED_CHAR:
      type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
      break;
    case FT_UNSIGNED_CHAR:
      type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
      break;
    case FT_SHORT:		/* Chill ints are 2 bytes */
      type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
      break;
    case FT_UNSIGNED_SHORT:	/* Chill ints are 2 bytes */
      type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
      break;
    case FT_INTEGER:		/* FIXME? */
    case FT_SIGNED_INTEGER:	/* FIXME? */
    case FT_LONG:		/* Chill longs are 4 bytes */
    case FT_SIGNED_LONG:	/* Chill longs are 4 bytes */
      type = init_type (TYPE_CODE_INT, 4, 0, "LONG", objfile);
      break;
    case FT_UNSIGNED_INTEGER:	/* FIXME? */
    case FT_UNSIGNED_LONG:	/* Chill longs are 4 bytes */
      type = init_type (TYPE_CODE_INT, 4, TYPE_FLAG_UNSIGNED, "ULONG", objfile);
      break;
    case FT_FLOAT:
      type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
      break;
    case FT_DBL_PREC_FLOAT:
      type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
      break;
    }
  return (type);
}
\f

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

static const struct op_print chill_op_print_tab[] =
{
  {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
  {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
  {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
  {"MOD", BINOP_MOD, PREC_MUL, 0},
  {"REM", BINOP_REM, PREC_MUL, 0},
  {"SIZE", UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
  {"LOWER", UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
  {"UPPER", UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
  {"CARD", UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
  {"MAX", UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
  {"MIN", UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
  {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
  {"=", 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},
  {"+", BINOP_ADD, PREC_ADD, 0},
  {"-", BINOP_SUB, PREC_ADD, 0},
  {"*", BINOP_MUL, PREC_MUL, 0},
  {"/", BINOP_DIV, PREC_MUL, 0},
  {"//", BINOP_CONCAT, PREC_PREFIX, 0},		/* FIXME: precedence? */
  {"-", UNOP_NEG, PREC_PREFIX, 0},
  {"->", UNOP_IND, PREC_SUFFIX, 1},
  {"->", UNOP_ADDR, PREC_PREFIX, 0},
  {":", BINOP_RANGE, PREC_ASSIGN, 0},
  {NULL, 0, 0, 0}
};
\f
/* The built-in types of Chill.  */

struct type *builtin_type_chill_bool;
struct type *builtin_type_chill_char;
struct type *builtin_type_chill_long;
struct type *builtin_type_chill_ulong;
struct type *builtin_type_chill_real;

struct type **CONST_PTR (chill_builtin_types[]) =
{
  &builtin_type_chill_bool,
    &builtin_type_chill_char,
    &builtin_type_chill_long,
    &builtin_type_chill_ulong,
    &builtin_type_chill_real,
    0
};

/* Calculate LOWER or UPPER of TYPE.
   Returns the result as an integer.
   *RESULT_TYPE is the appropriate type for the result. */

LONGEST
type_lower_upper (enum exp_opcode op,	/* Either UNOP_LOWER or UNOP_UPPER */
		  struct type *type, struct type **result_type)
{
  LONGEST low, high;
  *result_type = type;
  CHECK_TYPEDEF (type);
  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_STRUCT:
      *result_type = builtin_type_int;
      if (chill_varying_type (type))
	return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
      break;
    case TYPE_CODE_ARRAY:
    case TYPE_CODE_BITSTRING:
    case TYPE_CODE_STRING:
      type = TYPE_FIELD_TYPE (type, 0);		/* Get index type */

      /* ... fall through ... */
    case TYPE_CODE_RANGE:
      *result_type = TYPE_TARGET_TYPE (type);
      return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);

    case TYPE_CODE_ENUM:
    case TYPE_CODE_BOOL:
    case TYPE_CODE_INT:
    case TYPE_CODE_CHAR:
      if (get_discrete_bounds (type, &low, &high) >= 0)
	{
	  *result_type = type;
	  return op == UNOP_LOWER ? low : high;
	}
      break;
    case TYPE_CODE_UNDEF:
    case TYPE_CODE_PTR:
    case TYPE_CODE_UNION:
    case TYPE_CODE_FUNC:
    case TYPE_CODE_FLT:
    case TYPE_CODE_VOID:
    case TYPE_CODE_SET:
    case TYPE_CODE_ERROR:
    case TYPE_CODE_MEMBER:
    case TYPE_CODE_METHOD:
    case TYPE_CODE_REF:
    case TYPE_CODE_COMPLEX:
    default:
      break;
    }
  error ("unknown mode for LOWER/UPPER builtin");
}

static value_ptr
value_chill_length (value_ptr val)
{
  LONGEST tmp;
  struct type *type = VALUE_TYPE (val);
  struct type *ttype;
  CHECK_TYPEDEF (type);
  switch (TYPE_CODE (type))
    {
    case TYPE_CODE_ARRAY:
    case TYPE_CODE_BITSTRING:
    case TYPE_CODE_STRING:
      tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
	- type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
      break;
    case TYPE_CODE_STRUCT:
      if (chill_varying_type (type))
	{
	  tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
	  break;
	}
      /* ... else fall through ... */
    default:
      error ("bad argument to LENGTH builtin");
    }
  return value_from_longest (builtin_type_int, tmp);
}

static value_ptr
value_chill_card (value_ptr val)
{
  LONGEST tmp = 0;
  struct type *type = VALUE_TYPE (val);
  CHECK_TYPEDEF (type);

  if (TYPE_CODE (type) == TYPE_CODE_SET)
    {
      struct type *range_type = TYPE_INDEX_TYPE (type);
      LONGEST lower_bound, upper_bound;
      int i;

      get_discrete_bounds (range_type, &lower_bound, &upper_bound);
      for (i = lower_bound; i <= upper_bound; i++)
	if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
	  tmp++;
    }
  else
    error ("bad argument to CARD builtin");

  return value_from_longest (builtin_type_int, tmp);
}

static value_ptr
value_chill_max_min (enum exp_opcode op, value_ptr val)
{
  LONGEST tmp = 0;
  struct type *type = VALUE_TYPE (val);
  struct type *elttype;
  CHECK_TYPEDEF (type);

  if (TYPE_CODE (type) == TYPE_CODE_SET)
    {
      LONGEST lower_bound, upper_bound;
      int i, empty = 1;

      elttype = TYPE_INDEX_TYPE (type);
      CHECK_TYPEDEF (elttype);
      get_discrete_bounds (elttype, &lower_bound, &upper_bound);

      if (op == UNOP_CHMAX)
	{
	  for (i = upper_bound; i >= lower_bound; i--)
	    {
	      if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
		{
		  tmp = i;
		  empty = 0;
		  break;
		}
	    }
	}
      else
	{
	  for (i = lower_bound; i <= upper_bound; i++)
	    {
	      if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
		{
		  tmp = i;
		  empty = 0;
		  break;
		}
	    }
	}
      if (empty)
	error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
    }
  else
    error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");

  return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
			     ? TYPE_TARGET_TYPE (elttype)
			     : elttype,
			     tmp);
}

static value_ptr
evaluate_subexp_chill (struct type *expect_type,
		       register struct expression *exp, register int *pos,
		       enum noside noside)
{
  int pc = *pos;
  struct type *type;
  int tem, nargs;
  value_ptr arg1;
  value_ptr *argvec;
  enum exp_opcode op = exp->elts[*pos].opcode;
  switch (op)
    {
    case MULTI_SUBSCRIPT:
      if (noside == EVAL_SKIP)
	break;
      (*pos) += 3;
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      type = check_typedef (VALUE_TYPE (arg1));

      if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
	{
	  /* Looks like string repetition. */
	  value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
	  return value_concat (arg1, string);
	}

      switch (TYPE_CODE (type))
	{
	case TYPE_CODE_PTR:
	  type = check_typedef (TYPE_TARGET_TYPE (type));
	  if (!type || TYPE_CODE (type) != TYPE_CODE_FUNC)
	    error ("reference value used as function");
	  /* ... fall through ... */
	case TYPE_CODE_FUNC:
	  /* It's a function call. */
	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
	    break;

	  /* Allocate arg vector, including space for the function to be
	     called in argvec[0] and a terminating NULL */
	  argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
	  argvec[0] = arg1;
	  tem = 1;
	  for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
	    {
	      argvec[tem]
		= evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
					 exp, pos, noside);
	    }
	  for (; tem <= nargs; tem++)
	    argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
	  argvec[tem] = 0;	/* signal end of arglist */

	  return call_function_by_hand (argvec[0], nargs, argvec + 1);
	default:
	  break;
	}

      while (nargs-- > 0)
	{
	  value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
	  arg1 = value_subscript (arg1, index);
	}
      return (arg1);

    case UNOP_LOWER:
    case UNOP_UPPER:
      (*pos)++;
      if (noside == EVAL_SKIP)
	{
	  (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
	  goto nosideret;
	}
      arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
						  EVAL_AVOID_SIDE_EFFECTS);
      tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
      return value_from_longest (type, tem);

    case UNOP_LENGTH:
      (*pos)++;
      arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
      return value_chill_length (arg1);

    case UNOP_CARD:
      (*pos)++;
      arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
      return value_chill_card (arg1);

    case UNOP_CHMAX:
    case UNOP_CHMIN:
      (*pos)++;
      arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
      return value_chill_max_min (op, arg1);

    case BINOP_COMMA:
      error ("',' operator used in invalid context");

    default:
      break;
    }

  return evaluate_subexp_standard (expect_type, exp, pos, noside);
nosideret:
  return value_from_longest (builtin_type_long, (LONGEST) 1);
}

const struct language_defn chill_language_defn =
{
  "chill",
  language_chill,
  chill_builtin_types,
  range_check_on,
  type_check_on,
  case_sensitive_on,
  chill_parse,			/* parser */
  chill_error,			/* parser error function */
  evaluate_subexp_chill,
  chill_printchar,		/* print a character constant */
  chill_printstr,		/* function to print a string constant */
  NULL,				/* Function to print a single char */
  chill_create_fundamental_type,	/* Create fundamental type in this language */
  chill_print_type,		/* Print a type using appropriate syntax */
  chill_val_print,		/* Print a value using appropriate syntax */
  chill_value_print,		/* Print a top-levl value */
  {"", "B'", "", ""},		/* Binary format info */
  {"O'%lo", "O'", "o", ""},	/* Octal format info */
  {"D'%ld", "D'", "d", ""},	/* Decimal format info */
  {"H'%lx", "H'", "x", ""},	/* Hex format info */
  chill_op_print_tab,		/* expression operators for printing */
  0,				/* arrays are first-class (not c-style) */
  0,				/* String lower bound */
  &builtin_type_chill_char,	/* Type of string elements */
  LANG_MAGIC
};

/* Initialization for Chill */

void
_initialize_chill_language (void)
{
  builtin_type_chill_bool =
    init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "BOOL", (struct objfile *) NULL);
  builtin_type_chill_char =
    init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "CHAR", (struct objfile *) NULL);
  builtin_type_chill_long =
    init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
	       0,
	       "LONG", (struct objfile *) NULL);
  builtin_type_chill_ulong =
    init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
	       TYPE_FLAG_UNSIGNED,
	       "ULONG", (struct objfile *) NULL);
  builtin_type_chill_real =
    init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
	       0,
	       "LONG_REAL", (struct objfile *) NULL);

  add_language (&chill_language_defn);
}
Commit	Line	Data
c906108c	1	/* Chill language support routines for GDB, the GNU debugger.
b6ba6518 KB	2	Copyright 1992, 1993, 1994, 1995, 1996, 2000
b6ba6518 KB	3	Free Software Foundation, Inc.
c906108c	4
c5aa993b	5	This file is part of GDB.
c906108c	6
c5aa993b JM	7	This program is free software; you can redistribute it and/or modify
	8	it under the terms of the GNU General Public License as published by
	9	the Free Software Foundation; either version 2 of the License, or
	10	(at your option) any later version.
c906108c	11
c5aa993b JM	12	This program is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
c906108c	16
c5aa993b JM	17	You should have received a copy of the GNU General Public License
	18	along with this program; if not, write to the Free Software
	19	Foundation, Inc., 59 Temple Place - Suite 330,
	20	Boston, MA 02111-1307, USA. */
c906108c SS	21
	22	#include "defs.h"
	23	#include "symtab.h"
	24	#include "gdbtypes.h"
	25	#include "value.h"
	26	#include "expression.h"
	27	#include "parser-defs.h"
	28	#include "language.h"
	29	#include "ch-lang.h"
745b8ca0	30	#include "valprint.h"
c906108c	31
a14ed312	32	extern void _initialize_chill_language (void);
392a587b	33
c906108c	34	static value_ptr
a14ed312 KB	35	evaluate_subexp_chill (struct type , struct expression , int *,
a14ed312 KB	36	enum noside);
c906108c	37
a14ed312	38	static value_ptr value_chill_max_min (enum exp_opcode, value_ptr);
c906108c	39
a14ed312	40	static value_ptr value_chill_card (value_ptr);
c906108c	41
a14ed312	42	static value_ptr value_chill_length (value_ptr);
c906108c	43
a14ed312	44	static struct type chill_create_fundamental_type (struct objfile , int);
c906108c	45
d9fcf2fb JM	46	static void chill_printstr (struct ui_file * stream, char *string,
	47	unsigned int length, int width,
	48	int force_ellipses);
c906108c	49
d9fcf2fb	50	static void chill_printchar (int, struct ui_file *);
c906108c SS	51
	52	/* For now, Chill uses a simple mangling algorithm whereby you simply
	53	discard everything after the occurance of two successive CPLUS_MARKER
	54	characters to derive the demangled form. */
	55
	56	char *
fba45db2	57	chill_demangle (const char *mangled)
c906108c SS	58	{
	59	const char *joiner = NULL;
	60	char *demangled;
	61	const char *cp = mangled;
	62
	63	while (*cp)
	64	{
	65	if (is_cplus_marker (*cp))
	66	{
	67	joiner = cp;
	68	break;
	69	}
	70	cp++;
	71	}
	72	if (joiner != NULL && (joiner + 1) == joiner)
	73	{
	74	demangled = savestring (mangled, joiner - mangled);
	75	}
	76	else
	77	{
	78	demangled = NULL;
	79	}
	80	return (demangled);
	81	}
	82
	83	static void
fba45db2	84	chill_printchar (register int c, struct ui_file *stream)
c906108c SS	85	{
	86	c &= 0xFF; /* Avoid sign bit follies */
	87
	88	if (PRINT_LITERAL_FORM (c))
	89	{
	90	if (c == '\'' \|\| c == '^')
	91	fprintf_filtered (stream, "'%c%c'", c, c);
	92	else
	93	fprintf_filtered (stream, "'%c'", c);
	94	}
	95	else
	96	{
	97	fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
	98	}
	99	}
	100
	101	/* Print the character string STRING, printing at most LENGTH characters.
	102	Printing stops early if the number hits print_max; repeat counts
	103	are printed as appropriate. Print ellipses at the end if we
	104	had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
	105	Note that gdb maintains the length of strings without counting the
	106	terminating null byte, while chill strings are typically written with
	107	an explicit null byte. So we always assume an implied null byte
	108	until gdb is able to maintain non-null terminated strings as well
	109	as null terminated strings (FIXME).
c5aa993b	110	*/
c906108c SS	111
c906108c SS	112	static void
fba45db2 KB	113	chill_printstr (struct ui_file stream, char string, unsigned int length,
fba45db2 KB	114	int width, int force_ellipses)
c906108c SS	115	{
	116	register unsigned int i;
	117	unsigned int things_printed = 0;
	118	int in_literal_form = 0;
	119	int in_control_form = 0;
	120	int need_slashslash = 0;
	121	unsigned int c;
c906108c SS	122
	123	if (length == 0)
	124	{
	125	fputs_filtered ("\"\"", stream);
	126	return;
	127	}
	128
	129	for (i = 0; i < length && things_printed < print_max; ++i)
	130	{
	131	/* Position of the character we are examining
c5aa993b	132	to see whether it is repeated. */
c906108c SS	133	unsigned int rep1;
	134	/* Number of repetitions we have detected so far. */
	135	unsigned int reps;
	136
	137	QUIT;
	138
	139	if (need_slashslash)
	140	{
	141	fputs_filtered ("//", stream);
	142	need_slashslash = 0;
	143	}
	144
	145	rep1 = i + 1;
	146	reps = 1;
	147	while (rep1 < length && string[rep1] == string[i])
	148	{
	149	++rep1;
	150	++reps;
	151	}
	152
	153	c = string[i];
	154	if (reps > repeat_count_threshold)
	155	{
	156	if (in_control_form \|\| in_literal_form)
	157	{
	158	if (in_control_form)
	159	fputs_filtered (")", stream);
	160	fputs_filtered ("\"//", stream);
	161	in_control_form = in_literal_form = 0;
	162	}
	163	chill_printchar (c, stream);
	164	fprintf_filtered (stream, "<repeats %u times>", reps);
	165	i = rep1 - 1;
	166	things_printed += repeat_count_threshold;
	167	need_slashslash = 1;
	168	}
	169	else
	170	{
c5aa993b	171	if (!in_literal_form && !in_control_form)
c906108c SS	172	fputs_filtered ("\"", stream);
	173	if (PRINT_LITERAL_FORM (c))
	174	{
	175	if (!in_literal_form)
	176	{
	177	if (in_control_form)
	178	{
	179	fputs_filtered (")", stream);
	180	in_control_form = 0;
	181	}
	182	in_literal_form = 1;
	183	}
	184	fprintf_filtered (stream, "%c", c);
	185	if (c == '"' \|\| c == '^')
	186	/* duplicate this one as must be done at input */
	187	fprintf_filtered (stream, "%c", c);
	188	}
	189	else
	190	{
	191	if (!in_control_form)
	192	{
	193	if (in_literal_form)
	194	{
	195	in_literal_form = 0;
	196	}
	197	fputs_filtered ("^(", stream);
	198	in_control_form = 1;
	199	}
	200	else
	201	fprintf_filtered (stream, ",");
	202	c = c & 0xff;
	203	fprintf_filtered (stream, "%u", (unsigned int) c);
	204	}
	205	++things_printed;
	206	}
	207	}
	208
	209	/* Terminate the quotes if necessary. */
	210	if (in_control_form)
	211	{
	212	fputs_filtered (")", stream);
	213	}
	214	if (in_literal_form \|\| in_control_form)
	215	{
	216	fputs_filtered ("\"", stream);
	217	}
	218	if (force_ellipses \|\| (i < length))
	219	{
	220	fputs_filtered ("...", stream);
	221	}
	222	}
	223
	224	static struct type *
fba45db2	225	chill_create_fundamental_type (struct objfile *objfile, int typeid)
c906108c SS	226	{
	227	register struct type *type = NULL;
	228
	229	switch (typeid)
	230	{
c5aa993b JM	231	default:
	232	/* FIXME: For now, if we are asked to produce a type not in this
	233	language, create the equivalent of a C integer type with the
	234	name "<?type?>". When all the dust settles from the type
	235	reconstruction work, this should probably become an error. */
	236	type = init_type (TYPE_CODE_INT, 2, 0, "<?type?>", objfile);
	237	warning ("internal error: no chill fundamental type %d", typeid);
	238	break;
	239	case FT_VOID:
	240	/* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
	241	typedefs, unrelated to anything directly in the code being compiled,
	242	that have some FT_VOID types. Just fake it for now. */
	243	type = init_type (TYPE_CODE_VOID, 0, 0, "<?VOID?>", objfile);
	244	break;
	245	case FT_BOOLEAN:
	246	type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
	247	break;
	248	case FT_CHAR:
	249	type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
	250	break;
	251	case FT_SIGNED_CHAR:
	252	type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
	253	break;
	254	case FT_UNSIGNED_CHAR:
	255	type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
	256	break;
	257	case FT_SHORT: /* Chill ints are 2 bytes */
	258	type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
	259	break;
	260	case FT_UNSIGNED_SHORT: /* Chill ints are 2 bytes */
	261	type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
	262	break;
	263	case FT_INTEGER: /* FIXME? */
	264	case FT_SIGNED_INTEGER: /* FIXME? */
	265	case FT_LONG: /* Chill longs are 4 bytes */
	266	case FT_SIGNED_LONG: /* Chill longs are 4 bytes */
	267	type = init_type (TYPE_CODE_INT, 4, 0, "LONG", objfile);
	268	break;
	269	case FT_UNSIGNED_INTEGER: /* FIXME? */
	270	case FT_UNSIGNED_LONG: /* Chill longs are 4 bytes */
	271	type = init_type (TYPE_CODE_INT, 4, TYPE_FLAG_UNSIGNED, "ULONG", objfile);
	272	break;
	273	case FT_FLOAT:
	274	type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
	275	break;
	276	case FT_DBL_PREC_FLOAT:
	277	type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
	278	break;
	279	}
c906108c SS	280	return (type);
c906108c SS	281	}
c906108c	282	\f
c5aa993b	283
c906108c SS	284	/* Table of operators and their precedences for printing expressions. */
c906108c SS	285
c5aa993b JM	286	static const struct op_print chill_op_print_tab[] =
	287	{
	288	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	289	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	290	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
	291	{"MOD", BINOP_MOD, PREC_MUL, 0},
	292	{"REM", BINOP_REM, PREC_MUL, 0},
	293	{"SIZE", UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
	294	{"LOWER", UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
	295	{"UPPER", UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
	296	{"CARD", UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
	297	{"MAX", UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
	298	{"MIN", UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
	299	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	300	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	301	{"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	302	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	303	{">=", BINOP_GEQ, PREC_ORDER, 0},
	304	{">", BINOP_GTR, PREC_ORDER, 0},
	305	{"<", BINOP_LESS, PREC_ORDER, 0},
	306	{"+", BINOP_ADD, PREC_ADD, 0},
	307	{"-", BINOP_SUB, PREC_ADD, 0},
	308	{"*", BINOP_MUL, PREC_MUL, 0},
	309	{"/", BINOP_DIV, PREC_MUL, 0},
	310	{"//", BINOP_CONCAT, PREC_PREFIX, 0}, /* FIXME: precedence? */
	311	{"-", UNOP_NEG, PREC_PREFIX, 0},
	312	{"->", UNOP_IND, PREC_SUFFIX, 1},
	313	{"->", UNOP_ADDR, PREC_PREFIX, 0},
	314	{":", BINOP_RANGE, PREC_ASSIGN, 0},
	315	{NULL, 0, 0, 0}
c906108c SS	316	};
	317	\f
	318	/* The built-in types of Chill. */
	319
	320	struct type *builtin_type_chill_bool;
	321	struct type *builtin_type_chill_char;
	322	struct type *builtin_type_chill_long;
	323	struct type *builtin_type_chill_ulong;
	324	struct type *builtin_type_chill_real;
	325
c5aa993b	326	struct type **CONST_PTR (chill_builtin_types[]) =
c906108c SS	327	{
c906108c SS	328	&builtin_type_chill_bool,
c5aa993b JM	329	&builtin_type_chill_char,
	330	&builtin_type_chill_long,
	331	&builtin_type_chill_ulong,
	332	&builtin_type_chill_real,
	333	0
c906108c SS	334	};
	335
	336	/* Calculate LOWER or UPPER of TYPE.
	337	Returns the result as an integer.
	338	RESULT_TYPE is the appropriate type for the result. /
	339
	340	LONGEST
fba45db2 KB	341	type_lower_upper (enum exp_opcode op, /* Either UNOP_LOWER or UNOP_UPPER */
fba45db2 KB	342	struct type type, struct type *result_type)
c906108c SS	343	{
	344	LONGEST low, high;
	345	*result_type = type;
	346	CHECK_TYPEDEF (type);
	347	switch (TYPE_CODE (type))
	348	{
	349	case TYPE_CODE_STRUCT:
	350	*result_type = builtin_type_int;
	351	if (chill_varying_type (type))
	352	return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
	353	break;
	354	case TYPE_CODE_ARRAY:
	355	case TYPE_CODE_BITSTRING:
	356	case TYPE_CODE_STRING:
c5aa993b	357	type = TYPE_FIELD_TYPE (type, 0); /* Get index type */
c906108c SS	358
	359	/* ... fall through ... */
	360	case TYPE_CODE_RANGE:
	361	*result_type = TYPE_TARGET_TYPE (type);
	362	return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
	363
	364	case TYPE_CODE_ENUM:
	365	case TYPE_CODE_BOOL:
	366	case TYPE_CODE_INT:
	367	case TYPE_CODE_CHAR:
	368	if (get_discrete_bounds (type, &low, &high) >= 0)
	369	{
	370	*result_type = type;
	371	return op == UNOP_LOWER ? low : high;
	372	}
	373	break;
	374	case TYPE_CODE_UNDEF:
	375	case TYPE_CODE_PTR:
	376	case TYPE_CODE_UNION:
	377	case TYPE_CODE_FUNC:
	378	case TYPE_CODE_FLT:
	379	case TYPE_CODE_VOID:
	380	case TYPE_CODE_SET:
	381	case TYPE_CODE_ERROR:
	382	case TYPE_CODE_MEMBER:
	383	case TYPE_CODE_METHOD:
	384	case TYPE_CODE_REF:
	385	case TYPE_CODE_COMPLEX:
	386	default:
	387	break;
	388	}
	389	error ("unknown mode for LOWER/UPPER builtin");
	390	}
	391
	392	static value_ptr
fba45db2	393	value_chill_length (value_ptr val)
c906108c SS	394	{
	395	LONGEST tmp;
	396	struct type *type = VALUE_TYPE (val);
	397	struct type *ttype;
	398	CHECK_TYPEDEF (type);
	399	switch (TYPE_CODE (type))
	400	{
	401	case TYPE_CODE_ARRAY:
	402	case TYPE_CODE_BITSTRING:
	403	case TYPE_CODE_STRING:
	404	tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
	405	- type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
	406	break;
	407	case TYPE_CODE_STRUCT:
	408	if (chill_varying_type (type))
	409	{
	410	tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
	411	break;
	412	}
	413	/* ... else fall through ... */
	414	default:
	415	error ("bad argument to LENGTH builtin");
	416	}
	417	return value_from_longest (builtin_type_int, tmp);
	418	}
	419
	420	static value_ptr
fba45db2	421	value_chill_card (value_ptr val)
c906108c SS	422	{
	423	LONGEST tmp = 0;
	424	struct type *type = VALUE_TYPE (val);
	425	CHECK_TYPEDEF (type);
	426
	427	if (TYPE_CODE (type) == TYPE_CODE_SET)
	428	{
	429	struct type *range_type = TYPE_INDEX_TYPE (type);
	430	LONGEST lower_bound, upper_bound;
	431	int i;
	432
	433	get_discrete_bounds (range_type, &lower_bound, &upper_bound);
	434	for (i = lower_bound; i <= upper_bound; i++)
	435	if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
	436	tmp++;
	437	}
	438	else
	439	error ("bad argument to CARD builtin");
	440
	441	return value_from_longest (builtin_type_int, tmp);
	442	}
	443
	444	static value_ptr
fba45db2	445	value_chill_max_min (enum exp_opcode op, value_ptr val)
c906108c SS	446	{
	447	LONGEST tmp = 0;
	448	struct type *type = VALUE_TYPE (val);
	449	struct type *elttype;
	450	CHECK_TYPEDEF (type);
	451
	452	if (TYPE_CODE (type) == TYPE_CODE_SET)
	453	{
	454	LONGEST lower_bound, upper_bound;
	455	int i, empty = 1;
	456
	457	elttype = TYPE_INDEX_TYPE (type);
	458	CHECK_TYPEDEF (elttype);
	459	get_discrete_bounds (elttype, &lower_bound, &upper_bound);
	460
	461	if (op == UNOP_CHMAX)
	462	{
	463	for (i = upper_bound; i >= lower_bound; i--)
	464	{
	465	if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
	466	{
	467	tmp = i;
	468	empty = 0;
	469	break;
	470	}
	471	}
	472	}
	473	else
	474	{
	475	for (i = lower_bound; i <= upper_bound; i++)
	476	{
	477	if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
	478	{
	479	tmp = i;
	480	empty = 0;
	481	break;
	482	}
	483	}
	484	}
	485	if (empty)
	486	error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
	487	}
	488	else
	489	error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
	490
	491	return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
c5aa993b JM	492	? TYPE_TARGET_TYPE (elttype)
c5aa993b JM	493	: elttype,
c906108c SS	494	tmp);
	495	}
	496
	497	static value_ptr
fba45db2 KB	498	evaluate_subexp_chill (struct type *expect_type,
	499	register struct expression exp, register int pos,
	500	enum noside noside)
c906108c SS	501	{
	502	int pc = *pos;
	503	struct type *type;
	504	int tem, nargs;
	505	value_ptr arg1;
	506	value_ptr *argvec;
	507	enum exp_opcode op = exp->elts[*pos].opcode;
	508	switch (op)
	509	{
	510	case MULTI_SUBSCRIPT:
	511	if (noside == EVAL_SKIP)
	512	break;
	513	(*pos) += 3;
	514	nargs = longest_to_int (exp->elts[pc + 1].longconst);
	515	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	516	type = check_typedef (VALUE_TYPE (arg1));
	517
	518	if (nargs == 1 && TYPE_CODE (type) == TYPE_CODE_INT)
	519	{
	520	/* Looks like string repetition. */
	521	value_ptr string = evaluate_subexp_with_coercion (exp, pos, noside);
	522	return value_concat (arg1, string);
	523	}
	524
	525	switch (TYPE_CODE (type))
	526	{
	527	case TYPE_CODE_PTR:
	528	type = check_typedef (TYPE_TARGET_TYPE (type));
	529	if (!type \|\| TYPE_CODE (type) != TYPE_CODE_FUNC)
	530	error ("reference value used as function");
	531	/* ... fall through ... */
	532	case TYPE_CODE_FUNC:
	533	/* It's a function call. */
	534	if (noside == EVAL_AVOID_SIDE_EFFECTS)
	535	break;
	536
	537	/* Allocate arg vector, including space for the function to be
	538	called in argvec[0] and a terminating NULL */
	539	argvec = (value_ptr ) alloca (sizeof (value_ptr) (nargs + 2));
	540	argvec[0] = arg1;
	541	tem = 1;
	542	for (; tem <= nargs && tem <= TYPE_NFIELDS (type); tem++)
	543	{
	544	argvec[tem]
c5aa993b	545	= evaluate_subexp_chill (TYPE_FIELD_TYPE (type, tem - 1),
c906108c SS	546	exp, pos, noside);
	547	}
	548	for (; tem <= nargs; tem++)
	549	argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
c5aa993b	550	argvec[tem] = 0; /* signal end of arglist */
c906108c SS	551
	552	return call_function_by_hand (argvec[0], nargs, argvec + 1);
	553	default:
	554	break;
	555	}
	556
	557	while (nargs-- > 0)
	558	{
	559	value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
	560	arg1 = value_subscript (arg1, index);
	561	}
	562	return (arg1);
	563
	564	case UNOP_LOWER:
	565	case UNOP_UPPER:
	566	(*pos)++;
	567	if (noside == EVAL_SKIP)
	568	{
	569	(*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
	570	goto nosideret;
	571	}
	572	arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
	573	EVAL_AVOID_SIDE_EFFECTS);
	574	tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
	575	return value_from_longest (type, tem);
	576
	577	case UNOP_LENGTH:
	578	(*pos)++;
	579	arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
	580	return value_chill_length (arg1);
	581
	582	case UNOP_CARD:
	583	(*pos)++;
	584	arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
	585	return value_chill_card (arg1);
	586
	587	case UNOP_CHMAX:
	588	case UNOP_CHMIN:
	589	(*pos)++;
	590	arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
	591	return value_chill_max_min (op, arg1);
	592
	593	case BINOP_COMMA:
	594	error ("',' operator used in invalid context");
	595
	596	default:
	597	break;
	598	}
	599
	600	return evaluate_subexp_standard (expect_type, exp, pos, noside);
c5aa993b	601	nosideret:
c906108c SS	602	return value_from_longest (builtin_type_long, (LONGEST) 1);
	603	}
	604
c5aa993b JM	605	const struct language_defn chill_language_defn =
c5aa993b JM	606	{
c906108c SS	607	"chill",
	608	language_chill,
	609	chill_builtin_types,
	610	range_check_on,
	611	type_check_on,
63872f9d	612	case_sensitive_on,
c906108c SS	613	chill_parse, /* parser */
	614	chill_error, /* parser error function */
	615	evaluate_subexp_chill,
	616	chill_printchar, /* print a character constant */
	617	chill_printstr, /* function to print a string constant */
	618	NULL, /* Function to print a single char */
c5aa993b	619	chill_create_fundamental_type, /* Create fundamental type in this language */
c906108c SS	620	chill_print_type, /* Print a type using appropriate syntax */
	621	chill_val_print, /* Print a value using appropriate syntax */
	622	chill_value_print, /* Print a top-levl value */
c5aa993b JM	623	{"", "B'", "", ""}, /* Binary format info */
	624	{"O'%lo", "O'", "o", ""}, /* Octal format info */
	625	{"D'%ld", "D'", "d", ""}, /* Decimal format info */
	626	{"H'%lx", "H'", "x", ""}, /* Hex format info */
c906108c SS	627	chill_op_print_tab, /* expression operators for printing */
	628	0, /* arrays are first-class (not c-style) */
	629	0, /* String lower bound */
c5aa993b	630	&builtin_type_chill_char, /* Type of string elements */
c906108c SS	631	LANG_MAGIC
	632	};
	633
	634	/* Initialization for Chill */
	635
	636	void
fba45db2	637	_initialize_chill_language (void)
c906108c SS	638	{
	639	builtin_type_chill_bool =
	640	init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	641	TYPE_FLAG_UNSIGNED,
	642	"BOOL", (struct objfile *) NULL);
	643	builtin_type_chill_char =
	644	init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	645	TYPE_FLAG_UNSIGNED,
	646	"CHAR", (struct objfile *) NULL);
	647	builtin_type_chill_long =
	648	init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
	649	0,
	650	"LONG", (struct objfile *) NULL);
	651	builtin_type_chill_ulong =
	652	init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
	653	TYPE_FLAG_UNSIGNED,
	654	"ULONG", (struct objfile *) NULL);
	655	builtin_type_chill_real =
	656	init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
	657	0,
	658	"LONG_REAL", (struct objfile *) NULL);
	659
	660	add_language (&chill_language_defn);
	661	}