* eval.c (evaluate_subexp): Add case MULTI_SUBSCRIPT.

* expprint.c (print_subexp):  Rename BINOP_MULTI_SUBSCRIPT to
	MULTI_SUBSCRIPT.
	* expprint.c (dump_expression):  New function for dumping
	expression vectors during gdb debugging.
	* expression.h (BINOP_MULTI_SUBSCRIPT):  Name changed to
	MULTI_SUBSCRIPT and moved out of BINOP range.
	* expression.h (DUMP_EXPRESSION):  New macro that calls
	dump_expression if DEBUG_EXPRESSIONS is defined.
	* m2-exp.y (BINOP_MULTI_SUBSCRIPT):  Changed to MULTI_SUBSCRIPT.
	* parse.c (length_of_subexp, prefixify_subexp):  Change
	BINOP_MULTI_SUBSCRIPT to MULTI_SUBSCRIPT.
	* parse.c (parse_exp_1):  Call DUMP_EXPRESSION before and after
	prefixify'ing the expression.
	* printcmd.c (print_command_1):  Add comment.
	**** start-sanitize-chill ****
	* ch-exp.y (expression_list):  Add useful actions.
	* ch-exp.y (value_array_element):  Add useful actions.
	* ch-exp.y (array_primitive_value):  Add production.
	* ch-exp.y (yylex):  Recognize ',' as a token.
	**** end-sanitize-chill ****

gdb/ChangeLog

@@ -1,3 +1,27 @@
+Sat Jan  2 12:16:41 1993  Fred Fish  (fnf@cygnus.com)
+
+	* eval.c (evaluate_subexp):  Add case MULTI_SUBSCRIPT.
+	* expprint.c (print_subexp):  Rename BINOP_MULTI_SUBSCRIPT to
+	MULTI_SUBSCRIPT.
+	* expprint.c (dump_expression):  New function for dumping
+	expression vectors during gdb debugging.
+	* expression.h (BINOP_MULTI_SUBSCRIPT):  Name changed to
+	MULTI_SUBSCRIPT and moved out of BINOP range.
+	* expression.h (DUMP_EXPRESSION):  New macro that calls
+	dump_expression if DEBUG_EXPRESSIONS is defined.
+	* m2-exp.y (BINOP_MULTI_SUBSCRIPT):  Changed to MULTI_SUBSCRIPT.
+	* parse.c (length_of_subexp, prefixify_subexp):  Change
+	BINOP_MULTI_SUBSCRIPT to MULTI_SUBSCRIPT.
+	* parse.c (parse_exp_1):  Call DUMP_EXPRESSION before and after
+	prefixify'ing the expression.
+	* printcmd.c (print_command_1):  Add comment.
+	**** start-sanitize-chill ****
+	* ch-exp.y (expression_list):  Add useful actions.
+	* ch-exp.y (value_array_element):  Add useful actions.
+	* ch-exp.y (array_primitive_value):  Add production.
+	* ch-exp.y (yylex):  Recognize ',' as a token.
+	**** end-sanitize-chill ****
+
 Fri Jan  1 18:22:02 1993  david d `zoo' zuhn  (zoo at cirdan.cygnus.com)
 
 	* Makefile.in: pass prefix and exec_prefix via FLAGS_TO_PASS,

gdb/ch-exp.y

@@ -326,6 +326,17 @@ access_name	:	LOCATION_NAME
 			}
 		;
 
+/* Z.200, 4.2.8 */
+
+expression_list	:	expression
+			{
+			  arglist_len = 1;
+			}
+		|	expression_list ',' expression
+			{
+			  arglist_len++;
+			}
+
 /* Z.200, 5.2.1 */
 
 primitive_value	:	location_contents
@@ -495,9 +506,15 @@ value_string_slice:	string_primitive_value '(' left_element ':' right_element ')
 
 /* Z.200, 5.2.8 */
 
-value_array_element:	array_primitive_value '(' expression_list ')'
+value_array_element:	array_primitive_value '('
+				/* This is to save the value of arglist_len
+				   being accumulated for each dimension. */
+				{ start_arglist (); }
+			expression_list ')'
 			{
-			  $$ = 0;	/* FIXME */
+			  write_exp_elt_opcode (MULTI_SUBSCRIPT);
+			  write_exp_elt_longcst ((LONGEST) end_arglist ());
+			  write_exp_elt_opcode (MULTI_SUBSCRIPT);
 			}
 		;
 
@@ -793,7 +810,16 @@ integer_literal_expression:
 			  $$ = 0;
 			}
 
+/* Z.200, 12.4.3 */
+
+array_primitive_value :	primitive_value
+			{
+			  $$ = 0;
+			}
+
+
 /* Things which still need productions... */
+
 synonym_name	 	:	FIXME { $$ = 0; }
 value_enumeration_name 	:	FIXME { $$ = 0; }
 value_do_with_name 	:	FIXME { $$ = 0; }
@@ -803,8 +829,6 @@ start_element 		:	FIXME { $$ = 0; }
 left_element 		:	FIXME { $$ = 0; }
 right_element 		:	FIXME { $$ = 0; }
 slice_size 		:	FIXME { $$ = 0; }
-array_primitive_value 	:	FIXME { $$ = 0; }
-expression_list 	:	FIXME { $$ = 0; }
 lower_element 		:	FIXME { $$ = 0; }
 upper_element 		:	FIXME { $$ = 0; }
 first_element 		:	FIXME { $$ = 0; }
@@ -1304,6 +1328,7 @@ yylex ()
 	{
 	    case '\0':
 	        return (0);
+	    case ',':
 	    case '.':
 	    case '=':
 	    case ';':

gdb/eval.c

@@ -584,6 +584,57 @@ evaluate_subexp (expect_type, exp, pos, noside)
       else
 	return value_subscript (arg1, arg2);
       
+    case MULTI_SUBSCRIPT:
+      (*pos) += 2;
+      nargs = longest_to_int (exp->elts[pc + 1].longconst);
+      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
+      while (nargs-- > 0)
+	{
+	  arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
+	  /* FIXME:  EVAL_SKIP handling may not be correct. */
+	  if (noside == EVAL_SKIP)
+	    {
+	      if (nargs > 0)
+		{
+		  continue;
+		}
+	      else
+		{
+		  goto nosideret;
+		}
+	    }
+	  /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
+	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
+	    {
+	      /* If the user attempts to subscript something that has no target
+		 type (like a plain int variable for example), then report this
+		 as an error. */
+	      
+	      type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
+	      if (type != NULL)
+		{
+		  arg1 = value_zero (type, VALUE_LVAL (arg1));
+		  noside = EVAL_SKIP;
+		  continue;
+		}
+	      else
+		{
+		  error ("cannot subscript something of type `%s'",
+			 TYPE_NAME (VALUE_TYPE (arg1)));
+		}
+	    }
+	  
+	  if (binop_user_defined_p (op, arg1, arg2))
+	    {
+	      arg1 = value_x_binop (arg1, arg2, op, OP_NULL);
+	    }
+	  else
+	    {
+	      arg1 = value_subscript (arg1, arg2);
+	    }
+	}
+      return (arg1);
+
     case BINOP_LOGICAL_AND:
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
       if (noside == EVAL_SKIP)

gdb/expprint.c

@@ -264,7 +264,7 @@ print_subexp (exp, pos, stream, prec)
 
     /* Modula-2 ops */
 
-    case BINOP_MULTI_SUBSCRIPT:
+    case MULTI_SUBSCRIPT:
       (*pos) += 2;
       nargs = longest_to_int (exp->elts[pc + 1].longconst);
       print_subexp (exp, pos, stream, PREC_SUFFIX);
@@ -412,3 +412,130 @@ op_string(op)
       return op_print_tab[tem].string;
   return NULL;
 }
+
+#ifdef DEBUG_EXPRESSIONS
+
+/* Support for dumping the raw data from expressions in a human readable
+   form.  */
+
+void
+dump_expression (exp, stream, note)
+     struct expression *exp;
+     FILE *stream;
+     char *note;
+{
+  int elt;
+  char *opcode_name;
+  char *eltscan;
+  int eltsize;
+
+  fprintf_filtered (stream, "Dump of expression @ 0x%x, %s:\n", exp, note);
+  fprintf_filtered (stream, "\tLanguage %s, %d elements, %d bytes each.\n",
+		    exp->language_defn->la_name, exp -> nelts,
+		    sizeof (union exp_element));
+  fprintf_filtered (stream, "\t%5s  %20s  %16s  %s\n", "Index", "Opcode",
+		    "Hex Value", "String Value");
+  for (elt = 0; elt < exp -> nelts; elt++)
+    {
+      fprintf_filtered (stream, "\t%5d  ", elt);
+      switch (exp -> elts[elt].opcode)
+	{
+	  default: opcode_name = "<unknown>"; break;
+	  case OP_NULL: opcode_name = "OP_NULL"; break;
+	  case BINOP_ADD: opcode_name = "BINOP_ADD"; break;
+	  case BINOP_SUB: opcode_name = "BINOP_SUB"; break;
+	  case BINOP_MUL: opcode_name = "BINOP_MUL"; break;
+	  case BINOP_DIV: opcode_name = "BINOP_DIV"; break;
+	  case BINOP_REM: opcode_name = "BINOP_REM"; break;
+	  case BINOP_LSH: opcode_name = "BINOP_LSH"; break;
+	  case BINOP_RSH: opcode_name = "BINOP_RSH"; break;
+	  case BINOP_LOGICAL_AND: opcode_name = "BINOP_LOGICAL_AND"; break;
+	  case BINOP_LOGICAL_OR: opcode_name = "BINOP_LOGICAL_OR"; break;
+	  case BINOP_BITWISE_AND: opcode_name = "BINOP_BITWISE_AND"; break;
+	  case BINOP_BITWISE_IOR: opcode_name = "BINOP_BITWISE_IOR"; break;
+	  case BINOP_BITWISE_XOR: opcode_name = "BINOP_BITWISE_XOR"; break;
+	  case BINOP_EQUAL: opcode_name = "BINOP_EQUAL"; break;
+	  case BINOP_NOTEQUAL: opcode_name = "BINOP_NOTEQUAL"; break;
+	  case BINOP_LESS: opcode_name = "BINOP_LESS"; break;
+	  case BINOP_GTR: opcode_name = "BINOP_GTR"; break;
+	  case BINOP_LEQ: opcode_name = "BINOP_LEQ"; break;
+	  case BINOP_GEQ: opcode_name = "BINOP_GEQ"; break;
+	  case BINOP_REPEAT: opcode_name = "BINOP_REPEAT"; break;
+	  case BINOP_ASSIGN: opcode_name = "BINOP_ASSIGN"; break;
+	  case BINOP_COMMA: opcode_name = "BINOP_COMMA"; break;
+	  case BINOP_SUBSCRIPT: opcode_name = "BINOP_SUBSCRIPT"; break;
+	  case MULTI_SUBSCRIPT: opcode_name = "MULTI_SUBSCRIPT"; break;
+	  case BINOP_EXP: opcode_name = "BINOP_EXP"; break;
+	  case BINOP_MIN: opcode_name = "BINOP_MIN"; break;
+	  case BINOP_MAX: opcode_name = "BINOP_MAX"; break;
+	  case BINOP_SCOPE: opcode_name = "BINOP_SCOPE"; break;
+	  case STRUCTOP_MEMBER: opcode_name = "STRUCTOP_MEMBER"; break;
+	  case STRUCTOP_MPTR: opcode_name = "STRUCTOP_MPTR"; break;
+	  case BINOP_INTDIV: opcode_name = "BINOP_INTDIV"; break;
+	  case BINOP_ASSIGN_MODIFY: opcode_name = "BINOP_ASSIGN_MODIFY"; break;
+	  case BINOP_VAL: opcode_name = "BINOP_VAL"; break;
+	  case BINOP_INCL: opcode_name = "BINOP_INCL"; break;
+	  case BINOP_EXCL: opcode_name = "BINOP_EXCL"; break;
+	  case BINOP_END: opcode_name = "BINOP_END"; break;
+	  case TERNOP_COND: opcode_name = "TERNOP_COND"; break;
+	  case OP_LONG: opcode_name = "OP_LONG"; break;
+	  case OP_DOUBLE: opcode_name = "OP_DOUBLE"; break;
+	  case OP_VAR_VALUE: opcode_name = "OP_VAR_VALUE"; break;
+	  case OP_LAST: opcode_name = "OP_LAST"; break;
+	  case OP_REGISTER: opcode_name = "OP_REGISTER"; break;
+	  case OP_INTERNALVAR: opcode_name = "OP_INTERNALVAR"; break;
+	  case OP_FUNCALL: opcode_name = "OP_FUNCALL"; break;
+	  case OP_STRING: opcode_name = "OP_STRING"; break;
+	  case UNOP_CAST: opcode_name = "UNOP_CAST"; break;
+	  case UNOP_MEMVAL: opcode_name = "UNOP_MEMVAL"; break;
+	  case UNOP_NEG: opcode_name = "UNOP_NEG"; break;
+	  case UNOP_LOGICAL_NOT: opcode_name = "UNOP_LOGICAL_NOT"; break;
+	  case UNOP_COMPLEMENT: opcode_name = "UNOP_COMPLEMENT"; break;
+	  case UNOP_IND: opcode_name = "UNOP_IND"; break;
+	  case UNOP_ADDR: opcode_name = "UNOP_ADDR"; break;
+	  case UNOP_PREINCREMENT: opcode_name = "UNOP_PREINCREMENT"; break;
+	  case UNOP_POSTINCREMENT: opcode_name = "UNOP_POSTINCREMENT"; break;
+	  case UNOP_PREDECREMENT: opcode_name = "UNOP_PREDECREMENT"; break;
+	  case UNOP_POSTDECREMENT: opcode_name = "UNOP_POSTDECREMENT"; break;
+	  case UNOP_SIZEOF: opcode_name = "UNOP_SIZEOF"; break;
+	  case UNOP_PLUS: opcode_name = "UNOP_PLUS"; break;
+	  case UNOP_CAP: opcode_name = "UNOP_CAP"; break;
+	  case UNOP_CHR: opcode_name = "UNOP_CHR"; break;
+	  case UNOP_ORD: opcode_name = "UNOP_ORD"; break;
+	  case UNOP_ABS: opcode_name = "UNOP_ABS"; break;
+	  case UNOP_FLOAT: opcode_name = "UNOP_FLOAT"; break;
+	  case UNOP_HIGH: opcode_name = "UNOP_HIGH"; break;
+	  case UNOP_MAX: opcode_name = "UNOP_MAX"; break;
+	  case UNOP_MIN: opcode_name = "UNOP_MIN"; break;
+	  case UNOP_ODD: opcode_name = "UNOP_ODD"; break;
+	  case UNOP_TRUNC: opcode_name = "UNOP_TRUNC"; break;
+	  case OP_BOOL: opcode_name = "OP_BOOL"; break;
+	  case OP_M2_STRING: opcode_name = "OP_M2_STRING"; break;
+	  case STRUCTOP_STRUCT: opcode_name = "STRUCTOP_STRUCT"; break;
+	  case STRUCTOP_PTR: opcode_name = "STRUCTOP_PTR"; break;
+	  case OP_THIS: opcode_name = "OP_THIS"; break;
+	  case OP_SCOPE: opcode_name = "OP_SCOPE"; break;
+	  case OP_TYPE: opcode_name = "OP_TYPE"; break;
+	}
+      fprintf_filtered (stream, "%20s  ", opcode_name);
+      fprintf_filtered (stream,
+#if defined (LONG_LONG)
+			"%ll16x  ",
+#else
+			"%l16x  ",
+#endif
+			exp -> elts[elt].longconst);
+
+      for (eltscan = (char *) &exp->elts[elt],
+	     eltsize = sizeof (union exp_element) ;
+	   eltsize-- > 0;
+	   eltscan++)
+	{
+	  fprintf_filtered (stream, "%c",
+			    isprint (*eltscan) ? (*eltscan & 0xFF) : '.');
+	}
+      fprintf_filtered (stream, "\n");
+    }
+}
+
+#endif	/* DEBUG_EXPRESSIONS */

gdb/expression.h

@@ -20,6 +20,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #if !defined (EXPRESSION_H)
 #define EXPRESSION_H 1
 
+#ifdef __STDC__
+struct block;	/* Forward declaration for prototypes */
+#endif
+
 /* Definitions for saved C expressions.  */
 
 /* An expression is represented as a vector of union exp_element's.
@@ -50,11 +54,11 @@ enum exp_opcode
   BINOP_REM,		/* % */
   BINOP_LSH,		/* << */
   BINOP_RSH,		/* >> */
-  BINOP_AND,		/* && */
+  BINOP_LOGICAL_AND,	/* && */
-  BINOP_OR,		/* || */
+  BINOP_LOGICAL_OR,	/* || */
-  BINOP_LOGAND,		/* & */
+  BINOP_BITWISE_AND,	/* & */
-  BINOP_LOGIOR,		/* | */
+  BINOP_BITWISE_IOR,	/* | */
-  BINOP_LOGXOR,		/* ^ */
+  BINOP_BITWISE_XOR,	/* ^ */
   BINOP_EQUAL,		/* == */
   BINOP_NOTEQUAL,	/* != */
   BINOP_LESS,		/* < */
@@ -65,7 +69,6 @@ enum exp_opcode
   BINOP_ASSIGN,		/* = */
   BINOP_COMMA,		/* , */
   BINOP_SUBSCRIPT,	/* x[y] */
-  BINOP_MULTI_SUBSCRIPT, /* Modula-2 x[a,b,...] */
   BINOP_EXP,		/* Exponentiation */
 
 /* C++.  */
@@ -101,6 +104,14 @@ enum exp_opcode
 /* Operates on three values computed by following subexpressions.  */
   TERNOP_COND,		/* ?: */
 
+/* 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.
    After the arguments come another OP_... (the same one)
    so that the grouping can be recognized from the end.  */
@@ -153,8 +164,8 @@ enum exp_opcode
 /* UNOP_... operate on one value from a following subexpression
    and replace it with a result.  They take no immediate arguments.  */
   UNOP_NEG,		/* Unary - */
-  UNOP_ZEROP,		/* Unary ! */
+  UNOP_LOGICAL_NOT,	/* Unary ! */
-  UNOP_LOGNOT,		/* Unary ~ */
+  UNOP_COMPLEMENT,	/* Unary ~ */
   UNOP_IND,		/* Unary * */
   UNOP_ADDR,		/* Unary & */
   UNOP_PREINCREMENT,	/* ++ before an expression */
@@ -186,11 +197,6 @@ enum exp_opcode
    They differ only in the error message given in case the value is
    not suitable or the structure component specified is not found.
 
-   After the sub-expression and before the string is a (struct type*).
-   This is normally NULL, but is used for the TYPE in a C++ qualified
-   reference like EXP.TYPE::NAME.  (EXP.TYPE1::TYPE2::NAME does
-   not work, unfortunately.)
-
    The length of the string follows in the next exp_element,
    (after the string), followed by another STRUCTOP_... code.  */
   STRUCTOP_STRUCT,
@@ -251,4 +257,17 @@ print_expression PARAMS ((struct expression *, FILE *));
 extern char *
 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
+   at the moment, since it's not clear that this feature is important
+   enough to include by default. */
+
+#ifdef DEBUG_EXPRESSIONS
+extern void
+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 */
+#endif	/* DEBUG_EXPRESSIONS */
+
 #endif	/* !defined (EXPRESSION_H) */

gdb/m2-exp.y

@@ -333,9 +333,9 @@ exp     :       exp '['
 			   function types */
                         { start_arglist(); }
                 non_empty_arglist ']'  %prec DOT
-                        { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
+                        { write_exp_elt_opcode (MULTI_SUBSCRIPT);
 			  write_exp_elt_longcst ((LONGEST) end_arglist());
-			  write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
+			  write_exp_elt_opcode (MULTI_SUBSCRIPT); }
         ;
 
 exp	:	exp '('

gdb/parse.c

@@ -376,7 +376,7 @@ length_of_subexp (expr, endpos)
       break;
 
       /* Modula-2 */
-   case BINOP_MULTI_SUBSCRIPT:
+   case MULTI_SUBSCRIPT:
       oplen=3;
       args = 1 + longest_to_int (expr->elts[endpos- 2].longconst);
       break;
@@ -498,7 +498,7 @@ prefixify_subexp (inexpr, outexpr, inend, outbeg)
       break;
 
       /* Modula-2 */
-   case BINOP_MULTI_SUBSCRIPT:
+   case MULTI_SUBSCRIPT:
       oplen=3;
       args = 1 + longest_to_int (inexpr->elts[inend - 2].longconst);
       break;
@@ -591,12 +591,24 @@ parse_exp_1 (stringptr, block, comma)
     current_language->la_error (NULL);
 
   discard_cleanups (old_chain);
+
+  /* Record the actual number of expression elements, and then
+     reallocate the expression memory so that we free up any
+     excess elements. */
+
   expout->nelts = expout_ptr;
   expout = (struct expression *)
     xrealloc ((char *) expout,
 	      sizeof (struct expression)
 	      + expout_ptr * sizeof (union exp_element));
+
+  /* Convert expression from postfix form as generated by yacc
+     parser, to a prefix form. */
+
+  DUMP_EXPRESSION (expout, stdout, "before conversion to prefix form");
   prefixify_expression (expout);
+  DUMP_EXPRESSION (expout, stdout, "after conversion to prefix form");
+
   *stringptr = lexptr;
   return expout;
 }