Add support for Chill bitstring literals (e.h. H'FF00').

	* ch-exp.y (match_bitstring_literal):  Fix for proper endianness.
	* expprint.c (print_subexp):  Don't call error on OP_BITSTRING,
	just print B'<unimlemented>'.
	* gdbtypes.c (create_set_type):  Fix bug in length calculation.
	* valops.c, value.h (value_bitstring):  New function.
	* eval.c (evaluate_subexp):  Implement support for OP_BITSTRING.

	* ch-typeprint.c (chill_type_print_base): For TYPE_CODE_FUNC,
	check that return type is non-void, and print in proper Chill syntax.

7 files changed, 92 insertions, 28 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index f016c50..a6730c0 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,16 @@
+Mon Jan 23 13:11:46 1995  Per Bothner  <bothner@kalessin.cygnus.com>
+
+	Add support for Chill bitstring literals (e.h. H'FF00').
+	* ch-exp.y (match_bitstring_literal):  Fix for proper endianness.
+	* expprint.c (print_subexp):  Don't call error on OP_BITSTRING,
+	just print B'<unimlemented>'.
+	* gdbtypes.c (create_set_type):  Fix bug in length calculation.
+	* valops.c, value.h (value_bitstring):  New function.
+	* eval.c (evaluate_subexp):  Implement support for OP_BITSTRING.
+
+	* ch-typeprint.c (chill_type_print_base): For TYPE_CODE_FUNC,
+	check that return type is non-void, and print in proper Chill syntax.
+
 Mon Jan 23 12:20:34 1995  Rob Savoye  <rob@darkstar.cygnus.com>
 
 	* Makefile.in: Remove references to remote-mon.c.
diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y
index 9bb7526..46f48da 100644
--- a/gdb/ch-exp.y
+++ b/gdb/ch-exp.y
@@ -1503,14 +1503,15 @@ match_integer_literal ()
 static int
 match_bitstring_literal ()
 {
-  char *tokptr = lexptr;
-  int mask;
+  register char *tokptr = lexptr;
   int bitoffset = 0;
   int bitcount = 0;
-  int base;
+  int bits_per_char;
   int digit;
   
   tempbufindex = 0;
+  CHECKBUF (1);
+  tempbuf[0] = 0;
 
   /* Look for the required explicit base specifier. */
   
@@ -1518,21 +1519,21 @@ match_bitstring_literal ()
     {
     case 'b':
     case 'B':
-      base = 2;
+      bits_per_char = 1;
       break;
     case 'o':
     case 'O':
-      base = 8;
+      bits_per_char = 3;
       break;
     case 'h':
     case 'H':
-      base = 16;
+      bits_per_char = 4;
       break;
     default:
       return (0);
       break;
     }
-  
+
   /* Ensure that the character after the explicit base is a single quote. */
   
   if (*tokptr++ != '\'')
@@ -1562,29 +1563,33 @@ match_bitstring_literal ()
 	    return (0);
 	    break;
 	}
-      if (digit >= base)
+      if (digit >= 1 << bits_per_char)
 	{
 	  /* Found something not in domain for current base. */
 	  return (0);
 	}
       else
 	{
-	  /* Extract bits from digit, starting with the msbit appropriate for
-	     the current base, and packing them into the bitstring byte,
-	     starting at the lsbit. */
-	  for (mask = (base >> 1); mask > 0; mask >>= 1)
+	  /* Extract bits from digit, packing them into the bitstring byte. */
+	  int k = TARGET_BYTE_ORDER == BIG_ENDIAN ? bits_per_char - 1 : 0;
+	  for (; TARGET_BYTE_ORDER == BIG_ENDIAN ? k >= 0 : k < bits_per_char;
+	       TARGET_BYTE_ORDER == BIG_ENDIAN ? k-- : k++)
 	    {
 	      bitcount++;
-	      CHECKBUF (1);
-	      if (digit & mask)
+	      if (digit & (1 << k))
 		{
-		  tempbuf[tempbufindex] |= (1 << bitoffset);
+		  tempbuf[tempbufindex] |=
+		    (TARGET_BYTE_ORDER == BIG_ENDIAN)
+		      ? (1 << (HOST_CHAR_BIT - 1 - bitoffset))
+			: (1 << bitoffset);
 		}
 	      bitoffset++;
 	      if (bitoffset == HOST_CHAR_BIT)
 		{
 		  bitoffset = 0;
 		  tempbufindex++;
+		  CHECKBUF(1);
+		  tempbuf[tempbufindex] = 0;
 		}
 	    }
 	}
diff --git a/gdb/ch-typeprint.c b/gdb/ch-typeprint.c
index 88d994d..ce19e68 100644
--- a/gdb/ch-typeprint.c
+++ b/gdb/ch-typeprint.c
@@ -166,7 +166,12 @@ chill_type_print_base (type, stream, show, level)
 	break;
       case TYPE_CODE_FUNC:
 	fprintf_filtered (stream, "PROC (?)");
-        chill_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
+	if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
+	  {
+	    fputs_filtered (" RETURNS (", stream);
+	    chill_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
+	    fputs_filtered (")", stream);
+	  }
 	break;
 
       case TYPE_CODE_STRUCT:
diff --git a/gdb/eval.c b/gdb/eval.c
index a179840..a564fb3 100644
--- a/gdb/eval.c
+++ b/gdb/eval.c
@@ -346,7 +346,12 @@ evaluate_subexp (expect_type, exp, pos, noside)
       return value_string (&exp->elts[pc + 2].string, tem);
 
     case OP_BITSTRING:
-      error ("support for OP_BITSTRING unimplemented");
+      tem = longest_to_int (exp->elts[pc + 1].longconst);
+      (*pos)
+	+= 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
+      if (noside == EVAL_SKIP)
+	goto nosideret;
+      return value_bitstring (&exp->elts[pc + 2].string, tem);
       break;
 
     case OP_ARRAY:
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index c386a42..9ec6666 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -479,7 +479,7 @@ create_set_type (result_type, domain_type)
       high_bound = TYPE_HIGH_BOUND (domain_type);
       bit_length = high_bound - low_bound + 1;
       TYPE_LENGTH (result_type)
-	= ((bit_length + TARGET_INT_BIT - 1) / TARGET_INT_BIT)
+	= ((bit_length + TARGET_CHAR_BIT - 1) / TARGET_CHAR_BIT)
 	  * TARGET_CHAR_BIT;
     }
   TYPE_FIELD_TYPE (result_type, 0) = domain_type;
diff --git a/gdb/valops.c b/gdb/valops.c
index 100160e..880f872b 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -30,6 +30,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include "language.h"
 
 #include <errno.h>
+#include <string.h>
 
 /* Local functions.  */
 
@@ -463,7 +464,7 @@ Can't handle bitfield which doesn't fit in a single register.");
 					+ MAX_REGISTER_RAW_SIZE);
 
 	int regno;
-	FRAME frame;
+	struct frame_info *frame;
 
 	/* Figure out which frame this is in currently.  */
 	for (frame = get_current_frame ();
@@ -578,15 +579,15 @@ value_of_variable (var, b)
      struct block *b;
 {
   value_ptr val;
-  FRAME fr;
+  struct frame_info *frame;
 
   if (b == NULL)
     /* Use selected frame.  */
-    fr = NULL;
+    frame = NULL;
   else
     {
-      fr = block_innermost_frame (b);
-      if (fr == NULL && symbol_read_needs_frame (var))
+      frame = block_innermost_frame (b);
+      if (frame == NULL && symbol_read_needs_frame (var))
 	{
 	  if (BLOCK_FUNCTION (b) != NULL
 	      && SYMBOL_NAME (BLOCK_FUNCTION (b)) != NULL)
@@ -596,7 +597,7 @@ value_of_variable (var, b)
 	    error ("No frame is currently executing in specified block");
 	}
     }
-  val = read_var_value (var, fr);
+  val = read_var_value (var, frame);
   if (val == 0)
     error ("Address of symbol \"%s\" is unknown.", SYMBOL_SOURCE_NAME (var));
   return val;
@@ -1296,6 +1297,21 @@ value_string (ptr, len)
   val = value_at_lazy (stringtype, addr);
   return (val);
 }
+
+value_ptr
+value_bitstring (ptr, len)
+     char *ptr;
+     int len;
+{
+  value_ptr val;
+  struct type *domain_type = create_range_type (NULL, builtin_type_int,
+						0, len - 1);
+  struct type *type = create_set_type ((struct type*) NULL, domain_type);
+  TYPE_CODE (type) = TYPE_CODE_BITSTRING;
+  val = allocate_value (type);
+  memcpy (VALUE_CONTENTS_RAW (val), ptr, TYPE_LENGTH (type) / TARGET_CHAR_BIT);
+  return val;
+}
 
 /* See if we can pass arguments in T2 to a function which takes arguments
    of types T1.  Both t1 and t2 are NULL-terminated vectors.  If some
@@ -1407,6 +1423,17 @@ search_struct_field (name, arg1, offset, type, looking_for_baseclass)
 	      error("there is no field named %s", name);
 	    return v;
 	  }
+	if (t_field_name && t_field_name[0] == '\0'
+	    && TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_UNION)
+	  {
+	    /* Look for a match through the fields of an anonymous union.  */
+	    value_ptr v;
+	    v = search_struct_field (name, arg1, offset,
+				     TYPE_FIELD_TYPE (type, i),
+				     looking_for_baseclass);
+	    if (v)
+	      return v;
+	  }
       }
 
   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
@@ -1661,7 +1688,15 @@ destructor_name_p (name, type)
   if (name[0] == '~')
     {
       char *dname = type_name_no_tag (type);
-      if (!STREQ (dname, name+1))
+      char *cp = strchr (dname, '<');
+      int len;
+
+      /* Do not compare the template part for template classes.  */
+      if (cp == NULL)
+	len = strlen (dname);
+      else
+	len = cp - dname;
+      if (strlen (name + 1) != len || !STREQN (dname, name + 1, len))
 	error ("name of destructor must equal name of class");
       else
 	return 1;
@@ -1886,11 +1921,11 @@ value_struct_elt_for_reference (domain, offset, curtype, name, intype)
 /* C++: return the value of the class instance variable, if one exists.
    Flag COMPLAIN signals an error if the request is made in an
    inappropriate context.  */
+
 value_ptr
 value_of_this (complain)
      int complain;
 {
-  extern FRAME selected_frame;
   struct symbol *func, *sym;
   struct block *b;
   int i;
diff --git a/gdb/value.h b/gdb/value.h
index dc61bea..7708a44 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -1,5 +1,5 @@
 /* Definitions for values of C expressions, for GDB.
-   Copyright 1986, 1987, 1989, 1992, 1993, 1994 Free Software Foundation, Inc.
+   Copyright 1986, 1987, 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
 
 This file is part of GDB.
 
@@ -281,6 +281,7 @@ extern value_ptr value_mark PARAMS ((void));
 extern void value_free_to_mark PARAMS ((value_ptr mark));
 
 extern value_ptr value_string PARAMS ((char *ptr, int len));
+extern value_ptr value_bitstring PARAMS ((char *ptr, int len));
 
 extern value_ptr value_array PARAMS ((int lowbound, int highbound,
 				      value_ptr *elemvec));
@@ -484,7 +485,7 @@ extern value_ptr value_arg_coerce PARAMS ((value_ptr));
 extern int check_field PARAMS ((value_ptr, const char *));
 
 extern void
-c_typedef_print PARAMS ((struct type *type, struct symbol *new, GDB_FILE *stream));
+c_typedef_print PARAMS ((struct type *type, struct symbol *news, GDB_FILE *stream));
 
 extern char *
 internalvar_name PARAMS ((struct internalvar *var));