summaryrefslogtreecommitdiff
path: root/libguile/deprecated.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/deprecated.c')
-rw-r--r--libguile/deprecated.c51
1 files changed, 50 insertions, 1 deletions
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index cee6b1d74..9d94bc2d8 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2,7 +2,7 @@
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, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 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,6 +26,7 @@
#define SCM_BUILDING_DEPRECATED_CODE
+#include <alloca.h>
#include <sys/types.h>
#include <unistd.h>
@@ -954,6 +955,54 @@ SCM_FDES_RANDOM_P (int fdes)
+SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
+ (SCM vtable, SCM tail_array_size, SCM init),
+ "Create a new structure.\n\n"
+ "@var{vtable} must be a vtable structure (@pxref{Vtables}).\n\n"
+ "@var{tail_array_size} must be a non-negative integer. If the layout\n"
+ "specification indicated by @var{vtable} includes a tail-array,\n"
+ "this is the number of elements allocated to that array.\n\n"
+ "The @var{init1}, @dots{} are optional arguments describing how\n"
+ "successive fields of the structure should be initialized. Only fields\n"
+ "with protection 'r' or 'w' can be initialized, except for fields of\n"
+ "type 's', which are automatically initialized to point to the new\n"
+ "structure itself. Fields with protection 'o' can not be initialized by\n"
+ "Scheme programs.\n\n"
+ "If fewer optional arguments than initializable fields are supplied,\n"
+ "fields of type 'p' get default value #f while fields of type 'u' are\n"
+ "initialized to 0.")
+#define FUNC_NAME s_scm_make_struct
+{
+ size_t i, n_init;
+ long ilen;
+ scm_t_bits *v;
+
+ scm_c_issue_deprecation_warning
+ ("make-struct is deprecated. Use make-struct/no-tail instead.");
+
+ SCM_VALIDATE_VTABLE (1, vtable);
+ ilen = scm_ilength (init);
+ if (ilen < 0)
+ SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL);
+
+ n_init = (size_t)ilen;
+
+ /* best to use alloca, but init could be big, so hack to avoid a possible
+ stack overflow */
+ if (n_init < 64)
+ v = alloca (n_init * sizeof(scm_t_bits));
+ else
+ v = scm_gc_malloc (n_init * sizeof(scm_t_bits), "struct");
+
+ for (i = 0; i < n_init; i++, init = SCM_CDR (init))
+ v[i] = SCM_UNPACK (SCM_CAR (init));
+
+ return scm_c_make_structv (vtable, scm_to_size_t (tail_array_size), n_init, v);
+}
+#undef FUNC_NAME
+
+
+
void
scm_i_init_deprecated ()
{