gdb/guile/scm-value.c

   1 /* Scheme interface to values.
   2
   3    Copyright (C) 2008-2022 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 ()->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 ();
 831       contents = value_contents (value).data ();
 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).data (),
 982                                            type);
 983           check = value_from_host_double (type, d);
 984         }
 985       else if (type->is_unsigned ())
 986         {
 987           d = (ULONGEST) value_as_long (value);
 988           check = value_from_ulongest (type, (ULONGEST) d);
 989         }
 990       else
 991         {
 992           d = value_as_long (value);
 993           check = value_from_longest (type, (LONGEST) d);
 994         }
 995     }
 996   catch (const gdb_exception &except)
 997     {
 998       exc = unpack (except);
 999     }
1000
1001   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
1002   /* TODO: Is there a better way to check if the value fits?  */
1003   if (!value_equal (value, check))
1004     gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
1005                                _("number can't be converted to a double"));
1006
1007   return scm_from_double (d);
1008 }
1009
1010 /* (value->string <gdb:value>
1011        [#:encoding encoding]
1012        [#:errors #f | 'error | 'substitute]
1013        [#:length length])
1014      -> string
1015    Return Unicode string with value's contents, which must be a string.
1016
1017    If ENCODING is not given, the string is assumed to be encoded in
1018    the target's charset.
1019
1020    ERRORS is one of #f, 'error or 'substitute.
1021    An error setting of #f means use the default, which is Guile's
1022    %default-port-conversion-strategy when using Guile >= 2.0.6, or 'error if
1023    using an earlier version of Guile.  Earlier versions do not properly
1024    support obtaining the default port conversion strategy.
1025    If the default is not one of 'error or 'substitute, 'substitute is used.
1026    An error setting of "error" causes an exception to be thrown if there's
1027    a decoding error.  An error setting of "substitute" causes invalid
1028    characters to be replaced with "?".
1029
1030    If LENGTH is provided, only fetch string to the length provided.
1031    LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */
1032
1033 static SCM
1034 gdbscm_value_to_string (SCM self, SCM rest)
1035 {
1036   value_smob *v_smob
1037     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1038   struct value *value = v_smob->value;
1039   const SCM keywords[] = {
1040     encoding_keyword, errors_keyword, length_keyword, SCM_BOOL_F
1041   };
1042   int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
1043   char *encoding = NULL;
1044   SCM errors = SCM_BOOL_F;
1045   /* Avoid an uninitialized warning from gcc.  */
1046   gdb_byte *buffer_contents = nullptr;
1047   int length = -1;
1048   const char *la_encoding = NULL;
1049   struct type *char_type = NULL;
1050   SCM result;
1051
1052   /* The sequencing here, as everywhere else, is important.
1053      We can't have existing cleanups when a Scheme exception is thrown.  */
1054
1055   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#sOi", rest,
1056                               &encoding_arg_pos, &encoding,
1057                               &errors_arg_pos, &errors,
1058                               &length_arg_pos, &length);
1059
1060   if (errors_arg_pos > 0
1061       && errors != SCM_BOOL_F
1062       && !scm_is_eq (errors, error_symbol)
1063       && !scm_is_eq (errors, substitute_symbol))
1064     {
1065       SCM excp
1066         = gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
1067                                           _("invalid error kind"));
1068
1069       xfree (encoding);
1070       gdbscm_throw (excp);
1071     }
1072   if (errors == SCM_BOOL_F)
1073     {
1074       /* N.B. scm_port_conversion_strategy in Guile versions prior to 2.0.6
1075          will throw a Scheme error when passed #f.  */
1076       if (gdbscm_guile_version_is_at_least (2, 0, 6))
1077         errors = scm_port_conversion_strategy (SCM_BOOL_F);
1078       else
1079         errors = error_symbol;
1080     }
1081   /* We don't assume anything about the result of scm_port_conversion_strategy.
1082      From this point on, if errors is not 'errors, use 'substitute.  */
1083
1084   gdbscm_gdb_exception exc {};
1085   try
1086     {
1087       gdb::unique_xmalloc_ptr<gdb_byte> buffer;
1088       c_get_string (value, &buffer, &length, &char_type, &la_encoding);
1089       buffer_contents = buffer.release ();
1090     }
1091   catch (const gdb_exception &except)
1092     {
1093       xfree (encoding);
1094       exc = unpack (except);
1095     }
1096   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
1097
1098   /* If errors is "error", scm_from_stringn may throw a Scheme exception.
1099      Make sure we don't leak.  This is done via scm_dynwind_begin, et.al.  */
1100
1101   scm_dynwind_begin ((scm_t_dynwind_flags) 0);
1102
1103   gdbscm_dynwind_xfree (encoding);
1104   gdbscm_dynwind_xfree (buffer_contents);
1105
1106   result = scm_from_stringn ((const char *) buffer_contents,
1107                              length * char_type->length (),
1108                              (encoding != NULL && *encoding != '\0'
1109                               ? encoding
1110                               : la_encoding),
1111                              scm_is_eq (errors, error_symbol)
1112                              ? SCM_FAILED_CONVERSION_ERROR
1113                              : SCM_FAILED_CONVERSION_QUESTION_MARK);
1114
1115   scm_dynwind_end ();
1116
1117   return result;
1118 }
1119
1120 /* (value->lazy-string <gdb:value> [#:encoding encoding] [#:length length])
1121      -> <gdb:lazy-string>
1122    Return a Scheme object representing a lazy_string_object type.
1123    A lazy string is a pointer to a string with an optional encoding and length.
1124    If ENCODING is not given, the target's charset is used.
1125    If LENGTH is provided then the length parameter is set to LENGTH.
1126    Otherwise if the value is an array of known length then the array's length
1127    is used.  Otherwise the length will be set to -1 (meaning first null of
1128    appropriate with).
1129    LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */
1130
1131 static SCM
1132 gdbscm_value_to_lazy_string (SCM self, SCM rest)
1133 {
1134   value_smob *v_smob
1135     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1136   struct value *value = v_smob->value;
1137   const SCM keywords[] = { encoding_keyword, length_keyword, SCM_BOOL_F };
1138   int encoding_arg_pos = -1, length_arg_pos = -1;
1139   char *encoding = NULL;
1140   int length = -1;
1141   SCM result = SCM_BOOL_F; /* -Wall */
1142   gdbscm_gdb_exception except {};
1143
1144   /* The sequencing here, as everywhere else, is important.
1145      We can't have existing cleanups when a Scheme exception is thrown.  */
1146
1147   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#si", rest,
1148                               &encoding_arg_pos, &encoding,
1149                               &length_arg_pos, &length);
1150
1151   if (length < -1)
1152     {
1153       gdbscm_out_of_range_error (FUNC_NAME, length_arg_pos,
1154                                  scm_from_int (length),
1155                                  _("invalid length"));
1156     }
1157
1158   try
1159     {
1160       scoped_value_mark free_values;
1161
1162       struct type *type, *realtype;
1163       CORE_ADDR addr;
1164
1165       type = value_type (value);
1166       realtype = check_typedef (type);
1167
1168       switch (realtype->code ())
1169         {
1170         case TYPE_CODE_ARRAY:
1171           {
1172             LONGEST array_length = -1;
1173             LONGEST low_bound, high_bound;
1174
1175             /* PR 20786: There's no way to specify an array of length zero.
1176                Record a length of [0,-1] which is how Ada does it.  Anything
1177                we do is broken, but this one possible solution.  */
1178             if (get_array_bounds (realtype, &low_bound, &high_bound))
1179               array_length = high_bound - low_bound + 1;
1180             if (length == -1)
1181               length = array_length;
1182             else if (array_length == -1)
1183               {
1184                 type = lookup_array_range_type (realtype->target_type (),
1185                                                 0, length - 1);
1186               }
1187             else if (length != array_length)
1188               {
1189                 /* We need to create a new array type with the
1190                    specified length.  */
1191                 if (length > array_length)
1192                   error (_("length is larger than array size"));
1193                 type = lookup_array_range_type (type->target_type (),
1194                                                 low_bound,
1195                                                 low_bound + length - 1);
1196               }
1197             addr = value_address (value);
1198             break;
1199           }
1200         case TYPE_CODE_PTR:
1201           /* If a length is specified we defer creating an array of the
1202              specified width until we need to.  */
1203           addr = value_as_address (value);
1204           break;
1205         default:
1206           /* Should flag an error here.  PR 20769.  */
1207           addr = value_address (value);
1208           break;
1209         }
1210
1211       result = lsscm_make_lazy_string (addr, length, encoding, type);
1212     }
1213   catch (const gdb_exception &ex)
1214     {
1215       except = unpack (ex);
1216     }
1217
1218   xfree (encoding);
1219   GDBSCM_HANDLE_GDB_EXCEPTION (except);
1220
1221   if (gdbscm_is_exception (result))
1222     gdbscm_throw (result);
1223
1224   return result;
1225 }
1226
1227 /* (value-lazy? <gdb:value>) -> boolean */
1228
1229 static SCM
1230 gdbscm_value_lazy_p (SCM self)
1231 {
1232   value_smob *v_smob
1233     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1234   struct value *value = v_smob->value;
1235
1236   return scm_from_bool (value_lazy (value));
1237 }
1238
1239 /* (value-fetch-lazy! <gdb:value>) -> unspecified */
1240
1241 static SCM
1242 gdbscm_value_fetch_lazy_x (SCM self)
1243 {
1244   value_smob *v_smob
1245     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1246   struct value *value = v_smob->value;
1247
1248   return gdbscm_wrap ([=]
1249     {
1250       if (value_lazy (value))
1251         value_fetch_lazy (value);
1252       return SCM_UNSPECIFIED;
1253     });
1254 }
1255
1256 /* (value-print <gdb:value>) -> string */
1257
1258 static SCM
1259 gdbscm_value_print (SCM self)
1260 {
1261   value_smob *v_smob
1262     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1263   struct value *value = v_smob->value;
1264   struct value_print_options opts;
1265
1266   get_user_print_options (&opts);
1267   opts.deref_ref = 0;
1268
1269   string_file stb;
1270
1271   gdbscm_gdb_exception exc {};
1272   try
1273     {
1274       common_val_print (value, &stb, 0, &opts, current_language);
1275     }
1276   catch (const gdb_exception &except)
1277     {
1278       exc = unpack (except);
1279     }
1280
1281   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
1282   /* Use SCM_FAILED_CONVERSION_QUESTION_MARK to ensure this doesn't
1283      throw an error if the encoding fails.
1284      IWBN to use scm_take_locale_string here, but we'd have to temporarily
1285      override the default port conversion handler because contrary to
1286      documentation it doesn't necessarily free the input string.  */
1287   return scm_from_stringn (stb.c_str (), stb.size (), host_charset (),
1288                            SCM_FAILED_CONVERSION_QUESTION_MARK);
1289 }
1290 \f
1291 /* (parse-and-eval string) -> <gdb:value>
1292    Parse a string and evaluate the string as an expression.  */
1293
1294 static SCM
1295 gdbscm_parse_and_eval (SCM expr_scm)
1296 {
1297   char *expr_str;
1298   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
1299                               expr_scm, &expr_str);
1300
1301   return gdbscm_wrap ([=]
1302     {
1303       scoped_value_mark free_values;
1304       return vlscm_scm_from_value (parse_and_eval (expr_str));
1305     });
1306 }
1307
1308 /* (history-ref integer) -> <gdb:value>
1309    Return the specified value from GDB's value history.  */
1310
1311 static SCM
1312 gdbscm_history_ref (SCM index)
1313 {
1314   int i;
1315   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
1316
1317   return gdbscm_wrap ([=]
1318     {
1319       return vlscm_scm_from_value (access_value_history (i));
1320     });
1321 }
1322
1323 /* (history-append! <gdb:value>) -> index
1324    Append VALUE to GDB's value history.  Return its index in the history.  */
1325
1326 static SCM
1327 gdbscm_history_append_x (SCM value)
1328 {
1329   value_smob *v_smob
1330     = vlscm_get_value_smob_arg_unsafe (value, SCM_ARG1, FUNC_NAME);
1331   return gdbscm_wrap ([=]
1332     {
1333       return scm_from_int (record_latest_value (v_smob->value));
1334     });
1335 }
1336 \f
1337 /* Initialize the Scheme value code.  */
1338
1339 static const scheme_function value_functions[] =
1340 {
1341   { "value?", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_p),
1342     "\
1343 Return #t if the object is a <gdb:value> object." },
1344
1345   { "make-value", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_value),
1346     "\
1347 Create a <gdb:value> representing object.\n\
1348 Typically this is used to convert numbers and strings to\n\
1349 <gdb:value> objects.\n\
1350 \n\
1351   Arguments: object [#:type <gdb:type>]" },
1352
1353   { "value-optimized-out?", 1, 0, 0,
1354     as_a_scm_t_subr (gdbscm_value_optimized_out_p),
1355     "\
1356 Return #t if the value has been optimizd out." },
1357
1358   { "value-address", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_address),
1359     "\
1360 Return the address of the value." },
1361
1362   { "value-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_type),
1363     "\
1364 Return the type of the value." },
1365
1366   { "value-dynamic-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_dynamic_type),
1367     "\
1368 Return the dynamic type of the value." },
1369
1370   { "value-cast", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_cast),
1371     "\
1372 Cast the value to the supplied type.\n\
1373 \n\
1374   Arguments: <gdb:value> <gdb:type>" },
1375
1376   { "value-dynamic-cast", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_dynamic_cast),
1377     "\
1378 Cast the value to the supplied type, as if by the C++\n\
1379 dynamic_cast operator.\n\
1380 \n\
1381   Arguments: <gdb:value> <gdb:type>" },
1382
1383   { "value-reinterpret-cast", 2, 0, 0,
1384     as_a_scm_t_subr (gdbscm_value_reinterpret_cast),
1385     "\
1386 Cast the value to the supplied type, as if by the C++\n\
1387 reinterpret_cast operator.\n\
1388 \n\
1389   Arguments: <gdb:value> <gdb:type>" },
1390
1391   { "value-dereference", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_dereference),
1392     "\
1393 Return the result of applying the C unary * operator to the value." },
1394
1395   { "value-referenced-value", 1, 0, 0,
1396     as_a_scm_t_subr (gdbscm_value_referenced_value),
1397     "\
1398 Given a value of a reference type, return the value referenced.\n\
1399 The difference between this function and value-dereference is that\n\
1400 the latter applies * unary operator to a value, which need not always\n\
1401 result in the value referenced.\n\
1402 For example, for a value which is a reference to an 'int' pointer ('int *'),\n\
1403 value-dereference will result in a value of type 'int' while\n\
1404 value-referenced-value will result in a value of type 'int *'." },
1405
1406   { "value-reference-value", 1, 0, 0,
1407     as_a_scm_t_subr (gdbscm_value_reference_value),
1408     "\
1409 Return a <gdb:value> object which is a reference to the given value." },
1410
1411   { "value-rvalue-reference-value", 1, 0, 0,
1412     as_a_scm_t_subr (gdbscm_value_rvalue_reference_value),
1413     "\
1414 Return a <gdb:value> object which is an rvalue reference to the given value." },
1415
1416   { "value-const-value", 1, 0, 0,
1417     as_a_scm_t_subr (gdbscm_value_const_value),
1418     "\
1419 Return a <gdb:value> object which is a 'const' version of the given value." },
1420
1421   { "value-field", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_field),
1422     "\
1423 Return the specified field of the value.\n\
1424 \n\
1425   Arguments: <gdb:value> string" },
1426
1427   { "value-subscript", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_subscript),
1428     "\
1429 Return the value of the array at the specified index.\n\
1430 \n\
1431   Arguments: <gdb:value> integer" },
1432
1433   { "value-call", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_call),
1434     "\
1435 Perform an inferior function call taking the value as a pointer to the\n\
1436 function to call.\n\
1437 Each element of the argument list must be a <gdb:value> object or an object\n\
1438 that can be converted to one.\n\
1439 The result is the value returned by the function.\n\
1440 \n\
1441   Arguments: <gdb:value> arg-list" },
1442
1443   { "value->bool", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_bool),
1444     "\
1445 Return the Scheme boolean representing the GDB value.\n\
1446 The value must be \"integer like\".  Pointers are ok." },
1447
1448   { "value->integer", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_integer),
1449     "\
1450 Return the Scheme integer representing the GDB value.\n\
1451 The value must be \"integer like\".  Pointers are ok." },
1452
1453   { "value->real", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_real),
1454     "\
1455 Return the Scheme real number representing the GDB value.\n\
1456 The value must be a number." },
1457
1458   { "value->bytevector", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_bytevector),
1459     "\
1460 Return a Scheme bytevector with the raw contents of the GDB value.\n\
1461 No transformation, endian or otherwise, is performed." },
1462
1463   { "value->string", 1, 0, 1, as_a_scm_t_subr (gdbscm_value_to_string),
1464     "\
1465 Return the Unicode string of the value's contents.\n\
1466 If ENCODING is not given, the string is assumed to be encoded in\n\
1467 the target's charset.\n\
1468 An error setting \"error\" causes an exception to be thrown if there's\n\
1469 a decoding error.  An error setting of \"substitute\" causes invalid\n\
1470 characters to be replaced with \"?\".  The default is \"error\".\n\
1471 If LENGTH is provided, only fetch string to the length provided.\n\
1472 \n\
1473   Arguments: <gdb:value>\n\
1474              [#:encoding encoding] [#:errors \"error\"|\"substitute\"]\n\
1475              [#:length length]" },
1476
1477   { "value->lazy-string", 1, 0, 1,
1478     as_a_scm_t_subr (gdbscm_value_to_lazy_string),
1479     "\
1480 Return a Scheme object representing a lazily fetched Unicode string\n\
1481 of the value's contents.\n\
1482 If ENCODING is not given, the string is assumed to be encoded in\n\
1483 the target's charset.\n\
1484 If LENGTH is provided, only fetch string to the length provided.\n\
1485 \n\
1486   Arguments: <gdb:value> [#:encoding encoding] [#:length length]" },
1487
1488   { "value-lazy?", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_lazy_p),
1489     "\
1490 Return #t if the value is lazy (not fetched yet from the inferior).\n\
1491 A lazy value is fetched when needed, or when the value-fetch-lazy! function\n\
1492 is called." },
1493
1494   { "make-lazy-value", 2, 0, 0, as_a_scm_t_subr (gdbscm_make_lazy_value),
1495     "\
1496 Create a <gdb:value> that will be lazily fetched from the target.\n\
1497 \n\
1498   Arguments: <gdb:type> address" },
1499
1500   { "value-fetch-lazy!", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_fetch_lazy_x),
1501     "\
1502 Fetch the value from the inferior, if it was lazy.\n\
1503 The result is \"unspecified\"." },
1504
1505   { "value-print", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_print),
1506     "\
1507 Return the string representation (print form) of the value." },
1508
1509   { "parse-and-eval", 1, 0, 0, as_a_scm_t_subr (gdbscm_parse_and_eval),
1510     "\
1511 Evaluates string in gdb and returns the result as a <gdb:value> object." },
1512
1513   { "history-ref", 1, 0, 0, as_a_scm_t_subr (gdbscm_history_ref),
1514     "\
1515 Return the specified value from GDB's value history." },
1516
1517   { "history-append!", 1, 0, 0, as_a_scm_t_subr (gdbscm_history_append_x),
1518     "\
1519 Append the specified value onto GDB's value history." },
1520
1521   END_FUNCTIONS
1522 };
1523
1524 void
1525 gdbscm_initialize_values (void)
1526 {
1527   value_smob_tag = gdbscm_make_smob_type (value_smob_name,
1528                                           sizeof (value_smob));
1529   scm_set_smob_free (value_smob_tag, vlscm_free_value_smob);
1530   scm_set_smob_print (value_smob_tag, vlscm_print_value_smob);
1531   scm_set_smob_equalp (value_smob_tag, vlscm_equal_p_value_smob);
1532
1533   gdbscm_define_functions (value_functions, 1);
1534
1535   type_keyword = scm_from_latin1_keyword ("type");
1536   encoding_keyword = scm_from_latin1_keyword ("encoding");
1537   errors_keyword = scm_from_latin1_keyword ("errors");
1538   length_keyword = scm_from_latin1_keyword ("length");
1539
1540   error_symbol = scm_from_latin1_symbol ("error");
1541   escape_symbol = scm_from_latin1_symbol ("escape");
1542   substitute_symbol = scm_from_latin1_symbol ("substitute");
1543 }