mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Merge from stable-2.2

Browse source
This commit is contained in:
Andy Wingo 2019-08-02 14:37:55 +02:00
commit afb2c96248
8 changed files with 139 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

27
libguile/bytevectors.c
View file

@ -93,7 +93,8 @@
c_len = SCM_BYTEVECTOR_LENGTH (bv); \
c_bv = (_sign char *) SCM_BYTEVECTOR_CONTENTS (bv); \
\
if (SCM_UNLIKELY (c_index + ((_len) >> 3UL) - 1 >= c_len)) \
if (SCM_UNLIKELY (c_len < c_index \
|| (c_len - c_index < (_len) / 8))) \
scm_out_of_range (FUNC_NAME, index);
#define INTEGER_GETTER_PROLOGUE(_len, _sign) \
@ -215,12 +216,17 @@ make_bytevector (size_t len, scm_t_array_element_type element_type)
size_t c_len;
if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
|| scm_i_array_element_type_sizes[element_type] < 8
|| len >= (((size_t) -1)
/ (scm_i_array_element_type_sizes[element_type]/8))))
|| scm_i_array_element_type_sizes[element_type] < 8))
/* This would be an internal Guile programming error */
abort ();
/* Make sure that the total allocation size will not overflow size_t,
with ~30 extra bytes to spare to avoid an overflow within the
allocator. */
if (SCM_UNLIKELY (len >= (((size_t) -(SCM_BYTEVECTOR_HEADER_BYTES + 32))
/ (scm_i_array_element_type_sizes[element_type]/8))))
scm_num_overflow ("make-bytevector");
if (SCM_UNLIKELY (len == 0 && element_type == SCM_ARRAY_ELEMENT_TYPE_VU8
&& SCM_BYTEVECTOR_P (scm_null_bytevector)))
ret = scm_null_bytevector;
@ -261,7 +267,7 @@ make_bytevector_from_buffer (size_t len, void *contents,
size_t c_len;
ret = SCM_PACK_POINTER (scm_gc_malloc (SCM_BYTEVECTOR_HEADER_BYTES,
SCM_GC_BYTEVECTOR));
SCM_GC_BYTEVECTOR));
c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
@ -519,7 +525,7 @@ SCM_DEFINE (scm_bytevector_length, "bytevector-length", 1, 0, 0,
"Return the length (in bytes) of @var{bv}.")
#define FUNC_NAME s_scm_bytevector_length
{
return scm_from_uint (scm_c_bytevector_length (bv));
return scm_from_size_t (scm_c_bytevector_length (bv));
}
#undef FUNC_NAME
@ -604,9 +610,11 @@ SCM_DEFINE (scm_bytevector_copy_x, "bytevector-copy!", 5, 0, 0,
c_source_len = SCM_BYTEVECTOR_LENGTH (source);
c_target_len = SCM_BYTEVECTOR_LENGTH (target);
if (SCM_UNLIKELY (c_source_start + c_len > c_source_len))
if (SCM_UNLIKELY (c_source_len < c_source_start
|| (c_source_len - c_source_start < c_len)))
scm_out_of_range (FUNC_NAME, source_start);
if (SCM_UNLIKELY (c_target_start + c_len > c_target_len))
if (SCM_UNLIKELY (c_target_len < c_target_start
|| (c_target_len - c_target_start < c_len)))
scm_out_of_range (FUNC_NAME, target_start);
memmove (c_target + c_target_start,
@ -924,7 +932,8 @@ bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
size_t. */ \
if (SCM_UNLIKELY (c_size == 0 || c_size >= (SIZE_MAX >> 3))) \
scm_out_of_range (FUNC_NAME, size); \
if (SCM_UNLIKELY (c_index + c_size > c_len)) \
if (SCM_UNLIKELY (c_len < c_index \
|| (c_len - c_index < c_size))) \
scm_out_of_range (FUNC_NAME, index);
#define GENERIC_INTEGER_GETTER_PROLOGUE(_sign) \

7
libguile/fports.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-2004,2006-2015,2017-2018
/* Copyright 1995-2004,2006-2015,2017-2019
Free Software Foundation, Inc.
This file is part of Guile.
@ -633,6 +633,11 @@ fport_seek (SCM port, scm_t_off offset, int whence)
if (result == -1)
scm_syserror ("fport_seek");
/* Check to make sure the result fits in scm_t_off,
which might be smaller than off_t_or_off64_t. */
if (result > SCM_T_OFF_MAX)
scm_num_overflow ("fport_seek");
return result;
}

4
libguile/guardians.c
View file

@ -1,4 +1,4 @@
/* Copyright 1998-2001,2006,2008-2009,2011-2013,2018
/* Copyright 1998-2001,2006,2008-2009,2011-2013,2018-2019
Free Software Foundation, Inc.
This file is part of Guile.
@ -92,7 +92,7 @@ guardian_print (SCM guardian, SCM port, scm_print_state *pstate SCM_UNUSED)
scm_uintprint ((scm_t_bits) g, 16, port);
scm_puts (" (reachable: ", port);
scm_display (scm_from_uint (g->live), port);
scm_display (scm_from_ulong (g->live), port);
scm_puts (" unreachable: ", port);
scm_display (scm_length (g->zombies), port);
scm_puts (")", port);

15
libguile/ports.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-2001,2003-2004,2006-2018
/* Copyright 1995-2001,2003-2004,2006-2019
Free Software Foundation, Inc.
This file is part of Guile.
@ -2243,7 +2243,8 @@ SCM_DEFINE (scm_unread_string, "unread-string", 2, 0, 0,
"@var{port} is not supplied, the current-input-port is used.")
#define FUNC_NAME s_scm_unread_string
{
int n;
size_t n;
SCM_VALIDATE_STRING (1, str);
if (SCM_UNBNDP (port))
port = scm_current_input_port ();
@ -3741,8 +3742,8 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
{
scm_t_port *pt = SCM_PORT (fd_port);
scm_t_port_type *ptob = SCM_PORT_TYPE (fd_port);
off_t_or_off64_t off = scm_to_off_t_or_off64_t (offset);
off_t_or_off64_t rv;
scm_t_off off = scm_to_off_t (offset);
scm_t_off rv;
if (ptob->seek && how == SEEK_CUR && off == 0)
{
@ -3756,7 +3757,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
scm_dynwind_end ();
rv -= scm_port_buffer_can_take (pt->read_buf, &tmp);
rv += scm_port_buffer_can_take (pt->write_buf, &tmp);
return scm_from_off_t_or_off64_t (rv);
return scm_from_off_t (rv);
}
if (!ptob->seek || !pt->rw_random)
@ -3777,7 +3778,7 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
scm_i_clear_pending_eof (fd_port);
return scm_from_off_t_or_off64_t (rv);
return scm_from_off_t (rv);
}
else /* file descriptor?. */
{
@ -3862,7 +3863,7 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
}
else if (SCM_OPOUTPORTP (object))
{
off_t_or_off64_t c_length = scm_to_off_t_or_off64_t (length);
scm_t_off c_length = scm_to_off_t (length);
scm_t_port_type *ptob = SCM_PORT_TYPE (object);
if (!ptob->truncate)

104
libguile/r6rs-ports.c
View file

@ -1,4 +1,4 @@
/* Copyright 2009-2011,2013-2015,2018
/* Copyright 2009-2011,2013-2015,2018-2019
Free Software Foundation, Inc.
This file is part of Guile.
@ -21,10 +21,11 @@
# include <config.h>
#endif
#include <assert.h>
#include <intprops.h>
#include <unistd.h>
#include <string.h>
#include <stdio.h>
#include <assert.h>
#include "boolean.h"
#include "bytevectors.h"
#include "chars.h"
@ -138,21 +139,27 @@ bytevector_input_port_seek (SCM port, scm_t_off offset, int whence)
#define FUNC_NAME "bytevector_input_port_seek"
{
struct bytevector_input_port *stream = (void *) SCM_STREAM (port);
size_t base;
scm_t_off target;
if (whence == SEEK_CUR)
target = offset + stream->pos;
base = stream->pos;
else if (whence == SEEK_SET)
target = offset;
base = 0;
else if (whence == SEEK_END)
target = offset + SCM_BYTEVECTOR_LENGTH (stream->bytevector);
base = SCM_BYTEVECTOR_LENGTH (stream->bytevector);
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
if (base > SCM_T_OFF_MAX
|| INT_ADD_OVERFLOW ((scm_t_off) base, offset))
scm_num_overflow (FUNC_NAME);
target = (scm_t_off) base + offset;
if (target >= 0 && target <= SCM_BYTEVECTOR_LENGTH (stream->bytevector))
stream->pos = target;
else
scm_out_of_range (FUNC_NAME, scm_from_long (offset));
scm_out_of_range (FUNC_NAME, scm_from_off_t (offset));
return target;
}
@ -232,6 +239,9 @@ custom_binary_port_seek (SCM port, scm_t_off offset, int whence)
/* We just want to know the current position. */
break;
if (INT_ADD_OVERFLOW (offset, c_result))
scm_num_overflow (FUNC_NAME);
offset += c_result;
/* Fall through. */
}
@ -239,7 +249,7 @@ custom_binary_port_seek (SCM port, scm_t_off offset, int whence)
case SEEK_SET:
{
if (SCM_LIKELY (scm_is_true (stream->set_position_x)))
result = scm_call_1 (stream->set_position_x, scm_from_int (offset));
result = scm_call_1 (stream->set_position_x, scm_from_off_t (offset));
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
"seekable R6RS custom binary port");
@ -462,7 +472,8 @@ SCM_DEFINE (scm_get_bytevector_n_x, "get-bytevector-n!", 4, 0, 0,
c_len = SCM_BYTEVECTOR_LENGTH (bv);
if (SCM_UNLIKELY (c_start + c_count > c_len))
if (SCM_UNLIKELY (c_len < c_start
|| (c_len - c_start < c_count)))
scm_out_of_range (FUNC_NAME, count);
if (SCM_LIKELY (c_count > 0))
@ -519,7 +530,7 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
#define FUNC_NAME s_scm_get_bytevector_all
{
SCM result;
unsigned c_len, c_count;
size_t c_len, c_count;
size_t c_read, c_total;
SCM_VALIDATE_BINARY_INPUT_PORT (1, port);
@ -530,10 +541,14 @@ SCM_DEFINE (scm_get_bytevector_all, "get-bytevector-all", 1, 0, 0,
do
{
if (c_total + c_read > c_len)
if (c_read > c_len - c_total)
{
/* Grow the bytevector. */
SCM prev = result;
if (INT_ADD_OVERFLOW (c_len, c_len))
scm_num_overflow (FUNC_NAME);
result = scm_c_make_bytevector (c_len * 2);
memcpy (SCM_BYTEVECTOR_CONTENTS (result),
SCM_BYTEVECTOR_CONTENTS (prev),
@ -601,20 +616,17 @@ SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0,
if (!scm_is_eq (start, SCM_UNDEFINED))
{
c_start = scm_to_size_t (start);
if (SCM_UNLIKELY (c_start > c_len))
scm_out_of_range (FUNC_NAME, start);
if (!scm_is_eq (count, SCM_UNDEFINED))
{
c_count = scm_to_size_t (count);
if (SCM_UNLIKELY (c_start + c_count > c_len))
if (SCM_UNLIKELY (c_count > c_len - c_start))
scm_out_of_range (FUNC_NAME, count);
}
else
{
if (SCM_UNLIKELY (c_start > c_len))
scm_out_of_range (FUNC_NAME, start);
else
c_count = c_len - c_start;
}
c_count = c_len - c_start;
}
else
c_start = 0, c_count = c_len;
@ -644,20 +656,17 @@ SCM_DEFINE (scm_unget_bytevector, "unget-bytevector", 2, 2, 0,
if (!scm_is_eq (start, SCM_UNDEFINED))
{
c_start = scm_to_size_t (start);
if (SCM_UNLIKELY (c_start > c_len))
scm_out_of_range (FUNC_NAME, start);
if (!scm_is_eq (count, SCM_UNDEFINED))
{
c_count = scm_to_size_t (count);
if (SCM_UNLIKELY (c_start + c_count > c_len))
if (SCM_UNLIKELY (c_count > c_len - c_start))
scm_out_of_range (FUNC_NAME, count);
}
else
{
if (SCM_UNLIKELY (c_start > c_len))
scm_out_of_range (FUNC_NAME, start);
else
c_count = c_len - c_start;
}
c_count = c_len - c_start;
}
else
c_start = 0, c_count = c_len;
@ -723,6 +732,8 @@ bytevector_output_port_buffer_init (scm_t_bytevector_output_port_buffer *buf)
/* Don't clear the port. */
}
#define MAX(A, B) ((A) >= (B) ? (A) : (B))
static inline void
bytevector_output_port_buffer_grow (scm_t_bytevector_output_port_buffer *buf,
size_t min_size)
@ -730,17 +741,20 @@ bytevector_output_port_buffer_grow (scm_t_bytevector_output_port_buffer *buf,
char *new_buf;
size_t new_size;
for (new_size = buf->total_len
? buf->total_len : SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER_INITIAL_SIZE;
new_size < min_size;
new_size *= 2);
if (buf->buffer)
new_buf = scm_gc_realloc ((void *) buf->buffer, buf->total_len,
new_size, SCM_GC_BYTEVECTOR_OUTPUT_PORT);
{
if (INT_ADD_OVERFLOW (buf->total_len, buf->total_len))
scm_num_overflow ("bytevector_output_port_buffer_grow");
new_size = MAX (min_size, buf->total_len * 2);
new_buf = scm_gc_realloc ((void *) buf->buffer, buf->total_len,
new_size, SCM_GC_BYTEVECTOR_OUTPUT_PORT);
}
else
new_buf = scm_gc_malloc_pointerless (new_size,
SCM_GC_BYTEVECTOR_OUTPUT_PORT);
{
new_size = MAX (min_size, SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER_INITIAL_SIZE);
new_buf = scm_gc_malloc_pointerless (new_size,
SCM_GC_BYTEVECTOR_OUTPUT_PORT);
}
buf->buffer = new_buf;
buf->total_len = new_size;
@ -771,13 +785,18 @@ make_bytevector_output_port (void)
/* Write octets from WRITE_BUF to the backing store. */
static size_t
bytevector_output_port_write (SCM port, SCM src, size_t start, size_t count)
#define FUNC_NAME "bytevector_output_port_write"
{
scm_t_bytevector_output_port_buffer *buf;
buf = SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER (port);
if (buf->pos + count > buf->total_len)
bytevector_output_port_buffer_grow (buf, buf->pos + count);
if (count > buf->total_len - buf->pos)
{
if (INT_ADD_OVERFLOW (buf->pos, count))
scm_num_overflow (FUNC_NAME);
bytevector_output_port_buffer_grow (buf, buf->pos + count);
}
memcpy (buf->buffer + buf->pos, SCM_BYTEVECTOR_CONTENTS (src) + start, count);
@ -786,29 +805,36 @@ bytevector_output_port_write (SCM port, SCM src, size_t start, size_t count)
return count;
}
#undef FUNC_NAME
static scm_t_off
bytevector_output_port_seek (SCM port, scm_t_off offset, int whence)
#define FUNC_NAME "bytevector_output_port_seek"
{
scm_t_bytevector_output_port_buffer *buf;
size_t base;
scm_t_off target;
buf = SCM_BYTEVECTOR_OUTPUT_PORT_BUFFER (port);
if (whence == SEEK_CUR)
target = offset + buf->pos;
base = buf->pos;
else if (whence == SEEK_SET)
target = offset;
base = 0;
else if (whence == SEEK_END)
target = offset + buf->len;
base = buf->len;
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
if (base > SCM_T_OFF_MAX
|| INT_ADD_OVERFLOW ((scm_t_off) base, offset))
scm_num_overflow (FUNC_NAME);
target = (scm_t_off) base + offset;
if (target >= 0 && target <= buf->len)
buf->pos = target;
else
scm_out_of_range (FUNC_NAME, scm_from_long (offset));
scm_out_of_range (FUNC_NAME, scm_from_off_t (offset));
return target;
}

20
libguile/strings.c
View file

@ -32,6 +32,7 @@
#include <unistr.h>
#include <uniconv.h>
#include <c-strcase.h>
#include <intprops.h>
#include "chars.h"
#include "deprecation.h"
@ -129,6 +130,12 @@ make_stringbuf (size_t len)
lenhist[1000]++;
#endif
/* Make sure that the total allocation size will not overflow size_t,
with ~30 extra bytes to spare to avoid an overflow within the
allocator. */
if (INT_ADD_OVERFLOW (len, STRINGBUF_HEADER_BYTES + 32))
scm_num_overflow ("make_stringbuf");
buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + len + 1,
"string"));
@ -155,9 +162,16 @@ make_wide_stringbuf (size_t len)
lenhist[1000]++;
#endif
/* Make sure that the total allocation size will not overflow size_t,
with ~30 extra bytes to spare to avoid an overflow within the
allocator. */
if (len > (((size_t) -(STRINGBUF_HEADER_BYTES + 32 + sizeof (scm_t_wchar)))
/ sizeof (scm_t_wchar)))
scm_num_overflow ("make_wide_stringbuf");
raw_len = (len + 1) * sizeof (scm_t_wchar);
buf = SCM_PACK_POINTER (scm_gc_malloc_pointerless (STRINGBUF_HEADER_BYTES + raw_len,
"string"));
"string"));
SCM_SET_CELL_TYPE (buf, STRINGBUF_TAG | STRINGBUF_F_WIDE);
SCM_SET_CELL_WORD_1 (buf, (scm_t_bits) len);
@ -1393,8 +1407,8 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1,
s = SCM_CAR (l);
SCM_VALIDATE_STRING (SCM_ARGn, s);
len = scm_i_string_length (s);
if (((size_t) -1) - total < len)
scm_num_overflow (s_scm_string_append);
if (INT_ADD_OVERFLOW (total, len))
scm_num_overflow (FUNC_NAME);
total += len;
if (!scm_i_is_narrow_string (s))
wide = 1;

29
libguile/strports.c
View file

@ -27,6 +27,7 @@
#include <stdio.h>
#include <string.h>
#include <unistd.h>
#include <intprops.h>
#include "bytevectors.h"
#include "deprecation.h"
@ -86,16 +87,21 @@ string_port_read (SCM port, SCM dst, size_t start, size_t count)
static size_t
string_port_write (SCM port, SCM src, size_t start, size_t count)
#define FUNC_NAME "string_port_write"
{
struct string_port *stream = (void *) SCM_STREAM (port);
size_t old_size = SCM_BYTEVECTOR_LENGTH (stream->bytevector);
if (SCM_BYTEVECTOR_LENGTH (stream->bytevector) < stream->pos + count)
if (count > old_size - stream->pos)
{
SCM new_bv;
size_t new_size;
new_size = MAX (SCM_BYTEVECTOR_LENGTH (stream->bytevector) * 2,
stream->pos + count);
if (INT_ADD_OVERFLOW (stream->pos, count))
scm_num_overflow (FUNC_NAME);
/* If (old_size * 2) overflows, it's harmless. */
new_size = MAX (old_size * 2, stream->pos + count);
new_bv = scm_c_make_bytevector (new_size);
memcpy (SCM_BYTEVECTOR_CONTENTS (new_bv),
SCM_BYTEVECTOR_CONTENTS (stream->bytevector),
@ -112,27 +118,34 @@ string_port_write (SCM port, SCM src, size_t start, size_t count)
return count;
}
#undef FUNC_NAME
static scm_t_off
string_port_seek (SCM port, scm_t_off offset, int whence)
#define FUNC_NAME "string_port_seek"
{
struct string_port *stream = (void *) SCM_STREAM (port);
size_t base;
scm_t_off target;
if (whence == SEEK_CUR)
target = offset + stream->pos;
base = stream->pos;
else if (whence == SEEK_SET)
target = offset;
base = 0;
else if (whence == SEEK_END)
target = offset + stream->len;
base = stream->len;
else
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, "invalid `seek' parameter");
if (base > SCM_T_OFF_MAX
|| INT_ADD_OVERFLOW ((scm_t_off) base, offset))
scm_num_overflow (FUNC_NAME);
target = (scm_t_off) base + offset;
if (target >= 0 && target <= stream->len)
stream->pos = target;
else
scm_out_of_range (FUNC_NAME, scm_from_long (offset));
scm_out_of_range (FUNC_NAME, scm_from_off_t (offset));
return target;
}
@ -147,7 +160,7 @@ string_port_truncate (SCM port, scm_t_off length)
if (0 <= length && stream->pos <= length && length <= stream->len)
stream->len = length;
else
scm_out_of_range (FUNC_NAME, scm_from_off_t_or_off64_t (length));
scm_out_of_range (FUNC_NAME, scm_from_off_t (length));
}
#undef FUNC_NAME

4
libguile/vectors.c
View file

@ -1,4 +1,4 @@
/* Copyright 1995-1996,1998-2001,2006,2008-2012,2014,2018
/* Copyright 1995-1996,1998-2001,2006,2008-2012,2014,2018-2019
Free Software Foundation, Inc.
This file is part of Guile.
@ -246,7 +246,7 @@ scm_c_make_vector (size_t k, SCM fill)
#define FUNC_NAME s_scm_make_vector
{
SCM vector;
unsigned long int j;
size_t j;
SCM_ASSERT_RANGE (1, scm_from_size_t (k), k <= VECTOR_MAX_LENGTH);