deprecate something, move it here when that is feasible.
*/
-/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
# include <config.h>
#endif
+#include <math.h>
+#include <stdio.h>
+#include <string.h>
+
+#include <arpa/inet.h>
+
#define SCM_BUILDING_DEPRECATED_CODE
#include "libguile/_scm.h"
#include "libguile/bytevectors.h"
#include "libguile/bitvectors.h"
#include "libguile/deprecated.h"
-#include "libguile/discouraged.h"
#include "libguile/deprecation.h"
#include "libguile/snarf.h"
#include "libguile/validate.h"
#include "libguile/feature.h"
#include "libguile/uniform.h"
-#include <math.h>
-#include <stdio.h>
-#include <string.h>
-
-#include <arpa/inet.h>
#if (SCM_ENABLE_DEPRECATED == 1)
static void
init_module_stuff ()
{
- if (module_prefix == SCM_BOOL_F)
+ if (scm_is_false (module_prefix))
{
module_prefix = scm_list_2 (scm_sym_app, scm_sym_modules);
make_modules_in_var = scm_c_lookup ("make-modules-in");
static void
maybe_close_port (void *data, SCM port)
{
- SCM except_set = (SCM) data;
+ SCM except_set = PTR2SCM (data);
while (!scm_is_null (except_set))
{
{
SCM p;
SCM_VALIDATE_REST_ARGUMENT (ports);
-
+
for (p = ports; !scm_is_null (p); p = SCM_CDR (p))
SCM_VALIDATE_OPPORT (SCM_ARG1, SCM_COERCE_OUTPORT (SCM_CAR (p)));
- scm_c_port_for_each (maybe_close_port, ports);
+ scm_c_port_for_each (maybe_close_port, SCM2PTR (ports));
return SCM_UNSPECIFIED;
}
"leaving the remainder of the vector unchanged.\n\n"
"When @var{port-or-fdes} is a port, all specified elements\n"
"of @var{uvec} are attempted to be read, potentially blocking\n"
- "while waiting formore input or end-of-file.\n"
+ "while waiting for more input or end-of-file.\n"
"When @var{port-or-fd} is an integer, a single call to\n"
"read(2) is made.\n\n"
"An error is signalled when the last element has only\n"
c_start = SCM_UNBNDP (start) ? 0 : scm_to_size_t (start);
c_start *= c_width;
- c_end = SCM_UNBNDP (end) ? SCM_BYTEVECTOR_LENGTH (uvec) : scm_to_size_t (end);
- c_end *= c_width;
+ c_end = SCM_UNBNDP (end) ? SCM_BYTEVECTOR_LENGTH (uvec)
+ : scm_to_size_t (end) * c_width;
result = scm_get_bytevector_n_x (port_or_fd, uvec,
scm_from_size_t (c_start),
char **argv;
if (scm_is_string (func))
- func = scm_dynamic_func (func, dobj);
- SCM_VALIDATE_FOREIGN (SCM_ARG1, func);
+ {
+#if HAVE_MODULES
+ func = scm_dynamic_func (func, dobj);
+#else
+ scm_misc_error ("dynamic-args-call",
+ "dynamic-func not available to resolve ~S",
+ scm_list_1 (func));
+#endif
+ }
+ SCM_VALIDATE_POINTER (SCM_ARG1, func);
- fptr = SCM_FOREIGN_POINTER (func);
+ fptr = SCM_POINTER_VALUE (func);
argv = scm_i_allocate_string_pointers (args);
for (argc = 0; argv[argc]; argc++)
\f
-void
-scm_i_init_deprecated ()
+SCM
+scm_short2num (short x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_short2num' is deprecated. Use scm_from_short instead.");
+ return scm_from_short (x);
+}
+
+SCM
+scm_ushort2num (unsigned short x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_ushort2num' is deprecated. Use scm_from_ushort instead.");
+ return scm_from_ushort (x);
+}
+
+SCM
+scm_int2num (int x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_int2num' is deprecated. Use scm_from_int instead.");
+ return scm_from_int (x);
+}
+
+SCM
+scm_uint2num (unsigned int x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_uint2num' is deprecated. Use scm_from_uint instead.");
+ return scm_from_uint (x);
+}
+
+SCM
+scm_long2num (long x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_long2num' is deprecated. Use scm_from_long instead.");
+ return scm_from_long (x);
+}
+
+SCM
+scm_ulong2num (unsigned long x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_ulong2num' is deprecated. Use scm_from_ulong instead.");
+ return scm_from_ulong (x);
+}
+
+SCM
+scm_size2num (size_t x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_size2num' is deprecated. Use scm_from_size_t instead.");
+ return scm_from_size_t (x);
+}
+
+SCM
+scm_ptrdiff2num (ptrdiff_t x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_ptrdiff2num' is deprecated. Use scm_from_ssize_t instead.");
+ return scm_from_ssize_t (x);
+}
+
+short
+scm_num2short (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2short' is deprecated. Use scm_to_short instead.");
+ return scm_to_short (x);
+}
+
+unsigned short
+scm_num2ushort (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2ushort' is deprecated. Use scm_to_ushort instead.");
+ return scm_to_ushort (x);
+}
+
+int
+scm_num2int (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2int' is deprecated. Use scm_to_int instead.");
+ return scm_to_int (x);
+}
+
+unsigned int
+scm_num2uint (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2uint' is deprecated. Use scm_to_uint instead.");
+ return scm_to_uint (x);
+}
+
+long
+scm_num2long (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2long' is deprecated. Use scm_to_long instead.");
+ return scm_to_long (x);
+}
+
+unsigned long
+scm_num2ulong (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2ulong' is deprecated. Use scm_to_ulong instead.");
+ return scm_to_ulong (x);
+}
+
+size_t
+scm_num2size (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2size' is deprecated. Use scm_to_size_t instead.");
+ return scm_to_size_t (x);
+}
+
+ptrdiff_t
+scm_num2ptrdiff (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2ptrdiff' is deprecated. Use scm_to_ssize_t instead.");
+ return scm_to_ssize_t (x);
+}
+
+#if SCM_SIZEOF_LONG_LONG != 0
+
+SCM
+scm_long_long2num (long long x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_long_long2num' is deprecated. Use scm_from_long_long instead.");
+ return scm_from_long_long (x);
+}
+
+SCM
+scm_ulong_long2num (unsigned long long x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_ulong_long2num' is deprecated. Use scm_from_ulong_long instead.");
+ return scm_from_ulong_long (x);
+}
+
+long long
+scm_num2long_long (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2long_long' is deprecated. Use scm_to_long_long instead.");
+ return scm_to_long_long (x);
+}
+
+unsigned long long
+scm_num2ulong_long (SCM x, unsigned long pos, const char *s_caller)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2ulong_long' is deprecated. Use scm_from_ulong_long instead.");
+ return scm_to_ulong_long (x);
+}
+
+#endif
+
+SCM
+scm_make_real (double x)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_make_real' is deprecated. Use scm_from_double instead.");
+ return scm_from_double (x);
+}
+
+double
+scm_num2dbl (SCM a, const char *why)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_num2dbl' is deprecated. Use scm_to_double instead.");
+ return scm_to_double (a);
+}
+
+SCM
+scm_float2num (float n)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_float2num' is deprecated. Use scm_from_double instead.");
+ return scm_from_double ((double) n);
+}
+
+SCM
+scm_double2num (double n)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_double2num' is deprecated. Use scm_from_double instead.");
+ return scm_from_double (n);
+}
+
+SCM
+scm_make_complex (double x, double y)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_make_complex' is deprecated. Use scm_c_make_rectangular instead.");
+ return scm_c_make_rectangular (x, y);
+}
+
+SCM
+scm_mem2symbol (const char *mem, size_t len)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_mem2symbol' is deprecated. Use scm_from_locale_symboln instead.");
+ return scm_from_locale_symboln (mem, len);
+}
+
+SCM
+scm_mem2uninterned_symbol (const char *mem, size_t len)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_mem2uninterned_symbol' is deprecated. "
+ "Use scm_make_symbol and scm_from_locale_symboln instead.");
+ return scm_make_symbol (scm_from_locale_stringn (mem, len));
+}
+
+SCM
+scm_str2symbol (const char *str)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_str2symbol' is deprecated. Use scm_from_locale_symbol instead.");
+ return scm_from_locale_symbol (str);
+}
+
+
+/* This function must only be applied to memory obtained via malloc,
+ since the GC is going to apply `free' to it when the string is
+ dropped.
+
+ Also, s[len] must be `\0', since we promise that strings are
+ null-terminated. Perhaps we could handle non-null-terminated
+ strings by claiming they're shared substrings of a string we just
+ made up. */
+SCM
+scm_take_str (char *s, size_t len)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_take_str' is deprecated. Use scm_take_locale_stringn instead.");
+ return scm_take_locale_stringn (s, len);
+}
+
+/* `s' must be a malloc'd string. See scm_take_str. */
+SCM
+scm_take0str (char *s)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_take0str' is deprecated. Use scm_take_locale_string instead.");
+ return scm_take_locale_string (s);
+}
+
+SCM
+scm_mem2string (const char *src, size_t len)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_mem2string' is deprecated. Use scm_from_locale_stringn instead.");
+ return scm_from_locale_stringn (src, len);
+}
+
+SCM
+scm_str2string (const char *src)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_str2string' is deprecated. Use scm_from_locale_string instead.");
+ return scm_from_locale_string (src);
+}
+
+SCM
+scm_makfrom0str (const char *src)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_makfrom0str' is deprecated."
+ "Use scm_from_locale_string instead, but check for NULL first.");
+ if (!src) return SCM_BOOL_F;
+ return scm_from_locale_string (src);
+}
+
+SCM
+scm_makfrom0str_opt (const char *src)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_makfrom0str_opt' is deprecated."
+ "Use scm_from_locale_string instead, but check for NULL first.");
+ return scm_makfrom0str (src);
+}
+
+
+SCM
+scm_allocate_string (size_t len)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_allocate_string' is deprecated. Use scm_c_make_string instead.");
+ return scm_i_make_string (len, NULL, 0);
+}
+
+SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", 1, 0, 0,
+ (SCM symbol),
+ "Make a keyword object from a @var{symbol} that starts with a dash.")
+#define FUNC_NAME s_scm_make_keyword_from_dash_symbol
+{
+ SCM dash_string, non_dash_symbol;
+
+ scm_c_issue_deprecation_warning
+ ("`scm_make_keyword_from_dash_symbol' is deprecated. Don't use dash symbols.");
+
+ SCM_ASSERT (scm_is_symbol (symbol)
+ && (scm_i_symbol_ref (symbol, 0) == '-'),
+ symbol, SCM_ARG1, FUNC_NAME);
+
+ dash_string = scm_symbol_to_string (symbol);
+ non_dash_symbol =
+ scm_string_to_symbol (scm_c_substring (dash_string,
+ 1,
+ scm_c_string_length (dash_string)));
+
+ return scm_symbol_to_keyword (non_dash_symbol);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_keyword_dash_symbol, "keyword-dash-symbol", 1, 0, 0,
+ (SCM keyword),
+ "Return the dash symbol for @var{keyword}.\n"
+ "This is the inverse of @code{make-keyword-from-dash-symbol}.")
+#define FUNC_NAME s_scm_keyword_dash_symbol
+{
+ SCM symbol = scm_keyword_to_symbol (keyword);
+ SCM parts = scm_list_2 (scm_from_locale_string ("-"),
+ scm_symbol_to_string (symbol));
+ scm_c_issue_deprecation_warning
+ ("`scm_keyword_dash_symbol' is deprecated. Don't use dash symbols.");
+
+ return scm_string_to_symbol (scm_string_append (parts));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_make_keyword (const char *s)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_c_make_keyword' is deprecated. Use scm_from_locale_keyword instead.");
+ return scm_from_locale_keyword (s);
+}
+
+unsigned int
+scm_thread_sleep (unsigned int t)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_thread_sleep' is deprecated. Use scm_std_sleep instead.");
+ return scm_std_sleep (t);
+}
+
+unsigned long
+scm_thread_usleep (unsigned long t)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_thread_usleep' is deprecated. Use scm_std_usleep instead.");
+ return scm_std_usleep (t);
+}
+
+#ifdef HAVE_SYS_SELECT_H
+int scm_internal_select (int fds,
+ fd_set *rfds,
+ fd_set *wfds,
+ fd_set *efds,
+ struct timeval *timeout)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_internal_select' is deprecated. Use scm_std_select instead.");
+ return scm_std_select (fds, rfds, wfds, efds, timeout);
+}
+#endif /* HAVE_SYS_SELECT_H */
+
+\f
+
+#ifdef HAVE_CUSERID
+
+# if !HAVE_DECL_CUSERID
+extern char *cuserid (char *);
+# endif
+
+SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0,
+ (void),
+ "Return a string containing a user name associated with the\n"
+ "effective user id of the process. Return @code{#f} if this\n"
+ "information cannot be obtained.")
+#define FUNC_NAME s_scm_cuserid
+{
+ char buf[L_cuserid];
+ char * p;
+
+ scm_c_issue_deprecation_warning
+ ("`cuserid' is deprecated. Use `(passwd:name (getpwuid (geteuid)))' instead.");
+
+ p = cuserid (buf);
+ if (!p || !*p)
+ return SCM_BOOL_F;
+ return scm_from_locale_string (p);
+}
+#undef FUNC_NAME
+#endif /* HAVE_CUSERID */
+
+\f
+
+/* {Properties}
+ */
+
+static SCM properties_whash;
+
+SCM_DEFINE (scm_primitive_make_property, "primitive-make-property", 1, 0, 0,
+ (SCM not_found_proc),
+ "Create a @dfn{property token} that can be used with\n"
+ "@code{primitive-property-ref} and @code{primitive-property-set!}.\n"
+ "See @code{primitive-property-ref} for the significance of\n"
+ "@var{not_found_proc}.")
+#define FUNC_NAME s_scm_primitive_make_property
+{
+ scm_c_issue_deprecation_warning
+ ("`primitive-make-property' is deprecated. Use object properties.");
+
+ if (!scm_is_false (not_found_proc))
+ SCM_VALIDATE_PROC (SCM_ARG1, not_found_proc);
+ return scm_cons (not_found_proc, SCM_EOL);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
+ (SCM prop, SCM obj),
+ "Return the property @var{prop} of @var{obj}.\n"
+ "\n"
+ "When no value has yet been associated with @var{prop} and\n"
+ "@var{obj}, the @var{not-found-proc} from @var{prop} is used. A\n"
+ "call @code{(@var{not-found-proc} @var{prop} @var{obj})} is made\n"
+ "and the result set as the property value. If\n"
+ "@var{not-found-proc} is @code{#f} then @code{#f} is the\n"
+ "property value.")
+#define FUNC_NAME s_scm_primitive_property_ref
{
+ SCM alist;
+
+ scm_c_issue_deprecation_warning
+ ("`primitive-property-ref' is deprecated. Use object properties.");
+
+ SCM_VALIDATE_CONS (SCM_ARG1, prop);
+
+ alist = scm_hashq_ref (properties_whash, obj, SCM_EOL);
+ if (scm_is_pair (alist))
+ {
+ SCM assoc = scm_assq (prop, alist);
+ if (scm_is_true (assoc))
+ return SCM_CDR (assoc);
+ }
+
+ if (scm_is_false (SCM_CAR (prop)))
+ return SCM_BOOL_F;
+ else
+ {
+ SCM val = scm_call_2 (SCM_CAR (prop), prop, obj);
+ scm_hashq_set_x (properties_whash, obj,
+ scm_acons (prop, val, alist));
+ return val;
+ }
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
+ (SCM prop, SCM obj, SCM val),
+ "Set the property @var{prop} of @var{obj} to @var{val}.")
+#define FUNC_NAME s_scm_primitive_property_set_x
+{
+ SCM alist, assoc;
+
+ scm_c_issue_deprecation_warning
+ ("`primitive-property-set!' is deprecated. Use object properties.");
+
+ SCM_VALIDATE_CONS (SCM_ARG1, prop);
+ alist = scm_hashq_ref (properties_whash, obj, SCM_EOL);
+ assoc = scm_assq (prop, alist);
+ if (scm_is_pair (assoc))
+ SCM_SETCDR (assoc, val);
+ else
+ scm_hashq_set_x (properties_whash, obj,
+ scm_acons (prop, val, alist));
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
+ (SCM prop, SCM obj),
+ "Remove any value associated with @var{prop} and @var{obj}.")
+#define FUNC_NAME s_scm_primitive_property_del_x
+{
+ SCM alist;
+
+ scm_c_issue_deprecation_warning
+ ("`primitive-property-del!' is deprecated. Use object properties.");
+
+ SCM_VALIDATE_CONS (SCM_ARG1, prop);
+ alist = scm_hashq_ref (properties_whash, obj, SCM_EOL);
+ if (scm_is_pair (alist))
+ scm_hashq_set_x (properties_whash, obj, scm_assq_remove_x (alist, prop));
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+\f
+
+SCM
+scm_whash_get_handle (SCM whash, SCM key)
+{
+ scm_c_issue_deprecation_warning
+ ("The `scm_whash' API is deprecated. Use the `scm_hashq' API instead.");
+
+ return scm_hashq_get_handle (whash, key);
+}
+
+int
+SCM_WHASHFOUNDP (SCM h)
+{
+ scm_c_issue_deprecation_warning
+ ("The `scm_whash' API is deprecated. Use the `scm_hashq' API instead.");
+
+ return scm_is_true (h);
+}
+
+SCM
+SCM_WHASHREF (SCM whash, SCM handle)
+{
+ scm_c_issue_deprecation_warning
+ ("The `scm_whash' API is deprecated. Use the `scm_hashq' API instead.");
+
+ return SCM_CDR (handle);
+}
+
+void
+SCM_WHASHSET (SCM whash, SCM handle, SCM obj)
+{
+ scm_c_issue_deprecation_warning
+ ("The `scm_whash' API is deprecated. Use the `scm_hashq' API instead.");
+
+ SCM_SETCDR (handle, obj);
+}
+
+SCM
+scm_whash_create_handle (SCM whash, SCM key)
+{
+ scm_c_issue_deprecation_warning
+ ("The `scm_whash' API is deprecated. Use the `scm_hashq' API instead.");
+
+ return scm_hashq_create_handle_x (whash, key, SCM_UNSPECIFIED);
+}
+
+SCM
+scm_whash_lookup (SCM whash, SCM obj)
+{
+ scm_c_issue_deprecation_warning
+ ("The `scm_whash' API is deprecated. Use the `scm_hashq' API instead.");
+
+ return scm_hashq_ref (whash, obj, SCM_BOOL_F);
+}
+
+void
+scm_whash_insert (SCM whash, SCM key, SCM obj)
+{
+ scm_c_issue_deprecation_warning
+ ("The `scm_whash' API is deprecated. Use the `scm_hashq' API instead.");
+
+ scm_hashq_set_x (whash, key, obj);
+}
+
+\f
+
+SCM scm_struct_table = SCM_BOOL_F;
+
+SCM
+scm_struct_create_handle (SCM obj)
+{
+ scm_c_issue_deprecation_warning
+ ("`scm_struct_create_handle' is deprecated, and has no effect.");
+
+ return scm_cons (obj, scm_cons (SCM_BOOL_F, SCM_BOOL_F));
+}
+
+\f
+
+SCM
+scm_internal_dynamic_wind (scm_t_guard before,
+ scm_t_inner inner,
+ scm_t_guard after,
+ void *inner_data,
+ void *guard_data)
+{
+ SCM ans;
+
+ scm_c_issue_deprecation_warning
+ ("`scm_internal_dynamic_wind' is deprecated. "
+ "Use the `scm_dynwind_begin' / `scm_dynwind_end' API instead.");
+
+ scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
+ scm_dynwind_rewind_handler (before, guard_data, SCM_F_WIND_EXPLICITLY);
+ scm_dynwind_unwind_handler (after, guard_data, SCM_F_WIND_EXPLICITLY);
+ ans = inner (inner_data);
+ scm_dynwind_end ();
+ return ans;
+}
+
+\f
+
+SCM
+scm_immutable_cell (scm_t_bits car, scm_t_bits cdr)
+{
+ scm_c_issue_deprecation_warning
+ ("scm_immutable_cell is deprecated. Use scm_cell instead.");
+
+ return scm_cell (car, cdr);
+}
+
+SCM
+scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
+ scm_t_bits ccr, scm_t_bits cdr)
+{
+ scm_c_issue_deprecation_warning
+ ("scm_immutable_double_cell is deprecated. Use scm_double_cell instead.");
+
+ return scm_double_cell (car, cbr, ccr, cdr);
+}
+
+\f
+
+
+scm_t_bits
+scm_i_deprecated_asrtgo (scm_t_bits condition)
+{
+ scm_c_issue_deprecation_warning
+ ("SCM_ASRTGO is deprecated. Use `if (!condition) goto label;' directly.");
+
+ return condition;
+}
+
+
+\f
+
+
+/* scm_sym2var
+ *
+ * looks up the variable bound to SYM according to PROC. PROC should be
+ * a `eval closure' of some module.
+ *
+ * When no binding exists, and DEFINEP is true, create a new binding
+ * with a initial value of SCM_UNDEFINED. Return `#f' when DEFINEP as
+ * false and no binding exists.
+ *
+ * When PROC is `#f', it is ignored and the binding is searched for in
+ * the scm_pre_modules_obarray (a `eq' hash table).
+ */
+
+SCM
+scm_sym2var (SCM sym, SCM proc, SCM definep)
+#define FUNC_NAME "scm_sym2var"
+{
+ SCM var;
+
+ if (scm_is_true (definep))
+ scm_c_issue_deprecation_warning
+ ("scm_sym2var is deprecated. Use scm_define or scm_module_define\n"
+ "to define variables. In some rare cases you may need\n"
+ "scm_module_ensure_local_variable.");
+ else
+ scm_c_issue_deprecation_warning
+ ("scm_sym2var is deprecated. Use scm_module_variable to look up\n"
+ "variables.");
+
+ if (SCM_NIMP (proc))
+ {
+ if (SCM_EVAL_CLOSURE_P (proc))
+ {
+ /* Bypass evaluator in the standard case. */
+ var = scm_eval_closure_lookup (proc, sym, definep);
+ }
+ else
+ var = scm_call_2 (proc, sym, definep);
+ }
+ else
+ {
+ if (scm_is_false (definep))
+ var = scm_module_variable (scm_the_root_module (), sym);
+ else
+ var = scm_module_ensure_local_variable (scm_the_root_module (), sym);
+ }
+
+ if (scm_is_true (var) && !SCM_VARIABLEP (var))
+ SCM_MISC_ERROR ("~S is not bound to a variable", scm_list_1 (sym));
+
+ return var;
+}
+#undef FUNC_NAME
+
+SCM
+scm_lookup_closure_module (SCM proc)
+{
+ scm_c_issue_deprecation_warning
+ ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n"
+ "the manual, for replacements.");
+
+ if (scm_is_false (proc))
+ return scm_the_root_module ();
+ else if (SCM_EVAL_CLOSURE_P (proc))
+ return SCM_PACK (SCM_SMOB_DATA (proc));
+ else
+ /* FIXME: The `module' property is no longer set on eval closures, as it
+ introduced a circular reference that precludes garbage collection of
+ modules with the current weak hash table semantics (see
+ http://lists.gnu.org/archive/html/guile-devel/2009-01/msg00102.html and
+ http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/2465
+ for details). Since it doesn't appear to be used (only in this
+ function, which has 1 caller), we no longer extend
+ `set-module-eval-closure!' to set the `module' property. */
+ abort ();
+}
+
+SCM
+scm_module_lookup_closure (SCM module)
+{
+ scm_c_issue_deprecation_warning
+ ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n"
+ "the manual, for replacements.");
+
+ if (scm_is_false (module))
+ return SCM_BOOL_F;
+ else
+ return SCM_MODULE_EVAL_CLOSURE (module);
+}
+
+SCM
+scm_current_module_lookup_closure ()
+{
+ scm_c_issue_deprecation_warning
+ ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n"
+ "the manual, for replacements.");
+
+ if (scm_module_system_booted_p)
+ return scm_module_lookup_closure (scm_current_module ());
+ else
+ return SCM_BOOL_F;
+}
+
+scm_t_bits scm_tc16_eval_closure;
+
+#define SCM_F_EVAL_CLOSURE_INTERFACE (1<<0)
+#define SCM_EVAL_CLOSURE_INTERFACE_P(e) \
+ (SCM_SMOB_FLAGS (e) & SCM_F_EVAL_CLOSURE_INTERFACE)
+
+/* NOTE: This function may be called by a smob application
+ or from another C function directly. */
+SCM
+scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep)
+{
+ SCM module = SCM_PACK (SCM_SMOB_DATA (eclo));
+
+ scm_c_issue_deprecation_warning
+ ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n"
+ "the manual, for replacements.");
+
+ if (scm_is_true (definep))
+ {
+ if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo))
+ return SCM_BOOL_F;
+ return scm_module_ensure_local_variable (module, sym);
+ }
+ else
+ return scm_module_variable (module, sym);
+}
+
+SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0,
+ (SCM module),
+ "Return an eval closure for the module @var{module}.")
+#define FUNC_NAME s_scm_standard_eval_closure
+{
+ scm_c_issue_deprecation_warning
+ ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n"
+ "the manual, for replacements.");
+
+ SCM_RETURN_NEWSMOB (scm_tc16_eval_closure, SCM_UNPACK (module));
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_standard_interface_eval_closure,
+ "standard-interface-eval-closure", 1, 0, 0,
+ (SCM module),
+ "Return a interface eval closure for the module @var{module}. "
+ "Such a closure does not allow new bindings to be added.")
+#define FUNC_NAME s_scm_standard_interface_eval_closure
+{
+ scm_c_issue_deprecation_warning
+ ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n"
+ "the manual, for replacements.");
+
+ SCM_RETURN_NEWSMOB (scm_tc16_eval_closure | (SCM_F_EVAL_CLOSURE_INTERFACE<<16),
+ SCM_UNPACK (module));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_eval_closure_module,
+ "eval-closure-module", 1, 0, 0,
+ (SCM eval_closure),
+ "Return the module associated with this eval closure.")
+/* the idea is that eval closures are really not the way to do things, they're
+ superfluous given our module system. this function lets mmacros migrate away
+ from eval closures. */
+#define FUNC_NAME s_scm_eval_closure_module
+{
+ scm_c_issue_deprecation_warning
+ ("Eval closures are deprecated. See \"Accessing Modules From C\" in\n"
+ "the manual, for replacements.");
+
+ SCM_MAKE_VALIDATE_MSG (SCM_ARG1, eval_closure, EVAL_CLOSURE_P,
+ "eval-closure");
+ return SCM_SMOB_OBJECT (eval_closure);
+}
+#undef FUNC_NAME
+
+
+\f
+
+SCM_DEFINE (scm_struct_vtable_tag, "struct-vtable-tag", 1, 0, 0,
+ (SCM handle),
+ "Return the vtable tag of the structure @var{handle}.")
+#define FUNC_NAME s_scm_struct_vtable_tag
+{
+ SCM_VALIDATE_VTABLE (1, handle);
+ scm_c_issue_deprecation_warning
+ ("struct-vtable-tag is deprecated. What were you doing with it anyway?");
+
+ return scm_from_unsigned_integer
+ (((scm_t_bits)SCM_STRUCT_DATA (handle)) >> 3);
+}
+#undef FUNC_NAME
+
+
+\f
+
+SCM_DEFINE (scm_generalized_vector_p, "generalized-vector?", 1, 0, 0,
+ (SCM obj),
+ "Return @code{#t} if @var{obj} is a vector, string,\n"
+ "bitvector, or uniform numeric vector.")
+#define FUNC_NAME s_scm_generalized_vector_p
+{
+ scm_c_issue_deprecation_warning
+ ("generalized-vector? is deprecated. Use array? and check the "
+ "array-rank instead.");
+ return scm_from_bool (scm_is_generalized_vector (obj));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_generalized_vector_length, "generalized-vector-length", 1, 0, 0,
+ (SCM v),
+ "Return the length of the generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_length
+{
+ scm_c_issue_deprecation_warning
+ ("generalized-vector-length is deprecated. Use array-length instead.");
+ return scm_from_size_t (scm_c_generalized_vector_length (v));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_generalized_vector_ref, "generalized-vector-ref", 2, 0, 0,
+ (SCM v, SCM idx),
+ "Return the element at index @var{idx} of the\n"
+ "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_ref
+{
+ scm_c_issue_deprecation_warning
+ ("generalized-vector-ref is deprecated. Use array-ref instead.");
+ return scm_c_generalized_vector_ref (v, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_generalized_vector_set_x, "generalized-vector-set!", 3, 0, 0,
+ (SCM v, SCM idx, SCM val),
+ "Set the element at index @var{idx} of the\n"
+ "generalized vector @var{v} to @var{val}.")
+#define FUNC_NAME s_scm_generalized_vector_set_x
+{
+ scm_c_issue_deprecation_warning
+ ("generalized-vector-set! is deprecated. Use array-set! instead. "
+ "Note the change in argument order!");
+ scm_c_generalized_vector_set_x (v, scm_to_size_t (idx), val);
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_generalized_vector_to_list, "generalized-vector->list", 1, 0, 0,
+ (SCM v),
+ "Return a new list whose elements are the elements of the\n"
+ "generalized vector @var{v}.")
+#define FUNC_NAME s_scm_generalized_vector_to_list
+{
+ /* FIXME: This duplicates `array_to_list'. */
+ SCM ret = SCM_EOL;
+ long inc;
+ ssize_t pos, i;
+ scm_t_array_handle h;
+
+ scm_c_issue_deprecation_warning
+ ("generalized-vector->list is deprecated. Use array->list instead.");
+
+ scm_generalized_vector_get_handle (v, &h);
+
+ i = h.dims[0].ubnd - h.dims[0].lbnd + 1;
+ inc = h.dims[0].inc;
+ pos = (i - 1) * inc;
+
+ for (; i > 0; i--, pos -= inc)
+ ret = scm_cons (h.impl->vref (&h, h.base + pos), ret);
+
+ scm_array_handle_release (&h);
+ return ret;
+}
+#undef FUNC_NAME
+
+
+\f
+
+extern SCM
+scm_c_program_source (SCM program, size_t ip)
+{
+ scm_c_issue_deprecation_warning
+ ("scm_c_program_source is deprecated. Use scm_program_source instead.");
+
+ return scm_program_source (program, scm_from_size_t (ip), SCM_UNBOUND);
+}
+
+
+\f
+
+SCM_DEFINE (scm_gc_live_object_stats, "gc-live-object-stats", 0, 0, 0,
+ (),
+ "Return an alist of statistics of the current live objects. ")
+#define FUNC_NAME s_scm_gc_live_object_stats
+{
+ scm_c_issue_deprecation_warning
+ ("gc-live-object-stats is deprecated. There is no replacement,\n"
+ "unfortunately.");
+
+ return SCM_EOL;
+}
+#undef FUNC_NAME
+
+
+\f
+
+SCM_DEFINE (scm_htons, "htons", 1, 0, 0,
+ (SCM value),
+ "Convert a 16 bit quantity from host to network byte ordering.\n"
+ "@var{value} is packed into 2 bytes, which are then converted\n"
+ "and returned as a new integer.")
+#define FUNC_NAME s_scm_htons
+{
+ scm_c_issue_deprecation_warning
+ ("htons is deprecated. Use bytevector-u16-set! and bytevector-u16-ref "
+ "with big endianness.");
+
+ return scm_from_ushort (htons (scm_to_ushort (value)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0,
+ (SCM value),
+ "Convert a 16 bit quantity from network to host byte ordering.\n"
+ "@var{value} is packed into 2 bytes, which are then converted\n"
+ "and returned as a new integer.")
+#define FUNC_NAME s_scm_ntohs
+{
+ scm_c_issue_deprecation_warning
+ ("ntohs is deprecated. Use bytevector-u16-set! and bytevector-u16-ref "
+ "with big endianness.");
+
+ return scm_from_ushort (ntohs (scm_to_ushort (value)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
+ (SCM value),
+ "Convert a 32 bit quantity from host to network byte ordering.\n"
+ "@var{value} is packed into 4 bytes, which are then converted\n"
+ "and returned as a new integer.")
+#define FUNC_NAME s_scm_htonl
+{
+ scm_c_issue_deprecation_warning
+ ("htonl is deprecated. Use bytevector-u32-set! and bytevector-u32-ref "
+ "with big endianness.");
+
+ return scm_from_ulong (htonl (scm_to_uint32 (value)));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
+ (SCM value),
+ "Convert a 32 bit quantity from network to host byte ordering.\n"
+ "@var{value} is packed into 4 bytes, which are then converted\n"
+ "and returned as a new integer.")
+#define FUNC_NAME s_scm_ntohl
+{
+ scm_c_issue_deprecation_warning
+ ("ntohl is deprecated. Use bytevector-u32-set! and bytevector-u32-ref "
+ "with big endianness.");
+
+ return scm_from_ulong (ntohl (scm_to_uint32 (value)));
+}
+#undef FUNC_NAME
+
+
+\f
+
+void
+scm_i_init_deprecated ()
+{
+ properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
+ scm_struct_table = scm_make_hash_table (SCM_UNDEFINED);
+ scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0);
+ scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0);
+
#include "libguile/deprecated.x"
}
HCoop / bpt / guile.git / blobdiff