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

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

extern void _initialize_chill_language PARAMS ((void));

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

static value_ptr
  value_chill_max_min PARAMS ((enum exp_opcode, value_ptr));

static value_ptr
  value_chill_card PARAMS ((value_ptr));

static value_ptr
  value_chill_length PARAMS ((value_ptr));

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

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

static void
chill_printchar PARAMS ((int, GDB_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 (mangled)
     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 (c, stream)
     register int c;
     GDB_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 (stream, string, length, width, force_ellipses)
     GDB_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;
  extern int repeat_count_threshold;
  extern int print_max;

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