X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/92205699d01f918a0f8808d8cbbe55ba2568f058..a2689737679cf2553c118a1d96de7c9ddfec62b0:/libguile/deprecated.c diff --git a/libguile/deprecated.c b/libguile/deprecated.c index 93236ecb6..f428bd4bf 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -2,25 +2,37 @@ deprecate something, move it here when that is feasible. */ -/* Copyright (C) 2003, 2004 Free Software Foundation, Inc. +/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010 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 as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. + * 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. * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of + * This library 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 this library; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ +#ifdef HAVE_CONFIG_H +# include +#endif + +#define SCM_BUILDING_DEPRECATED_CODE + #include "libguile/_scm.h" #include "libguile/async.h" +#include "libguile/arrays.h" +#include "libguile/array-map.h" +#include "libguile/generalized-arrays.h" +#include "libguile/bytevectors.h" +#include "libguile/bitvectors.h" #include "libguile/deprecated.h" #include "libguile/discouraged.h" #include "libguile/deprecation.h" @@ -40,15 +52,21 @@ #include "libguile/ports.h" #include "libguile/eq.h" #include "libguile/read.h" +#include "libguile/r6rs-ports.h" #include "libguile/strports.h" #include "libguile/smob.h" #include "libguile/alist.h" #include "libguile/keywords.h" +#include "libguile/socket.h" #include "libguile/feature.h" +#include "libguile/uniform.h" +#include #include #include +#include + #if (SCM_ENABLE_DEPRECATED == 1) /* From print.c: Internal symbol names of isyms. Deprecated in guile 1.7.0 on @@ -59,17 +77,6 @@ char *scm_isymnames[] = }; -/* From eval.c: Error messages of the evaluator. These were deprecated in - * guile 1.7.0 on 2003-06-02. */ -const char scm_s_expression[] = "missing or extra expression"; -const char scm_s_test[] = "bad test"; -const char scm_s_body[] = "bad body"; -const char scm_s_bindings[] = "bad bindings"; -const char scm_s_variable[] = "bad variable"; -const char scm_s_clauses[] = "bad or missing clauses"; -const char scm_s_formals[] = "bad formals"; - - SCM_REGISTER_PROC(s_substring_move_left_x, "substring-move-left!", 5, 0, 0, scm_substring_move_x); SCM_REGISTER_PROC(s_substring_move_right_x, "substring-move-right!", 5, 0, 0, scm_substring_move_x); @@ -248,29 +255,16 @@ static SCM try_module_autoload_var; static void init_module_stuff () { -#define PERM(x) scm_permanent_object(x) - if (module_prefix == SCM_BOOL_F) { - module_prefix = PERM (scm_list_2 (scm_sym_app, scm_sym_modules)); - make_modules_in_var = PERM (scm_c_lookup ("make-modules-in")); + module_prefix = scm_list_2 (scm_sym_app, scm_sym_modules); + make_modules_in_var = scm_c_lookup ("make-modules-in"); beautify_user_module_x_var = - PERM (scm_c_lookup ("beautify-user-module!")); - try_module_autoload_var = PERM (scm_c_lookup ("try-module-autoload")); + scm_c_lookup ("beautify-user-module!"); + try_module_autoload_var = scm_c_lookup ("try-module-autoload"); } } -SCM -scm_the_root_module () -{ - init_module_stuff (); - scm_c_issue_deprecation_warning ("`scm_the_root_module' is deprecated. " - "Use `scm_c_resolve_module (\"guile\")' " - "instead."); - - return scm_c_resolve_module ("guile"); -} - static SCM scm_module_full_name (SCM name) { @@ -319,14 +313,14 @@ scm_load_scheme_module (SCM name) static void maybe_close_port (void *data, SCM port) { - SCM except = (SCM)data; + SCM except_set = (SCM) data; - while (!scm_is_null (except)) + while (!scm_is_null (except_set)) { - SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except)); + SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except_set)); if (scm_is_eq (p, port)) return; - except = SCM_CDR (except); + except_set = SCM_CDR (except_set); } scm_close_port (port); @@ -435,7 +429,7 @@ scm_create_hook (const char *name, int n_args) { SCM hook = scm_make_hook (scm_from_int (n_args)); scm_c_define (name, hook); - return scm_permanent_object (hook); + return hook; } } @@ -520,38 +514,6 @@ SCM_DEFINE (scm_read_and_eval_x, "read-and-eval!", 0, 1, 0, } #undef FUNC_NAME -SCM -scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set) -{ - scm_c_issue_deprecation_warning - ("`scm_make_subr_opt' is deprecated. Use `scm_c_make_subr' or " - "`scm_c_define_subr' instead."); - - if (set) - return scm_c_define_subr (name, type, fcn); - else - return scm_c_make_subr (name, type, fcn); -} - -SCM -scm_make_subr (const char *name, int type, SCM (*fcn) ()) -{ - scm_c_issue_deprecation_warning - ("`scm_make_subr' is deprecated. Use `scm_c_define_subr' instead."); - - return scm_c_define_subr (name, type, fcn); -} - -SCM -scm_make_subr_with_generic (const char *name, int type, SCM (*fcn) (), SCM *gf) -{ - scm_c_issue_deprecation_warning - ("`scm_make_subr_with_generic' is deprecated. Use " - "`scm_c_define_subr_with_generic' instead."); - - return scm_c_define_subr_with_generic (name, type, fcn, gf); -} - /* Call thunk(closure) underneath a top-level error handler. * If an error occurs, pass the exitval through err_filter and return it. * If no error occurs, return the value of thunk. @@ -627,6 +589,21 @@ scm_set_smob_mfpe (long tc, if (equalp) scm_set_smob_equalp (tc, equalp); } +size_t +scm_smob_free (SCM obj) +{ + long n = SCM_SMOBNUM (obj); + + scm_c_issue_deprecation_warning + ("`scm_smob_free' is deprecated. " + "It is no longer needed."); + + if (scm_smobs[n].size > 0) + scm_gc_free ((void *) SCM_SMOB_DATA_1 (obj), + scm_smobs[n].size, SCM_SMOBNAME (n)); + return 0; +} + SCM scm_read_0str (char *expr) { @@ -744,17 +721,13 @@ scm_sym2ovcell (SCM sym, SCM obarray) return (SYMBOL . SCM_UNDEFINED). */ -SCM -scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int softness) +static SCM +intern_obarray_soft (SCM symbol, SCM obarray, unsigned int softness) { - SCM symbol = scm_from_locale_symboln (name, len); size_t raw_hash = scm_i_symbol_hash (symbol); size_t hash; SCM lsym; - scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. " - "Use hashtables instead."); - if (scm_is_false (obarray)) { if (softness) @@ -790,6 +763,18 @@ scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int so } +SCM +scm_intern_obarray_soft (const char *name, size_t len, SCM obarray, + unsigned int softness) +{ + SCM symbol = scm_from_locale_symboln (name, len); + + scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. " + "Use hashtables instead."); + + return intern_obarray_soft (symbol, obarray, softness); +} + SCM scm_intern_obarray (const char *name,size_t len,SCM obarray) { @@ -845,10 +830,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0, else if (scm_is_eq (o, SCM_BOOL_T)) o = SCM_BOOL_F; - vcell = scm_intern_obarray_soft (scm_i_string_chars (s), - scm_i_string_length (s), - o, - softness); + vcell = intern_obarray_soft (scm_string_to_symbol (s), o, softness); if (scm_is_false (vcell)) return vcell; answer = SCM_CAR (vcell); @@ -1065,7 +1047,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, { char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN]; char *name = buf; - int len, n_digits; + int n_digits; + size_t len; scm_c_issue_deprecation_warning ("`gentemp' is deprecated. " "Use `gensym' instead."); @@ -1079,9 +1062,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, { SCM_VALIDATE_STRING (1, prefix); len = scm_i_string_length (prefix); - if (len > MAX_PREFIX_LENGTH) - name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN); - strncpy (name, scm_i_string_chars (prefix), len); + name = scm_to_locale_stringn (prefix, &len); + name = scm_realloc (name, len + SCM_INTBUFLEN); } if (SCM_UNBNDP (obarray)) @@ -1103,7 +1085,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0, obarray, 0); if (name != buf) - scm_must_free (name); + free (name); return SCM_CAR (vcell); } } @@ -1206,6 +1188,58 @@ scm_round (double x) return scm_c_round (x); } +SCM +scm_sys_expt (SCM x, SCM y) +{ + scm_c_issue_deprecation_warning + ("scm_sys_expt is deprecated. Use scm_expt instead."); + return scm_expt (x, y); +} + +double +scm_asinh (double x) +{ + scm_c_issue_deprecation_warning + ("scm_asinh is deprecated. Use asinh instead."); +#if HAVE_ASINH + return asinh (x); +#else + return log (x + sqrt (x * x + 1)); +#endif +} + +double +scm_acosh (double x) +{ + scm_c_issue_deprecation_warning + ("scm_acosh is deprecated. Use acosh instead."); +#if HAVE_ACOSH + return acosh (x); +#else + return log (x + sqrt (x * x - 1)); +#endif +} + +double +scm_atanh (double x) +{ + scm_c_issue_deprecation_warning + ("scm_atanh is deprecated. Use atanh instead."); +#if HAVE_ATANH + return atanh (x); +#else + return 0.5 * log ((1 + x) / (1 - x)); +#endif +} + +SCM +scm_sys_atan2 (SCM z1, SCM z2) +{ + scm_c_issue_deprecation_warning + ("scm_sys_atan2 is deprecated. Use scm_atan instead."); + return scm_atan (z1, z2); +} + char * scm_i_deprecated_symbol_chars (SCM sym) { @@ -1299,65 +1333,222 @@ scm_vector_equal_p (SCM x, SCM y) return scm_equal_p (x, y); } -int -scm_i_arrayp (SCM a) -{ - scm_c_issue_deprecation_warning - ("SCM_ARRAYP is deprecated. Use scm_is_array instead."); - return SCM_I_ARRAYP(a) || SCM_I_ENCLOSED_ARRAYP(a); -} +SCM_DEFINE (scm_uniform_vector_read_x, "uniform-vector-read!", 1, 3, 0, + (SCM uvec, SCM port_or_fd, SCM start, SCM end), + "Fill the elements of @var{uvec} by reading\n" + "raw bytes from @var{port-or-fdes}, using host byte order.\n\n" + "The optional arguments @var{start} (inclusive) and @var{end}\n" + "(exclusive) allow a specified region to be read,\n" + "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" + "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" + "been partially filled before reaching end-of-file or in\n" + "the single call to read(2).\n\n" + "@code{uniform-vector-read!} returns the number of elements\n" + "read.\n\n" + "@var{port-or-fdes} may be omitted, in which case it defaults\n" + "to the value returned by @code{(current-input-port)}.") +#define FUNC_NAME s_scm_uniform_vector_read_x +{ + size_t width; + SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, uvec); -size_t -scm_i_array_ndim (SCM a) -{ - scm_c_issue_deprecation_warning - ("SCM_ARRAY_NDIM is deprecated. " - "Use scm_c_array_rank or scm_array_handle_rank instead."); - return scm_c_array_rank (a); -} + scm_c_issue_deprecation_warning + ("`uniform-vector-read!' is deprecated. Use `get-bytevector-n!' from\n" + "`(rnrs io ports)' instead."); -int -scm_i_array_contp (SCM a) -{ - scm_c_issue_deprecation_warning - ("SCM_ARRAY_CONTP is deprecated. Do not use it."); - return SCM_I_ARRAY_CONTP (a); -} + width = scm_to_size_t (scm_uniform_vector_element_size (uvec)); -scm_t_array * -scm_i_array_mem (SCM a) -{ - scm_c_issue_deprecation_warning - ("SCM_ARRAY_MEM is deprecated. Do not use it."); - return (scm_t_array *)SCM_I_ARRAY_MEM (a); + return scm_get_bytevector_n_x (port_or_fd, uvec, + scm_from_size_t (scm_to_size_t (start)*width), + scm_from_size_t ((scm_to_size_t (end) + - scm_to_size_t (start)) + * width)); } +#undef FUNC_NAME -SCM -scm_i_array_v (SCM a) -{ - /* We could use scm_shared_array_root here, but it is better to move - them away from expecting vectors as the basic storage for arrays. - */ - scm_c_issue_deprecation_warning - ("SCM_ARRAY_V is deprecated. Do not use it."); - return SCM_I_ARRAY_V (a); +SCM_DEFINE (scm_uniform_vector_write, "uniform-vector-write", 1, 3, 0, + (SCM uvec, SCM port_or_fd, SCM start, SCM end), + "Write the elements of @var{uvec} as raw bytes to\n" + "@var{port-or-fdes}, in the host byte order.\n\n" + "The optional arguments @var{start} (inclusive)\n" + "and @var{end} (exclusive) allow\n" + "a specified region to be written.\n\n" + "When @var{port-or-fdes} is a port, all specified elements\n" + "of @var{uvec} are attempted to be written, potentially blocking\n" + "while waiting for more room.\n" + "When @var{port-or-fd} is an integer, a single call to\n" + "write(2) is made.\n\n" + "An error is signalled when the last element has only\n" + "been partially written in the single call to write(2).\n\n" + "The number of objects actually written is returned.\n" + "@var{port-or-fdes} may be\n" + "omitted, in which case it defaults to the value returned by\n" + "@code{(current-output-port)}.") +#define FUNC_NAME s_scm_uniform_vector_write +{ + size_t width; + SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, uvec); + port_or_fd = SCM_COERCE_OUTPORT (port_or_fd); + + scm_c_issue_deprecation_warning + ("`uniform-vector-write' is deprecated. Use `put-bytevector' from\n" + "`(rnrs io ports)' instead."); + + width = scm_to_size_t (scm_uniform_vector_element_size (uvec)); + + return scm_put_bytevector (port_or_fd, uvec, + scm_from_size_t (scm_to_size_t (start)*width), + scm_from_size_t ((scm_to_size_t (end) + - scm_to_size_t (start)) + * width)); } +#undef FUNC_NAME -size_t -scm_i_array_base (SCM a) +static SCM +scm_ra2contig (SCM ra, int copy) { - scm_c_issue_deprecation_warning - ("SCM_ARRAY_BASE is deprecated. Do not use it."); - return SCM_I_ARRAY_BASE (a); + SCM ret; + long inc = 1; + size_t k, len = 1; + for (k = SCM_I_ARRAY_NDIM (ra); k--;) + len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1; + k = SCM_I_ARRAY_NDIM (ra); + if (SCM_I_ARRAY_CONTP (ra) && ((0 == k) || (1 == SCM_I_ARRAY_DIMS (ra)[k - 1].inc))) + { + if (!scm_is_bitvector (SCM_I_ARRAY_V (ra))) + return ra; + if ((len == scm_c_bitvector_length (SCM_I_ARRAY_V (ra)) && + 0 == SCM_I_ARRAY_BASE (ra) % SCM_LONG_BIT && + 0 == len % SCM_LONG_BIT)) + return ra; + } + ret = scm_i_make_array (k); + SCM_I_ARRAY_BASE (ret) = 0; + while (k--) + { + SCM_I_ARRAY_DIMS (ret)[k].lbnd = SCM_I_ARRAY_DIMS (ra)[k].lbnd; + SCM_I_ARRAY_DIMS (ret)[k].ubnd = SCM_I_ARRAY_DIMS (ra)[k].ubnd; + SCM_I_ARRAY_DIMS (ret)[k].inc = inc; + inc *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1; + } + SCM_I_ARRAY_V (ret) = + scm_make_generalized_vector (scm_array_type (ra), scm_from_size_t (inc), + SCM_UNDEFINED); + if (copy) + scm_array_copy_x (ra, ret); + return ret; +} + +SCM_DEFINE (scm_uniform_array_read_x, "uniform-array-read!", 1, 3, 0, + (SCM ura, SCM port_or_fd, SCM start, SCM end), + "@deffnx {Scheme Procedure} uniform-vector-read! uve [port-or-fdes] [start] [end]\n" + "Attempt to read all elements of @var{ura}, in lexicographic order, as\n" + "binary objects from @var{port-or-fdes}.\n" + "If an end of file is encountered,\n" + "the objects up to that point are put into @var{ura}\n" + "(starting at the beginning) and the remainder of the array is\n" + "unchanged.\n\n" + "The optional arguments @var{start} and @var{end} allow\n" + "a specified region of a vector (or linearized array) to be read,\n" + "leaving the remainder of the vector unchanged.\n\n" + "@code{uniform-array-read!} returns the number of objects read.\n" + "@var{port-or-fdes} may be omitted, in which case it defaults to the value\n" + "returned by @code{(current-input-port)}.") +#define FUNC_NAME s_scm_uniform_array_read_x +{ + if (SCM_UNBNDP (port_or_fd)) + port_or_fd = scm_current_input_port (); + + if (scm_is_uniform_vector (ura)) + { + return scm_uniform_vector_read_x (ura, port_or_fd, start, end); + } + else if (SCM_I_ARRAYP (ura)) + { + size_t base, vlen, cstart, cend; + SCM cra, ans; + + cra = scm_ra2contig (ura, 0); + base = SCM_I_ARRAY_BASE (cra); + vlen = SCM_I_ARRAY_DIMS (cra)->inc * + (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1); + + cstart = 0; + cend = vlen; + if (!SCM_UNBNDP (start)) + { + cstart = scm_to_unsigned_integer (start, 0, vlen); + if (!SCM_UNBNDP (end)) + cend = scm_to_unsigned_integer (end, cstart, vlen); + } + + ans = scm_uniform_vector_read_x (SCM_I_ARRAY_V (cra), port_or_fd, + scm_from_size_t (base + cstart), + scm_from_size_t (base + cend)); + + if (!scm_is_eq (cra, ura)) + scm_array_copy_x (cra, ura); + return ans; + } + else + scm_wrong_type_arg_msg (NULL, 0, ura, "array"); } +#undef FUNC_NAME -scm_t_array_dim * -scm_i_array_dims (SCM a) -{ - scm_c_issue_deprecation_warning - ("SCM_ARRAY_DIMS is deprecated. Use scm_array_handle_dims instead."); - return SCM_I_ARRAY_DIMS (a); +SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0, + (SCM ura, SCM port_or_fd, SCM start, SCM end), + "Writes all elements of @var{ura} as binary objects to\n" + "@var{port-or-fdes}.\n\n" + "The optional arguments @var{start}\n" + "and @var{end} allow\n" + "a specified region of a vector (or linearized array) to be written.\n\n" + "The number of objects actually written is returned.\n" + "@var{port-or-fdes} may be\n" + "omitted, in which case it defaults to the value returned by\n" + "@code{(current-output-port)}.") +#define FUNC_NAME s_scm_uniform_array_write +{ + if (SCM_UNBNDP (port_or_fd)) + port_or_fd = scm_current_output_port (); + + if (scm_is_uniform_vector (ura)) + { + return scm_uniform_vector_write (ura, port_or_fd, start, end); + } + else if (SCM_I_ARRAYP (ura)) + { + size_t base, vlen, cstart, cend; + SCM cra, ans; + + cra = scm_ra2contig (ura, 1); + base = SCM_I_ARRAY_BASE (cra); + vlen = SCM_I_ARRAY_DIMS (cra)->inc * + (SCM_I_ARRAY_DIMS (cra)->ubnd - SCM_I_ARRAY_DIMS (cra)->lbnd + 1); + + cstart = 0; + cend = vlen; + if (!SCM_UNBNDP (start)) + { + cstart = scm_to_unsigned_integer (start, 0, vlen); + if (!SCM_UNBNDP (end)) + cend = scm_to_unsigned_integer (end, cstart, vlen); + } + + ans = scm_uniform_vector_write (SCM_I_ARRAY_V (cra), port_or_fd, + scm_from_size_t (base + cstart), + scm_from_size_t (base + cend)); + + return ans; + } + else + scm_wrong_type_arg_msg (NULL, 0, ura, "array"); } +#undef FUNC_NAME SCM scm_i_cur_inp (void) @@ -1407,14 +1598,6 @@ scm_i_deprecated_dynwinds (void) return scm_i_dynwinds (); } -scm_t_debug_frame * -scm_i_deprecated_last_debug_frame (void) -{ - scm_c_issue_deprecation_warning - ("scm_last_debug_frame is deprecated. Do not use it."); - return scm_i_last_debug_frame (); -} - SCM_STACKITEM * scm_i_stack_base (void) { @@ -1431,14 +1614,178 @@ scm_i_fluidp (SCM x) return scm_is_fluid (x); } + +/* Networking. */ + +#ifdef HAVE_NETWORKING + +SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0, + (SCM address), + "Convert an IPv4 Internet address from printable string\n" + "(dotted decimal notation) to an integer. E.g.,\n\n" + "@lisp\n" + "(inet-aton \"127.0.0.1\") @result{} 2130706433\n" + "@end lisp") +#define FUNC_NAME s_scm_inet_aton +{ + scm_c_issue_deprecation_warning + ("`inet-aton' is deprecated. Use `inet-pton' instead."); + + return scm_inet_pton (scm_from_int (AF_INET), address); +} +#undef FUNC_NAME + + +SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0, + (SCM inetid), + "Convert an IPv4 Internet address to a printable\n" + "(dotted decimal notation) string. E.g.,\n\n" + "@lisp\n" + "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n" + "@end lisp") +#define FUNC_NAME s_scm_inet_ntoa +{ + scm_c_issue_deprecation_warning + ("`inet-ntoa' is deprecated. Use `inet-ntop' instead."); + + return scm_inet_ntop (scm_from_int (AF_INET), inetid); +} +#undef FUNC_NAME + +#endif /* HAVE_NETWORKING */ + + void scm_i_defer_ints_etc () { scm_c_issue_deprecation_warning - ("SCM_CRITICAL_SECTION_START etc are deprecated. " + ("SCM_DEFER_INTS etc are deprecated. " "Use a mutex instead if appropriate."); } +int +scm_i_mask_ints (void) +{ + scm_c_issue_deprecation_warning ("`scm_mask_ints' is deprecated."); + return (SCM_I_CURRENT_THREAD->block_asyncs != 0); +} + + +SCM +scm_guard (SCM guardian, SCM obj, int throw_p) +{ + scm_c_issue_deprecation_warning + ("scm_guard is deprecated. Use scm_call_1 instead."); + + return scm_call_1 (guardian, obj); +} + +SCM +scm_get_one_zombie (SCM guardian) +{ + scm_c_issue_deprecation_warning + ("scm_guard is deprecated. Use scm_call_0 instead."); + + return scm_call_0 (guardian); +} + +SCM_DEFINE (scm_guardian_destroyed_p, "guardian-destroyed?", 1, 0, 0, + (SCM guardian), + "Return @code{#t} if @var{guardian} has been destroyed, otherwise @code{#f}.") +#define FUNC_NAME s_scm_guardian_destroyed_p +{ + scm_c_issue_deprecation_warning + ("'guardian-destroyed?' is deprecated."); + return SCM_BOOL_F; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_guardian_greedy_p, "guardian-greedy?", 1, 0, 0, + (SCM guardian), + "Return @code{#t} if @var{guardian} is a greedy guardian, otherwise @code{#f}.") +#define FUNC_NAME s_scm_guardian_greedy_p +{ + scm_c_issue_deprecation_warning + ("'guardian-greedy?' is deprecated."); + return SCM_BOOL_F; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_destroy_guardian_x, "destroy-guardian!", 1, 0, 0, + (SCM guardian), + "Destroys @var{guardian}, by making it impossible to put any more\n" + "objects in it or get any objects from it. It also unguards any\n" + "objects guarded by @var{guardian}.") +#define FUNC_NAME s_scm_destroy_guardian_x +{ + scm_c_issue_deprecation_warning + ("'destroy-guardian!' is deprecated and ineffective."); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + + +/* GC-related things. */ + +unsigned long scm_mallocated, scm_mtrigger; +size_t scm_max_segment_size; + +#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST) +SCM +scm_map_free_list (void) +{ + return SCM_EOL; +} +#endif + +#if defined (GUILE_DEBUG_FREELIST) +SCM +scm_gc_set_debug_check_freelist_x (SCM flag) +{ + return SCM_UNSPECIFIED; +} +#endif + + +/* Trampolines + * + * Trampolines were an intent to speed up calling the same Scheme procedure many + * times from C. + * + * However, this was the wrong thing to optimize; if you really know what you're + * calling, call its function directly, otherwise you're in Scheme-land, and we + * have many better tricks there (inlining, for example, which can remove the + * need for closures and free variables). + * + * Also, in the normal debugging case, trampolines were being computed but not + * used. Silliness. + */ + +scm_t_trampoline_0 +scm_trampoline_0 (SCM proc) +{ + scm_c_issue_deprecation_warning + ("`scm_trampoline_0' is deprecated. Just use `scm_call_0' instead."); + return scm_call_0; +} + +scm_t_trampoline_1 +scm_trampoline_1 (SCM proc) +{ + scm_c_issue_deprecation_warning + ("`scm_trampoline_1' is deprecated. Just use `scm_call_1' instead."); + return scm_call_1; +} + +scm_t_trampoline_2 +scm_trampoline_2 (SCM proc) +{ + scm_c_issue_deprecation_warning + ("`scm_trampoline_2' is deprecated. Just use `scm_call_2' instead."); + return scm_call_2; +} + + void scm_i_init_deprecated () {