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