mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 20:30:28 +02:00
Code Activity

Merge stable-2.2 into master

Browse source 
This commit resolves conflicts by removing the deprecated make-struct.
This commit is contained in:
Andy Wingo 2017-09-22 11:59:51 +02:00
commit 2f9ad7d9bc
24 changed files with 293 additions and 310 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/filesys.c
View file

@ -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

6
libguile/print.c
View file

@ -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;

4
libguile/print.h
View file

@ -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? */

5
libguile/procs.c
View file

@ -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

4
libguile/r6rs-ports.c
View file

@ -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;

4
libguile/stacks.c
View file

@ -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));

100
libguile/struct.c
View file

@ -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,

5
libguile/struct.h
View file

@ -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,