From fcbadaee94dcdcc47eb623ce1c41f2bf92719e42 Mon Sep 17 00:00:00 2001
From: Fred Fish <fnf@specifix.com>
Date: Thu, 21 Jan 1993 18:13:55 +0000
Subject: [PATCH] 	* eval.c (evaluate_subexp):  Fix OP_ARRAY, remove code
 that 	implied that "no side effects" was nonfunctional. 	* eval.c
 (evaluate_subexp):  Add BINOP_CONCAT case to deal with 	character
 string and bitstring concatenation. 	* expprint.c (dump_expression):  Add
 case for BINOP_CONCAT. 	* expression.h (exp_opcode):  Add
 BINOP_CONCAT. 	* gdbtypes.h (type_code):  Add TYPE_CODE_BITSTRING. 	*
 language.c (string_type):  Add function to determine if a type 	is a
 string type. 	* language.c (binop_type_check):  Add case for BINOP_CONCAT. 
 * valarith.c (value_concat):  New function to concatenate two 	values, such
 as character strings or bitstrings. 	* valops.c (value_string):  Remove
 error stub and implement 	function body. 	* value.h (value_concat):  Add
 prototype. 	**** start-sanitize-chill **** 	* ch-exp.y (operand_3):  Add
 actions for SLASH_SLASH (//). 	* ch-exp.y (yylex):  Recognize SLASH_SLASH. 
 * ch-lang.c (chill_op_print_tab):  Add SLASH_SLASH (//) as 	BINOP_CONCAT. 
 **** end-sanitize-chill ****

---
 gdb/ch-exp.y   |  3 +--
 gdb/ch-lang.c  |  1 +
 gdb/gdbtypes.h |  1 +
 gdb/language.c | 28 ++++++++++++++++++++++++++++
 4 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y
index 35fb2feff6..cb17086fd1 100644
--- a/gdb/ch-exp.y
+++ b/gdb/ch-exp.y
@@ -759,7 +759,7 @@ operand_3	:	operand_4
 			}
 		|	operand_3 SLASH_SLASH operand_4
 			{
-			  $$ = 0;	/* FIXME */
+			  write_exp_elt_opcode (BINOP_CONCAT);
 			}
 		;
 
@@ -1778,7 +1778,6 @@ yylex ()
 	    case '+':
 	    case '-':
 	    case '*':
-	    case '/':
 	    case '(':
 	    case ')':
 	    case '[':
diff --git a/gdb/ch-lang.c b/gdb/ch-lang.c
index d02d330b6d..78a20672b3 100644
--- a/gdb/ch-lang.c
+++ b/gdb/ch-lang.c
@@ -259,6 +259,7 @@ static const struct op_print chill_op_print_tab[] = {
     {"-",   BINOP_SUB, PREC_ADD, 0},
     {"*",   BINOP_MUL, PREC_MUL, 0},
     {"/",   BINOP_DIV, PREC_MUL, 0},
+    {"//",  BINOP_CONCAT, PREC_PREFIX, 0},	/* FIXME: precedence? */
     {"-",   UNOP_NEG, PREC_PREFIX, 0},
     {NULL,  0, 0, 0}
 };
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 6da24ce46e..da4fdffc40 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -82,6 +82,7 @@ enum type_code
   TYPE_CODE_SET,		/* Pascal sets */
   TYPE_CODE_RANGE,		/* Range (integers within spec'd bounds) */
   TYPE_CODE_STRING,		/* String types, distinct from array of char */
+  TYPE_CODE_BITSTRING,		/* String of bits, distinct from bool array */
   TYPE_CODE_ERROR,              /* Unknown type */
 
   /* C++ */
diff --git a/gdb/language.c b/gdb/language.c
index 44aea1e700..c5306bb9ef 100644
--- a/gdb/language.c
+++ b/gdb/language.c
@@ -666,6 +666,28 @@ character_type (type)
    }
 }
 
+/* Returns non-zero if the value is a string type */
+int
+string_type (type)
+   struct type *type;
+{
+   switch(current_language->la_language)
+   {
+    /* start-sanitize-chill */
+   case language_chill:
+    /* end-sanitize-chill */
+   case language_m2:
+      return TYPE_CODE(type) != TYPE_CODE_STRING ? 0 : 1;
+
+   case language_c:
+   case language_cplus:
+      /* C does not have distinct string type. */
+      return (0);
+   default:
+      return (0);
+   }
+}
+
 /* Returns non-zero if the value is a boolean type */
 int
 boolean_type (type)
@@ -871,6 +893,12 @@ binop_type_check(arg1,arg2,op)
 	 type_op_error ("Arguments to %s must be of the same type.",op);
       break;
 
+    case BINOP_CONCAT:
+      if (!(string_type(t1) || character_type(t1))
+	  || !(string_type(t2) || character_type(t2)))
+	  type_op_error ("Arguments to %s must be strings or characters.", op);
+      break;
+
    /* Unary checks -- arg2 is null */
 
    case UNOP_LOGICAL_NOT: