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