guile18/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