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