home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 9 / FreshFishVol9-CD2.bin / bbs / gnu / gdb-4.14-src.lha / gdb-4.14 / gdb / eval.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-02-02  |  47.4 KB  |  1,598 lines
  1. /* Evaluate expressions for GDB.
  2.    Copyright 1986, 1987, 1989, 1991, 1992, 1993, 1994
  3.    Free Software Foundation, Inc.
  4.  
  5. This file is part of GDB.
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or
  10. (at your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20.  
  21. #include "defs.h"
  22. #include <string.h>
  23. #include "symtab.h"
  24. #include "gdbtypes.h"
  25. #include "value.h"
  26. #include "expression.h"
  27. #include "target.h"
  28. #include "frame.h"
  29. #include "demangle.h"
  30. #include "language.h"    /* For CAST_IS_CONVERSION */
  31. #include "f-lang.h" /* for array bound stuff */
  32.  
  33. /* Values of NOSIDE argument to eval_subexp.  */
  34.  
  35. enum noside
  36. {
  37.   EVAL_NORMAL,
  38.   EVAL_SKIP,            /* Only effect is to increment pos.  */
  39.   EVAL_AVOID_SIDE_EFFECTS    /* Don't modify any variables or
  40.                    call any functions.  The value
  41.                    returned will have the correct
  42.                    type, and will have an
  43.                    approximately correct lvalue
  44.                    type (inaccuracy: anything that is
  45.                    listed as being in a register in
  46.                    the function in which it was
  47.                    declared will be lval_register).  */
  48. };
  49.  
  50. /* Prototypes for local functions. */
  51.  
  52. static value_ptr evaluate_subexp_for_sizeof PARAMS ((struct expression *,
  53.                              int *));
  54.  
  55. static value_ptr evaluate_subexp_with_coercion PARAMS ((struct expression *,
  56.                             int *, enum noside));
  57.  
  58. static value_ptr evaluate_subexp_for_address PARAMS ((struct expression *,
  59.                               int *, enum noside));
  60.  
  61. static value_ptr evaluate_subexp PARAMS ((struct type *, struct expression *,
  62.                       int *, enum noside));
  63.  
  64.  
  65. /* Parse the string EXP as a C expression, evaluate it,
  66.    and return the result as a number.  */
  67.  
  68. CORE_ADDR
  69. parse_and_eval_address (exp)
  70.      char *exp;
  71. {
  72.   struct expression *expr = parse_expression (exp);
  73.   register CORE_ADDR addr;
  74.   register struct cleanup *old_chain = 
  75.       make_cleanup (free_current_contents, &expr);
  76.  
  77.   addr = value_as_pointer (evaluate_expression (expr));
  78.   do_cleanups (old_chain);
  79.   return addr;
  80. }
  81.  
  82. /* Like parse_and_eval_address but takes a pointer to a char * variable
  83.    and advanced that variable across the characters parsed.  */
  84.  
  85. CORE_ADDR
  86. parse_and_eval_address_1 (expptr)
  87.      char **expptr;
  88. {
  89.   struct expression *expr = parse_exp_1 (expptr, (struct block *)0, 0);
  90.   register CORE_ADDR addr;
  91.   register struct cleanup *old_chain =
  92.       make_cleanup (free_current_contents, &expr);
  93.  
  94.   addr = value_as_pointer (evaluate_expression (expr));
  95.   do_cleanups (old_chain);
  96.   return addr;
  97. }
  98.  
  99. value_ptr
  100. parse_and_eval (exp)
  101.      char *exp;
  102. {
  103.   struct expression *expr = parse_expression (exp);
  104.   register value_ptr val;
  105.   register struct cleanup *old_chain
  106.     = make_cleanup (free_current_contents, &expr);
  107.  
  108.   val = evaluate_expression (expr);
  109.   do_cleanups (old_chain);
  110.   return val;
  111. }
  112.  
  113. /* Parse up to a comma (or to a closeparen)
  114.    in the string EXPP as an expression, evaluate it, and return the value.
  115.    EXPP is advanced to point to the comma.  */
  116.  
  117. value_ptr
  118. parse_to_comma_and_eval (expp)
  119.      char **expp;
  120. {
  121.   struct expression *expr = parse_exp_1 (expp, (struct block *) 0, 1);
  122.   register value_ptr val;
  123.   register struct cleanup *old_chain
  124.     = make_cleanup (free_current_contents, &expr);
  125.  
  126.   val = evaluate_expression (expr);
  127.   do_cleanups (old_chain);
  128.   return val;
  129. }
  130.  
  131. /* Evaluate an expression in internal prefix form
  132.    such as is constructed by parse.y.
  133.  
  134.    See expression.h for info on the format of an expression.  */
  135.  
  136. value_ptr
  137. evaluate_expression (exp)
  138.      struct expression *exp;
  139. {
  140.   int pc = 0;
  141.   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_NORMAL);
  142. }
  143.  
  144. /* Evaluate an expression, avoiding all memory references
  145.    and getting a value whose type alone is correct.  */
  146.  
  147. value_ptr
  148. evaluate_type (exp)
  149.      struct expression *exp;
  150. {
  151.   int pc = 0;
  152.   return evaluate_subexp (NULL_TYPE, exp, &pc, EVAL_AVOID_SIDE_EFFECTS);
  153. }
  154.  
  155. /* Helper function called by evaluate_subexp to initialize a field
  156.    a structure from a tuple in Chill.  This is recursive, to handle
  157.    more than one field name labels.
  158.  
  159.    STRUCT_VAL is the structure value we are constructing.
  160.    (*FIELDNOP) is the field to set, if there is no label.
  161.    It is set to the field following this one.
  162.    EXP, POS, and NOSIDE are as for evaluate_subexp.
  163.  
  164.    This function does not handle variant records.  FIXME */
  165.  
  166. static value_ptr
  167. evaluate_labeled_field_init (struct_val, fieldnop, exp, pos, noside)
  168.      value_ptr struct_val;
  169.      int *fieldnop;
  170.      register struct expression *exp;
  171.      register int *pos;
  172.      enum noside noside;
  173. {
  174.   int fieldno = *fieldnop;
  175.   value_ptr val;
  176.   int bitpos, bitsize;
  177.   char *addr;
  178.   struct type *struct_type = VALUE_TYPE (struct_val);
  179.   if (exp->elts[*pos].opcode == OP_LABELED)
  180.     {
  181.       int pc = (*pos)++;
  182.       char *name = &exp->elts[pc + 2].string;
  183.       int tem = longest_to_int (exp->elts[pc + 1].longconst);
  184.       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
  185.       for (fieldno = 0; ; fieldno++)
  186.     {
  187.       if (fieldno >= TYPE_NFIELDS (struct_type))
  188.         error ("there is no field named %s", name);
  189.       if (STREQ (TYPE_FIELD_NAME (struct_type, fieldno), name))
  190.         break;
  191.     }
  192.       *fieldnop = fieldno;
  193.       val = evaluate_labeled_field_init (struct_val, fieldnop,
  194.                      exp, pos, noside);
  195.     }
  196.   else
  197.     {
  198.       fieldno = (*fieldnop)++;
  199.       if (fieldno >= TYPE_NFIELDS (struct_type))
  200.     error ("too many initializers");
  201.       val = evaluate_subexp (TYPE_FIELD_TYPE (struct_type, fieldno),
  202.                  exp, pos, noside);
  203.     }
  204.  
  205.   /* Assign val to field fieldno. */
  206.   if (VALUE_TYPE (val) != TYPE_FIELD_TYPE (struct_type, fieldno))
  207.     val = value_cast (TYPE_FIELD_TYPE (struct_type, fieldno), val);
  208. #if 1
  209.   bitsize = TYPE_FIELD_BITSIZE (struct_type, fieldno);
  210.   bitpos = TYPE_FIELD_BITPOS (struct_type, fieldno);
  211.   addr = VALUE_CONTENTS (struct_val);
  212.   addr += bitpos / 8;
  213.   if (bitsize)
  214.     modify_field (addr, value_as_long (val),
  215.           bitpos % 8, bitsize);
  216.   else
  217.     memcpy (addr, VALUE_CONTENTS (val),
  218.         TYPE_LENGTH (VALUE_TYPE (val)));
  219. #else
  220.   value_assign (value_primitive_field (struct_val, 0, fieldno, struct_type),
  221.         val);
  222. #endif
  223.   return val;
  224. }
  225.  
  226. static value_ptr
  227. evaluate_subexp (expect_type, exp, pos, noside)
  228.      struct type *expect_type;
  229.      register struct expression *exp;
  230.      register int *pos;
  231.      enum noside noside;
  232. {
  233.   enum exp_opcode op;
  234.   int tem, tem2, tem3;
  235.   register int pc, pc2 = 0, oldpos;
  236.   register value_ptr arg1 = NULL, arg2 = NULL, arg3;
  237.   struct type *type;
  238.   int nargs;
  239.   value_ptr *argvec;
  240.   struct symbol *tmp_symbol; 
  241.   int upper, lower, retcode; 
  242.   int code;
  243.   struct internalvar *var; 
  244.  
  245.   /* This expect_type crap should not be used for C.  C expressions do
  246.      not have any notion of expected types, never has and (goddess
  247.      willing) never will.  The C++ code uses it for some twisted
  248.      purpose (I haven't investigated but I suspect it just the usual
  249.      combination of Stroustrup figuring out some crazy language
  250.      feature and Tiemann figuring out some crazier way to try to
  251.      implement it).  CHILL has the tuple stuff; I don't know enough
  252.      about CHILL to know whether expected types is the way to do it.
  253.      FORTRAN I don't know.  */
  254.   if (exp->language_defn->la_language != language_cplus
  255.       && exp->language_defn->la_language != language_chill)
  256.     expect_type = NULL_TYPE;
  257.  
  258.   pc = (*pos)++;
  259.   op = exp->elts[pc].opcode;
  260.  
  261.   switch (op)
  262.     {
  263.     case OP_SCOPE:
  264.       tem = longest_to_int (exp->elts[pc + 2].longconst);
  265.       (*pos) += 4 + BYTES_TO_EXP_ELEM (tem + 1);
  266.       arg1 = value_struct_elt_for_reference (exp->elts[pc + 1].type,
  267.                          0,
  268.                          exp->elts[pc + 1].type,
  269.                          &exp->elts[pc + 3].string,
  270.                          expect_type);
  271.       if (arg1 == NULL)
  272.     error ("There is no field named %s", &exp->elts[pc + 3].string);
  273.       return arg1;
  274.  
  275.     case OP_LONG:
  276.       (*pos) += 3;
  277.       return value_from_longest (exp->elts[pc + 1].type,
  278.                  exp->elts[pc + 2].longconst);
  279.  
  280.     case OP_DOUBLE:
  281.       (*pos) += 3;
  282.       return value_from_double (exp->elts[pc + 1].type,
  283.                 exp->elts[pc + 2].doubleconst);
  284.  
  285.     case OP_VAR_VALUE:
  286.       (*pos) += 3;
  287.       if (noside == EVAL_SKIP)
  288.     goto nosideret;
  289.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  290.     {
  291.       struct symbol * sym = exp->elts[pc + 2].symbol;
  292.       enum lval_type lv;
  293.  
  294.       switch (SYMBOL_CLASS (sym))
  295.         {
  296.         case LOC_CONST:
  297.         case LOC_LABEL:
  298.         case LOC_CONST_BYTES:
  299.           lv = not_lval;
  300.           break;
  301.  
  302.         case LOC_REGISTER:
  303.         case LOC_REGPARM:
  304.           lv = lval_register;
  305.           break;
  306.  
  307.         default:
  308.           lv = lval_memory;
  309.           break;
  310.         }
  311.  
  312.       return value_zero (SYMBOL_TYPE (sym), lv);
  313.     }
  314.       else
  315.     return value_of_variable (exp->elts[pc + 2].symbol,
  316.                   exp->elts[pc + 1].block);
  317.  
  318.     case OP_LAST:
  319.       (*pos) += 2;
  320.       return
  321.     access_value_history (longest_to_int (exp->elts[pc + 1].longconst));
  322.  
  323.     case OP_REGISTER:
  324.       (*pos) += 2;
  325.       return value_of_register (longest_to_int (exp->elts[pc + 1].longconst));
  326.  
  327.     case OP_BOOL:
  328.       (*pos) += 2;
  329.       if (current_language->la_language == language_fortran)
  330.     return value_from_longest (builtin_type_f_logical_s2,
  331.                    exp->elts[pc + 1].longconst);
  332.       else
  333.     return value_from_longest (builtin_type_chill_bool,
  334.                    exp->elts[pc + 1].longconst);
  335.  
  336.     case OP_INTERNALVAR:
  337.       (*pos) += 2;
  338.       return value_of_internalvar (exp->elts[pc + 1].internalvar);
  339.  
  340.     case OP_STRING:
  341.       tem = longest_to_int (exp->elts[pc + 1].longconst);
  342.       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
  343.       if (noside == EVAL_SKIP)
  344.     goto nosideret;
  345.       return value_string (&exp->elts[pc + 2].string, tem);
  346.  
  347.     case OP_BITSTRING:
  348.       tem = longest_to_int (exp->elts[pc + 1].longconst);
  349.       (*pos)
  350.     += 3 + BYTES_TO_EXP_ELEM ((tem + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
  351.       if (noside == EVAL_SKIP)
  352.     goto nosideret;
  353.       return value_bitstring (&exp->elts[pc + 2].string, tem);
  354.       break;
  355.  
  356.     case OP_ARRAY:
  357.       (*pos) += 3;
  358.       tem2 = longest_to_int (exp->elts[pc + 1].longconst);
  359.       tem3 = longest_to_int (exp->elts[pc + 2].longconst);
  360.       nargs = tem3 - tem2 + 1;
  361.  
  362.       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
  363.       && TYPE_CODE (expect_type) == TYPE_CODE_STRUCT)
  364.     {
  365.       value_ptr rec = allocate_value (expect_type);
  366.       int fieldno = 0;
  367.       memset (VALUE_CONTENTS_RAW (rec), '\0', TYPE_LENGTH (expect_type));
  368.       for (tem = 0; tem < nargs; tem++)
  369.         evaluate_labeled_field_init (rec, &fieldno, exp, pos, noside);
  370.       return rec;
  371.     }
  372.  
  373.       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
  374.       && TYPE_CODE (expect_type) == TYPE_CODE_ARRAY)
  375.     {
  376.       struct type *range_type = TYPE_FIELD_TYPE (expect_type, 0);
  377.       struct type *element_type = TYPE_TARGET_TYPE (expect_type);
  378.       LONGEST low_bound =  TYPE_FIELD_BITPOS (range_type, 0);
  379.       LONGEST high_bound = TYPE_FIELD_BITPOS (range_type, 1);
  380.       int element_size = TYPE_LENGTH (element_type);
  381.       value_ptr array = allocate_value (expect_type);
  382.       if (nargs != (high_bound - low_bound + 1))
  383.         error ("wrong number of initialiers for array type");
  384.       for (tem = low_bound;  tem <= high_bound;  tem++)
  385.         {
  386.           value_ptr element = evaluate_subexp (element_type,
  387.                            exp, pos, noside);
  388.           if (VALUE_TYPE (element) != element_type)
  389.         element = value_cast (element_type, element);
  390.           memcpy (VALUE_CONTENTS_RAW (array)
  391.               + (tem - low_bound) * element_size,
  392.               VALUE_CONTENTS (element),
  393.               element_size);
  394.         }
  395.       return array;
  396.     }
  397.  
  398.       if (expect_type != NULL_TYPE && noside != EVAL_SKIP
  399.       && TYPE_CODE (expect_type) == TYPE_CODE_SET)
  400.     {
  401.       value_ptr set = allocate_value (expect_type);
  402.       struct type *element_type = TYPE_INDEX_TYPE (expect_type);
  403.       int low_bound = TYPE_LOW_BOUND (element_type);
  404.       int high_bound = TYPE_HIGH_BOUND (element_type);
  405.       char *valaddr = VALUE_CONTENTS_RAW (set);
  406.       memset (valaddr, '\0', TYPE_LENGTH (expect_type));
  407.       for (tem = 0; tem < nargs; tem++)
  408.         {
  409.           value_ptr element_val = evaluate_subexp (element_type,
  410.                                exp, pos, noside);
  411.           LONGEST element = value_as_long (element_val);
  412.           int bit_index;
  413.           if (element < low_bound || element > high_bound)
  414.         error ("POWERSET tuple element out of range");
  415.           element -= low_bound;
  416.           bit_index = (unsigned) element % TARGET_CHAR_BIT;
  417.           if (BITS_BIG_ENDIAN)
  418.         bit_index = TARGET_CHAR_BIT - 1 - bit_index;
  419.           valaddr [(unsigned) element / TARGET_CHAR_BIT] |= 1 << bit_index;
  420.         }
  421.       return set;
  422.     }
  423.  
  424.       argvec = (value_ptr *) alloca (sizeof (value_ptr) * nargs);
  425.       for (tem = 0; tem < nargs; tem++)
  426.     {
  427.       /* Ensure that array expressions are coerced into pointer objects. */
  428.       argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
  429.     }
  430.       if (noside == EVAL_SKIP)
  431.     goto nosideret;
  432.       return value_array (tem2, tem3, argvec);
  433.  
  434.     case TERNOP_SLICE:
  435.       {
  436.     value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  437.     int lowbound
  438.       = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
  439.     int upper
  440.       = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
  441.     return value_slice (array, lowbound, upper - lowbound + 1);
  442.       }
  443.  
  444.     case TERNOP_SLICE_COUNT:
  445.       {
  446.     value_ptr array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  447.     int lowbound
  448.       = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
  449.     int length
  450.       = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
  451.     return value_slice (array, lowbound, length);
  452.       }
  453.  
  454.     case TERNOP_COND:
  455.       /* Skip third and second args to evaluate the first one.  */
  456.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  457.       if (value_logical_not (arg1))
  458.     {
  459.       evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
  460.       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
  461.     }
  462.       else
  463.     {
  464.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  465.       evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
  466.       return arg2;
  467.     }
  468.  
  469.     case OP_FUNCALL:
  470.       (*pos) += 2;
  471.       op = exp->elts[*pos].opcode;
  472.       if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
  473.     {
  474.       LONGEST fnptr;
  475.  
  476.       nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
  477.       /* First, evaluate the structure into arg2 */
  478.       pc2 = (*pos)++;
  479.  
  480.       if (noside == EVAL_SKIP)
  481.         goto nosideret;
  482.  
  483.       if (op == STRUCTOP_MEMBER)
  484.         {
  485.           arg2 = evaluate_subexp_for_address (exp, pos, noside);
  486.         }
  487.       else
  488.         {
  489.           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  490.         }
  491.  
  492.       /* If the function is a virtual function, then the
  493.          aggregate value (providing the structure) plays
  494.          its part by providing the vtable.  Otherwise,
  495.          it is just along for the ride: call the function
  496.          directly.  */
  497.  
  498.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  499.  
  500.       fnptr = value_as_long (arg1);
  501.  
  502.       if (METHOD_PTR_IS_VIRTUAL(fnptr))
  503.         {
  504.           int fnoffset = METHOD_PTR_TO_VOFFSET(fnptr);
  505.           struct type *basetype;
  506.           struct type *domain_type =
  507.           TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
  508.           int i, j;
  509.           basetype = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
  510.           if (domain_type != basetype)
  511.           arg2 = value_cast(lookup_pointer_type (domain_type), arg2);
  512.           basetype = TYPE_VPTR_BASETYPE (domain_type);
  513.           for (i = TYPE_NFN_FIELDS (basetype) - 1; i >= 0; i--)
  514.         {
  515.           struct fn_field *f = TYPE_FN_FIELDLIST1 (basetype, i);
  516.           /* If one is virtual, then all are virtual.  */
  517.           if (TYPE_FN_FIELD_VIRTUAL_P (f, 0))
  518.             for (j = TYPE_FN_FIELDLIST_LENGTH (basetype, i) - 1; j >= 0; --j)
  519.               if (TYPE_FN_FIELD_VOFFSET (f, j) == fnoffset)
  520.             {
  521.               value_ptr temp = value_ind (arg2);
  522.               arg1 = value_virtual_fn_field (&temp, f, j, domain_type, 0);
  523.               arg2 = value_addr (temp);
  524.               goto got_it;
  525.             }
  526.         }
  527.           if (i < 0)
  528.         error ("virtual function at index %d not found", fnoffset);
  529.         }
  530.       else
  531.         {
  532.           VALUE_TYPE (arg1) = lookup_pointer_type (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)));
  533.         }
  534.     got_it:
  535.  
  536.       /* Now, say which argument to start evaluating from */
  537.       tem = 2;
  538.     }
  539.       else if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
  540.     {
  541.       /* Hair for method invocations */
  542.       int tem2;
  543.  
  544.       nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
  545.       /* First, evaluate the structure into arg2 */
  546.       pc2 = (*pos)++;
  547.       tem2 = longest_to_int (exp->elts[pc2 + 1].longconst);
  548.       *pos += 3 + BYTES_TO_EXP_ELEM (tem2 + 1);
  549.       if (noside == EVAL_SKIP)
  550.         goto nosideret;
  551.  
  552.       if (op == STRUCTOP_STRUCT)
  553.         {
  554.           /* If v is a variable in a register, and the user types
  555.          v.method (), this will produce an error, because v has
  556.          no address.
  557.  
  558.          A possible way around this would be to allocate a
  559.          copy of the variable on the stack, copy in the
  560.          contents, call the function, and copy out the
  561.          contents.  I.e. convert this from call by reference
  562.          to call by copy-return (or whatever it's called).
  563.          However, this does not work because it is not the
  564.          same: the method being called could stash a copy of
  565.          the address, and then future uses through that address
  566.          (after the method returns) would be expected to
  567.          use the variable itself, not some copy of it.  */
  568.           arg2 = evaluate_subexp_for_address (exp, pos, noside);
  569.         }
  570.       else
  571.         {
  572.           arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  573.         }
  574.       /* Now, say which argument to start evaluating from */
  575.       tem = 2;
  576.     }
  577.       else
  578.     {
  579.       nargs = longest_to_int (exp->elts[pc + 1].longconst);
  580.       tem = 0;
  581.     }
  582.       /* Allocate arg vector, including space for the function to be
  583.      called in argvec[0] and a terminating NULL */
  584.       argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
  585.       for (; tem <= nargs; tem++)
  586.     /* Ensure that array expressions are coerced into pointer objects. */
  587.     argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
  588.  
  589.       /* signal end of arglist */
  590.       argvec[tem] = 0;
  591.  
  592.       if (op == STRUCTOP_STRUCT || op == STRUCTOP_PTR)
  593.     {
  594.       int static_memfuncp;
  595.       value_ptr temp = arg2;
  596.       char tstr[64];
  597.  
  598.       argvec[1] = arg2;
  599.       argvec[0] = 0;
  600.       strcpy(tstr, &exp->elts[pc2+2].string);
  601.           if (!argvec[0]) 
  602.         {
  603.           temp = arg2;
  604.           argvec[0] =
  605.           value_struct_elt (&temp, argvec+1, tstr,
  606.                   &static_memfuncp,
  607.                   op == STRUCTOP_STRUCT
  608.                   ? "structure" : "structure pointer");
  609.         }
  610.       arg2 = value_from_longest (lookup_pointer_type(VALUE_TYPE (temp)),
  611.              VALUE_ADDRESS (temp)+VALUE_OFFSET (temp));
  612.       argvec[1] = arg2;
  613.  
  614.       if (static_memfuncp)
  615.         {
  616.           argvec[1] = argvec[0];
  617.           nargs--;
  618.           argvec++;
  619.         }
  620.     }
  621.       else if (op == STRUCTOP_MEMBER || op == STRUCTOP_MPTR)
  622.     {
  623.       argvec[1] = arg2;
  624.       argvec[0] = arg1;
  625.     }
  626.  
  627.     do_call_it:
  628.  
  629.       if (noside == EVAL_SKIP)
  630.     goto nosideret;
  631.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  632.     {
  633.       /* If the return type doesn't look like a function type, call an
  634.          error.  This can happen if somebody tries to turn a variable into
  635.          a function call. This is here because people often want to
  636.          call, eg, strcmp, which gdb doesn't know is a function.  If
  637.          gdb isn't asked for it's opinion (ie. through "whatis"),
  638.          it won't offer it. */
  639.  
  640.       struct type *ftype =
  641.         TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0]));
  642.  
  643.       if (ftype)
  644.         return allocate_value (TYPE_TARGET_TYPE (VALUE_TYPE (argvec[0])));
  645.       else
  646.         error ("Expression of type other than \"Function returning ...\" used as function");
  647.     }
  648.       return call_function_by_hand (argvec[0], nargs, argvec + 1);
  649.  
  650.     case OP_F77_UNDETERMINED_ARGLIST: 
  651.  
  652.       /* Remember that in F77, functions, substring ops and 
  653.          array subscript operations cannot be disambiguated 
  654.          at parse time.  We have made all array subscript operations, 
  655.          substring operations as well as function calls  come here 
  656.          and we now have to discover what the heck this thing actually was.  
  657.      If it is a function, we process just as if we got an OP_FUNCALL. */
  658.  
  659.       nargs = longest_to_int (exp->elts[pc+1].longconst);
  660.       (*pos) += 2;
  661.  
  662.       /* First determine the type code we are dealing with.  */ 
  663.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  664.       code = TYPE_CODE (VALUE_TYPE (arg1)); 
  665.  
  666.       switch (code) 
  667.     {
  668.     case TYPE_CODE_ARRAY:
  669.       goto multi_f77_subscript;
  670.  
  671.     case TYPE_CODE_STRING:
  672.       goto op_f77_substr;
  673.  
  674.     case TYPE_CODE_PTR:
  675.     case TYPE_CODE_FUNC:
  676.       /* It's a function call. */
  677.       /* Allocate arg vector, including space for the function to be
  678.          called in argvec[0] and a terminating NULL */
  679.       argvec = (value_ptr *) alloca (sizeof (value_ptr) * (nargs + 2));
  680.       argvec[0] = arg1;
  681.       tem = 1;
  682.       for (; tem <= nargs; tem++)
  683.         argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
  684.       argvec[tem] = 0; /* signal end of arglist */
  685.       goto do_call_it;
  686.  
  687.     default:
  688.               error ("Cannot perform substring on this type"); 
  689.     }
  690.  
  691.     op_f77_substr:
  692.       /* We have a substring operation on our hands here, 
  693.          let us get the string we will be dealing with */
  694.  
  695.       /* Now evaluate the 'from' and 'to' */
  696.  
  697.       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  698.  
  699.       if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
  700.          error ("Substring arguments must be of type integer");
  701.  
  702.       if (nargs < 2)
  703.     return value_subscript (arg1, arg2);
  704.  
  705.       arg3 = evaluate_subexp_with_coercion (exp, pos, noside);
  706.  
  707.       if (TYPE_CODE (VALUE_TYPE (arg3)) != TYPE_CODE_INT)
  708.          error ("Substring arguments must be of type integer");
  709.  
  710.       tem2 = *((int *) VALUE_CONTENTS_RAW (arg2)); 
  711.       tem3 = *((int *) VALUE_CONTENTS_RAW (arg3)); 
  712.  
  713.       if ((tem2 < 1) || (tem2 > tem3))
  714.          error ("Bad 'from' value %d on substring operation", tem2); 
  715.  
  716.       if ((tem3 < tem2) || (tem3 > (TYPE_LENGTH (VALUE_TYPE (arg1)))))
  717.          error ("Bad 'to' value %d on substring operation", tem3); 
  718.       
  719.       if (noside == EVAL_SKIP)
  720.         goto nosideret;
  721.       
  722.       return value_slice (arg1, tem2, tem3 - tem2 + 1);
  723.  
  724.     case OP_COMPLEX:
  725.       /* We have a complex number, There should be 2 floating 
  726.      point numbers that compose it */ 
  727.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  728.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 
  729.  
  730.       return value_literal_complex (arg1, arg2, builtin_type_f_complex_s16);
  731.  
  732.     case STRUCTOP_STRUCT:
  733.       tem = longest_to_int (exp->elts[pc + 1].longconst);
  734.       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
  735.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  736.       if (noside == EVAL_SKIP)
  737.     goto nosideret;
  738.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  739.     return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
  740.                            &exp->elts[pc + 2].string,
  741.                            0),
  742.                lval_memory);
  743.       else
  744.     {
  745.       value_ptr temp = arg1;
  746.       return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
  747.                    NULL, "structure");
  748.     }
  749.  
  750.     case STRUCTOP_PTR:
  751.       tem = longest_to_int (exp->elts[pc + 1].longconst);
  752.       (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
  753.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  754.       if (noside == EVAL_SKIP)
  755.     goto nosideret;
  756.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  757.     return value_zero (lookup_struct_elt_type (VALUE_TYPE (arg1),
  758.                            &exp->elts[pc + 2].string,
  759.                            0),
  760.                lval_memory);
  761.       else
  762.     {
  763.       value_ptr temp = arg1;
  764.       return value_struct_elt (&temp, NULL, &exp->elts[pc + 2].string,
  765.                    NULL, "structure pointer");
  766.     }
  767.  
  768.     case STRUCTOP_MEMBER:
  769.       arg1 = evaluate_subexp_for_address (exp, pos, noside);
  770.       goto handle_pointer_to_member;
  771.     case STRUCTOP_MPTR:
  772.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  773.     handle_pointer_to_member:
  774.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  775.       if (noside == EVAL_SKIP)
  776.     goto nosideret;
  777.       if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_PTR)
  778.     goto bad_pointer_to_member;
  779.       type = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
  780.       if (TYPE_CODE (type) == TYPE_CODE_METHOD)
  781.     error ("not implemented: pointer-to-method in pointer-to-member construct");
  782.       if (TYPE_CODE (type) != TYPE_CODE_MEMBER)
  783.     goto bad_pointer_to_member;
  784.       /* Now, convert these values to an address.  */
  785.       arg1 = value_cast (lookup_pointer_type (TYPE_DOMAIN_TYPE (type)),
  786.              arg1);
  787.       arg3 = value_from_longest (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
  788.                  value_as_long (arg1) + value_as_long (arg2));
  789.       return value_ind (arg3);
  790.     bad_pointer_to_member:
  791.       error("non-pointer-to-member value used in pointer-to-member construct");
  792.  
  793.     case BINOP_CONCAT:
  794.       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
  795.       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  796.       if (noside == EVAL_SKIP)
  797.     goto nosideret;
  798.       if (binop_user_defined_p (op, arg1, arg2))
  799.     return value_x_binop (arg1, arg2, op, OP_NULL);
  800.       else
  801.     return value_concat (arg1, arg2);
  802.  
  803.     case BINOP_ASSIGN:
  804.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  805.       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
  806.       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
  807.     return arg1;
  808.       if (binop_user_defined_p (op, arg1, arg2))
  809.     return value_x_binop (arg1, arg2, op, OP_NULL);
  810.       else
  811.     return value_assign (arg1, arg2);
  812.  
  813.     case BINOP_ASSIGN_MODIFY:
  814.       (*pos) += 2;
  815.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  816.       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
  817.       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
  818.     return arg1;
  819.       op = exp->elts[pc + 1].opcode;
  820.       if (binop_user_defined_p (op, arg1, arg2))
  821.     return value_x_binop (arg1, arg2, BINOP_ASSIGN_MODIFY, op);
  822.       else if (op == BINOP_ADD)
  823.     arg2 = value_add (arg1, arg2);
  824.       else if (op == BINOP_SUB)
  825.     arg2 = value_sub (arg1, arg2);
  826.       else
  827.     arg2 = value_binop (arg1, arg2, op);
  828.       return value_assign (arg1, arg2);
  829.  
  830.     case BINOP_ADD:
  831.       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
  832.       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  833.       if (noside == EVAL_SKIP)
  834.     goto nosideret;
  835.       if (binop_user_defined_p (op, arg1, arg2))
  836.     return value_x_binop (arg1, arg2, op, OP_NULL);
  837.       else
  838.     return value_add (arg1, arg2);
  839.  
  840.     case BINOP_SUB:
  841.       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
  842.       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  843.       if (noside == EVAL_SKIP)
  844.     goto nosideret;
  845.       if (binop_user_defined_p (op, arg1, arg2))
  846.     return value_x_binop (arg1, arg2, op, OP_NULL);
  847.       else
  848.     return value_sub (arg1, arg2);
  849.  
  850.     case BINOP_MUL:
  851.     case BINOP_DIV:
  852.     case BINOP_REM:
  853.     case BINOP_MOD:
  854.     case BINOP_LSH:
  855.     case BINOP_RSH:
  856.     case BINOP_BITWISE_AND:
  857.     case BINOP_BITWISE_IOR:
  858.     case BINOP_BITWISE_XOR:
  859.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  860.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  861.       if (noside == EVAL_SKIP)
  862.     goto nosideret;
  863.       if (binop_user_defined_p (op, arg1, arg2))
  864.     return value_x_binop (arg1, arg2, op, OP_NULL);
  865.       else
  866.     if (noside == EVAL_AVOID_SIDE_EFFECTS
  867.         && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
  868.       return value_zero (VALUE_TYPE (arg1), not_lval);
  869.       else
  870.     return value_binop (arg1, arg2, op);
  871.  
  872.     case BINOP_SUBSCRIPT:
  873.       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
  874.       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  875.       if (noside == EVAL_SKIP)
  876.     goto nosideret;
  877.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  878.     {
  879.       /* If the user attempts to subscript something that has no target
  880.          type (like a plain int variable for example), then report this
  881.          as an error. */
  882.  
  883.       type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
  884.       if (type)
  885.         return value_zero (type, VALUE_LVAL (arg1));
  886.       else
  887.         error ("cannot subscript something of type `%s'",
  888.            TYPE_NAME (VALUE_TYPE (arg1)));
  889.     }
  890.                
  891.       if (binop_user_defined_p (op, arg1, arg2))
  892.     return value_x_binop (arg1, arg2, op, OP_NULL);
  893.       else
  894.     return value_subscript (arg1, arg2);
  895.  
  896.     case BINOP_IN:
  897.       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
  898.       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  899.       if (noside == EVAL_SKIP)
  900.     goto nosideret;
  901.       return value_in (arg1, arg2);
  902.       
  903.     case MULTI_SUBSCRIPT:
  904.       (*pos) += 2;
  905.       nargs = longest_to_int (exp->elts[pc + 1].longconst);
  906.       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
  907.       while (nargs-- > 0)
  908.     {
  909.       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  910.       /* FIXME:  EVAL_SKIP handling may not be correct. */
  911.       if (noside == EVAL_SKIP)
  912.         {
  913.           if (nargs > 0)
  914.         {
  915.           continue;
  916.         }
  917.           else
  918.         {
  919.           goto nosideret;
  920.         }
  921.         }
  922.       /* FIXME:  EVAL_AVOID_SIDE_EFFECTS handling may not be correct. */
  923.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  924.         {
  925.           /* If the user attempts to subscript something that has no target
  926.          type (like a plain int variable for example), then report this
  927.          as an error. */
  928.           
  929.           type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
  930.           if (type != NULL)
  931.         {
  932.           arg1 = value_zero (type, VALUE_LVAL (arg1));
  933.           noside = EVAL_SKIP;
  934.           continue;
  935.         }
  936.           else
  937.         {
  938.           error ("cannot subscript something of type `%s'",
  939.              TYPE_NAME (VALUE_TYPE (arg1)));
  940.         }
  941.         }
  942.       
  943.       if (binop_user_defined_p (op, arg1, arg2)
  944.           && ! chill_varying_type (VALUE_TYPE (arg1)))
  945.         {
  946.           arg1 = value_x_binop (arg1, arg2, op, OP_NULL);
  947.         }
  948.       else
  949.         {
  950.           arg1 = value_subscript (arg1, arg2);
  951.         }
  952.     }
  953.       return (arg1);
  954.  
  955.     multi_f77_subscript:
  956.       { 
  957.     int subscript_array[MAX_FORTRAN_DIMS+1]; /* 1-based array of 
  958.                             subscripts, max == 7 */
  959.     int array_size_array[MAX_FORTRAN_DIMS+1];
  960.     int ndimensions=1,i;
  961.     struct type *tmp_type; 
  962.     int offset_item;   /* The array offset where the item lives */ 
  963.     int fixed_subscript; 
  964.  
  965.     if (nargs > MAX_FORTRAN_DIMS)
  966.       error ("Too many subscripts for F77 (%d Max)", MAX_FORTRAN_DIMS);
  967.          
  968.     ndimensions = calc_f77_array_dims (VALUE_TYPE (arg1)); 
  969.  
  970.     if (nargs != ndimensions)
  971.       error ("Wrong number of subscripts");
  972.  
  973.     /* Now that we know we have a legal array subscript expression 
  974.        let us actually find out where this element exists in the array. */ 
  975.  
  976.     tmp_type = VALUE_TYPE (arg1);
  977.     offset_item = 0; 
  978.     for (i = 1; i <= nargs; i++)
  979.       {
  980.         /* Evaluate each subscript, It must be a legal integer in F77 */ 
  981.         arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  982.  
  983.         if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
  984.           error ("Array subscripts must be of type integer");
  985.  
  986.         /* Fill in the subscript and array size arrays */ 
  987.  
  988.         subscript_array[i] = (* (unsigned int *) VALUE_CONTENTS(arg2)); 
  989.                
  990.         retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
  991.         if (retcode == BOUND_FETCH_ERROR)
  992.           error ("Cannot obtain dynamic upper bound"); 
  993.  
  994.         retcode = f77_get_dynamic_lowerbound (tmp_type, &lower); 
  995.         if (retcode == BOUND_FETCH_ERROR)
  996.           error("Cannot obtain dynamic lower bound"); 
  997.  
  998.         array_size_array[i] = upper - lower + 1;
  999.                
  1000.         /* Zero-normalize subscripts so that offsetting will work. */ 
  1001.                
  1002.         subscript_array[i] -= lower;
  1003.  
  1004.         /* If we are at the bottom of a multidimensional 
  1005.            array type then keep a ptr to the last ARRAY
  1006.            type around for use when calling value_subscript()
  1007.            below. This is done because we pretend to value_subscript
  1008.            that we actually have a one-dimensional array 
  1009.            of base element type that we apply a simple 
  1010.            offset to. */ 
  1011.  
  1012.         if (i < nargs) 
  1013.           tmp_type = TYPE_TARGET_TYPE (tmp_type); 
  1014.       }
  1015.  
  1016.     /* Now let us calculate the offset for this item */
  1017.  
  1018.     offset_item = subscript_array[ndimensions]; 
  1019.          
  1020.     for (i = ndimensions - 1; i >= 1; i--)
  1021.       offset_item = 
  1022.         array_size_array[i] * offset_item + subscript_array[i];
  1023.  
  1024.     /* Construct a value node with the value of the offset */
  1025.  
  1026.     arg2 = value_from_longest (builtin_type_f_integer, offset_item); 
  1027.  
  1028.     /* Let us now play a dirty trick: we will take arg1 
  1029.        which is a value node pointing to the topmost level
  1030.        of the multidimensional array-set and pretend
  1031.        that it is actually a array of the final element 
  1032.        type, this will ensure that value_subscript()
  1033.        returns the correct type value */
  1034.  
  1035.     VALUE_TYPE (arg1) = tmp_type; 
  1036.     return value_ind (value_add (value_coerce_array (arg1), arg2));
  1037.       }
  1038.  
  1039.     case BINOP_LOGICAL_AND:
  1040.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1041.       if (noside == EVAL_SKIP)
  1042.     {
  1043.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1044.       goto nosideret;
  1045.     }
  1046.       
  1047.       oldpos = *pos;
  1048.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
  1049.       *pos = oldpos;
  1050.       
  1051.       if (binop_user_defined_p (op, arg1, arg2)) 
  1052.     {
  1053.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1054.       return value_x_binop (arg1, arg2, op, OP_NULL);
  1055.     }
  1056.       else
  1057.     {
  1058.       tem = value_logical_not (arg1);
  1059.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
  1060.                   (tem ? EVAL_SKIP : noside));
  1061.       return value_from_longest (builtin_type_int,
  1062.                   (LONGEST) (!tem && !value_logical_not (arg2)));
  1063.     }
  1064.  
  1065.     case BINOP_LOGICAL_OR:
  1066.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1067.       if (noside == EVAL_SKIP)
  1068.     {
  1069.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1070.       goto nosideret;
  1071.     }
  1072.       
  1073.       oldpos = *pos;
  1074.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
  1075.       *pos = oldpos;
  1076.       
  1077.       if (binop_user_defined_p (op, arg1, arg2)) 
  1078.     {
  1079.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1080.       return value_x_binop (arg1, arg2, op, OP_NULL);
  1081.     }
  1082.       else
  1083.     {
  1084.       tem = value_logical_not (arg1);
  1085.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos,
  1086.                   (!tem ? EVAL_SKIP : noside));
  1087.       return value_from_longest (builtin_type_int,
  1088.                   (LONGEST) (!tem || !value_logical_not (arg2)));
  1089.     }
  1090.  
  1091.     case BINOP_EQUAL:
  1092.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1093.       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
  1094.       if (noside == EVAL_SKIP)
  1095.     goto nosideret;
  1096.       if (binop_user_defined_p (op, arg1, arg2))
  1097.     {
  1098.       return value_x_binop (arg1, arg2, op, OP_NULL);
  1099.     }
  1100.       else
  1101.     {
  1102.       tem = value_equal (arg1, arg2);
  1103.       return value_from_longest (builtin_type_int, (LONGEST) tem);
  1104.     }
  1105.  
  1106.     case BINOP_NOTEQUAL:
  1107.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1108.       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
  1109.       if (noside == EVAL_SKIP)
  1110.     goto nosideret;
  1111.       if (binop_user_defined_p (op, arg1, arg2))
  1112.     {
  1113.       return value_x_binop (arg1, arg2, op, OP_NULL);
  1114.     }
  1115.       else
  1116.     {
  1117.       tem = value_equal (arg1, arg2);
  1118.       return value_from_longest (builtin_type_int, (LONGEST) ! tem);
  1119.     }
  1120.  
  1121.     case BINOP_LESS:
  1122.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1123.       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
  1124.       if (noside == EVAL_SKIP)
  1125.     goto nosideret;
  1126.       if (binop_user_defined_p (op, arg1, arg2))
  1127.     {
  1128.       return value_x_binop (arg1, arg2, op, OP_NULL);
  1129.     }
  1130.       else
  1131.     {
  1132.       tem = value_less (arg1, arg2);
  1133.       return value_from_longest (builtin_type_int, (LONGEST) tem);
  1134.     }
  1135.  
  1136.     case BINOP_GTR:
  1137.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1138.       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
  1139.       if (noside == EVAL_SKIP)
  1140.     goto nosideret;
  1141.       if (binop_user_defined_p (op, arg1, arg2))
  1142.     {
  1143.       return value_x_binop (arg1, arg2, op, OP_NULL);
  1144.     }
  1145.       else
  1146.     {
  1147.       tem = value_less (arg2, arg1);
  1148.       return value_from_longest (builtin_type_int, (LONGEST) tem);
  1149.     }
  1150.  
  1151.     case BINOP_GEQ:
  1152.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1153.       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
  1154.       if (noside == EVAL_SKIP)
  1155.     goto nosideret;
  1156.       if (binop_user_defined_p (op, arg1, arg2))
  1157.     {
  1158.       return value_x_binop (arg1, arg2, op, OP_NULL);
  1159.     }
  1160.       else
  1161.     {
  1162.       tem = value_less (arg2, arg1) || value_equal (arg1, arg2);
  1163.       return value_from_longest (builtin_type_int, (LONGEST) tem);
  1164.     }
  1165.  
  1166.     case BINOP_LEQ:
  1167.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1168.       arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside);
  1169.       if (noside == EVAL_SKIP)
  1170.     goto nosideret;
  1171.       if (binop_user_defined_p (op, arg1, arg2))
  1172.     {
  1173.       return value_x_binop (arg1, arg2, op, OP_NULL);
  1174.     }
  1175.       else 
  1176.     {
  1177.       tem = value_less (arg1, arg2) || value_equal (arg1, arg2);
  1178.       return value_from_longest (builtin_type_int, (LONGEST) tem);
  1179.     }
  1180.  
  1181.     case BINOP_REPEAT:
  1182.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1183.       arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1184.       if (noside == EVAL_SKIP)
  1185.     goto nosideret;
  1186.       if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT)
  1187.     error ("Non-integral right operand for \"@\" operator.");
  1188.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  1189.     return allocate_repeat_value (VALUE_TYPE (arg1),
  1190.                       longest_to_int (value_as_long (arg2)));
  1191.       else
  1192.     return value_repeat (arg1, longest_to_int (value_as_long (arg2)));
  1193.  
  1194.     case BINOP_COMMA:
  1195.       evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1196.       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1197.  
  1198.     case UNOP_NEG:
  1199.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1200.       if (noside == EVAL_SKIP)
  1201.     goto nosideret;
  1202.       if (unop_user_defined_p (op, arg1))
  1203.     return value_x_unop (arg1, op);
  1204.       else
  1205.     return value_neg (arg1);
  1206.  
  1207.     case UNOP_COMPLEMENT:
  1208.       /* C++: check for and handle destructor names.  */
  1209.       op = exp->elts[*pos].opcode;
  1210.  
  1211.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1212.       if (noside == EVAL_SKIP)
  1213.     goto nosideret;
  1214.       if (unop_user_defined_p (UNOP_COMPLEMENT, arg1))
  1215.     return value_x_unop (arg1, UNOP_COMPLEMENT);
  1216.       else
  1217.     return value_complement (arg1);
  1218.  
  1219.     case UNOP_LOGICAL_NOT:
  1220.       arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1221.       if (noside == EVAL_SKIP)
  1222.     goto nosideret;
  1223.       if (unop_user_defined_p (op, arg1))
  1224.     return value_x_unop (arg1, op);
  1225.       else
  1226.     return value_from_longest (builtin_type_int,
  1227.                    (LONGEST) value_logical_not (arg1));
  1228.  
  1229.     case UNOP_IND:
  1230.       if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
  1231.         expect_type = TYPE_TARGET_TYPE (expect_type);
  1232.       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
  1233.       if (noside == EVAL_SKIP)
  1234.     goto nosideret;
  1235.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  1236.     {
  1237.       if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR
  1238.           || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_REF
  1239.           /* In C you can dereference an array to get the 1st elt.  */
  1240.           || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_ARRAY
  1241.           )
  1242.         return value_zero (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)),
  1243.                    lval_memory);
  1244.       else if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_INT)
  1245.         /* GDB allows dereferencing an int.  */
  1246.         return value_zero (builtin_type_int, lval_memory);
  1247.       else
  1248.         error ("Attempt to take contents of a non-pointer value.");
  1249.     }
  1250.       return value_ind (arg1);
  1251.  
  1252.     case UNOP_ADDR:
  1253.       /* C++: check for and handle pointer to members.  */
  1254.       
  1255.       op = exp->elts[*pos].opcode;
  1256.  
  1257.       if (noside == EVAL_SKIP)
  1258.     {
  1259.       if (op == OP_SCOPE)
  1260.         {
  1261.           int temm = longest_to_int (exp->elts[pc+3].longconst);
  1262.           (*pos) += 3 + BYTES_TO_EXP_ELEM (temm + 1);
  1263.         }
  1264.       else
  1265.         evaluate_subexp (expect_type, exp, pos, EVAL_SKIP);
  1266.       goto nosideret;
  1267.     }
  1268.  
  1269.       return evaluate_subexp_for_address (exp, pos, noside);
  1270.  
  1271.     case UNOP_SIZEOF:
  1272.       if (noside == EVAL_SKIP)
  1273.     {
  1274.       evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
  1275.       goto nosideret;
  1276.     }
  1277.       return evaluate_subexp_for_sizeof (exp, pos);
  1278.  
  1279.     case UNOP_CAST:
  1280.       (*pos) += 2;
  1281.       type = exp->elts[pc + 1].type;
  1282.       arg1 = evaluate_subexp (type, exp, pos, noside);
  1283.       if (noside == EVAL_SKIP)
  1284.     goto nosideret;
  1285.       if (type != VALUE_TYPE (arg1))
  1286.     arg1 = value_cast (type, arg1);
  1287.       return arg1;
  1288.  
  1289.     case UNOP_MEMVAL:
  1290.       (*pos) += 2;
  1291.       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
  1292.       if (noside == EVAL_SKIP)
  1293.     goto nosideret;
  1294.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  1295.     return value_zero (exp->elts[pc + 1].type, lval_memory);
  1296.       else
  1297.     return value_at_lazy (exp->elts[pc + 1].type,
  1298.                   value_as_pointer (arg1));
  1299.  
  1300.     case UNOP_PREINCREMENT:
  1301.       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
  1302.       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
  1303.     return arg1;
  1304.       else if (unop_user_defined_p (op, arg1))
  1305.     {
  1306.       return value_x_unop (arg1, op);
  1307.     }
  1308.       else
  1309.     {
  1310.       arg2 = value_add (arg1, value_from_longest (builtin_type_char, 
  1311.                            (LONGEST) 1));
  1312.       return value_assign (arg1, arg2);
  1313.     }
  1314.  
  1315.     case UNOP_PREDECREMENT:
  1316.       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
  1317.       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
  1318.     return arg1;
  1319.       else if (unop_user_defined_p (op, arg1))
  1320.     {
  1321.       return value_x_unop (arg1, op);
  1322.     }
  1323.       else
  1324.     {
  1325.       arg2 = value_sub (arg1, value_from_longest (builtin_type_char, 
  1326.                            (LONGEST) 1));
  1327.       return value_assign (arg1, arg2);
  1328.     }
  1329.  
  1330.     case UNOP_POSTINCREMENT:
  1331.       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
  1332.       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
  1333.     return arg1;
  1334.       else if (unop_user_defined_p (op, arg1))
  1335.     {
  1336.       return value_x_unop (arg1, op);
  1337.     }
  1338.       else
  1339.     {
  1340.       arg2 = value_add (arg1, value_from_longest (builtin_type_char, 
  1341.                            (LONGEST) 1));
  1342.       value_assign (arg1, arg2);
  1343.       return arg1;
  1344.     }
  1345.  
  1346.     case UNOP_POSTDECREMENT:
  1347.       arg1 = evaluate_subexp (expect_type, exp, pos, noside);
  1348.       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
  1349.     return arg1;
  1350.       else if (unop_user_defined_p (op, arg1))
  1351.     {
  1352.       return value_x_unop (arg1, op);
  1353.     }
  1354.       else
  1355.     {
  1356.       arg2 = value_sub (arg1, value_from_longest (builtin_type_char, 
  1357.                            (LONGEST) 1));
  1358.       value_assign (arg1, arg2);
  1359.       return arg1;
  1360.     }
  1361.     
  1362.     case OP_THIS:
  1363.       (*pos) += 1;
  1364.       return value_of_this (1);
  1365.  
  1366.     case OP_TYPE:
  1367.       error ("Attempt to use a type name as an expression");
  1368.  
  1369.     default:
  1370.       /* Removing this case and compiling with gcc -Wall reveals that
  1371.      a lot of cases are hitting this case.  Some of these should
  1372.      probably be removed from expression.h (e.g. do we need a BINOP_SCOPE
  1373.      and an OP_SCOPE?); others are legitimate expressions which are
  1374.      (apparently) not fully implemented.
  1375.  
  1376.      If there are any cases landing here which mean a user error,
  1377.      then they should be separate cases, with more descriptive
  1378.      error messages.  */
  1379.  
  1380.       error ("\
  1381. GDB does not (yet) know how to evaluate that kind of expression");
  1382.     }
  1383.  
  1384.  nosideret:
  1385.   return value_from_longest (builtin_type_long, (LONGEST) 1);
  1386. }
  1387.  
  1388. /* Evaluate a subexpression of EXP, at index *POS,
  1389.    and return the address of that subexpression.
  1390.    Advance *POS over the subexpression.
  1391.    If the subexpression isn't an lvalue, get an error.
  1392.    NOSIDE may be EVAL_AVOID_SIDE_EFFECTS;
  1393.    then only the type of the result need be correct.  */
  1394.  
  1395. static value_ptr
  1396. evaluate_subexp_for_address (exp, pos, noside)
  1397.      register struct expression *exp;
  1398.      register int *pos;
  1399.      enum noside noside;
  1400. {
  1401.   enum exp_opcode op;
  1402.   register int pc;
  1403.   struct symbol *var;
  1404.  
  1405.   pc = (*pos);
  1406.   op = exp->elts[pc].opcode;
  1407.  
  1408.   switch (op)
  1409.     {
  1410.     case UNOP_IND:
  1411.       (*pos)++;
  1412.       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1413.  
  1414.     case UNOP_MEMVAL:
  1415.       (*pos) += 3;
  1416.       return value_cast (lookup_pointer_type (exp->elts[pc + 1].type),
  1417.              evaluate_subexp (NULL_TYPE, exp, pos, noside));
  1418.  
  1419.     case OP_VAR_VALUE:
  1420.       var = exp->elts[pc + 2].symbol;
  1421.  
  1422.       /* C++: The "address" of a reference should yield the address
  1423.        * of the object pointed to. Let value_addr() deal with it. */
  1424.       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_REF)
  1425.         goto default_case;
  1426.  
  1427.       (*pos) += 4;
  1428.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  1429.     {
  1430.       struct type *type =
  1431.         lookup_pointer_type (SYMBOL_TYPE (var));
  1432.       enum address_class sym_class = SYMBOL_CLASS (var);
  1433.  
  1434.       if (sym_class == LOC_CONST
  1435.           || sym_class == LOC_CONST_BYTES
  1436.           || sym_class == LOC_REGISTER
  1437.           || sym_class == LOC_REGPARM)
  1438.         error ("Attempt to take address of register or constant.");
  1439.  
  1440.     return
  1441.       value_zero (type, not_lval);
  1442.     }
  1443.       else
  1444.     return
  1445.       locate_var_value
  1446.         (var,
  1447.          block_innermost_frame (exp->elts[pc + 1].block));
  1448.  
  1449.     default:
  1450.     default_case:
  1451.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  1452.     {
  1453.       value_ptr x = evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1454.       if (VALUE_LVAL (x) == lval_memory)
  1455.         return value_zero (lookup_pointer_type (VALUE_TYPE (x)),
  1456.                    not_lval);
  1457.       else
  1458.         error ("Attempt to take address of non-lval");
  1459.     }
  1460.       return value_addr (evaluate_subexp (NULL_TYPE, exp, pos, noside));
  1461.     }
  1462. }
  1463.  
  1464. /* Evaluate like `evaluate_subexp' except coercing arrays to pointers.
  1465.    When used in contexts where arrays will be coerced anyway, this is
  1466.    equivalent to `evaluate_subexp' but much faster because it avoids
  1467.    actually fetching array contents (perhaps obsolete now that we have
  1468.    VALUE_LAZY).
  1469.  
  1470.    Note that we currently only do the coercion for C expressions, where
  1471.    arrays are zero based and the coercion is correct.  For other languages,
  1472.    with nonzero based arrays, coercion loses.  Use CAST_IS_CONVERSION
  1473.    to decide if coercion is appropriate.
  1474.  
  1475.    */
  1476.  
  1477. static value_ptr
  1478. evaluate_subexp_with_coercion (exp, pos, noside)
  1479.      register struct expression *exp;
  1480.      register int *pos;
  1481.      enum noside noside;
  1482. {
  1483.   register enum exp_opcode op;
  1484.   register int pc;
  1485.   register value_ptr val;
  1486.   struct symbol *var;
  1487.  
  1488.   pc = (*pos);
  1489.   op = exp->elts[pc].opcode;
  1490.  
  1491.   switch (op)
  1492.     {
  1493.     case OP_VAR_VALUE:
  1494.       var = exp->elts[pc + 2].symbol;
  1495.       if (TYPE_CODE (SYMBOL_TYPE (var)) == TYPE_CODE_ARRAY
  1496.       && CAST_IS_CONVERSION)
  1497.     {
  1498.       (*pos) += 4;
  1499.       val =
  1500.         locate_var_value
  1501.           (var, block_innermost_frame (exp->elts[pc + 1].block));
  1502.       return value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (SYMBOL_TYPE (var))),
  1503.                  val);
  1504.     }
  1505.       /* FALLTHROUGH */
  1506.  
  1507.     default:
  1508.       return evaluate_subexp (NULL_TYPE, exp, pos, noside);
  1509.     }
  1510. }
  1511.  
  1512. /* Evaluate a subexpression of EXP, at index *POS,
  1513.    and return a value for the size of that subexpression.
  1514.    Advance *POS over the subexpression.  */
  1515.  
  1516. static value_ptr
  1517. evaluate_subexp_for_sizeof (exp, pos)
  1518.      register struct expression *exp;
  1519.      register int *pos;
  1520. {
  1521.   enum exp_opcode op;
  1522.   register int pc;
  1523.   value_ptr val;
  1524.  
  1525.   pc = (*pos);
  1526.   op = exp->elts[pc].opcode;
  1527.  
  1528.   switch (op)
  1529.     {
  1530.       /* This case is handled specially
  1531.      so that we avoid creating a value for the result type.
  1532.      If the result type is very big, it's desirable not to
  1533.      create a value unnecessarily.  */
  1534.     case UNOP_IND:
  1535.       (*pos)++;
  1536.       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
  1537.       return value_from_longest (builtin_type_int, (LONGEST)
  1538.               TYPE_LENGTH (TYPE_TARGET_TYPE (VALUE_TYPE (val))));
  1539.  
  1540.     case UNOP_MEMVAL:
  1541.       (*pos) += 3;
  1542.       return value_from_longest (builtin_type_int, 
  1543.                   (LONGEST) TYPE_LENGTH (exp->elts[pc + 1].type));
  1544.  
  1545.     case OP_VAR_VALUE:
  1546.       (*pos) += 4;
  1547.       return
  1548.     value_from_longest
  1549.       (builtin_type_int,
  1550.        (LONGEST) TYPE_LENGTH (SYMBOL_TYPE (exp->elts[pc + 2].symbol)));
  1551.  
  1552.     default:
  1553.       val = evaluate_subexp (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
  1554.       return value_from_longest (builtin_type_int,
  1555.                   (LONGEST) TYPE_LENGTH (VALUE_TYPE (val)));
  1556.     }
  1557. }
  1558.  
  1559. /* Parse a type expression in the string [P..P+LENGTH). */
  1560.  
  1561. struct type *
  1562. parse_and_eval_type (p, length)
  1563.      char *p;
  1564.      int length;
  1565. {
  1566.     char *tmp = (char *)alloca (length + 4);
  1567.     struct expression *expr;
  1568.     tmp[0] = '(';
  1569.     memcpy (tmp+1, p, length);
  1570.     tmp[length+1] = ')';
  1571.     tmp[length+2] = '0';
  1572.     tmp[length+3] = '\0';
  1573.     expr = parse_expression (tmp);
  1574.     if (expr->elts[0].opcode != UNOP_CAST)
  1575.     error ("Internal error in eval_type.");
  1576.     return expr->elts[1].type;
  1577. }
  1578.  
  1579. int
  1580. calc_f77_array_dims (array_type)
  1581.      struct type *array_type;
  1582. {
  1583.   int ndimen = 1;
  1584.   struct type *tmp_type;
  1585.  
  1586.   if ((TYPE_CODE(array_type) != TYPE_CODE_ARRAY))
  1587.     error ("Can't get dimensions for a non-array type");
  1588.    
  1589.   tmp_type = array_type; 
  1590.  
  1591.   while (tmp_type = TYPE_TARGET_TYPE (tmp_type))
  1592.     {
  1593.       if (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
  1594.     ++ndimen;
  1595.     }
  1596.   return ndimen; 
  1597. }
  1598.