summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2017-09-22 10:25:38 +0200
committerAndy Wingo <wingo@pobox.com>2017-09-22 10:32:33 +0200
commitfe4a34d20d8342106a46fc2b842a892c17a11920 (patch)
treeb0de9d3b4d1e4231749e8211ca8c80140234e042 /libguile
parent53d4df80c91d0c744e86df421572f60bb9a80261 (diff)
downloadguile-fe4a34d20d8342106a46fc2b842a892c17a11920.tar.gz
Deprecate make-struct
* libguile/struct.c: Replace uses of scm_make_struct with scm_make_struct_no_tail or scm_c_make_struct. (scm_make_struct_no_tail): Move this function to C instead of Scheme to be able to deprecate scm_make_struct. * libguile/struct.h (scm_make_struct_no_tail): New public declaration. * libguile/deprecated.h: * libguile/deprecated.c (scm_make_struct): Deprecate. * libguile/print.c: * libguile/procs.c: * libguile/stacks.c: Replace uses of scm_make_struct with scm_make_struct_no_tail. * test-suite/tests/coverage.test: * test-suite/tests/structs.test: Use make-struct/no-tail instead of make-struct. * NEWS: Add entry.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/deprecated.c51
-rw-r--r--libguile/deprecated.h6
-rw-r--r--libguile/print.c5
-rw-r--r--libguile/procs.c5
-rw-r--r--libguile/stacks.c4
-rw-r--r--libguile/struct.c29
-rw-r--r--libguile/struct.h5
7 files changed, 77 insertions, 28 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 ()
{
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 2c49076a1..68cd65448 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -5,7 +5,7 @@
#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,2004, 2005, 2006, 2007, 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
@@ -274,6 +274,10 @@ SCM_DEPRECATED int SCM_FDES_RANDOM_P (int fdes);
+SCM_DEPRECATED SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init);
+
+
+
void scm_i_init_deprecated (void);
#endif
diff --git a/libguile/print.c b/libguile/print.c
index 7667d24bb..4d57a877d 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995-1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008,
- * 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
+ * 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
@@ -194,8 +194,7 @@ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0,
static SCM
make_print_state (void)
{
- SCM print_state
- = scm_make_struct (scm_print_state_vtable, SCM_INUM0, SCM_EOL);
+ SCM print_state = scm_make_struct_no_tail (scm_print_state_vtable, SCM_EOL);
scm_print_state *pstate = SCM_PRINT_STATE (print_state);
pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
pstate->ceiling = SCM_SIMPLE_VECTOR_LENGTH (pstate->ref_vect);
diff --git a/libguile/procs.c b/libguile/procs.c
index 08c5c355e..2329f4a1b 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2006, 2008, 2009,
- * 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2010, 2011, 2012, 2013, 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
@@ -90,8 +90,7 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
{
SCM_VALIDATE_PROC (1, procedure);
SCM_VALIDATE_PROC (2, setter);
- return scm_make_struct (pws_vtable, SCM_INUM0,
- scm_list_2 (procedure, setter));
+ return scm_make_struct_no_tail (pws_vtable, scm_list_2 (procedure, setter));
}
#undef FUNC_NAME
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 9bd2db8de..76e10faf3 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -1,5 +1,5 @@
/* A stack holds a frame chain
- * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017 Free Software Foundation
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -388,7 +388,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
if (n > 0)
{
/* Make the stack object. */
- SCM stack = scm_make_struct (scm_stack_type, SCM_INUM0, SCM_EOL);
+ SCM stack = scm_make_struct_no_tail (scm_stack_type, SCM_EOL);
SCM_SET_STACK_LENGTH (stack, n);
SCM_SET_STACK_ID (stack, scm_stack_id (obj));
SCM_SET_STACK_FRAME (stack, scm_c_make_frame (kind, &frame));
diff --git a/libguile/struct.c b/libguile/struct.c
index 51c0f111d..78099ac45 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,5 +1,5 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007,
- * 2008, 2009, 2010, 2011, 2012, 2013, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 1996-2001, 2003-2004, 2006-2013, 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
@@ -553,13 +553,10 @@ SCM_DEFINE (scm_allocate_struct, "allocate-struct", 2, 0, 0,
}
#undef FUNC_NAME
-SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
- (SCM vtable, SCM tail_array_size, SCM init),
+SCM_DEFINE (scm_make_struct_no_tail, "make-struct/no-tail", 1, 0, 1,
+ (SCM vtable, 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"
@@ -569,7 +566,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
"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
+#define FUNC_NAME s_scm_make_struct_no_tail
{
size_t i, n_init;
long ilen;
@@ -592,7 +589,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
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);
+ return scm_c_make_structv (vtable, 0, n_init, v);
}
#undef FUNC_NAME
@@ -638,9 +635,9 @@ SCM_DEFINE (scm_make_vtable, "make-vtable", 1, 1, 0,
if (SCM_UNBNDP (printer))
printer = SCM_BOOL_F;
- return scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
- scm_list_2 (scm_make_struct_layout (fields),
- printer));
+ return scm_c_make_struct (scm_standard_vtable_vtable, 0, 2,
+ SCM_UNPACK (scm_make_struct_layout (fields)),
+ SCM_UNPACK (printer));
}
#undef FUNC_NAME
@@ -1002,8 +999,8 @@ scm_init_struct ()
scm_define (name, scm_standard_vtable_vtable);
scm_applicable_struct_vtable_vtable =
- scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
- scm_list_1 (scm_make_struct_layout (required_vtable_fields)));
+ scm_c_make_struct (scm_standard_vtable_vtable, 0, 1,
+ SCM_UNPACK (scm_make_struct_layout (required_vtable_fields)));
name = scm_from_utf8_symbol ("<applicable-struct-vtable>");
SCM_SET_VTABLE_FLAGS (scm_applicable_struct_vtable_vtable,
SCM_VTABLE_FLAG_APPLICABLE_VTABLE);
@@ -1011,8 +1008,8 @@ scm_init_struct ()
scm_define (name, scm_applicable_struct_vtable_vtable);
scm_applicable_struct_with_setter_vtable_vtable =
- scm_make_struct (scm_standard_vtable_vtable, SCM_INUM0,
- scm_list_1 (scm_make_struct_layout (required_vtable_fields)));
+ scm_c_make_struct (scm_standard_vtable_vtable, 0, 1,
+ SCM_UNPACK (scm_make_struct_layout (required_vtable_fields)));
name = scm_from_utf8_symbol ("<applicable-struct-with-setter-vtable>");
scm_set_struct_vtable_name_x (scm_applicable_struct_with_setter_vtable_vtable, name);
SCM_SET_VTABLE_FLAGS (scm_applicable_struct_with_setter_vtable_vtable,
diff --git a/libguile/struct.h b/libguile/struct.h
index e8db316c8..257e40e1e 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -3,7 +3,8 @@
#ifndef SCM_STRUCT_H
#define SCM_STRUCT_H
-/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1997,1999-2001, 2006-2013, 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
@@ -175,7 +176,7 @@ SCM_API SCM scm_make_struct_layout (SCM fields);
SCM_API SCM scm_struct_p (SCM x);
SCM_API SCM scm_struct_vtable_p (SCM x);
SCM_INTERNAL SCM scm_allocate_struct (SCM vtable, SCM n_words);
-SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init);
+SCM_API SCM scm_make_struct_no_tail (SCM vtable, SCM init);
SCM_API SCM scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_inits,
scm_t_bits init, ...);
SCM_API SCM scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_inits,