summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2017-09-22 11:59:51 +0200
committerAndy Wingo <wingo@pobox.com>2017-09-22 12:02:25 +0200
commit2f9ad7d9bcd1f787e324158a1ee402d111e8608e (patch)
tree7a79123f736074bfee46574e9067dd6702b39ff7 /libguile
parented549da23078657836e359d9d9ef3c6bd01cd738 (diff)
parentc7c7588f2416624319be2a037056ba8bb1c054e7 (diff)
downloadguile-2f9ad7d9bcd1f787e324158a1ee402d111e8608e.tar.gz
Merge stable-2.2 into master
This commit resolves conflicts by removing the deprecated make-struct.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/filesys.c8
-rw-r--r--libguile/print.c6
-rw-r--r--libguile/print.h4
-rw-r--r--libguile/procs.c5
-rw-r--r--libguile/r6rs-ports.c4
-rw-r--r--libguile/stacks.c4
-rw-r--r--libguile/struct.c100
-rw-r--r--libguile/struct.h5
8 files changed, 60 insertions, 76 deletions
diff --git a/libguile/filesys.c b/libguile/filesys.c
index f18560162..af283dd5e 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2006,
- * 2009, 2010, 2011, 2012, 2013, 2014, 2016 Free Software Foundation, Inc.
+ * 2009, 2010, 2011, 2012, 2013, 2014, 2016, 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
@@ -1679,7 +1679,11 @@ scm_i_relativize_path (SCM path, SCM in_path)
if (len > 0
&& scm_is_true (scm_string_prefix_p (dir, scanon,
SCM_UNDEFINED, SCM_UNDEFINED,
- SCM_UNDEFINED, SCM_UNDEFINED)))
+ SCM_UNDEFINED, SCM_UNDEFINED))
+
+ /* Make sure SCANON starts with DIR followed by a separator. */
+ && (is_file_name_separator (scm_c_string_ref (dir, len - 1))
+ || is_file_name_separator (scm_c_string_ref (scanon, len))))
{
/* DIR either has a trailing delimiter or doesn't. SCANON
will be delimited by single delimiters. When DIR does not
diff --git a/libguile/print.c b/libguile/print.c
index 7667d24bb..24c532f29 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,9 +194,9 @@ 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->handle = print_state;
pstate->ref_vect = scm_c_make_vector (PSTATE_SIZE, SCM_UNDEFINED);
pstate->ceiling = SCM_SIMPLE_VECTOR_LENGTH (pstate->ref_vect);
pstate->highlight_objects = SCM_EOL;
diff --git a/libguile/print.h b/libguile/print.h
index 14318c031..11f533c79 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -4,7 +4,7 @@
#define SCM_PRINT_H
/* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2003, 2004, 2006, 2008,
- * 2010, 2012 Free Software Foundation, Inc.
+ * 2010, 2012, 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
@@ -53,7 +53,7 @@ do { \
#define SCM_COERCE_OUTPORT(p) \
(SCM_PORT_WITH_PS_P (p) ? SCM_PORT_WITH_PS_PORT (p) : p)
-#define SCM_PRINT_STATE_LAYOUT "sruwuwuwuwuwpwuwuwurprpw"
+#define SCM_PRINT_STATE_LAYOUT "pruwuwuwuwuwpwuwuwurprpw"
typedef struct scm_print_state {
SCM handle; /* Struct handle */
int revealed; /* Has the state escaped to Scheme? */
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/r6rs-ports.c b/libguile/r6rs-ports.c
index c2f97ffa1..e944c7aab 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -602,7 +602,7 @@ SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0,
}
else
{
- if (SCM_UNLIKELY (c_start >= c_len))
+ if (SCM_UNLIKELY (c_start > c_len))
scm_out_of_range (FUNC_NAME, start);
else
c_count = c_len - c_start;
@@ -645,7 +645,7 @@ SCM_DEFINE (scm_unget_bytevector, "unget-bytevector", 2, 2, 0,
}
else
{
- if (SCM_UNLIKELY (c_start >= c_len))
+ if (SCM_UNLIKELY (c_start > c_len))
scm_out_of_range (FUNC_NAME, start);
else
c_count = c_len - c_start;
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 67e2e62df..53bf3f302 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, 2017 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
@@ -30,6 +30,7 @@
#include "libguile/_scm.h"
#include "libguile/async.h"
#include "libguile/chars.h"
+#include "libguile/deprecation.h"
#include "libguile/eval.h"
#include "libguile/alist.h"
#include "libguile/hashtab.h"
@@ -68,16 +69,14 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
"@var{fields} must be a string made up of pairs of characters\n"
"strung together. The first character of each pair describes a field\n"
"type, the second a field protection. Allowed types are 'p' for\n"
- "GC-protected Scheme data, 'u' for unprotected binary data, and 's' for\n"
- "a field that points to the structure itself. Allowed protections\n"
+ "GC-protected Scheme data, 'u' for unprotected binary data. \n"
+ "Allowed protections\n"
"are 'w' for mutable fields, 'h' for hidden fields, 'r' for read-only\n"
"fields, and 'o' for opaque fields.\n\n"
"Hidden fields are writable, but they will not consume an initializer arg\n"
"passed to @code{make-struct}. They are useful to add slots to a struct\n"
"in a way that preserves backward-compatibility with existing calls to\n"
- "@code{make-struct}, especially for derived vtables.\n\n"
- "The last field protection specification may be capitalized to indicate\n"
- "that the field is a tail-array.")
+ "@code{make-struct}, especially for derived vtables.")
#define FUNC_NAME s_scm_make_struct_layout
{
SCM new_sym;
@@ -100,10 +99,6 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
{
case 'u':
case 'p':
-#if 0
- case 'i':
- case 'd':
-#endif
case 's':
break;
default:
@@ -134,16 +129,6 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
SCM_MISC_ERROR ("unrecognized ref specification: ~S",
scm_list_1 (SCM_MAKE_CHAR (c)));
}
-#if 0
- if (scm_i_string_ref (fields, x, 'd'))
- {
- if (!scm_i_string_ref (fields, x+2, '-'))
- SCM_MISC_ERROR ("missing dash field at position ~A",
- scm_list_1 (scm_from_int (x / 2)));
- x += 2;
- goto recheck_ref;
- }
-#endif
}
new_sym = scm_string_to_symbol (fields);
}
@@ -243,6 +228,23 @@ scm_is_valid_vtable_layout (SCM layout)
return 1;
}
+static void
+issue_deprecation_warning_for_self_slots (SCM vtable)
+{
+ SCM olayout;
+ size_t idx, first_user_slot = 0;
+
+ olayout = scm_symbol_to_string (SCM_VTABLE_LAYOUT (vtable));
+ if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_VTABLE))
+ first_user_slot = scm_vtable_offset_user;
+
+ for (idx = first_user_slot * 2; idx < scm_c_string_length (olayout); idx += 2)
+ if (scm_is_eq (scm_c_string_ref (olayout, idx), SCM_MAKE_CHAR ('s')))
+ scm_c_issue_deprecation_warning
+ ("Vtables with \"self\" slots are deprecated. Initialize these "
+ "fields manually.");
+}
+
/* Have OBJ, a newly created vtable, inherit flags from VTABLE. VTABLE is a
vtable-vtable and OBJ is an instance of VTABLE. */
void
@@ -302,6 +304,8 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_APPLICABLE);
}
+ issue_deprecation_warning_for_self_slots (obj);
+
SCM_SET_VTABLE_FLAGS (obj, SCM_VTABLE_FLAG_VALIDATED);
}
#undef FUNC_NAME
@@ -540,23 +544,19 @@ 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"
- "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"
+ "successive fields of the structure should be initialized.\n"
+ "Only fields with protection 'r' or 'w' can be initialized.\n"
+ "Fields with protection 'o' can not be initialized by Scheme\n"
+ "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
+#define FUNC_NAME s_scm_make_struct_no_tail
{
size_t i, n_init;
long ilen;
@@ -579,7 +579,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
@@ -625,9 +625,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
@@ -748,16 +748,6 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
answer = scm_from_ulong (data[p]);
break;
-#if 0
- case 'i':
- answer = scm_from_long (data[p]);
- break;
-
- case 'd':
- answer = scm_make_real (*((double *)&(data[p])));
- break;
-#endif
-
case 's':
case 'p':
answer = SCM_PACK (data[p]);
@@ -831,16 +821,6 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
data[p] = SCM_NUM2ULONG (3, val);
break;
-#if 0
- case 'i':
- data[p] = SCM_NUM2LONG (3, val);
- break;
-
- case 'd':
- *((double *)&(data[p])) = scm_num2dbl (val, (char *)SCM_ARG3);
- break;
-#endif
-
case 'p':
data[p] = SCM_UNPACK (val);
break;
@@ -979,8 +959,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);
@@ -988,8 +968,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 25d5ae53f..32af8ab5a 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, 2017 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
@@ -153,7 +154,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,