1 /* This file contains definitions for deprecated features. When you
2 deprecate something, move it here when that is feasible.
5 /* Copyright (C) 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
7 * This library is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU Lesser General Public License
9 * as published by the Free Software Foundation; either version 3 of
10 * the License, or (at your option) any later version.
12 * This library is distributed in the hope that it will be useful, but
13 * WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 * Lesser General Public License for more details.
17 * You should have received a copy of the GNU Lesser General Public
18 * License along with this library; if not, write to the Free Software
19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27 #define SCM_BUILDING_DEPRECATED_CODE
29 #include "libguile/_scm.h"
30 #include "libguile/async.h"
31 #include "libguile/deprecated.h"
32 #include "libguile/discouraged.h"
33 #include "libguile/deprecation.h"
34 #include "libguile/snarf.h"
35 #include "libguile/validate.h"
36 #include "libguile/strings.h"
37 #include "libguile/srfi-13.h"
38 #include "libguile/modules.h"
39 #include "libguile/generalized-arrays.h"
40 #include "libguile/eval.h"
41 #include "libguile/smob.h"
42 #include "libguile/procprop.h"
43 #include "libguile/vectors.h"
44 #include "libguile/hashtab.h"
45 #include "libguile/struct.h"
46 #include "libguile/variable.h"
47 #include "libguile/fluids.h"
48 #include "libguile/ports.h"
49 #include "libguile/eq.h"
50 #include "libguile/read.h"
51 #include "libguile/strports.h"
52 #include "libguile/smob.h"
53 #include "libguile/alist.h"
54 #include "libguile/keywords.h"
55 #include "libguile/socket.h"
56 #include "libguile/feature.h"
61 #include <arpa/inet.h>
63 #if (SCM_ENABLE_DEPRECATED == 1)
65 /* From print.c: Internal symbol names of isyms. Deprecated in guile 1.7.0 on
67 char *scm_isymnames
[] =
73 /* From eval.c: Error messages of the evaluator. These were deprecated in
74 * guile 1.7.0 on 2003-06-02. */
75 const char scm_s_expression
[] = "missing or extra expression";
76 const char scm_s_test
[] = "bad test";
77 const char scm_s_body
[] = "bad body";
78 const char scm_s_bindings
[] = "bad bindings";
79 const char scm_s_variable
[] = "bad variable";
80 const char scm_s_clauses
[] = "bad or missing clauses";
81 const char scm_s_formals
[] = "bad formals";
84 SCM_REGISTER_PROC(s_substring_move_left_x
, "substring-move-left!", 5, 0, 0, scm_substring_move_x
);
86 SCM_REGISTER_PROC(s_substring_move_right_x
, "substring-move-right!", 5, 0, 0, scm_substring_move_x
);
89 scm_wta (SCM arg
, const char *pos
, const char *s_subr
)
91 if (!s_subr
|| !*s_subr
)
93 if ((~0x1fL
) & (long) pos
)
95 /* error string supplied. */
96 scm_misc_error (s_subr
, pos
, scm_list_1 (arg
));
100 /* numerical error code. */
101 scm_t_bits error
= (scm_t_bits
) pos
;
106 scm_wrong_type_arg (s_subr
, 0, arg
);
108 scm_wrong_type_arg (s_subr
, 1, arg
);
110 scm_wrong_type_arg (s_subr
, 2, arg
);
112 scm_wrong_type_arg (s_subr
, 3, arg
);
114 scm_wrong_type_arg (s_subr
, 4, arg
);
116 scm_wrong_type_arg (s_subr
, 5, arg
);
118 scm_wrong_type_arg (s_subr
, 6, arg
);
120 scm_wrong_type_arg (s_subr
, 7, arg
);
122 scm_wrong_num_args (arg
);
124 scm_out_of_range (s_subr
, arg
);
126 scm_memory_error (s_subr
);
128 /* this shouldn't happen. */
129 scm_misc_error (s_subr
, "Unknown error", SCM_EOL
);
132 return SCM_UNSPECIFIED
;
138 /* We can't use SCM objects here. One should be able to call
139 SCM_REGISTER_MODULE from a C++ constructor for a static
140 object. This happens before main and thus before libguile is
144 struct moddata
*link
;
149 static struct moddata
*registered_mods
= NULL
;
152 scm_register_module_xxx (char *module_name
, void *init_func
)
156 scm_c_issue_deprecation_warning
157 ("`scm_register_module_xxx' is deprecated. Use extensions instead.");
159 /* XXX - should we (and can we) DEFER_INTS here? */
161 for (md
= registered_mods
; md
; md
= md
->link
)
162 if (!strcmp (md
->module_name
, module_name
))
164 md
->init_func
= init_func
;
168 md
= (struct moddata
*) malloc (sizeof (struct moddata
));
172 "guile: can't register module (%s): not enough memory",
177 md
->module_name
= module_name
;
178 md
->init_func
= init_func
;
179 md
->link
= registered_mods
;
180 registered_mods
= md
;
183 SCM_DEFINE (scm_registered_modules
, "c-registered-modules", 0, 0, 0,
185 "Return a list of the object code modules that have been imported into\n"
186 "the current Guile process. Each element of the list is a pair whose\n"
187 "car is the name of the module, and whose cdr is the function handle\n"
188 "for that module's initializer function. The name is the string that\n"
189 "has been passed to scm_register_module_xxx.")
190 #define FUNC_NAME s_scm_registered_modules
196 for (md
= registered_mods
; md
; md
= md
->link
)
197 res
= scm_cons (scm_cons (scm_from_locale_string (md
->module_name
),
198 scm_from_ulong ((unsigned long) md
->init_func
)),
204 SCM_DEFINE (scm_clear_registered_modules
, "c-clear-registered-modules", 0, 0, 0,
206 "Destroy the list of modules registered with the current Guile process.\n"
207 "The return value is unspecified. @strong{Warning:} this function does\n"
208 "not actually unlink or deallocate these modules, but only destroys the\n"
209 "records of which modules have been loaded. It should therefore be used\n"
210 "only by module bookkeeping operations.")
211 #define FUNC_NAME s_scm_clear_registered_modules
213 struct moddata
*md1
, *md2
;
215 SCM_CRITICAL_SECTION_START
;
217 for (md1
= registered_mods
; md1
; md1
= md2
)
222 registered_mods
= NULL
;
224 SCM_CRITICAL_SECTION_END
;
225 return SCM_UNSPECIFIED
;
230 scm_remember (SCM
*ptr
)
232 scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
233 "Use the `scm_remember_upto_here*' family of functions instead.");
237 scm_protect_object (SCM obj
)
239 scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. "
240 "Use `scm_gc_protect_object' instead.");
241 return scm_gc_protect_object (obj
);
245 scm_unprotect_object (SCM obj
)
247 scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. "
248 "Use `scm_gc_unprotect_object' instead.");
249 return scm_gc_unprotect_object (obj
);
252 SCM_SYMBOL (scm_sym_app
, "app");
253 SCM_SYMBOL (scm_sym_modules
, "modules");
254 static SCM module_prefix
= SCM_BOOL_F
;
255 static SCM make_modules_in_var
;
256 static SCM beautify_user_module_x_var
;
257 static SCM try_module_autoload_var
;
262 #define PERM(x) scm_permanent_object(x)
264 if (module_prefix
== SCM_BOOL_F
)
266 module_prefix
= PERM (scm_list_2 (scm_sym_app
, scm_sym_modules
));
267 make_modules_in_var
= PERM (scm_c_lookup ("make-modules-in"));
268 beautify_user_module_x_var
=
269 PERM (scm_c_lookup ("beautify-user-module!"));
270 try_module_autoload_var
= PERM (scm_c_lookup ("try-module-autoload"));
275 scm_the_root_module ()
277 init_module_stuff ();
278 scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. "
279 "Use `scm_c_resolve_module (\"guile\")' "
282 return scm_c_resolve_module ("guile");
286 scm_module_full_name (SCM name
)
288 init_module_stuff ();
289 if (scm_is_eq (SCM_CAR (name
), scm_sym_app
))
292 return scm_append (scm_list_2 (module_prefix
, name
));
296 scm_make_module (SCM name
)
298 init_module_stuff ();
299 scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. "
300 "Use `scm_c_define_module instead.");
302 return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var
),
303 scm_the_root_module (),
304 scm_module_full_name (name
));
308 scm_ensure_user_module (SCM module
)
310 init_module_stuff ();
311 scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. "
312 "Use `scm_c_define_module instead.");
314 scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var
), module
);
315 return SCM_UNSPECIFIED
;
319 scm_load_scheme_module (SCM name
)
321 init_module_stuff ();
322 scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. "
323 "Use `scm_c_resolve_module instead.");
325 return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var
), name
);
328 /* This is implemented in C solely for SCM_COERCE_OUTPORT ... */
331 maybe_close_port (void *data
, SCM port
)
333 SCM except_set
= (SCM
) data
;
335 while (!scm_is_null (except_set
))
337 SCM p
= SCM_COERCE_OUTPORT (SCM_CAR (except_set
));
338 if (scm_is_eq (p
, port
))
340 except_set
= SCM_CDR (except_set
);
343 scm_close_port (port
);
346 SCM_DEFINE (scm_close_all_ports_except
, "close-all-ports-except", 0, 0, 1,
348 "[DEPRECATED] Close all open file ports used by the interpreter\n"
349 "except for those supplied as arguments. This procedure\n"
350 "was intended to be used before an exec call to close file descriptors\n"
351 "which are not needed in the new process. However it has the\n"
352 "undesirable side effect of flushing buffers, so it's deprecated.\n"
353 "Use port-for-each instead.")
354 #define FUNC_NAME s_scm_close_all_ports_except
357 SCM_VALIDATE_REST_ARGUMENT (ports
);
359 for (p
= ports
; !scm_is_null (p
); p
= SCM_CDR (p
))
360 SCM_VALIDATE_OPPORT (SCM_ARG1
, SCM_COERCE_OUTPORT (SCM_CAR (p
)));
362 scm_c_port_for_each (maybe_close_port
, ports
);
364 return SCM_UNSPECIFIED
;
368 SCM_DEFINE (scm_variable_set_name_hint
, "variable-set-name-hint!", 2, 0, 0,
370 "Do not use this function.")
371 #define FUNC_NAME s_scm_variable_set_name_hint
373 SCM_VALIDATE_VARIABLE (1, var
);
374 SCM_VALIDATE_SYMBOL (2, hint
);
375 scm_c_issue_deprecation_warning
376 ("'variable-set-name-hint!' is deprecated. Do not use it.");
377 return SCM_UNSPECIFIED
;
381 SCM_DEFINE (scm_builtin_variable
, "builtin-variable", 1, 0, 0,
383 "Do not use this function.")
384 #define FUNC_NAME s_scm_builtin_variable
386 SCM_VALIDATE_SYMBOL (1,name
);
387 scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. "
388 "Use module system operations instead.");
389 return scm_sym2var (name
, SCM_BOOL_F
, SCM_BOOL_T
);
394 scm_makstr (size_t len
, int dummy
)
396 scm_c_issue_deprecation_warning
397 ("'scm_makstr' is deprecated. Use 'scm_c_make_string' instead.");
398 return scm_c_make_string (len
, SCM_UNDEFINED
);
402 scm_makfromstr (const char *src
, size_t len
, int dummy SCM_UNUSED
)
404 scm_c_issue_deprecation_warning ("`scm_makfromstr' is deprecated. "
405 "Use `scm_from_locale_stringn' instead.");
407 return scm_from_locale_stringn (src
, len
);
411 scm_internal_with_fluids (SCM fluids
, SCM values
, SCM (*cproc
) (), void *cdata
)
413 scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. "
414 "Use `scm_c_with_fluids' instead.");
416 return scm_c_with_fluids (fluids
, values
, cproc
, cdata
);
420 scm_make_gsubr (const char *name
, int req
, int opt
, int rst
, SCM (*fcn
)())
422 scm_c_issue_deprecation_warning
423 ("`scm_make_gsubr' is deprecated. Use `scm_c_define_gsubr' instead.");
425 return scm_c_define_gsubr (name
, req
, opt
, rst
, fcn
);
429 scm_make_gsubr_with_generic (const char *name
,
430 int req
, int opt
, int rst
,
431 SCM (*fcn
)(), SCM
*gf
)
433 scm_c_issue_deprecation_warning
434 ("`scm_make_gsubr_with_generic' is deprecated. "
435 "Use `scm_c_define_gsubr_with_generic' instead.");
437 return scm_c_define_gsubr_with_generic (name
, req
, opt
, rst
, fcn
, gf
);
441 scm_create_hook (const char *name
, int n_args
)
443 scm_c_issue_deprecation_warning
444 ("'scm_create_hook' is deprecated. "
445 "Use 'scm_make_hook' and 'scm_c_define' instead.");
447 SCM hook
= scm_make_hook (scm_from_int (n_args
));
448 scm_c_define (name
, hook
);
449 return scm_permanent_object (hook
);
453 SCM_DEFINE (scm_sloppy_memq
, "sloppy-memq", 2, 0, 0,
455 "This procedure behaves like @code{memq}, but does no type or error checking.\n"
456 "Its use is recommended only in writing Guile internals,\n"
457 "not for high-level Scheme programs.")
458 #define FUNC_NAME s_scm_sloppy_memq
460 scm_c_issue_deprecation_warning
461 ("'sloppy-memq' is deprecated. Use 'memq' instead.");
463 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
465 if (scm_is_eq (SCM_CAR (lst
), x
))
473 SCM_DEFINE (scm_sloppy_memv
, "sloppy-memv", 2, 0, 0,
475 "This procedure behaves like @code{memv}, but does no type or error checking.\n"
476 "Its use is recommended only in writing Guile internals,\n"
477 "not for high-level Scheme programs.")
478 #define FUNC_NAME s_scm_sloppy_memv
480 scm_c_issue_deprecation_warning
481 ("'sloppy-memv' is deprecated. Use 'memv' instead.");
483 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
485 if (! scm_is_false (scm_eqv_p (SCM_CAR (lst
), x
)))
493 SCM_DEFINE (scm_sloppy_member
, "sloppy-member", 2, 0, 0,
495 "This procedure behaves like @code{member}, but does no type or error checking.\n"
496 "Its use is recommended only in writing Guile internals,\n"
497 "not for high-level Scheme programs.")
498 #define FUNC_NAME s_scm_sloppy_member
500 scm_c_issue_deprecation_warning
501 ("'sloppy-member' is deprecated. Use 'member' instead.");
503 for(; scm_is_pair (lst
); lst
= SCM_CDR(lst
))
505 if (! scm_is_false (scm_equal_p (SCM_CAR (lst
), x
)))
512 SCM_SYMBOL (scm_end_of_file_key
, "end-of-file");
514 SCM_DEFINE (scm_read_and_eval_x
, "read-and-eval!", 0, 1, 0,
516 "Read a form from @var{port} (standard input by default), and evaluate it\n"
517 "(memoizing it in the process) in the top-level environment. If no data\n"
518 "is left to be read from @var{port}, an @code{end-of-file} error is\n"
520 #define FUNC_NAME s_scm_read_and_eval_x
524 scm_c_issue_deprecation_warning
525 ("'read-and-eval!' is deprecated. Use 'read' and 'eval' instead.");
527 form
= scm_read (port
);
528 if (SCM_EOF_OBJECT_P (form
))
529 scm_ithrow (scm_end_of_file_key
, SCM_EOL
, 1);
530 return scm_eval_x (form
, scm_current_module ());
535 scm_make_subr_opt (const char *name
, int type
, SCM (*fcn
) (), int set
)
537 scm_c_issue_deprecation_warning
538 ("`scm_make_subr_opt' is deprecated. Use `scm_c_make_subr' or "
539 "`scm_c_define_subr' instead.");
542 return scm_c_define_subr (name
, type
, fcn
);
544 return scm_c_make_subr (name
, type
, fcn
);
548 scm_make_subr (const char *name
, int type
, SCM (*fcn
) ())
550 scm_c_issue_deprecation_warning
551 ("`scm_make_subr' is deprecated. Use `scm_c_define_subr' instead.");
553 return scm_c_define_subr (name
, type
, fcn
);
557 scm_make_subr_with_generic (const char *name
, int type
, SCM (*fcn
) (), SCM
*gf
)
559 scm_c_issue_deprecation_warning
560 ("`scm_make_subr_with_generic' is deprecated. Use "
561 "`scm_c_define_subr_with_generic' instead.");
563 return scm_c_define_subr_with_generic (name
, type
, fcn
, gf
);
566 /* Call thunk(closure) underneath a top-level error handler.
567 * If an error occurs, pass the exitval through err_filter and return it.
568 * If no error occurs, return the value of thunk.
572 typedef int setjmp_type
;
574 typedef long setjmp_type
;
577 struct cce_handler_data
{
578 SCM (*err_filter
) ();
583 invoke_err_filter (void *d
, SCM tag
, SCM args
)
585 struct cce_handler_data
*data
= (struct cce_handler_data
*)d
;
586 return data
->err_filter (SCM_BOOL_F
, data
->closure
);
590 scm_call_catching_errors (SCM (*thunk
)(), SCM (*err_filter
)(), void *closure
)
592 scm_c_issue_deprecation_warning
593 ("'scm_call_catching_errors' is deprecated. "
594 "Use 'scm_internal_catch' instead.");
597 struct cce_handler_data data
;
598 data
.err_filter
= err_filter
;
599 data
.closure
= closure
;
600 return scm_internal_catch (SCM_BOOL_T
,
601 (scm_t_catch_body
)thunk
, closure
,
602 (scm_t_catch_handler
)invoke_err_filter
, &data
);
607 scm_make_smob_type_mfpe (char *name
, size_t size
,
609 size_t (*free
) (SCM
),
610 int (*print
) (SCM
, SCM
, scm_print_state
*),
611 SCM (*equalp
) (SCM
, SCM
))
613 scm_c_issue_deprecation_warning
614 ("'scm_make_smob_type_mfpe' is deprecated. "
615 "Use 'scm_make_smob_type' plus 'scm_set_smob_*' instead.");
618 long answer
= scm_make_smob_type (name
, size
);
619 scm_set_smob_mfpe (answer
, mark
, free
, print
, equalp
);
625 scm_set_smob_mfpe (long tc
,
627 size_t (*free
) (SCM
),
628 int (*print
) (SCM
, SCM
, scm_print_state
*),
629 SCM (*equalp
) (SCM
, SCM
))
631 scm_c_issue_deprecation_warning
632 ("'scm_set_smob_mfpe' is deprecated. "
633 "Use 'scm_set_smob_mark' instead, for example.");
635 if (mark
) scm_set_smob_mark (tc
, mark
);
636 if (free
) scm_set_smob_free (tc
, free
);
637 if (print
) scm_set_smob_print (tc
, print
);
638 if (equalp
) scm_set_smob_equalp (tc
, equalp
);
642 scm_smob_free (SCM obj
)
644 long n
= SCM_SMOBNUM (obj
);
646 scm_c_issue_deprecation_warning
647 ("`scm_smob_free' is deprecated. "
648 "It is no longer needed.");
650 if (scm_smobs
[n
].size
> 0)
651 scm_gc_free ((void *) SCM_CELL_WORD_1 (obj
),
652 scm_smobs
[n
].size
, SCM_SMOBNAME (n
));
657 scm_read_0str (char *expr
)
659 scm_c_issue_deprecation_warning
660 ("scm_read_0str is deprecated. Use scm_c_read_string instead.");
662 return scm_c_read_string (expr
);
666 scm_eval_0str (const char *expr
)
668 scm_c_issue_deprecation_warning
669 ("scm_eval_0str is deprecated. Use scm_c_eval_string instead.");
671 return scm_c_eval_string (expr
);
675 scm_strprint_obj (SCM obj
)
677 scm_c_issue_deprecation_warning
678 ("scm_strprint_obj is deprecated. Use scm_object_to_string instead.");
679 return scm_object_to_string (obj
, SCM_UNDEFINED
);
683 scm_i_object_chars (SCM obj
)
685 scm_c_issue_deprecation_warning
686 ("SCM_CHARS is deprecated. See the manual for alternatives.");
687 if (SCM_STRINGP (obj
))
688 return SCM_STRING_CHARS (obj
);
689 if (SCM_SYMBOLP (obj
))
690 return SCM_SYMBOL_CHARS (obj
);
695 scm_i_object_length (SCM obj
)
697 scm_c_issue_deprecation_warning
698 ("SCM_LENGTH is deprecated. "
699 "Use scm_c_string_length instead, for example, or see the manual.");
700 if (SCM_STRINGP (obj
))
701 return SCM_STRING_LENGTH (obj
);
702 if (SCM_SYMBOLP (obj
))
703 return SCM_SYMBOL_LENGTH (obj
);
704 if (SCM_VECTORP (obj
))
705 return SCM_VECTOR_LENGTH (obj
);
710 scm_sym2ovcell_soft (SCM sym
, SCM obarray
)
713 size_t hash
= scm_i_symbol_hash (sym
) % SCM_VECTOR_LENGTH (obarray
);
715 scm_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
716 "Use hashtables instead.");
718 SCM_CRITICAL_SECTION_START
;
719 for (lsym
= SCM_VECTOR_REF (obarray
, hash
);
721 lsym
= SCM_CDR (lsym
))
724 if (scm_is_eq (SCM_CAR (z
), sym
))
726 SCM_CRITICAL_SECTION_END
;
730 SCM_CRITICAL_SECTION_END
;
736 scm_sym2ovcell (SCM sym
, SCM obarray
)
737 #define FUNC_NAME "scm_sym2ovcell"
741 scm_c_issue_deprecation_warning ("`scm_sym2ovcell' is deprecated. "
742 "Use hashtables instead.");
744 answer
= scm_sym2ovcell_soft (sym
, obarray
);
745 if (scm_is_true (answer
))
747 SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym
));
748 return SCM_UNSPECIFIED
; /* not reached */
753 /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY.
755 OBARRAY should be a vector of lists, indexed by the name's hash
756 value, modulo OBARRAY's length. Each list has the form
757 ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the
758 value associated with that symbol (in the current module? in the
761 To "intern" a symbol means: if OBARRAY already contains a symbol by
762 that name, return its (SYMBOL . VALUE) pair; otherwise, create a
763 new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the
764 appropriate list of the OBARRAY, and return the pair.
766 If softness is non-zero, don't create a symbol if it isn't already
767 in OBARRAY; instead, just return #f.
769 If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
770 return (SYMBOL . SCM_UNDEFINED). */
774 intern_obarray_soft (SCM symbol
, SCM obarray
, unsigned int softness
)
776 size_t raw_hash
= scm_i_symbol_hash (symbol
);
780 if (scm_is_false (obarray
))
785 return scm_cons (symbol
, SCM_UNDEFINED
);
788 hash
= raw_hash
% SCM_VECTOR_LENGTH (obarray
);
790 for (lsym
= SCM_VECTOR_REF(obarray
, hash
);
791 SCM_NIMP (lsym
); lsym
= SCM_CDR (lsym
))
793 SCM a
= SCM_CAR (lsym
);
795 if (scm_is_eq (z
, symbol
))
805 SCM cell
= scm_cons (symbol
, SCM_UNDEFINED
);
806 SCM slot
= SCM_VECTOR_REF (obarray
, hash
);
808 SCM_VECTOR_SET (obarray
, hash
, scm_cons (cell
, slot
));
816 scm_intern_obarray_soft (const char *name
, size_t len
, SCM obarray
,
817 unsigned int softness
)
819 SCM symbol
= scm_from_locale_symboln (name
, len
);
821 scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
822 "Use hashtables instead.");
824 return intern_obarray_soft (symbol
, obarray
, softness
);
828 scm_intern_obarray (const char *name
,size_t len
,SCM obarray
)
830 scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
831 "Use hashtables instead.");
833 return scm_intern_obarray_soft (name
, len
, obarray
, 0);
836 /* Lookup the value of the symbol named by the nul-terminated string
837 NAME in the current module. */
839 scm_symbol_value0 (const char *name
)
841 scm_c_issue_deprecation_warning ("`scm_symbol_value0' is deprecated. "
842 "Use `scm_lookup' instead.");
844 return scm_variable_ref (scm_c_lookup (name
));
847 SCM_DEFINE (scm_string_to_obarray_symbol
, "string->obarray-symbol", 2, 1, 0,
848 (SCM o
, SCM s
, SCM softp
),
849 "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
851 "If @var{obarray} is @code{#f}, use the default system symbol table. If\n"
852 "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
853 "symbol table; merely return the pair (@var{symbol}\n"
854 ". @var{#<undefined>}).\n\n"
855 "The @var{soft?} argument determines whether new symbol table entries\n"
856 "should be created when the specified symbol is not already present in\n"
857 "@var{obarray}. If @var{soft?} is specified and is a true value, then\n"
858 "new entries should not be added for symbols not already present in the\n"
859 "table; instead, simply return @code{#f}.")
860 #define FUNC_NAME s_scm_string_to_obarray_symbol
866 SCM_VALIDATE_STRING (2, s
);
867 SCM_ASSERT (scm_is_bool (o
) || SCM_VECTORP (o
), o
, SCM_ARG1
, FUNC_NAME
);
869 scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
870 "Use hashtables instead.");
872 softness
= (!SCM_UNBNDP (softp
) && scm_is_true(softp
));
873 /* iron out some screwy calling conventions */
874 if (scm_is_false (o
))
876 /* nothing interesting to do here. */
877 return scm_string_to_symbol (s
);
879 else if (scm_is_eq (o
, SCM_BOOL_T
))
882 vcell
= intern_obarray_soft (scm_string_to_symbol (s
), o
, softness
);
883 if (scm_is_false (vcell
))
885 answer
= SCM_CAR (vcell
);
890 SCM_DEFINE (scm_intern_symbol
, "intern-symbol", 2, 0, 0,
892 "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n"
893 "unspecified initial value. The symbol table is not modified if a symbol\n"
894 "with this name is already present.")
895 #define FUNC_NAME s_scm_intern_symbol
898 SCM_VALIDATE_SYMBOL (2,s
);
899 if (scm_is_false (o
))
900 return SCM_UNSPECIFIED
;
902 scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
903 "Use hashtables instead.");
905 SCM_VALIDATE_VECTOR (1,o
);
906 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
907 /* If the symbol is already interned, simply return. */
908 SCM_CRITICAL_SECTION_START
;
912 for (lsym
= SCM_VECTOR_REF (o
, hval
);
914 lsym
= SCM_CDR (lsym
))
916 sym
= SCM_CAR (lsym
);
917 if (scm_is_eq (SCM_CAR (sym
), s
))
919 SCM_CRITICAL_SECTION_END
;
920 return SCM_UNSPECIFIED
;
923 SCM_VECTOR_SET (o
, hval
,
924 scm_acons (s
, SCM_UNDEFINED
,
925 SCM_VECTOR_REF (o
, hval
)));
927 SCM_CRITICAL_SECTION_END
;
928 return SCM_UNSPECIFIED
;
932 SCM_DEFINE (scm_unintern_symbol
, "unintern-symbol", 2, 0, 0,
934 "Remove the symbol with name @var{string} from @var{obarray}. This\n"
935 "function returns @code{#t} if the symbol was present and @code{#f}\n"
937 #define FUNC_NAME s_scm_unintern_symbol
941 scm_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
942 "Use hashtables instead.");
944 SCM_VALIDATE_SYMBOL (2,s
);
945 if (scm_is_false (o
))
947 SCM_VALIDATE_VECTOR (1,o
);
948 hval
= scm_i_symbol_hash (s
) % SCM_VECTOR_LENGTH (o
);
949 SCM_CRITICAL_SECTION_START
;
954 for (lsym
= SCM_VECTOR_REF (o
, hval
), lsym_follow
= SCM_BOOL_F
;
956 lsym_follow
= lsym
, lsym
= SCM_CDR (lsym
))
958 sym
= SCM_CAR (lsym
);
959 if (scm_is_eq (SCM_CAR (sym
), s
))
961 /* Found the symbol to unintern. */
962 if (scm_is_false (lsym_follow
))
963 SCM_VECTOR_SET (o
, hval
, lsym
);
965 SCM_SETCDR (lsym_follow
, SCM_CDR(lsym
));
966 SCM_CRITICAL_SECTION_END
;
971 SCM_CRITICAL_SECTION_END
;
976 SCM_DEFINE (scm_symbol_binding
, "symbol-binding", 2, 0, 0,
978 "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
979 "return the value to which it is bound. If @var{obarray} is @code{#f},\n"
980 "use the global symbol table. If @var{string} is not interned in\n"
981 "@var{obarray}, an error is signalled.")
982 #define FUNC_NAME s_scm_symbol_binding
986 scm_c_issue_deprecation_warning ("`symbol-binding' is deprecated. "
987 "Use hashtables instead.");
989 SCM_VALIDATE_SYMBOL (2,s
);
990 if (scm_is_false (o
))
991 return scm_variable_ref (scm_lookup (s
));
992 SCM_VALIDATE_VECTOR (1,o
);
993 vcell
= scm_sym2ovcell (s
, o
);
994 return SCM_CDR(vcell
);
999 SCM_DEFINE (scm_symbol_interned_p
, "symbol-interned?", 2, 0, 0,
1001 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
1002 "@var{string}, and @code{#f} otherwise.")
1003 #define FUNC_NAME s_scm_symbol_interned_p
1007 scm_c_issue_deprecation_warning ("`symbol-interned?' is deprecated. "
1008 "Use hashtables instead.");
1010 SCM_VALIDATE_SYMBOL (2,s
);
1011 if (scm_is_false (o
))
1013 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
1014 if (var
!= SCM_BOOL_F
)
1018 SCM_VALIDATE_VECTOR (1,o
);
1019 vcell
= scm_sym2ovcell_soft (s
, o
);
1020 return (SCM_NIMP(vcell
)
1027 SCM_DEFINE (scm_symbol_bound_p
, "symbol-bound?", 2, 0, 0,
1029 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
1030 "@var{string} bound to a defined value. This differs from\n"
1031 "@var{symbol-interned?} in that the mere mention of a symbol\n"
1032 "usually causes it to be interned; @code{symbol-bound?}\n"
1033 "determines whether a symbol has been given any meaningful\n"
1035 #define FUNC_NAME s_scm_symbol_bound_p
1039 scm_c_issue_deprecation_warning ("`symbol-bound?' is deprecated. "
1040 "Use hashtables instead.");
1042 SCM_VALIDATE_SYMBOL (2,s
);
1043 if (scm_is_false (o
))
1045 SCM var
= scm_sym2var (s
, SCM_BOOL_F
, SCM_BOOL_F
);
1046 if (SCM_VARIABLEP(var
) && !SCM_UNBNDP(SCM_VARIABLE_REF(var
)))
1050 SCM_VALIDATE_VECTOR (1,o
);
1051 vcell
= scm_sym2ovcell_soft (s
, o
);
1052 return scm_from_bool (SCM_NIMP (vcell
) && !SCM_UNBNDP (SCM_CDR (vcell
)));
1057 SCM_DEFINE (scm_symbol_set_x
, "symbol-set!", 3, 0, 0,
1058 (SCM o
, SCM s
, SCM v
),
1059 "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n"
1060 "it to @var{value}. An error is signalled if @var{string} is not present\n"
1061 "in @var{obarray}.")
1062 #define FUNC_NAME s_scm_symbol_set_x
1066 scm_c_issue_deprecation_warning ("`symbol-set!' is deprecated. "
1067 "Use the module system instead.");
1069 SCM_VALIDATE_SYMBOL (2,s
);
1070 if (scm_is_false (o
))
1073 return SCM_UNSPECIFIED
;
1075 SCM_VALIDATE_VECTOR (1,o
);
1076 vcell
= scm_sym2ovcell (s
, o
);
1077 SCM_SETCDR (vcell
, v
);
1078 return SCM_UNSPECIFIED
;
1082 #define MAX_PREFIX_LENGTH 30
1084 static int gentemp_counter
;
1086 SCM_DEFINE (scm_gentemp
, "gentemp", 0, 2, 0,
1087 (SCM prefix
, SCM obarray
),
1088 "Create a new symbol with a name unique in an obarray.\n"
1089 "The name is constructed from an optional string @var{prefix}\n"
1090 "and a counter value. The default prefix is @code{t}. The\n"
1091 "@var{obarray} is specified as a second optional argument.\n"
1092 "Default is the system obarray where all normal symbols are\n"
1093 "interned. The counter is increased by 1 at each\n"
1094 "call. There is no provision for resetting the counter.")
1095 #define FUNC_NAME s_scm_gentemp
1097 char buf
[MAX_PREFIX_LENGTH
+ SCM_INTBUFLEN
];
1102 scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
1103 "Use `gensym' instead.");
1105 if (SCM_UNBNDP (prefix
))
1112 SCM_VALIDATE_STRING (1, prefix
);
1113 len
= scm_i_string_length (prefix
);
1114 name
= scm_to_locale_stringn (prefix
, &len
);
1115 name
= scm_realloc (name
, len
+ SCM_INTBUFLEN
);
1118 if (SCM_UNBNDP (obarray
))
1119 return scm_gensym (prefix
);
1121 SCM_ASSERT ((scm_is_vector (obarray
) || SCM_I_WVECTP (obarray
)),
1126 n_digits
= scm_iint2str (gentemp_counter
++, 10, &name
[len
]);
1127 while (scm_is_true (scm_intern_obarray_soft (name
,
1132 SCM vcell
= scm_intern_obarray_soft (name
,
1138 return SCM_CAR (vcell
);
1144 scm_i_makinum (scm_t_signed_bits val
)
1146 scm_c_issue_deprecation_warning
1147 ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead.");
1148 return SCM_I_MAKINUM (val
);
1152 scm_i_inump (SCM obj
)
1154 scm_c_issue_deprecation_warning
1155 ("SCM_INUMP is deprecated. Use scm_is_integer or similar instead.");
1156 return SCM_I_INUMP (obj
);
1160 scm_i_inum (SCM obj
)
1162 scm_c_issue_deprecation_warning
1163 ("SCM_INUM is deprecated. Use scm_to_int or similar instead.");
1164 return scm_to_intmax (obj
);
1168 scm_c_string2str (SCM obj
, char *str
, size_t *lenp
)
1170 scm_c_issue_deprecation_warning
1171 ("scm_c_string2str is deprecated. Use scm_to_locale_stringbuf or similar instead.");
1175 char *result
= scm_to_locale_string (obj
);
1177 *lenp
= scm_i_string_length (obj
);
1182 /* Pray that STR is large enough.
1184 size_t len
= scm_to_locale_stringbuf (obj
, str
, SCM_I_SIZE_MAX
);
1193 scm_c_substring2str (SCM obj
, char *str
, size_t start
, size_t len
)
1195 scm_c_issue_deprecation_warning
1196 ("scm_c_substring2str is deprecated. Use scm_substring plus scm_to_locale_stringbuf instead.");
1199 obj
= scm_substring (obj
, scm_from_size_t (start
), SCM_UNDEFINED
);
1201 scm_to_locale_stringbuf (obj
, str
, len
);
1205 /* Converts the given Scheme symbol OBJ into a C string, containing a copy
1206 of OBJ's content with a trailing null byte. If LENP is non-NULL, set
1207 *LENP to the string's length.
1209 When STR is non-NULL it receives the copy and is returned by the function,
1210 otherwise new memory is allocated and the caller is responsible for
1211 freeing it via free(). If out of memory, NULL is returned.
1213 Note that Scheme symbols may contain arbitrary data, including null
1214 characters. This means that null termination is not a reliable way to
1215 determine the length of the returned value. However, the function always
1216 copies the complete contents of OBJ, and sets *LENP to the length of the
1217 scheme symbol (if LENP is non-null). */
1219 scm_c_symbol2str (SCM obj
, char *str
, size_t *lenp
)
1221 return scm_c_string2str (scm_symbol_to_string (obj
), str
, lenp
);
1225 scm_truncate (double x
)
1227 scm_c_issue_deprecation_warning
1228 ("scm_truncate is deprecated. Use scm_c_truncate instead.");
1229 return scm_c_truncate (x
);
1233 scm_round (double x
)
1235 scm_c_issue_deprecation_warning
1236 ("scm_round is deprecated. Use scm_c_round instead.");
1237 return scm_c_round (x
);
1241 scm_i_deprecated_symbol_chars (SCM sym
)
1243 scm_c_issue_deprecation_warning
1244 ("SCM_SYMBOL_CHARS is deprecated. Use scm_symbol_to_string.");
1246 return (char *)scm_i_symbol_chars (sym
);
1250 scm_i_deprecated_symbol_length (SCM sym
)
1252 scm_c_issue_deprecation_warning
1253 ("SCM_SYMBOL_LENGTH is deprecated. Use scm_symbol_to_string.");
1254 return scm_i_symbol_length (sym
);
1258 scm_i_keywordp (SCM obj
)
1260 scm_c_issue_deprecation_warning
1261 ("SCM_KEYWORDP is deprecated. Use scm_is_keyword instead.");
1262 return scm_is_keyword (obj
);
1266 scm_i_keywordsym (SCM keyword
)
1268 scm_c_issue_deprecation_warning
1269 ("SCM_KEYWORDSYM is deprecated. See scm_keyword_to_symbol instead.");
1270 return scm_keyword_dash_symbol (keyword
);
1274 scm_i_vectorp (SCM x
)
1276 scm_c_issue_deprecation_warning
1277 ("SCM_VECTORP is deprecated. Use scm_is_vector instead.");
1278 return SCM_I_IS_VECTOR (x
);
1282 scm_i_vector_length (SCM x
)
1284 scm_c_issue_deprecation_warning
1285 ("SCM_VECTOR_LENGTH is deprecated. Use scm_c_vector_length instead.");
1286 return SCM_I_VECTOR_LENGTH (x
);
1292 scm_c_issue_deprecation_warning
1293 ("SCM_VELTS is deprecated. Use scm_vector_elements instead.");
1294 return SCM_I_VECTOR_ELTS (x
);
1298 scm_i_writable_velts (SCM x
)
1300 scm_c_issue_deprecation_warning
1301 ("SCM_WRITABLE_VELTS is deprecated. "
1302 "Use scm_vector_writable_elements instead.");
1303 return SCM_I_VECTOR_WELTS (x
);
1307 scm_i_vector_ref (SCM x
, size_t idx
)
1309 scm_c_issue_deprecation_warning
1310 ("SCM_VECTOR_REF is deprecated. "
1311 "Use scm_c_vector_ref or scm_vector_elements instead.");
1312 return scm_c_vector_ref (x
, idx
);
1316 scm_i_vector_set (SCM x
, size_t idx
, SCM val
)
1318 scm_c_issue_deprecation_warning
1319 ("SCM_VECTOR_SET is deprecated. "
1320 "Use scm_c_vector_set_x or scm_vector_writable_elements instead.");
1321 scm_c_vector_set_x (x
, idx
, val
);
1325 scm_vector_equal_p (SCM x
, SCM y
)
1327 scm_c_issue_deprecation_warning
1328 ("scm_vector_euqal_p is deprecated. "
1329 "Use scm_equal_p instead.");
1330 return scm_equal_p (x
, y
);
1334 scm_i_arrayp (SCM a
)
1336 scm_c_issue_deprecation_warning
1337 ("SCM_ARRAYP is deprecated. Use scm_is_array instead.");
1338 return SCM_I_ARRAYP(a
);
1342 scm_i_array_ndim (SCM a
)
1344 scm_c_issue_deprecation_warning
1345 ("SCM_ARRAY_NDIM is deprecated. "
1346 "Use scm_c_array_rank or scm_array_handle_rank instead.");
1347 return scm_c_array_rank (a
);
1351 scm_i_array_contp (SCM a
)
1353 scm_c_issue_deprecation_warning
1354 ("SCM_ARRAY_CONTP is deprecated. Do not use it.");
1355 return SCM_I_ARRAY_CONTP (a
);
1359 scm_i_array_mem (SCM a
)
1361 scm_c_issue_deprecation_warning
1362 ("SCM_ARRAY_MEM is deprecated. Do not use it.");
1363 return (scm_t_array
*)SCM_I_ARRAY_MEM (a
);
1367 scm_i_array_v (SCM a
)
1369 /* We could use scm_shared_array_root here, but it is better to move
1370 them away from expecting vectors as the basic storage for arrays.
1372 scm_c_issue_deprecation_warning
1373 ("SCM_ARRAY_V is deprecated. Do not use it.");
1374 return SCM_I_ARRAY_V (a
);
1378 scm_i_array_base (SCM a
)
1380 scm_c_issue_deprecation_warning
1381 ("SCM_ARRAY_BASE is deprecated. Do not use it.");
1382 return SCM_I_ARRAY_BASE (a
);
1386 scm_i_array_dims (SCM a
)
1388 scm_c_issue_deprecation_warning
1389 ("SCM_ARRAY_DIMS is deprecated. Use scm_array_handle_dims instead.");
1390 return SCM_I_ARRAY_DIMS (a
);
1394 scm_i_cur_inp (void)
1396 scm_c_issue_deprecation_warning
1397 ("scm_cur_inp is deprecated. Use scm_current_input_port instead.");
1398 return scm_current_input_port ();
1402 scm_i_cur_outp (void)
1404 scm_c_issue_deprecation_warning
1405 ("scm_cur_outp is deprecated. Use scm_current_output_port instead.");
1406 return scm_current_output_port ();
1410 scm_i_cur_errp (void)
1412 scm_c_issue_deprecation_warning
1413 ("scm_cur_errp is deprecated. Use scm_current_error_port instead.");
1414 return scm_current_error_port ();
1418 scm_i_cur_loadp (void)
1420 scm_c_issue_deprecation_warning
1421 ("scm_cur_loadp is deprecated. Use scm_current_load_port instead.");
1422 return scm_current_load_port ();
1426 scm_i_progargs (void)
1428 scm_c_issue_deprecation_warning
1429 ("scm_progargs is deprecated. Use scm_program_arguments instead.");
1430 return scm_program_arguments ();
1434 scm_i_deprecated_dynwinds (void)
1436 scm_c_issue_deprecation_warning
1437 ("scm_dynwinds is deprecated. Do not use it.");
1438 return scm_i_dynwinds ();
1442 scm_i_deprecated_last_debug_frame (void)
1444 scm_c_issue_deprecation_warning
1445 ("scm_last_debug_frame is deprecated. Do not use it.");
1446 return scm_i_last_debug_frame ();
1450 scm_i_stack_base (void)
1452 scm_c_issue_deprecation_warning
1453 ("scm_stack_base is deprecated. Do not use it.");
1454 return SCM_I_CURRENT_THREAD
->base
;
1458 scm_i_fluidp (SCM x
)
1460 scm_c_issue_deprecation_warning
1461 ("SCM_FLUIDP is deprecated. Use scm_is_fluid instead.");
1462 return scm_is_fluid (x
);
1468 SCM_DEFINE (scm_inet_aton
, "inet-aton", 1, 0, 0,
1470 "Convert an IPv4 Internet address from printable string\n"
1471 "(dotted decimal notation) to an integer. E.g.,\n\n"
1473 "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
1475 #define FUNC_NAME s_scm_inet_aton
1477 scm_c_issue_deprecation_warning
1478 ("`inet-aton' is deprecated. Use `inet-pton' instead.");
1480 return scm_inet_pton (scm_from_int (AF_INET
), address
);
1485 SCM_DEFINE (scm_inet_ntoa
, "inet-ntoa", 1, 0, 0,
1487 "Convert an IPv4 Internet address to a printable\n"
1488 "(dotted decimal notation) string. E.g.,\n\n"
1490 "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
1492 #define FUNC_NAME s_scm_inet_ntoa
1494 scm_c_issue_deprecation_warning
1495 ("`inet-ntoa' is deprecated. Use `inet-ntop' instead.");
1497 return scm_inet_ntop (scm_from_int (AF_INET
), inetid
);
1504 scm_i_defer_ints_etc ()
1506 scm_c_issue_deprecation_warning
1507 ("SCM_DEFER_INTS etc are deprecated. "
1508 "Use a mutex instead if appropriate.");
1512 scm_i_mask_ints (void)
1514 scm_c_issue_deprecation_warning ("`scm_mask_ints' is deprecated.");
1515 return (SCM_I_CURRENT_THREAD
->block_asyncs
!= 0);
1520 scm_guard (SCM guardian
, SCM obj
, int throw_p
)
1522 scm_c_issue_deprecation_warning
1523 ("scm_guard is deprecated. Use scm_call_1 instead.");
1525 return scm_call_1 (guardian
, obj
);
1529 scm_get_one_zombie (SCM guardian
)
1531 scm_c_issue_deprecation_warning
1532 ("scm_guard is deprecated. Use scm_call_0 instead.");
1534 return scm_call_0 (guardian
);
1537 SCM_DEFINE (scm_guardian_destroyed_p
, "guardian-destroyed?", 1, 0, 0,
1539 "Return @code{#t} if @var{guardian} has been destroyed, otherwise @code{#f}.")
1540 #define FUNC_NAME s_scm_guardian_destroyed_p
1542 scm_c_issue_deprecation_warning
1543 ("'guardian-destroyed?' is deprecated.");
1548 SCM_DEFINE (scm_guardian_greedy_p
, "guardian-greedy?", 1, 0, 0,
1550 "Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.")
1551 #define FUNC_NAME s_scm_guardian_greedy_p
1553 scm_c_issue_deprecation_warning
1554 ("'guardian-greedy?' is deprecated.");
1559 SCM_DEFINE (scm_destroy_guardian_x
, "destroy-guardian!", 1, 0, 0,
1561 "Destroys @var{guardian}, by making it impossible to put any more\n"
1562 "objects in it or get any objects from it. It also unguards any\n"
1563 "objects guarded by @var{guardian}.")
1564 #define FUNC_NAME s_scm_destroy_guardian_x
1566 scm_c_issue_deprecation_warning
1567 ("'destroy-guardian!' is deprecated and ineffective.");
1568 return SCM_UNSPECIFIED
;
1573 /* GC-related things. */
1575 unsigned long scm_mallocated
, scm_mtrigger
;
1576 size_t scm_max_segment_size
;
1578 #if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
1580 scm_map_free_list (void)
1586 #if defined (GUILE_DEBUG_FREELIST)
1588 scm_gc_set_debug_check_freelist_x (SCM flag
)
1590 return SCM_UNSPECIFIED
;
1596 scm_i_init_deprecated ()
1598 #include "libguile/deprecated.x"