gdb/guile/scm-value.c

   1 /* Scheme interface to values.
   2
   3    Copyright (C) 2008-2021 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 3 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, see <http://www.gnu.org/licenses/>.  */
  19
  20 /* See README file in this directory for implementation notes, coding
  21    conventions, et.al.  */
  22
  23 #include "defs.h"
  24 #include "arch-utils.h"
  25 #include "charset.h"
  26 #include "cp-abi.h"
  27 #include "target-float.h"
  28 #include "infcall.h"
  29 #include "symtab.h" /* Needed by language.h.  */
  30 #include "language.h"
  31 #include "valprint.h"
  32 #include "value.h"
  33 #include "guile-internal.h"
  34
  35 /* The <gdb:value> smob.  */
  36
  37 struct value_smob
  38 {
  39   /* This always appears first.  */
  40   gdb_smob base;
  41
  42   /* Doubly linked list of values in values_in_scheme.
  43      IWBN to use a chained_gdb_smob instead, which is doable, it just requires
  44      a bit more casting than normal.  */
  45   value_smob *next;
  46   value_smob *prev;
  47
  48   struct value *value;
  49
  50   /* These are cached here to avoid making multiple copies of them.
  51      Plus computing the dynamic_type can be a bit expensive.
  52      We use #f to indicate that the value doesn't exist (e.g. value doesn't
  53      have an address), so we need another value to indicate that we haven't
  54      computed the value yet.  For this we use SCM_UNDEFINED.  */
  55   SCM address;
  56   SCM type;
  57   SCM dynamic_type;
  58 };
  59
  60 static const char value_smob_name[] = "gdb:value";
  61
  62 /* The tag Guile knows the value smob by.  */
  63 static scm_t_bits value_smob_tag;
  64
  65 /* List of all values which are currently exposed to Scheme. It is
  66    maintained so that when an objfile is discarded, preserve_values
  67    can copy the values' types if needed.  */
  68 static value_smob *values_in_scheme;
  69
  70 /* Keywords used by Scheme procedures in this file.  */
  71 static SCM type_keyword;
  72 static SCM encoding_keyword;
  73 static SCM errors_keyword;
  74 static SCM length_keyword;
  75
  76 /* Possible #:errors values.  */
  77 static SCM error_symbol;
  78 static SCM escape_symbol;
  79 static SCM substitute_symbol;
  80 \f
  81 /* Administrivia for value smobs.  */
  82
  83 /* Iterate over all the <gdb:value> objects, calling preserve_one_value on
  84    each.
  85    This is the extension_language_ops.preserve_values "method".  */
  86
  87 void
  88 gdbscm_preserve_values (const struct extension_language_defn *extlang,
  89                         struct objfile *objfile, htab_t copied_types)
  90 {
  91   value_smob *iter;
  92
  93   for (iter = values_in_scheme; iter; iter = iter->next)
  94     preserve_one_value (iter->value, objfile, copied_types);
  95 }
  96
  97 /* Helper to add a value_smob to the global list.  */
  98
  99 static void
 100 vlscm_remember_scheme_value (value_smob *v_smob)
 101 {
 102   v_smob->next = values_in_scheme;
 103   if (v_smob->next)
 104     v_smob->next->prev = v_smob;
 105   v_smob->prev = NULL;
 106   values_in_scheme = v_smob;
 107 }
 108
 109 /* Helper to remove a value_smob from the global list.  */
 110
 111 static void
 112 vlscm_forget_value_smob (value_smob *v_smob)
 113 {
 114   /* Remove SELF from the global list.  */
 115   if (v_smob->prev)
 116     v_smob->prev->next = v_smob->next;
 117   else
 118     {
 119       gdb_assert (values_in_scheme == v_smob);
 120       values_in_scheme = v_smob->next;
 121     }
 122   if (v_smob->next)
 123     v_smob->next->prev = v_smob->prev;
 124 }
 125
 126 /* The smob "free" function for <gdb:value>.  */
 127
 128 static size_t
 129 vlscm_free_value_smob (SCM self)
 130 {
 131   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
 132
 133   vlscm_forget_value_smob (v_smob);
 134   value_decref (v_smob->value);
 135
 136   return 0;
 137 }
 138
 139 /* The smob "print" function for <gdb:value>.  */
 140
 141 static int
 142 vlscm_print_value_smob (SCM self, SCM port, scm_print_state *pstate)
 143 {
 144   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
 145   struct value_print_options opts;
 146
 147   if (pstate->writingp)
 148     gdbscm_printf (port, "#<%s ", value_smob_name);
 149
 150   get_user_print_options (&opts);
 151   opts.deref_ref = 0;
 152
 153   /* pstate->writingp = zero if invoked by display/~A, and nonzero if
 154      invoked by write/~S.  What to do here may need to evolve.
 155      IWBN if we could pass an argument to format that would we could use
 156      instead of writingp.  */
 157   opts.raw = !!pstate->writingp;
 158
 159   gdbscm_gdb_exception exc {};
 160   try
 161     {
 162       string_file stb;
 163
 164       common_val_print (v_smob->value, &stb, 0, &opts, current_language);
 165       scm_puts (stb.c_str (), port);
 166     }
 167   catch (const gdb_exception &except)
 168     {
 169       exc = unpack (except);
 170     }
 171
 172   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 173   if (pstate->writingp)
 174     scm_puts (">", port);
 175
 176   scm_remember_upto_here_1 (self);
 177
 178   /* Non-zero means success.  */
 179   return 1;
 180 }
 181
 182 /* The smob "equalp" function for <gdb:value>.  */
 183
 184 static SCM
 185 vlscm_equal_p_value_smob (SCM v1, SCM v2)
 186 {
 187   const value_smob *v1_smob = (value_smob *) SCM_SMOB_DATA (v1);
 188   const value_smob *v2_smob = (value_smob *) SCM_SMOB_DATA (v2);
 189   int result = 0;
 190
 191   gdbscm_gdb_exception exc {};
 192   try
 193     {
 194       result = value_equal (v1_smob->value, v2_smob->value);
 195     }
 196   catch (const gdb_exception &except)
 197     {
 198       exc = unpack (except);
 199     }
 200
 201   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 202   return scm_from_bool (result);
 203 }
 204
 205 /* Low level routine to create a <gdb:value> object.  */
 206
 207 static SCM
 208 vlscm_make_value_smob (void)
 209 {
 210   value_smob *v_smob = (value_smob *)
 211     scm_gc_malloc (sizeof (value_smob), value_smob_name);
 212   SCM v_scm;
 213
 214   /* These must be filled in by the caller.  */
 215   v_smob->value = NULL;
 216   v_smob->prev = NULL;
 217   v_smob->next = NULL;
 218
 219   /* These are lazily computed.  */
 220   v_smob->address = SCM_UNDEFINED;
 221   v_smob->type = SCM_UNDEFINED;
 222   v_smob->dynamic_type = SCM_UNDEFINED;
 223
 224   v_scm = scm_new_smob (value_smob_tag, (scm_t_bits) v_smob);
 225   gdbscm_init_gsmob (&v_smob->base);
 226
 227   return v_scm;
 228 }
 229
 230 /* Return non-zero if SCM is a <gdb:value> object.  */
 231
 232 int
 233 vlscm_is_value (SCM scm)
 234 {
 235   return SCM_SMOB_PREDICATE (value_smob_tag, scm);
 236 }
 237
 238 /* (value? object) -> boolean */
 239
 240 static SCM
 241 gdbscm_value_p (SCM scm)
 242 {
 243   return scm_from_bool (vlscm_is_value (scm));
 244 }
 245
 246 /* Create a new <gdb:value> object that encapsulates VALUE.
 247    The value is released from the all_values chain so its lifetime is not
 248    bound to the execution of a command.  */
 249
 250 SCM
 251 vlscm_scm_from_value (struct value *value)
 252 {
 253   /* N.B. It's important to not cause any side-effects until we know the
 254      conversion worked.  */
 255   SCM v_scm = vlscm_make_value_smob ();
 256   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
 257
 258   v_smob->value = release_value (value).release ();
 259   vlscm_remember_scheme_value (v_smob);
 260
 261   return v_scm;
 262 }
 263
 264 /* Create a new <gdb:value> object that encapsulates VALUE.
 265    The value is not released from the all_values chain.  */
 266
 267 SCM
 268 vlscm_scm_from_value_no_release (struct value *value)
 269 {
 270   /* N.B. It's important to not cause any side-effects until we know the
 271      conversion worked.  */
 272   SCM v_scm = vlscm_make_value_smob ();
 273   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
 274
 275   value_incref (value);
 276   v_smob->value = value;
 277   vlscm_remember_scheme_value (v_smob);
 278
 279   return v_scm;
 280 }
 281
 282 /* Returns the <gdb:value> object in SELF.
 283    Throws an exception if SELF is not a <gdb:value> object.  */
 284
 285 static SCM
 286 vlscm_get_value_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 287 {
 288   SCM_ASSERT_TYPE (vlscm_is_value (self), self, arg_pos, func_name,
 289                    value_smob_name);
 290
 291   return self;
 292 }
 293
 294 /* Returns a pointer to the value smob of SELF.
 295    Throws an exception if SELF is not a <gdb:value> object.  */
 296
 297 static value_smob *
 298 vlscm_get_value_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 299 {
 300   SCM v_scm = vlscm_get_value_arg_unsafe (self, arg_pos, func_name);
 301   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
 302
 303   return v_smob;
 304 }
 305
 306 /* Return the value field of V_SCM, an object of type <gdb:value>.
 307    This exists so that we don't have to export the struct's contents.  */
 308
 309 struct value *
 310 vlscm_scm_to_value (SCM v_scm)
 311 {
 312   value_smob *v_smob;
 313
 314   gdb_assert (vlscm_is_value (v_scm));
 315   v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
 316   return v_smob->value;
 317 }
 318 \f
 319 /* Value methods.  */
 320
 321 /* (make-value x [#:type type]) -> <gdb:value> */
 322
 323 static SCM
 324 gdbscm_make_value (SCM x, SCM rest)
 325 {
 326   const SCM keywords[] = { type_keyword, SCM_BOOL_F };
 327
 328   int type_arg_pos = -1;
 329   SCM type_scm = SCM_UNDEFINED;
 330   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", rest,
 331                               &type_arg_pos, &type_scm);
 332
 333   struct type *type = NULL;
 334   if (type_arg_pos > 0)
 335     {
 336       type_smob *t_smob = tyscm_get_type_smob_arg_unsafe (type_scm,
 337                                                           type_arg_pos,
 338                                                           FUNC_NAME);
 339       type = tyscm_type_smob_type (t_smob);
 340     }
 341
 342   return gdbscm_wrap ([=]
 343     {
 344       scoped_value_mark free_values;
 345
 346       SCM except_scm;
 347       struct value *value
 348         = vlscm_convert_typed_value_from_scheme (FUNC_NAME, SCM_ARG1, x,
 349                                                  type_arg_pos, type_scm, type,
 350                                                  &except_scm,
 351                                                  get_current_arch (),
 352                                                  current_language);
 353       if (value == NULL)
 354         return except_scm;
 355
 356       return vlscm_scm_from_value (value);
 357     });
 358 }
 359
 360 /* (make-lazy-value <gdb:type> address) -> <gdb:value> */
 361
 362 static SCM
 363 gdbscm_make_lazy_value (SCM type_scm, SCM address_scm)
 364 {
 365   type_smob *t_smob = tyscm_get_type_smob_arg_unsafe (type_scm,
 366                                                       SCM_ARG1, FUNC_NAME);
 367   struct type *type = tyscm_type_smob_type (t_smob);
 368
 369   ULONGEST address;
 370   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "U",
 371                               address_scm, &address);
 372
 373   return gdbscm_wrap ([=]
 374     {
 375       scoped_value_mark free_values;
 376
 377       struct value *value = value_from_contents_and_address (type, NULL,
 378                                                              address);
 379       return vlscm_scm_from_value (value);
 380     });
 381 }
 382
 383 /* (value-optimized-out? <gdb:value>) -> boolean */
 384
 385 static SCM
 386 gdbscm_value_optimized_out_p (SCM self)
 387 {
 388   value_smob *v_smob
 389     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 390
 391   return gdbscm_wrap ([=]
 392     {
 393       return scm_from_bool (value_optimized_out (v_smob->value));
 394     });
 395 }
 396
 397 /* (value-address <gdb:value>) -> integer
 398    Returns #f if the value doesn't have one.  */
 399
 400 static SCM
 401 gdbscm_value_address (SCM self)
 402 {
 403   value_smob *v_smob
 404     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 405   struct value *value = v_smob->value;
 406
 407   return gdbscm_wrap ([=]
 408     {
 409       if (SCM_UNBNDP (v_smob->address))
 410         {
 411           scoped_value_mark free_values;
 412
 413           SCM address = SCM_BOOL_F;
 414
 415           try
 416             {
 417               address = vlscm_scm_from_value (value_addr (value));
 418             }
 419           catch (const gdb_exception &except)
 420             {
 421             }
 422
 423           if (gdbscm_is_exception (address))
 424             return address;
 425
 426           v_smob->address = address;
 427         }
 428
 429       return v_smob->address;
 430     });
 431 }
 432
 433 /* (value-dereference <gdb:value>) -> <gdb:value>
 434    Given a value of a pointer type, apply the C unary * operator to it.  */
 435
 436 static SCM
 437 gdbscm_value_dereference (SCM self)
 438 {
 439   value_smob *v_smob
 440     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 441
 442   return gdbscm_wrap ([=]
 443     {
 444       scoped_value_mark free_values;
 445
 446       struct value *res_val = value_ind (v_smob->value);
 447       return vlscm_scm_from_value (res_val);
 448     });
 449 }
 450
 451 /* (value-referenced-value <gdb:value>) -> <gdb:value>
 452    Given a value of a reference type, return the value referenced.
 453    The difference between this function and gdbscm_value_dereference is that
 454    the latter applies * unary operator to a value, which need not always
 455    result in the value referenced.
 456    For example, for a value which is a reference to an 'int' pointer ('int *'),
 457    gdbscm_value_dereference will result in a value of type 'int' while
 458    gdbscm_value_referenced_value will result in a value of type 'int *'.  */
 459
 460 static SCM
 461 gdbscm_value_referenced_value (SCM self)
 462 {
 463   value_smob *v_smob
 464     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 465   struct value *value = v_smob->value;
 466
 467   return gdbscm_wrap ([=]
 468     {
 469       scoped_value_mark free_values;
 470
 471       struct value *res_val;
 472
 473       switch (check_typedef (value_type (value))->code ())
 474         {
 475         case TYPE_CODE_PTR:
 476           res_val = value_ind (value);
 477           break;
 478         case TYPE_CODE_REF:
 479         case TYPE_CODE_RVALUE_REF:
 480           res_val = coerce_ref (value);
 481           break;
 482         default:
 483           error (_("Trying to get the referenced value from a value which is"
 484                    " neither a pointer nor a reference"));
 485         }
 486
 487       return vlscm_scm_from_value (res_val);
 488     });
 489 }
 490
 491 static SCM
 492 gdbscm_reference_value (SCM self, enum type_code refcode)
 493 {
 494   value_smob *v_smob
 495     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 496   struct value *value = v_smob->value;
 497
 498   return gdbscm_wrap ([=]
 499     {
 500       scoped_value_mark free_values;
 501
 502       struct value *res_val = value_ref (value, refcode);
 503       return vlscm_scm_from_value (res_val);
 504     });
 505 }
 506
 507 /* (value-reference-value <gdb:value>) -> <gdb:value> */
 508
 509 static SCM
 510 gdbscm_value_reference_value (SCM self)
 511 {
 512   return gdbscm_reference_value (self, TYPE_CODE_REF);
 513 }
 514
 515 /* (value-rvalue-reference-value <gdb:value>) -> <gdb:value> */
 516
 517 static SCM
 518 gdbscm_value_rvalue_reference_value (SCM self)
 519 {
 520   return gdbscm_reference_value (self, TYPE_CODE_RVALUE_REF);
 521 }
 522
 523 /* (value-const-value <gdb:value>) -> <gdb:value> */
 524
 525 static SCM
 526 gdbscm_value_const_value (SCM self)
 527 {
 528   value_smob *v_smob
 529     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 530   struct value *value = v_smob->value;
 531
 532   return gdbscm_wrap ([=]
 533     {
 534       scoped_value_mark free_values;
 535
 536       struct value *res_val = make_cv_value (1, 0, value);
 537       return vlscm_scm_from_value (res_val);
 538     });
 539 }
 540
 541 /* (value-type <gdb:value>) -> <gdb:type> */
 542
 543 static SCM
 544 gdbscm_value_type (SCM self)
 545 {
 546   value_smob *v_smob
 547     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 548   struct value *value = v_smob->value;
 549
 550   if (SCM_UNBNDP (v_smob->type))
 551     v_smob->type = tyscm_scm_from_type (value_type (value));
 552
 553   return v_smob->type;
 554 }
 555
 556 /* (value-dynamic-type <gdb:value>) -> <gdb:type> */
 557
 558 static SCM
 559 gdbscm_value_dynamic_type (SCM self)
 560 {
 561   value_smob *v_smob
 562     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 563   struct value *value = v_smob->value;
 564   struct type *type = NULL;
 565
 566   if (! SCM_UNBNDP (v_smob->dynamic_type))
 567     return v_smob->dynamic_type;
 568
 569   gdbscm_gdb_exception exc {};
 570   try
 571     {
 572       scoped_value_mark free_values;
 573
 574       type = value_type (value);
 575       type = check_typedef (type);
 576
 577       if (((type->code () == TYPE_CODE_PTR)
 578            || (type->code () == TYPE_CODE_REF))
 579           && (TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_STRUCT))
 580         {
 581           struct value *target;
 582           int was_pointer = type->code () == TYPE_CODE_PTR;
 583
 584           if (was_pointer)
 585             target = value_ind (value);
 586           else
 587             target = coerce_ref (value);
 588           type = value_rtti_type (target, NULL, NULL, NULL);
 589
 590           if (type)
 591             {
 592               if (was_pointer)
 593                 type = lookup_pointer_type (type);
 594               else
 595                 type = lookup_lvalue_reference_type (type);
 596             }
 597         }
 598       else if (type->code () == TYPE_CODE_STRUCT)
 599         type = value_rtti_type (value, NULL, NULL, NULL);
 600       else
 601         {
 602           /* Re-use object's static type.  */
 603           type = NULL;
 604         }
 605     }
 606   catch (const gdb_exception &except)
 607     {
 608       exc = unpack (except);
 609     }
 610
 611   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 612   if (type == NULL)
 613     v_smob->dynamic_type = gdbscm_value_type (self);
 614   else
 615     v_smob->dynamic_type = tyscm_scm_from_type (type);
 616
 617   return v_smob->dynamic_type;
 618 }
 619
 620 /* A helper function that implements the various cast operators.  */
 621
 622 static SCM
 623 vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
 624                const char *func_name)
 625 {
 626   value_smob *v_smob
 627     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 628   struct value *value = v_smob->value;
 629   type_smob *t_smob
 630     = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG2, FUNC_NAME);
 631   struct type *type = tyscm_type_smob_type (t_smob);
 632
 633   return gdbscm_wrap ([=]
 634     {
 635       scoped_value_mark free_values;
 636
 637       struct value *res_val;
 638       if (op == UNOP_DYNAMIC_CAST)
 639         res_val = value_dynamic_cast (type, value);
 640       else if (op == UNOP_REINTERPRET_CAST)
 641         res_val = value_reinterpret_cast (type, value);
 642       else
 643         {
 644           gdb_assert (op == UNOP_CAST);
 645           res_val = value_cast (type, value);
 646         }
 647
 648       return vlscm_scm_from_value (res_val);
 649     });
 650 }
 651
 652 /* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
 653
 654 static SCM
 655 gdbscm_value_cast (SCM self, SCM new_type)
 656 {
 657   return vlscm_do_cast (self, new_type, UNOP_CAST, FUNC_NAME);
 658 }
 659
 660 /* (value-dynamic-cast <gdb:value> <gdb:type>) -> <gdb:value> */
 661
 662 static SCM
 663 gdbscm_value_dynamic_cast (SCM self, SCM new_type)
 664 {
 665   return vlscm_do_cast (self, new_type, UNOP_DYNAMIC_CAST, FUNC_NAME);
 666 }
 667
 668 /* (value-reinterpret-cast <gdb:value> <gdb:type>) -> <gdb:value> */
 669
 670 static SCM
 671 gdbscm_value_reinterpret_cast (SCM self, SCM new_type)
 672 {
 673   return vlscm_do_cast (self, new_type, UNOP_REINTERPRET_CAST, FUNC_NAME);
 674 }
 675
 676 /* (value-field <gdb:value> string) -> <gdb:value>
 677    Given string name of an element inside structure, return its <gdb:value>
 678    object.  */
 679
 680 static SCM
 681 gdbscm_value_field (SCM self, SCM field_scm)
 682 {
 683   value_smob *v_smob
 684     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 685
 686   SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
 687                    _("string"));
 688
 689   return gdbscm_wrap ([=]
 690     {
 691       scoped_value_mark free_values;
 692
 693       gdb::unique_xmalloc_ptr<char> field = gdbscm_scm_to_c_string (field_scm);
 694
 695       struct value *tmp = v_smob->value;
 696
 697       struct value *res_val = value_struct_elt (&tmp, {}, field.get (), NULL,
 698                                                 "struct/class/union");
 699
 700       return vlscm_scm_from_value (res_val);
 701     });
 702 }
 703
 704 /* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
 705    Return the specified value in an array.  */
 706
 707 static SCM
 708 gdbscm_value_subscript (SCM self, SCM index_scm)
 709 {
 710   value_smob *v_smob
 711     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 712   struct value *value = v_smob->value;
 713   struct type *type = value_type (value);
 714
 715   SCM_ASSERT (type != NULL, self, SCM_ARG2, FUNC_NAME);
 716
 717   return gdbscm_wrap ([=]
 718     {
 719       scoped_value_mark free_values;
 720
 721       SCM except_scm;
 722       struct value *index
 723         = vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
 724                                            &except_scm,
 725                                            type->arch (),
 726                                            current_language);
 727       if (index == NULL)
 728         return except_scm;
 729
 730       /* Assume we are attempting an array access, and let the value code
 731          throw an exception if the index has an invalid type.
 732          Check the value's type is something that can be accessed via
 733          a subscript.  */
 734       struct value *tmp = coerce_ref (value);
 735       struct type *tmp_type = check_typedef (value_type (tmp));
 736       if (tmp_type->code () != TYPE_CODE_ARRAY
 737           && tmp_type->code () != TYPE_CODE_PTR)
 738         error (_("Cannot subscript requested type"));
 739
 740       struct value *res_val = value_subscript (tmp, value_as_long (index));
 741       return vlscm_scm_from_value (res_val);
 742     });
 743 }
 744
 745 /* (value-call <gdb:value> arg-list) -> <gdb:value>
 746    Perform an inferior function call on the value.  */
 747
 748 static SCM
 749 gdbscm_value_call (SCM self, SCM args)
 750 {
 751   value_smob *v_smob
 752     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 753   struct value *function = v_smob->value;
 754   struct type *ftype = NULL;
 755   long args_count;
 756   struct value **vargs = NULL;
 757
 758   gdbscm_gdb_exception exc {};
 759   try
 760     {
 761       ftype = check_typedef (value_type (function));
 762     }
 763   catch (const gdb_exception &except)
 764     {
 765       exc = unpack (except);
 766     }
 767
 768   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 769   SCM_ASSERT_TYPE (ftype->code () == TYPE_CODE_FUNC, self,
 770                    SCM_ARG1, FUNC_NAME,
 771                    _("function (value of TYPE_CODE_FUNC)"));
 772
 773   SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (args)), args,
 774                    SCM_ARG2, FUNC_NAME, _("list"));
 775
 776   args_count = scm_ilength (args);
 777   if (args_count > 0)
 778     {
 779       struct gdbarch *gdbarch = get_current_arch ();
 780       const struct language_defn *language = current_language;
 781       SCM except_scm;
 782       long i;
 783
 784       vargs = XALLOCAVEC (struct value *, args_count);
 785       for (i = 0; i < args_count; i++)
 786         {
 787           SCM arg = scm_car (args);
 788
 789           vargs[i] = vlscm_convert_value_from_scheme (FUNC_NAME,
 790                                                       GDBSCM_ARG_NONE, arg,
 791                                                       &except_scm,
 792                                                       gdbarch, language);
 793           if (vargs[i] == NULL)
 794             gdbscm_throw (except_scm);
 795
 796           args = scm_cdr (args);
 797         }
 798       gdb_assert (gdbscm_is_true (scm_null_p (args)));
 799     }
 800
 801   return gdbscm_wrap ([=]
 802     {
 803       scoped_value_mark free_values;
 804
 805       auto av = gdb::make_array_view (vargs, args_count);
 806       value *return_value = call_function_by_hand (function, NULL, av);
 807       return vlscm_scm_from_value (return_value);
 808     });
 809 }
 810
 811 /* (value->bytevector <gdb:value>) -> bytevector */
 812
 813 static SCM
 814 gdbscm_value_to_bytevector (SCM self)
 815 {
 816   value_smob *v_smob
 817     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 818   struct value *value = v_smob->value;
 819   struct type *type;
 820   size_t length = 0;
 821   const gdb_byte *contents = NULL;
 822   SCM bv;
 823
 824   type = value_type (value);
 825
 826   gdbscm_gdb_exception exc {};
 827   try
 828     {
 829       type = check_typedef (type);
 830       length = TYPE_LENGTH (type);
 831       contents = value_contents (value);
 832     }
 833   catch (const gdb_exception &except)
 834     {
 835       exc = unpack (except);
 836     }
 837
 838   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 839   bv = scm_c_make_bytevector (length);
 840   memcpy (SCM_BYTEVECTOR_CONTENTS (bv), contents, length);
 841
 842   return bv;
 843 }
 844
 845 /* Helper function to determine if a type is "int-like".  */
 846
 847 static int
 848 is_intlike (struct type *type, int ptr_ok)
 849 {
 850   return (type->code () == TYPE_CODE_INT
 851           || type->code () == TYPE_CODE_ENUM
 852           || type->code () == TYPE_CODE_BOOL
 853           || type->code () == TYPE_CODE_CHAR
 854           || (ptr_ok && type->code () == TYPE_CODE_PTR));
 855 }
 856
 857 /* (value->bool <gdb:value>) -> boolean
 858    Throws an error if the value is not integer-like.  */
 859
 860 static SCM
 861 gdbscm_value_to_bool (SCM self)
 862 {
 863   value_smob *v_smob
 864     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 865   struct value *value = v_smob->value;
 866   struct type *type;
 867   LONGEST l = 0;
 868
 869   type = value_type (value);
 870
 871   gdbscm_gdb_exception exc {};
 872   try
 873     {
 874       type = check_typedef (type);
 875     }
 876   catch (const gdb_exception &except)
 877     {
 878       exc = unpack (except);
 879     }
 880
 881   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 882   SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
 883                    _("integer-like gdb value"));
 884
 885   try
 886     {
 887       if (type->code () == TYPE_CODE_PTR)
 888         l = value_as_address (value);
 889       else
 890         l = value_as_long (value);
 891     }
 892   catch (const gdb_exception &except)
 893     {
 894       exc = unpack (except);
 895     }
 896
 897   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 898   return scm_from_bool (l != 0);
 899 }
 900
 901 /* (value->integer <gdb:value>) -> integer
 902    Throws an error if the value is not integer-like.  */
 903
 904 static SCM
 905 gdbscm_value_to_integer (SCM self)
 906 {
 907   value_smob *v_smob
 908     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 909   struct value *value = v_smob->value;
 910   struct type *type;
 911   LONGEST l = 0;
 912
 913   type = value_type (value);
 914
 915   gdbscm_gdb_exception exc {};
 916   try
 917     {
 918       type = check_typedef (type);
 919     }
 920   catch (const gdb_exception &except)
 921     {
 922       exc = unpack (except);
 923     }
 924
 925   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 926   SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
 927                    _("integer-like gdb value"));
 928
 929   try
 930     {
 931       if (type->code () == TYPE_CODE_PTR)
 932         l = value_as_address (value);
 933       else
 934         l = value_as_long (value);
 935     }
 936   catch (const gdb_exception &except)
 937     {
 938       exc = unpack (except);
 939     }
 940
 941   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 942   if (type->is_unsigned ())
 943     return gdbscm_scm_from_ulongest (l);
 944   else
 945     return gdbscm_scm_from_longest (l);
 946 }
 947
 948 /* (value->real <gdb:value>) -> real
 949    Throws an error if the value is not a number.  */
 950
 951 static SCM
 952 gdbscm_value_to_real (SCM self)
 953 {
 954   value_smob *v_smob
 955     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 956   struct value *value = v_smob->value;
 957   struct type *type;
 958   double d = 0;
 959   struct value *check = nullptr;
 960
 961   type = value_type (value);
 962
 963   gdbscm_gdb_exception exc {};
 964   try
 965     {
 966       type = check_typedef (type);
 967     }
 968   catch (const gdb_exception &except)
 969     {
 970       exc = unpack (except);
 971     }
 972
 973   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 974   SCM_ASSERT_TYPE (is_intlike (type, 0) || type->code () == TYPE_CODE_FLT,
 975                    self, SCM_ARG1, FUNC_NAME, _("number"));
 976
 977   try
 978     {
 979       if (is_floating_value (value))
 980         {
 981           d = target_float_to_host_double (value_contents (value), type);
 982           check = value_from_host_double (type, d);
 983         }
 984       else if (type->is_unsigned ())
 985         {
 986           d = (ULONGEST) value_as_long (value);
 987           check = value_from_ulongest (type, (ULONGEST) d);
 988         }
 989       else
 990         {
 991           d = value_as_long (value);
 992           check = value_from_longest (type, (LONGEST) d);
 993         }
 994     }
 995   catch (const gdb_exception &except)
 996     {
 997       exc = unpack (except);
 998     }
 999
1000   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
1001   /* TODO: Is there a better way to check if the value fits?  */
1002   if (!value_equal (value, check))
1003     gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
1004                                _("number can't be converted to a double"));
1005
1006   return scm_from_double (d);
1007 }
1008
1009 /* (value->string <gdb:value>
1010        [#:encoding encoding]
1011        [#:errors #f | 'error | 'substitute]
1012        [#:length length])
1013      -> string
1014    Return Unicode string with value's contents, which must be a string.
1015
1016    If ENCODING is not given, the string is assumed to be encoded in
1017    the target's charset.
1018
1019    ERRORS is one of #f, 'error or 'substitute.
1020    An error setting of #f means use the default, which is Guile's
1021    %default-port-conversion-strategy when using Guile >= 2.0.6, or 'error if
1022    using an earlier version of Guile.  Earlier versions do not properly
1023    support obtaining the default port conversion strategy.
1024    If the default is not one of 'error or 'substitute, 'substitute is used.
1025    An error setting of "error" causes an exception to be thrown if there's
1026    a decoding error.  An error setting of "substitute" causes invalid
1027    characters to be replaced with "?".
1028
1029    If LENGTH is provided, only fetch string to the length provided.
1030    LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */
1031
1032 static SCM
1033 gdbscm_value_to_string (SCM self, SCM rest)
1034 {
1035   value_smob *v_smob
1036     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1037   struct value *value = v_smob->value;
1038   const SCM keywords[] = {
1039     encoding_keyword, errors_keyword, length_keyword, SCM_BOOL_F
1040   };
1041   int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
1042   char *encoding = NULL;
1043   SCM errors = SCM_BOOL_F;
1044   /* Avoid an uninitialized warning from gcc.  */
1045   gdb_byte *buffer_contents = nullptr;
1046   int length = -1;
1047   const char *la_encoding = NULL;
1048   struct type *char_type = NULL;
1049   SCM result;
1050
1051   /* The sequencing here, as everywhere else, is important.
1052      We can't have existing cleanups when a Scheme exception is thrown.  */
1053
1054   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#sOi", rest,
1055                               &encoding_arg_pos, &encoding,
1056                               &errors_arg_pos, &errors,
1057                               &length_arg_pos, &length);
1058
1059   if (errors_arg_pos > 0
1060       && errors != SCM_BOOL_F
1061       && !scm_is_eq (errors, error_symbol)
1062       && !scm_is_eq (errors, substitute_symbol))
1063     {
1064       SCM excp
1065         = gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
1066                                           _("invalid error kind"));
1067
1068       xfree (encoding);
1069       gdbscm_throw (excp);
1070     }
1071   if (errors == SCM_BOOL_F)
1072     {
1073       /* N.B. scm_port_conversion_strategy in Guile versions prior to 2.0.6
1074          will throw a Scheme error when passed #f.  */
1075       if (gdbscm_guile_version_is_at_least (2, 0, 6))
1076         errors = scm_port_conversion_strategy (SCM_BOOL_F);
1077       else
1078         errors = error_symbol;
1079     }
1080   /* We don't assume anything about the result of scm_port_conversion_strategy.
1081      From this point on, if errors is not 'errors, use 'substitute.  */
1082
1083   gdbscm_gdb_exception exc {};
1084   try
1085     {
1086       gdb::unique_xmalloc_ptr<gdb_byte> buffer;
1087       c_get_string (value, &buffer, &length, &char_type, &la_encoding);
1088       buffer_contents = buffer.release ();
1089     }
1090   catch (const gdb_exception &except)
1091     {
1092       xfree (encoding);
1093       exc = unpack (except);
1094     }
1095   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
1096
1097   /* If errors is "error", scm_from_stringn may throw a Scheme exception.
1098      Make sure we don't leak.  This is done via scm_dynwind_begin, et.al.  */
1099
1100   scm_dynwind_begin ((scm_t_dynwind_flags) 0);
1101
1102   gdbscm_dynwind_xfree (encoding);
1103   gdbscm_dynwind_xfree (buffer_contents);
1104
1105   result = scm_from_stringn ((const char *) buffer_contents,
1106                              length * TYPE_LENGTH (char_type),
1107                              (encoding != NULL && *encoding != '\0'
1108                               ? encoding
1109                               : la_encoding),
1110                              scm_is_eq (errors, error_symbol)
1111                              ? SCM_FAILED_CONVERSION_ERROR
1112                              : SCM_FAILED_CONVERSION_QUESTION_MARK);
1113
1114   scm_dynwind_end ();
1115
1116   return result;
1117 }
1118
1119 /* (value->lazy-string <gdb:value> [#:encoding encoding] [#:length length])
1120      -> <gdb:lazy-string>
1121    Return a Scheme object representing a lazy_string_object type.
1122    A lazy string is a pointer to a string with an optional encoding and length.
1123    If ENCODING is not given, the target's charset is used.
1124    If LENGTH is provided then the length parameter is set to LENGTH.
1125    Otherwise if the value is an array of known length then the array's length
1126    is used.  Otherwise the length will be set to -1 (meaning first null of
1127    appropriate with).
1128    LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */
1129
1130 static SCM
1131 gdbscm_value_to_lazy_string (SCM self, SCM rest)
1132 {
1133   value_smob *v_smob
1134     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1135   struct value *value = v_smob->value;
1136   const SCM keywords[] = { encoding_keyword, length_keyword, SCM_BOOL_F };
1137   int encoding_arg_pos = -1, length_arg_pos = -1;
1138   char *encoding = NULL;
1139   int length = -1;
1140   SCM result = SCM_BOOL_F; /* -Wall */
1141   gdbscm_gdb_exception except {};
1142
1143   /* The sequencing here, as everywhere else, is important.
1144      We can't have existing cleanups when a Scheme exception is thrown.  */
1145
1146   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#si", rest,
1147                               &encoding_arg_pos, &encoding,
1148                               &length_arg_pos, &length);
1149
1150   if (length < -1)
1151     {
1152       gdbscm_out_of_range_error (FUNC_NAME, length_arg_pos,
1153                                  scm_from_int (length),
1154                                  _("invalid length"));
1155     }
1156
1157   try
1158     {
1159       scoped_value_mark free_values;
1160
1161       struct type *type, *realtype;
1162       CORE_ADDR addr;
1163
1164       type = value_type (value);
1165       realtype = check_typedef (type);
1166
1167       switch (realtype->code ())
1168         {
1169         case TYPE_CODE_ARRAY:
1170           {
1171             LONGEST array_length = -1;
1172             LONGEST low_bound, high_bound;
1173
1174             /* PR 20786: There's no way to specify an array of length zero.
1175                Record a length of [0,-1] which is how Ada does it.  Anything
1176                we do is broken, but this one possible solution.  */
1177             if (get_array_bounds (realtype, &low_bound, &high_bound))
1178               array_length = high_bound - low_bound + 1;
1179             if (length == -1)
1180               length = array_length;
1181             else if (array_length == -1)
1182               {
1183                 type = lookup_array_range_type (TYPE_TARGET_TYPE (realtype),
1184                                                 0, length - 1);
1185               }
1186             else if (length != array_length)
1187               {
1188                 /* We need to create a new array type with the
1189                    specified length.  */
1190                 if (length > array_length)
1191                   error (_("length is larger than array size"));
1192                 type = lookup_array_range_type (TYPE_TARGET_TYPE (type),
1193                                                 low_bound,
1194                                                 low_bound + length - 1);
1195               }
1196             addr = value_address (value);
1197             break;
1198           }
1199         case TYPE_CODE_PTR:
1200           /* If a length is specified we defer creating an array of the
1201              specified width until we need to.  */
1202           addr = value_as_address (value);
1203           break;
1204         default:
1205           /* Should flag an error here.  PR 20769.  */
1206           addr = value_address (value);
1207           break;
1208         }
1209
1210       result = lsscm_make_lazy_string (addr, length, encoding, type);
1211     }
1212   catch (const gdb_exception &ex)
1213     {
1214       except = unpack (ex);
1215     }
1216
1217   xfree (encoding);
1218   GDBSCM_HANDLE_GDB_EXCEPTION (except);
1219
1220   if (gdbscm_is_exception (result))
1221     gdbscm_throw (result);
1222
1223   return result;
1224 }
1225
1226 /* (value-lazy? <gdb:value>) -> boolean */
1227
1228 static SCM
1229 gdbscm_value_lazy_p (SCM self)
1230 {
1231   value_smob *v_smob
1232     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1233   struct value *value = v_smob->value;
1234
1235   return scm_from_bool (value_lazy (value));
1236 }
1237
1238 /* (value-fetch-lazy! <gdb:value>) -> unspecified */
1239
1240 static SCM
1241 gdbscm_value_fetch_lazy_x (SCM self)
1242 {
1243   value_smob *v_smob
1244     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1245   struct value *value = v_smob->value;
1246
1247   return gdbscm_wrap ([=]
1248     {
1249       if (value_lazy (value))
1250         value_fetch_lazy (value);
1251       return SCM_UNSPECIFIED;
1252     });
1253 }
1254
1255 /* (value-print <gdb:value>) -> string */
1256
1257 static SCM
1258 gdbscm_value_print (SCM self)
1259 {
1260   value_smob *v_smob
1261     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1262   struct value *value = v_smob->value;
1263   struct value_print_options opts;
1264
1265   get_user_print_options (&opts);
1266   opts.deref_ref = 0;
1267
1268   string_file stb;
1269
1270   gdbscm_gdb_exception exc {};
1271   try
1272     {
1273       common_val_print (value, &stb, 0, &opts, current_language);
1274     }
1275   catch (const gdb_exception &except)
1276     {
1277       exc = unpack (except);
1278     }
1279
1280   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
1281   /* Use SCM_FAILED_CONVERSION_QUESTION_MARK to ensure this doesn't
1282      throw an error if the encoding fails.
1283      IWBN to use scm_take_locale_string here, but we'd have to temporarily
1284      override the default port conversion handler because contrary to
1285      documentation it doesn't necessarily free the input string.  */
1286   return scm_from_stringn (stb.c_str (), stb.size (), host_charset (),
1287                            SCM_FAILED_CONVERSION_QUESTION_MARK);
1288 }
1289 \f
1290 /* (parse-and-eval string) -> <gdb:value>
1291    Parse a string and evaluate the string as an expression.  */
1292
1293 static SCM
1294 gdbscm_parse_and_eval (SCM expr_scm)
1295 {
1296   char *expr_str;
1297   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
1298                               expr_scm, &expr_str);
1299
1300   return gdbscm_wrap ([=]
1301     {
1302       scoped_value_mark free_values;
1303       return vlscm_scm_from_value (parse_and_eval (expr_str));
1304     });
1305 }
1306
1307 /* (history-ref integer) -> <gdb:value>
1308    Return the specified value from GDB's value history.  */
1309
1310 static SCM
1311 gdbscm_history_ref (SCM index)
1312 {
1313   int i;
1314   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
1315
1316   return gdbscm_wrap ([=]
1317     {
1318       return vlscm_scm_from_value (access_value_history (i));
1319     });
1320 }
1321
1322 /* (history-append! <gdb:value>) -> index
1323    Append VALUE to GDB's value history.  Return its index in the history.  */
1324
1325 static SCM
1326 gdbscm_history_append_x (SCM value)
1327 {
1328   value_smob *v_smob
1329     = vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
1330   return gdbscm_wrap ([=]
1331     {
1332       return scm_from_int (record_latest_value (v_smob->value));
1333     });
1334 }
1335 \f
1336 /* Initialize the Scheme value code.  */
1337
1338 static const scheme_function value_functions[] =
1339 {
1340   { "value?", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_p),
1341     "\
1342 Return #t if the object is a <gdb:value> object." },
1343
1344   { "make-value", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_value),
1345     "\
1346 Create a <gdb:value> representing object.\n\
1347 Typically this is used to convert numbers and strings to\n\
1348 <gdb:value> objects.\n\
1349 \n\
1350   Arguments: object [#:type <gdb:type>]" },
1351
1352   { "value-optimized-out?", 1, 0, 0,
1353     as_a_scm_t_subr (gdbscm_value_optimized_out_p),
1354     "\
1355 Return #t if the value has been optimizd out." },
1356
1357   { "value-address", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_address),
1358     "\
1359 Return the address of the value." },
1360
1361   { "value-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_type),
1362     "\
1363 Return the type of the value." },
1364
1365   { "value-dynamic-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_dynamic_type),
1366     "\
1367 Return the dynamic type of the value." },
1368
1369   { "value-cast", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_cast),
1370     "\
1371 Cast the value to the supplied type.\n\
1372 \n\
1373   Arguments: <gdb:value> <gdb:type>" },
1374
1375   { "value-dynamic-cast", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_dynamic_cast),
1376     "\
1377 Cast the value to the supplied type, as if by the C++\n\
1378 dynamic_cast operator.\n\
1379 \n\
1380   Arguments: <gdb:value> <gdb:type>" },
1381
1382   { "value-reinterpret-cast", 2, 0, 0,
1383     as_a_scm_t_subr (gdbscm_value_reinterpret_cast),
1384     "\
1385 Cast the value to the supplied type, as if by the C++\n\
1386 reinterpret_cast operator.\n\
1387 \n\
1388   Arguments: <gdb:value> <gdb:type>" },
1389
1390   { "value-dereference", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_dereference),
1391     "\
1392 Return the result of applying the C unary * operator to the value." },
1393
1394   { "value-referenced-value", 1, 0, 0,
1395     as_a_scm_t_subr (gdbscm_value_referenced_value),
1396     "\
1397 Given a value of a reference type, return the value referenced.\n\
1398 The difference between this function and value-dereference is that\n\
1399 the latter applies * unary operator to a value, which need not always\n\
1400 result in the value referenced.\n\
1401 For example, for a value which is a reference to an 'int' pointer ('int *'),\n\
1402 value-dereference will result in a value of type 'int' while\n\
1403 value-referenced-value will result in a value of type 'int *'." },
1404
1405   { "value-reference-value", 1, 0, 0,
1406     as_a_scm_t_subr (gdbscm_value_reference_value),
1407     "\
1408 Return a <gdb:value> object which is a reference to the given value." },
1409
1410   { "value-rvalue-reference-value", 1, 0, 0,
1411     as_a_scm_t_subr (gdbscm_value_rvalue_reference_value),
1412     "\
1413 Return a <gdb:value> object which is an rvalue reference to the given value." },
1414
1415   { "value-const-value", 1, 0, 0,
1416     as_a_scm_t_subr (gdbscm_value_const_value),
1417     "\
1418 Return a <gdb:value> object which is a 'const' version of the given value." },
1419
1420   { "value-field", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_field),
1421     "\
1422 Return the specified field of the value.\n\
1423 \n\
1424   Arguments: <gdb:value> string" },
1425
1426   { "value-subscript", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_subscript),
1427     "\
1428 Return the value of the array at the specified index.\n\
1429 \n\
1430   Arguments: <gdb:value> integer" },
1431
1432   { "value-call", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_call),
1433     "\
1434 Perform an inferior function call taking the value as a pointer to the\n\
1435 function to call.\n\
1436 Each element of the argument list must be a <gdb:value> object or an object\n\
1437 that can be converted to one.\n\
1438 The result is the value returned by the function.\n\
1439 \n\
1440   Arguments: <gdb:value> arg-list" },
1441
1442   { "value->bool", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_bool),
1443     "\
1444 Return the Scheme boolean representing the GDB value.\n\
1445 The value must be \"integer like\".  Pointers are ok." },
1446
1447   { "value->integer", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_integer),
1448     "\
1449 Return the Scheme integer representing the GDB value.\n\
1450 The value must be \"integer like\".  Pointers are ok." },
1451
1452   { "value->real", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_real),
1453     "\
1454 Return the Scheme real number representing the GDB value.\n\
1455 The value must be a number." },
1456
1457   { "value->bytevector", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_bytevector),
1458     "\
1459 Return a Scheme bytevector with the raw contents of the GDB value.\n\
1460 No transformation, endian or otherwise, is performed." },
1461
1462   { "value->string", 1, 0, 1, as_a_scm_t_subr (gdbscm_value_to_string),
1463     "\
1464 Return the Unicode string of the value's contents.\n\
1465 If ENCODING is not given, the string is assumed to be encoded in\n\
1466 the target's charset.\n\
1467 An error setting \"error\" causes an exception to be thrown if there's\n\
1468 a decoding error.  An error setting of \"substitute\" causes invalid\n\
1469 characters to be replaced with \"?\".  The default is \"error\".\n\
1470 If LENGTH is provided, only fetch string to the length provided.\n\
1471 \n\
1472   Arguments: <gdb:value>\n\
1473              [#:encoding encoding] [#:errors \"error\"|\"substitute\"]\n\
1474              [#:length length]" },
1475
1476   { "value->lazy-string", 1, 0, 1,
1477     as_a_scm_t_subr (gdbscm_value_to_lazy_string),
1478     "\
1479 Return a Scheme object representing a lazily fetched Unicode string\n\
1480 of the value's contents.\n\
1481 If ENCODING is not given, the string is assumed to be encoded in\n\
1482 the target's charset.\n\
1483 If LENGTH is provided, only fetch string to the length provided.\n\
1484 \n\
1485   Arguments: <gdb:value> [#:encoding encoding] [#:length length]" },
1486
1487   { "value-lazy?", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_lazy_p),
1488     "\
1489 Return #t if the value is lazy (not fetched yet from the inferior).\n\
1490 A lazy value is fetched when needed, or when the value-fetch-lazy! function\n\
1491 is called." },
1492
1493   { "make-lazy-value", 2, 0, 0, as_a_scm_t_subr (gdbscm_make_lazy_value),
1494     "\
1495 Create a <gdb:value> that will be lazily fetched from the target.\n\
1496 \n\
1497   Arguments: <gdb:type> address" },
1498
1499   { "value-fetch-lazy!", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_fetch_lazy_x),
1500     "\
1501 Fetch the value from the inferior, if it was lazy.\n\
1502 The result is \"unspecified\"." },
1503
1504   { "value-print", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_print),
1505     "\
1506 Return the string representation (print form) of the value." },
1507
1508   { "parse-and-eval", 1, 0, 0, as_a_scm_t_subr (gdbscm_parse_and_eval),
1509     "\
1510 Evaluates string in gdb and returns the result as a <gdb:value> object." },
1511
1512   { "history-ref", 1, 0, 0, as_a_scm_t_subr (gdbscm_history_ref),
1513     "\
1514 Return the specified value from GDB's value history." },
1515
1516   { "history-append!", 1, 0, 0, as_a_scm_t_subr (gdbscm_history_append_x),
1517     "\
1518 Append the specified value onto GDB's value history." },
1519
1520   END_FUNCTIONS
1521 };
1522
1523 void
1524 gdbscm_initialize_values (void)
1525 {
1526   value_smob_tag = gdbscm_make_smob_type (value_smob_name,
1527                                           sizeof (value_smob));
1528   scm_set_smob_free (value_smob_tag, vlscm_free_value_smob);
1529   scm_set_smob_print (value_smob_tag, vlscm_print_value_smob);
1530   scm_set_smob_equalp (value_smob_tag, vlscm_equal_p_value_smob);
1531
1532   gdbscm_define_functions (value_functions, 1);
1533
1534   type_keyword = scm_from_latin1_keyword ("type");
1535   encoding_keyword = scm_from_latin1_keyword ("encoding");
1536   errors_keyword = scm_from_latin1_keyword ("errors");
1537   length_keyword = scm_from_latin1_keyword ("length");
1538
1539   error_symbol = scm_from_latin1_symbol ("error");
1540   escape_symbol = scm_from_latin1_symbol ("escape");
1541   substitute_symbol = scm_from_latin1_symbol ("substitute");
1542 }