* ch-exp.y (value_string_element, string_primitive_value,
authorPer Bothner <per@bothner.com>
Wed, 1 Feb 1995 21:02:51 +0000 (21:02 +0000)
committerPer Bothner <per@bothner.com>
Wed, 1 Feb 1995 21:02:51 +0000 (21:02 +0000)
start_element, left_element, right_element, slice_size,
lower_element, upper_element, first_element):  Removed.
(value_string_slice, value_array_slice):  Replaced by ...
(slice):  New non-terminal, with working slice support.
(primitive_value_lparen, rparen):  New non-terminals.
(maybe_tuple_elements):  New non-terminal, to allow empty tuples.
(idtokentab):  Added "up".

* value.h (COERCE_VARYING_ARRAY):  New macro.
* valarith.c (value_subscript):  Use it.
* valops.c (value_cast):  Likewise.  Also, do nothing if already
correct type, and allow converting from/to range to/from scalar.

* valops.c, value.h (varying_to_slice, value_slice):  New functions.
* eval.c (OP_ARRAY):  Add cast for array element.
* expression.h (TERNOP_SLICE, TERNOP_SLICE_COUNT):  New exp_opcodes.
* valops.c (chill_varying_type):  Moved function frp, here ...
* gdbtypes.c (chill_varying_type), gdbtypes.h: ... to here.
* parse.c (length_of_subexp, prefixify_subexp):  Add support
for TERNOP_SLICE, TERNOP_SLICE_COUNT.
* expprint.c (print_subexp, dump_expression):  Likewise.
* eval.c (evaluate_subexp):  Likewise.

* eval.c (evaluate_subexp case MULTI_SUBSCRIPT):  Don't call
value_x_binop on a Chill varying string.

gdb/ChangeLog
gdb/ch-exp.y
gdb/eval.c
gdb/expression.h
gdb/gdbtypes.c
gdb/gdbtypes.h
gdb/parse.c
gdb/valops.c
gdb/value.h

index 091e021de6d752b43c101aa464974dcd1a876c6f..60c7bacae1a81fd7a02d06f5279cbfb1b92efa34 100644 (file)
@@ -1,3 +1,32 @@
+Wed Feb  1 12:23:57 1995  Per Bothner  <bothner@kalessin.cygnus.com>
+
+       * ch-exp.y (value_string_element, string_primitive_value,
+       start_element, left_element, right_element, slice_size,
+       lower_element, upper_element, first_element):  Removed.
+       (value_string_slice, value_array_slice):  Replaced by ...
+       (slice):  New non-terminal, with working slice support.
+       (primitive_value_lparen, rparen):  New non-terminals.
+       (maybe_tuple_elements):  New non-terminal, to allow empty tuples.
+       (idtokentab):  Added "up".
+
+       * value.h (COERCE_VARYING_ARRAY):  New macro.
+       * valarith.c (value_subscript):  Use it.
+       * valops.c (value_cast):  Likewise.  Also, do nothing if already
+       correct type, and allow converting from/to range to/from scalar.
+
+       * valops.c, value.h (varying_to_slice, value_slice):  New functions.
+       * eval.c (OP_ARRAY):  Add cast for array element.
+       * expression.h (TERNOP_SLICE, TERNOP_SLICE_COUNT):  New exp_opcodes.
+       * valops.c (chill_varying_type):  Moved function frp, here ...
+       * gdbtypes.c (chill_varying_type), gdbtypes.h: ... to here.
+       * parse.c (length_of_subexp, prefixify_subexp):  Add support
+       for TERNOP_SLICE, TERNOP_SLICE_COUNT.
+       * expprint.c (print_subexp, dump_expression):  Likewise.
+       * eval.c (evaluate_subexp):  Likewise.
+
+       * eval.c (evaluate_subexp case MULTI_SUBSCRIPT):  Don't call
+       value_x_binop on a Chill varying string.
+
 Tue Jan 31 13:51:53 1995  Jim Kingdon  (kingdon@lioth.cygnus.com)
 
        * config/m68k/monitor.mt,
index 46f48dac7d0da5b702c63c38b24256023a37d836..8b76979091416e569ffd8c0c17f2c22093a4d0ab 100644 (file)
@@ -252,9 +252,7 @@ yyerror PARAMS ((char *));
 %type <voidval>                value_name
 %type <voidval>                literal
 %type <voidval>                tuple
-%type <voidval>                value_string_element
-%type <voidval>                value_string_slice
-%type <voidval>                value_array_slice
+%type <voidval>                slice
 %type <voidval>                expression_conversion
 %type <voidval>                value_procedure_call
 %type <voidval>                value_built_in_routine_call
@@ -281,15 +279,7 @@ yyerror PARAMS ((char *));
 %type <voidval>                value_enumeration_name
 %type <voidval>                value_do_with_name
 %type <voidval>                value_receive_name
-%type <voidval>                string_primitive_value
-%type <voidval>                start_element
-%type <voidval>                left_element
-%type <voidval>                right_element
-%type <voidval>                slice_size
 %type <voidval>                expression_list
-%type <voidval>                lower_element
-%type <voidval>                upper_element
-%type <voidval>                first_element
 %type <tval>           mode_argument
 %type <voidval>                upper_lower_argument
 %type <voidval>                length_argument
@@ -303,6 +293,7 @@ yyerror PARAMS ((char *));
 %type <voidval>                buffer_location
 %type <voidval>                single_assignment_action
 %type <tsym>           mode_name
+%type <lval>           rparen
 
 %%
 
@@ -379,16 +370,22 @@ expression_list   :       expression
 
 /* Z.200, 5.2.1 */
 
-primitive_value        :
-                       access_name
-               |       primitive_value '('
+primitive_value_lparen: primitive_value '('
                                /* This is to save the value of arglist_len
                                   being accumulated for each dimension. */
                                { start_arglist (); }
-                       expression_list ')'
+               ;
+
+rparen         :       ')'
+                               { $$ = end_arglist (); }
+               ;
+
+primitive_value        :
+                       access_name
+               |       primitive_value_lparen expression_list rparen
                        {
                          write_exp_elt_opcode (MULTI_SUBSCRIPT);
-                         write_exp_elt_longcst ((LONGEST) end_arglist ());
+                         write_exp_elt_longcst ($3);
                          write_exp_elt_opcode (MULTI_SUBSCRIPT);
                        }
                |       primitive_value FIELD_NAME
@@ -412,15 +409,7 @@ primitive_value    :
                        {
                          $$ = 0;       /* FIXME */
                        }
-                |      value_string_element
-                       {
-                         $$ = 0;       /* FIXME */
-                       }
-                |      value_string_slice
-                       {
-                         $$ = 0;       /* FIXME */
-                       }
-                |      value_array_slice
+                |      slice
                        {
                          $$ = 0;       /* FIXME */
                        }
@@ -561,9 +550,13 @@ tuple_elements     :       tuple_element
                        }
                ;
 
+maybe_tuple_elements : tuple_elements
+               | /* EMPTY */
+               ;
+
 tuple  :       '['
                        { start_arglist (); }
-               tuple_elements ']'
+               maybe_tuple_elements ']'
                        {
                          write_exp_elt_opcode (OP_ARRAY);
                          write_exp_elt_longcst ((LONGEST) 0);
@@ -573,7 +566,7 @@ tuple       :       '['
                |
                mode_name '['
                        { start_arglist (); }
-               tuple_elements ']'
+               maybe_tuple_elements ']'
                        {
                          write_exp_elt_opcode (OP_ARRAY);
                          write_exp_elt_longcst ((LONGEST) 0);
@@ -589,33 +582,14 @@ tuple     :       '['
 
 /* Z.200, 5.2.6 */
 
-value_string_element:  string_primitive_value '(' start_element ')'
-                       {
-                         $$ = 0;       /* FIXME */
-                       }
-               ;
-
-/* Z.200, 5.2.7 */
-
-value_string_slice:    string_primitive_value '(' left_element ':' right_element ')'
-                       {
-                         $$ = 0;       /* FIXME */
-                       }
-               |       string_primitive_value '(' start_element UP slice_size ')'
-                       {
-                         $$ = 0;       /* FIXME */
-                       }
-               ;
-
-/* Z.200, 5.2.9 */
 
-value_array_slice:     primitive_value '(' lower_element ':' upper_element ')'
+slice: primitive_value_lparen expression ':' expression rparen
                        {
-                         $$ = 0;       /* FIXME */
+                         write_exp_elt_opcode (TERNOP_SLICE);
                        }
-               |       primitive_value '(' first_element UP slice_size ')'
+               |       primitive_value_lparen expression UP expression rparen
                        {
-                         $$ = 0;       /* FIXME */
+                         write_exp_elt_opcode (TERNOP_SLICE_COUNT);
                        }
                ;
 
@@ -986,14 +960,6 @@ synonym_name               :       FIXME_11 { $$ = 0; }
 value_enumeration_name         :       FIXME_12 { $$ = 0; }
 value_do_with_name     :       FIXME_13 { $$ = 0; }
 value_receive_name     :       FIXME_14 { $$ = 0; }
-string_primitive_value         :       FIXME_15 { $$ = 0; }
-start_element          :       FIXME_16 { $$ = 0; }
-left_element           :       FIXME_17 { $$ = 0; }
-right_element          :       FIXME_18 { $$ = 0; }
-slice_size             :       FIXME_19 { $$ = 0; }
-lower_element          :       FIXME_20 { $$ = 0; }
-upper_element          :       FIXME_21 { $$ = 0; }
-first_element          :       FIXME_22 { $$ = 0; }
 boolean_expression     :       FIXME_26 { $$ = 0; }
 case_selector_list     :       FIXME_27 { $$ = 0; }
 subexpression          :       FIXME_28 { $$ = 0; }
@@ -1764,6 +1730,7 @@ static const struct token idtokentab[] =
     { "and", LOGAND },
     { "in", IN },
     { "or", LOGIOR },
+    { "up", UP },
     { "null", EMPTINESS_LITERAL }
 };
 
index a564fb3976dd82103b56cdef65aa85bc9edb4986..45ee8b49444d2d35708578874d0c7dc3028bb831 100644 (file)
@@ -365,8 +365,7 @@ evaluate_subexp (expect_type, exp, pos, noside)
        {
          value_ptr rec = allocate_value (expect_type);
          int fieldno = 0;
-         memset (VALUE_CONTENTS_RAW (rec), '\0',
-                 TYPE_LENGTH (expect_type) / TARGET_CHAR_BIT);
+         memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (expect_type));
          for (tem = 0; tem < nargs; tem++)
            evaluate_labeled_field_init (rec, &fieldno, exp, pos, noside);
          return rec;
@@ -380,19 +379,21 @@ evaluate_subexp (expect_type, exp, pos, noside)
          LONGEST low_bound =  TYPE_FIELD_BITPOS (range_type, 0);
          LONGEST high_bound = TYPE_FIELD_BITPOS (range_type, 1);
          int element_size = TYPE_LENGTH (element_type);
-         value_ptr rec = allocate_value (expect_type);
+         value_ptr array = allocate_value (expect_type);
          if (nargs != (high_bound - low_bound + 1))
            error ("wrong number of initialiers for array type");
          for (tem = low_bound;  tem <= high_bound;  tem++)
            {
              value_ptr element = evaluate_subexp (element_type,
                                                   exp, pos, noside);
-             memcpy (VALUE_CONTENTS_RAW (rec)
+             if (VALUE_TYPE (element) != element_type)
+               element = value_cast (element_type, element);
+             memcpy (VALUE_CONTENTS_RAW (array)
                      + (tem - low_bound) * element_size,
                      VALUE_CONTENTS (element),
                      element_size);
            }
-         return rec;
+         return array;
        }
 
       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
@@ -403,12 +404,11 @@ evaluate_subexp (expect_type, exp, pos, noside)
          int low_bound = TYPE_LOW_BOUND (element_type);
          int high_bound = TYPE_HIGH_BOUND (element_type);
          char *valaddr = VALUE_CONTENTS_RAW (set);
-         memset (valaddr, '\0', TYPE_LENGTH (expect_type) / TARGET_CHAR_BIT);
+         memset (valaddr, '\0', TYPE_LENGTH (expect_type));
          for (tem = 0; tem < nargs; tem++)
            {
              value_ptr element_val = evaluate_subexp (element_type,
                                                       exp, pos, noside);
-             /* FIXME check that element_val has appropriate type. */
              LONGEST element = value_as_long (element_val);
              int bit_index;
              if (element < low_bound || element > high_bound)
@@ -436,6 +436,26 @@ evaluate_subexp (expect_type, exp, pos, noside)
       return value_array (tem2, tem3, argvec);
       break;
 
+    case TERNOP_SLICE:
+      {
+       value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       int lowbound
+         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+       int upper
+         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+       return value_slice (array, lowbound, upper - lowbound + 1);
+      }
+
+    case TERNOP_SLICE_COUNT:
+      {
+       value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+       int lowbound
+         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+       int length
+         = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
+       return value_slice (array, lowbound, length);
+      }
+
     case TERNOP_COND:
       /* Skip third and second args to evaluate the first one.  */
       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
@@ -982,7 +1002,8 @@ evaluate_subexp (expect_type, exp, pos, noside)
                }
            }
          
-         if (binop_user_defined_p (op, arg1, arg2))
+         if (binop_user_defined_p (op, arg1, arg2)
+             && ! chill_varying_type (VALUE_TYPE (arg1)))
            {
              arg1 = value_x_binop (arg1, arg2, op, OP_NULL);
            }
index 8c34642a35ad67af7215ab2181092be0c28bd556..d9c7bfe3c0676359d09c634e2b67aa4a99a2bb7a 100644 (file)
@@ -1,5 +1,5 @@
 /* Definitions for expressions stored in reversed prefix form, for GDB.
-   Copyright 1986, 1989, 1992 Free Software Foundation, Inc.
+   Copyright 1986, 1989, 1992, 1994 Free Software Foundation, Inc.
 
 This file is part of GDB.
 
@@ -47,6 +47,7 @@ enum exp_opcode
 
 /* BINOP_... operate on two values computed by following subexpressions,
    replacing them by one result value.  They take no immediate arguments.  */
+
   BINOP_ADD,           /* + */
   BINOP_SUB,           /* - */
   BINOP_MUL,           /* * */
@@ -72,7 +73,8 @@ enum exp_opcode
   BINOP_SUBSCRIPT,     /* x[y] */
   BINOP_EXP,           /* Exponentiation */
 
-/* C++.  */
+  /* C++.  */
+
   BINOP_MIN,           /* <? */
   BINOP_MAX,           /* >? */
   BINOP_SCOPE,         /* :: */
@@ -80,10 +82,12 @@ enum exp_opcode
   /* STRUCTOP_MEMBER is used for pointer-to-member constructs.
      X . * Y translates into X STRUCTOP_MEMBER Y.  */
   STRUCTOP_MEMBER,
+
   /* STRUCTOP_MPTR is used for pointer-to-member constructs
      when X is a pointer instead of an aggregate.  */
   STRUCTOP_MPTR,
-/* end of C++.  */
+
+  /* end of C++.  */
 
   /* For Modula-2 integer division DIV */
   BINOP_INTDIV,
@@ -94,76 +98,143 @@ enum exp_opcode
                           Then comes another BINOP_ASSIGN_MODIFY,
                           making three exp_elements in total.  */
 
-  /* Modula-2 standard (binary) procedures*/
+  /* Modula-2 standard (binary) procedures */
   BINOP_VAL,
   BINOP_INCL,
   BINOP_EXCL,
 
+  /* Concatenate two operands, such as character strings or bitstrings.
+     If the first operand is a integer expression, then it means concatenate
+     the second operand with itself that many times. */
+  BINOP_CONCAT,
+
+  /* For Chill and Pascal. */
+  BINOP_IN, /* Returns 1 iff ARG1 IN ARG2. */
+
   /* This must be the highest BINOP_ value, for expprint.c.  */
   BINOP_END,
 
-/* Operates on three values computed by following subexpressions.  */
+  /* 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. */
+  /* A sub-string/sub-array.  Chill syntax:  OP1(OP2:OP3).
+     Return elements OP2 through OP3 of OP1.  */
+  TERNOP_SLICE,
 
-   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.  */
+  /* A sub-string/sub-array.  Chill syntax:  OP1(OP2 UP OP3).
+     Return OP3 elements of OP1, starting with element OP2. */
+  TERNOP_SLICE_COUNT,
 
-/* OP_LONG is followed by a type pointer in the next exp_element
-   and the long constant value in the following exp_element.
-   Then comes another OP_LONG.
-   Thus, the operation occupies four exp_elements.  */
+  /* 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,
 
+  /* For Fortran array subscripting (column major style). Like the 
+     Modula operator, we find that the dimensionality is 
+     encoded in the operator.  This operator is distinct 
+     from the above one because it uses column-major array 
+     ordering not row-major.  */ 
+  MULTI_F77_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.  */
+
+  /* OP_LONG is followed by a type pointer in the next exp_element
+     and the long constant value in the following exp_element.
+     Then comes another OP_LONG.
+     Thus, the operation occupies four exp_elements.  */
   OP_LONG,
-/* OP_DOUBLE is similar but takes a double constant instead of a long one.  */
+
+  /* OP_DOUBLE is similar but takes a double constant instead of a long.  */
   OP_DOUBLE,
-/* OP_VAR_VALUE takes one struct symbol * in the following exp_element,
-   followed by another OP_VAR_VALUE, making three exp_elements.  */
+
+  /* OP_VAR_VALUE takes one struct block * in the following element,
+     and one struct symbol * in the following exp_element, followed by
+     another OP_VAR_VALUE, making four exp_elements.  If the block is
+     non-NULL, evaluate the symbol relative to the innermost frame
+     executing in that block; if the block is NULL use the selected frame.  */
   OP_VAR_VALUE,
-/* OP_LAST is followed by an integer in the next exp_element.
-   The integer is zero for the last value printed,
-   or it is the absolute number of a history element.
-   With another OP_LAST at the end, this makes three exp_elements.  */
+
+  /* OP_LAST is followed by an integer in the next exp_element.
+     The integer is zero for the last value printed,
+     or it is the absolute number of a history element.
+     With another OP_LAST at the end, this makes three exp_elements.  */
   OP_LAST,
-/* OP_REGISTER is followed by an integer in the next exp_element.
-   This is the number of a register to fetch (as an int).
-   With another OP_REGISTER at the end, this makes three exp_elements.  */
+
+  /* OP_REGISTER is followed by an integer in the next exp_element.
+     This is the number of a register to fetch (as an int).
+     With another OP_REGISTER at the end, this makes three exp_elements.  */
   OP_REGISTER,
-/* OP_INTERNALVAR is followed by an internalvar ptr in the next exp_element.
-   With another OP_INTERNALVAR at the end, this makes three exp_elements.  */
+
+  /* OP_INTERNALVAR is followed by an internalvar ptr in the next exp_element.
+     With another OP_INTERNALVAR at the end, this makes three exp_elements.  */
   OP_INTERNALVAR,
-/* OP_FUNCALL is followed by an integer in the next exp_element.
-   The integer is the number of args to the function call.
-   That many plus one values from following subexpressions
-   are used, the first one being the function.
-   The integer is followed by a repeat of OP_FUNCALL,
-   making three exp_elements.  */
+
+  /* OP_FUNCALL is followed by an integer in the next exp_element.
+     The integer is the number of args to the function call.
+     That many plus one values from following subexpressions
+     are used, the first one being the function.
+     The integer is followed by a repeat of OP_FUNCALL,
+     making three exp_elements.  */
   OP_FUNCALL,
-/* OP_STRING represents a string constant.
-   Its format is the same as that of a STRUCTOP, but the string
-   data is just made into a string constant when the operation
-   is executed.  */
+
+  /* This is EXACTLY like OP_FUNCALL but is semantically different.  
+     In F77, array subscript expressions, substring expressions
+     and function calls are  all exactly the same syntactically. They may 
+     only be dismabiguated at runtime.  Thus this operator, which 
+     indicates that we have found something of the form <name> ( <stuff> ) */ 
+  OP_F77_UNDETERMINED_ARGLIST,
+  
+  /* The following OP is a special one, it introduces a F77 complex
+     literal. It is followed by exactly two args that are doubles.  */ 
+  OP_F77_LITERAL_COMPLEX,
+
+  /* The following OP introduces a F77 substring operator.
+     It should have a string type and two integer types that follow 
+     indicating the "from" and "to" for the substring. */ 
+  OP_F77_SUBSTR,
+
+  /* OP_STRING represents a string constant.
+     Its format is the same as that of a STRUCTOP, but the string
+     data is just made into a string constant when the operation
+     is executed.  */
   OP_STRING,
 
-/* UNOP_CAST is followed by a type pointer in the next exp_element.
-   With another UNOP_CAST at the end, this makes three exp_elements.
-   It casts the value of the following subexpression.  */
+  /* OP_BITSTRING represents a packed bitstring constant.
+     Its format is the same as that of a STRUCTOP, but the bitstring
+     data is just made into a bitstring constant when the operation
+     is executed.  */
+  OP_BITSTRING,
+
+  /* OP_ARRAY creates an array constant out of the following subexpressions.
+     It is followed by two exp_elements, the first containing an integer
+     that is the lower bound of the array and the second containing another
+     integer that is the upper bound of the array.  The second integer is
+     followed by a repeat of OP_ARRAY, making four exp_elements total.
+     The bounds are used to compute the number of following subexpressions
+     to consume, as well as setting the bounds in the created array constant.
+     The type of the elements is taken from the type of the first subexp,
+     and they must all match. */
+  OP_ARRAY,
+
+  /* UNOP_CAST is followed by a type pointer in the next exp_element.
+     With another UNOP_CAST at the end, this makes three exp_elements.
+     It casts the value of the following subexpression.  */
   UNOP_CAST,
-/* UNOP_MEMVAL is followed by a type pointer in the next exp_element
-   With another UNOP_MEMVAL at the end, this makes three exp_elements.
-   It casts the contents of the word addressed by the value of the
-   following subexpression.  */
+
+  /* UNOP_MEMVAL is followed by a type pointer in the next exp_element
+     With another UNOP_MEMVAL at the end, this makes three exp_elements.
+     It casts the contents of the word addressed by the value of the
+     following subexpression.  */
   UNOP_MEMVAL,
-/* UNOP_... operate on one value from a following subexpression
-   and replace it with a result.  They take no immediate arguments.  */
+
+  /* UNOP_... operate on one value from a following subexpression
+     and replace it with a result.  They take no immediate arguments.  */
+
   UNOP_NEG,            /* Unary - */
   UNOP_LOGICAL_NOT,    /* Unary ! */
   UNOP_COMPLEMENT,     /* Unary ~ */
@@ -191,19 +262,21 @@ enum exp_opcode
   OP_BOOL,             /* Modula-2 builtin BOOLEAN type */
   OP_M2_STRING,                /* Modula-2 string constants */
 
-/* STRUCTOP_... operate on a value from a following subexpression
-   by extracting a structure component specified by a string
-   that appears in the following exp_elements (as many as needed).
-   STRUCTOP_STRUCT is used for "." and STRUCTOP_PTR for "->".
-   They differ only in the error message given in case the value is
-   not suitable or the structure component specified is not found.
+  /* STRUCTOP_... operate on a value from a following subexpression
+     by extracting a structure component specified by a string
+     that appears in the following exp_elements (as many as needed).
+     STRUCTOP_STRUCT is used for "." and STRUCTOP_PTR for "->".
+     They differ only in the error message given in case the value is
+     not suitable or the structure component specified is not found.
+
+     The length of the string follows the opcode, followed by
+     BYTES_TO_EXP_ELEM(length) elements containing the data of the
+     string, followed by the length again and the opcode again.  */
 
-   The length of the string follows in the next exp_element,
-   (after the string), followed by another STRUCTOP_... code.  */
   STRUCTOP_STRUCT,
   STRUCTOP_PTR,
 
-/* C++ */
+  /* C++ */
   /* OP_THIS is just a placeholder for the class instance variable.
      It just comes in a tight (OP_THIS, OP_THIS) pair.  */
   OP_THIS,
@@ -213,6 +286,16 @@ enum exp_opcode
      a string, which, of course, is variable length.  */
   OP_SCOPE,
 
+  /* Used to represent named structure field values in brace initializers
+     (or tuples as they are called in Chill).
+     The gcc C syntax is NAME:VALUE or .NAME=VALUE, the Chill syntax is
+     .NAME:VALUE.  Multiple labels (as in the Chill syntax
+     .NAME1,.NAME2:VALUE) is represented as if it were
+     .NAME1:(.NAME2:VALUE) (though that is not valid Chill syntax).
+
+     The NAME is represented as for STRUCTOP_STRUCT;  VALUE follows. */
+  OP_LABELED,
+
   /* OP_TYPE is for parsing types, and used with the "ptype" command
      so we can look up types that are qualified by scope, either with
      the GDB "::" operator, or the Modula-2 '.' operator. */
@@ -225,9 +308,12 @@ union exp_element
   struct symbol *symbol;
   LONGEST longconst;
   double doubleconst;
+  /* Really sizeof (union exp_element) characters (or less for the last
+     element of a string).  */
   char string;
   struct type *type;
   struct internalvar *internalvar;
+  struct block *block;
 };
 
 struct expression
@@ -237,13 +323,19 @@ struct expression
   union exp_element elts[1];
 };
 
+/* Macros for converting between number of expression elements and bytes
+   to store that many expression elements. */
+
+#define EXP_ELEM_TO_BYTES(elements) \
+    ((elements) * sizeof (union exp_element))
+#define BYTES_TO_EXP_ELEM(bytes) \
+    (((bytes) + sizeof (union exp_element) - 1) / sizeof (union exp_element))
+
 /* From parse.c */
 
-extern struct expression *
-parse_expression PARAMS ((char *));
+extern struct expression *parse_expression PARAMS ((char *));
 
-extern struct expression *
-parse_exp_1 PARAMS ((char **, struct block *, int));
+extern struct expression *parse_exp_1 PARAMS ((char **, struct block *, int));
 
 /* The innermost context required by the stack and register variables
    we've encountered so far.  To use this, set it to NULL, then call
@@ -252,11 +344,9 @@ extern struct block *innermost_block;
 
 /* From expprint.c */
 
-extern void
-print_expression PARAMS ((struct expression *, FILE *));
+extern void print_expression PARAMS ((struct expression *, GDB_FILE *));
 
-extern char *
-op_string PARAMS ((enum exp_opcode));
+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
@@ -264,8 +354,7 @@ op_string PARAMS ((enum exp_opcode));
    enough to include by default. */
 
 #ifdef DEBUG_EXPRESSIONS
-extern void
-dump_expression PARAMS ((struct expression *, FILE *, char *));
+extern void dump_expression PARAMS ((struct expression *, GDB_FILE *, char *));
 #define DUMP_EXPRESSION(exp,file,note) dump_expression ((exp), (file), (note))
 #else
 #define DUMP_EXPRESSION(exp,file,note) /* Null expansion */
index 9ec66660787c6ceb5c2a7b78e53c39b64c602280..cc768980f8f4e3a2fc07c0a0063032b55cc1f6ec 100644 (file)
@@ -1236,6 +1236,23 @@ can_dereference (t)
      && TYPE_CODE (TYPE_TARGET_TYPE (t)) != TYPE_CODE_VOID);
 }
 
+/* Chill varying string and arrays are represented as follows:
+
+   struct { int __var_length; ELEMENT_TYPE[MAX_SIZE] __var_data};
+
+   Return true if TYPE is such a Chill varying type. */
+
+int
+chill_varying_type (type)
+     struct type *type;
+{
+  if (TYPE_CODE (type) != TYPE_CODE_STRUCT
+      || TYPE_NFIELDS (type) != 2
+      || strcmp (TYPE_FIELD_NAME (type, 0), "__var_length") != 0)
+    return 0;
+  return 1;
+}
+
 #if MAINTENANCE_CMDS
 
 static void
index c3b5f31745767c98af35528bb3f6615bd6b7c6f7..3e26098da257d5132ecece07b7218678760704d1 100644 (file)
@@ -732,6 +732,8 @@ extern struct type *create_set_type PARAMS ((struct type *, struct type *));
 extern struct type *f77_create_literal_complex_type PARAMS ((struct type *,
                                                             struct type *));
 
+extern int chill_varying_type PARAMS ((struct type*));
+
 extern struct type *
 lookup_unsigned_typename PARAMS ((char *));
 
index a6d9575765082a5d1616dbab4d6460a3319e0584..0defac0fdca1ee3bb728fbdf5640595ef86099a6 100644 (file)
@@ -535,6 +535,8 @@ length_of_subexp (expr, endpos)
       break;
 
     case TERNOP_COND:
+    case TERNOP_SLICE:
+    case TERNOP_SLICE_COUNT:
       args = 3;
       break;
 
@@ -677,6 +679,8 @@ prefixify_subexp (inexpr, outexpr, inend, outbeg)
       break;
 
     case TERNOP_COND:
+    case TERNOP_SLICE:
+    case TERNOP_SLICE_COUNT:
       args = 3;
       break;
 
index 880f872b5fe767f9977f81943c6f857978c25ac6..e5e5734266f5c6dd83b1cee1f42314e5929fe6f2 100644 (file)
@@ -129,6 +129,11 @@ value_cast (type, arg2)
   register enum type_code code2;
   register int scalar;
 
+  if (VALUE_TYPE (arg2) == type)
+    return arg2;
+
+  COERCE_VARYING_ARRAY (arg2);
+
   /* Coerce arrays but not enums.  Enums will work as-is
      and coercing them would cause an infinite recursion.  */
   if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_ENUM)
@@ -145,7 +150,7 @@ value_cast (type, arg2)
     code2 = TYPE_CODE_INT; 
 
   scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_FLT
-           || code2 == TYPE_CODE_ENUM);
+           || code2 == TYPE_CODE_ENUM || code2 == TYPE_CODE_RANGE);
 
   if (   code1 == TYPE_CODE_STRUCT
       && code2 == TYPE_CODE_STRUCT
@@ -164,7 +169,8 @@ value_cast (type, arg2)
     }
   if (code1 == TYPE_CODE_FLT && scalar)
     return value_from_double (type, value_as_double (arg2));
-  else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM)
+  else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM
+           || code1 == TYPE_CODE_RANGE)
           && (scalar || code2 == TYPE_CODE_PTR))
     return value_from_longest (type, value_as_long (arg2));
   else if (TYPE_LENGTH (type) == TYPE_LENGTH (VALUE_TYPE (arg2)))
@@ -194,6 +200,40 @@ value_cast (type, arg2)
       VALUE_TYPE (arg2) = type;
       return arg2;
     }
+  else if (chill_varying_type (type))
+    {
+      struct type *range1, *range2, *eltype1, *eltype2;
+      value_ptr val;
+      int count1, count2;
+      char *valaddr, *valaddr_data;
+      if (code2 == TYPE_CODE_BITSTRING)
+       error ("not implemented: converting bitstring to varying type");
+      if ((code2 != TYPE_CODE_ARRAY && code2 != TYPE_CODE_STRING)
+         || (eltype1 = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1)),
+             eltype2 = TYPE_TARGET_TYPE (VALUE_TYPE (arg2)),
+             (TYPE_LENGTH (eltype1) != TYPE_LENGTH (eltype2)
+              /* || TYPE_CODE (eltype1) != TYPE_CODE (eltype2) */ )))
+       error ("Invalid conversion to varying type");
+      range1 = TYPE_FIELD_TYPE (TYPE_FIELD_TYPE (type, 1), 0);
+      range2 = TYPE_FIELD_TYPE (VALUE_TYPE (arg2), 0);
+      count1 = TYPE_HIGH_BOUND (range1) - TYPE_LOW_BOUND (range1) + 1;
+      count2 = TYPE_HIGH_BOUND (range2) - TYPE_LOW_BOUND (range2) + 1;
+      if (count2 > count1)
+       error ("target varying type is too small");
+      val = allocate_value (type);
+      valaddr = VALUE_CONTENTS_RAW (val);
+      valaddr_data = valaddr + TYPE_FIELD_BITPOS (type, 1) / 8;
+      /* Set val's __var_length field to count2. */
+      store_signed_integer (valaddr, TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)),
+                           count2);
+      /* Set the __var_data field to count2 elements copied from arg2. */
+      memcpy (valaddr_data, VALUE_CONTENTS (arg2),
+             count2 * TYPE_LENGTH (eltype2));
+      /* Zero the rest of the __var_data field of val. */
+      memset (valaddr_data + count2 * TYPE_LENGTH (eltype2), '\0',
+             (count1 - count2) * TYPE_LENGTH (eltype2));
+      return val;
+    }
   else if (VALUE_LVAL (arg2) == lval_memory)
     {
       return value_at_lazy (type, VALUE_ADDRESS (arg2) + VALUE_OFFSET (arg2));
@@ -679,8 +719,9 @@ value_addr (arg1)
       VALUE_TYPE (arg2) = lookup_pointer_type (TYPE_TARGET_TYPE (type));
       return arg2;
     }
-  if (VALUE_REPEATED (arg1)
-      || TYPE_CODE (type) == TYPE_CODE_ARRAY)
+  if (current_language->c_style_arrays
+      && (VALUE_REPEATED (arg1)
+         || TYPE_CODE (type) == TYPE_CODE_ARRAY))
     return value_coerce_array (arg1);
   if (TYPE_CODE (type) == TYPE_CODE_FUNC)
     return value_coerce_function (arg1);
@@ -799,8 +840,9 @@ value_arg_coerce (arg)
     arg = value_cast (builtin_type_unsigned_int, arg);
 
 #if 1  /* FIXME:  This is only a temporary patch.  -fnf */
-  if (VALUE_REPEATED (arg)
-      || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)
+  if (current_language->c_style_arrays
+      && (VALUE_REPEATED (arg)
+         || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY))
     arg = value_coerce_array (arg);
   if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FUNC)
     arg = value_coerce_function (arg);
@@ -1278,22 +1320,26 @@ value_string (ptr, len)
      int len;
 {
   value_ptr val;
-  struct type *rangetype;
-  struct type *stringtype;
+  struct type *rangetype = create_range_type ((struct type *) NULL,
+                                             builtin_type_int, 0, len - 1);
+  struct type *stringtype
+    = create_string_type ((struct type *) NULL, rangetype);
   CORE_ADDR addr;
 
+  if (current_language->c_style_arrays == 0)
+    {
+      val = allocate_value (stringtype);
+      memcpy (VALUE_CONTENTS_RAW (val), ptr, len);
+      return val;
+    }
+
+
   /* Allocate space to store the string in the inferior, and then
      copy LEN bytes from PTR in gdb to that address in the inferior. */
 
   addr = allocate_space_in_inferior (len);
   write_memory (addr, ptr, len);
 
-  /* Create the string type and set up a string value to be evaluated
-     lazily. */
-
-  rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
-                                0, len - 1);
-  stringtype = create_string_type ((struct type *) NULL, rangetype);
   val = value_at_lazy (stringtype, addr);
   return (val);
 }
@@ -2043,6 +2089,69 @@ f77_value_literal_string (lowbound, highbound, elemvec)
   return val;
 }
 
+/* Create a slice (sub-string, sub-array) of ARRAY, that is LENGTH elements
+   long, starting at LOWBOUND.  The result has the same lower bound as
+   the original ARRAY.  */
+
+value_ptr
+value_slice (array, lowbound, length)
+     value_ptr array;
+     int lowbound, length;
+{
+  if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_BITSTRING)
+    error ("not implemented - bitstring slice");
+  if (TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_ARRAY
+      && TYPE_CODE (VALUE_TYPE (array)) != TYPE_CODE_STRING)
+    error ("cannot take slice of non-array");
+  else
+    {
+      struct type *slice_range_type, *slice_type;
+      value_ptr slice;
+      struct type *range_type = TYPE_FIELD_TYPE (VALUE_TYPE (array), 0);
+      struct type *element_type = TYPE_TARGET_TYPE (VALUE_TYPE (array));
+      int lowerbound = TYPE_LOW_BOUND (range_type);
+      int upperbound = TYPE_HIGH_BOUND (range_type);
+      int offset = (lowbound - lowerbound) * TYPE_LENGTH (element_type);
+      if (lowbound < lowerbound || length < 0
+         || lowbound + length - 1 > upperbound)
+       error ("slice out of range");
+      slice_range_type = create_range_type ((struct type*) NULL,
+                                           TYPE_TARGET_TYPE (range_type),
+                                           lowerbound,
+                                           lowerbound + length - 1);
+      slice_type = create_array_type ((struct type*) NULL, element_type,
+                                     slice_range_type);
+      TYPE_CODE (slice_type) = TYPE_CODE (VALUE_TYPE (array));
+      slice = allocate_value (slice_type);
+      if (VALUE_LAZY (array))
+       VALUE_LAZY (slice) = 1;
+      else
+       memcpy (VALUE_CONTENTS (slice), VALUE_CONTENTS (array) + offset,
+               TYPE_LENGTH (slice_type));
+      if (VALUE_LVAL (array) == lval_internalvar)
+       VALUE_LVAL (slice) = lval_internalvar_component;
+      else
+       VALUE_LVAL (slice) = VALUE_LVAL (array);
+      VALUE_ADDRESS (slice) = VALUE_ADDRESS (array);
+      VALUE_OFFSET (slice) = VALUE_OFFSET (array) + offset;
+      return slice;
+    }
+}
+
+/* Assuming chill_varying_type (VARRAY) is true, return an equivalent
+   value as a fixed-length array. */
+
+value_ptr
+varying_to_slice (varray)
+     value_ptr varray;
+{
+  struct type *vtype = VALUE_TYPE (varray);
+  LONGEST length = unpack_long (TYPE_FIELD_TYPE (vtype, 0),
+                               VALUE_CONTENTS (varray)
+                               + TYPE_FIELD_BITPOS (vtype, 0) / 8);
+  return value_slice (value_primitive_field (varray, 0, 1, vtype), 0, length);
+}
+
 /* Create a value for a substring.  We copy data into a local 
    (NOT inferior's memory) buffer, and then set up an array value.
 
index 7708a440ba213823a3f2e150bca0af1c8c22f479..8979dbe06e5b74e63f7edc52abcddab71a95d105 100644 (file)
@@ -186,8 +186,9 @@ extern int value_fetch_lazy PARAMS ((value_ptr val));
 
 #define COERCE_ARRAY(arg)    \
 { COERCE_REF(arg);                                                     \
-  if (VALUE_REPEATED (arg)                                             \
-      || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)              \
+  if (current_language->c_style_arrays                                 \
+      && (VALUE_REPEATED (arg)                                         \
+         || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY))          \
     arg = value_coerce_array (arg);                                    \
   if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FUNC)                   \
     arg = value_coerce_function (arg);                                  \
@@ -195,6 +196,9 @@ extern int value_fetch_lazy PARAMS ((value_ptr val));
     arg = value_cast (builtin_type_unsigned_int, arg);                 \
 }
 
+#define COERCE_VARYING_ARRAY(arg)      \
+{ if (chill_varying_type (VALUE_TYPE (arg))) arg = varying_to_slice (arg); }
+
 /* If ARG is an enum, convert it to an integer.  */
 
 #define COERCE_ENUM(arg)    \
@@ -504,6 +508,10 @@ extern int baseclass_offset PARAMS ((struct type *, int, value_ptr, int));
 
 /* From valops.c */
 
+extern value_ptr varying_to_slice PARAMS ((value_ptr));
+
+extern value_ptr value_slice PARAMS ((value_ptr, int, int));
+
 extern value_ptr call_function_by_hand PARAMS ((value_ptr, int, value_ptr *));
 
 extern value_ptr f77_value_literal_complex PARAMS ((value_ptr, value_ptr, int));