1 /* Scheme interface to values.
3 Copyright (C) 2008-2018 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
24 #include "arch-utils.h"
27 #include "target-float.h"
29 #include "symtab.h" /* Needed by language.h. */
33 #include "guile-internal.h"
35 /* The <gdb:value> smob. */
37 typedef struct _value_smob
39 /* This always appears first. */
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
;
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. */
60 static const char value_smob_name
[] = "gdb:value";
62 /* The tag Guile knows the value smob by. */
63 static scm_t_bits value_smob_tag
;
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
;
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
;
76 /* Possible #:errors values. */
77 static SCM error_symbol
;
78 static SCM escape_symbol
;
79 static SCM substitute_symbol
;
81 /* Administrivia for value smobs. */
83 /* Iterate over all the <gdb:value> objects, calling preserve_one_value on
85 This is the extension_language_ops.preserve_values "method". */
88 gdbscm_preserve_values (const struct extension_language_defn
*extlang
,
89 struct objfile
*objfile
, htab_t copied_types
)
93 for (iter
= values_in_scheme
; iter
; iter
= iter
->next
)
94 preserve_one_value (iter
->value
, objfile
, copied_types
);
97 /* Helper to add a value_smob to the global list. */
100 vlscm_remember_scheme_value (value_smob
*v_smob
)
102 v_smob
->next
= values_in_scheme
;
104 v_smob
->next
->prev
= v_smob
;
106 values_in_scheme
= v_smob
;
109 /* Helper to remove a value_smob from the global list. */
112 vlscm_forget_value_smob (value_smob
*v_smob
)
114 /* Remove SELF from the global list. */
116 v_smob
->prev
->next
= v_smob
->next
;
119 gdb_assert (values_in_scheme
== v_smob
);
120 values_in_scheme
= v_smob
->next
;
123 v_smob
->next
->prev
= v_smob
->prev
;
126 /* The smob "free" function for <gdb:value>. */
129 vlscm_free_value_smob (SCM self
)
131 value_smob
*v_smob
= (value_smob
*) SCM_SMOB_DATA (self
);
133 vlscm_forget_value_smob (v_smob
);
134 value_decref (v_smob
->value
);
139 /* The smob "print" function for <gdb:value>. */
142 vlscm_print_value_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
144 value_smob
*v_smob
= (value_smob
*) SCM_SMOB_DATA (self
);
145 struct value_print_options opts
;
147 if (pstate
->writingp
)
148 gdbscm_printf (port
, "#<%s ", value_smob_name
);
150 get_user_print_options (&opts
);
153 /* pstate->writingp = zero if invoked by display/~A, and nonzero if
154 invoked by write/~S. What to do here may need to evolve.
155 IWBN if we could pass an argument to format that would we could use
156 instead of writingp. */
157 opts
.raw
= !!pstate
->writingp
;
163 common_val_print (v_smob
->value
, &stb
, 0, &opts
, current_language
);
164 scm_puts (stb
.c_str (), port
);
166 CATCH (except
, RETURN_MASK_ALL
)
168 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
172 if (pstate
->writingp
)
173 scm_puts (">", port
);
175 scm_remember_upto_here_1 (self
);
177 /* Non-zero means success. */
181 /* The smob "equalp" function for <gdb:value>. */
184 vlscm_equal_p_value_smob (SCM v1
, SCM v2
)
186 const value_smob
*v1_smob
= (value_smob
*) SCM_SMOB_DATA (v1
);
187 const value_smob
*v2_smob
= (value_smob
*) SCM_SMOB_DATA (v2
);
192 result
= value_equal (v1_smob
->value
, v2_smob
->value
);
194 CATCH (except
, RETURN_MASK_ALL
)
196 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
200 return scm_from_bool (result
);
203 /* Low level routine to create a <gdb:value> object. */
206 vlscm_make_value_smob (void)
208 value_smob
*v_smob
= (value_smob
*)
209 scm_gc_malloc (sizeof (value_smob
), value_smob_name
);
212 /* These must be filled in by the caller. */
213 v_smob
->value
= NULL
;
217 /* These are lazily computed. */
218 v_smob
->address
= SCM_UNDEFINED
;
219 v_smob
->type
= SCM_UNDEFINED
;
220 v_smob
->dynamic_type
= SCM_UNDEFINED
;
222 v_scm
= scm_new_smob (value_smob_tag
, (scm_t_bits
) v_smob
);
223 gdbscm_init_gsmob (&v_smob
->base
);
228 /* Return non-zero if SCM is a <gdb:value> object. */
231 vlscm_is_value (SCM scm
)
233 return SCM_SMOB_PREDICATE (value_smob_tag
, scm
);
236 /* (value? object) -> boolean */
239 gdbscm_value_p (SCM scm
)
241 return scm_from_bool (vlscm_is_value (scm
));
244 /* Create a new <gdb:value> object that encapsulates VALUE.
245 The value is released from the all_values chain so its lifetime is not
246 bound to the execution of a command. */
249 vlscm_scm_from_value (struct value
*value
)
251 /* N.B. It's important to not cause any side-effects until we know the
252 conversion worked. */
253 SCM v_scm
= vlscm_make_value_smob ();
254 value_smob
*v_smob
= (value_smob
*) SCM_SMOB_DATA (v_scm
);
256 v_smob
->value
= release_value (value
).release ();
257 vlscm_remember_scheme_value (v_smob
);
262 /* Returns the <gdb:value> object in SELF.
263 Throws an exception if SELF is not a <gdb:value> object. */
266 vlscm_get_value_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
268 SCM_ASSERT_TYPE (vlscm_is_value (self
), self
, arg_pos
, func_name
,
274 /* Returns a pointer to the value smob of SELF.
275 Throws an exception if SELF is not a <gdb:value> object. */
278 vlscm_get_value_smob_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
280 SCM v_scm
= vlscm_get_value_arg_unsafe (self
, arg_pos
, func_name
);
281 value_smob
*v_smob
= (value_smob
*) SCM_SMOB_DATA (v_scm
);
286 /* Return the value field of V_SCM, an object of type <gdb:value>.
287 This exists so that we don't have to export the struct's contents. */
290 vlscm_scm_to_value (SCM v_scm
)
294 gdb_assert (vlscm_is_value (v_scm
));
295 v_smob
= (value_smob
*) SCM_SMOB_DATA (v_scm
);
296 return v_smob
->value
;
301 /* (make-value x [#:type type]) -> <gdb:value> */
304 gdbscm_make_value (SCM x
, SCM rest
)
306 struct gdbarch
*gdbarch
= get_current_arch ();
307 const struct language_defn
*language
= current_language
;
308 const SCM keywords
[] = { type_keyword
, SCM_BOOL_F
};
309 int type_arg_pos
= -1;
310 SCM type_scm
= SCM_UNDEFINED
;
311 SCM except_scm
, result
;
313 struct type
*type
= NULL
;
315 struct cleanup
*cleanups
;
317 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#O", rest
,
318 &type_arg_pos
, &type_scm
);
320 if (type_arg_pos
> 0)
322 t_smob
= tyscm_get_type_smob_arg_unsafe (type_scm
, type_arg_pos
,
324 type
= tyscm_type_smob_type (t_smob
);
327 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
329 value
= vlscm_convert_typed_value_from_scheme (FUNC_NAME
, SCM_ARG1
, x
,
330 type_arg_pos
, type_scm
, type
,
335 do_cleanups (cleanups
);
336 gdbscm_throw (except_scm
);
339 result
= vlscm_scm_from_value (value
);
341 do_cleanups (cleanups
);
343 if (gdbscm_is_exception (result
))
344 gdbscm_throw (result
);
348 /* (make-lazy-value <gdb:type> address) -> <gdb:value> */
351 gdbscm_make_lazy_value (SCM type_scm
, SCM address_scm
)
356 struct value
*value
= NULL
;
358 struct cleanup
*cleanups
;
360 t_smob
= tyscm_get_type_smob_arg_unsafe (type_scm
, SCM_ARG1
, FUNC_NAME
);
361 type
= tyscm_type_smob_type (t_smob
);
363 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, NULL
, "U",
364 address_scm
, &address
);
366 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
368 /* There's no (current) need to wrap this in a TRY_CATCH, but for consistency
369 and future-proofing we do. */
372 value
= value_from_contents_and_address (type
, NULL
, address
);
374 CATCH (except
, RETURN_MASK_ALL
)
376 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
380 result
= vlscm_scm_from_value (value
);
382 do_cleanups (cleanups
);
384 if (gdbscm_is_exception (result
))
385 gdbscm_throw (result
);
389 /* (value-optimized-out? <gdb:value>) -> boolean */
392 gdbscm_value_optimized_out_p (SCM self
)
395 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
396 struct value
*value
= v_smob
->value
;
401 opt
= value_optimized_out (value
);
403 CATCH (except
, RETURN_MASK_ALL
)
405 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
409 return scm_from_bool (opt
);
412 /* (value-address <gdb:value>) -> integer
413 Returns #f if the value doesn't have one. */
416 gdbscm_value_address (SCM self
)
419 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
420 struct value
*value
= v_smob
->value
;
422 if (SCM_UNBNDP (v_smob
->address
))
424 struct cleanup
*cleanup
425 = make_cleanup_value_free_to_mark (value_mark ());
426 SCM address
= SCM_BOOL_F
;
430 address
= vlscm_scm_from_value (value_addr (value
));
432 CATCH (except
, RETURN_MASK_ALL
)
437 do_cleanups (cleanup
);
439 if (gdbscm_is_exception (address
))
440 gdbscm_throw (address
);
442 v_smob
->address
= address
;
445 return v_smob
->address
;
448 /* (value-dereference <gdb:value>) -> <gdb:value>
449 Given a value of a pointer type, apply the C unary * operator to it. */
452 gdbscm_value_dereference (SCM self
)
455 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
456 struct value
*value
= v_smob
->value
;
458 struct value
*res_val
= NULL
;
459 struct cleanup
*cleanups
;
461 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
465 res_val
= value_ind (value
);
467 CATCH (except
, RETURN_MASK_ALL
)
469 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
473 result
= vlscm_scm_from_value (res_val
);
475 do_cleanups (cleanups
);
477 if (gdbscm_is_exception (result
))
478 gdbscm_throw (result
);
483 /* (value-referenced-value <gdb:value>) -> <gdb:value>
484 Given a value of a reference type, return the value referenced.
485 The difference between this function and gdbscm_value_dereference is that
486 the latter applies * unary operator to a value, which need not always
487 result in the value referenced.
488 For example, for a value which is a reference to an 'int' pointer ('int *'),
489 gdbscm_value_dereference will result in a value of type 'int' while
490 gdbscm_value_referenced_value will result in a value of type 'int *'. */
493 gdbscm_value_referenced_value (SCM self
)
496 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
497 struct value
*value
= v_smob
->value
;
499 struct value
*res_val
= NULL
;
500 struct cleanup
*cleanups
;
502 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
506 switch (TYPE_CODE (check_typedef (value_type (value
))))
509 res_val
= value_ind (value
);
512 res_val
= coerce_ref (value
);
515 error (_("Trying to get the referenced value from a value which is"
516 " neither a pointer nor a reference"));
519 CATCH (except
, RETURN_MASK_ALL
)
521 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
525 result
= vlscm_scm_from_value (res_val
);
527 do_cleanups (cleanups
);
529 if (gdbscm_is_exception (result
))
530 gdbscm_throw (result
);
535 /* (value-type <gdb:value>) -> <gdb:type> */
538 gdbscm_value_type (SCM self
)
541 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
542 struct value
*value
= v_smob
->value
;
544 if (SCM_UNBNDP (v_smob
->type
))
545 v_smob
->type
= tyscm_scm_from_type (value_type (value
));
550 /* (value-dynamic-type <gdb:value>) -> <gdb:type> */
553 gdbscm_value_dynamic_type (SCM self
)
556 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
557 struct value
*value
= v_smob
->value
;
558 struct type
*type
= NULL
;
560 if (! SCM_UNBNDP (v_smob
->dynamic_type
))
561 return v_smob
->dynamic_type
;
565 struct cleanup
*cleanup
566 = make_cleanup_value_free_to_mark (value_mark ());
568 type
= value_type (value
);
569 type
= check_typedef (type
);
571 if (((TYPE_CODE (type
) == TYPE_CODE_PTR
)
572 || (TYPE_CODE (type
) == TYPE_CODE_REF
))
573 && (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_STRUCT
))
575 struct value
*target
;
576 int was_pointer
= TYPE_CODE (type
) == TYPE_CODE_PTR
;
579 target
= value_ind (value
);
581 target
= coerce_ref (value
);
582 type
= value_rtti_type (target
, NULL
, NULL
, NULL
);
587 type
= lookup_pointer_type (type
);
589 type
= lookup_lvalue_reference_type (type
);
592 else if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
593 type
= value_rtti_type (value
, NULL
, NULL
, NULL
);
596 /* Re-use object's static type. */
600 do_cleanups (cleanup
);
602 CATCH (except
, RETURN_MASK_ALL
)
604 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
609 v_smob
->dynamic_type
= gdbscm_value_type (self
);
611 v_smob
->dynamic_type
= tyscm_scm_from_type (type
);
613 return v_smob
->dynamic_type
;
616 /* A helper function that implements the various cast operators. */
619 vlscm_do_cast (SCM self
, SCM type_scm
, enum exp_opcode op
,
620 const char *func_name
)
623 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
624 struct value
*value
= v_smob
->value
;
626 = tyscm_get_type_smob_arg_unsafe (type_scm
, SCM_ARG2
, FUNC_NAME
);
627 struct type
*type
= tyscm_type_smob_type (t_smob
);
629 struct value
*res_val
= NULL
;
630 struct cleanup
*cleanups
;
632 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
636 if (op
== UNOP_DYNAMIC_CAST
)
637 res_val
= value_dynamic_cast (type
, value
);
638 else if (op
== UNOP_REINTERPRET_CAST
)
639 res_val
= value_reinterpret_cast (type
, value
);
642 gdb_assert (op
== UNOP_CAST
);
643 res_val
= value_cast (type
, value
);
646 CATCH (except
, RETURN_MASK_ALL
)
648 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
652 gdb_assert (res_val
!= NULL
);
653 result
= vlscm_scm_from_value (res_val
);
655 do_cleanups (cleanups
);
657 if (gdbscm_is_exception (result
))
658 gdbscm_throw (result
);
663 /* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
666 gdbscm_value_cast (SCM self
, SCM new_type
)
668 return vlscm_do_cast (self
, new_type
, UNOP_CAST
, FUNC_NAME
);
671 /* (value-dynamic-cast <gdb:value> <gdb:type>) -> <gdb:value> */
674 gdbscm_value_dynamic_cast (SCM self
, SCM new_type
)
676 return vlscm_do_cast (self
, new_type
, UNOP_DYNAMIC_CAST
, FUNC_NAME
);
679 /* (value-reinterpret-cast <gdb:value> <gdb:type>) -> <gdb:value> */
682 gdbscm_value_reinterpret_cast (SCM self
, SCM new_type
)
684 return vlscm_do_cast (self
, new_type
, UNOP_REINTERPRET_CAST
, FUNC_NAME
);
687 /* (value-field <gdb:value> string) -> <gdb:value>
688 Given string name of an element inside structure, return its <gdb:value>
692 gdbscm_value_field (SCM self
, SCM field_scm
)
695 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
696 struct value
*value
= v_smob
->value
;
698 struct value
*res_val
= NULL
;
700 struct cleanup
*cleanups
;
702 SCM_ASSERT_TYPE (scm_is_string (field_scm
), field_scm
, SCM_ARG2
, FUNC_NAME
,
705 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
707 field
= gdbscm_scm_to_c_string (field_scm
);
708 make_cleanup (xfree
, field
);
712 struct value
*tmp
= value
;
714 res_val
= value_struct_elt (&tmp
, NULL
, field
, NULL
,
715 "struct/class/union");
717 CATCH (except
, RETURN_MASK_ALL
)
719 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
723 gdb_assert (res_val
!= NULL
);
724 result
= vlscm_scm_from_value (res_val
);
726 do_cleanups (cleanups
);
728 if (gdbscm_is_exception (result
))
729 gdbscm_throw (result
);
734 /* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
735 Return the specified value in an array. */
738 gdbscm_value_subscript (SCM self
, SCM index_scm
)
741 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
742 struct value
*value
= v_smob
->value
;
743 struct value
*index
= NULL
;
744 struct value
*res_val
= NULL
;
745 struct type
*type
= value_type (value
);
746 struct gdbarch
*gdbarch
;
747 SCM result
, except_scm
;
748 struct cleanup
*cleanups
;
750 /* The sequencing here, as everywhere else, is important.
751 We can't have existing cleanups when a Scheme exception is thrown. */
753 SCM_ASSERT (type
!= NULL
, self
, SCM_ARG2
, FUNC_NAME
);
754 gdbarch
= get_type_arch (type
);
756 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
758 index
= vlscm_convert_value_from_scheme (FUNC_NAME
, SCM_ARG2
, index_scm
,
760 gdbarch
, current_language
);
763 do_cleanups (cleanups
);
764 gdbscm_throw (except_scm
);
769 struct value
*tmp
= value
;
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
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"));
781 res_val
= value_subscript (tmp
, value_as_long (index
));
783 CATCH (except
, RETURN_MASK_ALL
)
785 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
789 gdb_assert (res_val
!= NULL
);
790 result
= vlscm_scm_from_value (res_val
);
792 do_cleanups (cleanups
);
794 if (gdbscm_is_exception (result
))
795 gdbscm_throw (result
);
800 /* (value-call <gdb:value> arg-list) -> <gdb:value>
801 Perform an inferior function call on the value. */
804 gdbscm_value_call (SCM self
, SCM args
)
807 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
808 struct value
*function
= v_smob
->value
;
809 struct value
*mark
= value_mark ();
810 struct type
*ftype
= NULL
;
812 struct value
**vargs
= NULL
;
813 SCM result
= SCM_BOOL_F
;
817 ftype
= check_typedef (value_type (function
));
819 CATCH (except
, RETURN_MASK_ALL
)
821 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
825 SCM_ASSERT_TYPE (TYPE_CODE (ftype
) == TYPE_CODE_FUNC
, self
,
827 _("function (value of TYPE_CODE_FUNC)"));
829 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (args
)), args
,
830 SCM_ARG2
, FUNC_NAME
, _("list"));
832 args_count
= scm_ilength (args
);
835 struct gdbarch
*gdbarch
= get_current_arch ();
836 const struct language_defn
*language
= current_language
;
840 vargs
= XALLOCAVEC (struct value
*, args_count
);
841 for (i
= 0; i
< args_count
; i
++)
843 SCM arg
= scm_car (args
);
845 vargs
[i
] = vlscm_convert_value_from_scheme (FUNC_NAME
,
846 GDBSCM_ARG_NONE
, arg
,
849 if (vargs
[i
] == NULL
)
850 gdbscm_throw (except_scm
);
852 args
= scm_cdr (args
);
854 gdb_assert (gdbscm_is_true (scm_null_p (args
)));
859 struct cleanup
*cleanup
= make_cleanup_value_free_to_mark (mark
);
860 struct value
*return_value
;
862 return_value
= call_function_by_hand (function
, NULL
, args_count
, vargs
);
863 result
= vlscm_scm_from_value (return_value
);
864 do_cleanups (cleanup
);
866 CATCH (except
, RETURN_MASK_ALL
)
868 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
872 if (gdbscm_is_exception (result
))
873 gdbscm_throw (result
);
878 /* (value->bytevector <gdb:value>) -> bytevector */
881 gdbscm_value_to_bytevector (SCM self
)
884 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
885 struct value
*value
= v_smob
->value
;
888 const gdb_byte
*contents
= NULL
;
891 type
= value_type (value
);
895 type
= check_typedef (type
);
896 length
= TYPE_LENGTH (type
);
897 contents
= value_contents (value
);
899 CATCH (except
, RETURN_MASK_ALL
)
901 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
905 bv
= scm_c_make_bytevector (length
);
906 memcpy (SCM_BYTEVECTOR_CONTENTS (bv
), contents
, length
);
911 /* Helper function to determine if a type is "int-like". */
914 is_intlike (struct type
*type
, int ptr_ok
)
916 return (TYPE_CODE (type
) == TYPE_CODE_INT
917 || TYPE_CODE (type
) == TYPE_CODE_ENUM
918 || TYPE_CODE (type
) == TYPE_CODE_BOOL
919 || TYPE_CODE (type
) == TYPE_CODE_CHAR
920 || (ptr_ok
&& TYPE_CODE (type
) == TYPE_CODE_PTR
));
923 /* (value->bool <gdb:value>) -> boolean
924 Throws an error if the value is not integer-like. */
927 gdbscm_value_to_bool (SCM self
)
930 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
931 struct value
*value
= v_smob
->value
;
935 type
= value_type (value
);
939 type
= check_typedef (type
);
941 CATCH (except
, RETURN_MASK_ALL
)
943 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
947 SCM_ASSERT_TYPE (is_intlike (type
, 1), self
, SCM_ARG1
, FUNC_NAME
,
948 _("integer-like gdb value"));
952 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
953 l
= value_as_address (value
);
955 l
= value_as_long (value
);
957 CATCH (except
, RETURN_MASK_ALL
)
959 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
963 return scm_from_bool (l
!= 0);
966 /* (value->integer <gdb:value>) -> integer
967 Throws an error if the value is not integer-like. */
970 gdbscm_value_to_integer (SCM self
)
973 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
974 struct value
*value
= v_smob
->value
;
978 type
= value_type (value
);
982 type
= check_typedef (type
);
984 CATCH (except
, RETURN_MASK_ALL
)
986 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
990 SCM_ASSERT_TYPE (is_intlike (type
, 1), self
, SCM_ARG1
, FUNC_NAME
,
991 _("integer-like gdb value"));
995 if (TYPE_CODE (type
) == TYPE_CODE_PTR
)
996 l
= value_as_address (value
);
998 l
= value_as_long (value
);
1000 CATCH (except
, RETURN_MASK_ALL
)
1002 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1006 if (TYPE_UNSIGNED (type
))
1007 return gdbscm_scm_from_ulongest (l
);
1009 return gdbscm_scm_from_longest (l
);
1012 /* (value->real <gdb:value>) -> real
1013 Throws an error if the value is not a number. */
1016 gdbscm_value_to_real (SCM self
)
1019 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1020 struct value
*value
= v_smob
->value
;
1023 struct value
*check
= nullptr;
1025 type
= value_type (value
);
1029 type
= check_typedef (type
);
1031 CATCH (except
, RETURN_MASK_ALL
)
1033 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1037 SCM_ASSERT_TYPE (is_intlike (type
, 0) || TYPE_CODE (type
) == TYPE_CODE_FLT
,
1038 self
, SCM_ARG1
, FUNC_NAME
, _("number"));
1042 if (is_floating_value (value
))
1044 d
= target_float_to_host_double (value_contents (value
), type
);
1045 check
= allocate_value (type
);
1046 target_float_from_host_double (value_contents_raw (check
), type
, d
);
1048 else if (TYPE_UNSIGNED (type
))
1050 d
= (ULONGEST
) value_as_long (value
);
1051 check
= value_from_ulongest (type
, (ULONGEST
) d
);
1055 d
= value_as_long (value
);
1056 check
= value_from_longest (type
, (LONGEST
) d
);
1059 CATCH (except
, RETURN_MASK_ALL
)
1061 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1065 /* TODO: Is there a better way to check if the value fits? */
1066 if (!value_equal (value
, check
))
1067 gdbscm_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
1068 _("number can't be converted to a double"));
1070 return scm_from_double (d
);
1073 /* (value->string <gdb:value>
1074 [#:encoding encoding]
1075 [#:errors #f | 'error | 'substitute]
1078 Return Unicode string with value's contents, which must be a string.
1080 If ENCODING is not given, the string is assumed to be encoded in
1081 the target's charset.
1083 ERRORS is one of #f, 'error or 'substitute.
1084 An error setting of #f means use the default, which is Guile's
1085 %default-port-conversion-strategy when using Guile >= 2.0.6, or 'error if
1086 using an earlier version of Guile. Earlier versions do not properly
1087 support obtaining the default port conversion strategy.
1088 If the default is not one of 'error or 'substitute, 'substitute is used.
1089 An error setting of "error" causes an exception to be thrown if there's
1090 a decoding error. An error setting of "substitute" causes invalid
1091 characters to be replaced with "?".
1093 If LENGTH is provided, only fetch string to the length provided.
1094 LENGTH must be a Scheme integer, it can't be a <gdb:value> integer. */
1097 gdbscm_value_to_string (SCM self
, SCM rest
)
1100 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1101 struct value
*value
= v_smob
->value
;
1102 const SCM keywords
[] = {
1103 encoding_keyword
, errors_keyword
, length_keyword
, SCM_BOOL_F
1105 int encoding_arg_pos
= -1, errors_arg_pos
= -1, length_arg_pos
= -1;
1106 char *encoding
= NULL
;
1107 SCM errors
= SCM_BOOL_F
;
1109 gdb_byte
*buffer
= NULL
;
1110 const char *la_encoding
= NULL
;
1111 struct type
*char_type
= NULL
;
1113 struct cleanup
*cleanups
;
1115 /* The sequencing here, as everywhere else, is important.
1116 We can't have existing cleanups when a Scheme exception is thrown. */
1118 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#sOi", rest
,
1119 &encoding_arg_pos
, &encoding
,
1120 &errors_arg_pos
, &errors
,
1121 &length_arg_pos
, &length
);
1123 cleanups
= make_cleanup (xfree
, encoding
);
1125 if (errors_arg_pos
> 0
1126 && errors
!= SCM_BOOL_F
1127 && !scm_is_eq (errors
, error_symbol
)
1128 && !scm_is_eq (errors
, substitute_symbol
))
1131 = gdbscm_make_out_of_range_error (FUNC_NAME
, errors_arg_pos
, errors
,
1132 _("invalid error kind"));
1134 do_cleanups (cleanups
);
1135 gdbscm_throw (excp
);
1137 if (errors
== SCM_BOOL_F
)
1139 /* N.B. scm_port_conversion_strategy in Guile versions prior to 2.0.6
1140 will throw a Scheme error when passed #f. */
1141 if (gdbscm_guile_version_is_at_least (2, 0, 6))
1142 errors
= scm_port_conversion_strategy (SCM_BOOL_F
);
1144 errors
= error_symbol
;
1146 /* We don't assume anything about the result of scm_port_conversion_strategy.
1147 From this point on, if errors is not 'errors, use 'substitute. */
1151 LA_GET_STRING (value
, &buffer
, &length
, &char_type
, &la_encoding
);
1153 CATCH (except
, RETURN_MASK_ALL
)
1155 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
1159 /* If errors is "error" scm_from_stringn may throw a Scheme exception.
1160 Make sure we don't leak. This is done via scm_dynwind_begin, et.al. */
1161 discard_cleanups (cleanups
);
1163 scm_dynwind_begin ((scm_t_dynwind_flags
) 0);
1165 gdbscm_dynwind_xfree (encoding
);
1166 gdbscm_dynwind_xfree (buffer
);
1168 result
= scm_from_stringn ((const char *) buffer
,
1169 length
* TYPE_LENGTH (char_type
),
1170 (encoding
!= NULL
&& *encoding
!= '\0'
1173 scm_is_eq (errors
, error_symbol
)
1174 ? SCM_FAILED_CONVERSION_ERROR
1175 : SCM_FAILED_CONVERSION_QUESTION_MARK
);
1182 /* (value->lazy-string <gdb:value> [#:encoding encoding] [#:length length])
1183 -> <gdb:lazy-string>
1184 Return a Scheme object representing a lazy_string_object type.
1185 A lazy string is a pointer to a string with an optional encoding and length.
1186 If ENCODING is not given, the target's charset is used.
1187 If LENGTH is provided then the length parameter is set to LENGTH.
1188 Otherwise if the value is an array of known length then the array's length
1189 is used. Otherwise the length will be set to -1 (meaning first null of
1191 LENGTH must be a Scheme integer, it can't be a <gdb:value> integer. */
1194 gdbscm_value_to_lazy_string (SCM self
, SCM rest
)
1197 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1198 struct value
*value
= v_smob
->value
;
1199 const SCM keywords
[] = { encoding_keyword
, length_keyword
, SCM_BOOL_F
};
1200 int encoding_arg_pos
= -1, length_arg_pos
= -1;
1201 char *encoding
= NULL
;
1203 SCM result
= SCM_BOOL_F
; /* -Wall */
1204 struct cleanup
*cleanups
;
1205 struct gdb_exception except
= exception_none
;
1207 /* The sequencing here, as everywhere else, is important.
1208 We can't have existing cleanups when a Scheme exception is thrown. */
1210 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG2
, keywords
, "#si", rest
,
1211 &encoding_arg_pos
, &encoding
,
1212 &length_arg_pos
, &length
);
1216 gdbscm_out_of_range_error (FUNC_NAME
, length_arg_pos
,
1217 scm_from_int (length
),
1218 _("invalid length"));
1221 cleanups
= make_cleanup (xfree
, encoding
);
1225 struct cleanup
*inner_cleanup
1226 = make_cleanup_value_free_to_mark (value_mark ());
1227 struct type
*type
, *realtype
;
1230 type
= value_type (value
);
1231 realtype
= check_typedef (type
);
1233 switch (TYPE_CODE (realtype
))
1235 case TYPE_CODE_ARRAY
:
1237 LONGEST array_length
= -1;
1238 LONGEST low_bound
, high_bound
;
1240 /* PR 20786: There's no way to specify an array of length zero.
1241 Record a length of [0,-1] which is how Ada does it. Anything
1242 we do is broken, but this one possible solution. */
1243 if (get_array_bounds (realtype
, &low_bound
, &high_bound
))
1244 array_length
= high_bound
- low_bound
+ 1;
1246 length
= array_length
;
1247 else if (array_length
== -1)
1249 type
= lookup_array_range_type (TYPE_TARGET_TYPE (realtype
),
1252 else if (length
!= array_length
)
1254 /* We need to create a new array type with the
1255 specified length. */
1256 if (length
> array_length
)
1257 error (_("length is larger than array size"));
1258 type
= lookup_array_range_type (TYPE_TARGET_TYPE (type
),
1260 low_bound
+ length
- 1);
1262 addr
= value_address (value
);
1266 /* If a length is specified we defer creating an array of the
1267 specified width until we need to. */
1268 addr
= value_as_address (value
);
1271 /* Should flag an error here. PR 20769. */
1272 addr
= value_address (value
);
1276 result
= lsscm_make_lazy_string (addr
, length
, encoding
, type
);
1278 do_cleanups (inner_cleanup
);
1280 CATCH (ex
, RETURN_MASK_ALL
)
1286 do_cleanups (cleanups
);
1287 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1289 if (gdbscm_is_exception (result
))
1290 gdbscm_throw (result
);
1295 /* (value-lazy? <gdb:value>) -> boolean */
1298 gdbscm_value_lazy_p (SCM self
)
1301 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1302 struct value
*value
= v_smob
->value
;
1304 return scm_from_bool (value_lazy (value
));
1307 /* (value-fetch-lazy! <gdb:value>) -> unspecified */
1310 gdbscm_value_fetch_lazy_x (SCM self
)
1313 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1314 struct value
*value
= v_smob
->value
;
1318 if (value_lazy (value
))
1319 value_fetch_lazy (value
);
1321 CATCH (except
, RETURN_MASK_ALL
)
1323 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1327 return SCM_UNSPECIFIED
;
1330 /* (value-print <gdb:value>) -> string */
1333 gdbscm_value_print (SCM self
)
1336 = vlscm_get_value_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
1337 struct value
*value
= v_smob
->value
;
1338 struct value_print_options opts
;
1340 get_user_print_options (&opts
);
1347 common_val_print (value
, &stb
, 0, &opts
, current_language
);
1349 CATCH (except
, RETURN_MASK_ALL
)
1351 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1355 /* Use SCM_FAILED_CONVERSION_QUESTION_MARK to ensure this doesn't
1356 throw an error if the encoding fails.
1357 IWBN to use scm_take_locale_string here, but we'd have to temporarily
1358 override the default port conversion handler because contrary to
1359 documentation it doesn't necessarily free the input string. */
1360 return scm_from_stringn (stb
.c_str (), stb
.size (), host_charset (),
1361 SCM_FAILED_CONVERSION_QUESTION_MARK
);
1364 /* (parse-and-eval string) -> <gdb:value>
1365 Parse a string and evaluate the string as an expression. */
1368 gdbscm_parse_and_eval (SCM expr_scm
)
1371 struct value
*res_val
= NULL
;
1373 struct cleanup
*cleanups
;
1375 /* The sequencing here, as everywhere else, is important.
1376 We can't have existing cleanups when a Scheme exception is thrown. */
1378 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "s",
1379 expr_scm
, &expr_str
);
1381 cleanups
= make_cleanup_value_free_to_mark (value_mark ());
1382 make_cleanup (xfree
, expr_str
);
1386 res_val
= parse_and_eval (expr_str
);
1388 CATCH (except
, RETURN_MASK_ALL
)
1390 GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except
, cleanups
);
1394 gdb_assert (res_val
!= NULL
);
1395 result
= vlscm_scm_from_value (res_val
);
1397 do_cleanups (cleanups
);
1399 if (gdbscm_is_exception (result
))
1400 gdbscm_throw (result
);
1405 /* (history-ref integer) -> <gdb:value>
1406 Return the specified value from GDB's value history. */
1409 gdbscm_history_ref (SCM index
)
1412 struct value
*res_val
= NULL
; /* Initialize to appease gcc warning. */
1414 gdbscm_parse_function_args (FUNC_NAME
, SCM_ARG1
, NULL
, "i", index
, &i
);
1418 res_val
= access_value_history (i
);
1420 CATCH (except
, RETURN_MASK_ALL
)
1422 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1426 return vlscm_scm_from_value (res_val
);
1429 /* (history-append! <gdb:value>) -> index
1430 Append VALUE to GDB's value history. Return its index in the history. */
1433 gdbscm_history_append_x (SCM value
)
1439 v_smob
= vlscm_get_value_smob_arg_unsafe (value
, SCM_ARG1
, FUNC_NAME
);
1444 res_index
= record_latest_value (v
);
1446 CATCH (except
, RETURN_MASK_ALL
)
1448 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
1452 return scm_from_int (res_index
);
1455 /* Initialize the Scheme value code. */
1457 static const scheme_function value_functions
[] =
1459 { "value?", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_p
),
1461 Return #t if the object is a <gdb:value> object." },
1463 { "make-value", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_value
),
1465 Create a <gdb:value> representing object.\n\
1466 Typically this is used to convert numbers and strings to\n\
1467 <gdb:value> objects.\n\
1469 Arguments: object [#:type <gdb:type>]" },
1471 { "value-optimized-out?", 1, 0, 0,
1472 as_a_scm_t_subr (gdbscm_value_optimized_out_p
),
1474 Return #t if the value has been optimizd out." },
1476 { "value-address", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_address
),
1478 Return the address of the value." },
1480 { "value-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_type
),
1482 Return the type of the value." },
1484 { "value-dynamic-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_dynamic_type
),
1486 Return the dynamic type of the value." },
1488 { "value-cast", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_cast
),
1490 Cast the value to the supplied type.\n\
1492 Arguments: <gdb:value> <gdb:type>" },
1494 { "value-dynamic-cast", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_dynamic_cast
),
1496 Cast the value to the supplied type, as if by the C++\n\
1497 dynamic_cast operator.\n\
1499 Arguments: <gdb:value> <gdb:type>" },
1501 { "value-reinterpret-cast", 2, 0, 0,
1502 as_a_scm_t_subr (gdbscm_value_reinterpret_cast
),
1504 Cast the value to the supplied type, as if by the C++\n\
1505 reinterpret_cast operator.\n\
1507 Arguments: <gdb:value> <gdb:type>" },
1509 { "value-dereference", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_dereference
),
1511 Return the result of applying the C unary * operator to the value." },
1513 { "value-referenced-value", 1, 0, 0,
1514 as_a_scm_t_subr (gdbscm_value_referenced_value
),
1516 Given a value of a reference type, return the value referenced.\n\
1517 The difference between this function and value-dereference is that\n\
1518 the latter applies * unary operator to a value, which need not always\n\
1519 result in the value referenced.\n\
1520 For example, for a value which is a reference to an 'int' pointer ('int *'),\n\
1521 value-dereference will result in a value of type 'int' while\n\
1522 value-referenced-value will result in a value of type 'int *'." },
1524 { "value-field", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_field
),
1526 Return the specified field of the value.\n\
1528 Arguments: <gdb:value> string" },
1530 { "value-subscript", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_subscript
),
1532 Return the value of the array at the specified index.\n\
1534 Arguments: <gdb:value> integer" },
1536 { "value-call", 2, 0, 0, as_a_scm_t_subr (gdbscm_value_call
),
1538 Perform an inferior function call taking the value as a pointer to the\n\
1539 function to call.\n\
1540 Each element of the argument list must be a <gdb:value> object or an object\n\
1541 that can be converted to one.\n\
1542 The result is the value returned by the function.\n\
1544 Arguments: <gdb:value> arg-list" },
1546 { "value->bool", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_bool
),
1548 Return the Scheme boolean representing the GDB value.\n\
1549 The value must be \"integer like\". Pointers are ok." },
1551 { "value->integer", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_integer
),
1553 Return the Scheme integer representing the GDB value.\n\
1554 The value must be \"integer like\". Pointers are ok." },
1556 { "value->real", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_real
),
1558 Return the Scheme real number representing the GDB value.\n\
1559 The value must be a number." },
1561 { "value->bytevector", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_to_bytevector
),
1563 Return a Scheme bytevector with the raw contents of the GDB value.\n\
1564 No transformation, endian or otherwise, is performed." },
1566 { "value->string", 1, 0, 1, as_a_scm_t_subr (gdbscm_value_to_string
),
1568 Return the Unicode string of the value's contents.\n\
1569 If ENCODING is not given, the string is assumed to be encoded in\n\
1570 the target's charset.\n\
1571 An error setting \"error\" causes an exception to be thrown if there's\n\
1572 a decoding error. An error setting of \"substitute\" causes invalid\n\
1573 characters to be replaced with \"?\". The default is \"error\".\n\
1574 If LENGTH is provided, only fetch string to the length provided.\n\
1576 Arguments: <gdb:value>\n\
1577 [#:encoding encoding] [#:errors \"error\"|\"substitute\"]\n\
1578 [#:length length]" },
1580 { "value->lazy-string", 1, 0, 1,
1581 as_a_scm_t_subr (gdbscm_value_to_lazy_string
),
1583 Return a Scheme object representing a lazily fetched Unicode string\n\
1584 of the value's contents.\n\
1585 If ENCODING is not given, the string is assumed to be encoded in\n\
1586 the target's charset.\n\
1587 If LENGTH is provided, only fetch string to the length provided.\n\
1589 Arguments: <gdb:value> [#:encoding encoding] [#:length length]" },
1591 { "value-lazy?", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_lazy_p
),
1593 Return #t if the value is lazy (not fetched yet from the inferior).\n\
1594 A lazy value is fetched when needed, or when the value-fetch-lazy! function\n\
1597 { "make-lazy-value", 2, 0, 0, as_a_scm_t_subr (gdbscm_make_lazy_value
),
1599 Create a <gdb:value> that will be lazily fetched from the target.\n\
1601 Arguments: <gdb:type> address" },
1603 { "value-fetch-lazy!", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_fetch_lazy_x
),
1605 Fetch the value from the inferior, if it was lazy.\n\
1606 The result is \"unspecified\"." },
1608 { "value-print", 1, 0, 0, as_a_scm_t_subr (gdbscm_value_print
),
1610 Return the string representation (print form) of the value." },
1612 { "parse-and-eval", 1, 0, 0, as_a_scm_t_subr (gdbscm_parse_and_eval
),
1614 Evaluates string in gdb and returns the result as a <gdb:value> object." },
1616 { "history-ref", 1, 0, 0, as_a_scm_t_subr (gdbscm_history_ref
),
1618 Return the specified value from GDB's value history." },
1620 { "history-append!", 1, 0, 0, as_a_scm_t_subr (gdbscm_history_append_x
),
1622 Append the specified value onto GDB's value history." },
1628 gdbscm_initialize_values (void)
1630 value_smob_tag
= gdbscm_make_smob_type (value_smob_name
,
1631 sizeof (value_smob
));
1632 scm_set_smob_free (value_smob_tag
, vlscm_free_value_smob
);
1633 scm_set_smob_print (value_smob_tag
, vlscm_print_value_smob
);
1634 scm_set_smob_equalp (value_smob_tag
, vlscm_equal_p_value_smob
);
1636 gdbscm_define_functions (value_functions
, 1);
1638 type_keyword
= scm_from_latin1_keyword ("type");
1639 encoding_keyword
= scm_from_latin1_keyword ("encoding");
1640 errors_keyword
= scm_from_latin1_keyword ("errors");
1641 length_keyword
= scm_from_latin1_keyword ("length");
1643 error_symbol
= scm_from_latin1_symbol ("error");
1644 escape_symbol
= scm_from_latin1_symbol ("escape");
1645 substitute_symbol
= scm_from_latin1_symbol ("substitute");