* ch-exp.c (parse_primval): Handle CARD, MAX, MIN.

        (match_string_literal): Handle control sequence.
        (match_character_literal): Deto.

        * ch-lang.c (chill_printchar): Change formating of nonprintable
        characters from C'xx' to ^(num).
        (chill_printstr): Deto.
        (value_chill_card, value_chill_max_min): New functions to process
        Chill's CARD, MAX, MIN.
        (evaluate_subexp_chill): Process UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN.

        * expression.h (exp_opcode): Add UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN
        for Chill's CARD, MAX, MIN.

        * valarith.c (value_in): Add processing of TYPE_CODE_RANGE
        and change return type from builtin_type_int to
        builtin_type_chill_bool.

4 files changed, 225 insertions, 36 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 55c1e64..2654d1d 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,23 @@
+Tue Mar  5 23:48:36 1996  Wilfried Moser (Alcatel)  <moser@rtl.cygnus.com>
+
+	* ch-exp.c (parse_primval): Handle CARD, MAX, MIN.
+	(match_string_literal): Handle control sequence.
+	(match_character_literal): Deto.
+
+	* ch-lang.c (chill_printchar): Change formating of nonprintable
+	characters from C'xx' to ^(num).
+	(chill_printstr): Deto.
+	(value_chill_card, value_chill_max_min): New functions to process
+	Chill's CARD, MAX, MIN.
+	(evaluate_subexp_chill): Process UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN.
+
+	* expression.h (exp_opcode): Add UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN
+	for Chill's CARD, MAX, MIN.
+
+	* valarith.c (value_in): Add processing of TYPE_CODE_RANGE
+	and change return type from builtin_type_int to
+	builtin_type_chill_bool.
+
 Tue Mar  5 18:54:04 1996  Stan Shebs  <shebs@andros.cygnus.com>
 
 	* config/nm-nbsd.h (link_object, lo_name, etc): Move to here
diff --git a/gdb/ch-exp.c b/gdb/ch-exp.c
index 4767d94..af43fc2 100644
--- a/gdb/ch-exp.c
+++ b/gdb/ch-exp.c
@@ -683,12 +683,21 @@ parse_primval ()
       write_exp_elt_type (builtin_type_int);
       write_exp_elt_opcode (UNOP_CAST);
       break;
+    case CARD:
+      parse_unary_call ();
+      write_exp_elt_opcode (UNOP_CARD);
+      break;
+    case MAX_TOKEN:
+      parse_unary_call ();
+      write_exp_elt_opcode (UNOP_CHMAX);
+      break;
+    case MIN_TOKEN:
+      parse_unary_call ();
+      write_exp_elt_opcode (UNOP_CHMIN);
+      break;
     case PRED:      op_name = "PRED"; goto unimplemented_unary_builtin;
     case SUCC:      op_name = "SUCC"; goto unimplemented_unary_builtin;
     case ABS:       op_name = "ABS";  goto unimplemented_unary_builtin;
-    case CARD:      op_name = "CARD"; goto unimplemented_unary_builtin;
-    case MAX_TOKEN: op_name = "MAX";  goto unimplemented_unary_builtin;
-    case MIN_TOKEN: op_name = "MIN";  goto unimplemented_unary_builtin;
     unimplemented_unary_builtin:
       parse_unary_call ();
       error ("not implemented:  %s builtin function", op_name);
@@ -1404,23 +1413,67 @@ static enum ch_terminal
 match_string_literal ()
 {
   char *tokptr = lexptr;
+  int in_ctrlseq = 0;
+  LONGEST ival;
 
   for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
     {
       CHECKBUF (1);
-      if (*tokptr == *lexptr)
+    tryagain: ;
+      if (in_ctrlseq)
 	{
-	  if (*(tokptr + 1) == *lexptr)
+	  /* skip possible whitespaces */
+	  while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
+	    tokptr++;
+	  if (*tokptr == ')')
 	    {
+	      in_ctrlseq = 0;
 	      tokptr++;
+	      goto tryagain;
+	    }
+	  else if (*tokptr != ',')
+	    error ("Invalid control sequence");
+	  tokptr++;
+	  /* skip possible whitespaces */
+	  while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
+	    tokptr++;
+	  if (!decode_integer_literal (&ival, &tokptr))
+	    error ("Invalid control sequence");
+	  tokptr--;
+	}
+      else if (*tokptr == *lexptr)
+	{
+	  if (*(tokptr + 1) == *lexptr)
+	    {
+	      ival = *tokptr++;
 	    }
 	  else
 	    {
 	      break;
 	    }
 	}
-      tempbuf[tempbufindex++] = *tokptr;
+      else if (*tokptr == '^')
+	{
+	  if (*(tokptr + 1) == '(')
+	    {
+	      in_ctrlseq = 1;
+	      tokptr += 2;
+	      if (!decode_integer_literal (&ival, &tokptr))
+		error ("Invalid control sequence");
+	      tokptr--;
+	    }
+	  else if (*(tokptr + 1) == '^')
+	    ival = *tokptr++;
+	  else
+	    error ("Invalid control sequence");
+	}
+      else
+	ival = *tokptr;
+      tempbuf[tempbufindex++] = ival;
     }
+  if (in_ctrlseq)
+    error ("Invalid control sequence");
+
   if (*tokptr == '\0'					/* no terminator */
       || (tempbufindex == 1 && *tokptr == '\''))	/* char literal */
     {
@@ -1449,12 +1502,6 @@ match_string_literal ()
    Note that more than a single character, enclosed in single quotes, is
    a string literal.
 
-   Also note that the control sequence form is not in GNU Chill since it
-   is ambiguous with the string literal form using single quotes.  I.E.
-   is '^(7)' a character literal or a string literal.  In theory it it
-   possible to tell by context, but GNU Chill doesn't accept the control
-   sequence form, so neither do we (for now the code is disabled).
-
    Returns CHARACTER_LITERAL if a match is found.
    */
 
@@ -1483,28 +1530,39 @@ match_character_literal ()
       /* Determine which form we have, either a control sequence or the
 	 single character form. */
       
-      if ((*tokptr == '^') && (*(tokptr + 1) == '('))
+      if (*tokptr == '^')
 	{
-#if 0     /* Disable, see note above. -fnf */
-	  /* Match and decode a control sequence.  Return zero if we don't
-	     find a valid integer literal, or if the next unconsumed character
-	     after the integer literal is not the trailing ')'.
-	     FIXME:  We currently don't handle the multiple integer literal
-	     form. */
-	  tokptr += 2;
-	  if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
+	  if (*(tokptr + 1) == '(')
 	    {
-	      return (0);
+	      /* Match and decode a control sequence.  Return zero if we don't
+		 find a valid integer literal, or if the next unconsumed character
+		 after the integer literal is not the trailing ')'. */
+	      tokptr += 2;
+	      if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
+		{
+		  return (0);
+		}
 	    }
-#else
-	  return (0);
-#endif
+	  else if (*(tokptr + 1) == '^')
+	    {
+	      ival = *tokptr;
+	      tokptr += 2;
+	    }
+	  else
+	    /* fail */
+	    error ("Invalid control sequence");
+	}
+      else if (*tokptr == '\'')
+	{
+	  /* this must be duplicated */
+	  ival = *tokptr;
+	  tokptr += 2;
 	}
       else
 	{
 	  ival = *tokptr++;
 	}
-      
+
       /* The trailing quote has not yet been consumed.  If we don't find
 	 it, then we have no match. */
       
@@ -1618,7 +1676,8 @@ match_bitstring_literal ()
 	    digit += 10;
 	    break;
 	  default:
-	    error ("Invalid character in bitstring or integer.");
+	    /* this is not a bitstring literal, probably an integer */
+	    return 0;
 	}
       if (digit >= 1 << bits_per_char)
 	{
diff --git a/gdb/ch-lang.c b/gdb/ch-lang.c
index 5c041d7..12d2f98 100644
--- a/gdb/ch-lang.c
+++ b/gdb/ch-lang.c
@@ -68,11 +68,14 @@ chill_printchar (c, stream)
 
   if (PRINT_LITERAL_FORM (c))
     {
-      fprintf_filtered (stream, "'%c'", c);
+      if (c == '\'' || c == '^')
+	fprintf_filtered (stream, "'%c%c'", c, c);
+      else
+	fprintf_filtered (stream, "'%c'", c);
     }
   else
     {
-      fprintf_filtered (stream, "C'%.2x'", (unsigned int) c);
+      fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
     }
 }
 
@@ -138,6 +141,8 @@ chill_printstr (stream, string, length, force_ellipses)
 	{
 	  if (in_control_form || in_literal_form)
 	    {
+	      if (in_control_form)
+		fputs_filtered (")", stream);
 	      fputs_filtered ("\"//", stream);
 	      in_control_form = in_literal_form = 0;
 	    }
@@ -149,19 +154,23 @@ chill_printstr (stream, string, length, force_ellipses)
 	}
       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);
+		      fputs_filtered (")", stream);
 		      in_control_form = 0;
 		    }
-		  fputs_filtered ("\"", stream);
 		  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
 	    {
@@ -169,19 +178,25 @@ chill_printstr (stream, string, length, force_ellipses)
 		{
 		  if (in_literal_form)
 		    {
-		      fputs_filtered ("\"//", stream);
 		      in_literal_form = 0;
 		    }
-		  fputs_filtered ("c\"", stream);
+		  fputs_filtered ("^(", stream);
 		  in_control_form = 1;
 		}
-	      fprintf_filtered (stream, "%.2x", c);
+	      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);
@@ -265,7 +280,9 @@ static const struct op_print chill_op_print_tab[] = {
     {"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},
+    {"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},
@@ -391,6 +408,86 @@ value_chill_length (val)
 }
 
 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;
@@ -477,6 +574,17 @@ evaluate_subexp_chill (expect_type, exp, pos, noside)
       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");
 
diff --git a/gdb/valarith.c b/gdb/valarith.c
index 3b9d9cc..0446907 100644
--- a/gdb/valarith.c
+++ b/gdb/valarith.c
@@ -1191,6 +1191,8 @@ value_in (element, set)
   int member;
   struct type *settype = check_typedef (VALUE_TYPE (set));
   struct type *eltype = check_typedef (VALUE_TYPE (element));
+  if (TYPE_CODE (eltype) == TYPE_CODE_RANGE)
+    eltype = TYPE_TARGET_TYPE (eltype);
   if (TYPE_CODE (settype) != TYPE_CODE_SET)
     error ("Second argument of 'IN' has wrong type");
   if (TYPE_CODE (eltype) != TYPE_CODE_INT
@@ -1202,7 +1204,7 @@ value_in (element, set)
 			    value_as_long (element));
   if (member < 0)
     error ("First argument of 'IN' not in range");
-  return value_from_longest (builtin_type_int, member);
+  return value_from_longest (builtin_type_chill_bool, member);
 }
 
 void