[deliverable/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"


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