guile/libguile/deprecated.c

/* Copyright 2003-2004,2006,2008-2018,2020,2021,2022,2025
     Free Software Foundation, Inc.

   This file is part of Guile.

   Guile is free software: you can redistribute it and/or modify it
   under the terms of the GNU Lesser General Public License as published
   by the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.

   Guile is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
   License for more details.

   You should have received a copy of the GNU Lesser General Public
   License along with Guile.  If not, see
   <https://www.gnu.org/licenses/>.  */

#ifdef HAVE_CONFIG_H
# include <config.h>
#endif

#include <stdio.h>

#define SCM_BUILDING_DEPRECATED_CODE

#include "deprecation.h"
#include "eval.h"
#include "gsubr.h"
#include "keywords.h"
#include "modules.h"
#include "numbers.h"
#include "ports.h"
#include "symbols.h"
#include "threads-internal.h"
#include "variable.h"
#include "vectors.h"

#include "deprecated.h"

#if (SCM_ENABLE_DEPRECATED == 1)



/* Deprecated functions go here.  */
static SCM make_guardian_var;

static void
init_make_guardian_var (void)
{
  make_guardian_var = scm_c_public_lookup ("ice-9 guardians", "make-guardian");
}

SCM
scm_make_guardian (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_i_pthread_once (&once, init_make_guardian_var);

  scm_c_issue_deprecation_warning
    ("The scm_make_guardian C interface is deprecated.  Invoke the Scheme "
     "make-guardian procedure from (ice-9 guardians) instead.");

  return scm_call_0 (scm_variable_ref (make_guardian_var));
}



static SCM make_weak_vector_var;
static SCM weak_vector_var;
static SCM weak_vector_p_var;
static SCM weak_vector_length_var;
static SCM weak_vector_ref_var;
static SCM weak_vector_set_x_var;

static void
init_weak_vector_vars (void)
{
  make_weak_vector_var =
    scm_c_public_lookup ("ice-9 weak-vector", "make-weak-vector");
  weak_vector_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector");
  weak_vector_p_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector?");
  weak_vector_length_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-length");
  weak_vector_ref_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-ref");
  weak_vector_set_x_var =
    scm_c_public_lookup ("ice-9 weak-vector", "weak-vector-set!");
}

static void
init_weak_vectors (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("The weak vector C interface is deprecated.  Invoke the Scheme "
     "procedures from (ice-9 weak-vector) instead.");
  scm_i_pthread_once (&once, init_weak_vector_vars);
}

SCM
scm_make_weak_vector (SCM len, SCM fill)
{
  init_weak_vectors ();
  return scm_call_2 (scm_variable_ref (make_weak_vector_var), len,
                     SCM_UNBNDP (fill) ? SCM_BOOL_F : fill);
}

SCM
scm_weak_vector (SCM l)
{
  init_weak_vectors ();
  return scm_call_1 (scm_variable_ref (weak_vector_var), l);
}

SCM
scm_weak_vector_p (SCM x)
{
  init_weak_vectors ();
  return scm_call_1 (scm_variable_ref (weak_vector_p_var), x);
}

SCM
scm_weak_vector_length (SCM v)
{
  init_weak_vectors ();
  return scm_call_1 (scm_variable_ref (weak_vector_length_var), v);
}

SCM
scm_weak_vector_ref (SCM v, SCM k)
{
  init_weak_vectors ();
  return scm_call_2 (scm_variable_ref (weak_vector_ref_var), v, k);
}

SCM
scm_weak_vector_set_x (SCM v, SCM k, SCM x)
{
  init_weak_vectors ();
  scm_call_3 (scm_variable_ref (weak_vector_set_x_var), v, k, x);
  return SCM_UNSPECIFIED;
}

SCM
scm_c_make_weak_vector (size_t len, SCM fill)
{
  return scm_make_weak_vector (scm_from_size_t (len), fill);
}

int
scm_is_weak_vector (SCM obj)
{
  return scm_is_true (scm_weak_vector_p (obj));
}

size_t
scm_c_weak_vector_length (SCM vec)
{
  return scm_to_size_t (scm_weak_vector_length (vec));
}

SCM
scm_c_weak_vector_ref (SCM v, size_t k)
{
  return scm_weak_vector_ref (v, scm_from_size_t (k));
}

void
scm_c_weak_vector_set_x (SCM v, size_t k, SCM x)
{
  scm_weak_vector_set_x (v, scm_from_size_t (k), x);
}




static SCM object_properties_var;
static SCM set_object_properties_var;
static SCM object_property_var;
static SCM set_object_property_var;

static void
init_object_properties_vars (void)
{
  object_properties_var =
    scm_c_public_lookup ("ice-9 object-properties", "object-properties");
  set_object_properties_var =
    scm_c_public_lookup ("ice-9 object-properties", "set-object-properties!");
  object_property_var =
    scm_c_public_lookup ("ice-9 object-properties", "object-property");
  set_object_property_var =
    scm_c_public_lookup ("ice-9 object-properties", "set-object-property!");
}

static void
init_object_properties (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("The object properties C interface is deprecated.  Invoke the Scheme "
     "procedures from (ice-9 object-properties) instead.");
  scm_i_pthread_once (&once, init_object_properties_vars);
}

SCM
scm_object_properties (SCM obj)
{
  init_object_properties ();
  return scm_call_1 (scm_variable_ref (object_properties_var), obj);
}


SCM
scm_set_object_properties_x (SCM obj, SCM alist)
{
  init_object_properties ();
  return scm_call_2 (scm_variable_ref (set_object_properties_var), obj, alist);
}

SCM
scm_object_property (SCM obj, SCM key)
{
  init_object_properties ();
  return scm_call_2 (scm_variable_ref (object_property_var), obj, key);
}

SCM
scm_set_object_property_x (SCM obj, SCM key, SCM value)
{
  init_object_properties ();
  return scm_call_3 (scm_variable_ref (set_object_property_var), obj, key, value);
}




SCM_GLOBAL_SYMBOL (scm_sym_filename, "filename");
SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
SCM_GLOBAL_SYMBOL (scm_sym_column, "column");

static SCM source_properties_var;
static SCM set_source_properties_var;
static SCM source_property_var;
static SCM set_source_property_var;
static SCM cons_source_var;

static void
init_source_properties_vars (void)
{
  source_properties_var =
    scm_c_public_lookup ("ice-9 source-properties", "source-properties");
  set_source_properties_var =
    scm_c_public_lookup ("ice-9 source-properties", "set-source-properties!");
  source_property_var =
    scm_c_public_lookup ("ice-9 source-properties", "source-property");
  set_source_property_var =
    scm_c_public_lookup ("ice-9 source-properties", "set-source-property!");
  cons_source_var =
    scm_c_public_lookup ("ice-9 source-properties", "cons-source");
}

static void
init_source_properties (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("The source properties C interface is deprecated.  Invoke the Scheme "
     "procedures from (ice-9 source-properties) instead.");
  scm_i_pthread_once (&once, init_source_properties_vars);
}

SCM
scm_source_properties (SCM obj)
{
  init_source_properties ();
  return scm_call_1 (scm_variable_ref (source_properties_var), obj);
}


SCM
scm_set_source_properties_x (SCM obj, SCM alist)
{
  init_source_properties ();
  return scm_call_2 (scm_variable_ref (set_source_properties_var), obj, alist);
}

SCM
scm_source_property (SCM obj, SCM key)
{
  init_source_properties ();
  return scm_call_2 (scm_variable_ref (source_property_var), obj, key);
}

SCM
scm_set_source_property_x (SCM obj, SCM key, SCM value)
{
  init_source_properties ();
  return scm_call_3 (scm_variable_ref (set_source_property_var), obj, key, value);
}

SCM
scm_cons_source (SCM orig, SCM x, SCM y)
{
  init_source_properties ();
  return scm_call_3 (scm_variable_ref (cons_source_var), orig, x, y);
}

/* In versions 3.0 and prior, the hash table interface could also access
   weak tables.  This is now deprecated.  */



static SCM array_fill_x_var;
static SCM array_copy_x_var;
static SCM array_map_x_var;
static SCM array_for_each_var;
static SCM array_index_map_x_var;
static SCM array_equal_p_var;
static SCM array_slice_for_each_var;
static SCM array_cell_ref_var;
static SCM array_cell_set_x_var;

static void
init_array_map_vars (void)
{
  array_fill_x_var = scm_c_public_lookup ("ice-9 arrays", "array-fill!");
  array_copy_x_var = scm_c_public_lookup ("ice-9 arrays", "array-copy!");
  array_map_x_var = scm_c_public_lookup ("ice-9 arrays", "array-map!");
  array_for_each_var = scm_c_public_lookup ("ice-9 arrays", "array-for-each");
  array_index_map_x_var = scm_c_public_lookup ("ice-9 arrays", "array-index-map!");
  array_equal_p_var = scm_c_public_lookup ("ice-9 arrays", "array-equal?");
  array_fill_x_var = scm_c_public_lookup ("ice-9 arrays", "array-fill!");
  array_cell_ref_var = scm_c_public_lookup ("ice-9 arrays", "array-cell-ref");
  array_cell_set_x_var = scm_c_public_lookup ("ice-9 arrays", "array-cell-set!");
}

static void
init_array_map_functions (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("Using the array map functions from C is deprecated.  Invoke "
     "array-map!, etc. from (ice-9 arrays) instead.");
  scm_i_pthread_once (&once, init_array_map_vars);
}

SCM
scm_array_fill_x (SCM ra, SCM fill)
{
  init_array_map_functions ();
  return scm_call_2 (scm_variable_ref (array_fill_x_var), ra, fill);
}

SCM
scm_array_copy_x (SCM src, SCM dst)
{
  init_array_map_functions ();
  return scm_call_2 (scm_variable_ref (array_copy_x_var), src, dst);
}

SCM
scm_array_map_x (SCM ra0, SCM proc, SCM lra)
{
  init_array_map_functions ();
  return scm_apply_2 (scm_variable_ref (array_map_x_var), ra0, proc, lra);
}

SCM
scm_array_for_each (SCM proc, SCM ra0, SCM lra)
{
  init_array_map_functions ();
  return scm_apply_2 (scm_variable_ref (array_for_each_var), proc, ra0, lra);
}

SCM
scm_array_index_map_x (SCM ra, SCM proc)
{
  init_array_map_functions ();
  return scm_call_2 (scm_variable_ref (array_index_map_x_var), ra, proc);
}

SCM
scm_array_equal_p (SCM ra0, SCM ra1)
{
  init_array_map_functions ();
  return scm_call_2 (scm_variable_ref (array_equal_p_var), ra0, ra1);
}

SCM
scm_array_slice_for_each (SCM frank, SCM op, SCM args)
{
  init_array_map_functions ();
  return scm_apply_2 (scm_variable_ref (array_slice_for_each_var), frank, op,
                      args);
}

SCM
scm_array_slice_for_each_in_order (SCM frank, SCM op, SCM args)
{
  return scm_array_slice_for_each (frank, op, args);
}

SCM
scm_array_cell_ref (SCM array, SCM indices)
{
  init_array_map_functions ();
  return scm_apply_1 (scm_variable_ref (array_cell_ref_var), array, indices);
}

SCM
scm_array_cell_set_x (SCM array, SCM val, SCM indices)
{
  init_array_map_functions ();
  return scm_apply_2 (scm_variable_ref (array_cell_set_x_var), array, val,
                      indices);
}




static SCM char_set_cursor_var;
static SCM char_set_ref_var;
static SCM char_set_cursor_next_var;
static SCM end_of_char_set_p_var;

static void
init_char_set_cursor_vars (void)
{
  char_set_cursor_var = scm_c_public_lookup ("srfi srfi-14", "char-set-cursor");
  char_set_ref_var = scm_c_public_lookup ("srfi srfi-14", "char-set-ref");
  char_set_cursor_next_var = scm_c_public_lookup ("srfi srfi-14", "char-set-cursor-next");
  end_of_char_set_p_var = scm_c_public_lookup ("srfi srfi-14", "end-of-char-set?");
}

static void
init_char_set_cursor_functions (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("Using the char set cursor functions from C is deprecated.  Invoke"
     "char-set-cursor, etc. from (srfi srfi-14) instead.");
  scm_i_pthread_once (&once, init_char_set_cursor_vars);
}

SCM
scm_char_set_cursor (SCM cs)
{
  init_char_set_cursor_functions ();
  return scm_call_1 (scm_variable_ref (char_set_cursor_var), cs);
}

SCM
scm_char_set_ref (SCM cs, SCM cursor)
{
  init_char_set_cursor_functions ();
  return scm_call_2 (scm_variable_ref (char_set_ref_var), cs, cursor);
}

SCM
scm_char_set_cursor_next (SCM cs, SCM cursor)
{
  init_char_set_cursor_functions ();
  return scm_call_2 (scm_variable_ref (char_set_cursor_next_var), cs, cursor);
}

SCM
scm_end_of_char_set_p (SCM cursor)
{
  init_char_set_cursor_functions ();
  return scm_call_1 (scm_variable_ref (end_of_char_set_p_var), cursor);
}




static SCM make_hook_var;
static SCM hook_p_var;
static SCM hook_empty_p_var;
static SCM add_hook_x_var;
static SCM remove_hook_x_var;
static SCM reset_hook_x_var;
static SCM run_hook_var;
static SCM hook_to_list_var;

static void
init_hook_vars (void)
{
  make_hook_var = scm_c_public_lookup ("ice-9 hooks", "make-hook");
  hook_p_var = scm_c_public_lookup ("ice-9 hooks", "hook?");
  hook_empty_p_var = scm_c_public_lookup ("ice-9 hooks", "hook-empty?");
  add_hook_x_var = scm_c_public_lookup ("ice-9 hooks", "add-hook!");
  remove_hook_x_var = scm_c_public_lookup ("ice-9 hooks", "remove-hook!");
  reset_hook_x_var = scm_c_public_lookup ("ice-9 hooks", "reset-hook!");
  run_hook_var = scm_c_public_lookup ("ice-9 hooks", "run-hook");
  hook_to_list_var = scm_c_public_lookup ("ice-9 hooks", "hook->list");
}

static void
init_hook_functions (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("Using the SCM hook functions from C is deprecated.  Invoke"
     "make-hook, etc. from (ice-9 hooks) instead.");
  scm_i_pthread_once (&once, init_hook_vars);
}

SCM
scm_make_hook (SCM arity)
{
  init_hook_functions ();
  return scm_call_0 (scm_variable_ref (make_hook_var));
}

SCM
scm_hook_p (SCM x)
{
  init_hook_functions ();
  return scm_call_1 (scm_variable_ref (hook_p_var), x);
}

SCM
scm_hook_empty_p (SCM hook)
{
  init_hook_functions ();
  return scm_call_1 (scm_variable_ref (hook_empty_p_var), hook);
}

SCM_KEYWORD (kw_append_p, "append?");

SCM
scm_add_hook_x (SCM hook, SCM f, SCM append_p)
{
  init_hook_functions ();
  return scm_call_4 (scm_variable_ref (add_hook_x_var), hook, f,
                     kw_append_p,
                     SCM_UNBNDP (append_p) ? SCM_BOOL_F : append_p);
}

SCM
scm_remove_hook_x (SCM hook, SCM f)
{
  init_hook_functions ();
  return scm_call_2 (scm_variable_ref (remove_hook_x_var), hook, f);
}

SCM
scm_reset_hook_x (SCM hook)
{
  init_hook_functions ();
  return scm_call_1 (scm_variable_ref (reset_hook_x_var), hook);
}

SCM
scm_run_hook (SCM hook, SCM args)
{
  init_hook_functions ();
  return scm_apply_1 (scm_variable_ref (run_hook_var), hook, args);
}

void
scm_c_run_hook (SCM hook, SCM args)
{
  scm_run_hook (hook, args);
}

void
scm_c_run_hookn (SCM hook, SCM *argsv, size_t nargs)
{
  init_hook_functions ();

  SCM hook_and_argsv[nargs + 1];
  hook_and_argsv[0] = hook;
  memcpy (&hook_and_argsv[1], argsv, nargs * sizeof (SCM));
  scm_call_n (scm_variable_ref (run_hook_var), hook_and_argsv, nargs + 1);
}

SCM
scm_hook_to_list (SCM hook)
{
  init_hook_functions ();
  return scm_call_1 (scm_variable_ref (hook_to_list_var), hook);
}




void
scm_free_print_state (SCM)
{
  scm_c_issue_deprecation_warning ("scm_free_print_state is no longer useful; "
                                   "remove calls to it.");
}

SCM
scm_coerce_outport (SCM val)
{
  scm_c_issue_deprecation_warning
    ("SCM_COERCE_OUTPORT is deprecated; just return the value instead.");
  return val;
}

int
scm_valid_oport_value_p (SCM val)
{
  scm_c_issue_deprecation_warning
    ("scm_valid_oport_value_p is deprecated.  Use SCM_OPOUTPORTP instead.");
  return SCM_OPOUTPORTP (val);
}

SCM
scm_make_print_state (void)
{
  scm_c_issue_deprecation_warning
    ("scm_make_print_state is deprecated.  Use a custom writer instead.");
  return SCM_BOOL_F;
}

SCM
scm_port_with_print_state (SCM port, SCM pstate)
{
  scm_c_issue_deprecation_warning
    ("scm_port_with_print_state is deprecated.  Just use ports.");
  return port;
}

SCM
scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *)
{
  scm_c_issue_deprecation_warning
    ("scm_printer_apply is deprecated.  Just use scm_call_2.");
  return scm_call_2 (proc, exp, port);
}

SCM
scm_get_print_state (SCM port)
{
  scm_c_issue_deprecation_warning
    ("scm_get_print_state is deprecated.  Use a custom writer instead.");
  return SCM_BOOL_F;
}



static SCM make_promise_var;
static SCM force_var;
static SCM promise_p_var;

static void
init_promise_vars (void)
{
  make_promise_var = scm_c_public_lookup ("ice-9 promises", "make-promise");
  force_var = scm_c_public_lookup ("ice-9 promises", "force");
  promise_p_var = scm_c_public_lookup ("ice-9 promises", "promise?");
}

static void
init_promise_functions (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("Using the SCM promise functions from C is deprecated.  Invoke"
     "force, etc. from (ice-9 promises) or (srfi srfi-45) instead.");
  scm_i_pthread_once (&once, init_promise_vars);
}

SCM
scm_make_promise (SCM thunk)
{
  init_promise_functions ();
  return scm_call_1 (scm_variable_ref (make_promise_var), thunk);
}

SCM
scm_promise_p (SCM x)
{
  init_promise_functions ();
  return scm_call_1 (scm_variable_ref (promise_p_var), x);
}

SCM
scm_force (SCM promise)
{
  init_promise_functions ();
  return scm_call_1 (scm_variable_ref (force_var), promise);
}



static SCM make_regexp_var;
static SCM regexp_p_var;
static SCM regexp_exec_var;

static void
init_regexp_vars (void)
{
  make_regexp_var = scm_c_public_lookup ("ice-9 regex", "make-regexp");
  regexp_p_var = scm_c_public_lookup ("ice-9 regex", "regexp?");
  regexp_exec_var = scm_c_public_lookup ("ice-9 regex", "regexp-exec");
}

static void
init_regexp_functions (void)
{
  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
  scm_c_issue_deprecation_warning
    ("Using the SCM regexp functions from C is deprecated.  Invoke"
     "make-regexp, etc. from (ice-9 regex) instead.");
  scm_i_pthread_once (&once, init_regexp_vars);
}


SCM
scm_make_regexp (SCM pat, SCM flags)
{
  init_regexp_functions ();
  return scm_apply_1 (scm_variable_ref (make_regexp_var), pat, flags);
}

SCM
scm_regexp_p (SCM x)
{
  init_regexp_functions ();
  return scm_call_1 (scm_variable_ref (regexp_p_var), x);
}

SCM
scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags)
{
  init_regexp_functions ();
  if (SCM_UNBNDP (start))
    start = SCM_INUM0;
  if (SCM_UNBNDP (flags))
    flags = SCM_INUM0;
  return scm_call_4 (scm_variable_ref (regexp_exec_var), rx, str, start, flags);
}



size_t
scm_i_simple_vector_length (SCM v)
{
  scm_c_issue_deprecation_warning
    ("SCM_SIMPLE_VECTOR_LENGTH is deprecated.  Use scm_c_vector_length instead.");
  return scm_c_vector_length (v);
}
    
SCM
scm_i_simple_vector_ref (SCM v, size_t k)
{
  scm_c_issue_deprecation_warning
    ("SCM_SIMPLE_VECTOR_REF is deprecated.  Use scm_c_vector_ref instead.");
  return scm_c_vector_ref (v, k);
}

void
scm_i_simple_vector_set_x (SCM v, size_t k, SCM val)
{
  scm_c_issue_deprecation_warning
    ("SCM_SIMPLE_VECTOR_SET is deprecated.  Use scm_c_vector_set_x instead.");
  scm_c_vector_set_x (v, k, val);
}



scm_t_c_hook scm_before_gc_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
scm_t_c_hook scm_before_mark_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
scm_t_c_hook scm_before_sweep_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
scm_t_c_hook scm_after_sweep_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };
scm_t_c_hook scm_after_gc_c_hook = { 0, SCM_C_HOOK_NORMAL, NULL };

void
scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
{
  scm_c_issue_deprecation_warning
    ("C hooks (scm_c_hook_ functions) are deprecated.  Implement this yourself.");
  hook->first = 0;
  hook->type = type;
  hook->data = hook_data;
}

void
scm_c_hook_add (scm_t_c_hook *hook,
		scm_t_c_hook_function func,
		void *fn_data, 
		int appendp)
{
  scm_c_issue_deprecation_warning
    ("C hooks (scm_c_hook_ functions) are deprecated.  Implement this yourself.");

  scm_t_c_hook_entry *entry;
  scm_t_c_hook_entry **loc = &hook->first;

  entry = scm_allocate_sloppy (SCM_I_CURRENT_THREAD,
                               sizeof (scm_t_c_hook_entry));
  if (appendp)
    while (*loc)
      loc = &(*loc)->next;
  entry->next = *loc;
  entry->func = func;
  entry->data = fn_data;
  *loc = entry;
}

void
scm_c_hook_remove (scm_t_c_hook *hook,
		   scm_t_c_hook_function func,
		   void *fn_data)
{
  scm_c_issue_deprecation_warning
    ("C hooks (scm_c_hook_ functions) are deprecated.  Implement this yourself.");

  scm_t_c_hook_entry **loc = &hook->first;
  while (*loc)
    {
      if ((*loc)->func == func && (*loc)->data == fn_data)
	{
	  *loc = (*loc)->next;
	  return;
	}
      loc = &(*loc)->next;
    }
  fprintf (stderr, "Attempt to remove non-existent hook function\n");
  abort ();
}

void *
scm_c_hook_run (scm_t_c_hook *hook, void *data)
{
  scm_c_issue_deprecation_warning
    ("C hooks (scm_c_hook_ functions) are deprecated.  Implement this yourself.");

  return scm_i_c_hook_run (hook, data);
}

void *
scm_i_c_hook_run (scm_t_c_hook *hook, void *data)
{
  scm_t_c_hook_entry *entry = hook->first;
  scm_t_c_hook_type type = hook->type;
  void *res = 0;
  while (entry)
    {
      res = (entry->func) (hook->data, entry->data, data);
      if (res)
	{
	  if (type == SCM_C_HOOK_OR)
	    break;
	}
      else
	{
	  if (type == SCM_C_HOOK_AND)
	    break;
	}
      entry = entry->next;
    }
  return res;
}



void
scm_i_init_deprecated ()
{
#include "deprecated.x"
}

#endif /* SCM_ENABLE_DEPRECATED == 1 */