gdb/guile/scm-value.c

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