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

/* Chill language support routines for GDB, the GNU debugger.
   Copyright 1992, 1993, 1994, 1995, 1996, 2000, 2001, 2002
   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 struct value *evaluate_subexp_chill (struct type *, struct expression *,
					    int *, enum noside);

static struct value *value_chill_max_min (enum exp_opcode, struct value *);

static struct value *value_chill_card (struct value *);

static struct value *value_chill_length (struct value *);

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