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

/* Chill language support routines for GDB, the GNU debugger.
   Copyright 1992 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., 675 Mass Ave, Cambridge, MA 02139, 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;
{
  char *joiner;
  char *demangled;

  joiner = strchr (mangled, CPLUS_MARKER);
  if (joiner != NULL && *(joiner + 1) == CPLUS_MARKER)
    {
      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))
    {
      fprintf_filtered (stream, "'%c'", c);
    }
  else
    {
      fprintf_filtered (stream, "C'%.2x'", (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)
	    {
	      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 (PRINT_LITERAL_FORM (c))
	    {
	      if (!in_literal_form)
		{
		  if (in_control_form)
		    {
		      fputs_filtered ("\"//", stream);
		      in_control_form = 0;
		    }
		  fputs_filtered ("\"", stream);
		  in_literal_form = 1;
		}
	      fprintf_filtered (stream, "%c", c);
	    }
	  else
	    {
	      if (!in_control_form)
		{
		  if (in_literal_form)
		    {
		      fputs_filtered ("\"//", stream);
		      in_literal_form = 0;
		    }
		  fputs_filtered ("c\"", stream);
		  in_control_form = 1;
		}
	      fprintf_filtered (stream, "%.2x", c);
	    }
	  ++things_printed;
	}
    }

  /* Terminate the quotes if necessary.  */
  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},
    {":=",  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},
    {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
};

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;
  int tem, nargs;
  value_ptr arg1;
  value_ptr *argvec;
  switch (exp->elts[*pos].opcode)
    {
    case MULTI_SUBSCRIPT:
      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
	break;
      (*pos) += 3;
      nargs = longest_to_int (exp->elts[pc + 1].longconst);
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);

      switch (TYPE_CODE (VALUE_TYPE (arg1)))
	{
	case TYPE_CODE_PTR:
	case TYPE_CODE_FUNC:
	  /* It's a function call. */
	  /* 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++)
	    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);
    default:
      break;
    }

  return evaluate_subexp_standard (expect_type, exp, pos, noside);
}

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 FF	1	/* Chill language support routines for GDB, the GNU debugger.
	2	Copyright 1992 Free Software Foundation, Inc.
	3
	4	This file is part of GDB.
	5
	6	This program is free software; you can redistribute it and/or modify
	7	it under the terms of the GNU General Public License as published by
	8	the Free Software Foundation; either version 2 of the License, or
	9	(at your option) any later version.
	10
	11	This program is distributed in the hope that it will be useful,
	12	but WITHOUT ANY WARRANTY; without even the implied warranty of
	13	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	GNU General Public License for more details.
	15
	16	You should have received a copy of the GNU General Public License
	17	along with this program; if not, write to the Free Software
	18	Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
	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	{
	38	char *joiner;
	39	char *demangled;
	40
	41	joiner = strchr (mangled, CPLUS_MARKER);
	42	if (joiner != NULL && *(joiner + 1) == CPLUS_MARKER)
	43	{
	44	demangled = savestring (mangled, joiner - mangled);
	45	}
	46	else
	47	{
	48	demangled = NULL;
	49	}
	50	return (demangled);
	51	}
	52
22e39759 FF	53	static void
	54	chill_printchar (c, stream)
	55	register int c;
199b2450	56	GDB_FILE *stream;
22e39759 FF	57	{
	58	c &= 0xFF; /* Avoid sign bit follies */
	59
	60	if (PRINT_LITERAL_FORM (c))
	61	{
	62	fprintf_filtered (stream, "'%c'", c);
	63	}
	64	else
	65	{
	66	fprintf_filtered (stream, "C'%.2x'", (unsigned int) c);
	67	}
	68	}
	69
	70	/* Print the character string STRING, printing at most LENGTH characters.
	71	Printing stops early if the number hits print_max; repeat counts
	72	are printed as appropriate. Print ellipses at the end if we
	73	had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
	74	Note that gdb maintains the length of strings without counting the
	75	terminating null byte, while chill strings are typically written with
	76	an explicit null byte. So we always assume an implied null byte
	77	until gdb is able to maintain non-null terminated strings as well
	78	as null terminated strings (FIXME).
	79	*/
	80
	81	static void
	82	chill_printstr (stream, string, length, force_ellipses)
199b2450	83	GDB_FILE *stream;
22e39759 FF	84	char *string;
	85	unsigned int length;
	86	int force_ellipses;
	87	{
	88	register unsigned int i;
	89	unsigned int things_printed = 0;
	90	int in_literal_form = 0;
	91	int in_control_form = 0;
	92	int need_slashslash = 0;
	93	unsigned int c;
	94	extern int repeat_count_threshold;
	95	extern int print_max;
	96
	97	if (length == 0)
	98	{
96b6b765	99	fputs_filtered ("\"\"", stream);
22e39759 FF	100	return;
	101	}
	102
	103	for (i = 0; i < length && things_printed < print_max; ++i)
	104	{
	105	/* Position of the character we are examining
	106	to see whether it is repeated. */
	107	unsigned int rep1;
	108	/* Number of repetitions we have detected so far. */
	109	unsigned int reps;
	110
	111	QUIT;
	112
	113	if (need_slashslash)
	114	{
	115	fputs_filtered ("//", stream);
	116	need_slashslash = 0;
	117	}
	118
	119	rep1 = i + 1;
	120	reps = 1;
	121	while (rep1 < length && string[rep1] == string[i])
	122	{
	123	++rep1;
	124	++reps;
	125	}
	126
	127	c = string[i];
	128	if (reps > repeat_count_threshold)
	129	{
	130	if (in_control_form \|\| in_literal_form)
	131	{
cba00921	132	fputs_filtered ("\"//", stream);
22e39759 FF	133	in_control_form = in_literal_form = 0;
	134	}
	135	chill_printchar (c, stream);
	136	fprintf_filtered (stream, "<repeats %u times>", reps);
	137	i = rep1 - 1;
	138	things_printed += repeat_count_threshold;
	139	need_slashslash = 1;
	140	}
	141	else
	142	{
	143	if (PRINT_LITERAL_FORM (c))
	144	{
	145	if (!in_literal_form)
	146	{
	147	if (in_control_form)
	148	{
cba00921	149	fputs_filtered ("\"//", stream);
22e39759 FF	150	in_control_form = 0;
22e39759 FF	151	}
cba00921	152	fputs_filtered ("\"", stream);
22e39759 FF	153	in_literal_form = 1;
	154	}
	155	fprintf_filtered (stream, "%c", c);
	156	}
	157	else
	158	{
	159	if (!in_control_form)
	160	{
	161	if (in_literal_form)
	162	{
cba00921	163	fputs_filtered ("\"//", stream);
22e39759 FF	164	in_literal_form = 0;
22e39759 FF	165	}
cba00921	166	fputs_filtered ("c\"", stream);
22e39759 FF	167	in_control_form = 1;
	168	}
	169	fprintf_filtered (stream, "%.2x", c);
	170	}
	171	++things_printed;
	172	}
	173	}
	174
	175	/* Terminate the quotes if necessary. */
	176	if (in_literal_form \|\| in_control_form)
	177	{
cba00921	178	fputs_filtered ("\"", stream);
22e39759 FF	179	}
	180	if (force_ellipses \|\| (i < length))
	181	{
	182	fputs_filtered ("...", stream);
	183	}
	184	}
	185
	186	static struct type *
	187	chill_create_fundamental_type (objfile, typeid)
	188	struct objfile *objfile;
	189	int typeid;
	190	{
	191	register struct type *type = NULL;
22e39759 FF	192
	193	switch (typeid)
	194	{
	195	default:
	196	/* FIXME: For now, if we are asked to produce a type not in this
	197	language, create the equivalent of a C integer type with the
	198	name "<?type?>". When all the dust settles from the type
	199	reconstruction work, this should probably become an error. */
a8a69e63	200	type = init_type (TYPE_CODE_INT, 2, 0, "<?type?>", objfile);
22e39759 FF	201	warning ("internal error: no chill fundamental type %d", typeid);
22e39759 FF	202	break;
a8a69e63 FF	203	case FT_VOID:
	204	/* FIXME: Currently the GNU Chill compiler emits some DWARF entries for
	205	typedefs, unrelated to anything directly in the code being compiled,
	206	that have some FT_VOID types. Just fake it for now. */
	207	type = init_type (TYPE_CODE_VOID, 0, 0, "<?VOID?>", objfile);
	208	break;
22e39759 FF	209	case FT_BOOLEAN:
	210	type = init_type (TYPE_CODE_BOOL, 1, TYPE_FLAG_UNSIGNED, "BOOL", objfile);
	211	break;
	212	case FT_CHAR:
a8a69e63	213	type = init_type (TYPE_CODE_CHAR, 1, TYPE_FLAG_UNSIGNED, "CHAR", objfile);
22e39759 FF	214	break;
22e39759 FF	215	case FT_SIGNED_CHAR:
dda398c3	216	type = init_type (TYPE_CODE_INT, 1, 0, "BYTE", objfile);
22e39759 FF	217	break;
	218	case FT_UNSIGNED_CHAR:
	219	type = init_type (TYPE_CODE_INT, 1, TYPE_FLAG_UNSIGNED, "UBYTE", objfile);
	220	break;
	221	case FT_SHORT: /* Chill ints are 2 bytes */
dda398c3	222	type = init_type (TYPE_CODE_INT, 2, 0, "INT", objfile);
22e39759 FF	223	break;
	224	case FT_UNSIGNED_SHORT: /* Chill ints are 2 bytes */
	225	type = init_type (TYPE_CODE_INT, 2, TYPE_FLAG_UNSIGNED, "UINT", objfile);
	226	break;
b6236d6e FF	227	case FT_INTEGER: /* FIXME? */
	228	case FT_SIGNED_INTEGER: /* FIXME? */
	229	case FT_LONG: /* Chill longs are 4 bytes */
	230	case FT_SIGNED_LONG: /* Chill longs are 4 bytes */
dda398c3	231	type = init_type (TYPE_CODE_INT, 4, 0, "LONG", objfile);
22e39759	232	break;
b6236d6e FF	233	case FT_UNSIGNED_INTEGER: /* FIXME? */
b6236d6e FF	234	case FT_UNSIGNED_LONG: /* Chill longs are 4 bytes */
22e39759 FF	235	type = init_type (TYPE_CODE_INT, 4, TYPE_FLAG_UNSIGNED, "ULONG", objfile);
	236	break;
	237	case FT_FLOAT:
	238	type = init_type (TYPE_CODE_FLT, 4, 0, "REAL", objfile);
	239	break;
	240	case FT_DBL_PREC_FLOAT:
	241	type = init_type (TYPE_CODE_FLT, 8, 0, "LONG_REAL", objfile);
	242	break;
	243	}
	244	return (type);
	245	}
	246
	247	\f
	248	/* Table of operators and their precedences for printing expressions. */
	249
a8a69e63	250	static const struct op_print chill_op_print_tab[] = {
22e39759 FF	251	{"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
	252	{"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
	253	{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
76a0ffb4 FF	254	{"MOD", BINOP_MOD, PREC_MUL, 0},
76a0ffb4 FF	255	{"REM", BINOP_REM, PREC_MUL, 0},
22e39759 FF	256	{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
	257	{"=", BINOP_EQUAL, PREC_EQUAL, 0},
	258	{"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
	259	{"<=", BINOP_LEQ, PREC_ORDER, 0},
	260	{">=", BINOP_GEQ, PREC_ORDER, 0},
	261	{">", BINOP_GTR, PREC_ORDER, 0},
	262	{"<", BINOP_LESS, PREC_ORDER, 0},
	263	{"+", BINOP_ADD, PREC_ADD, 0},
	264	{"-", BINOP_SUB, PREC_ADD, 0},
	265	{"*", BINOP_MUL, PREC_MUL, 0},
	266	{"/", BINOP_DIV, PREC_MUL, 0},
fcbadaee	267	{"//", BINOP_CONCAT, PREC_PREFIX, 0}, /* FIXME: precedence? */
22e39759	268	{"-", UNOP_NEG, PREC_PREFIX, 0},
bdef6b60 PB	269	{"->", UNOP_IND, PREC_SUFFIX, 1},
bdef6b60 PB	270	{"->", UNOP_ADDR, PREC_PREFIX, 0},
22e39759 FF	271	{NULL, 0, 0, 0}
22e39759 FF	272	};
22e39759 FF	273	\f
	274	/* The built-in types of Chill. */
	275
	276	struct type *builtin_type_chill_bool;
	277	struct type *builtin_type_chill_char;
	278	struct type *builtin_type_chill_long;
	279	struct type *builtin_type_chill_ulong;
	280	struct type *builtin_type_chill_real;
	281
	282	struct type ** const (chill_builtin_types[]) =
	283	{
	284	&builtin_type_chill_bool,
	285	&builtin_type_chill_char,
	286	&builtin_type_chill_long,
	287	&builtin_type_chill_ulong,
	288	&builtin_type_chill_real,
	289	0
	290	};
	291
7398958c PB	292	static value_ptr
	293	evaluate_subexp_chill (expect_type, exp, pos, noside)
	294	struct type *expect_type;
	295	register struct expression *exp;
	296	register int *pos;
	297	enum noside noside;
	298	{
	299	int pc = *pos;
	300	int tem, nargs;
	301	value_ptr arg1;
	302	value_ptr *argvec;
	303	switch (exp->elts[*pos].opcode)
	304	{
	305	case MULTI_SUBSCRIPT:
	306	if (noside == EVAL_SKIP \|\| noside == EVAL_AVOID_SIDE_EFFECTS)
	307	break;
	308	(*pos) += 3;
	309	nargs = longest_to_int (exp->elts[pc + 1].longconst);
	310	arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
	311
	312	switch (TYPE_CODE (VALUE_TYPE (arg1)))
	313	{
	314	case TYPE_CODE_PTR:
	315	case TYPE_CODE_FUNC:
	316	/* It's a function call. */
	317	/* Allocate arg vector, including space for the function to be
	318	called in argvec[0] and a terminating NULL */
	319	argvec = (value_ptr ) alloca (sizeof (value_ptr) (nargs + 2));
	320	argvec[0] = arg1;
	321	tem = 1;
	322	for (; tem <= nargs; tem++)
	323	argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
	324	argvec[tem] = 0; /* signal end of arglist */
	325
	326	return call_function_by_hand (argvec[0], nargs, argvec + 1);
18d3d859 JK	327	default:
18d3d859 JK	328	break;
7398958c PB	329	}
	330
	331	while (nargs-- > 0)
	332	{
	333	value_ptr index = evaluate_subexp_with_coercion (exp, pos, noside);
	334	arg1 = value_subscript (arg1, index);
	335	}
	336	return (arg1);
18d3d859 JK	337	default:
18d3d859 JK	338	break;
7398958c PB	339	}
	340
	341	return evaluate_subexp_standard (expect_type, exp, pos, noside);
	342	}
	343
22e39759 FF	344	const struct language_defn chill_language_defn = {
	345	"chill",
	346	language_chill,
	347	chill_builtin_types,
	348	range_check_on,
	349	type_check_on,
	350	chill_parse, /* parser */
	351	chill_error, /* parser error function */
7398958c	352	evaluate_subexp_chill,
22e39759 FF	353	chill_printchar, /* print a character constant */
	354	chill_printstr, /* function to print a string constant */
	355	chill_create_fundamental_type,/* Create fundamental type in this language */
a8a69e63 FF	356	chill_print_type, /* Print a type using appropriate syntax */
a8a69e63 FF	357	chill_val_print, /* Print a value using appropriate syntax */
e10cfcaa	358	chill_value_print, /* Print a top-levl value */
22e39759	359	{"", "B'", "", ""}, /* Binary format info */
5573d7d4 JK	360	{"O'%lo", "O'", "o", ""}, /* Octal format info */
	361	{"D'%ld", "D'", "d", ""}, /* Decimal format info */
	362	{"H'%lx", "H'", "x", ""}, /* Hex format info */
22e39759	363	chill_op_print_tab, /* expression operators for printing */
acc4efde	364	0, /* arrays are first-class (not c-style) */
ead95f8a PB	365	0, /* String lower bound */
ead95f8a PB	366	&builtin_type_chill_char, /* Type of string elements */
22e39759 FF	367	LANG_MAGIC
	368	};
	369
	370	/* Initialization for Chill */
	371
	372	void
d62e7a20	373	_initialize_chill_language ()
22e39759 FF	374	{
	375	builtin_type_chill_bool =
	376	init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	377	TYPE_FLAG_UNSIGNED,
	378	"BOOL", (struct objfile *) NULL);
	379	builtin_type_chill_char =
	380	init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
	381	TYPE_FLAG_UNSIGNED,
	382	"CHAR", (struct objfile *) NULL);
	383	builtin_type_chill_long =
	384	init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
	385	0,
	386	"LONG", (struct objfile *) NULL);
	387	builtin_type_chill_ulong =
	388	init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
	389	TYPE_FLAG_UNSIGNED,
	390	"ULONG", (struct objfile *) NULL);
	391	builtin_type_chill_real =
	392	init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
	393	0,
	394	"LONG_REAL", (struct objfile *) NULL);
	395
	396	add_language (&chill_language_defn);
	397	}