* parser-defs.h (enum precedence): Added PREC_BUILTIN_FUNCTION.

	* expression.h (enum exp_opcode):  Added UNOP_LOWER, UNOP_UPPER,
	UNUP_LENGTH.
	* expprint.c (dump_expression):  Handle the new exp_opcodes.
	(print_subexp):  Handle PREC_BUILTIN_FUNCTION.
	(print_simple_m2_func):  Removed.
	(print_subexp):  Remove support for Modula2 builtin functions.
	* m2-lang.c (m2_op_print_tab):  Add support for builtin functions.
	* ch-exp.y:  Parse LOWER, UPPER, and LENGTH builtins.
	(write_lower_upper_value):  Convenience function for LOWER and UPPER.
	(upper_lower_argument, length_argument):  Removed non-terminals.
	* ch-lang.c (chill_op_print_tab):  Entries for UPPER, LOWER, LENGTH.
	(type_lower_upper):  New function.  Calculate LOWER/UPPER of type.
	(value_chill_length):  New function.  Calcalate LENGTH of ARRAY/STRING.
	(evaluate_subexp_chill):  Handle UNOP_LOWER, UNOP_UPPER, UNOP_LENGTH.
This fixes PR 5015 (and 5826 which is a duplicate).

5 files changed, 161 insertions, 32 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index aebb3bd..cc6c2c4 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,21 @@
+Tue Jun 13 21:40:11 1995  Per Bothner  <bothner@kalessin.cygnus.com>
+
+	* parser-defs.h (enum precedence):  Added PREC_BUILTIN_FUNCTION.
+	* expression.h (enum exp_opcode):  Added UNOP_LOWER, UNOP_UPPER,
+	UNUP_LENGTH.
+	* expprint.c (dump_expression):  Handle the new exp_opcodes.
+	(print_subexp):  Handle PREC_BUILTIN_FUNCTION.
+	(print_simple_m2_func):  Removed.
+	(print_subexp):  Remove support for Modula2 builtin functions.
+	* m2-lang.c (m2_op_print_tab):  Add support for builtin functions.
+	* ch-exp.y:  Parse LOWER, UPPER, and LENGTH builtins.
+	(write_lower_upper_value):  Convenience function for LOWER and UPPER.
+	(upper_lower_argument, length_argument):  Removed non-terminals.
+	* ch-lang.c (chill_op_print_tab):  Entries for UPPER, LOWER, LENGTH.
+	(type_lower_upper):  New function.  Calculate LOWER/UPPER of type.
+	(value_chill_length):  New function.  Calcalate LENGTH of ARRAY/STRING.
+	(evaluate_subexp_chill):  Handle UNOP_LOWER, UNOP_UPPER, UNOP_LENGTH.
+
 Mon Jun 12 12:48:13 1995  Stan Shebs  <shebs@andros.cygnus.com>
 
 	Windows support bits from Steve Chamberlain <sac@slash.cygnus.com>.
diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y
index c1b132b..c450b5c 100644
--- a/gdb/ch-exp.y
+++ b/gdb/ch-exp.y
@@ -291,8 +291,6 @@ yyerror PARAMS ((char *));
 %type <voidval>		value_receive_name
 %type <voidval>		expression_list
 %type <tval>		mode_argument
-%type <voidval>		upper_lower_argument
-%type <voidval>		length_argument
 %type <voidval>		array_mode_name
 %type <voidval>		string_mode_name
 %type <voidval>		variant_structure_mode_name
@@ -940,18 +938,16 @@ chill_value_built_in_routine_call :
 			  write_exp_elt_type (builtin_type_int);
 			  write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
 			  write_exp_elt_opcode (OP_LONG); }
-		|	UPPER '(' upper_lower_argument ')'
-			{
-			  $$ = 0;	/* FIXME */
-			}
-		|	LOWER '(' upper_lower_argument ')'
-			{
-			  $$ = 0;	/* FIXME */
-			}
-		|	LENGTH '(' length_argument ')'
-			{
-			  $$ = 0;	/* FIXME */
-			}
+		|	LOWER '(' mode_argument ')'
+			{ write_lower_upper_value (UNOP_LOWER, $3); }
+		|	UPPER '(' mode_argument ')'
+			{ write_lower_upper_value (UNOP_UPPER, $3); }
+		|	LOWER '(' expression ')'
+			{ write_exp_elt_opcode (UNOP_LOWER); }
+		|	UPPER '(' expression ')'
+			{ write_exp_elt_opcode (UNOP_UPPER); }
+		|	LENGTH '(' expression ')'
+			{ write_exp_elt_opcode (UNOP_LENGTH); }
 		;
 
 mode_argument :		mode_name
@@ -975,22 +971,6 @@ mode_argument :		mode_name
 mode_name :		TYPENAME
 		;
 
-upper_lower_argument :	expression
-			{
-			  $$ = 0;	/* FIXME */
-			}
-		|	mode_name
-			{
-			  $$ = 0;	/* FIXME */
-			}
-		;
-
-length_argument :	expression
-			{
-			  $$ = 0;	/* FIXME */
-			}
-		;
-
 /* Things which still need productions... */
 
 array_mode_name	 	:	FIXME_08 { $$ = 0; }
@@ -2019,6 +1999,20 @@ yylex ()
 }
 
 void
+write_lower_upper_value (opcode, type)
+     enum exp_opcode opcode;  /* Either UNOP_LOWER or UNOP_UPPER */
+     struct type *type;
+{
+  extern LONGEST type_lower_upper ();
+  struct type *result_type;
+  LONGEST val = type_lower_upper (opcode, type, &result_type);
+  write_exp_elt_opcode (OP_LONG);
+  write_exp_elt_type (result_type);
+  write_exp_elt_longcst (val);
+  write_exp_elt_opcode (OP_LONG);
+}
+
+void
 yyerror (msg)
      char *msg;
 {
diff --git a/gdb/ch-lang.c b/gdb/ch-lang.c
index 2b65fb4..e90e4a7 100644
--- a/gdb/ch-lang.c
+++ b/gdb/ch-lang.c
@@ -253,6 +253,10 @@ static const struct op_print chill_op_print_tab[] = {
     {"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},
+    {"LOWER",UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
     {":=",  BINOP_ASSIGN, PREC_ASSIGN, 1},
     {"=",   BINOP_EQUAL, PREC_EQUAL, 0},
     {"/=",  BINOP_NOTEQUAL, PREC_EQUAL, 0},
@@ -289,6 +293,87 @@ struct type ** const (chill_builtin_types[]) =
   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 tmp;
+  *result_type = builtin_type_int;
+ retry:
+  switch (TYPE_CODE (type))
+    {
+    case TYPE_CODE_STRUCT:
+      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:
+      if (TYPE_DUMMY_RANGE (type) > 0)
+	return type_lower_upper (op, TYPE_TARGET_TYPE (type), result_type);
+      *result_type = TYPE_TARGET_TYPE (type);
+      return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
+
+    case TYPE_CODE_ENUM:
+      *result_type = type;
+      if (TYPE_NFIELDS (type) > 0)
+	return TYPE_FIELD_BITPOS (type,
+				  op == UNOP_LOWER ? 0
+				  : TYPE_NFIELDS (type) - 1);
+
+    case TYPE_CODE_BOOL:
+      *result_type = type;
+      return op == UNOP_LOWER ? 0 : 1;
+    case TYPE_CODE_INT:
+    case TYPE_CODE_CHAR:
+      *result_type = type;
+      tmp = (LONGEST) 1 << (TARGET_CHAR_BIT * TYPE_LENGTH (type));
+      if (TYPE_UNSIGNED (type))
+	return op == UNOP_LOWER ? 0 : tmp - (LONGEST) 1;
+      tmp = tmp >> 1;
+      return op == UNOP_LOWER ? -tmp : (tmp - 1);
+    }
+  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;
+  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
 evaluate_subexp_chill (expect_type, exp, pos, noside)
      struct type *expect_type;
@@ -297,10 +382,12 @@ evaluate_subexp_chill (expect_type, exp, pos, noside)
      enum noside noside;
 {
   int pc = *pos;
+  struct type *type;
   int tem, nargs;
   value_ptr arg1;
   value_ptr *argvec;
-  switch (exp->elts[*pos].opcode)
+  enum exp_opcode op = exp->elts[*pos].opcode;
+  switch (op)
     {
     case MULTI_SUBSCRIPT:
       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
@@ -334,11 +421,32 @@ evaluate_subexp_chill (expect_type, 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);
+
     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 = {
diff --git a/gdb/m2-lang.c b/gdb/m2-lang.c
index 1a7fd6d..4eac7e6 100644
--- a/gdb/m2-lang.c
+++ b/gdb/m2-lang.c
@@ -378,6 +378,15 @@ static const struct op_print m2_op_print_tab[] = {
     {"<",   BINOP_LESS, PREC_ORDER, 0},
     {"^",   UNOP_IND, PREC_PREFIX, 0},
     {"@",   BINOP_REPEAT, PREC_REPEAT, 0},
+    {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
+    {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
+    {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
+    {"FLOAT",UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
+    {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
+    {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
+    {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
+    {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
+    {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
     {NULL,  0, 0, 0}
 };
 
diff --git a/gdb/parser-defs.h b/gdb/parser-defs.h
index f294402..3845c1a 100644
--- a/gdb/parser-defs.h
+++ b/gdb/parser-defs.h
@@ -169,7 +169,7 @@ enum precedence
 { PREC_NULL, PREC_COMMA, PREC_ABOVE_COMMA, PREC_ASSIGN, PREC_LOGICAL_OR,
   PREC_LOGICAL_AND, PREC_BITWISE_IOR, PREC_BITWISE_AND, PREC_BITWISE_XOR,
   PREC_EQUAL, PREC_ORDER, PREC_SHIFT, PREC_ADD, PREC_MUL, PREC_REPEAT,
-  PREC_HYPER, PREC_PREFIX, PREC_SUFFIX };
+  PREC_HYPER, PREC_PREFIX, PREC_SUFFIX, PREC_BUILTIN_FUNCTION };
 
 /* Table mapping opcodes into strings for printing operators
    and precedences of the operators.  */