* ch-exp.y (value_string_element, string_primitive_value,

start_element, left_element, right_element, slice_size,
	lower_element, upper_element, first_element):  Removed.
	(value_string_slice, value_array_slice):  Replaced by ...
	(slice):  New non-terminal, with working slice support.
	(primitive_value_lparen, rparen):  New non-terminals.
	(maybe_tuple_elements):  New non-terminal, to allow empty tuples.
	(idtokentab):  Added "up".

	* value.h (COERCE_VARYING_ARRAY):  New macro.
	* valarith.c (value_subscript):  Use it.
	* valops.c (value_cast):  Likewise.  Also, do nothing if already
	correct type, and allow converting from/to range to/from scalar.

	* valops.c, value.h (varying_to_slice, value_slice):  New functions.
	* eval.c (OP_ARRAY):  Add cast for array element.
	* expression.h (TERNOP_SLICE, TERNOP_SLICE_COUNT):  New exp_opcodes.
	* valops.c (chill_varying_type):  Moved function frp, here ...
	* gdbtypes.c (chill_varying_type), gdbtypes.h: ... to here.
	* parse.c (length_of_subexp, prefixify_subexp):  Add support
	for TERNOP_SLICE, TERNOP_SLICE_COUNT.
	* expprint.c (print_subexp, dump_expression):  Likewise.
	* eval.c (evaluate_subexp):  Likewise.

	* eval.c (evaluate_subexp case MULTI_SUBSCRIPT):  Don't call
	value_x_binop on a Chill varying string.

gdb/ChangeLog

@@ -1,3 +1,32 @@
+Wed Feb  1 12:23:57 1995  Per Bothner  <bothner@kalessin.cygnus.com>
+
+	* ch-exp.y (value_string_element, string_primitive_value,
+	start_element, left_element, right_element, slice_size,
+	lower_element, upper_element, first_element):  Removed.
+	(value_string_slice, value_array_slice):  Replaced by ...
+	(slice):  New non-terminal, with working slice support.
+	(primitive_value_lparen, rparen):  New non-terminals.
+	(maybe_tuple_elements):  New non-terminal, to allow empty tuples.
+	(idtokentab):  Added "up".
+
+	* value.h (COERCE_VARYING_ARRAY):  New macro.
+	* valarith.c (value_subscript):  Use it.
+	* valops.c (value_cast):  Likewise.  Also, do nothing if already
+	correct type, and allow converting from/to range to/from scalar.
+
+	* valops.c, value.h (varying_to_slice, value_slice):  New functions.
+	* eval.c (OP_ARRAY):  Add cast for array element.
+	* expression.h (TERNOP_SLICE, TERNOP_SLICE_COUNT):  New exp_opcodes.
+	* valops.c (chill_varying_type):  Moved function frp, here ...
+	* gdbtypes.c (chill_varying_type), gdbtypes.h: ... to here.
+	* parse.c (length_of_subexp, prefixify_subexp):  Add support
+	for TERNOP_SLICE, TERNOP_SLICE_COUNT.
+	* expprint.c (print_subexp, dump_expression):  Likewise.
+	* eval.c (evaluate_subexp):  Likewise.
+
+	* eval.c (evaluate_subexp case MULTI_SUBSCRIPT):  Don't call
+	value_x_binop on a Chill varying string.
+
 Tue Jan 31 13:51:53 1995  Jim Kingdon  (kingdon@lioth.cygnus.com)
 
 	* config/m68k/monitor.mt,

gdb/ch-exp.y

@@ -252,9 +252,7 @@ yyerror PARAMS ((char *));
 %type <voidval>		value_name
 %type <voidval>		literal
 %type <voidval>		tuple
-%type <voidval>		value_string_element
+%type <voidval>		slice
-%type <voidval>		value_string_slice
-%type <voidval>		value_array_slice
 %type <voidval>		expression_conversion
 %type <voidval>		value_procedure_call
 %type <voidval>		value_built_in_routine_call
@@ -281,15 +279,7 @@ yyerror PARAMS ((char *));
 %type <voidval>		value_enumeration_name
 %type <voidval>		value_do_with_name
 %type <voidval>		value_receive_name
-%type <voidval>		string_primitive_value
-%type <voidval>		start_element
-%type <voidval>		left_element
-%type <voidval>		right_element
-%type <voidval>		slice_size
 %type <voidval>		expression_list
-%type <voidval>		lower_element
-%type <voidval>		upper_element
-%type <voidval>		first_element
 %type <tval>		mode_argument
 %type <voidval>		upper_lower_argument
 %type <voidval>		length_argument
@@ -303,6 +293,7 @@ yyerror PARAMS ((char *));
 %type <voidval>		buffer_location
 %type <voidval>		single_assignment_action
 %type <tsym>		mode_name
+%type <lval>		rparen
 
 %%
 
@@ -379,16 +370,22 @@ expression_list	:	expression
 
 /* Z.200, 5.2.1 */
 
-primitive_value	:
+primitive_value_lparen: primitive_value '('
-			access_name
-		|	primitive_value '('
 				/* This is to save the value of arglist_len
 				   being accumulated for each dimension. */
 				{ start_arglist (); }
-			expression_list ')'
+		;
+
+rparen		:	')'
+				{ $$ = end_arglist (); }
+		;
+
+primitive_value	:
+			access_name
+		|	primitive_value_lparen expression_list rparen
 			{
 			  write_exp_elt_opcode (MULTI_SUBSCRIPT);
-			  write_exp_elt_longcst ((LONGEST) end_arglist ());
+			  write_exp_elt_longcst ($3);
 			  write_exp_elt_opcode (MULTI_SUBSCRIPT);
 			}
 		|	primitive_value FIELD_NAME
@@ -412,15 +409,7 @@ primitive_value	:
 			{
 			  $$ = 0;	/* FIXME */
 			}
-                |	value_string_element
+                |	slice
-			{
-			  $$ = 0;	/* FIXME */
-			}
-                |	value_string_slice
-			{
-			  $$ = 0;	/* FIXME */
-			}
-                |	value_array_slice
 			{
 			  $$ = 0;	/* FIXME */
 			}
@@ -561,9 +550,13 @@ tuple_elements	:	tuple_element
 			}
 		;
 
+maybe_tuple_elements :	tuple_elements
+		| /* EMPTY */
+		;
+
 tuple	:	'['
 			{ start_arglist (); }
-		tuple_elements ']'
+		maybe_tuple_elements ']'
 			{
 			  write_exp_elt_opcode (OP_ARRAY);
 			  write_exp_elt_longcst ((LONGEST) 0);
@@ -573,7 +566,7 @@ tuple	:	'['
 		|
 		mode_name '['
 			{ start_arglist (); }
-		tuple_elements ']'
+		maybe_tuple_elements ']'
 			{
 			  write_exp_elt_opcode (OP_ARRAY);
 			  write_exp_elt_longcst ((LONGEST) 0);
@@ -589,33 +582,14 @@ tuple	:	'['
 
 /* Z.200, 5.2.6 */
 
-value_string_element:	string_primitive_value '(' start_element ')'
-			{
-			  $$ = 0;	/* FIXME */
-			}
-		;
 
-/* Z.200, 5.2.7 */
+slice:	primitive_value_lparen expression ':' expression rparen
-
-value_string_slice:	string_primitive_value '(' left_element ':' right_element ')'
 			{
-			  $$ = 0;	/* FIXME */
+			  write_exp_elt_opcode (TERNOP_SLICE);
 			}
-		|	string_primitive_value '(' start_element UP slice_size ')'
+		|	primitive_value_lparen expression UP expression rparen
 			{
-			  $$ = 0;	/* FIXME */
+			  write_exp_elt_opcode (TERNOP_SLICE_COUNT);
-			}
-		;
-
-/* Z.200, 5.2.9 */
-
-value_array_slice:	primitive_value '(' lower_element ':' upper_element ')'
-			{
-			  $$ = 0;	/* FIXME */
-			}
-		|	primitive_value '(' first_element UP slice_size ')'
-			{
-			  $$ = 0;	/* FIXME */
 			}
 		;
 
@@ -986,14 +960,6 @@ synonym_name	 	:	FIXME_11 { $$ = 0; }
 value_enumeration_name 	:	FIXME_12 { $$ = 0; }
 value_do_with_name 	:	FIXME_13 { $$ = 0; }
 value_receive_name 	:	FIXME_14 { $$ = 0; }
-string_primitive_value 	:	FIXME_15 { $$ = 0; }
-start_element 		:	FIXME_16 { $$ = 0; }
-left_element 		:	FIXME_17 { $$ = 0; }
-right_element 		:	FIXME_18 { $$ = 0; }
-slice_size 		:	FIXME_19 { $$ = 0; }
-lower_element 		:	FIXME_20 { $$ = 0; }
-upper_element 		:	FIXME_21 { $$ = 0; }
-first_element 		:	FIXME_22 { $$ = 0; }
 boolean_expression 	:	FIXME_26 { $$ = 0; }
 case_selector_list 	:	FIXME_27 { $$ = 0; }
 subexpression 		:	FIXME_28 { $$ = 0; }
@@ -1764,6 +1730,7 @@ static const struct token idtokentab[] =
     { "and", LOGAND },
     { "in", IN },
     { "or", LOGIOR },
+    { "up", UP },
     { "null", EMPTINESS_LITERAL }
 };
 

gdb/eval.c

@@ -365,8 +365,7 @@ evaluate_subexp (expect_type, exp, pos, noside)
 	{
 	  value_ptr rec = allocate_value (expect_type);
 	  int fieldno = 0;
-	  memset (VALUE_CONTENTS_RAW (rec), '\0',
+	  memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (expect_type));
-		  TYPE_LENGTH (expect_type) / TARGET_CHAR_BIT);
 	  for (tem = 0; tem < nargs; tem++)
 	    evaluate_labeled_field_init (rec, &fieldno, exp, pos, noside);
 	  return rec;
@@ -380,19 +379,21 @@ evaluate_subexp (expect_type, exp, pos, noside)
 	  LONGEST low_bound =  TYPE_FIELD_BITPOS (range_type, 0);
 	  LONGEST high_bound = TYPE_FIELD_BITPOS (range_type, 1);
 	  int element_size = TYPE_LENGTH (element_type);
-	  value_ptr rec = allocate_value (expect_type);
+	  value_ptr array = allocate_value (expect_type);
 	  if (nargs != (high_bound - low_bound + 1))
 	    error ("wrong number of initialiers for array type");
 	  for (tem = low_bound;  tem <= high_bound;  tem++)
 	    {
 	      value_ptr element = evaluate_subexp (element_type,
 						   exp, pos, noside);
-	      memcpy (VALUE_CONTENTS_RAW (rec)
+	      if (VALUE_TYPE (element) != element_type)
+		element = value_cast (element_type, element);
+	      memcpy (VALUE_CONTENTS_RAW (array)
 		      + (tem - low_bound) * element_size,
 		      VALUE_CONTENTS (element),
 		      element_size);
 	    }
-	  return rec;
+	  return array;
 	}
 
       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
@@ -403,12 +404,11 @@ evaluate_subexp (expect_type, exp, pos, noside)
 	  int low_bound = TYPE_LOW_BOUND (element_type);
 	  int high_bound = TYPE_HIGH_BOUND (element_type);
 	  char *valaddr = VALUE_CONTENTS_RAW (set);
-	  memset (valaddr, '\0', TYPE_LENGTH (expect_type) / TARGET_CHAR_BIT);
+	  memset (valaddr, '\0', TYPE_LENGTH (expect_type));
 	  for (tem = 0; tem < nargs; tem++)
 	    {
 	      value_ptr element_val = evaluate_subexp (element_type,
 						       exp, pos, noside);
-	      /* FIXME check that element_val has appropriate type. */
 	      LONGEST element = value_as_long (element_val);
 	      int bit_index;
 	      if (element < low_bound || element > high_bound)
@@ -436,6 +436,26 @@ evaluate_subexp (expect_type, exp, pos, noside)
       return value_array (tem2, tem3, argvec);
       break;
 
+    case TERNOP_SLICE:
+      {
+	value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+	int lowbound
+	  = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+	int upper
+	  = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+	return value_slice (array, lowbound, upper - lowbound + 1);
+      }
+
+    case TERNOP_SLICE_COUNT:
+      {
+	value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+	int lowbound
+	  = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+	int length
+	  = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+	return value_slice (array, lowbound, length);
+      }
+
     case TERNOP_COND:
       /* Skip third and second args to evaluate the first one.  */
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
@@ -982,7 +1002,8 @@ evaluate_subexp (expect_type, exp, pos, noside)
 		}
 	    }
 	  
-	  if (binop_user_defined_p (op, arg1, arg2))
+	  if (binop_user_defined_p (op, arg1, arg2)
+	      && ! chill_varying_type (VALUE_TYPE (arg1)))
 	    {
 	      arg1 = value_x_binop (arg1, arg2, op, OP_NULL);
 	    }

gdb/expression.h

@@ -1,5 +1,5 @@
 /* Definitions for expressions stored in reversed prefix form, for GDB.
-   Copyright 1986, 1989, 1992 Free Software Foundation, Inc.
+   Copyright 1986, 1989, 1992, 1994 Free Software Foundation, Inc.
 
 This file is part of GDB.
 
@@ -47,6 +47,7 @@ enum exp_opcode
 
 /* BINOP_... operate on two values computed by following subexpressions,
    replacing them by one result value.  They take no immediate arguments.  */
+
   BINOP_ADD,		/* + */
   BINOP_SUB,		/* - */
   BINOP_MUL,		/* * */
@@ -72,7 +73,8 @@ enum exp_opcode
   BINOP_SUBSCRIPT,	/* x[y] */
   BINOP_EXP,		/* Exponentiation */
 
-/* C++.  */
+  /* C++.  */
+
   BINOP_MIN,		/* <? */
   BINOP_MAX,		/* >? */
   BINOP_SCOPE,		/* :: */
@@ -80,10 +82,12 @@ enum exp_opcode
   /* STRUCTOP_MEMBER is used for pointer-to-member constructs.
      X . * Y translates into X STRUCTOP_MEMBER Y.  */
   STRUCTOP_MEMBER,
+
   /* STRUCTOP_MPTR is used for pointer-to-member constructs
      when X is a pointer instead of an aggregate.  */
   STRUCTOP_MPTR,
-/* end of C++.  */
+
+  /* end of C++.  */
 
   /* For Modula-2 integer division DIV */
   BINOP_INTDIV,
@@ -94,76 +98,143 @@ enum exp_opcode
 			   Then comes another BINOP_ASSIGN_MODIFY,
 			   making three exp_elements in total.  */
 
-  /* Modula-2 standard (binary) procedures*/
+  /* Modula-2 standard (binary) procedures */
   BINOP_VAL,
   BINOP_INCL,
   BINOP_EXCL,
 
+  /* Concatenate two operands, such as character strings or bitstrings.
+     If the first operand is a integer expression, then it means concatenate
+     the second operand with itself that many times. */
+  BINOP_CONCAT,
+
+  /* For Chill and Pascal. */
+  BINOP_IN, /* Returns 1 iff ARG1 IN ARG2. */
+
   /* This must be the highest BINOP_ value, for expprint.c.  */
   BINOP_END,
 
-/* Operates on three values computed by following subexpressions.  */
+  /* Operates on three values computed by following subexpressions.  */
   TERNOP_COND,		/* ?: */
 
-/* Multidimensional subscript operator, such as Modula-2 x[a,b,...].
+  /* A sub-string/sub-array.  Chill syntax:  OP1(OP2:OP3).
-   The dimensionality is encoded in the operator, like the number of
+     Return elements OP2 through OP3 of OP1.  */
-   function arguments in OP_FUNCALL, I.E. <OP><dimension><OP>.
+  TERNOP_SLICE,
-   The value of the first following subexpression is subscripted
-   by each of the next following subexpressions, one per dimension. */
 
+  /* A sub-string/sub-array.  Chill syntax:  OP1(OP2 UP OP3).
+     Return OP3 elements of OP1, starting with element OP2. */
+  TERNOP_SLICE_COUNT,
+
+  /* Multidimensional subscript operator, such as Modula-2 x[a,b,...].
+     The dimensionality is encoded in the operator, like the number of
+     function arguments in OP_FUNCALL, I.E. <OP><dimension><OP>.
+     The value of the first following subexpression is subscripted
+     by each of the next following subexpressions, one per dimension. */
    MULTI_SUBSCRIPT,
 
-/* The OP_... series take immediate following arguments.
+  /* For Fortran array subscripting (column major style). Like the 
-   After the arguments come another OP_... (the same one)
+     Modula operator, we find that the dimensionality is 
-   so that the grouping can be recognized from the end.  */
+     encoded in the operator.  This operator is distinct 
+     from the above one because it uses column-major array 
+     ordering not row-major.  */ 
+  MULTI_F77_SUBSCRIPT,
 
-/* OP_LONG is followed by a type pointer in the next exp_element
+  /* The OP_... series take immediate following arguments.
-   and the long constant value in the following exp_element.
+     After the arguments come another OP_... (the same one)
-   Then comes another OP_LONG.
+     so that the grouping can be recognized from the end.  */
-   Thus, the operation occupies four exp_elements.  */
 
+  /* OP_LONG is followed by a type pointer in the next exp_element
+     and the long constant value in the following exp_element.
+     Then comes another OP_LONG.
+     Thus, the operation occupies four exp_elements.  */
   OP_LONG,
-/* OP_DOUBLE is similar but takes a double constant instead of a long one.  */
+
+  /* OP_DOUBLE is similar but takes a double constant instead of a long.  */
   OP_DOUBLE,
-/* OP_VAR_VALUE takes one struct symbol * in the following exp_element,
+
-   followed by another OP_VAR_VALUE, making three exp_elements.  */
+  /* OP_VAR_VALUE takes one struct block * in the following element,
+     and one struct symbol * in the following exp_element, followed by
+     another OP_VAR_VALUE, making four exp_elements.  If the block is
+     non-NULL, evaluate the symbol relative to the innermost frame
+     executing in that block; if the block is NULL use the selected frame.  */
   OP_VAR_VALUE,
-/* OP_LAST is followed by an integer in the next exp_element.
+
-   The integer is zero for the last value printed,
+  /* OP_LAST is followed by an integer in the next exp_element.
-   or it is the absolute number of a history element.
+     The integer is zero for the last value printed,
-   With another OP_LAST at the end, this makes three exp_elements.  */
+     or it is the absolute number of a history element.
+     With another OP_LAST at the end, this makes three exp_elements.  */
   OP_LAST,
-/* OP_REGISTER is followed by an integer in the next exp_element.
+
-   This is the number of a register to fetch (as an int).
+  /* OP_REGISTER is followed by an integer in the next exp_element.
-   With another OP_REGISTER at the end, this makes three exp_elements.  */
+     This is the number of a register to fetch (as an int).
+     With another OP_REGISTER at the end, this makes three exp_elements.  */
   OP_REGISTER,
-/* OP_INTERNALVAR is followed by an internalvar ptr in the next exp_element.
+
-   With another OP_INTERNALVAR at the end, this makes three exp_elements.  */
+  /* OP_INTERNALVAR is followed by an internalvar ptr in the next exp_element.
+     With another OP_INTERNALVAR at the end, this makes three exp_elements.  */
   OP_INTERNALVAR,
-/* OP_FUNCALL is followed by an integer in the next exp_element.
+
-   The integer is the number of args to the function call.
+  /* OP_FUNCALL is followed by an integer in the next exp_element.
-   That many plus one values from following subexpressions
+     The integer is the number of args to the function call.
-   are used, the first one being the function.
+     That many plus one values from following subexpressions
-   The integer is followed by a repeat of OP_FUNCALL,
+     are used, the first one being the function.
-   making three exp_elements.  */
+     The integer is followed by a repeat of OP_FUNCALL,
+     making three exp_elements.  */
   OP_FUNCALL,
-/* OP_STRING represents a string constant.
+
-   Its format is the same as that of a STRUCTOP, but the string
+  /* This is EXACTLY like OP_FUNCALL but is semantically different.  
-   data is just made into a string constant when the operation
+     In F77, array subscript expressions, substring expressions
-   is executed.  */
+     and function calls are  all exactly the same syntactically. They may 
+     only be dismabiguated at runtime.  Thus this operator, which 
+     indicates that we have found something of the form <name> ( <stuff> ) */ 
+  OP_F77_UNDETERMINED_ARGLIST,
+  
+  /* The following OP is a special one, it introduces a F77 complex
+     literal. It is followed by exactly two args that are doubles.  */ 
+  OP_F77_LITERAL_COMPLEX,
+
+  /* The following OP introduces a F77 substring operator.
+     It should have a string type and two integer types that follow 
+     indicating the "from" and "to" for the substring. */ 
+  OP_F77_SUBSTR,
+
+  /* OP_STRING represents a string constant.
+     Its format is the same as that of a STRUCTOP, but the string
+     data is just made into a string constant when the operation
+     is executed.  */
   OP_STRING,
 
-/* UNOP_CAST is followed by a type pointer in the next exp_element.
+  /* OP_BITSTRING represents a packed bitstring constant.
-   With another UNOP_CAST at the end, this makes three exp_elements.
+     Its format is the same as that of a STRUCTOP, but the bitstring
-   It casts the value of the following subexpression.  */
+     data is just made into a bitstring constant when the operation
+     is executed.  */
+  OP_BITSTRING,
+
+  /* OP_ARRAY creates an array constant out of the following subexpressions.
+     It is followed by two exp_elements, the first containing an integer
+     that is the lower bound of the array and the second containing another
+     integer that is the upper bound of the array.  The second integer is
+     followed by a repeat of OP_ARRAY, making four exp_elements total.
+     The bounds are used to compute the number of following subexpressions
+     to consume, as well as setting the bounds in the created array constant.
+     The type of the elements is taken from the type of the first subexp,
+     and they must all match. */
+  OP_ARRAY,
+
+  /* UNOP_CAST is followed by a type pointer in the next exp_element.
+     With another UNOP_CAST at the end, this makes three exp_elements.
+     It casts the value of the following subexpression.  */
   UNOP_CAST,
-/* UNOP_MEMVAL is followed by a type pointer in the next exp_element
+
-   With another UNOP_MEMVAL at the end, this makes three exp_elements.
+  /* UNOP_MEMVAL is followed by a type pointer in the next exp_element
-   It casts the contents of the word addressed by the value of the
+     With another UNOP_MEMVAL at the end, this makes three exp_elements.
-   following subexpression.  */
+     It casts the contents of the word addressed by the value of the
+     following subexpression.  */
   UNOP_MEMVAL,
-/* UNOP_... operate on one value from a following subexpression
+
-   and replace it with a result.  They take no immediate arguments.  */
+  /* UNOP_... operate on one value from a following subexpression
+     and replace it with a result.  They take no immediate arguments.  */
+
   UNOP_NEG,		/* Unary - */
   UNOP_LOGICAL_NOT,	/* Unary ! */
   UNOP_COMPLEMENT,	/* Unary ~ */
@@ -191,19 +262,21 @@ enum exp_opcode
   OP_BOOL,		/* Modula-2 builtin BOOLEAN type */
   OP_M2_STRING,		/* Modula-2 string constants */
 
-/* STRUCTOP_... operate on a value from a following subexpression
+  /* STRUCTOP_... operate on a value from a following subexpression
-   by extracting a structure component specified by a string
+     by extracting a structure component specified by a string
-   that appears in the following exp_elements (as many as needed).
+     that appears in the following exp_elements (as many as needed).
-   STRUCTOP_STRUCT is used for "." and STRUCTOP_PTR for "->".
+     STRUCTOP_STRUCT is used for "." and STRUCTOP_PTR for "->".
-   They differ only in the error message given in case the value is
+     They differ only in the error message given in case the value is
-   not suitable or the structure component specified is not found.
+     not suitable or the structure component specified is not found.
+
+     The length of the string follows the opcode, followed by
+     BYTES_TO_EXP_ELEM(length) elements containing the data of the
+     string, followed by the length again and the opcode again.  */
 
-   The length of the string follows in the next exp_element,
-   (after the string), followed by another STRUCTOP_... code.  */
   STRUCTOP_STRUCT,
   STRUCTOP_PTR,
 
-/* C++ */
+  /* C++ */
   /* OP_THIS is just a placeholder for the class instance variable.
      It just comes in a tight (OP_THIS, OP_THIS) pair.  */
   OP_THIS,
@@ -213,6 +286,16 @@ enum exp_opcode
      a string, which, of course, is variable length.  */
   OP_SCOPE,
 
+  /* Used to represent named structure field values in brace initializers
+     (or tuples as they are called in Chill).
+     The gcc C syntax is NAME:VALUE or .NAME=VALUE, the Chill syntax is
+     .NAME:VALUE.  Multiple labels (as in the Chill syntax
+     .NAME1,.NAME2:VALUE) is represented as if it were
+     .NAME1:(.NAME2:VALUE) (though that is not valid Chill syntax).
+
+     The NAME is represented as for STRUCTOP_STRUCT;  VALUE follows. */
+  OP_LABELED,
+
   /* OP_TYPE is for parsing types, and used with the "ptype" command
      so we can look up types that are qualified by scope, either with
      the GDB "::" operator, or the Modula-2 '.' operator. */
@@ -225,9 +308,12 @@ union exp_element
   struct symbol *symbol;
   LONGEST longconst;
   double doubleconst;
+  /* Really sizeof (union exp_element) characters (or less for the last
+     element of a string).  */
   char string;
   struct type *type;
   struct internalvar *internalvar;
+  struct block *block;
 };
 
 struct expression
@@ -237,13 +323,19 @@ struct expression
   union exp_element elts[1];
 };
 
+/* Macros for converting between number of expression elements and bytes
+   to store that many expression elements. */
+
+#define EXP_ELEM_TO_BYTES(elements) \
+    ((elements) * sizeof (union exp_element))
+#define BYTES_TO_EXP_ELEM(bytes) \
+    (((bytes) + sizeof (union exp_element) - 1) / sizeof (union exp_element))
+
 /* From parse.c */
 
-extern struct expression *
+extern struct expression *parse_expression PARAMS ((char *));
-parse_expression PARAMS ((char *));
 
-extern struct expression *
+extern struct expression *parse_exp_1 PARAMS ((char **, struct block *, int));
-parse_exp_1 PARAMS ((char **, struct block *, int));
 
 /* The innermost context required by the stack and register variables
    we've encountered so far.  To use this, set it to NULL, then call
@@ -252,11 +344,9 @@ extern struct block *innermost_block;
 
 /* From expprint.c */
 
-extern void
+extern void print_expression PARAMS ((struct expression *, GDB_FILE *));
-print_expression PARAMS ((struct expression *, FILE *));
 
-extern char *
+extern char *op_string PARAMS ((enum exp_opcode));
-op_string PARAMS ((enum exp_opcode));
 
 /* To enable dumping of all parsed expressions in a human readable
    form, define DEBUG_EXPRESSIONS.  This is a compile time constant
@@ -264,8 +354,7 @@ op_string PARAMS ((enum exp_opcode));
    enough to include by default. */
 
 #ifdef DEBUG_EXPRESSIONS
-extern void
+extern void dump_expression PARAMS ((struct expression *, GDB_FILE *, char *));
-dump_expression PARAMS ((struct expression *, FILE *, char *));
 #define DUMP_EXPRESSION(exp,file,note) dump_expression ((exp), (file), (note))
 #else
 #define DUMP_EXPRESSION(exp,file,note)	/* Null expansion */

gdb/gdbtypes.c

@@ -1236,6 +1236,23 @@ can_dereference (t)
      && TYPE_CODE (TYPE_TARGET_TYPE (t)) != TYPE_CODE_VOID);
 }
 
+/* Chill varying string and arrays are represented as follows:
+
+   struct { int __var_length; ELEMENT_TYPE[MAX_SIZE] __var_data};
+
+   Return true if TYPE is such a Chill varying type. */
+
+int
+chill_varying_type (type)
+     struct type *type;
+{
+  if (TYPE_CODE (type) != TYPE_CODE_STRUCT
+      || TYPE_NFIELDS (type) != 2
+      || strcmp (TYPE_FIELD_NAME (type, 0), "__var_length") != 0)
+    return 0;
+  return 1;
+}
+
 #if MAINTENANCE_CMDS
 
 static void

gdb/gdbtypes.h

@@ -732,6 +732,8 @@ extern struct type *create_set_type PARAMS ((struct type *, struct type *));
 extern struct type *f77_create_literal_complex_type PARAMS ((struct type *,
 							     struct type *));
 
+extern int chill_varying_type PARAMS ((struct type*));
+
 extern struct type *
 lookup_unsigned_typename PARAMS ((char *));
 

gdb/parse.c

@@ -535,6 +535,8 @@ length_of_subexp (expr, endpos)
       break;
 
     case TERNOP_COND:
+    case TERNOP_SLICE:
+    case TERNOP_SLICE_COUNT:
       args = 3;
       break;
 
@@ -677,6 +679,8 @@ prefixify_subexp (inexpr, outexpr, inend, outbeg)
       break;
 
     case TERNOP_COND:
+    case TERNOP_SLICE:
+    case TERNOP_SLICE_COUNT:
       args = 3;
       break;
 

gdb/valops.c

@@ -129,6 +129,11 @@ value_cast (type, arg2)
   register enum type_code code2;
   register int scalar;
 
+  if (VALUE_TYPE (arg2) == type)
+    return arg2;
+
+  COERCE_VARYING_ARRAY (arg2);
+
   /* Coerce arrays but not enums.  Enums will work as-is
      and coercing them would cause an infinite recursion.  */
   if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_ENUM)
@@ -145,7 +150,7 @@ value_cast (type, arg2)
     code2 = TYPE_CODE_INT; 
 
   scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_FLT
-	    || code2 == TYPE_CODE_ENUM);
+	    || code2 == TYPE_CODE_ENUM || code2 == TYPE_CODE_RANGE);
 
   if (   code1 == TYPE_CODE_STRUCT
       && code2 == TYPE_CODE_STRUCT
@@ -164,7 +169,8 @@ value_cast (type, arg2)
     }
   if (code1 == TYPE_CODE_FLT && scalar)
     return value_from_double (type, value_as_double (arg2));
-  else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM)
+  else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM
+	    || code1 == TYPE_CODE_RANGE)
 	   && (scalar || code2 == TYPE_CODE_PTR))
     return value_from_longest (type, value_as_long (arg2));
   else if (TYPE_LENGTH (type) == TYPE_LENGTH (VALUE_TYPE (arg2)))
@@ -194,6 +200,40 @@ value_cast (type, arg2)
       VALUE_TYPE (arg2) = type;
       return arg2;
     }
+  else if (chill_varying_type (type))
+    {
+      struct type *range1, *range2, *eltype1, *eltype2;
+      value_ptr val;
+      int count1, count2;
+      char *valaddr, *valaddr_data;
+      if (code2 == TYPE_CODE_BITSTRING)
+	error ("not implemented: converting bitstring to varying type");
+      if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING)
+	  || (eltype1 = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1)),
+	      eltype2 = TYPE_TARGET_TYPE (VALUE_TYPE (arg2)),
+	      (TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
+	       /* || TYPE_CODE (eltype1) != TYPE_CODE (eltype2) */ )))
+	error ("Invalid conversion to varying type");
+      range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0);
+      range2 = TYPE_FIELD_TYPE (VALUE_TYPE (arg2), 0);
+      count1 = TYPE_HIGH_BOUND (range1) - TYPE_LOW_BOUND (range1) + 1;
+      count2 = TYPE_HIGH_BOUND (range2) - TYPE_LOW_BOUND (range2) + 1;
+      if (count2 > count1)
+	error ("target varying type is too small");
+      val = allocate_value (type);
+      valaddr = VALUE_CONTENTS_RAW (val);
+      valaddr_data = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
+      /* Set val's __var_length field to count2. */
+      store_signed_integer (valaddr, TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)),
+			    count2);
+      /* Set the __var_data field to count2 elements copied from arg2. */
+      memcpy (valaddr_data, VALUE_CONTENTS (arg2),
+	      count2 * TYPE_LENGTH (eltype2));
+      /* Zero the rest of the __var_data field of val. */
+      memset (valaddr_data + count2 * TYPE_LENGTH (eltype2), '\0',
+	      (count1 - count2) * TYPE_LENGTH (eltype2));
+      return val;
+    }
   else if (VALUE_LVAL (arg2) == lval_memory)
     {
       return value_at_lazy (type, VALUE_ADDRESS (arg2) + VALUE_OFFSET (arg2));
@@ -679,8 +719,9 @@ value_addr (arg1)
       VALUE_TYPE (arg2) = lookup_pointer_type (TYPE_TARGET_TYPE (type));
       return arg2;
     }
-  if (VALUE_REPEATED (arg1)
+  if (current_language->c_style_arrays
-      || TYPE_CODE (type) == TYPE_CODE_ARRAY)
+      && (VALUE_REPEATED (arg1)
+	  || TYPE_CODE (type) == TYPE_CODE_ARRAY))
     return value_coerce_array (arg1);
   if (TYPE_CODE (type) == TYPE_CODE_FUNC)
     return value_coerce_function (arg1);
@@ -799,8 +840,9 @@ value_arg_coerce (arg)
     arg = value_cast (builtin_type_unsigned_int, arg);
 
 #if 1	/* FIXME:  This is only a temporary patch.  -fnf */
-  if (VALUE_REPEATED (arg)
+  if (current_language->c_style_arrays
-      || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)
+      && (VALUE_REPEATED (arg)
+	  || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY))
     arg = value_coerce_array (arg);
   if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FUNC)
     arg = value_coerce_function (arg);
@@ -1278,22 +1320,26 @@ value_string (ptr, len)
      int len;
 {
   value_ptr val;
-  struct type *rangetype;
+  struct type *rangetype = create_range_type ((struct type *) NULL,
-  struct type *stringtype;
+					      builtin_type_int, 0, len - 1);
+  struct type *stringtype
+    = create_string_type ((struct type *) NULL, rangetype);
   CORE_ADDR addr;
 
+  if (current_language->c_style_arrays == 0)
+    {
+      val = allocate_value (stringtype);
+      memcpy (VALUE_CONTENTS_RAW (val), ptr, len);
+      return val;
+    }
+
+
   /* Allocate space to store the string in the inferior, and then
      copy LEN bytes from PTR in gdb to that address in the inferior. */
 
   addr = allocate_space_in_inferior (len);
   write_memory (addr, ptr, len);
 
-  /* Create the string type and set up a string value to be evaluated
-     lazily. */
-
-  rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
-				 0, len - 1);
-  stringtype = create_string_type ((struct type *) NULL, rangetype);
   val = value_at_lazy (stringtype, addr);
   return (val);
 }
@@ -2043,6 +2089,69 @@ f77_value_literal_string (lowbound, highbound, elemvec)
   return val;
 }
 
+/* Create a slice (sub-string, sub-array) of ARRAY, that is LENGTH elements
+   long, starting at LOWBOUND.  The result has the same lower bound as
+   the original ARRAY.  */
+
+value_ptr
+value_slice (array, lowbound, length)
+     value_ptr array;
+     int lowbound, length;
+{
+  if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_BITSTRING)
+    error ("not implemented - bitstring slice");
+  if (TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_ARRAY
+      && TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_STRING)
+    error ("cannot take slice of non-array");
+  else
+    {
+      struct type *slice_range_type, *slice_type;
+      value_ptr slice;
+      struct type *range_type = TYPE_FIELD_TYPE (VALUE_TYPE (array), 0);
+      struct type *element_type = TYPE_TARGET_TYPE (VALUE_TYPE (array));
+      int lowerbound = TYPE_LOW_BOUND (range_type);
+      int upperbound = TYPE_HIGH_BOUND (range_type);
+      int offset = (lowbound - lowerbound) * TYPE_LENGTH (element_type);
+      if (lowbound < lowerbound || length < 0
+	  || lowbound + length - 1 > upperbound)
+	error ("slice out of range");
+      slice_range_type = create_range_type ((struct type*) NULL,
+					    TYPE_TARGET_TYPE (range_type),
+					    lowerbound,
+					    lowerbound + length - 1);
+      slice_type = create_array_type ((struct type*) NULL, element_type,
+				      slice_range_type);
+      TYPE_CODE (slice_type) = TYPE_CODE (VALUE_TYPE (array));
+      slice = allocate_value (slice_type);
+      if (VALUE_LAZY (array))
+	VALUE_LAZY (slice) = 1;
+      else
+	memcpy (VALUE_CONTENTS (slice), VALUE_CONTENTS (array) + offset,
+		TYPE_LENGTH (slice_type));
+      if (VALUE_LVAL (array) == lval_internalvar)
+	VALUE_LVAL (slice) = lval_internalvar_component;
+      else
+	VALUE_LVAL (slice) = VALUE_LVAL (array);
+      VALUE_ADDRESS (slice) = VALUE_ADDRESS (array);
+      VALUE_OFFSET (slice) = VALUE_OFFSET (array) + offset;
+      return slice;
+    }
+}
+
+/* Assuming chill_varying_type (VARRAY) is true, return an equivalent
+   value as a fixed-length array. */
+
+value_ptr
+varying_to_slice (varray)
+     value_ptr varray;
+{
+  struct type *vtype = VALUE_TYPE (varray);
+  LONGEST length = unpack_long (TYPE_FIELD_TYPE (vtype, 0),
+				VALUE_CONTENTS (varray)
+				+ TYPE_FIELD_BITPOS (vtype, 0) / 8);
+  return value_slice (value_primitive_field (varray, 0, 1, vtype), 0, length);
+}
+
 /* Create a value for a substring.  We copy data into a local 
    (NOT inferior's memory) buffer, and then set up an array value.
 

gdb/value.h

@@ -186,8 +186,9 @@ extern int value_fetch_lazy PARAMS ((value_ptr val));
 
 #define COERCE_ARRAY(arg)    \
 { COERCE_REF(arg);							\
-  if (VALUE_REPEATED (arg)						\
+  if (current_language->c_style_arrays					\
-      || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)		\
+      && (VALUE_REPEATED (arg)						\
+	  || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY))		\
     arg = value_coerce_array (arg);					\
   if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FUNC)                   \
     arg = value_coerce_function (arg);                                  \
@@ -195,6 +196,9 @@ extern int value_fetch_lazy PARAMS ((value_ptr val));
     arg = value_cast (builtin_type_unsigned_int, arg);			\
 }
 
+#define COERCE_VARYING_ARRAY(arg)	\
+{ if (chill_varying_type (VALUE_TYPE (arg))) arg = varying_to_slice (arg); }
+
 /* If ARG is an enum, convert it to an integer.  */
 
 #define COERCE_ENUM(arg)    \
@@ -504,6 +508,10 @@ extern int baseclass_offset PARAMS ((struct type *, int, value_ptr, int));
 
 /* From valops.c */
 
+extern value_ptr varying_to_slice PARAMS ((value_ptr));
+
+extern value_ptr value_slice PARAMS ((value_ptr, int, int));
+
 extern value_ptr call_function_by_hand PARAMS ((value_ptr, int, value_ptr *));
 
 extern value_ptr f77_value_literal_complex PARAMS ((value_ptr, value_ptr, int));