gdb/valops.c

   1 /* Perform non-arithmetic operations on values, 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 "symtab.h"
  23 #include "gdbtypes.h"
  24 #include "value.h"
  25 #include "frame.h"
  26 #include "inferior.h"
  27 #include "gdbcore.h"
  28 #include "target.h"
  29 #include "demangle.h"
  30 #include "language.h"
  31
  32 #include <errno.h>
  33 #include <string.h>
  34
  35 /* Local functions.  */
  36
  37 static int typecmp PARAMS ((int staticp, struct type *t1[], value_ptr t2[]));
  38
  39 static CORE_ADDR find_function_addr PARAMS ((value_ptr, struct type **));
  40
  41 static CORE_ADDR value_push PARAMS ((CORE_ADDR, value_ptr));
  42
  43 static CORE_ADDR value_arg_push PARAMS ((CORE_ADDR, value_ptr));
  44
  45 static value_ptr search_struct_field PARAMS ((char *, value_ptr, int,
  46                                               struct type *, int));
  47
  48 static value_ptr search_struct_method PARAMS ((char *, value_ptr *,
  49                                                value_ptr *,
  50                                                int, int *, struct type *));
  51
  52 static int check_field_in PARAMS ((struct type *, const char *));
  53
  54 static CORE_ADDR allocate_space_in_inferior PARAMS ((int));
  55
  56 static value_ptr f77_cast_into_complex PARAMS ((struct type *, value_ptr));
  57
  58 static value_ptr f77_assign_from_literal_string PARAMS ((value_ptr,
  59                                                          value_ptr));
  60
  61 static value_ptr f77_assign_from_literal_complex PARAMS ((value_ptr,
  62                                                           value_ptr));
  63
  64 #define VALUE_SUBSTRING_START(VAL) VALUE_FRAME(VAL)
  65
  66 \f
  67 /* Allocate NBYTES of space in the inferior using the inferior's malloc
  68    and return a value that is a pointer to the allocated space. */
  69
  70 static CORE_ADDR
  71 allocate_space_in_inferior (len)
  72      int len;
  73 {
  74   register value_ptr val;
  75   register struct symbol *sym;
  76   struct minimal_symbol *msymbol;
  77   struct type *type;
  78   value_ptr blocklen;
  79   LONGEST maddr;
  80
  81   /* Find the address of malloc in the inferior.  */
  82
  83   sym = lookup_symbol ("malloc", 0, VAR_NAMESPACE, 0, NULL);
  84   if (sym != NULL)
  85     {
  86       if (SYMBOL_CLASS (sym) != LOC_BLOCK)
  87         {
  88           error ("\"malloc\" exists in this program but is not a function.");
  89         }
  90       val = value_of_variable (sym, NULL);
  91     }
  92   else
  93     {
  94       msymbol = lookup_minimal_symbol ("malloc", (struct objfile *) NULL);
  95       if (msymbol != NULL)
  96         {
  97           type = lookup_pointer_type (builtin_type_char);
  98           type = lookup_function_type (type);
  99           type = lookup_pointer_type (type);
 100           maddr = (LONGEST) SYMBOL_VALUE_ADDRESS (msymbol);
 101           val = value_from_longest (type, maddr);
 102         }
 103       else
 104         {
 105           error ("evaluation of this expression requires the program to have a function \"malloc\".");
 106         }
 107     }
 108
 109   blocklen = value_from_longest (builtin_type_int, (LONGEST) len);
 110   val = call_function_by_hand (val, 1, &blocklen);
 111   if (value_logical_not (val))
 112     {
 113       error ("No memory available to program.");
 114     }
 115   return (value_as_long (val));
 116 }
 117
 118 /* Cast value ARG2 to type TYPE and return as a value.
 119    More general than a C cast: accepts any two types of the same length,
 120    and if ARG2 is an lvalue it can be cast into anything at all.  */
 121 /* In C++, casts may change pointer or object representations.  */
 122
 123 value_ptr
 124 value_cast (type, arg2)
 125      struct type *type;
 126      register value_ptr arg2;
 127 {
 128   register enum type_code code1;
 129   register enum type_code code2;
 130   register int scalar;
 131
 132   /* Coerce arrays but not enums.  Enums will work as-is
 133      and coercing them would cause an infinite recursion.  */
 134   if (TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_ENUM)
 135     COERCE_ARRAY (arg2);
 136
 137   code1 = TYPE_CODE (type);
 138   code2 = TYPE_CODE (VALUE_TYPE (arg2));
 139
 140   if (code1 == TYPE_CODE_COMPLEX)
 141     return f77_cast_into_complex (type, arg2);
 142   if (code1 == TYPE_CODE_BOOL)
 143     code1 = TYPE_CODE_INT;
 144   if (code2 == TYPE_CODE_BOOL)
 145     code2 = TYPE_CODE_INT;
 146
 147   scalar = (code2 == TYPE_CODE_INT || code2 == TYPE_CODE_FLT
 148             || code2 == TYPE_CODE_ENUM);
 149
 150   if (   code1 == TYPE_CODE_STRUCT
 151       && code2 == TYPE_CODE_STRUCT
 152       && TYPE_NAME (type) != 0)
 153     {
 154       /* Look in the type of the source to see if it contains the
 155          type of the target as a superclass.  If so, we'll need to
 156          offset the object in addition to changing its type.  */
 157       value_ptr v = search_struct_field (type_name_no_tag (type),
 158                                          arg2, 0, VALUE_TYPE (arg2), 1);
 159       if (v)
 160         {
 161           VALUE_TYPE (v) = type;
 162           return v;
 163         }
 164     }
 165   if (code1 == TYPE_CODE_FLT && scalar)
 166     return value_from_double (type, value_as_double (arg2));
 167   else if ((code1 == TYPE_CODE_INT || code1 == TYPE_CODE_ENUM)
 168            && (scalar || code2 == TYPE_CODE_PTR))
 169     return value_from_longest (type, value_as_long (arg2));
 170   else if (TYPE_LENGTH (type) == TYPE_LENGTH (VALUE_TYPE (arg2)))
 171     {
 172       if (code1 == TYPE_CODE_PTR && code2 == TYPE_CODE_PTR)
 173         {
 174           /* Look in the type of the source to see if it contains the
 175              type of the target as a superclass.  If so, we'll need to
 176              offset the pointer rather than just change its type.  */
 177           struct type *t1 = TYPE_TARGET_TYPE (type);
 178           struct type *t2 = TYPE_TARGET_TYPE (VALUE_TYPE (arg2));
 179           if (   TYPE_CODE (t1) == TYPE_CODE_STRUCT
 180               && TYPE_CODE (t2) == TYPE_CODE_STRUCT
 181               && TYPE_NAME (t1) != 0) /* if name unknown, can't have supercl */
 182             {
 183               value_ptr v = search_struct_field (type_name_no_tag (t1),
 184                                                  value_ind (arg2), 0, t2, 1);
 185               if (v)
 186                 {
 187                   v = value_addr (v);
 188                   VALUE_TYPE (v) = type;
 189                   return v;
 190                 }
 191             }
 192           /* No superclass found, just fall through to change ptr type.  */
 193         }
 194       VALUE_TYPE (arg2) = type;
 195       return arg2;
 196     }
 197   else if (VALUE_LVAL (arg2) == lval_memory)
 198     {
 199       return value_at_lazy (type, VALUE_ADDRESS (arg2) + VALUE_OFFSET (arg2));
 200     }
 201   else if (code1 == TYPE_CODE_VOID)
 202     {
 203       return value_zero (builtin_type_void, not_lval);
 204     }
 205   else
 206     {
 207       error ("Invalid cast.");
 208       return 0;
 209     }
 210 }
 211
 212 /* Create a value of type TYPE that is zero, and return it.  */
 213
 214 value_ptr
 215 value_zero (type, lv)
 216      struct type *type;
 217      enum lval_type lv;
 218 {
 219   register value_ptr val = allocate_value (type);
 220
 221   memset (VALUE_CONTENTS (val), 0, TYPE_LENGTH (type));
 222   VALUE_LVAL (val) = lv;
 223
 224   return val;
 225 }
 226
 227 /* Return a value with type TYPE located at ADDR.
 228
 229    Call value_at only if the data needs to be fetched immediately;
 230    if we can be 'lazy' and defer the fetch, perhaps indefinately, call
 231    value_at_lazy instead.  value_at_lazy simply records the address of
 232    the data and sets the lazy-evaluation-required flag.  The lazy flag
 233    is tested in the VALUE_CONTENTS macro, which is used if and when
 234    the contents are actually required.  */
 235
 236 value_ptr
 237 value_at (type, addr)
 238      struct type *type;
 239      CORE_ADDR addr;
 240 {
 241   register value_ptr val;
 242
 243   if (TYPE_CODE (type) == TYPE_CODE_VOID)
 244     error ("Attempt to dereference a generic pointer.");
 245
 246   val = allocate_value (type);
 247
 248   read_memory (addr, VALUE_CONTENTS_RAW (val), TYPE_LENGTH (type));
 249
 250   VALUE_LVAL (val) = lval_memory;
 251   VALUE_ADDRESS (val) = addr;
 252
 253   return val;
 254 }
 255
 256 /* Return a lazy value with type TYPE located at ADDR (cf. value_at).  */
 257
 258 value_ptr
 259 value_at_lazy (type, addr)
 260      struct type *type;
 261      CORE_ADDR addr;
 262 {
 263   register value_ptr val;
 264
 265   if (TYPE_CODE (type) == TYPE_CODE_VOID)
 266     error ("Attempt to dereference a generic pointer.");
 267
 268   val = allocate_value (type);
 269
 270   VALUE_LVAL (val) = lval_memory;
 271   VALUE_ADDRESS (val) = addr;
 272   VALUE_LAZY (val) = 1;
 273
 274   return val;
 275 }
 276
 277 /* Called only from the VALUE_CONTENTS macro, if the current data for
 278    a variable needs to be loaded into VALUE_CONTENTS(VAL).  Fetches the
 279    data from the user's process, and clears the lazy flag to indicate
 280    that the data in the buffer is valid.
 281
 282    If the value is zero-length, we avoid calling read_memory, which would
 283    abort.  We mark the value as fetched anyway -- all 0 bytes of it.
 284
 285    This function returns a value because it is used in the VALUE_CONTENTS
 286    macro as part of an expression, where a void would not work.  The
 287    value is ignored.  */
 288
 289 int
 290 value_fetch_lazy (val)
 291      register value_ptr val;
 292 {
 293   CORE_ADDR addr = VALUE_ADDRESS (val) + VALUE_OFFSET (val);
 294
 295   if (TYPE_LENGTH (VALUE_TYPE (val)))
 296     read_memory (addr, VALUE_CONTENTS_RAW (val),
 297                  TYPE_LENGTH (VALUE_TYPE (val)));
 298   VALUE_LAZY (val) = 0;
 299   return 0;
 300 }
 301
 302
 303 /* Store the contents of FROMVAL into the location of TOVAL.
 304    Return a new value with the location of TOVAL and contents of FROMVAL.  */
 305
 306 value_ptr
 307 value_assign (toval, fromval)
 308      register value_ptr toval, fromval;
 309 {
 310   register struct type *type;
 311   register value_ptr val;
 312   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 313   int use_buffer = 0;
 314
 315   if (current_language->la_language == language_fortran)
 316     {
 317       /* Deal with literal assignment in F77.  All composite (i.e. string
 318          and complex number types) types are allocated in the superior
 319          NOT the inferior.  Therefore assigment is somewhat tricky.  */
 320
 321       if (TYPE_CODE (VALUE_TYPE (fromval)) == TYPE_CODE_LITERAL_STRING)
 322         return f77_assign_from_literal_string (toval, fromval);
 323
 324       if (TYPE_CODE (VALUE_TYPE (fromval)) == TYPE_CODE_LITERAL_COMPLEX)
 325         return f77_assign_from_literal_complex (toval, fromval);
 326     }
 327
 328   if (!toval->modifiable)
 329     error ("Left operand of assignment is not a modifiable lvalue.");
 330
 331   COERCE_ARRAY (fromval);
 332   COERCE_REF (toval);
 333
 334   type = VALUE_TYPE (toval);
 335   if (VALUE_LVAL (toval) != lval_internalvar)
 336     fromval = value_cast (type, fromval);
 337
 338   /* If TOVAL is a special machine register requiring conversion
 339      of program values to a special raw format,
 340      convert FROMVAL's contents now, with result in `raw_buffer',
 341      and set USE_BUFFER to the number of bytes to write.  */
 342
 343 #ifdef REGISTER_CONVERTIBLE
 344   if (VALUE_REGNO (toval) >= 0
 345       && REGISTER_CONVERTIBLE (VALUE_REGNO (toval)))
 346     {
 347       int regno = VALUE_REGNO (toval);
 348       if (REGISTER_CONVERTIBLE (regno))
 349         {
 350           REGISTER_CONVERT_TO_RAW (VALUE_TYPE (fromval), regno,
 351                                    VALUE_CONTENTS (fromval), raw_buffer);
 352           use_buffer = REGISTER_RAW_SIZE (regno);
 353         }
 354     }
 355 #endif
 356
 357   switch (VALUE_LVAL (toval))
 358     {
 359     case lval_internalvar:
 360       set_internalvar (VALUE_INTERNALVAR (toval), fromval);
 361       break;
 362
 363     case lval_internalvar_component:
 364       set_internalvar_component (VALUE_INTERNALVAR (toval),
 365                                  VALUE_OFFSET (toval),
 366                                  VALUE_BITPOS (toval),
 367                                  VALUE_BITSIZE (toval),
 368                                  fromval);
 369       break;
 370
 371     case lval_memory:
 372       if (VALUE_BITSIZE (toval))
 373         {
 374           char buffer[sizeof (LONGEST)];
 375           /* We assume that the argument to read_memory is in units of
 376              host chars.  FIXME:  Is that correct?  */
 377           int len = (VALUE_BITPOS (toval)
 378                      + VALUE_BITSIZE (toval)
 379                      + HOST_CHAR_BIT - 1)
 380                     / HOST_CHAR_BIT;
 381
 382           if (len > sizeof (LONGEST))
 383             error ("Can't handle bitfields which don't fit in a %d bit word.",
 384                    sizeof (LONGEST) * HOST_CHAR_BIT);
 385
 386           read_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 387                        buffer, len);
 388           modify_field (buffer, value_as_long (fromval),
 389                         VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
 390           write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 391                         buffer, len);
 392         }
 393       else if (use_buffer)
 394         write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 395                       raw_buffer, use_buffer);
 396       else
 397         write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 398                       VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
 399       break;
 400
 401     case lval_register:
 402       if (VALUE_BITSIZE (toval))
 403         {
 404           char buffer[sizeof (LONGEST)];
 405           int len = REGISTER_RAW_SIZE (VALUE_REGNO (toval));
 406
 407           if (len > sizeof (LONGEST))
 408             error ("Can't handle bitfields in registers larger than %d bits.",
 409                    sizeof (LONGEST) * HOST_CHAR_BIT);
 410
 411           if (VALUE_BITPOS (toval) + VALUE_BITSIZE (toval)
 412               > len * HOST_CHAR_BIT)
 413             /* Getting this right would involve being very careful about
 414                byte order.  */
 415             error ("\
 416 Can't handle bitfield which doesn't fit in a single register.");
 417
 418           read_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 419                                buffer, len);
 420           modify_field (buffer, value_as_long (fromval),
 421                         VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
 422           write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 423                                 buffer, len);
 424         }
 425       else if (use_buffer)
 426         write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 427                               raw_buffer, use_buffer);
 428       else
 429         {
 430           /* Do any conversion necessary when storing this type to more
 431              than one register.  */
 432 #ifdef REGISTER_CONVERT_FROM_TYPE
 433           memcpy (raw_buffer, VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
 434           REGISTER_CONVERT_FROM_TYPE(VALUE_REGNO (toval), type, raw_buffer);
 435           write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 436                                 raw_buffer, TYPE_LENGTH (type));
 437 #else
 438           write_register_bytes (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval),
 439                                 VALUE_CONTENTS (fromval), TYPE_LENGTH (type));
 440 #endif
 441         }
 442       /* Assigning to the stack pointer, frame pointer, and other
 443          (architecture and calling convention specific) registers may
 444          cause the frame cache to be out of date.  We just do this
 445          on all assignments to registers for simplicity; I doubt the slowdown
 446          matters.  */
 447       reinit_frame_cache ();
 448       break;
 449
 450     case lval_reg_frame_relative:
 451       {
 452         /* value is stored in a series of registers in the frame
 453            specified by the structure.  Copy that value out, modify
 454            it, and copy it back in.  */
 455         int amount_to_copy = (VALUE_BITSIZE (toval) ? 1 : TYPE_LENGTH (type));
 456         int reg_size = REGISTER_RAW_SIZE (VALUE_FRAME_REGNUM (toval));
 457         int byte_offset = VALUE_OFFSET (toval) % reg_size;
 458         int reg_offset = VALUE_OFFSET (toval) / reg_size;
 459         int amount_copied;
 460
 461         /* Make the buffer large enough in all cases.  */
 462         char *buffer = (char *) alloca (amount_to_copy
 463                                         + sizeof (LONGEST)
 464                                         + MAX_REGISTER_RAW_SIZE);
 465
 466         int regno;
 467         struct frame_info *frame;
 468
 469         /* Figure out which frame this is in currently.  */
 470         for (frame = get_current_frame ();
 471              frame && FRAME_FP (frame) != VALUE_FRAME (toval);
 472              frame = get_prev_frame (frame))
 473           ;
 474
 475         if (!frame)
 476           error ("Value being assigned to is no longer active.");
 477
 478         amount_to_copy += (reg_size - amount_to_copy % reg_size);
 479
 480         /* Copy it out.  */
 481         for ((regno = VALUE_FRAME_REGNUM (toval) + reg_offset,
 482               amount_copied = 0);
 483              amount_copied < amount_to_copy;
 484              amount_copied += reg_size, regno++)
 485           {
 486             get_saved_register (buffer + amount_copied,
 487                                 (int *)NULL, (CORE_ADDR *)NULL,
 488                                 frame, regno, (enum lval_type *)NULL);
 489           }
 490
 491         /* Modify what needs to be modified.  */
 492         if (VALUE_BITSIZE (toval))
 493           modify_field (buffer + byte_offset,
 494                         value_as_long (fromval),
 495                         VALUE_BITPOS (toval), VALUE_BITSIZE (toval));
 496         else if (use_buffer)
 497           memcpy (buffer + byte_offset, raw_buffer, use_buffer);
 498         else
 499           memcpy (buffer + byte_offset, VALUE_CONTENTS (fromval),
 500                   TYPE_LENGTH (type));
 501
 502         /* Copy it back.  */
 503         for ((regno = VALUE_FRAME_REGNUM (toval) + reg_offset,
 504               amount_copied = 0);
 505              amount_copied < amount_to_copy;
 506              amount_copied += reg_size, regno++)
 507           {
 508             enum lval_type lval;
 509             CORE_ADDR addr;
 510             int optim;
 511
 512             /* Just find out where to put it.  */
 513             get_saved_register ((char *)NULL,
 514                                 &optim, &addr, frame, regno, &lval);
 515
 516             if (optim)
 517               error ("Attempt to assign to a value that was optimized out.");
 518             if (lval == lval_memory)
 519               write_memory (addr, buffer + amount_copied, reg_size);
 520             else if (lval == lval_register)
 521               write_register_bytes (addr, buffer + amount_copied, reg_size);
 522             else
 523               error ("Attempt to assign to an unmodifiable value.");
 524           }
 525       }
 526       break;
 527
 528
 529     default:
 530       error ("Left operand of assignment is not an lvalue.");
 531     }
 532
 533   /* Return a value just like TOVAL except with the contents of FROMVAL
 534      (except in the case of the type if TOVAL is an internalvar).  */
 535
 536   if (VALUE_LVAL (toval) == lval_internalvar
 537       || VALUE_LVAL (toval) == lval_internalvar_component)
 538     {
 539       type = VALUE_TYPE (fromval);
 540     }
 541
 542   val = allocate_value (type);
 543   memcpy (val, toval, VALUE_CONTENTS_RAW (val) - (char *) val);
 544   memcpy (VALUE_CONTENTS_RAW (val), VALUE_CONTENTS (fromval),
 545           TYPE_LENGTH (type));
 546   VALUE_TYPE (val) = type;
 547
 548   return val;
 549 }
 550
 551 /* Extend a value VAL to COUNT repetitions of its type.  */
 552
 553 value_ptr
 554 value_repeat (arg1, count)
 555      value_ptr arg1;
 556      int count;
 557 {
 558   register value_ptr val;
 559
 560   if (VALUE_LVAL (arg1) != lval_memory)
 561     error ("Only values in memory can be extended with '@'.");
 562   if (count < 1)
 563     error ("Invalid number %d of repetitions.", count);
 564
 565   val = allocate_repeat_value (VALUE_TYPE (arg1), count);
 566
 567   read_memory (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1),
 568                VALUE_CONTENTS_RAW (val),
 569                TYPE_LENGTH (VALUE_TYPE (val)) * count);
 570   VALUE_LVAL (val) = lval_memory;
 571   VALUE_ADDRESS (val) = VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1);
 572
 573   return val;
 574 }
 575
 576 value_ptr
 577 value_of_variable (var, b)
 578      struct symbol *var;
 579      struct block *b;
 580 {
 581   value_ptr val;
 582   struct frame_info *frame;
 583
 584   if (b == NULL)
 585     /* Use selected frame.  */
 586     frame = NULL;
 587   else
 588     {
 589       frame = block_innermost_frame (b);
 590       if (frame == NULL && symbol_read_needs_frame (var))
 591         {
 592           if (BLOCK_FUNCTION (b) != NULL
 593               && SYMBOL_NAME (BLOCK_FUNCTION (b)) != NULL)
 594             error ("No frame is currently executing in block %s.",
 595                    SYMBOL_NAME (BLOCK_FUNCTION (b)));
 596           else
 597             error ("No frame is currently executing in specified block");
 598         }
 599     }
 600   val = read_var_value (var, frame);
 601   if (val == 0)
 602     error ("Address of symbol \"%s\" is unknown.", SYMBOL_SOURCE_NAME (var));
 603   return val;
 604 }
 605
 606 /* Given a value which is an array, return a value which is a pointer to its
 607    first element, regardless of whether or not the array has a nonzero lower
 608    bound.
 609
 610    FIXME:  A previous comment here indicated that this routine should be
 611    substracting the array's lower bound.  It's not clear to me that this
 612    is correct.  Given an array subscripting operation, it would certainly
 613    work to do the adjustment here, essentially computing:
 614
 615    (&array[0] - (lowerbound * sizeof array[0])) + (index * sizeof array[0])
 616
 617    However I believe a more appropriate and logical place to account for
 618    the lower bound is to do so in value_subscript, essentially computing:
 619
 620    (&array[0] + ((index - lowerbound) * sizeof array[0]))
 621
 622    As further evidence consider what would happen with operations other
 623    than array subscripting, where the caller would get back a value that
 624    had an address somewhere before the actual first element of the array,
 625    and the information about the lower bound would be lost because of
 626    the coercion to pointer type.
 627    */
 628
 629 value_ptr
 630 value_coerce_array (arg1)
 631      value_ptr arg1;
 632 {
 633   register struct type *type;
 634
 635   if (VALUE_LVAL (arg1) != lval_memory)
 636     error ("Attempt to take address of value not located in memory.");
 637
 638   /* Get type of elements.  */
 639   if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_ARRAY
 640       || TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_STRING)
 641     type = TYPE_TARGET_TYPE (VALUE_TYPE (arg1));
 642   else
 643     /* A phony array made by value_repeat.
 644        Its type is the type of the elements, not an array type.  */
 645     type = VALUE_TYPE (arg1);
 646
 647   return value_from_longest (lookup_pointer_type (type),
 648                        (LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
 649 }
 650
 651 /* Given a value which is a function, return a value which is a pointer
 652    to it.  */
 653
 654 value_ptr
 655 value_coerce_function (arg1)
 656      value_ptr arg1;
 657 {
 658
 659   if (VALUE_LVAL (arg1) != lval_memory)
 660     error ("Attempt to take address of value not located in memory.");
 661
 662   return value_from_longest (lookup_pointer_type (VALUE_TYPE (arg1)),
 663                 (LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
 664 }
 665
 666 /* Return a pointer value for the object for which ARG1 is the contents.  */
 667
 668 value_ptr
 669 value_addr (arg1)
 670      value_ptr arg1;
 671 {
 672   struct type *type = VALUE_TYPE (arg1);
 673   if (TYPE_CODE (type) == TYPE_CODE_REF)
 674     {
 675       /* Copy the value, but change the type from (T&) to (T*).
 676          We keep the same location information, which is efficient,
 677          and allows &(&X) to get the location containing the reference. */
 678       value_ptr arg2 = value_copy (arg1);
 679       VALUE_TYPE (arg2) = lookup_pointer_type (TYPE_TARGET_TYPE (type));
 680       return arg2;
 681     }
 682   if (VALUE_REPEATED (arg1)
 683       || TYPE_CODE (type) == TYPE_CODE_ARRAY)
 684     return value_coerce_array (arg1);
 685   if (TYPE_CODE (type) == TYPE_CODE_FUNC)
 686     return value_coerce_function (arg1);
 687
 688   if (VALUE_LVAL (arg1) != lval_memory)
 689     error ("Attempt to take address of value not located in memory.");
 690
 691   return value_from_longest (lookup_pointer_type (type),
 692                 (LONGEST) (VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1)));
 693 }
 694
 695 /* Given a value of a pointer type, apply the C unary * operator to it.  */
 696
 697 value_ptr
 698 value_ind (arg1)
 699      value_ptr arg1;
 700 {
 701   COERCE_ARRAY (arg1);
 702
 703   if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_MEMBER)
 704     error ("not implemented: member types in value_ind");
 705
 706   /* Allow * on an integer so we can cast it to whatever we want.
 707      This returns an int, which seems like the most C-like thing
 708      to do.  "long long" variables are rare enough that
 709      BUILTIN_TYPE_LONGEST would seem to be a mistake.  */
 710   if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_INT)
 711     return value_at (builtin_type_int,
 712                      (CORE_ADDR) value_as_long (arg1));
 713   else if (TYPE_CODE (VALUE_TYPE (arg1)) == TYPE_CODE_PTR)
 714     return value_at_lazy (TYPE_TARGET_TYPE (VALUE_TYPE (arg1)),
 715                           value_as_pointer (arg1));
 716   error ("Attempt to take contents of a non-pointer value.");
 717   return 0;  /* For lint -- never reached */
 718 }
 719 \f
 720 /* Pushing small parts of stack frames.  */
 721
 722 /* Push one word (the size of object that a register holds).  */
 723
 724 CORE_ADDR
 725 push_word (sp, word)
 726      CORE_ADDR sp;
 727      unsigned LONGEST word;
 728 {
 729   register int len = REGISTER_SIZE;
 730   char buffer[MAX_REGISTER_RAW_SIZE];
 731
 732   store_unsigned_integer (buffer, len, word);
 733 #if 1 INNER_THAN 2
 734   sp -= len;
 735   write_memory (sp, buffer, len);
 736 #else /* stack grows upward */
 737   write_memory (sp, buffer, len);
 738   sp += len;
 739 #endif /* stack grows upward */
 740
 741   return sp;
 742 }
 743
 744 /* Push LEN bytes with data at BUFFER.  */
 745
 746 CORE_ADDR
 747 push_bytes (sp, buffer, len)
 748      CORE_ADDR sp;
 749      char *buffer;
 750      int len;
 751 {
 752 #if 1 INNER_THAN 2
 753   sp -= len;
 754   write_memory (sp, buffer, len);
 755 #else /* stack grows upward */
 756   write_memory (sp, buffer, len);
 757   sp += len;
 758 #endif /* stack grows upward */
 759
 760   return sp;
 761 }
 762
 763 /* Push onto the stack the specified value VALUE.  */
 764
 765 static CORE_ADDR
 766 value_push (sp, arg)
 767      register CORE_ADDR sp;
 768      value_ptr arg;
 769 {
 770   register int len = TYPE_LENGTH (VALUE_TYPE (arg));
 771
 772 #if 1 INNER_THAN 2
 773   sp -= len;
 774   write_memory (sp, VALUE_CONTENTS (arg), len);
 775 #else /* stack grows upward */
 776   write_memory (sp, VALUE_CONTENTS (arg), len);
 777   sp += len;
 778 #endif /* stack grows upward */
 779
 780   return sp;
 781 }
 782
 783 /* Perform the standard coercions that are specified
 784    for arguments to be passed to C functions.  */
 785
 786 value_ptr
 787 value_arg_coerce (arg)
 788      value_ptr arg;
 789 {
 790   register struct type *type;
 791
 792   /* FIXME: We should coerce this according to the prototype (if we have
 793      one).  Right now we do a little bit of this in typecmp(), but that
 794      doesn't always get called.  For example, if passing a ref to a function
 795      without a prototype, we probably should de-reference it.  Currently
 796      we don't.  */
 797
 798   if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ENUM)
 799     arg = value_cast (builtin_type_unsigned_int, arg);
 800
 801 #if 1   /* FIXME:  This is only a temporary patch.  -fnf */
 802   if (VALUE_REPEATED (arg)
 803       || TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_ARRAY)
 804     arg = value_coerce_array (arg);
 805   if (TYPE_CODE (VALUE_TYPE (arg)) == TYPE_CODE_FUNC)
 806     arg = value_coerce_function (arg);
 807 #endif
 808
 809   type = VALUE_TYPE (arg);
 810
 811   if (TYPE_CODE (type) == TYPE_CODE_INT
 812       && TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_int))
 813     return value_cast (builtin_type_int, arg);
 814
 815   if (TYPE_CODE (type) == TYPE_CODE_FLT
 816       && TYPE_LENGTH (type) < TYPE_LENGTH (builtin_type_double))
 817     return value_cast (builtin_type_double, arg);
 818
 819   return arg;
 820 }
 821
 822 /* Push the value ARG, first coercing it as an argument
 823    to a C function.  */
 824
 825 static CORE_ADDR
 826 value_arg_push (sp, arg)
 827      register CORE_ADDR sp;
 828      value_ptr arg;
 829 {
 830   return value_push (sp, value_arg_coerce (arg));
 831 }
 832
 833 /* Determine a function's address and its return type from its value.
 834    Calls error() if the function is not valid for calling.  */
 835
 836 static CORE_ADDR
 837 find_function_addr (function, retval_type)
 838      value_ptr function;
 839      struct type **retval_type;
 840 {
 841   register struct type *ftype = VALUE_TYPE (function);
 842   register enum type_code code = TYPE_CODE (ftype);
 843   struct type *value_type;
 844   CORE_ADDR funaddr;
 845
 846   /* If it's a member function, just look at the function
 847      part of it.  */
 848
 849   /* Determine address to call.  */
 850   if (code == TYPE_CODE_FUNC || code == TYPE_CODE_METHOD)
 851     {
 852       funaddr = VALUE_ADDRESS (function);
 853       value_type = TYPE_TARGET_TYPE (ftype);
 854     }
 855   else if (code == TYPE_CODE_PTR)
 856     {
 857       funaddr = value_as_pointer (function);
 858       if (TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_FUNC
 859           || TYPE_CODE (TYPE_TARGET_TYPE (ftype)) == TYPE_CODE_METHOD)
 860         {
 861 #ifdef CONVERT_FROM_FUNC_PTR_ADDR
 862           /* FIXME: This is a workaround for the unusual function
 863              pointer representation on the RS/6000, see comment
 864              in config/rs6000/tm-rs6000.h  */
 865           funaddr = CONVERT_FROM_FUNC_PTR_ADDR (funaddr);
 866 #endif
 867           value_type = TYPE_TARGET_TYPE (TYPE_TARGET_TYPE (ftype));
 868         }
 869       else
 870         value_type = builtin_type_int;
 871     }
 872   else if (code == TYPE_CODE_INT)
 873     {
 874       /* Handle the case of functions lacking debugging info.
 875          Their values are characters since their addresses are char */
 876       if (TYPE_LENGTH (ftype) == 1)
 877         funaddr = value_as_pointer (value_addr (function));
 878       else
 879         /* Handle integer used as address of a function.  */
 880         funaddr = (CORE_ADDR) value_as_long (function);
 881
 882       value_type = builtin_type_int;
 883     }
 884   else
 885     error ("Invalid data type for function to be called.");
 886
 887   *retval_type = value_type;
 888   return funaddr;
 889 }
 890
 891 #if defined (CALL_DUMMY)
 892 /* All this stuff with a dummy frame may seem unnecessarily complicated
 893    (why not just save registers in GDB?).  The purpose of pushing a dummy
 894    frame which looks just like a real frame is so that if you call a
 895    function and then hit a breakpoint (get a signal, etc), "backtrace"
 896    will look right.  Whether the backtrace needs to actually show the
 897    stack at the time the inferior function was called is debatable, but
 898    it certainly needs to not display garbage.  So if you are contemplating
 899    making dummy frames be different from normal frames, consider that.  */
 900
 901 /* Perform a function call in the inferior.
 902    ARGS is a vector of values of arguments (NARGS of them).
 903    FUNCTION is a value, the function to be called.
 904    Returns a value representing what the function returned.
 905    May fail to return, if a breakpoint or signal is hit
 906    during the execution of the function.  */
 907
 908 value_ptr
 909 call_function_by_hand (function, nargs, args)
 910      value_ptr function;
 911      int nargs;
 912      value_ptr *args;
 913 {
 914   register CORE_ADDR sp;
 915   register int i;
 916   CORE_ADDR start_sp;
 917   /* CALL_DUMMY is an array of words (REGISTER_SIZE), but each word
 918      is in host byte order.  Before calling FIX_CALL_DUMMY, we byteswap it
 919      and remove any extra bytes which might exist because unsigned LONGEST is
 920      bigger than REGISTER_SIZE.  */
 921   static unsigned LONGEST dummy[] = CALL_DUMMY;
 922   char dummy1[REGISTER_SIZE * sizeof dummy / sizeof (unsigned LONGEST)];
 923   CORE_ADDR old_sp;
 924   struct type *value_type;
 925   unsigned char struct_return;
 926   CORE_ADDR struct_addr;
 927   struct inferior_status inf_status;
 928   struct cleanup *old_chain;
 929   CORE_ADDR funaddr;
 930   int using_gcc;
 931   CORE_ADDR real_pc;
 932
 933   if (!target_has_execution)
 934     noprocess();
 935
 936   save_inferior_status (&inf_status, 1);
 937   old_chain = make_cleanup (restore_inferior_status, &inf_status);
 938
 939   /* PUSH_DUMMY_FRAME is responsible for saving the inferior registers
 940      (and POP_FRAME for restoring them).  (At least on most machines)
 941      they are saved on the stack in the inferior.  */
 942   PUSH_DUMMY_FRAME;
 943
 944   old_sp = sp = read_sp ();
 945
 946 #if 1 INNER_THAN 2              /* Stack grows down */
 947   sp -= sizeof dummy1;
 948   start_sp = sp;
 949 #else                           /* Stack grows up */
 950   start_sp = sp;
 951   sp += sizeof dummy1;
 952 #endif
 953
 954   funaddr = find_function_addr (function, &value_type);
 955
 956   {
 957     struct block *b = block_for_pc (funaddr);
 958     /* If compiled without -g, assume GCC.  */
 959     using_gcc = b == NULL || BLOCK_GCC_COMPILED (b);
 960   }
 961
 962   /* Are we returning a value using a structure return or a normal
 963      value return? */
 964
 965   struct_return = using_struct_return (function, funaddr, value_type,
 966                                        using_gcc);
 967
 968   /* Create a call sequence customized for this function
 969      and the number of arguments for it.  */
 970   for (i = 0; i < sizeof dummy / sizeof (dummy[0]); i++)
 971     store_unsigned_integer (&dummy1[i * REGISTER_SIZE],
 972                             REGISTER_SIZE,
 973                             (unsigned LONGEST)dummy[i]);
 974
 975 #ifdef GDB_TARGET_IS_HPPA
 976   real_pc = FIX_CALL_DUMMY (dummy1, start_sp, funaddr, nargs, args,
 977                             value_type, using_gcc);
 978 #else
 979   FIX_CALL_DUMMY (dummy1, start_sp, funaddr, nargs, args,
 980                   value_type, using_gcc);
 981   real_pc = start_sp;
 982 #endif
 983
 984 #if CALL_DUMMY_LOCATION == ON_STACK
 985   write_memory (start_sp, (char *)dummy1, sizeof dummy1);
 986 #endif /* On stack.  */
 987
 988 #if CALL_DUMMY_LOCATION == BEFORE_TEXT_END
 989   /* Convex Unix prohibits executing in the stack segment. */
 990   /* Hope there is empty room at the top of the text segment. */
 991   {
 992     extern CORE_ADDR text_end;
 993     static checked = 0;
 994     if (!checked)
 995       for (start_sp = text_end - sizeof dummy1; start_sp < text_end; ++start_sp)
 996         if (read_memory_integer (start_sp, 1) != 0)
 997           error ("text segment full -- no place to put call");
 998     checked = 1;
 999     sp = old_sp;
1000     real_pc = text_end - sizeof dummy1;
1001     write_memory (real_pc, (char *)dummy1, sizeof dummy1);
1002   }
1003 #endif /* Before text_end.  */
1004
1005 #if CALL_DUMMY_LOCATION == AFTER_TEXT_END
1006   {
1007     extern CORE_ADDR text_end;
1008     int errcode;
1009     sp = old_sp;
1010     real_pc = text_end;
1011     errcode = target_write_memory (real_pc, (char *)dummy1, sizeof dummy1);
1012     if (errcode != 0)
1013       error ("Cannot write text segment -- call_function failed");
1014   }
1015 #endif /* After text_end.  */
1016
1017 #if CALL_DUMMY_LOCATION == AT_ENTRY_POINT
1018   real_pc = funaddr;
1019 #endif /* At entry point.  */
1020
1021 #ifdef lint
1022   sp = old_sp;          /* It really is used, for some ifdef's... */
1023 #endif
1024
1025 #ifdef STACK_ALIGN
1026   /* If stack grows down, we must leave a hole at the top. */
1027   {
1028     int len = 0;
1029
1030     /* Reserve space for the return structure to be written on the
1031        stack, if necessary */
1032
1033     if (struct_return)
1034       len += TYPE_LENGTH (value_type);
1035
1036     for (i = nargs - 1; i >= 0; i--)
1037       len += TYPE_LENGTH (VALUE_TYPE (value_arg_coerce (args[i])));
1038 #ifdef CALL_DUMMY_STACK_ADJUST
1039     len += CALL_DUMMY_STACK_ADJUST;
1040 #endif
1041 #if 1 INNER_THAN 2
1042     sp -= STACK_ALIGN (len) - len;
1043 #else
1044     sp += STACK_ALIGN (len) - len;
1045 #endif
1046   }
1047 #endif /* STACK_ALIGN */
1048
1049     /* Reserve space for the return structure to be written on the
1050        stack, if necessary */
1051
1052     if (struct_return)
1053       {
1054 #if 1 INNER_THAN 2
1055         sp -= TYPE_LENGTH (value_type);
1056         struct_addr = sp;
1057 #else
1058         struct_addr = sp;
1059         sp += TYPE_LENGTH (value_type);
1060 #endif
1061       }
1062
1063 #if defined (REG_STRUCT_HAS_ADDR)
1064   {
1065     /* This is a machine like the sparc, where we may need to pass a pointer
1066        to the structure, not the structure itself.  */
1067     for (i = nargs - 1; i >= 0; i--)
1068       if (TYPE_CODE (VALUE_TYPE (args[i])) == TYPE_CODE_STRUCT
1069           && REG_STRUCT_HAS_ADDR (using_gcc, VALUE_TYPE (args[i])))
1070         {
1071           CORE_ADDR addr;
1072 #if !(1 INNER_THAN 2)
1073           /* The stack grows up, so the address of the thing we push
1074              is the stack pointer before we push it.  */
1075           addr = sp;
1076 #endif
1077           /* Push the structure.  */
1078           sp = value_push (sp, args[i]);
1079 #if 1 INNER_THAN 2
1080           /* The stack grows down, so the address of the thing we push
1081              is the stack pointer after we push it.  */
1082           addr = sp;
1083 #endif
1084           /* The value we're going to pass is the address of the thing
1085              we just pushed.  */
1086           args[i] = value_from_longest (lookup_pointer_type (value_type),
1087                                         (LONGEST) addr);
1088         }
1089   }
1090 #endif /* REG_STRUCT_HAS_ADDR.  */
1091
1092 #ifdef PUSH_ARGUMENTS
1093   PUSH_ARGUMENTS(nargs, args, sp, struct_return, struct_addr);
1094 #else /* !PUSH_ARGUMENTS */
1095   for (i = nargs - 1; i >= 0; i--)
1096     sp = value_arg_push (sp, args[i]);
1097 #endif /* !PUSH_ARGUMENTS */
1098
1099 #ifdef CALL_DUMMY_STACK_ADJUST
1100 #if 1 INNER_THAN 2
1101   sp -= CALL_DUMMY_STACK_ADJUST;
1102 #else
1103   sp += CALL_DUMMY_STACK_ADJUST;
1104 #endif
1105 #endif /* CALL_DUMMY_STACK_ADJUST */
1106
1107   /* Store the address at which the structure is supposed to be
1108      written.  Note that this (and the code which reserved the space
1109      above) assumes that gcc was used to compile this function.  Since
1110      it doesn't cost us anything but space and if the function is pcc
1111      it will ignore this value, we will make that assumption.
1112
1113      Also note that on some machines (like the sparc) pcc uses a
1114      convention like gcc's.  */
1115
1116   if (struct_return)
1117     STORE_STRUCT_RETURN (struct_addr, sp);
1118
1119   /* Write the stack pointer.  This is here because the statements above
1120      might fool with it.  On SPARC, this write also stores the register
1121      window into the right place in the new stack frame, which otherwise
1122      wouldn't happen.  (See store_inferior_registers in sparc-nat.c.)  */
1123   write_sp (sp);
1124
1125   {
1126     char retbuf[REGISTER_BYTES];
1127     char *name;
1128     struct symbol *symbol;
1129
1130     name = NULL;
1131     symbol = find_pc_function (funaddr);
1132     if (symbol)
1133       {
1134         name = SYMBOL_SOURCE_NAME (symbol);
1135       }
1136     else
1137       {
1138         /* Try the minimal symbols.  */
1139         struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (funaddr);
1140
1141         if (msymbol)
1142           {
1143             name = SYMBOL_SOURCE_NAME (msymbol);
1144           }
1145       }
1146     if (name == NULL)
1147       {
1148         char format[80];
1149         sprintf (format, "at %s", local_hex_format ());
1150         name = alloca (80);
1151         /* FIXME-32x64: assumes funaddr fits in a long.  */
1152         sprintf (name, format, (unsigned long) funaddr);
1153       }
1154
1155     /* Execute the stack dummy routine, calling FUNCTION.
1156        When it is done, discard the empty frame
1157        after storing the contents of all regs into retbuf.  */
1158     if (run_stack_dummy (real_pc + CALL_DUMMY_START_OFFSET, retbuf))
1159       {
1160         /* We stopped somewhere besides the call dummy.  */
1161
1162         /* If we did the cleanups, we would print a spurious error message
1163            (Unable to restore previously selected frame), would write the
1164            registers from the inf_status (which is wrong), and would do other
1165            wrong things (like set stop_bpstat to the wrong thing).  */
1166         discard_cleanups (old_chain);
1167         /* Prevent memory leak.  */
1168         bpstat_clear (&inf_status.stop_bpstat);
1169
1170         /* The following error message used to say "The expression
1171            which contained the function call has been discarded."  It
1172            is a hard concept to explain in a few words.  Ideally, GDB
1173            would be able to resume evaluation of the expression when
1174            the function finally is done executing.  Perhaps someday
1175            this will be implemented (it would not be easy).  */
1176
1177         /* FIXME: Insert a bunch of wrap_here; name can be very long if it's
1178            a C++ name with arguments and stuff.  */
1179         error ("\
1180 The program being debugged stopped while in a function called from GDB.\n\
1181 When the function (%s) is done executing, GDB will silently\n\
1182 stop (instead of continuing to evaluate the expression containing\n\
1183 the function call).", name);
1184       }
1185
1186     do_cleanups (old_chain);
1187
1188     /* Figure out the value returned by the function.  */
1189     return value_being_returned (value_type, retbuf, struct_return);
1190   }
1191 }
1192 #else /* no CALL_DUMMY.  */
1193 value_ptr
1194 call_function_by_hand (function, nargs, args)
1195      value_ptr function;
1196      int nargs;
1197      value_ptr *args;
1198 {
1199   error ("Cannot invoke functions on this machine.");
1200 }
1201 #endif /* no CALL_DUMMY.  */
1202
1203 \f
1204 /* Create a value for an array by allocating space in the inferior, copying
1205    the data into that space, and then setting up an array value.
1206
1207    The array bounds are set from LOWBOUND and HIGHBOUND, and the array is
1208    populated from the values passed in ELEMVEC.
1209
1210    The element type of the array is inherited from the type of the
1211    first element, and all elements must have the same size (though we
1212    don't currently enforce any restriction on their types). */
1213
1214 value_ptr
1215 value_array (lowbound, highbound, elemvec)
1216      int lowbound;
1217      int highbound;
1218      value_ptr *elemvec;
1219 {
1220   int nelem;
1221   int idx;
1222   int typelength;
1223   value_ptr val;
1224   struct type *rangetype;
1225   struct type *arraytype;
1226   CORE_ADDR addr;
1227
1228   /* Validate that the bounds are reasonable and that each of the elements
1229      have the same size. */
1230
1231   nelem = highbound - lowbound + 1;
1232   if (nelem <= 0)
1233     {
1234       error ("bad array bounds (%d, %d)", lowbound, highbound);
1235     }
1236   typelength = TYPE_LENGTH (VALUE_TYPE (elemvec[0]));
1237   for (idx = 0; idx < nelem; idx++)
1238     {
1239       if (TYPE_LENGTH (VALUE_TYPE (elemvec[idx])) != typelength)
1240         {
1241           error ("array elements must all be the same size");
1242         }
1243     }
1244
1245   /* Allocate space to store the array in the inferior, and then initialize
1246      it by copying in each element.  FIXME:  Is it worth it to create a
1247      local buffer in which to collect each value and then write all the
1248      bytes in one operation? */
1249
1250   addr = allocate_space_in_inferior (nelem * typelength);
1251   for (idx = 0; idx < nelem; idx++)
1252     {
1253       write_memory (addr + (idx * typelength), VALUE_CONTENTS (elemvec[idx]),
1254                     typelength);
1255     }
1256
1257   /* Create the array type and set up an array value to be evaluated lazily. */
1258
1259   rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
1260                                  lowbound, highbound);
1261   arraytype = create_array_type ((struct type *) NULL,
1262                                  VALUE_TYPE (elemvec[0]), rangetype);
1263   val = value_at_lazy (arraytype, addr);
1264   return (val);
1265 }
1266
1267 /* Create a value for a string constant by allocating space in the inferior,
1268    copying the data into that space, and returning the address with type
1269    TYPE_CODE_STRING.  PTR points to the string constant data; LEN is number
1270    of characters.
1271    Note that string types are like array of char types with a lower bound of
1272    zero and an upper bound of LEN - 1.  Also note that the string may contain
1273    embedded null bytes. */
1274
1275 value_ptr
1276 value_string (ptr, len)
1277      char *ptr;
1278      int len;
1279 {
1280   value_ptr val;
1281   struct type *rangetype;
1282   struct type *stringtype;
1283   CORE_ADDR addr;
1284
1285   /* Allocate space to store the string in the inferior, and then
1286      copy LEN bytes from PTR in gdb to that address in the inferior. */
1287
1288   addr = allocate_space_in_inferior (len);
1289   write_memory (addr, ptr, len);
1290
1291   /* Create the string type and set up a string value to be evaluated
1292      lazily. */
1293
1294   rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
1295                                  0, len - 1);
1296   stringtype = create_string_type ((struct type *) NULL, rangetype);
1297   val = value_at_lazy (stringtype, addr);
1298   return (val);
1299 }
1300
1301 value_ptr
1302 value_bitstring (ptr, len)
1303      char *ptr;
1304      int len;
1305 {
1306   value_ptr val;
1307   struct type *domain_type = create_range_type (NULL, builtin_type_int,
1308                                                 0, len - 1);
1309   struct type *type = create_set_type ((struct type*) NULL, domain_type);
1310   TYPE_CODE (type) = TYPE_CODE_BITSTRING;
1311   val = allocate_value (type);
1312   memcpy (VALUE_CONTENTS_RAW (val), ptr, TYPE_LENGTH (type) / TARGET_CHAR_BIT);
1313   return val;
1314 }
1315 \f
1316 /* See if we can pass arguments in T2 to a function which takes arguments
1317    of types T1.  Both t1 and t2 are NULL-terminated vectors.  If some
1318    arguments need coercion of some sort, then the coerced values are written
1319    into T2.  Return value is 0 if the arguments could be matched, or the
1320    position at which they differ if not.
1321
1322    STATICP is nonzero if the T1 argument list came from a
1323    static member function.
1324
1325    For non-static member functions, we ignore the first argument,
1326    which is the type of the instance variable.  This is because we want
1327    to handle calls with objects from derived classes.  This is not
1328    entirely correct: we should actually check to make sure that a
1329    requested operation is type secure, shouldn't we?  FIXME.  */
1330
1331 static int
1332 typecmp (staticp, t1, t2)
1333      int staticp;
1334      struct type *t1[];
1335      value_ptr t2[];
1336 {
1337   int i;
1338
1339   if (t2 == 0)
1340     return 1;
1341   if (staticp && t1 == 0)
1342     return t2[1] != 0;
1343   if (t1 == 0)
1344     return 1;
1345   if (TYPE_CODE (t1[0]) == TYPE_CODE_VOID) return 0;
1346   if (t1[!staticp] == 0) return 0;
1347   for (i = !staticp; t1[i] && TYPE_CODE (t1[i]) != TYPE_CODE_VOID; i++)
1348     {
1349     struct type *tt1, *tt2;
1350       if (! t2[i])
1351         return i+1;
1352       tt1 = t1[i];
1353       tt2 = VALUE_TYPE(t2[i]);
1354       if (TYPE_CODE (tt1) == TYPE_CODE_REF
1355           /* We should be doing hairy argument matching, as below.  */
1356           && (TYPE_CODE (TYPE_TARGET_TYPE (tt1)) == TYPE_CODE (tt2)))
1357         {
1358           t2[i] = value_addr (t2[i]);
1359           continue;
1360         }
1361
1362       while (TYPE_CODE (tt1) == TYPE_CODE_PTR
1363           && (TYPE_CODE(tt2)==TYPE_CODE_ARRAY || TYPE_CODE(tt2)==TYPE_CODE_PTR))
1364         {
1365            tt1 = TYPE_TARGET_TYPE(tt1);
1366            tt2 = TYPE_TARGET_TYPE(tt2);
1367         }
1368       if (TYPE_CODE(tt1) == TYPE_CODE(tt2)) continue;
1369       /* Array to pointer is a `trivial conversion' according to the ARM.  */
1370
1371       /* We should be doing much hairier argument matching (see section 13.2
1372          of the ARM), but as a quick kludge, just check for the same type
1373          code.  */
1374       if (TYPE_CODE (t1[i]) != TYPE_CODE (VALUE_TYPE (t2[i])))
1375         return i+1;
1376     }
1377   if (!t1[i]) return 0;
1378   return t2[i] ? i+1 : 0;
1379 }
1380
1381 /* Helper function used by value_struct_elt to recurse through baseclasses.
1382    Look for a field NAME in ARG1. Adjust the address of ARG1 by OFFSET bytes,
1383    and search in it assuming it has (class) type TYPE.
1384    If found, return value, else return NULL.
1385
1386    If LOOKING_FOR_BASECLASS, then instead of looking for struct fields,
1387    look for a baseclass named NAME.  */
1388
1389 static value_ptr
1390 search_struct_field (name, arg1, offset, type, looking_for_baseclass)
1391      char *name;
1392      register value_ptr arg1;
1393      int offset;
1394      register struct type *type;
1395      int looking_for_baseclass;
1396 {
1397   int i;
1398
1399   check_stub_type (type);
1400
1401   if (! looking_for_baseclass)
1402     for (i = TYPE_NFIELDS (type) - 1; i >= TYPE_N_BASECLASSES (type); i--)
1403       {
1404         char *t_field_name = TYPE_FIELD_NAME (type, i);
1405
1406         if (t_field_name && STREQ (t_field_name, name))
1407           {
1408             value_ptr v;
1409             if (TYPE_FIELD_STATIC (type, i))
1410               {
1411                 char *phys_name = TYPE_FIELD_STATIC_PHYSNAME (type, i);
1412                 struct symbol *sym =
1413                     lookup_symbol (phys_name, 0, VAR_NAMESPACE, 0, NULL);
1414                 if (sym == NULL)
1415                     error ("Internal error: could not find physical static variable named %s",
1416                            phys_name);
1417                 v = value_at (TYPE_FIELD_TYPE (type, i),
1418                               (CORE_ADDR)SYMBOL_BLOCK_VALUE (sym));
1419               }
1420             else
1421               v = value_primitive_field (arg1, offset, i, type);
1422             if (v == 0)
1423               error("there is no field named %s", name);
1424             return v;
1425           }
1426         if (t_field_name && t_field_name[0] == '\0'
1427             && TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_UNION)
1428           {
1429             /* Look for a match through the fields of an anonymous union.  */
1430             value_ptr v;
1431             v = search_struct_field (name, arg1, offset,
1432                                      TYPE_FIELD_TYPE (type, i),
1433                                      looking_for_baseclass);
1434             if (v)
1435               return v;
1436           }
1437       }
1438
1439   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
1440     {
1441       value_ptr v;
1442       /* If we are looking for baseclasses, this is what we get when we
1443          hit them.  But it could happen that the base part's member name
1444          is not yet filled in.  */
1445       int found_baseclass = (looking_for_baseclass
1446                              && TYPE_BASECLASS_NAME (type, i) != NULL
1447                              && STREQ (name, TYPE_BASECLASS_NAME (type, i)));
1448
1449       if (BASETYPE_VIA_VIRTUAL (type, i))
1450         {
1451           value_ptr v2;
1452           /* Fix to use baseclass_offset instead. FIXME */
1453           baseclass_addr (type, i, VALUE_CONTENTS (arg1) + offset,
1454                           &v2, (int *)NULL);
1455           if (v2 == 0)
1456             error ("virtual baseclass botch");
1457           if (found_baseclass)
1458             return v2;
1459           v = search_struct_field (name, v2, 0, TYPE_BASECLASS (type, i),
1460                                    looking_for_baseclass);
1461         }
1462       else if (found_baseclass)
1463         v = value_primitive_field (arg1, offset, i, type);
1464       else
1465         v = search_struct_field (name, arg1,
1466                                  offset + TYPE_BASECLASS_BITPOS (type, i) / 8,
1467                                  TYPE_BASECLASS (type, i),
1468                                  looking_for_baseclass);
1469       if (v) return v;
1470     }
1471   return NULL;
1472 }
1473
1474 /* Helper function used by value_struct_elt to recurse through baseclasses.
1475    Look for a field NAME in ARG1. Adjust the address of ARG1 by OFFSET bytes,
1476    and search in it assuming it has (class) type TYPE.
1477    If found, return value, else if name matched and args not return (value)-1,
1478    else return NULL. */
1479
1480 static value_ptr
1481 search_struct_method (name, arg1p, args, offset, static_memfuncp, type)
1482      char *name;
1483      register value_ptr *arg1p, *args;
1484      int offset, *static_memfuncp;
1485      register struct type *type;
1486 {
1487   int i;
1488   value_ptr v;
1489   int name_matched = 0;
1490   char dem_opname[64];
1491
1492   check_stub_type (type);
1493   for (i = TYPE_NFN_FIELDS (type) - 1; i >= 0; i--)
1494     {
1495       char *t_field_name = TYPE_FN_FIELDLIST_NAME (type, i);
1496       if (strncmp(t_field_name, "__", 2)==0 ||
1497         strncmp(t_field_name, "op", 2)==0 ||
1498         strncmp(t_field_name, "type", 4)==0 )
1499         {
1500           if (cplus_demangle_opname(t_field_name, dem_opname, DMGL_ANSI))
1501             t_field_name = dem_opname;
1502           else if (cplus_demangle_opname(t_field_name, dem_opname, 0))
1503             t_field_name = dem_opname;
1504         }
1505       if (t_field_name && STREQ (t_field_name, name))
1506         {
1507           int j = TYPE_FN_FIELDLIST_LENGTH (type, i) - 1;
1508           struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
1509           name_matched = 1;
1510
1511           if (j > 0 && args == 0)
1512             error ("cannot resolve overloaded method `%s'", name);
1513           while (j >= 0)
1514             {
1515               if (TYPE_FN_FIELD_STUB (f, j))
1516                 check_stub_method (type, i, j);
1517               if (!typecmp (TYPE_FN_FIELD_STATIC_P (f, j),
1518                             TYPE_FN_FIELD_ARGS (f, j), args))
1519                 {
1520                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
1521                     return value_virtual_fn_field (arg1p, f, j, type, offset);
1522                   if (TYPE_FN_FIELD_STATIC_P (f, j) && static_memfuncp)
1523                     *static_memfuncp = 1;
1524                   v = value_fn_field (arg1p, f, j, type, offset);
1525                   if (v != NULL) return v;
1526                 }
1527               j--;
1528             }
1529         }
1530     }
1531
1532   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
1533     {
1534       int base_offset;
1535
1536       if (BASETYPE_VIA_VIRTUAL (type, i))
1537         {
1538           base_offset = baseclass_offset (type, i, *arg1p, offset);
1539           if (base_offset == -1)
1540             error ("virtual baseclass botch");
1541         }
1542       else
1543         {
1544           base_offset = TYPE_BASECLASS_BITPOS (type, i) / 8;
1545         }
1546       v = search_struct_method (name, arg1p, args, base_offset + offset,
1547                                 static_memfuncp, TYPE_BASECLASS (type, i));
1548       if (v == (value_ptr) -1)
1549         {
1550           name_matched = 1;
1551         }
1552       else if (v)
1553         {
1554 /* FIXME-bothner:  Why is this commented out?  Why is it here?  */
1555 /*        *arg1p = arg1_tmp;*/
1556           return v;
1557         }
1558     }
1559   if (name_matched) return (value_ptr) -1;
1560   else return NULL;
1561 }
1562
1563 /* Given *ARGP, a value of type (pointer to a)* structure/union,
1564    extract the component named NAME from the ultimate target structure/union
1565    and return it as a value with its appropriate type.
1566    ERR is used in the error message if *ARGP's type is wrong.
1567
1568    C++: ARGS is a list of argument types to aid in the selection of
1569    an appropriate method. Also, handle derived types.
1570
1571    STATIC_MEMFUNCP, if non-NULL, points to a caller-supplied location
1572    where the truthvalue of whether the function that was resolved was
1573    a static member function or not is stored.
1574
1575    ERR is an error message to be printed in case the field is not found.  */
1576
1577 value_ptr
1578 value_struct_elt (argp, args, name, static_memfuncp, err)
1579      register value_ptr *argp, *args;
1580      char *name;
1581      int *static_memfuncp;
1582      char *err;
1583 {
1584   register struct type *t;
1585   value_ptr v;
1586
1587   COERCE_ARRAY (*argp);
1588
1589   t = VALUE_TYPE (*argp);
1590
1591   /* Follow pointers until we get to a non-pointer.  */
1592
1593   while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF)
1594     {
1595       *argp = value_ind (*argp);
1596       /* Don't coerce fn pointer to fn and then back again!  */
1597       if (TYPE_CODE (VALUE_TYPE (*argp)) != TYPE_CODE_FUNC)
1598         COERCE_ARRAY (*argp);
1599       t = VALUE_TYPE (*argp);
1600     }
1601
1602   if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
1603     error ("not implemented: member type in value_struct_elt");
1604
1605   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
1606       && TYPE_CODE (t) != TYPE_CODE_UNION)
1607     error ("Attempt to extract a component of a value that is not a %s.", err);
1608
1609   /* Assume it's not, unless we see that it is.  */
1610   if (static_memfuncp)
1611     *static_memfuncp =0;
1612
1613   if (!args)
1614     {
1615       /* if there are no arguments ...do this...  */
1616
1617       /* Try as a field first, because if we succeed, there
1618          is less work to be done.  */
1619       v = search_struct_field (name, *argp, 0, t, 0);
1620       if (v)
1621         return v;
1622
1623       /* C++: If it was not found as a data field, then try to
1624          return it as a pointer to a method.  */
1625
1626       if (destructor_name_p (name, t))
1627         error ("Cannot get value of destructor");
1628
1629       v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
1630
1631       if (v == (value_ptr) -1)
1632         error ("Cannot take address of a method");
1633       else if (v == 0)
1634         {
1635           if (TYPE_NFN_FIELDS (t))
1636             error ("There is no member or method named %s.", name);
1637           else
1638             error ("There is no member named %s.", name);
1639         }
1640       return v;
1641     }
1642
1643   if (destructor_name_p (name, t))
1644     {
1645       if (!args[1])
1646         {
1647           /* destructors are a special case.  */
1648           v = value_fn_field (NULL, TYPE_FN_FIELDLIST1 (t, 0),
1649                               TYPE_FN_FIELDLIST_LENGTH (t, 0), 0, 0);
1650           if (!v) error("could not find destructor function named %s.", name);
1651           else return v;
1652         }
1653       else
1654         {
1655           error ("destructor should not have any argument");
1656         }
1657     }
1658   else
1659     v = search_struct_method (name, argp, args, 0, static_memfuncp, t);
1660
1661   if (v == (value_ptr) -1)
1662     {
1663         error("Argument list of %s mismatch with component in the structure.", name);
1664     }
1665   else if (v == 0)
1666     {
1667       /* See if user tried to invoke data as function.  If so,
1668          hand it back.  If it's not callable (i.e., a pointer to function),
1669          gdb should give an error.  */
1670       v = search_struct_field (name, *argp, 0, t, 0);
1671     }
1672
1673   if (!v)
1674     error ("Structure has no component named %s.", name);
1675   return v;
1676 }
1677
1678 /* C++: return 1 is NAME is a legitimate name for the destructor
1679    of type TYPE.  If TYPE does not have a destructor, or
1680    if NAME is inappropriate for TYPE, an error is signaled.  */
1681 int
1682 destructor_name_p (name, type)
1683      const char *name;
1684      const struct type *type;
1685 {
1686   /* destructors are a special case.  */
1687
1688   if (name[0] == '~')
1689     {
1690       char *dname = type_name_no_tag (type);
1691       char *cp = strchr (dname, '<');
1692       int len;
1693
1694       /* Do not compare the template part for template classes.  */
1695       if (cp == NULL)
1696         len = strlen (dname);
1697       else
1698         len = cp - dname;
1699       if (strlen (name + 1) != len || !STREQN (dname, name + 1, len))
1700         error ("name of destructor must equal name of class");
1701       else
1702         return 1;
1703     }
1704   return 0;
1705 }
1706
1707 /* Helper function for check_field: Given TYPE, a structure/union,
1708    return 1 if the component named NAME from the ultimate
1709    target structure/union is defined, otherwise, return 0. */
1710
1711 static int
1712 check_field_in (type, name)
1713      register struct type *type;
1714      const char *name;
1715 {
1716   register int i;
1717
1718   for (i = TYPE_NFIELDS (type) - 1; i >= TYPE_N_BASECLASSES (type); i--)
1719     {
1720       char *t_field_name = TYPE_FIELD_NAME (type, i);
1721       if (t_field_name && STREQ (t_field_name, name))
1722         return 1;
1723     }
1724
1725   /* C++: If it was not found as a data field, then try to
1726      return it as a pointer to a method.  */
1727
1728   /* Destructors are a special case.  */
1729   if (destructor_name_p (name, type))
1730     return 1;
1731
1732   for (i = TYPE_NFN_FIELDS (type) - 1; i >= 0; --i)
1733     {
1734       if (STREQ (TYPE_FN_FIELDLIST_NAME (type, i), name))
1735         return 1;
1736     }
1737
1738   for (i = TYPE_N_BASECLASSES (type) - 1; i >= 0; i--)
1739     if (check_field_in (TYPE_BASECLASS (type, i), name))
1740       return 1;
1741
1742   return 0;
1743 }
1744
1745
1746 /* C++: Given ARG1, a value of type (pointer to a)* structure/union,
1747    return 1 if the component named NAME from the ultimate
1748    target structure/union is defined, otherwise, return 0.  */
1749
1750 int
1751 check_field (arg1, name)
1752      register value_ptr arg1;
1753      const char *name;
1754 {
1755   register struct type *t;
1756
1757   COERCE_ARRAY (arg1);
1758
1759   t = VALUE_TYPE (arg1);
1760
1761   /* Follow pointers until we get to a non-pointer.  */
1762
1763   while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF)
1764     t = TYPE_TARGET_TYPE (t);
1765
1766   if (TYPE_CODE (t) == TYPE_CODE_MEMBER)
1767     error ("not implemented: member type in check_field");
1768
1769   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
1770       && TYPE_CODE (t) != TYPE_CODE_UNION)
1771     error ("Internal error: `this' is not an aggregate");
1772
1773   return check_field_in (t, name);
1774 }
1775
1776 /* C++: Given an aggregate type CURTYPE, and a member name NAME,
1777    return the address of this member as a "pointer to member"
1778    type.  If INTYPE is non-null, then it will be the type
1779    of the member we are looking for.  This will help us resolve
1780    "pointers to member functions".  This function is used
1781    to resolve user expressions of the form "DOMAIN::NAME".  */
1782
1783 value_ptr
1784 value_struct_elt_for_reference (domain, offset, curtype, name, intype)
1785      struct type *domain, *curtype, *intype;
1786      int offset;
1787      char *name;
1788 {
1789   register struct type *t = curtype;
1790   register int i;
1791   value_ptr v;
1792
1793   if (   TYPE_CODE (t) != TYPE_CODE_STRUCT
1794       && TYPE_CODE (t) != TYPE_CODE_UNION)
1795     error ("Internal error: non-aggregate type to value_struct_elt_for_reference");
1796
1797   for (i = TYPE_NFIELDS (t) - 1; i >= TYPE_N_BASECLASSES (t); i--)
1798     {
1799       char *t_field_name = TYPE_FIELD_NAME (t, i);
1800
1801       if (t_field_name && STREQ (t_field_name, name))
1802         {
1803           if (TYPE_FIELD_STATIC (t, i))
1804             {
1805               char *phys_name = TYPE_FIELD_STATIC_PHYSNAME (t, i);
1806               struct symbol *sym =
1807                 lookup_symbol (phys_name, 0, VAR_NAMESPACE, 0, NULL);
1808               if (sym == NULL)
1809                 error ("Internal error: could not find physical static variable named %s",
1810                        phys_name);
1811               return value_at (SYMBOL_TYPE (sym),
1812                                (CORE_ADDR)SYMBOL_BLOCK_VALUE (sym));
1813             }
1814           if (TYPE_FIELD_PACKED (t, i))
1815             error ("pointers to bitfield members not allowed");
1816
1817           return value_from_longest
1818             (lookup_reference_type (lookup_member_type (TYPE_FIELD_TYPE (t, i),
1819                                                         domain)),
1820              offset + (LONGEST) (TYPE_FIELD_BITPOS (t, i) >> 3));
1821         }
1822     }
1823
1824   /* C++: If it was not found as a data field, then try to
1825      return it as a pointer to a method.  */
1826
1827   /* Destructors are a special case.  */
1828   if (destructor_name_p (name, t))
1829     {
1830       error ("member pointers to destructors not implemented yet");
1831     }
1832
1833   /* Perform all necessary dereferencing.  */
1834   while (intype && TYPE_CODE (intype) == TYPE_CODE_PTR)
1835     intype = TYPE_TARGET_TYPE (intype);
1836
1837   for (i = TYPE_NFN_FIELDS (t) - 1; i >= 0; --i)
1838     {
1839       char *t_field_name = TYPE_FN_FIELDLIST_NAME (t, i);
1840       char dem_opname[64];
1841
1842       if (strncmp(t_field_name, "__", 2)==0 ||
1843         strncmp(t_field_name, "op", 2)==0 ||
1844         strncmp(t_field_name, "type", 4)==0 )
1845         {
1846           if (cplus_demangle_opname(t_field_name, dem_opname, DMGL_ANSI))
1847             t_field_name = dem_opname;
1848           else if (cplus_demangle_opname(t_field_name, dem_opname, 0))
1849             t_field_name = dem_opname;
1850         }
1851       if (t_field_name && STREQ (t_field_name, name))
1852         {
1853           int j = TYPE_FN_FIELDLIST_LENGTH (t, i);
1854           struct fn_field *f = TYPE_FN_FIELDLIST1 (t, i);
1855
1856           if (intype == 0 && j > 1)
1857             error ("non-unique member `%s' requires type instantiation", name);
1858           if (intype)
1859             {
1860               while (j--)
1861                 if (TYPE_FN_FIELD_TYPE (f, j) == intype)
1862                   break;
1863               if (j < 0)
1864                 error ("no member function matches that type instantiation");
1865             }
1866           else
1867             j = 0;
1868
1869           if (TYPE_FN_FIELD_STUB (f, j))
1870             check_stub_method (t, i, j);
1871           if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
1872             {
1873               return value_from_longest
1874                 (lookup_reference_type
1875                  (lookup_member_type (TYPE_FN_FIELD_TYPE (f, j),
1876                                       domain)),
1877                  (LONGEST) METHOD_PTR_FROM_VOFFSET
1878                   (TYPE_FN_FIELD_VOFFSET (f, j)));
1879             }
1880           else
1881             {
1882               struct symbol *s = lookup_symbol (TYPE_FN_FIELD_PHYSNAME (f, j),
1883                                                 0, VAR_NAMESPACE, 0, NULL);
1884               if (s == NULL)
1885                 {
1886                   v = 0;
1887                 }
1888               else
1889                 {
1890                   v = read_var_value (s, 0);
1891 #if 0
1892                   VALUE_TYPE (v) = lookup_reference_type
1893                     (lookup_member_type (TYPE_FN_FIELD_TYPE (f, j),
1894                                          domain));
1895 #endif
1896                 }
1897               return v;
1898             }
1899         }
1900     }
1901   for (i = TYPE_N_BASECLASSES (t) - 1; i >= 0; i--)
1902     {
1903       value_ptr v;
1904       int base_offset;
1905
1906       if (BASETYPE_VIA_VIRTUAL (t, i))
1907         base_offset = 0;
1908       else
1909         base_offset = TYPE_BASECLASS_BITPOS (t, i) / 8;
1910       v = value_struct_elt_for_reference (domain,
1911                                           offset + base_offset,
1912                                           TYPE_BASECLASS (t, i),
1913                                           name,
1914                                           intype);
1915       if (v)
1916         return v;
1917     }
1918   return 0;
1919 }
1920
1921 /* C++: return the value of the class instance variable, if one exists.
1922    Flag COMPLAIN signals an error if the request is made in an
1923    inappropriate context.  */
1924
1925 value_ptr
1926 value_of_this (complain)
1927      int complain;
1928 {
1929   struct symbol *func, *sym;
1930   struct block *b;
1931   int i;
1932   static const char funny_this[] = "this";
1933   value_ptr this;
1934
1935   if (selected_frame == 0)
1936     if (complain)
1937       error ("no frame selected");
1938     else return 0;
1939
1940   func = get_frame_function (selected_frame);
1941   if (!func)
1942     {
1943       if (complain)
1944         error ("no `this' in nameless context");
1945       else return 0;
1946     }
1947
1948   b = SYMBOL_BLOCK_VALUE (func);
1949   i = BLOCK_NSYMS (b);
1950   if (i <= 0)
1951     if (complain)
1952       error ("no args, no `this'");
1953     else return 0;
1954
1955   /* Calling lookup_block_symbol is necessary to get the LOC_REGISTER
1956      symbol instead of the LOC_ARG one (if both exist).  */
1957   sym = lookup_block_symbol (b, funny_this, VAR_NAMESPACE);
1958   if (sym == NULL)
1959     {
1960       if (complain)
1961         error ("current stack frame not in method");
1962       else
1963         return NULL;
1964     }
1965
1966   this = read_var_value (sym, selected_frame);
1967   if (this == 0 && complain)
1968     error ("`this' argument at unknown address");
1969   return this;
1970 }
1971
1972 /* Create a value for a literal string.  We copy data into a local
1973    (NOT inferior's memory) buffer, and then set up an array value.
1974
1975    The array bounds are set from LOWBOUND and HIGHBOUND, and the array is
1976    populated from the values passed in ELEMVEC.
1977
1978    The element type of the array is inherited from the type of the
1979    first element, and all elements must have the same size (though we
1980    don't currently enforce any restriction on their types). */
1981
1982 value_ptr
1983 f77_value_literal_string (lowbound, highbound, elemvec)
1984      int lowbound;
1985      int highbound;
1986      value_ptr *elemvec;
1987 {
1988   int nelem;
1989   int idx;
1990   int typelength;
1991   register value_ptr val;
1992   struct type *rangetype;
1993   struct type *arraytype;
1994   char *addr;
1995
1996   /* Validate that the bounds are reasonable and that each of the elements
1997      have the same size. */
1998
1999   nelem = highbound - lowbound + 1;
2000   if (nelem <= 0)
2001     error ("bad array bounds (%d, %d)", lowbound, highbound);
2002   typelength = TYPE_LENGTH (VALUE_TYPE (elemvec[0]));
2003   for (idx = 0; idx < nelem; idx++)
2004     {
2005       if (TYPE_LENGTH (VALUE_TYPE (elemvec[idx])) != typelength)
2006         error ("array elements must all be the same size");
2007     }
2008
2009   /* Make sure we are dealing with characters */
2010
2011   if (typelength != 1)
2012     error ("Found a non character type in a literal string ");
2013
2014   /* Allocate space to store the array */
2015
2016   addr = xmalloc (nelem);
2017   for (idx = 0; idx < nelem; idx++)
2018     {
2019       memcpy (addr + (idx), VALUE_CONTENTS (elemvec[idx]), 1);
2020     }
2021
2022   rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
2023                                  lowbound, highbound);
2024
2025   arraytype = f77_create_literal_string_type ((struct type *) NULL,
2026                                               rangetype);
2027
2028   val = allocate_value (arraytype);
2029
2030   /* Make sure that this the rest of the world knows that this is
2031      a standard literal string, not one that is a substring of
2032      some base */
2033
2034   VALUE_SUBSTRING_MEMADDR (val) = (CORE_ADDR)0;
2035
2036   VALUE_LAZY (val) = 0;
2037   VALUE_LITERAL_DATA (val) = addr;
2038
2039   /* Since this is a standard literal string with no real lval,
2040      make sure that value_lval indicates this fact */
2041
2042   VALUE_LVAL (val) = not_lval;
2043   return val;
2044 }
2045
2046 /* Create a value for a substring.  We copy data into a local
2047    (NOT inferior's memory) buffer, and then set up an array value.
2048
2049    The array bounds for the string are (1:(to-from +1))
2050    The elements of the string are all characters.  */
2051
2052 value_ptr
2053 f77_value_substring (str, from, to)
2054      value_ptr str;
2055      int from;
2056      int to;
2057 {
2058   int nelem;
2059   register value_ptr val;
2060   struct type *rangetype;
2061   struct type *arraytype;
2062   struct internalvar *var;
2063   char *addr;
2064
2065   /* Validate that the bounds are reasonable. */
2066
2067   nelem = to - from + 1;
2068   if (nelem <= 0)
2069     error ("bad substring bounds (%d, %d)", from, to);
2070
2071   rangetype = create_range_type ((struct type *) NULL, builtin_type_int,
2072                                  1, nelem);
2073
2074   arraytype = f77_create_literal_string_type ((struct type *) NULL,
2075                                               rangetype);
2076
2077   val = allocate_value (arraytype);
2078
2079   /* Allocate space to store the substring array */
2080
2081   addr = xmalloc (nelem);
2082
2083   /* Copy over the data */
2084
2085   /* In case we ever try to use this substring on the LHS of an assignment
2086      remember where the SOURCE substring begins, for lval_memory
2087      types this ptr is to a location in legal inferior memory,
2088      for lval_internalvars it is a ptr. to superior memory. This
2089      helps us out later when we do assigments like:
2090
2091      set var ARR(2:3) = 'ab'
2092
2093      */
2094
2095
2096   if (VALUE_LVAL (str) == lval_memory)
2097     {
2098       if (VALUE_SUBSTRING_MEMADDR (str) == (CORE_ADDR)0)
2099         {
2100           /* This is a regular lval_memory string located in the
2101              inferior */
2102
2103           VALUE_SUBSTRING_MEMADDR (val) = VALUE_ADDRESS (str) + (from - 1);
2104           target_read_memory (VALUE_SUBSTRING_MEMADDR (val), addr, nelem);
2105         }
2106       else
2107         {
2108
2109 #if 0
2110           /* str is a substring allocated in the superior. Just
2111              do a memcpy */
2112
2113           VALUE_SUBSTRING_MYADDR (val) = VALUE_LITERAL_DATA(str)+(from - 1);
2114           memcpy(addr, VALUE_SUBSTRING_MYADDR (val), nelem);
2115 #else
2116           error ("Cannot get substrings of substrings");
2117 #endif
2118         }
2119     }
2120   else
2121     if (VALUE_LVAL(str) == lval_internalvar)
2122       {
2123         /* Internal variables of type TYPE_CODE_LITERAL_STRING
2124            have their data located in the superior
2125            process not the inferior */
2126
2127         var = VALUE_INTERNALVAR (str);
2128
2129         if (VALUE_SUBSTRING_MEMADDR (str) == (CORE_ADDR)0)
2130            VALUE_SUBSTRING_MYADDR (val) =
2131              ((char *) VALUE_LITERAL_DATA (var->value)) + (from - 1);
2132         else
2133 #if 0
2134           VALUE_SUBSTRING_MYADDR (val) = VALUE_LITERAL_DATA(str)+(from -1);
2135 #else
2136         error ("Cannot get substrings of substrings");
2137 #endif
2138         memcpy (addr, VALUE_SUBSTRING_MYADDR (val), nelem);
2139       }
2140     else
2141       error ("Substrings can not be applied to this data item");
2142
2143   VALUE_LAZY (val) = 0;
2144   VALUE_LITERAL_DATA (val) = addr;
2145
2146   /* This literal string's *data* is located in the superior BUT
2147      we do need to know where it came from (i.e. was the source
2148      string an internalvar or a regular lval_memory variable), so
2149      we set the lval field to indicate this.  This will be useful
2150      when we use this value on the LHS of an expr. */
2151
2152   VALUE_LVAL (val) = VALUE_LVAL (str);
2153   return val;
2154 }
2155
2156 /* Create a value for a FORTRAN complex number.  Currently most of
2157    the time values are coerced to COMPLEX*16 (i.e. a complex number
2158    composed of 2 doubles.  This really should be a smarter routine
2159    that figures out precision inteligently as opposed to assuming
2160    doubles. FIXME: fmb */
2161
2162 value_ptr
2163 f77_value_literal_complex (arg1, arg2, size)
2164      value_ptr arg1;
2165      value_ptr arg2;
2166      int size;
2167 {
2168   struct type *complex_type;
2169   register value_ptr val;
2170   char *addr;
2171
2172   if (size != 8 && size != 16 && size != 32)
2173     error ("Cannot create number of type 'complex*%d'", size);
2174
2175   /* If either value comprising a complex number is a non-floating
2176      type, cast to double. */
2177
2178   if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_FLT)
2179     arg1 = value_cast (builtin_type_f_real_s8, arg1);
2180
2181   if (TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_FLT)
2182     arg2 = value_cast (builtin_type_f_real_s8, arg2);
2183
2184   complex_type = f77_create_literal_complex_type (VALUE_TYPE (arg1),
2185                                                   VALUE_TYPE (arg2)
2186 #if 0
2187 /* FIXME: does f77_create_literal_complex_type need to do something with
2188    this?  */
2189                                                   ,
2190                                                   size
2191 #endif
2192                                                   );
2193
2194   val = allocate_value (complex_type);
2195
2196   /* Now create a pointer to enough memory to hold the the two args */
2197
2198   addr = xmalloc (TYPE_LENGTH (complex_type));
2199
2200   /* Copy over the two components */
2201
2202   memcpy (addr, VALUE_CONTENTS_RAW (arg1), TYPE_LENGTH (VALUE_TYPE (arg1)));
2203
2204   memcpy (addr + TYPE_LENGTH (VALUE_TYPE (arg1)), VALUE_CONTENTS_RAW (arg2),
2205           TYPE_LENGTH (VALUE_TYPE (arg2)));
2206
2207   VALUE_ADDRESS (val) = 0; /* Not located in the inferior */
2208   VALUE_LAZY (val) = 0;
2209   VALUE_LITERAL_DATA (val) = addr;
2210
2211   /* Since this is a literal value, make sure that value_lval indicates
2212      this fact */
2213
2214   VALUE_LVAL (val) = not_lval;
2215   return val;
2216 }
2217
2218 /* Cast a value into the appropriate complex data type. Only works
2219    if both values are complex.  */
2220
2221 static value_ptr
2222 f77_cast_into_complex (type, val)
2223      struct type *type;
2224      register value_ptr val;
2225 {
2226   register enum type_code valcode;
2227   float tmp_f;
2228   double tmp_d;
2229   register value_ptr piece1, piece2;
2230
2231   int lenfrom, lento;
2232
2233   valcode = TYPE_CODE (VALUE_TYPE (val));
2234
2235   /* This casting will only work if the right hand side is
2236      either a regular complex type or a literal complex type.
2237      I.e: this casting is only for size adjustment of
2238      complex numbers not anything else. */
2239
2240   if ((valcode != TYPE_CODE_COMPLEX) &&
2241       (valcode != TYPE_CODE_LITERAL_COMPLEX))
2242     error ("Cannot cast from a non complex type!");
2243
2244   lenfrom = TYPE_LENGTH (VALUE_TYPE (val));
2245   lento =   TYPE_LENGTH (type);
2246
2247   if (lento == lenfrom)
2248     error ("Value to be cast is already of type %s", TYPE_NAME (type));
2249
2250   if (lento == 32 || lenfrom == 32)
2251     error ("Casting into/out of complex*32 unsupported");
2252
2253   switch (lento)
2254     {
2255     case 16:
2256       {
2257         /* Since we have excluded lenfrom == 32 and
2258            lenfrom == 16, it MUST be 8 */
2259
2260         if (valcode == TYPE_CODE_LITERAL_COMPLEX)
2261           {
2262             /* Located in superior's memory. Routine should
2263                deal with both real literal complex numbers
2264                as well as internal vars */
2265
2266             /* Grab the two 4 byte reals that make up the complex*8 */
2267
2268             tmp_f = *((float *) VALUE_LITERAL_DATA (val));
2269
2270             piece1 = value_from_double(builtin_type_f_real_s8,tmp_f);
2271
2272             tmp_f = *((float *) (((char *) VALUE_LITERAL_DATA (val))
2273                                  + sizeof(float)));
2274
2275             piece2 = value_from_double (builtin_type_f_real_s8, tmp_f);
2276           }
2277         else
2278           {
2279             /* Located in inferior memory, so first we need
2280                to read the 2 floats that make up the 8 byte
2281                complex we are are casting from */
2282
2283             read_memory ((CORE_ADDR) VALUE_CONTENTS (val),
2284                          (char *) &tmp_f, sizeof(float));
2285
2286             piece1 = value_from_double (builtin_type_f_real_s8, tmp_f);
2287
2288             read_memory ((CORE_ADDR) VALUE_CONTENTS (val) + sizeof(float),
2289                          (char *) &tmp_f, sizeof(float));
2290
2291             piece2 = value_from_double (builtin_type_f_real_s8, tmp_f);
2292           }
2293         return f77_value_literal_complex (piece1, piece2, 16);
2294       }
2295
2296     case 8:
2297       {
2298         /* Since we have excluded lenfrom == 32 and
2299            lenfrom == 8, it MUST be 16. NOTE: in this
2300            case data may be since we are dropping precison */
2301
2302         if (valcode == TYPE_CODE_LITERAL_COMPLEX)
2303           {
2304             /* Located in superior's memory. Routine should
2305                deal with both real literal complex numbers
2306                as well as internal vars */
2307
2308             /* Grab the two 8 byte reals that make up the complex*16 */
2309
2310             tmp_d = *((double *) VALUE_LITERAL_DATA (val));
2311
2312             piece1 = value_from_double (builtin_type_f_real, tmp_d);
2313
2314             tmp_d = *((double *) (((char *) VALUE_LITERAL_DATA (val))
2315                                   + sizeof(double)));
2316
2317             piece2 = value_from_double (builtin_type_f_real, tmp_d);
2318           }
2319         else
2320           {
2321             /* Located in inferior memory, so first we need to read the
2322                2 floats that make up the 8 byte complex we are are
2323                casting from.  */
2324
2325             read_memory ((CORE_ADDR) VALUE_CONTENTS (val),
2326                          (char *) &tmp_d, sizeof(double));
2327
2328             piece1 = value_from_double (builtin_type_f_real, tmp_d);
2329
2330             read_memory ((CORE_ADDR) VALUE_CONTENTS (val) + sizeof(double),
2331                          (char *) &tmp_f, sizeof(double));
2332
2333             piece2 = value_from_double (builtin_type_f_real, tmp_d);
2334           }
2335         return f77_value_literal_complex (piece1, piece2, 8);
2336       }
2337
2338     default:
2339       error ("Invalid F77 complex number cast");
2340     }
2341 }
2342
2343 /* The following function is called in order to assign
2344    a literal F77 array to either an internal GDB variable
2345    or to a real array variable in the inferior.
2346    This function is necessary because in F77, literal
2347    arrays are allocated in the superior's memory space
2348    NOT the inferior's.  This function provides a way to
2349    get the F77 stuff to work without messing with the
2350    way C deals with this issue. NOTE: we are assuming
2351    that all F77 array literals are STRING array literals.  F77
2352    users have no good way of expressing non-string
2353    literal strings.
2354
2355    This routine now also handles assignment TO literal strings
2356    in the peculiar case of substring assignments of the
2357    form:
2358
2359    STR(2:3) = 'foo'
2360
2361    */
2362
2363 static value_ptr
2364 f77_assign_from_literal_string (toval, fromval)
2365      register value_ptr toval, fromval;
2366 {
2367   register struct type *type = VALUE_TYPE (toval);
2368   register value_ptr val;
2369   struct internalvar *var;
2370   int lenfrom, lento;
2371   CORE_ADDR tmp_addr;
2372   char *c;
2373
2374   lenfrom = TYPE_LENGTH (VALUE_TYPE (fromval));
2375   lento = TYPE_LENGTH (VALUE_TYPE (toval));
2376
2377   if ((VALUE_LVAL (toval) == lval_internalvar
2378        || VALUE_LVAL (toval) == lval_memory)
2379       && VALUE_SUBSTRING_START (toval) != 0)
2380     {
2381       /* We are assigning TO a substring type. This is of the form:
2382
2383          set A(2:5) = 'foov'
2384
2385          The result of this will be a modified toval not a brand new
2386          value. This is high F77 weirdness.  */
2387
2388       /* Simply overwrite the relevant memory, wherever it
2389          exists. Use standard F77 character assignment rules
2390          (if len(toval) > len(fromval) pad with blanks,
2391          if len(toval) < len(fromval) truncate else just copy. */
2392
2393       if (VALUE_LVAL (toval) == lval_internalvar)
2394         {
2395           /* Memory in superior.  */
2396           var = VALUE_INTERNALVAR (toval);
2397           memcpy ((char *) VALUE_SUBSTRING_START (toval),
2398                   (char *) VALUE_LITERAL_DATA (fromval),
2399                   (lento > lenfrom) ? lenfrom : lento);
2400
2401           /* Check to see if we have to pad. */
2402
2403           if (lento > lenfrom)
2404             {
2405               memset((char *) VALUE_SUBSTRING_START(toval) + lenfrom,
2406                      ' ', lento - lenfrom);
2407             }
2408         }
2409       else
2410         {
2411           /* Memory in inferior.  */
2412           write_memory ((CORE_ADDR) VALUE_SUBSTRING_START (toval),
2413                         (char *) VALUE_LITERAL_DATA (fromval),
2414                         (lento > lenfrom) ? lenfrom : lento);
2415
2416           /* Check to see if we have to pad.  */
2417
2418           if (lento > lenfrom)
2419             {
2420               c = alloca (lento-lenfrom);
2421               memset (c, ' ', lento - lenfrom);
2422
2423               tmp_addr = VALUE_SUBSTRING_START (toval) + lenfrom;
2424               write_memory (tmp_addr, c, lento - lenfrom);
2425             }
2426         }
2427       return fromval;
2428     }
2429   else
2430     {
2431       if (VALUE_LVAL (toval) == lval_internalvar)
2432         type = VALUE_TYPE (fromval);
2433
2434       val = allocate_value (type);
2435
2436       switch (VALUE_LVAL (toval))
2437         {
2438         case lval_internalvar:
2439
2440           /* Internal variables are funny.  Their value information
2441              is stored in the location.internalvar sub structure.  */
2442
2443           var = VALUE_INTERNALVAR (toval);
2444
2445           /* The item in toval is a regular internal variable
2446              and this assignment is of the form:
2447
2448              set var $foo = 'hello' */
2449
2450           /* First free up any old stuff in this internalvar.  */
2451
2452           free (VALUE_LITERAL_DATA (var->value));
2453           VALUE_LITERAL_DATA (var->value) = 0;
2454           VALUE_LAZY (var->value) = 0; /* Disable lazy fetches since this
2455                                           is not located in inferior. */
2456
2457           /* Copy over the relevant value data from 'fromval' */
2458
2459           set_internalvar (VALUE_INTERNALVAR (toval), fromval);
2460
2461           /* Now replicate the VALUE_LITERAL_DATA field so that
2462              we may later safely de-allocate fromval. */
2463
2464           VALUE_LITERAL_DATA (var->value) =
2465             malloc (TYPE_LENGTH (VALUE_TYPE (fromval)));
2466
2467           memcpy((char *) VALUE_LITERAL_DATA (var->value),
2468                  (char *) VALUE_LITERAL_DATA (fromval),
2469                  lenfrom);
2470
2471           /* Copy over all relevant value data from 'toval'.  into
2472              the structure to returned */
2473
2474           memcpy (val, toval, sizeof(struct value));
2475
2476           /* Lastly copy the pointer to the area where the
2477              internalvar data is stored to the VALUE_CONTENTS field.
2478              This will be a helpful shortcut for printout
2479              routines later */
2480
2481           VALUE_LITERAL_DATA (val) = VALUE_LITERAL_DATA (var->value);
2482           break;
2483
2484         case lval_memory:
2485
2486           /* We are copying memory from the local (superior)
2487              literal string to a legitimate address in the
2488              inferior. VALUE_ADDRESS is the address in
2489              the inferior. VALUE_OFFSET is not used because
2490              structs do not exist in F77. */
2491
2492           /* Copy over all relevant value data from 'toval'.  */
2493
2494           memcpy (val, toval, sizeof(struct value));
2495
2496           write_memory ((CORE_ADDR) VALUE_ADDRESS (val),
2497                         (char *) VALUE_LITERAL_DATA (fromval),
2498                         (lento > lenfrom) ? lenfrom : lento);
2499
2500           /* Check to see if we have to pad */
2501
2502           if (lento > lenfrom)
2503             {
2504               c = alloca (lento - lenfrom);
2505               memset (c, ' ', lento - lenfrom);
2506               tmp_addr = VALUE_ADDRESS (val) + lenfrom;
2507               write_memory (tmp_addr, c, lento - lenfrom);
2508             }
2509           break;
2510
2511         default:
2512           error ("Unknown lval type in f77_assign_from_literal_string");
2513         }
2514
2515       /* Now free up the transient literal string's storage. */
2516
2517       free (VALUE_LITERAL_DATA (fromval));
2518
2519       VALUE_TYPE (val) = type;
2520
2521       return val;
2522     }
2523 }
2524
2525
2526 /* The following function is called in order to assign a literal F77
2527    complex to either an internal GDB variable or to a real complex
2528    variable in the inferior.  This function is necessary because in F77,
2529    composite literals are allocated in the superior's memory space
2530    NOT the inferior's.  This function provides a way to get the F77 stuff
2531    to work without messing with the way C deals with this issue. */
2532
2533 static value_ptr
2534 f77_assign_from_literal_complex (toval, fromval)
2535      register value_ptr toval, fromval;
2536 {
2537   register struct type *type = VALUE_TYPE (toval);
2538   register value_ptr val;
2539   struct internalvar *var;
2540   float tmp_float=0;
2541   double tmp_double = 0;
2542
2543   if (VALUE_LVAL (toval) == lval_internalvar)
2544     type = VALUE_TYPE (fromval);
2545
2546   /* Allocate a value node for the result.  */
2547
2548   val = allocate_value (type);
2549
2550   if (VALUE_LVAL (toval) == lval_internalvar)
2551     {
2552       /* Internal variables are funny.  Their value information
2553          is stored in the location.internalvar sub structure.  */
2554
2555       var = VALUE_INTERNALVAR (toval);
2556
2557       /* First free up any old stuff in this internalvar. */
2558
2559       free (VALUE_LITERAL_DATA (var->value));
2560       VALUE_LITERAL_DATA (var->value) = 0;
2561       VALUE_LAZY (var->value) = 0; /* Disable lazy fetches since
2562                                       this is not located in inferior. */
2563
2564       /* Copy over the relevant value data from 'fromval'.  */
2565
2566       set_internalvar (VALUE_INTERNALVAR (toval), fromval);
2567
2568       /* Now replicate the VALUE_LITERAL_DATA field so that
2569          we may later safely de-allocate  fromval.  */
2570
2571       VALUE_LITERAL_DATA (var->value) =
2572         malloc (TYPE_LENGTH (VALUE_TYPE (fromval)));
2573
2574       memcpy ((char *) VALUE_LITERAL_DATA (var->value),
2575               (char *) VALUE_LITERAL_DATA (fromval),
2576               TYPE_LENGTH (VALUE_TYPE (fromval)));
2577
2578       /* Copy over all relevant value data from 'toval' into the
2579          structure to be returned.  */
2580
2581       memcpy (val, toval, sizeof(struct value));
2582     }
2583   else
2584     {
2585       /* We are copying memory from the local (superior) process to a
2586          legitimate address in the inferior. VALUE_ADDRESS is the
2587          address in the inferior. */
2588
2589       /* Copy over all relevant value data from 'toval'.  */
2590
2591       memcpy (val, toval, sizeof(struct value));
2592
2593       if (TYPE_LENGTH (VALUE_TYPE (fromval))
2594           > TYPE_LENGTH (VALUE_TYPE (toval)))
2595         {
2596           /* Since all literals are actually complex*16 types, deal with
2597              the case when one tries to assign a literal to a complex*8.  */
2598
2599           if ((TYPE_LENGTH(VALUE_TYPE(fromval)) == 16) &&
2600               (TYPE_LENGTH(VALUE_TYPE(toval)) == 8))
2601             {
2602               tmp_double = *((double *) VALUE_LITERAL_DATA (fromval));
2603
2604               tmp_float = (float) tmp_double;
2605
2606               write_memory (VALUE_ADDRESS(val),
2607                             (char *) &tmp_float, sizeof(float));
2608
2609               tmp_double = *((double *)
2610                              (((char *) VALUE_LITERAL_DATA (fromval))
2611                               + sizeof(double)));
2612
2613               tmp_float = (float) tmp_double;
2614
2615               write_memory(VALUE_ADDRESS(val) + sizeof(float),
2616                            (char *) &tmp_float, sizeof(float));
2617             }
2618           else
2619             error ("Cannot assign literal complex to variable!");
2620         }
2621       else
2622         {
2623           write_memory (VALUE_ADDRESS (val),
2624                         (char *) VALUE_LITERAL_DATA (fromval),
2625                         TYPE_LENGTH (VALUE_TYPE (fromval)));
2626         }
2627     }
2628
2629   /* Now free up the transient literal string's storage */
2630
2631   free (VALUE_LITERAL_DATA (fromval));
2632
2633   VALUE_TYPE (val) = type;
2634
2635   return val;
2636 }