Update autogen.sh
[bpt/guile.git] / libguile / deprecated.c
1 /* This file contains definitions for deprecated features. When you
2 deprecate something, move it here when that is feasible.
3 */
4
5 /* Copyright (C) 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
6 *
7 * This library is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU Lesser General Public
9 * License as published by the Free Software Foundation; either
10 * version 2.1 of the License, or (at your option) any later version.
11 *
12 * This library 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 GNU
15 * Lesser General Public License for more details.
16 *
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 02110-1301 USA
20 */
21
22 #ifdef HAVE_CONFIG_H
23 # include <config.h>
24 #endif
25
26 #include "libguile/_scm.h"
27 #include "libguile/async.h"
28 #include "libguile/deprecated.h"
29 #include "libguile/discouraged.h"
30 #include "libguile/deprecation.h"
31 #include "libguile/snarf.h"
32 #include "libguile/validate.h"
33 #include "libguile/strings.h"
34 #include "libguile/srfi-13.h"
35 #include "libguile/modules.h"
36 #include "libguile/eval.h"
37 #include "libguile/smob.h"
38 #include "libguile/procprop.h"
39 #include "libguile/vectors.h"
40 #include "libguile/hashtab.h"
41 #include "libguile/struct.h"
42 #include "libguile/variable.h"
43 #include "libguile/fluids.h"
44 #include "libguile/ports.h"
45 #include "libguile/eq.h"
46 #include "libguile/read.h"
47 #include "libguile/strports.h"
48 #include "libguile/smob.h"
49 #include "libguile/alist.h"
50 #include "libguile/keywords.h"
51 #include "libguile/feature.h"
52
53 #include <stdio.h>
54 #include <string.h>
55
56 #if (SCM_ENABLE_DEPRECATED == 1)
57
58 /* From print.c: Internal symbol names of isyms. Deprecated in guile 1.7.0 on
59 * 2004-04-22. */
60 char *scm_isymnames[] =
61 {
62 "#@<deprecated>"
63 };
64
65
66 /* From eval.c: Error messages of the evaluator. These were deprecated in
67 * guile 1.7.0 on 2003-06-02. */
68 const char scm_s_expression[] = "missing or extra expression";
69 const char scm_s_test[] = "bad test";
70 const char scm_s_body[] = "bad body";
71 const char scm_s_bindings[] = "bad bindings";
72 const char scm_s_variable[] = "bad variable";
73 const char scm_s_clauses[] = "bad or missing clauses";
74 const char scm_s_formals[] = "bad formals";
75
76
77 SCM_REGISTER_PROC(s_substring_move_left_x, "substring-move-left!", 5, 0, 0, scm_substring_move_x);
78
79 SCM_REGISTER_PROC(s_substring_move_right_x, "substring-move-right!", 5, 0, 0, scm_substring_move_x);
80
81 SCM
82 scm_wta (SCM arg, const char *pos, const char *s_subr)
83 {
84 if (!s_subr || !*s_subr)
85 s_subr = NULL;
86 if ((~0x1fL) & (long) pos)
87 {
88 /* error string supplied. */
89 scm_misc_error (s_subr, pos, scm_list_1 (arg));
90 }
91 else
92 {
93 /* numerical error code. */
94 scm_t_bits error = (scm_t_bits) pos;
95
96 switch (error)
97 {
98 case SCM_ARGn:
99 scm_wrong_type_arg (s_subr, 0, arg);
100 case SCM_ARG1:
101 scm_wrong_type_arg (s_subr, 1, arg);
102 case SCM_ARG2:
103 scm_wrong_type_arg (s_subr, 2, arg);
104 case SCM_ARG3:
105 scm_wrong_type_arg (s_subr, 3, arg);
106 case SCM_ARG4:
107 scm_wrong_type_arg (s_subr, 4, arg);
108 case SCM_ARG5:
109 scm_wrong_type_arg (s_subr, 5, arg);
110 case SCM_ARG6:
111 scm_wrong_type_arg (s_subr, 6, arg);
112 case SCM_ARG7:
113 scm_wrong_type_arg (s_subr, 7, arg);
114 case SCM_WNA:
115 scm_wrong_num_args (arg);
116 case SCM_OUTOFRANGE:
117 scm_out_of_range (s_subr, arg);
118 case SCM_NALLOC:
119 scm_memory_error (s_subr);
120 default:
121 /* this shouldn't happen. */
122 scm_misc_error (s_subr, "Unknown error", SCM_EOL);
123 }
124 }
125 return SCM_UNSPECIFIED;
126 }
127
128 /* Module registry
129 */
130
131 /* We can't use SCM objects here. One should be able to call
132 SCM_REGISTER_MODULE from a C++ constructor for a static
133 object. This happens before main and thus before libguile is
134 initialized. */
135
136 struct moddata {
137 struct moddata *link;
138 char *module_name;
139 void *init_func;
140 };
141
142 static struct moddata *registered_mods = NULL;
143
144 void
145 scm_register_module_xxx (char *module_name, void *init_func)
146 {
147 struct moddata *md;
148
149 scm_c_issue_deprecation_warning
150 ("`scm_register_module_xxx' is deprecated. Use extensions instead.");
151
152 /* XXX - should we (and can we) DEFER_INTS here? */
153
154 for (md = registered_mods; md; md = md->link)
155 if (!strcmp (md->module_name, module_name))
156 {
157 md->init_func = init_func;
158 return;
159 }
160
161 md = (struct moddata *) malloc (sizeof (struct moddata));
162 if (md == NULL)
163 {
164 fprintf (stderr,
165 "guile: can't register module (%s): not enough memory",
166 module_name);
167 return;
168 }
169
170 md->module_name = module_name;
171 md->init_func = init_func;
172 md->link = registered_mods;
173 registered_mods = md;
174 }
175
176 SCM_DEFINE (scm_registered_modules, "c-registered-modules", 0, 0, 0,
177 (),
178 "Return a list of the object code modules that have been imported into\n"
179 "the current Guile process. Each element of the list is a pair whose\n"
180 "car is the name of the module, and whose cdr is the function handle\n"
181 "for that module's initializer function. The name is the string that\n"
182 "has been passed to scm_register_module_xxx.")
183 #define FUNC_NAME s_scm_registered_modules
184 {
185 SCM res;
186 struct moddata *md;
187
188 res = SCM_EOL;
189 for (md = registered_mods; md; md = md->link)
190 res = scm_cons (scm_cons (scm_from_locale_string (md->module_name),
191 scm_from_ulong ((unsigned long) md->init_func)),
192 res);
193 return res;
194 }
195 #undef FUNC_NAME
196
197 SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
198 (),
199 "Destroy the list of modules registered with the current Guile process.\n"
200 "The return value is unspecified. @strong{Warning:} this function does\n"
201 "not actually unlink or deallocate these modules, but only destroys the\n"
202 "records of which modules have been loaded. It should therefore be used\n"
203 "only by module bookkeeping operations.")
204 #define FUNC_NAME s_scm_clear_registered_modules
205 {
206 struct moddata *md1, *md2;
207
208 SCM_CRITICAL_SECTION_START;
209
210 for (md1 = registered_mods; md1; md1 = md2)
211 {
212 md2 = md1->link;
213 free (md1);
214 }
215 registered_mods = NULL;
216
217 SCM_CRITICAL_SECTION_END;
218 return SCM_UNSPECIFIED;
219 }
220 #undef FUNC_NAME
221
222 void
223 scm_remember (SCM *ptr)
224 {
225 scm_c_issue_deprecation_warning ("`scm_remember' is deprecated. "
226 "Use the `scm_remember_upto_here*' family of functions instead.");
227 }
228
229 SCM
230 scm_protect_object (SCM obj)
231 {
232 scm_c_issue_deprecation_warning ("`scm_protect_object' is deprecated. "
233 "Use `scm_gc_protect_object' instead.");
234 return scm_gc_protect_object (obj);
235 }
236
237 SCM
238 scm_unprotect_object (SCM obj)
239 {
240 scm_c_issue_deprecation_warning ("`scm_unprotect_object' is deprecated. "
241 "Use `scm_gc_unprotect_object' instead.");
242 return scm_gc_unprotect_object (obj);
243 }
244
245 SCM_SYMBOL (scm_sym_app, "app");
246 SCM_SYMBOL (scm_sym_modules, "modules");
247 static SCM module_prefix = SCM_BOOL_F;
248 static SCM make_modules_in_var;
249 static SCM beautify_user_module_x_var;
250 static SCM try_module_autoload_var;
251
252 static void
253 init_module_stuff ()
254 {
255 #define PERM(x) scm_permanent_object(x)
256
257 if (module_prefix == SCM_BOOL_F)
258 {
259 module_prefix = PERM (scm_list_2 (scm_sym_app, scm_sym_modules));
260 make_modules_in_var = PERM (scm_c_lookup ("make-modules-in"));
261 beautify_user_module_x_var =
262 PERM (scm_c_lookup ("beautify-user-module!"));
263 try_module_autoload_var = PERM (scm_c_lookup ("try-module-autoload"));
264 }
265 }
266
267 SCM
268 scm_the_root_module ()
269 {
270 init_module_stuff ();
271 scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. "
272 "Use `scm_c_resolve_module (\"guile\")' "
273 "instead.");
274
275 return scm_c_resolve_module ("guile");
276 }
277
278 static SCM
279 scm_module_full_name (SCM name)
280 {
281 init_module_stuff ();
282 if (scm_is_eq (SCM_CAR (name), scm_sym_app))
283 return name;
284 else
285 return scm_append (scm_list_2 (module_prefix, name));
286 }
287
288 SCM
289 scm_make_module (SCM name)
290 {
291 init_module_stuff ();
292 scm_c_issue_deprecation_warning ("`scm_make_module' is deprecated. "
293 "Use `scm_c_define_module instead.");
294
295 return scm_call_2 (SCM_VARIABLE_REF (make_modules_in_var),
296 scm_the_root_module (),
297 scm_module_full_name (name));
298 }
299
300 SCM
301 scm_ensure_user_module (SCM module)
302 {
303 init_module_stuff ();
304 scm_c_issue_deprecation_warning ("`scm_ensure_user_module' is deprecated. "
305 "Use `scm_c_define_module instead.");
306
307 scm_call_1 (SCM_VARIABLE_REF (beautify_user_module_x_var), module);
308 return SCM_UNSPECIFIED;
309 }
310
311 SCM
312 scm_load_scheme_module (SCM name)
313 {
314 init_module_stuff ();
315 scm_c_issue_deprecation_warning ("`scm_load_scheme_module' is deprecated. "
316 "Use `scm_c_resolve_module instead.");
317
318 return scm_call_1 (SCM_VARIABLE_REF (try_module_autoload_var), name);
319 }
320
321 /* This is implemented in C solely for SCM_COERCE_OUTPORT ... */
322
323 static void
324 maybe_close_port (void *data, SCM port)
325 {
326 SCM except_set = (SCM) data;
327
328 while (!scm_is_null (except_set))
329 {
330 SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except_set));
331 if (scm_is_eq (p, port))
332 return;
333 except_set = SCM_CDR (except_set);
334 }
335
336 scm_close_port (port);
337 }
338
339 SCM_DEFINE (scm_close_all_ports_except, "close-all-ports-except", 0, 0, 1,
340 (SCM ports),
341 "[DEPRECATED] Close all open file ports used by the interpreter\n"
342 "except for those supplied as arguments. This procedure\n"
343 "was intended to be used before an exec call to close file descriptors\n"
344 "which are not needed in the new process. However it has the\n"
345 "undesirable side effect of flushing buffers, so it's deprecated.\n"
346 "Use port-for-each instead.")
347 #define FUNC_NAME s_scm_close_all_ports_except
348 {
349 SCM p;
350 SCM_VALIDATE_REST_ARGUMENT (ports);
351
352 for (p = ports; !scm_is_null (p); p = SCM_CDR (p))
353 SCM_VALIDATE_OPPORT (SCM_ARG1, SCM_COERCE_OUTPORT (SCM_CAR (p)));
354
355 scm_c_port_for_each (maybe_close_port, ports);
356
357 return SCM_UNSPECIFIED;
358 }
359 #undef FUNC_NAME
360
361 SCM_DEFINE (scm_variable_set_name_hint, "variable-set-name-hint!", 2, 0, 0,
362 (SCM var, SCM hint),
363 "Do not use this function.")
364 #define FUNC_NAME s_scm_variable_set_name_hint
365 {
366 SCM_VALIDATE_VARIABLE (1, var);
367 SCM_VALIDATE_SYMBOL (2, hint);
368 scm_c_issue_deprecation_warning
369 ("'variable-set-name-hint!' is deprecated. Do not use it.");
370 return SCM_UNSPECIFIED;
371 }
372 #undef FUNC_NAME
373
374 SCM_DEFINE (scm_builtin_variable, "builtin-variable", 1, 0, 0,
375 (SCM name),
376 "Do not use this function.")
377 #define FUNC_NAME s_scm_builtin_variable
378 {
379 SCM_VALIDATE_SYMBOL (1,name);
380 scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. "
381 "Use module system operations instead.");
382 return scm_sym2var (name, SCM_BOOL_F, SCM_BOOL_T);
383 }
384 #undef FUNC_NAME
385
386 SCM
387 scm_makstr (size_t len, int dummy)
388 {
389 scm_c_issue_deprecation_warning
390 ("'scm_makstr' is deprecated. Use 'scm_c_make_string' instead.");
391 return scm_c_make_string (len, SCM_UNDEFINED);
392 }
393
394 SCM
395 scm_makfromstr (const char *src, size_t len, int dummy SCM_UNUSED)
396 {
397 scm_c_issue_deprecation_warning ("`scm_makfromstr' is deprecated. "
398 "Use `scm_from_locale_stringn' instead.");
399
400 return scm_from_locale_stringn (src, len);
401 }
402
403 SCM
404 scm_internal_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
405 {
406 scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. "
407 "Use `scm_c_with_fluids' instead.");
408
409 return scm_c_with_fluids (fluids, values, cproc, cdata);
410 }
411
412 SCM
413 scm_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
414 {
415 scm_c_issue_deprecation_warning
416 ("`scm_make_gsubr' is deprecated. Use `scm_c_define_gsubr' instead.");
417
418 return scm_c_define_gsubr (name, req, opt, rst, fcn);
419 }
420
421 SCM
422 scm_make_gsubr_with_generic (const char *name,
423 int req, int opt, int rst,
424 SCM (*fcn)(), SCM *gf)
425 {
426 scm_c_issue_deprecation_warning
427 ("`scm_make_gsubr_with_generic' is deprecated. "
428 "Use `scm_c_define_gsubr_with_generic' instead.");
429
430 return scm_c_define_gsubr_with_generic (name, req, opt, rst, fcn, gf);
431 }
432
433 SCM
434 scm_create_hook (const char *name, int n_args)
435 {
436 scm_c_issue_deprecation_warning
437 ("'scm_create_hook' is deprecated. "
438 "Use 'scm_make_hook' and 'scm_c_define' instead.");
439 {
440 SCM hook = scm_make_hook (scm_from_int (n_args));
441 scm_c_define (name, hook);
442 return scm_permanent_object (hook);
443 }
444 }
445
446 SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0,
447 (SCM x, SCM lst),
448 "This procedure behaves like @code{memq}, but does no type or error checking.\n"
449 "Its use is recommended only in writing Guile internals,\n"
450 "not for high-level Scheme programs.")
451 #define FUNC_NAME s_scm_sloppy_memq
452 {
453 scm_c_issue_deprecation_warning
454 ("'sloppy-memq' is deprecated. Use 'memq' instead.");
455
456 for(; scm_is_pair (lst); lst = SCM_CDR(lst))
457 {
458 if (scm_is_eq (SCM_CAR (lst), x))
459 return lst;
460 }
461 return lst;
462 }
463 #undef FUNC_NAME
464
465
466 SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0,
467 (SCM x, SCM lst),
468 "This procedure behaves like @code{memv}, but does no type or error checking.\n"
469 "Its use is recommended only in writing Guile internals,\n"
470 "not for high-level Scheme programs.")
471 #define FUNC_NAME s_scm_sloppy_memv
472 {
473 scm_c_issue_deprecation_warning
474 ("'sloppy-memv' is deprecated. Use 'memv' instead.");
475
476 for(; scm_is_pair (lst); lst = SCM_CDR(lst))
477 {
478 if (! scm_is_false (scm_eqv_p (SCM_CAR (lst), x)))
479 return lst;
480 }
481 return lst;
482 }
483 #undef FUNC_NAME
484
485
486 SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0,
487 (SCM x, SCM lst),
488 "This procedure behaves like @code{member}, but does no type or error checking.\n"
489 "Its use is recommended only in writing Guile internals,\n"
490 "not for high-level Scheme programs.")
491 #define FUNC_NAME s_scm_sloppy_member
492 {
493 scm_c_issue_deprecation_warning
494 ("'sloppy-member' is deprecated. Use 'member' instead.");
495
496 for(; scm_is_pair (lst); lst = SCM_CDR(lst))
497 {
498 if (! scm_is_false (scm_equal_p (SCM_CAR (lst), x)))
499 return lst;
500 }
501 return lst;
502 }
503 #undef FUNC_NAME
504
505 SCM_SYMBOL (scm_end_of_file_key, "end-of-file");
506
507 SCM_DEFINE (scm_read_and_eval_x, "read-and-eval!", 0, 1, 0,
508 (SCM port),
509 "Read a form from @var{port} (standard input by default), and evaluate it\n"
510 "(memoizing it in the process) in the top-level environment. If no data\n"
511 "is left to be read from @var{port}, an @code{end-of-file} error is\n"
512 "signalled.")
513 #define FUNC_NAME s_scm_read_and_eval_x
514 {
515 SCM form;
516
517 scm_c_issue_deprecation_warning
518 ("'read-and-eval!' is deprecated. Use 'read' and 'eval' instead.");
519
520 form = scm_read (port);
521 if (SCM_EOF_OBJECT_P (form))
522 scm_ithrow (scm_end_of_file_key, SCM_EOL, 1);
523 return scm_eval_x (form, scm_current_module ());
524 }
525 #undef FUNC_NAME
526
527 SCM
528 scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
529 {
530 scm_c_issue_deprecation_warning
531 ("`scm_make_subr_opt' is deprecated. Use `scm_c_make_subr' or "
532 "`scm_c_define_subr' instead.");
533
534 if (set)
535 return scm_c_define_subr (name, type, fcn);
536 else
537 return scm_c_make_subr (name, type, fcn);
538 }
539
540 SCM
541 scm_make_subr (const char *name, int type, SCM (*fcn) ())
542 {
543 scm_c_issue_deprecation_warning
544 ("`scm_make_subr' is deprecated. Use `scm_c_define_subr' instead.");
545
546 return scm_c_define_subr (name, type, fcn);
547 }
548
549 SCM
550 scm_make_subr_with_generic (const char *name, int type, SCM (*fcn) (), SCM *gf)
551 {
552 scm_c_issue_deprecation_warning
553 ("`scm_make_subr_with_generic' is deprecated. Use "
554 "`scm_c_define_subr_with_generic' instead.");
555
556 return scm_c_define_subr_with_generic (name, type, fcn, gf);
557 }
558
559 /* Call thunk(closure) underneath a top-level error handler.
560 * If an error occurs, pass the exitval through err_filter and return it.
561 * If no error occurs, return the value of thunk.
562 */
563
564 #ifdef _UNICOS
565 typedef int setjmp_type;
566 #else
567 typedef long setjmp_type;
568 #endif
569
570 struct cce_handler_data {
571 SCM (*err_filter) ();
572 void *closure;
573 };
574
575 static SCM
576 invoke_err_filter (void *d, SCM tag, SCM args)
577 {
578 struct cce_handler_data *data = (struct cce_handler_data *)d;
579 return data->err_filter (SCM_BOOL_F, data->closure);
580 }
581
582 SCM
583 scm_call_catching_errors (SCM (*thunk)(), SCM (*err_filter)(), void *closure)
584 {
585 scm_c_issue_deprecation_warning
586 ("'scm_call_catching_errors' is deprecated. "
587 "Use 'scm_internal_catch' instead.");
588
589 {
590 struct cce_handler_data data;
591 data.err_filter = err_filter;
592 data.closure = closure;
593 return scm_internal_catch (SCM_BOOL_T,
594 (scm_t_catch_body)thunk, closure,
595 (scm_t_catch_handler)invoke_err_filter, &data);
596 }
597 }
598
599 long
600 scm_make_smob_type_mfpe (char *name, size_t size,
601 SCM (*mark) (SCM),
602 size_t (*free) (SCM),
603 int (*print) (SCM, SCM, scm_print_state *),
604 SCM (*equalp) (SCM, SCM))
605 {
606 scm_c_issue_deprecation_warning
607 ("'scm_make_smob_type_mfpe' is deprecated. "
608 "Use 'scm_make_smob_type' plus 'scm_set_smob_*' instead.");
609
610 {
611 long answer = scm_make_smob_type (name, size);
612 scm_set_smob_mfpe (answer, mark, free, print, equalp);
613 return answer;
614 }
615 }
616
617 void
618 scm_set_smob_mfpe (long tc,
619 SCM (*mark) (SCM),
620 size_t (*free) (SCM),
621 int (*print) (SCM, SCM, scm_print_state *),
622 SCM (*equalp) (SCM, SCM))
623 {
624 scm_c_issue_deprecation_warning
625 ("'scm_set_smob_mfpe' is deprecated. "
626 "Use 'scm_set_smob_mark' instead, for example.");
627
628 if (mark) scm_set_smob_mark (tc, mark);
629 if (free) scm_set_smob_free (tc, free);
630 if (print) scm_set_smob_print (tc, print);
631 if (equalp) scm_set_smob_equalp (tc, equalp);
632 }
633
634 SCM
635 scm_read_0str (char *expr)
636 {
637 scm_c_issue_deprecation_warning
638 ("scm_read_0str is deprecated. Use scm_c_read_string instead.");
639
640 return scm_c_read_string (expr);
641 }
642
643 SCM
644 scm_eval_0str (const char *expr)
645 {
646 scm_c_issue_deprecation_warning
647 ("scm_eval_0str is deprecated. Use scm_c_eval_string instead.");
648
649 return scm_c_eval_string (expr);
650 }
651
652 SCM
653 scm_strprint_obj (SCM obj)
654 {
655 scm_c_issue_deprecation_warning
656 ("scm_strprint_obj is deprecated. Use scm_object_to_string instead.");
657 return scm_object_to_string (obj, SCM_UNDEFINED);
658 }
659
660 char *
661 scm_i_object_chars (SCM obj)
662 {
663 scm_c_issue_deprecation_warning
664 ("SCM_CHARS is deprecated. See the manual for alternatives.");
665 if (SCM_STRINGP (obj))
666 return SCM_STRING_CHARS (obj);
667 if (SCM_SYMBOLP (obj))
668 return SCM_SYMBOL_CHARS (obj);
669 abort ();
670 }
671
672 long
673 scm_i_object_length (SCM obj)
674 {
675 scm_c_issue_deprecation_warning
676 ("SCM_LENGTH is deprecated. "
677 "Use scm_c_string_length instead, for example, or see the manual.");
678 if (SCM_STRINGP (obj))
679 return SCM_STRING_LENGTH (obj);
680 if (SCM_SYMBOLP (obj))
681 return SCM_SYMBOL_LENGTH (obj);
682 if (SCM_VECTORP (obj))
683 return SCM_VECTOR_LENGTH (obj);
684 abort ();
685 }
686
687 SCM
688 scm_sym2ovcell_soft (SCM sym, SCM obarray)
689 {
690 SCM lsym, z;
691 size_t hash = scm_i_symbol_hash (sym) % SCM_VECTOR_LENGTH (obarray);
692
693 scm_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
694 "Use hashtables instead.");
695
696 SCM_CRITICAL_SECTION_START;
697 for (lsym = SCM_VECTOR_REF (obarray, hash);
698 SCM_NIMP (lsym);
699 lsym = SCM_CDR (lsym))
700 {
701 z = SCM_CAR (lsym);
702 if (scm_is_eq (SCM_CAR (z), sym))
703 {
704 SCM_CRITICAL_SECTION_END;
705 return z;
706 }
707 }
708 SCM_CRITICAL_SECTION_END;
709 return SCM_BOOL_F;
710 }
711
712
713 SCM
714 scm_sym2ovcell (SCM sym, SCM obarray)
715 #define FUNC_NAME "scm_sym2ovcell"
716 {
717 SCM answer;
718
719 scm_c_issue_deprecation_warning ("`scm_sym2ovcell' is deprecated. "
720 "Use hashtables instead.");
721
722 answer = scm_sym2ovcell_soft (sym, obarray);
723 if (scm_is_true (answer))
724 return answer;
725 SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym));
726 return SCM_UNSPECIFIED; /* not reached */
727 }
728 #undef FUNC_NAME
729
730
731 /* Intern a symbol whose name is the LEN characters at NAME in OBARRAY.
732
733 OBARRAY should be a vector of lists, indexed by the name's hash
734 value, modulo OBARRAY's length. Each list has the form
735 ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the
736 value associated with that symbol (in the current module? in the
737 system module?)
738
739 To "intern" a symbol means: if OBARRAY already contains a symbol by
740 that name, return its (SYMBOL . VALUE) pair; otherwise, create a
741 new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the
742 appropriate list of the OBARRAY, and return the pair.
743
744 If softness is non-zero, don't create a symbol if it isn't already
745 in OBARRAY; instead, just return #f.
746
747 If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
748 return (SYMBOL . SCM_UNDEFINED). */
749
750
751 SCM
752 scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int softness)
753 {
754 SCM symbol = scm_from_locale_symboln (name, len);
755 size_t raw_hash = scm_i_symbol_hash (symbol);
756 size_t hash;
757 SCM lsym;
758
759 scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
760 "Use hashtables instead.");
761
762 if (scm_is_false (obarray))
763 {
764 if (softness)
765 return SCM_BOOL_F;
766 else
767 return scm_cons (symbol, SCM_UNDEFINED);
768 }
769
770 hash = raw_hash % SCM_VECTOR_LENGTH (obarray);
771
772 for (lsym = SCM_VECTOR_REF(obarray, hash);
773 SCM_NIMP (lsym); lsym = SCM_CDR (lsym))
774 {
775 SCM a = SCM_CAR (lsym);
776 SCM z = SCM_CAR (a);
777 if (scm_is_eq (z, symbol))
778 return a;
779 }
780
781 if (softness)
782 {
783 return SCM_BOOL_F;
784 }
785 else
786 {
787 SCM cell = scm_cons (symbol, SCM_UNDEFINED);
788 SCM slot = SCM_VECTOR_REF (obarray, hash);
789
790 SCM_VECTOR_SET (obarray, hash, scm_cons (cell, slot));
791
792 return cell;
793 }
794 }
795
796
797 SCM
798 scm_intern_obarray (const char *name,size_t len,SCM obarray)
799 {
800 scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
801 "Use hashtables instead.");
802
803 return scm_intern_obarray_soft (name, len, obarray, 0);
804 }
805
806 /* Lookup the value of the symbol named by the nul-terminated string
807 NAME in the current module. */
808 SCM
809 scm_symbol_value0 (const char *name)
810 {
811 scm_c_issue_deprecation_warning ("`scm_symbol_value0' is deprecated. "
812 "Use `scm_lookup' instead.");
813
814 return scm_variable_ref (scm_c_lookup (name));
815 }
816
817 SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
818 (SCM o, SCM s, SCM softp),
819 "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
820 "@var{string}.\n\n"
821 "If @var{obarray} is @code{#f}, use the default system symbol table. If\n"
822 "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
823 "symbol table; merely return the pair (@var{symbol}\n"
824 ". @var{#<undefined>}).\n\n"
825 "The @var{soft?} argument determines whether new symbol table entries\n"
826 "should be created when the specified symbol is not already present in\n"
827 "@var{obarray}. If @var{soft?} is specified and is a true value, then\n"
828 "new entries should not be added for symbols not already present in the\n"
829 "table; instead, simply return @code{#f}.")
830 #define FUNC_NAME s_scm_string_to_obarray_symbol
831 {
832 SCM vcell;
833 SCM answer;
834 int softness;
835
836 SCM_VALIDATE_STRING (2, s);
837 SCM_ASSERT (scm_is_bool (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME);
838
839 scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
840 "Use hashtables instead.");
841
842 softness = (!SCM_UNBNDP (softp) && scm_is_true(softp));
843 /* iron out some screwy calling conventions */
844 if (scm_is_false (o))
845 {
846 /* nothing interesting to do here. */
847 return scm_string_to_symbol (s);
848 }
849 else if (scm_is_eq (o, SCM_BOOL_T))
850 o = SCM_BOOL_F;
851
852 vcell = scm_intern_obarray_soft (scm_i_string_chars (s),
853 scm_i_string_length (s),
854 o,
855 softness);
856 if (scm_is_false (vcell))
857 return vcell;
858 answer = SCM_CAR (vcell);
859 return answer;
860 }
861 #undef FUNC_NAME
862
863 SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0,
864 (SCM o, SCM s),
865 "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n"
866 "unspecified initial value. The symbol table is not modified if a symbol\n"
867 "with this name is already present.")
868 #define FUNC_NAME s_scm_intern_symbol
869 {
870 size_t hval;
871 SCM_VALIDATE_SYMBOL (2,s);
872 if (scm_is_false (o))
873 return SCM_UNSPECIFIED;
874
875 scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
876 "Use hashtables instead.");
877
878 SCM_VALIDATE_VECTOR (1,o);
879 hval = scm_i_symbol_hash (s) % SCM_VECTOR_LENGTH (o);
880 /* If the symbol is already interned, simply return. */
881 SCM_CRITICAL_SECTION_START;
882 {
883 SCM lsym;
884 SCM sym;
885 for (lsym = SCM_VECTOR_REF (o, hval);
886 SCM_NIMP (lsym);
887 lsym = SCM_CDR (lsym))
888 {
889 sym = SCM_CAR (lsym);
890 if (scm_is_eq (SCM_CAR (sym), s))
891 {
892 SCM_CRITICAL_SECTION_END;
893 return SCM_UNSPECIFIED;
894 }
895 }
896 SCM_VECTOR_SET (o, hval,
897 scm_acons (s, SCM_UNDEFINED,
898 SCM_VECTOR_REF (o, hval)));
899 }
900 SCM_CRITICAL_SECTION_END;
901 return SCM_UNSPECIFIED;
902 }
903 #undef FUNC_NAME
904
905 SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0,
906 (SCM o, SCM s),
907 "Remove the symbol with name @var{string} from @var{obarray}. This\n"
908 "function returns @code{#t} if the symbol was present and @code{#f}\n"
909 "otherwise.")
910 #define FUNC_NAME s_scm_unintern_symbol
911 {
912 size_t hval;
913
914 scm_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
915 "Use hashtables instead.");
916
917 SCM_VALIDATE_SYMBOL (2,s);
918 if (scm_is_false (o))
919 return SCM_BOOL_F;
920 SCM_VALIDATE_VECTOR (1,o);
921 hval = scm_i_symbol_hash (s) % SCM_VECTOR_LENGTH (o);
922 SCM_CRITICAL_SECTION_START;
923 {
924 SCM lsym_follow;
925 SCM lsym;
926 SCM sym;
927 for (lsym = SCM_VECTOR_REF (o, hval), lsym_follow = SCM_BOOL_F;
928 SCM_NIMP (lsym);
929 lsym_follow = lsym, lsym = SCM_CDR (lsym))
930 {
931 sym = SCM_CAR (lsym);
932 if (scm_is_eq (SCM_CAR (sym), s))
933 {
934 /* Found the symbol to unintern. */
935 if (scm_is_false (lsym_follow))
936 SCM_VECTOR_SET (o, hval, lsym);
937 else
938 SCM_SETCDR (lsym_follow, SCM_CDR(lsym));
939 SCM_CRITICAL_SECTION_END;
940 return SCM_BOOL_T;
941 }
942 }
943 }
944 SCM_CRITICAL_SECTION_END;
945 return SCM_BOOL_F;
946 }
947 #undef FUNC_NAME
948
949 SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0,
950 (SCM o, SCM s),
951 "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
952 "return the value to which it is bound. If @var{obarray} is @code{#f},\n"
953 "use the global symbol table. If @var{string} is not interned in\n"
954 "@var{obarray}, an error is signalled.")
955 #define FUNC_NAME s_scm_symbol_binding
956 {
957 SCM vcell;
958
959 scm_c_issue_deprecation_warning ("`symbol-binding' is deprecated. "
960 "Use hashtables instead.");
961
962 SCM_VALIDATE_SYMBOL (2,s);
963 if (scm_is_false (o))
964 return scm_variable_ref (scm_lookup (s));
965 SCM_VALIDATE_VECTOR (1,o);
966 vcell = scm_sym2ovcell (s, o);
967 return SCM_CDR(vcell);
968 }
969 #undef FUNC_NAME
970
971 #if 0
972 SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 2, 0, 0,
973 (SCM o, SCM s),
974 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
975 "@var{string}, and @code{#f} otherwise.")
976 #define FUNC_NAME s_scm_symbol_interned_p
977 {
978 SCM vcell;
979
980 scm_c_issue_deprecation_warning ("`symbol-interned?' is deprecated. "
981 "Use hashtables instead.");
982
983 SCM_VALIDATE_SYMBOL (2,s);
984 if (scm_is_false (o))
985 {
986 SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F);
987 if (var != SCM_BOOL_F)
988 return SCM_BOOL_T;
989 return SCM_BOOL_F;
990 }
991 SCM_VALIDATE_VECTOR (1,o);
992 vcell = scm_sym2ovcell_soft (s, o);
993 return (SCM_NIMP(vcell)
994 ? SCM_BOOL_T
995 : SCM_BOOL_F);
996 }
997 #undef FUNC_NAME
998 #endif
999
1000 SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0,
1001 (SCM o, SCM s),
1002 "Return @code{#t} if @var{obarray} contains a symbol with name\n"
1003 "@var{string} bound to a defined value. This differs from\n"
1004 "@var{symbol-interned?} in that the mere mention of a symbol\n"
1005 "usually causes it to be interned; @code{symbol-bound?}\n"
1006 "determines whether a symbol has been given any meaningful\n"
1007 "value.")
1008 #define FUNC_NAME s_scm_symbol_bound_p
1009 {
1010 SCM vcell;
1011
1012 scm_c_issue_deprecation_warning ("`symbol-bound?' is deprecated. "
1013 "Use hashtables instead.");
1014
1015 SCM_VALIDATE_SYMBOL (2,s);
1016 if (scm_is_false (o))
1017 {
1018 SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F);
1019 if (SCM_VARIABLEP(var) && !SCM_UNBNDP(SCM_VARIABLE_REF(var)))
1020 return SCM_BOOL_T;
1021 return SCM_BOOL_F;
1022 }
1023 SCM_VALIDATE_VECTOR (1,o);
1024 vcell = scm_sym2ovcell_soft (s, o);
1025 return scm_from_bool (SCM_NIMP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell)));
1026 }
1027 #undef FUNC_NAME
1028
1029
1030 SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0,
1031 (SCM o, SCM s, SCM v),
1032 "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n"
1033 "it to @var{value}. An error is signalled if @var{string} is not present\n"
1034 "in @var{obarray}.")
1035 #define FUNC_NAME s_scm_symbol_set_x
1036 {
1037 SCM vcell;
1038
1039 scm_c_issue_deprecation_warning ("`symbol-set!' is deprecated. "
1040 "Use the module system instead.");
1041
1042 SCM_VALIDATE_SYMBOL (2,s);
1043 if (scm_is_false (o))
1044 {
1045 scm_define (s, v);
1046 return SCM_UNSPECIFIED;
1047 }
1048 SCM_VALIDATE_VECTOR (1,o);
1049 vcell = scm_sym2ovcell (s, o);
1050 SCM_SETCDR (vcell, v);
1051 return SCM_UNSPECIFIED;
1052 }
1053 #undef FUNC_NAME
1054
1055 #define MAX_PREFIX_LENGTH 30
1056
1057 static int gentemp_counter;
1058
1059 SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
1060 (SCM prefix, SCM obarray),
1061 "Create a new symbol with a name unique in an obarray.\n"
1062 "The name is constructed from an optional string @var{prefix}\n"
1063 "and a counter value. The default prefix is @code{t}. The\n"
1064 "@var{obarray} is specified as a second optional argument.\n"
1065 "Default is the system obarray where all normal symbols are\n"
1066 "interned. The counter is increased by 1 at each\n"
1067 "call. There is no provision for resetting the counter.")
1068 #define FUNC_NAME s_scm_gentemp
1069 {
1070 char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
1071 char *name = buf;
1072 int len, n_digits;
1073
1074 scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
1075 "Use `gensym' instead.");
1076
1077 if (SCM_UNBNDP (prefix))
1078 {
1079 name[0] = 't';
1080 len = 1;
1081 }
1082 else
1083 {
1084 SCM_VALIDATE_STRING (1, prefix);
1085 len = scm_i_string_length (prefix);
1086 if (len > MAX_PREFIX_LENGTH)
1087 name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
1088 strncpy (name, scm_i_string_chars (prefix), len);
1089 }
1090
1091 if (SCM_UNBNDP (obarray))
1092 return scm_gensym (prefix);
1093 else
1094 SCM_ASSERT ((scm_is_vector (obarray) || SCM_I_WVECTP (obarray)),
1095 obarray,
1096 SCM_ARG2,
1097 FUNC_NAME);
1098 do
1099 n_digits = scm_iint2str (gentemp_counter++, 10, &name[len]);
1100 while (scm_is_true (scm_intern_obarray_soft (name,
1101 len + n_digits,
1102 obarray,
1103 1)));
1104 {
1105 SCM vcell = scm_intern_obarray_soft (name,
1106 len + n_digits,
1107 obarray,
1108 0);
1109 if (name != buf)
1110 scm_must_free (name);
1111 return SCM_CAR (vcell);
1112 }
1113 }
1114 #undef FUNC_NAME
1115
1116 SCM
1117 scm_i_makinum (scm_t_signed_bits val)
1118 {
1119 scm_c_issue_deprecation_warning
1120 ("SCM_MAKINUM is deprecated. Use scm_from_int or similar instead.");
1121 return SCM_I_MAKINUM (val);
1122 }
1123
1124 int
1125 scm_i_inump (SCM obj)
1126 {
1127 scm_c_issue_deprecation_warning
1128 ("SCM_INUMP is deprecated. Use scm_is_integer or similar instead.");
1129 return SCM_I_INUMP (obj);
1130 }
1131
1132 scm_t_signed_bits
1133 scm_i_inum (SCM obj)
1134 {
1135 scm_c_issue_deprecation_warning
1136 ("SCM_INUM is deprecated. Use scm_to_int or similar instead.");
1137 return scm_to_intmax (obj);
1138 }
1139
1140 char *
1141 scm_c_string2str (SCM obj, char *str, size_t *lenp)
1142 {
1143 scm_c_issue_deprecation_warning
1144 ("scm_c_string2str is deprecated. Use scm_to_locale_stringbuf or similar instead.");
1145
1146 if (str == NULL)
1147 {
1148 char *result = scm_to_locale_string (obj);
1149 if (lenp)
1150 *lenp = scm_i_string_length (obj);
1151 return result;
1152 }
1153 else
1154 {
1155 /* Pray that STR is large enough.
1156 */
1157 size_t len = scm_to_locale_stringbuf (obj, str, SCM_I_SIZE_MAX);
1158 str[len] = '\0';
1159 if (lenp)
1160 *lenp = len;
1161 return str;
1162 }
1163 }
1164
1165 char *
1166 scm_c_substring2str (SCM obj, char *str, size_t start, size_t len)
1167 {
1168 scm_c_issue_deprecation_warning
1169 ("scm_c_substring2str is deprecated. Use scm_substring plus scm_to_locale_stringbuf instead.");
1170
1171 if (start)
1172 obj = scm_substring (obj, scm_from_size_t (start), SCM_UNDEFINED);
1173
1174 scm_to_locale_stringbuf (obj, str, len);
1175 return str;
1176 }
1177
1178 /* Converts the given Scheme symbol OBJ into a C string, containing a copy
1179 of OBJ's content with a trailing null byte. If LENP is non-NULL, set
1180 *LENP to the string's length.
1181
1182 When STR is non-NULL it receives the copy and is returned by the function,
1183 otherwise new memory is allocated and the caller is responsible for
1184 freeing it via free(). If out of memory, NULL is returned.
1185
1186 Note that Scheme symbols may contain arbitrary data, including null
1187 characters. This means that null termination is not a reliable way to
1188 determine the length of the returned value. However, the function always
1189 copies the complete contents of OBJ, and sets *LENP to the length of the
1190 scheme symbol (if LENP is non-null). */
1191 char *
1192 scm_c_symbol2str (SCM obj, char *str, size_t *lenp)
1193 {
1194 return scm_c_string2str (scm_symbol_to_string (obj), str, lenp);
1195 }
1196
1197 double
1198 scm_truncate (double x)
1199 {
1200 scm_c_issue_deprecation_warning
1201 ("scm_truncate is deprecated. Use scm_c_truncate instead.");
1202 return scm_c_truncate (x);
1203 }
1204
1205 double
1206 scm_round (double x)
1207 {
1208 scm_c_issue_deprecation_warning
1209 ("scm_round is deprecated. Use scm_c_round instead.");
1210 return scm_c_round (x);
1211 }
1212
1213 char *
1214 scm_i_deprecated_symbol_chars (SCM sym)
1215 {
1216 scm_c_issue_deprecation_warning
1217 ("SCM_SYMBOL_CHARS is deprecated. Use scm_symbol_to_string.");
1218
1219 return (char *)scm_i_symbol_chars (sym);
1220 }
1221
1222 size_t
1223 scm_i_deprecated_symbol_length (SCM sym)
1224 {
1225 scm_c_issue_deprecation_warning
1226 ("SCM_SYMBOL_LENGTH is deprecated. Use scm_symbol_to_string.");
1227 return scm_i_symbol_length (sym);
1228 }
1229
1230 int
1231 scm_i_keywordp (SCM obj)
1232 {
1233 scm_c_issue_deprecation_warning
1234 ("SCM_KEYWORDP is deprecated. Use scm_is_keyword instead.");
1235 return scm_is_keyword (obj);
1236 }
1237
1238 SCM
1239 scm_i_keywordsym (SCM keyword)
1240 {
1241 scm_c_issue_deprecation_warning
1242 ("SCM_KEYWORDSYM is deprecated. See scm_keyword_to_symbol instead.");
1243 return scm_keyword_dash_symbol (keyword);
1244 }
1245
1246 int
1247 scm_i_vectorp (SCM x)
1248 {
1249 scm_c_issue_deprecation_warning
1250 ("SCM_VECTORP is deprecated. Use scm_is_vector instead.");
1251 return SCM_I_IS_VECTOR (x);
1252 }
1253
1254 unsigned long
1255 scm_i_vector_length (SCM x)
1256 {
1257 scm_c_issue_deprecation_warning
1258 ("SCM_VECTOR_LENGTH is deprecated. Use scm_c_vector_length instead.");
1259 return SCM_I_VECTOR_LENGTH (x);
1260 }
1261
1262 const SCM *
1263 scm_i_velts (SCM x)
1264 {
1265 scm_c_issue_deprecation_warning
1266 ("SCM_VELTS is deprecated. Use scm_vector_elements instead.");
1267 return SCM_I_VECTOR_ELTS (x);
1268 }
1269
1270 SCM *
1271 scm_i_writable_velts (SCM x)
1272 {
1273 scm_c_issue_deprecation_warning
1274 ("SCM_WRITABLE_VELTS is deprecated. "
1275 "Use scm_vector_writable_elements instead.");
1276 return SCM_I_VECTOR_WELTS (x);
1277 }
1278
1279 SCM
1280 scm_i_vector_ref (SCM x, size_t idx)
1281 {
1282 scm_c_issue_deprecation_warning
1283 ("SCM_VECTOR_REF is deprecated. "
1284 "Use scm_c_vector_ref or scm_vector_elements instead.");
1285 return scm_c_vector_ref (x, idx);
1286 }
1287
1288 void
1289 scm_i_vector_set (SCM x, size_t idx, SCM val)
1290 {
1291 scm_c_issue_deprecation_warning
1292 ("SCM_VECTOR_SET is deprecated. "
1293 "Use scm_c_vector_set_x or scm_vector_writable_elements instead.");
1294 scm_c_vector_set_x (x, idx, val);
1295 }
1296
1297 SCM
1298 scm_vector_equal_p (SCM x, SCM y)
1299 {
1300 scm_c_issue_deprecation_warning
1301 ("scm_vector_euqal_p is deprecated. "
1302 "Use scm_equal_p instead.");
1303 return scm_equal_p (x, y);
1304 }
1305
1306 int
1307 scm_i_arrayp (SCM a)
1308 {
1309 scm_c_issue_deprecation_warning
1310 ("SCM_ARRAYP is deprecated. Use scm_is_array instead.");
1311 return SCM_I_ARRAYP(a) || SCM_I_ENCLOSED_ARRAYP(a);
1312 }
1313
1314 size_t
1315 scm_i_array_ndim (SCM a)
1316 {
1317 scm_c_issue_deprecation_warning
1318 ("SCM_ARRAY_NDIM is deprecated. "
1319 "Use scm_c_array_rank or scm_array_handle_rank instead.");
1320 return scm_c_array_rank (a);
1321 }
1322
1323 int
1324 scm_i_array_contp (SCM a)
1325 {
1326 scm_c_issue_deprecation_warning
1327 ("SCM_ARRAY_CONTP is deprecated. Do not use it.");
1328 return SCM_I_ARRAY_CONTP (a);
1329 }
1330
1331 scm_t_array *
1332 scm_i_array_mem (SCM a)
1333 {
1334 scm_c_issue_deprecation_warning
1335 ("SCM_ARRAY_MEM is deprecated. Do not use it.");
1336 return (scm_t_array *)SCM_I_ARRAY_MEM (a);
1337 }
1338
1339 SCM
1340 scm_i_array_v (SCM a)
1341 {
1342 /* We could use scm_shared_array_root here, but it is better to move
1343 them away from expecting vectors as the basic storage for arrays.
1344 */
1345 scm_c_issue_deprecation_warning
1346 ("SCM_ARRAY_V is deprecated. Do not use it.");
1347 return SCM_I_ARRAY_V (a);
1348 }
1349
1350 size_t
1351 scm_i_array_base (SCM a)
1352 {
1353 scm_c_issue_deprecation_warning
1354 ("SCM_ARRAY_BASE is deprecated. Do not use it.");
1355 return SCM_I_ARRAY_BASE (a);
1356 }
1357
1358 scm_t_array_dim *
1359 scm_i_array_dims (SCM a)
1360 {
1361 scm_c_issue_deprecation_warning
1362 ("SCM_ARRAY_DIMS is deprecated. Use scm_array_handle_dims instead.");
1363 return SCM_I_ARRAY_DIMS (a);
1364 }
1365
1366 SCM
1367 scm_i_cur_inp (void)
1368 {
1369 scm_c_issue_deprecation_warning
1370 ("scm_cur_inp is deprecated. Use scm_current_input_port instead.");
1371 return scm_current_input_port ();
1372 }
1373
1374 SCM
1375 scm_i_cur_outp (void)
1376 {
1377 scm_c_issue_deprecation_warning
1378 ("scm_cur_outp is deprecated. Use scm_current_output_port instead.");
1379 return scm_current_output_port ();
1380 }
1381
1382 SCM
1383 scm_i_cur_errp (void)
1384 {
1385 scm_c_issue_deprecation_warning
1386 ("scm_cur_errp is deprecated. Use scm_current_error_port instead.");
1387 return scm_current_error_port ();
1388 }
1389
1390 SCM
1391 scm_i_cur_loadp (void)
1392 {
1393 scm_c_issue_deprecation_warning
1394 ("scm_cur_loadp is deprecated. Use scm_current_load_port instead.");
1395 return scm_current_load_port ();
1396 }
1397
1398 SCM
1399 scm_i_progargs (void)
1400 {
1401 scm_c_issue_deprecation_warning
1402 ("scm_progargs is deprecated. Use scm_program_arguments instead.");
1403 return scm_program_arguments ();
1404 }
1405
1406 SCM
1407 scm_i_deprecated_dynwinds (void)
1408 {
1409 scm_c_issue_deprecation_warning
1410 ("scm_dynwinds is deprecated. Do not use it.");
1411 return scm_i_dynwinds ();
1412 }
1413
1414 scm_t_debug_frame *
1415 scm_i_deprecated_last_debug_frame (void)
1416 {
1417 scm_c_issue_deprecation_warning
1418 ("scm_last_debug_frame is deprecated. Do not use it.");
1419 return scm_i_last_debug_frame ();
1420 }
1421
1422 SCM_STACKITEM *
1423 scm_i_stack_base (void)
1424 {
1425 scm_c_issue_deprecation_warning
1426 ("scm_stack_base is deprecated. Do not use it.");
1427 return SCM_I_CURRENT_THREAD->base;
1428 }
1429
1430 int
1431 scm_i_fluidp (SCM x)
1432 {
1433 scm_c_issue_deprecation_warning
1434 ("SCM_FLUIDP is deprecated. Use scm_is_fluid instead.");
1435 return scm_is_fluid (x);
1436 }
1437
1438 void
1439 scm_i_defer_ints_etc ()
1440 {
1441 scm_c_issue_deprecation_warning
1442 ("SCM_DEFER_INTS etc are deprecated. "
1443 "Use a mutex instead if appropriate.");
1444 }
1445
1446 SCM
1447 scm_guard (SCM guardian, SCM obj, int throw_p)
1448 {
1449 scm_c_issue_deprecation_warning
1450 ("scm_guard is deprecated. Use scm_call_1 instead.");
1451
1452 return scm_call_1 (guardian, obj);
1453 }
1454
1455 SCM
1456 scm_get_one_zombie (SCM guardian)
1457 {
1458 scm_c_issue_deprecation_warning
1459 ("scm_guard is deprecated. Use scm_call_0 instead.");
1460
1461 return scm_call_0 (guardian);
1462 }
1463
1464 SCM_DEFINE (scm_guardian_destroyed_p, "guardian-destroyed?", 1, 0, 0,
1465 (SCM guardian),
1466 "Return @code{#t} if @var{guardian} has been destroyed, otherwise @code{#f}.")
1467 #define FUNC_NAME s_scm_guardian_destroyed_p
1468 {
1469 scm_c_issue_deprecation_warning
1470 ("'guardian-destroyed?' is deprecated.");
1471 return SCM_BOOL_F;
1472 }
1473 #undef FUNC_NAME
1474
1475 SCM_DEFINE (scm_guardian_greedy_p, "guardian-greedy?", 1, 0, 0,
1476 (SCM guardian),
1477 "Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.")
1478 #define FUNC_NAME s_scm_guardian_greedy_p
1479 {
1480 scm_c_issue_deprecation_warning
1481 ("'guardian-greedy?' is deprecated.");
1482 return SCM_BOOL_F;
1483 }
1484 #undef FUNC_NAME
1485
1486 SCM_DEFINE (scm_destroy_guardian_x, "destroy-guardian!", 1, 0, 0,
1487 (SCM guardian),
1488 "Destroys @var{guardian}, by making it impossible to put any more\n"
1489 "objects in it or get any objects from it. It also unguards any\n"
1490 "objects guarded by @var{guardian}.")
1491 #define FUNC_NAME s_scm_destroy_guardian_x
1492 {
1493 scm_c_issue_deprecation_warning
1494 ("'destroy-guardian!' is deprecated and ineffective.");
1495 return SCM_UNSPECIFIED;
1496 }
1497 #undef FUNC_NAME
1498
1499 void
1500 scm_i_init_deprecated ()
1501 {
1502 #include "libguile/deprecated.x"
1503 }
1504
1505 #endif