summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2017-05-22 13:36:42 +0200
committerAndy Wingo <wingo@pobox.com>2017-05-22 13:36:42 +0200
commitc248ea10beb2afa4c113dbc6dc707bed5dbfc92e (patch)
treedb395a46941c1a13096f9b49dd6b1405fd38dfc7 /libguile
parent8f4597d1da371c23e19721c2fdb3177c3ae73f14 (diff)
downloadguile-c248ea10beb2afa4c113dbc6dc707bed5dbfc92e.tar.gz
Remove all deprecated code
* module/ice-9/debug.scm: * module/ice-9/mapping.scm: * module/ice-9/syncase.scm: Delete these deprecated files. * module/Makefile.am: Remove deleted files. * libguile/deprecated.c: * libguile/deprecated.h: * libguile/backtrace.c: * libguile/goops.c: * libguile/numbers.c: * libguile/socket.c: * libguile/srfi-13.c: * module/ice-9/deprecated.scm: * module/ice-9/format.scm: * module/oop/goops.scm: * module/statprof.scm: * module/texinfo/reflection.scm: * module/web/client.scm: * module/web/uri.scm: Remove deprecated code.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/backtrace.c13
-rw-r--r--libguile/deprecated.c933
-rw-r--r--libguile/deprecated.h253
-rw-r--r--libguile/goops.c4
-rw-r--r--libguile/numbers.c9
-rw-r--r--libguile/socket.c5
-rw-r--r--libguile/srfi-13.c32
7 files changed, 6 insertions, 1243 deletions
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 495a68bad..6eb7454ce 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -170,19 +170,6 @@ SCM_DEFINE (scm_display_error, "display-error", 6, 0, 0,
{
SCM_VALIDATE_OUTPUT_PORT (2, port);
-#if SCM_ENABLE_DEPRECATED
- if (SCM_STACKP (frame))
- {
- scm_c_issue_deprecation_warning
- ("Passing a stack as the first argument to `scm_display_error' is "
- "deprecated. Pass a frame instead.");
- if (SCM_STACK_LENGTH (frame))
- frame = scm_stack_ref (frame, SCM_INUM0);
- else
- frame = SCM_BOOL_F;
- }
-#endif
-
scm_i_display_error (frame, port, subr, message, args, rest);
return SCM_UNSPECIFIED;
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index cee6b1d74..acf9b198f 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1,8 +1,4 @@
-/* This file contains definitions for deprecated features. When you
- deprecate something, move it here when that is feasible.
-*/
-
-/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 2003-2004, 2006, 2008-2017 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
@@ -26,9 +22,6 @@
#define SCM_BUILDING_DEPRECATED_CODE
-#include <sys/types.h>
-#include <unistd.h>
-
#include "libguile/_scm.h"
#include "libguile/deprecation.h"
@@ -36,934 +29,14 @@
-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;
-}
-
-
-
-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);
-}
-
-
-
-
-SCM_GLOBAL_SYMBOL (scm_memory_alloc_key, "memory-allocation-error");
-void
-scm_memory_error (const char *subr)
-{
- scm_c_issue_deprecation_warning
- ("scm_memory_error is deprecated. Use scm_report_out_of_memory to raise "
- "an exception, or abort() to cause the program to exit.");
-
- fprintf (stderr, "FATAL: memory error in %s\n", subr);
- abort ();
-}
-
-
-
-
-static SCM var_slot_ref_using_class = SCM_BOOL_F;
-static SCM var_slot_set_using_class_x = SCM_BOOL_F;
-static SCM var_slot_bound_using_class_p = SCM_BOOL_F;
-static SCM var_slot_exists_using_class_p = SCM_BOOL_F;
-
-SCM scm_no_applicable_method = SCM_BOOL_F;
-
-SCM var_get_keyword = SCM_BOOL_F;
-
-SCM scm_class_boolean, scm_class_char, scm_class_pair;
-SCM scm_class_procedure, scm_class_string, scm_class_symbol;
-SCM scm_class_primitive_generic;
-SCM scm_class_vector, scm_class_null;
-SCM scm_class_integer, scm_class_real, scm_class_complex, scm_class_fraction;
-SCM scm_class_unknown;
-SCM scm_class_top, scm_class_object, scm_class_class;
-SCM scm_class_applicable;
-SCM scm_class_applicable_struct, scm_class_applicable_struct_with_setter;
-SCM scm_class_generic, scm_class_generic_with_setter;
-SCM scm_class_accessor;
-SCM scm_class_extended_generic, scm_class_extended_generic_with_setter;
-SCM scm_class_extended_accessor;
-SCM scm_class_method;
-SCM scm_class_accessor_method;
-SCM scm_class_procedure_class;
-SCM scm_class_applicable_struct_class;
-SCM scm_class_number, scm_class_list;
-SCM scm_class_keyword;
-SCM scm_class_port, scm_class_input_output_port;
-SCM scm_class_input_port, scm_class_output_port;
-SCM scm_class_foreign_slot;
-SCM scm_class_self, scm_class_protected;
-SCM scm_class_hidden, scm_class_opaque, scm_class_read_only;
-SCM scm_class_protected_hidden, scm_class_protected_opaque, scm_class_protected_read_only;
-SCM scm_class_scm;
-SCM scm_class_int, scm_class_float, scm_class_double;
-
-SCM *scm_port_class, *scm_smob_class;
-
-void
-scm_init_deprecated_goops (void)
-{
- var_slot_ref_using_class = scm_c_lookup ("slot-ref-using-class");
- var_slot_set_using_class_x = scm_c_lookup ("slot-set-using-class!");
- var_slot_bound_using_class_p = scm_c_lookup ("slot-bound-using-class?");
- var_slot_exists_using_class_p = scm_c_lookup ("slot-exists-using-class?");
-
- scm_no_applicable_method =
- scm_variable_ref (scm_c_lookup ("no-applicable-method"));
-
- var_get_keyword = scm_c_lookup ("get-keyword");
-
- scm_class_class = scm_variable_ref (scm_c_lookup ("<class>"));
- scm_class_top = scm_variable_ref (scm_c_lookup ("<top>"));
- scm_class_object = scm_variable_ref (scm_c_lookup ("<object>"));
-
- scm_class_foreign_slot = scm_variable_ref (scm_c_lookup ("<foreign-slot>"));
- scm_class_protected = scm_variable_ref (scm_c_lookup ("<protected-slot>"));
- scm_class_hidden = scm_variable_ref (scm_c_lookup ("<hidden-slot>"));
- scm_class_opaque = scm_variable_ref (scm_c_lookup ("<opaque-slot>"));
- scm_class_read_only = scm_variable_ref (scm_c_lookup ("<read-only-slot>"));
- scm_class_self = scm_variable_ref (scm_c_lookup ("<self-slot>"));
- scm_class_protected_opaque = scm_variable_ref (scm_c_lookup ("<protected-opaque-slot>"));
- scm_class_protected_hidden = scm_variable_ref (scm_c_lookup ("<protected-hidden-slot>"));
- scm_class_protected_read_only = scm_variable_ref (scm_c_lookup ("<protected-read-only-slot>"));
- scm_class_scm = scm_variable_ref (scm_c_lookup ("<scm-slot>"));
- scm_class_int = scm_variable_ref (scm_c_lookup ("<int-slot>"));
- scm_class_float = scm_variable_ref (scm_c_lookup ("<float-slot>"));
- scm_class_double = scm_variable_ref (scm_c_lookup ("<double-slot>"));
-
- /* scm_class_generic functions classes */
- scm_class_procedure_class = scm_variable_ref (scm_c_lookup ("<procedure-class>"));
- scm_class_applicable_struct_class = scm_variable_ref (scm_c_lookup ("<applicable-struct-class>"));
-
- scm_class_method = scm_variable_ref (scm_c_lookup ("<method>"));
- scm_class_accessor_method = scm_variable_ref (scm_c_lookup ("<accessor-method>"));
- scm_class_applicable = scm_variable_ref (scm_c_lookup ("<applicable>"));
- scm_class_applicable_struct = scm_variable_ref (scm_c_lookup ("<applicable-struct>"));
- scm_class_applicable_struct_with_setter = scm_variable_ref (scm_c_lookup ("<applicable-struct-with-setter>"));
- scm_class_generic = scm_variable_ref (scm_c_lookup ("<generic>"));
- scm_class_extended_generic = scm_variable_ref (scm_c_lookup ("<extended-generic>"));
- scm_class_generic_with_setter = scm_variable_ref (scm_c_lookup ("<generic-with-setter>"));
- scm_class_accessor = scm_variable_ref (scm_c_lookup ("<accessor>"));
- scm_class_extended_generic_with_setter = scm_variable_ref (scm_c_lookup ("<extended-generic-with-setter>"));
- scm_class_extended_accessor = scm_variable_ref (scm_c_lookup ("<extended-accessor>"));
-
- /* Primitive types classes */
- scm_class_boolean = scm_variable_ref (scm_c_lookup ("<boolean>"));
- scm_class_char = scm_variable_ref (scm_c_lookup ("<char>"));
- scm_class_list = scm_variable_ref (scm_c_lookup ("<list>"));
- scm_class_pair = scm_variable_ref (scm_c_lookup ("<pair>"));
- scm_class_null = scm_variable_ref (scm_c_lookup ("<null>"));
- scm_class_string = scm_variable_ref (scm_c_lookup ("<string>"));
- scm_class_symbol = scm_variable_ref (scm_c_lookup ("<symbol>"));
- scm_class_vector = scm_variable_ref (scm_c_lookup ("<vector>"));
- scm_class_number = scm_variable_ref (scm_c_lookup ("<number>"));
- scm_class_complex = scm_variable_ref (scm_c_lookup ("<complex>"));
- scm_class_real = scm_variable_ref (scm_c_lookup ("<real>"));
- scm_class_integer = scm_variable_ref (scm_c_lookup ("<integer>"));
- scm_class_fraction = scm_variable_ref (scm_c_lookup ("<fraction>"));
- scm_class_keyword = scm_variable_ref (scm_c_lookup ("<keyword>"));
- scm_class_unknown = scm_variable_ref (scm_c_lookup ("<unknown>"));
- scm_class_procedure = scm_variable_ref (scm_c_lookup ("<procedure>"));
- scm_class_primitive_generic = scm_variable_ref (scm_c_lookup ("<primitive-generic>"));
- scm_class_port = scm_variable_ref (scm_c_lookup ("<port>"));
- scm_class_input_port = scm_variable_ref (scm_c_lookup ("<input-port>"));
- scm_class_output_port = scm_variable_ref (scm_c_lookup ("<output-port>"));
- scm_class_input_output_port = scm_variable_ref (scm_c_lookup ("<input-output-port>"));
-
- scm_smob_class = scm_i_smob_class;
-}
-
-SCM
-scm_get_keyword (SCM kw, SCM initargs, SCM default_value)
-{
- scm_c_issue_deprecation_warning
- ("scm_get_keyword is deprecated. Use `kw-arg-ref' from Scheme instead.");
-
- return scm_call_3 (scm_variable_ref (var_get_keyword),
- kw, initargs, default_value);
-}
-
-#define BUFFSIZE 32 /* big enough for most uses */
-#define SPEC_OF(x) \
- (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("specializers"))))
-#define CPL_OF(x) \
- (scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("cpl"))))
-
-static SCM
-scm_i_vector2list (SCM l, long len)
-{
- long j;
- SCM z = scm_c_make_vector (len, SCM_UNDEFINED);
-
- for (j = 0; j < len; j++, l = SCM_CDR (l)) {
- SCM_SIMPLE_VECTOR_SET (z, j, SCM_CAR (l));
- }
- return z;
-}
-
-static int
-applicablep (SCM actual, SCM formal)
-{
- /* We already know that the cpl is well formed. */
- return scm_is_true (scm_c_memq (formal, CPL_OF (actual)));
-}
-
-static int
-more_specificp (SCM m1, SCM m2, SCM const *targs)
-{
- register SCM s1, s2;
- register long i;
- /*
- * Note:
- * m1 and m2 can have != length (i.e. one can be one element longer than the
- * other when we have a dotted parameter list). For instance, with the call
- * (M 1)
- * with
- * (define-method M (a . l) ....)
- * (define-method M (a) ....)
- *
- * we consider that the second method is more specific.
- *
- * BTW, targs is an array of types. We don't need it's size since
- * we already know that m1 and m2 are applicable (no risk to go past
- * the end of this array).
- *
- */
- for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) {
- if (scm_is_null(s1)) return 1;
- if (scm_is_null(s2)) return 0;
- if (!scm_is_eq (SCM_CAR(s1), SCM_CAR(s2))) {
- register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2);
-
- for (l = CPL_OF (targs[i]); ; l = SCM_CDR(l)) {
- if (scm_is_eq (cs1, SCM_CAR (l)))
- return 1;
- if (scm_is_eq (cs2, SCM_CAR (l)))
- return 0;
- }
- return 0;/* should not occur! */
- }
- }
- return 0; /* should not occur! */
-}
-
-static SCM
-sort_applicable_methods (SCM method_list, long size, SCM const *targs)
-{
- long i, j, incr;
- SCM *v, vector = SCM_EOL;
- SCM buffer[BUFFSIZE];
- SCM save = method_list;
- scm_t_array_handle handle;
-
- /* For reasonably sized method_lists we can try to avoid all the
- * consing and reorder the list in place...
- * This idea is due to David McClain <Dave_McClain@msn.com>
- */
- if (size <= BUFFSIZE)
- {
- for (i = 0; i < size; i++)
- {
- buffer[i] = SCM_CAR (method_list);
- method_list = SCM_CDR (method_list);
- }
- v = buffer;
- }
- else
- {
- /* Too many elements in method_list to keep everything locally */
- vector = scm_i_vector2list (save, size);
- v = scm_vector_writable_elements (vector, &handle, NULL, NULL);
- }
-
- /* Use a simple shell sort since it is generally faster than qsort on
- * small vectors (which is probably mostly the case when we have to
- * sort a list of applicable methods).
- */
- for (incr = size / 2; incr; incr /= 2)
- {
- for (i = incr; i < size; i++)
- {
- for (j = i - incr; j >= 0; j -= incr)
- {
- if (more_specificp (v[j], v[j+incr], targs))
- break;
- else
- {
- SCM tmp = v[j + incr];
- v[j + incr] = v[j];
- v[j] = tmp;
- }
- }
- }
- }
-
- if (size <= BUFFSIZE)
- {
- /* We did it in locally, so restore the original list (reordered) in-place */
- for (i = 0, method_list = save; i < size; i++, v++)
- {
- SCM_SETCAR (method_list, *v);
- method_list = SCM_CDR (method_list);
- }
- return save;
- }
-
- /* If we are here, that's that we did it the hard way... */
- scm_array_handle_release (&handle);
- return scm_vector_to_list (vector);
-}
-
-SCM
-scm_compute_applicable_methods (SCM gf, SCM args, long len, int find_method_p)
-{
- register long i;
- long count = 0;
- SCM l, fl, applicable = SCM_EOL;
- SCM save = args;
- SCM buffer[BUFFSIZE];
- SCM const *types;
- SCM *p;
- SCM tmp = SCM_EOL;
- scm_t_array_handle handle;
-
- scm_c_issue_deprecation_warning
- ("scm_compute_applicable_methods is deprecated. Use "
- "`compute-applicable-methods' from Scheme instead.");
-
- /* Build the list of arguments types */
- if (len >= BUFFSIZE)
- {
- tmp = scm_c_make_vector (len, SCM_UNDEFINED);
- types = p = scm_vector_writable_elements (tmp, &handle, NULL, NULL);
-
- /*
- note that we don't have to work to reset the generation
- count. TMP is a new vector anyway, and it is found
- conservatively.
- */
- }
- else
- types = p = buffer;
-
- for ( ; !scm_is_null (args); args = SCM_CDR (args))
- *p++ = scm_class_of (SCM_CAR (args));
-
- /* Build a list of all applicable methods */
- for (l = scm_generic_function_methods (gf); !scm_is_null (l); l = SCM_CDR (l))
- {
- fl = SPEC_OF (SCM_CAR (l));
- for (i = 0; ; i++, fl = SCM_CDR (fl))
- {
- if (SCM_INSTANCEP (fl)
- /* We have a dotted argument list */
- || (i >= len && scm_is_null (fl)))
- { /* both list exhausted */
- applicable = scm_cons (SCM_CAR (l), applicable);
- count += 1;
- break;
- }
- if (i >= len
- || scm_is_null (fl)
- || !applicablep (types[i], SCM_CAR (fl)))
- break;
- }
- }
-
- if (len >= BUFFSIZE)
- scm_array_handle_release (&handle);
-
- if (count == 0)
- {
- if (find_method_p)
- return SCM_BOOL_F;
- scm_call_2 (scm_no_applicable_method, gf, save);
- /* if we are here, it's because no-applicable-method hasn't signaled an error */
- return SCM_BOOL_F;
- }
-
- return (count == 1
- ? applicable
- : sort_applicable_methods (applicable, count, types));
-}
-
-SCM_SYMBOL (sym_compute_applicable_methods, "compute-applicable-methods");
-
-SCM
-scm_find_method (SCM l)
-#define FUNC_NAME "find-method"
-{
- SCM gf;
- long len = scm_ilength (l);
-
- if (len == 0)
- SCM_WRONG_NUM_ARGS ();
-
- scm_c_issue_deprecation_warning
- ("scm_find_method is deprecated. Use `compute-applicable-methods' "
- "from Scheme instead.");
-
- gf = SCM_CAR(l); l = SCM_CDR(l);
- SCM_VALIDATE_GENERIC (1, gf);
- if (scm_is_null (scm_slot_ref (gf, scm_from_latin1_symbol ("methods"))))
- SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf));
-
- return scm_compute_applicable_methods (gf, l, len - 1, 1);
-}
-#undef FUNC_NAME
-
-SCM
-scm_basic_make_class (SCM meta, SCM name, SCM dsupers, SCM dslots)
-{
- scm_c_issue_deprecation_warning
- ("scm_basic_make_class is deprecated. Use `define-class' in Scheme,"
- "or use `(make META #:name NAME #:dsupers DSUPERS #:slots DSLOTS)' "
- "in Scheme.");
-
- return scm_make_standard_class (meta, name, dsupers, dslots);
-}
-
-/* Scheme will issue the deprecation warning for these. */
-SCM
-scm_slot_ref_using_class (SCM class, SCM obj, SCM slot_name)
-{
- return scm_call_3 (scm_variable_ref (var_slot_ref_using_class),
- class, obj, slot_name);
-}
-
-SCM
-scm_slot_set_using_class_x (SCM class, SCM obj, SCM slot_name, SCM value)
-{
- return scm_call_4 (scm_variable_ref (var_slot_set_using_class_x),
- class, obj, slot_name, value);
-}
-
-SCM
-scm_slot_bound_using_class_p (SCM class, SCM obj, SCM slot_name)
-{
- return scm_call_3 (scm_variable_ref (var_slot_bound_using_class_p),
- class, obj, slot_name);
-}
-
-SCM
-scm_slot_exists_using_class_p (SCM class, SCM obj, SCM slot_name)
-{
- return scm_call_3 (scm_variable_ref (var_slot_exists_using_class_p),
- class, obj, slot_name);
-}
-
-
-
-#define FETCH_STORE(fet,mem,sto) \
- do { \
- scm_i_scm_pthread_mutex_lock (&scm_i_misc_mutex); \
- (fet) = (mem); \
- (mem) = (sto); \
- scm_i_pthread_mutex_unlock (&scm_i_misc_mutex); \
- } while (0)
-
-static scm_t_bits scm_tc16_arbiter;
-
-
-#define SCM_LOCK_VAL (scm_tc16_arbiter | (1L << 16))
-#define SCM_UNLOCK_VAL scm_tc16_arbiter
-#define SCM_ARB_LOCKED(arb) ((SCM_CELL_WORD_0 (arb)) & (1L << 16))
-
-
-static int
-arbiter_print (SCM exp, SCM port, scm_print_state *pstate)
-{
- scm_puts ("#<arbiter ", port);
- if (SCM_ARB_LOCKED (exp))
- scm_puts ("locked ", port);
- scm_iprin1 (SCM_PACK (SCM_SMOB_DATA (exp)), port, pstate);
- scm_putc ('>', port);
- return !0;
-}
-
-SCM_DEFINE (scm_make_arbiter, "make-arbiter", 1, 0, 0,
- (SCM name),
- "Return an arbiter object, initially unlocked. Currently\n"
- "@var{name} is only used for diagnostic output.")
-#define FUNC_NAME s_scm_make_arbiter
-{
- scm_c_issue_deprecation_warning
- ("Arbiters are deprecated. "
- "Use mutexes or atomic variables instead.");
-
- SCM_RETURN_NEWSMOB (scm_tc16_arbiter, SCM_UNPACK (name));
-}
-#undef FUNC_NAME
-
-
-/* The atomic FETCH_STORE here is so two threads can't both see the arbiter
- unlocked and return #t. The arbiter itself wouldn't be corrupted by
- this, but two threads both getting #t would be contrary to the intended
- semantics. */
-
-SCM_DEFINE (scm_try_arbiter, "try-arbiter", 1, 0, 0,
- (SCM arb),
- "If @var{arb} is unlocked, then lock it and return @code{#t}.\n"
- "If @var{arb} is already locked, then do nothing and return\n"
- "@code{#f}.")
-#define FUNC_NAME s_scm_try_arbiter
-{
- scm_t_bits old;
- scm_t_bits *loc;
- SCM_VALIDATE_SMOB (1, arb, arbiter);
- loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0);
- FETCH_STORE (old, *loc, SCM_LOCK_VAL);
- return scm_from_bool (old == SCM_UNLOCK_VAL);
-}
-#undef FUNC_NAME
-
-
-/* The atomic FETCH_STORE here is so two threads can't both see the arbiter
- locked and return #t. The arbiter itself wouldn't be corrupted by this,
- but we don't want two threads both thinking they were the unlocker. The
- intended usage is for the code which locked to be responsible for
- unlocking, but we guarantee the return value even if multiple threads
- compete. */
-
-SCM_DEFINE (scm_release_arbiter, "release-arbiter", 1, 0, 0,
- (SCM arb),
- "If @var{arb} is locked, then unlock it and return @code{#t}.\n"
- "If @var{arb} is already unlocked, then do nothing and return\n"
- "@code{#f}.\n"
- "\n"
- "Typical usage is for the thread which locked an arbiter to\n"
- "later release it, but that's not required, any thread can\n"
- "release it.")
-#define FUNC_NAME s_scm_release_arbiter
-{
- scm_t_bits old;
- scm_t_bits *loc;
- SCM_VALIDATE_SMOB (1, arb, arbiter);
- loc = (scm_t_bits*)SCM_SMOB_OBJECT_N_LOC (arb, 0);
- FETCH_STORE (old, *loc, SCM_UNLOCK_VAL);
- return scm_from_bool (old == SCM_LOCK_VAL);
-}
-#undef FUNC_NAME
-
-
-
-
-/* User asyncs. */
-
-static scm_t_bits tc16_async;
-
-/* cmm: this has SCM_ prefix because SCM_MAKE_VALIDATE expects it.
- this is ugly. */
-#define SCM_ASYNCP(X) SCM_TYP16_PREDICATE (tc16_async, X)
-#define VALIDATE_ASYNC(pos, a) SCM_MAKE_VALIDATE_MSG(pos, a, ASYNCP, "user async")
-
-#define ASYNC_GOT_IT(X) (SCM_SMOB_FLAGS (X))
-#define SET_ASYNC_GOT_IT(X, V) (SCM_SET_SMOB_FLAGS ((X), ((V))))
-#define ASYNC_THUNK(X) SCM_SMOB_OBJECT_1 (X)
-
-
-SCM_DEFINE (scm_async, "async", 1, 0, 0,
- (SCM thunk),
- "Create a new async for the procedure @var{thunk}.")
-#define FUNC_NAME s_scm_async
-{
- scm_c_issue_deprecation_warning
- ("\"User asyncs\" are deprecated. Use closures instead.");
-
- SCM_RETURN_NEWSMOB (tc16_async, SCM_UNPACK (thunk));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_async_mark, "async-mark", 1, 0, 0,
- (SCM a),
- "Mark the async @var{a} for future execution.")
-#define FUNC_NAME s_scm_async_mark
-{
- VALIDATE_ASYNC (1, a);
- SET_ASYNC_GOT_IT (a, 1);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_run_asyncs, "run-asyncs", 1, 0, 0,
- (SCM list_of_a),
- "Execute all thunks from the asyncs of the list @var{list_of_a}.")
-#define FUNC_NAME s_scm_run_asyncs
-{
- while (! SCM_NULL_OR_NIL_P (list_of_a))
- {
- SCM a;
- SCM_VALIDATE_CONS (1, list_of_a);
- a = SCM_CAR (list_of_a);
- VALIDATE_ASYNC (SCM_ARG1, a);
- if (ASYNC_GOT_IT (a))
- {
- SET_ASYNC_GOT_IT (a, 0);
- scm_call_0 (ASYNC_THUNK (a));
- }
- list_of_a = SCM_CDR (list_of_a);
- }
- return SCM_BOOL_T;
-}
-#undef FUNC_NAME
-
-
-static scm_i_pthread_mutex_t critical_section_mutex;
-static SCM dynwind_critical_section_mutex;
-
-void
-scm_critical_section_start (void)
-{
- scm_c_issue_deprecation_warning
- ("Critical sections are deprecated. Instead use dynwinds and "
- "\"scm_dynwind_pthread_mutex_lock\" together with "
- "\"scm_dynwind_block_asyncs\" if appropriate.");
-
- scm_i_pthread_mutex_lock (&critical_section_mutex);
- SCM_I_CURRENT_THREAD->block_asyncs++;
-}
-
-void
-scm_critical_section_end (void)
-{
- SCM_I_CURRENT_THREAD->block_asyncs--;
- scm_i_pthread_mutex_unlock (&critical_section_mutex);
- scm_async_tick ();
-}
-
-void
-scm_dynwind_critical_section (SCM mutex)
-{
- scm_c_issue_deprecation_warning
- ("Critical sections are deprecated. Instead use dynwinds and "
- "\"scm_dynwind_pthread_mutex_lock\" together with "
- "\"scm_dynwind_block_asyncs\" if appropriate.");
-
- if (scm_is_false (mutex))
- mutex = dynwind_critical_section_mutex;
- scm_dynwind_lock_mutex (mutex);
- scm_dynwind_block_asyncs ();
-}
-
-
-
-
-SCM
-scm_make_mutex_with_flags (SCM flags)
-{
- SCM kind = SCM_UNDEFINED;
-
- scm_c_issue_deprecation_warning
- ("'scm_make_mutex_with_flags' is deprecated. "
- "Use 'scm_make_mutex_with_kind' instead.");
-
- if (!scm_is_null (flags))
- {
- if (!scm_is_null (scm_cdr (flags)))
- scm_misc_error (NULL, "too many mutex options: ~a", scm_list_1 (flags));
- kind = scm_car (flags);
- }
-
- return scm_make_mutex_with_kind (kind);
-}
-
-SCM
-scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner)
-{
- scm_c_issue_deprecation_warning
- ("'scm_lock_mutex_timed' is deprecated. "
- "Use 'scm_timed_lock_mutex' instead.");
-
- if (!SCM_UNBNDP (owner) && !scm_is_false (owner))
- scm_c_issue_deprecation_warning
- ("The 'owner' argument to 'scm_lock_mutex_timed' is deprecated. "
- "Use SRFI-18 directly if you need this concept.");
-
- return scm_timed_lock_mutex (m, timeout);
-}
-
-SCM
-scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout)
-{
- scm_c_issue_deprecation_warning
- ("'scm_unlock_mutex_timed' is deprecated. "
- "Use just plain old 'scm_unlock_mutex' instead, or otherwise "
- "'scm_wait_condition_variable' if you need to.");
-
- if (!SCM_UNBNDP (cond) &&
- scm_is_false (scm_timed_wait_condition_variable (cond, mx, timeout)))
- return SCM_BOOL_F;
-
- return scm_unlock_mutex (mx);
-}
-
-
-
-SCM
-scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
-#define FUNC_NAME "scm_from_contiguous_array"
-{
- size_t k, rlen = 1;
- scm_t_array_dim *s;
- SCM ra;
- scm_t_array_handle h;
-
- scm_c_issue_deprecation_warning
- ("`scm_from_contiguous_array' is deprecated. Use make-array and array-copy!\n"
- "instead.\n");
-
- ra = scm_i_shap2ra (bounds);
- SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
- s = SCM_I_ARRAY_DIMS (ra);
- k = SCM_I_ARRAY_NDIM (ra);
-
- while (k--)
- {
- s[k].inc = rlen;
- SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
- rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
- }
- if (rlen != len)
- SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
-
- SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED));
- scm_array_get_handle (ra, &h);
- memcpy (h.writable_elements, elts, rlen * sizeof(SCM));
- scm_array_handle_release (&h);
-
- if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
- if (0 == s->lbnd)
- return SCM_I_ARRAY_V (ra);
- return ra;
-}
-#undef FUNC_NAME
-
-
-
-/* {call-with-dynamic-root}
- *
- * Suspending the current thread to evaluate a thunk on the
- * same C stack but under a new root.
- *
- * Calls to call-with-dynamic-root return exactly once (unless
- * the process is somehow exitted). */
-
-/* cwdr fills out both of these structures, and then passes a pointer
- to them through scm_internal_catch to the cwdr_body and
- cwdr_handler functions, to tell them how to behave and to get
- information back from them.
-
- A cwdr is a lot like a catch, except there is no tag (all
- exceptions are caught), and the body procedure takes the arguments
- passed to cwdr as A1 and ARGS. The handler is also special since
- it is not directly run from scm_internal_catch. It is executed
- outside the new dynamic root. */
-
-struct cwdr_body_data {
- /* Arguments to pass to the cwdr body function. */
- SCM a1, args;
-
- /* Scheme procedure to use as body of cwdr. */
- SCM body_proc;
-};
-
-struct cwdr_handler_data {
- /* Do we need to run the handler? */
- int run_handler;
-
- /* The tag and args to pass it. */
- SCM tag, args;
-};
-
-
-/* Invoke the body of a cwdr, assuming that the throw handler has
- already been set up. DATA points to a struct set up by cwdr that
- says what proc to call, and what args to apply it to.
-
- With a little thought, we could replace this with scm_body_thunk,
- but I don't want to mess with that at the moment. */
-static SCM
-cwdr_body (void *data)
-{
- struct cwdr_body_data *c = (struct cwdr_body_data *) data;
-
- return scm_apply (c->body_proc, c->a1, c->args);
-}
-
-/* Record the fact that the body of the cwdr has thrown. Record
- enough information to invoke the handler later when the dynamic
- root has been deestablished. */
-
-static SCM
-cwdr_handler (void *data, SCM tag, SCM args)
-{
- struct cwdr_handler_data *c = (struct cwdr_handler_data *) data;
-
- c->run_handler = 1;
- c->tag = tag;
- c->args = args;
- return SCM_UNSPECIFIED;
-}
-
-SCM
-scm_internal_cwdr (scm_t_catch_body body, void *body_data,
- scm_t_catch_handler handler, void *handler_data,
- SCM_STACKITEM *stack_start)
-{
- struct cwdr_handler_data my_handler_data;
- scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
- SCM answer;
- scm_t_dynstack *old_dynstack;
-
- /* Exit caller's dynamic state.
- */
- old_dynstack = scm_dynstack_capture_all (dynstack);
- scm_dynstack_unwind (dynstack, SCM_DYNSTACK_FIRST (dynstack));
-
- scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
- scm_dynwind_current_dynamic_state (scm_current_dynamic_state ());
-
- my_handler_data.run_handler = 0;
- answer = scm_i_with_continuation_barrier (body, body_data,
- cwdr_handler, &my_handler_data,
- NULL, NULL);
-
- scm_dynwind_end ();
-
- /* Enter caller's dynamic state.
- */
- scm_dynstack_wind (dynstack, SCM_DYNSTACK_FIRST (old_dynstack));
-
- /* Now run the real handler iff the body did a throw. */
- if (my_handler_data.run_handler)
- return handler (handler_data, my_handler_data.tag, my_handler_data.args);
- else
- return answer;
-}
-
-/* The original CWDR for invoking Scheme code with a Scheme handler. */
-
-static SCM
-cwdr (SCM proc, SCM a1, SCM args, SCM handler, SCM_STACKITEM *stack_start)
-{
- struct cwdr_body_data c;
-
- c.a1 = a1;
- c.args = args;
- c.body_proc = proc;
-
- return scm_internal_cwdr (cwdr_body, &c,
- scm_handle_by_proc, &handler,
- stack_start);
-}
-
-SCM_DEFINE (scm_call_with_dynamic_root, "call-with-dynamic-root", 2, 0, 0,
- (SCM thunk, SCM handler),
- "Call @var{thunk} with a new dynamic state and within\n"
- "a continuation barrier. The @var{handler} catches all\n"
- "otherwise uncaught throws and executes within the same\n"
- "dynamic context as @var{thunk}.")
-#define FUNC_NAME s_scm_call_with_dynamic_root
-{
- SCM_STACKITEM stack_place;
- scm_c_issue_deprecation_warning
- ("call-with-dynamic-root is deprecated. There is no replacement.");
- return cwdr (thunk, SCM_EOL, SCM_EOL, handler, &stack_place);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_dynamic_root, "dynamic-root", 0, 0, 0,
- (),
- "Return an object representing the current dynamic root.\n\n"
- "These objects are only useful for comparison using @code{eq?}.\n")
-#define FUNC_NAME s_scm_dynamic_root
-{
- scm_c_issue_deprecation_warning
- ("dynamic-root is deprecated. There is no replacement.");
- return SCM_I_CURRENT_THREAD->continuation_root;
-}
-#undef FUNC_NAME
-
-SCM
-scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler)
-{
- SCM_STACKITEM stack_place;
- scm_c_issue_deprecation_warning
- ("scm_apply_with_dynamic_root is deprecated. There is no replacement.");
- return cwdr (proc, a1, args, handler, &stack_place);
-}
-
-
-
-
-SCM
-scm_make_dynamic_state (SCM parent)
-{
- scm_c_issue_deprecation_warning
- ("scm_make_dynamic_state is deprecated. Dynamic states are "
- "now immutable; just use the parent directly.");
- return SCM_UNBNDP (parent) ? scm_current_dynamic_state () : parent;
-}
-
-
-
-
-int
-SCM_FDES_RANDOM_P (int fdes)
-{
- scm_c_issue_deprecation_warning
- ("SCM_FDES_RANDOM_P is deprecated. Use lseek (fd, 0, SEEK_CUR).");
-
- return (lseek (fdes, 0, SEEK_CUR) == -1) ? 0 : 1;
-}
+/* Newly deprecated code goes here. */
void
scm_i_init_deprecated ()
{
- scm_tc16_arbiter = scm_make_smob_type ("arbiter", 0);
- scm_set_smob_print (scm_tc16_arbiter, arbiter_print);
- tc16_async = scm_make_smob_type ("async", 0);
- scm_i_pthread_mutex_init (&critical_section_mutex,
- scm_i_pthread_mutexattr_recursive);
- dynwind_critical_section_mutex = scm_make_recursive_mutex ();
#include "libguile/deprecated.x"
}
-#endif
+#endif /* SCM_ENABLE_DEPRECATD == 1 */
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 2c49076a1..af5e901d7 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -1,11 +1,7 @@
-/* This file contains definitions for deprecated features. When you
- deprecate something, move it here when that is feasible.
-*/
-
#ifndef SCM_DEPRECATED_H
#define SCM_DEPRECATED_H
-/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 2003-2007, 2009-2017 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
@@ -24,255 +20,10 @@
*/
#include "libguile/__scm.h"
-#include "libguile/strings.h"
-#include "libguile/eval.h"
-#include "libguile/throw.h"
-#include "libguile/iselect.h"
#if (SCM_ENABLE_DEPRECATED == 1)
-/* Deprecated 13-05-2011 because it's better just to scm_dynwind_begin.
- That also avoids the temptation to stuff pointers in an SCM. */
-
-typedef SCM (*scm_t_inner) (void *);
-SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard before,
- scm_t_inner inner,
- scm_t_guard after,
- void *inner_data,
- void *guard_data);
-
-
-/* Deprecated 15-05-2011 because it's better to be explicit with the
- `return'. Code is more readable that way. */
-#define SCM_WTA_DISPATCH_0(gf, subr) \
- return scm_wta_dispatch_0 ((gf), (subr))
-#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \
- return scm_wta_dispatch_1 ((gf), (a1), (pos), (subr))
-#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \
- return scm_wta_dispatch_2 ((gf), (a1), (a2), (pos), (subr))
-#define SCM_WTA_DISPATCH_N(gf, args, pos, subr) \
- return scm_wta_dispatch_n ((gf), (args), (pos), (subr))
-
-/* Deprecated 15-05-2011 because this idiom is not very readable. */
-#define SCM_GASSERT0(cond, gf, subr) \
- if (SCM_UNLIKELY (!(cond))) \
- return scm_wta_dispatch_0 ((gf), (subr))
-#define SCM_GASSERT1(cond, gf, a1, pos, subr) \
- if (SCM_UNLIKELY (!(cond))) \
- return scm_wta_dispatch_1 ((gf), (a1), (pos), (subr))
-#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \
- if (SCM_UNLIKELY (!(cond))) \
- return scm_wta_dispatch_2 ((gf), (a1), (a2), (pos), (subr))
-#define SCM_GASSERTn(cond, gf, args, pos, subr) \
- if (SCM_UNLIKELY (!(cond))) \
- return scm_wta_dispatch_n ((gf), (args), (pos), (subr))
-
-/* Deprecated 15-05-2011 because this is a one-off macro that does
- strange things. */
-#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos) \
- return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr))) \
- ? scm_call_1 ((*SCM_SUBR_GENERIC (subr)), (a1)) \
- : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), SCM_UNSPECIFIED))
-
-#define SCM_LIST0 SCM_EOL
-#define SCM_LIST1(e0) scm_cons ((e0), SCM_EOL)
-#define SCM_LIST2(e0, e1) scm_cons2 ((e0), (e1), SCM_EOL)
-#define SCM_LIST3(e0, e1, e2) scm_cons ((e0), SCM_LIST2 ((e1), (e2)))
-#define SCM_LIST4(e0, e1, e2, e3)\
- scm_cons2 ((e0), (e1), SCM_LIST2 ((e2), (e3)))
-#define SCM_LIST5(e0, e1, e2, e3, e4)\
- scm_cons ((e0), SCM_LIST4 ((e1), (e2), (e3), (e4)))
-#define SCM_LIST6(e0, e1, e2, e3, e4, e5)\
- scm_cons2 ((e0), (e1), SCM_LIST4 ((e2), (e3), (e4), (e5)))
-#define SCM_LIST7(e0, e1, e2, e3, e4, e5, e6)\
- scm_cons ((e0), SCM_LIST6 ((e1), (e2), (e3), (e4), (e5), (e6)))
-#define SCM_LIST8(e0, e1, e2, e3, e4, e5, e6, e7)\
- scm_cons2 ((e0), (e1), SCM_LIST6 ((e2), (e3), (e4), (e5), (e6), (e7)))
-#define SCM_LIST9(e0, e1, e2, e3, e4, e5, e6, e7, e8)\
- scm_cons ((e0),\
- SCM_LIST8 ((e1), (e2), (e3), (e4), (e5), (e6), (e7), (e8)))
-
-#define SCM_CHAR_CODE_LIMIT SCM_CHAR_CODE_LIMIT__GONE__REPLACE_WITH__256L
-#define SCM_OPDIRP SCM_OPDIRP__GONE__REPLACE_WITH__SCM_DIRP_and_SCM_DIR_OPEN_P
-#define SCM_PROCEDURE SCM_PROCEDURE__GONE__REPLACE_WITH__scm_procedure
-#define SCM_PROCEDURE_WITH_SETTER_P SCM_PROCEDURE_WITH_SETTER_P__GONE__REPLACE_WITH__scm_is_true__scm_procedure_with_setter_p
-#define SCM_SETTER SCM_SETTER__GONE__REPLACE_WITH__scm_setter
-#define SCM_THREAD_SWITCHING_CODE SCM_THREAD_SWITCHING_CODE__GONE__REMOVE_FROM_YOUR_CODE
-#define SCM_VALIDATE_NUMBER_COPY SCM_VALIDATE_NUMBER_COPY__GONE__REPLACE_WITH__SCM_VALIDATE_DOUBLE_COPY
-#define SCM_VALIDATE_NUMBER_DEF_COPY SCM_VALIDATE_NUMBER_DEF_COPY__GONE__REPLACE_WITH__SCM_UNBNDP_and_SCM_VALIDATE_DOUBLE_COPY
-#define SCM_VALIDATE_OPDIR SCM_VALIDATE_OPDIR__GONE
-#define SCM_VALIDATE_STRING_COPY SCM_VALIDATE_STRING_COPY__GONE
-#define SCM_VALIDATE_SUBSTRING_SPEC_COPY SCM_VALIDATE_SUBSTRING_SPEC_COPY__GONE
-#define scm_array scm_array__GONE__REPLACE_WITH__scm_t_array
-#define scm_array_dim scm_array_dim__GONE__REPLACE_WITH__scm_t_array_dim
-#define scm_async_click scm_async_click__GONE__REPLACE_WITH__scm_async_tick
-#define scm_call_generic_0 scm_call_generic_0__GONE__REPLACE_WITH__scm_call_0
-#define scm_call_generic_1 scm_call_generic_1__GONE__REPLACE_WITH__scm_call_1
-#define scm_call_generic_2 scm_call_generic_2__GONE__REPLACE_WITH__scm_call_2
-#define scm_call_generic_3 scm_call_generic_3__GONE__REPLACE_WITH__scm_call_3
-#define scm_apply_generic scm_apply_generic__GONE__REPLACE_WITH__scm_apply_0
-#define scm_fport scm_fport__GONE__REPLACE_WITH__scm_t_fport
-#define scm_listify scm_listify__GONE__REPLACE_WITH__scm_list_n
-#define scm_option scm_option__GONE__REPLACE_WITH__scm_t_option
-#define scm_port scm_port__GONE__REPLACE_WITH__scm_t_port
-#define scm_ptob_descriptor scm_ptob_descriptor__GONE__REPLACE_WITH__scm_t_port_type
-#define scm_rng scm_rng__GONE__REPLACE_WITH__scm_t_rng
-#define scm_rstate scm_rstate__GONE__REPLACE_WITH__scm_t_rstate
-#define scm_sizet scm_sizet__GONE__REPLACE_WITH__size_t
-#define scm_srcprops scm_srcprops__GONE__REPLACE_WITH__scm_t_srcprops
-#define scm_srcprops_chunk scm_srcprops_chunk__GONE__REPLACE_WITH__scm_t_srcprops_chunk
-#define scm_struct_i_flags scm_struct_i_flags__GONE__REPLACE_WITH__scm_vtable_index_flags
-#define scm_struct_i_free scm_struct_i_free__GONE__REPLACE_WITH__scm_vtable_index_instance_finalize
-#define scm_subr_entry scm_subr_entry__GONE__REPLACE_WITH__scm_t_subr_entry
-#define scm_substring_move_left_x scm_substring_move_left_x__GONE__REPLACE_WITH__scm_substring_move_x
-#define scm_substring_move_right_x scm_substring_move_right_x__GONE__REPLACE_WITH__scm_substring_move_x
-#define scm_vtable_index_printer scm_vtable_index_printer__GONE__REPLACE_WITH__scm_vtable_index_instance_printer
-#define scm_vtable_index_vtable scm_vtable_index_vtable__GONE__REPLACE_WITH__scm_vtable_index_self
-
-#ifndef BUILDING_LIBGUILE
-#define SCM_ASYNC_TICK SCM_ASYNC_TICK__GONE__REPLACE_WITH__scm_async_tick
-#endif
-
-
-
-
-/* Deprecated 26-05-2011, as the GC_STUBBORN API doesn't do anything any
- more. */
-SCM_DEPRECATED SCM scm_immutable_cell (scm_t_bits car, scm_t_bits cdr);
-SCM_DEPRECATED SCM scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
- scm_t_bits ccr, scm_t_bits cdr);
-
-
-
-SCM_DEPRECATED SCM scm_memory_alloc_key;
-SCM_DEPRECATED void scm_memory_error (const char *subr) SCM_NORETURN;
-
-
-
-SCM_DEPRECATED SCM scm_no_applicable_method;
-
-SCM_DEPRECATED SCM scm_class_boolean;
-SCM_DEPRECATED SCM scm_class_char;
-SCM_DEPRECATED SCM scm_class_pair;
-SCM_DEPRECATED SCM scm_class_procedure;
-SCM_DEPRECATED SCM scm_class_string;
-SCM_DEPRECATED SCM scm_class_symbol;
-SCM_DEPRECATED SCM scm_class_primitive_generic;
-SCM_DEPRECATED SCM scm_class_vector;
-SCM_DEPRECATED SCM scm_class_null;
-SCM_DEPRECATED SCM scm_class_real;
-SCM_DEPRECATED SCM scm_class_complex;
-SCM_DEPRECATED SCM scm_class_integer;
-SCM_DEPRECATED SCM scm_class_fraction;
-SCM_DEPRECATED SCM scm_class_unknown;
-SCM_DEPRECATED SCM scm_class_top;
-SCM_DEPRECATED SCM scm_class_object;
-SCM_DEPRECATED SCM scm_class_class;
-SCM_DEPRECATED SCM scm_class_applicable;
-SCM_DEPRECATED SCM scm_class_applicable_struct;
-SCM_DEPRECATED SCM scm_class_applicable_struct_with_setter;
-SCM_DEPRECATED SCM scm_class_generic;
-SCM_DEPRECATED SCM scm_class_generic_with_setter;
-SCM_DEPRECATED SCM scm_class_accessor;
-SCM_DEPRECATED SCM scm_class_extended_generic;
-SCM_DEPRECATED SCM scm_class_extended_generic_with_setter;
-SCM_DEPRECATED SCM scm_class_extended_accessor;
-SCM_DEPRECATED SCM scm_class_method;
-SCM_DEPRECATED SCM scm_class_accessor_method;
-SCM_DEPRECATED SCM scm_class_procedure_class;
-SCM_DEPRECATED SCM scm_class_applicable_struct_class;
-SCM_DEPRECATED SCM scm_class_number;
-SCM_DEPRECATED SCM scm_class_list;
-SCM_DEPRECATED SCM scm_class_keyword;
-SCM_DEPRECATED SCM scm_class_port;
-SCM_DEPRECATED SCM scm_class_input_output_port;
-SCM_DEPRECATED SCM scm_class_input_port;
-SCM_DEPRECATED SCM scm_class_output_port;
-SCM_DEPRECATED SCM scm_class_foreign_slot;
-SCM_DEPRECATED SCM scm_class_self;
-SCM_DEPRECATED SCM scm_class_protected;
-SCM_DEPRECATED SCM scm_class_hidden;
-SCM_DEPRECATED SCM scm_class_opaque;
-SCM_DEPRECATED SCM scm_class_read_only;
-SCM_DEPRECATED SCM scm_class_protected_hidden;
-SCM_DEPRECATED SCM scm_class_protected_opaque;
-SCM_DEPRECATED SCM scm_class_protected_read_only;
-SCM_DEPRECATED SCM scm_class_scm;
-SCM_DEPRECATED SCM scm_class_int;
-SCM_DEPRECATED SCM scm_class_float;
-SCM_DEPRECATED SCM scm_class_double;
-
-SCM_DEPRECATED SCM *scm_smob_class;
-
-SCM_INTERNAL void scm_init_deprecated_goops (void);
-
-SCM_DEPRECATED SCM scm_compute_applicable_methods (SCM gf, SCM args, long len, int scm_find_method);
-SCM_DEPRECATED SCM scm_find_method (SCM l);
-SCM_DEPRECATED SCM scm_basic_make_class (SCM c, SCM name, SCM dsupers, SCM dslots);
-SCM_DEPRECATED SCM scm_get_keyword (SCM kw, SCM initargs, SCM default_value);
-SCM_DEPRECATED SCM scm_slot_ref_using_class (SCM cls, SCM obj, SCM slot_name);
-SCM_DEPRECATED SCM scm_slot_set_using_class_x (SCM cls, SCM obj, SCM slot_name, SCM value);
-SCM_DEPRECATED SCM scm_slot_bound_using_class_p (SCM cls, SCM obj, SCM slot_name);
-SCM_DEPRECATED SCM scm_slot_exists_using_class_p (SCM cls, SCM obj, SCM slot_name);
-
-
-
-SCM_DEPRECATED SCM scm_make_arbiter (SCM name);
-SCM_DEPRECATED SCM scm_try_arbiter (SCM arb);
-SCM_DEPRECATED SCM scm_release_arbiter (SCM arb);
-
-
-
-SCM_DEPRECATED SCM scm_async (SCM thunk);
-SCM_DEPRECATED SCM scm_async_mark (SCM a);
-SCM_DEPRECATED SCM scm_run_asyncs (SCM list_of_a);
-
-
-
-SCM_DEPRECATED void scm_critical_section_start (void);
-SCM_DEPRECATED void scm_critical_section_end (void);
-SCM_DEPRECATED void scm_dynwind_critical_section (SCM mutex);
-
-#define SCM_CRITICAL_SECTION_START scm_critical_section_start ()
-#define SCM_CRITICAL_SECTION_END scm_critical_section_end ()
-
-
-
-SCM_DEPRECATED SCM scm_make_mutex_with_flags (SCM flags);
-SCM_DEPRECATED SCM scm_unlock_mutex_timed (SCM mx, SCM cond, SCM timeout);
-SCM_DEPRECATED SCM scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner);
-
-
-
-SCM_DEPRECATED SCM scm_internal_cwdr (scm_t_catch_body body,
- void *body_data,
- scm_t_catch_handler handler,
- void *handler_data,
- SCM_STACKITEM *stack_start);
-SCM_DEPRECATED SCM scm_call_with_dynamic_root (SCM thunk, SCM handler);
-SCM_DEPRECATED SCM scm_dynamic_root (void);
-SCM_DEPRECATED SCM scm_apply_with_dynamic_root (SCM proc, SCM a1,
- SCM args, SCM handler);
-
-
-
-SCM_DEPRECATED SCM scm_make_dynamic_state (SCM parent);
-
-
-
-/* Deprecated 2016-11-18. Never documented. Unnecessary, since
- array-copy! already unrolls and does it in more general cases. */
-/* With this also remove SCM_I_ARRAY_FLAG_CONTIGUOUS,
- SCM_SET_ARRAY_CONTIGUOUS_FLAG, SCM_CLR_ARRAY_CONTIGUOUS_FLAG,
- scm_i_ra_set_contp, and uses thereof. */
-SCM_DEPRECATED SCM scm_from_contiguous_array (SCM bounds, const SCM *elts,
- size_t len);
-
-
-
-SCM_DEPRECATED int SCM_FDES_RANDOM_P (int fdes);
-
-
+/* Deprecated declarations go here. */
void scm_i_init_deprecated (void);
diff --git a/libguile/goops.c b/libguile/goops.c
index a158a1cab..1e7639ef1 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1054,10 +1054,6 @@ SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0,
var_change_class = scm_c_lookup ("change-class");
-#if (SCM_ENABLE_DEPRECATED == 1)
- scm_init_deprecated_goops ();
-#endif
-
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 3e0efc8bb..39e2d622c 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -6089,14 +6089,7 @@ mem2ureal (SCM mem, unsigned int *p_idx,
idx += 4;
if (!scm_is_eq (mem2uinteger (mem, &idx, 10, &implicit_x),
SCM_INUM0))
- {
-#if SCM_ENABLE_DEPRECATED == 1
- scm_c_issue_deprecation_warning
- ("Non-zero suffixes to `+nan.' are deprecated. Use `+nan.0'.");
-#else
- return SCM_BOOL_F;
-#endif
- }
+ return SCM_BOOL_F;
*p_idx = idx;
return scm_nan ();
diff --git a/libguile/socket.c b/libguile/socket.c
index 71c17e892..b28e01bca 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -58,11 +58,6 @@
#include "libguile/validate.h"
#include "libguile/socket.h"
-#if SCM_ENABLE_DEPRECATED == 1
-# include "libguile/deprecation.h"
-#endif
-
-
#if defined (HAVE_UNIX_DOMAIN_SOCKETS) && !defined (SUN_LEN)
#define SUN_LEN(ptr) (offsetof (struct sockaddr_un, sun_path) \
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c
index c77cba9b2..ff5e72150 100644
--- a/libguile/srfi-13.c
+++ b/libguile/srfi-13.c
@@ -3112,22 +3112,6 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
SCM result;
size_t idx;
-#if SCM_ENABLE_DEPRECATED == 1
- if (scm_is_string (char_pred))
- {
- SCM tmp;
-
- scm_c_issue_deprecation_warning
- ("Guile used to use the wrong argument order for string-filter.\n"
- "This call to string-filter had the arguments in the wrong order.\n"
- "See SRFI-13 for more details. At some point we will remove this hack.");
-
- tmp = char_pred;
- char_pred = s;
- s = tmp;
- }
-#endif
-
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);
@@ -3245,22 +3229,6 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
SCM result;
size_t idx;
-#if SCM_ENABLE_DEPRECATED == 1
- if (scm_is_string (char_pred))
- {
- SCM tmp;
-
- scm_c_issue_deprecation_warning
- ("Guile used to use the wrong argument order for string-delete.\n"
- "This call to string-filter had the arguments in the wrong order.\n"
- "See SRFI-13 for more details. At some point we will remove this hack.");
-
- tmp = char_pred;
- char_pred = s;
- s = tmp;
- }
-#endif
-
MY_VALIDATE_SUBSTRING_SPEC (2, s,
3, start, cstart,
4, end, cend);