diff options
author | Andy Wingo <wingo@pobox.com> | 2012-01-30 18:25:07 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-01-30 18:25:07 +0100 |
commit | 855db1905d56efcdf91ae51a9e80990f79030eae (patch) | |
tree | 9c918dba899ddae458147ce1095018fcbdec18b0 /libguile | |
parent | 91ee7515da0bad91330ce5c87b250d6cf12a2789 (diff) | |
parent | 9b0975f1dc41ddd10d81fb5b0965b9e9a54ef37a (diff) | |
download | guile-855db1905d56efcdf91ae51a9e80990f79030eae.tar.gz |
Merge commit '9b0975f1dc41ddd10d81fb5b0965b9e9a54ef37a'
Conflicts:
libguile/foreign.c
module/ice-9/psyntax-pp.scm
module/ice-9/psyntax.scm
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/filesys.c | 32 | ||||
-rw-r--r-- | libguile/fluids.c | 5 | ||||
-rw-r--r-- | libguile/foreign.c | 7 | ||||
-rw-r--r-- | libguile/i18n.c | 10 | ||||
-rw-r--r-- | libguile/print.c | 3 | ||||
-rw-r--r-- | libguile/strings.c | 85 | ||||
-rw-r--r-- | libguile/threads.c | 4 | ||||
-rw-r--r-- | libguile/values.c | 25 | ||||
-rw-r--r-- | libguile/values.h | 1 |
9 files changed, 109 insertions, 63 deletions
diff --git a/libguile/filesys.c b/libguile/filesys.c index 3856b4412..63e5a206b 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1,5 +1,6 @@ -/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2002, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. - * +/* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004, 2006, + * 2009, 2010, 2011, 2012 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 * as published by the Free Software Foundation; either version 3 of @@ -96,23 +97,9 @@ #include <pwd.h> #endif +#include <dirent.h> -#if HAVE_DIRENT_H -# include <dirent.h> -# define NAMLEN(dirent) strlen((dirent)->d_name) -#else -# define dirent direct -# define NAMLEN(dirent) (dirent)->d_namlen -# if HAVE_SYS_NDIR_H -# include <sys/ndir.h> -# endif -# if HAVE_SYS_DIR_H -# include <sys/dir.h> -# endif -# if HAVE_NDIR_H -# include <ndir.h> -# endif -#endif +#define NAMLEN(dirent) strlen ((dirent)->d_name) /* Some more definitions for the native Windows port. */ #ifdef __MINGW32__ @@ -121,15 +108,6 @@ # define fchmod(fd, mode) (-1) #endif /* __MINGW32__ */ -/* dirfd() returns the file descriptor underlying a "DIR*" directory stream. - Found on MacOS X for instance. The following definition is for Solaris - 10, it's probably not right elsewhere, but that's ok, it shouldn't be - used elsewhere. Crib note: If we need more then gnulib has a dirfd.m4 - figuring out how to get the fd (dirfd function, dirfd macro, dd_fd field, - or d_fd field). */ -#ifndef dirfd -#define dirfd(dirstream) ((dirstream)->dd_fd) -#endif diff --git a/libguile/fluids.c b/libguile/fluids.c index 0c9c03ff8..55910b0a5 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 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 @@ -179,7 +179,8 @@ scm_make_fluid (void) SCM_DEFINE (scm_make_fluid_with_default, "make-fluid", 0, 1, 0, (SCM dflt), - "Return a newly created fluid.\n" + "Return a newly created fluid, whose initial value is @var{dflt},\n" + "or @code{#f} if @var{dflt} is not given.\n" "Fluids are objects that can hold one\n" "value per dynamic state. That is, modifications to this value are\n" "only visible to code that executes with the same dynamic state as\n" diff --git a/libguile/foreign.c b/libguile/foreign.c index a734f2d1e..445ce0289 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2010, 2011 Free Software Foundation, Inc. +/* Copyright (C) 2010, 2011, 2012 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 @@ -266,7 +266,8 @@ SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0, blen = scm_to_size_t (len); - ret = scm_c_take_typed_bytevector (ptr + boffset, blen, btype, pointer); + ret = scm_c_take_typed_bytevector ((signed char *) ptr + boffset, + blen, btype, pointer); return ret; } @@ -280,7 +281,7 @@ SCM_DEFINE (scm_bytevector_to_pointer, "bytevector->pointer", 1, 1, 0, #define FUNC_NAME s_scm_bytevector_to_pointer { SCM ret; - scm_t_int8 *ptr; + signed char *ptr; size_t boffset; SCM_VALIDATE_BYTEVECTOR (1, bv); diff --git a/libguile/i18n.c b/libguile/i18n.c index f833e5d16..4bb9e2137 100644 --- a/libguile/i18n.c +++ b/libguile/i18n.c @@ -1744,13 +1744,23 @@ define_langinfo_items (void) DEFINE_NLITEM_CONSTANT (T_FMT); /* Time format for strftime. */ DEFINE_NLITEM_CONSTANT (T_FMT_AMPM);/* 12-hour time format for strftime. */ +#ifdef ERA DEFINE_NLITEM_CONSTANT (ERA); /* Alternate era. */ +#endif +#ifdef ERA_D_FMT DEFINE_NLITEM_CONSTANT (ERA_D_FMT); /* Date in alternate era format. */ +#endif +#ifdef ERA_D_T_FMT DEFINE_NLITEM_CONSTANT (ERA_D_T_FMT); /* Date and time in alternate era format. */ +#endif +#ifdef ERA_T_FMT DEFINE_NLITEM_CONSTANT (ERA_T_FMT); /* Time in alternate era format. */ +#endif +#ifdef ALT_DIGITS DEFINE_NLITEM_CONSTANT (ALT_DIGITS); /* Alternate symbols for digits. */ +#endif DEFINE_NLITEM_CONSTANT (RADIXCHAR); DEFINE_NLITEM_CONSTANT (THOUSEP); diff --git a/libguile/print.c b/libguile/print.c index a1c36eb94..b800362c1 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 Free Software Foundation, Inc. + * 2009, 2010, 2011, 2012 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 @@ -654,6 +654,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) case scm_tc7_array: ENTER_NESTED_DATA (pstate, exp, circref); scm_i_print_array (exp, port, pstate); + EXIT_NESTED_DATA (pstate); break; case scm_tc7_bytevector: scm_i_print_bytevector (exp, port, pstate); diff --git a/libguile/strings.c b/libguile/strings.c index cb883fa73..cdd43e1b2 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -267,8 +267,22 @@ SCM scm_nullstr; SCM scm_i_make_string (size_t len, char **charsp, int read_only_p) { - SCM buf = make_stringbuf (len); + static SCM null_stringbuf = SCM_BOOL_F; + SCM buf; SCM res; + + if (len == 0) + { + if (SCM_UNLIKELY (scm_is_false (null_stringbuf))) + { + null_stringbuf = make_stringbuf (0); + SET_STRINGBUF_SHARED (null_stringbuf); + } + buf = null_stringbuf; + } + else + buf = make_stringbuf (len); + if (charsp) *charsp = (char *) STRINGBUF_CHARS (buf); res = scm_double_cell (read_only_p ? RO_STRING_TAG : STRING_TAG, @@ -320,37 +334,48 @@ get_str_buf_start (SCM *str, SCM *buf, size_t *start) SCM scm_i_substring (SCM str, size_t start, size_t end) { - SCM buf; - size_t str_start; - get_str_buf_start (&str, &buf, &str_start); - scm_i_pthread_mutex_lock (&stringbuf_write_mutex); - SET_STRINGBUF_SHARED (buf); - scm_i_pthread_mutex_unlock (&stringbuf_write_mutex); - return scm_double_cell (STRING_TAG, SCM_UNPACK(buf), - (scm_t_bits)str_start + start, - (scm_t_bits) end - start); + if (start == end) + return scm_i_make_string (0, NULL, 0); + else + { + SCM buf; + size_t str_start; + get_str_buf_start (&str, &buf, &str_start); + scm_i_pthread_mutex_lock (&stringbuf_write_mutex); + SET_STRINGBUF_SHARED (buf); + scm_i_pthread_mutex_unlock (&stringbuf_write_mutex); + return scm_double_cell (STRING_TAG, SCM_UNPACK(buf), + (scm_t_bits)str_start + start, + (scm_t_bits) end - start); + } } SCM scm_i_substring_read_only (SCM str, size_t start, size_t end) { - SCM buf; - size_t str_start; - get_str_buf_start (&str, &buf, &str_start); - scm_i_pthread_mutex_lock (&stringbuf_write_mutex); - SET_STRINGBUF_SHARED (buf); - scm_i_pthread_mutex_unlock (&stringbuf_write_mutex); - return scm_double_cell (RO_STRING_TAG, SCM_UNPACK(buf), - (scm_t_bits)str_start + start, - (scm_t_bits) end - start); + if (start == end) + return scm_i_make_string (0, NULL, 1); + else + { + SCM buf; + size_t str_start; + get_str_buf_start (&str, &buf, &str_start); + scm_i_pthread_mutex_lock (&stringbuf_write_mutex); + SET_STRINGBUF_SHARED (buf); + scm_i_pthread_mutex_unlock (&stringbuf_write_mutex); + return scm_double_cell (RO_STRING_TAG, SCM_UNPACK(buf), + (scm_t_bits)str_start + start, + (scm_t_bits) end - start); + } } SCM scm_i_substring_copy (SCM str, size_t start, size_t end) { size_t len = end - start; - SCM buf, my_buf; + SCM buf, my_buf, substr; size_t str_start; + int wide = 0; get_str_buf_start (&str, &buf, &str_start); if (scm_i_is_narrow_string (str)) { @@ -364,12 +389,14 @@ scm_i_substring_copy (SCM str, size_t start, size_t end) u32_cpy ((scm_t_uint32 *) STRINGBUF_WIDE_CHARS (my_buf), (scm_t_uint32 *) (STRINGBUF_WIDE_CHARS (buf) + str_start + start), len); - /* Even though this string is wide, the substring may be narrow. - Consider adding code to narrow the string. */ + wide = 1; } scm_remember_upto_here_1 (buf); - return scm_double_cell (STRING_TAG, SCM_UNPACK (my_buf), - (scm_t_bits) 0, (scm_t_bits) len); + substr = scm_double_cell (STRING_TAG, SCM_UNPACK (my_buf), + (scm_t_bits) 0, (scm_t_bits) len); + if (wide) + scm_i_try_narrow_string (substr); + return substr; } SCM @@ -377,7 +404,9 @@ scm_i_substring_shared (SCM str, size_t start, size_t end) { if (start == 0 && end == STRING_LENGTH (str)) return str; - else + else if (start == end) + return scm_i_make_string (0, NULL, 0); + else { size_t len = end - start; if (IS_SH_STRING (str)) @@ -1489,12 +1518,10 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, scm_misc_error ("scm_from_stringn", "NULL string pointer", SCM_EOL); if (len == (size_t) -1) len = strlen (str); - if (len == 0) - return scm_nullstr; - if (encoding == NULL) + if (encoding == NULL || len == 0) { - /* If encoding is null, use Latin-1. */ + /* If encoding is null (or the string is empty), use Latin-1. */ char *buf; res = scm_i_make_string (len, &buf, 0); memcpy (buf, str, len); diff --git a/libguile/threads.c b/libguile/threads.c index 0dba50f8a..463414f4a 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -550,7 +550,7 @@ guilify_self_1 (struct GC_stack_base *base) t.critical_section_level = 0; t.base = base->mem_base; #ifdef __ia64__ - t.register_backing_store_base = base->reg-base; + t.register_backing_store_base = base->reg_base; #endif t.continuation_root = SCM_EOL; t.continuation_base = t.base; @@ -1127,6 +1127,8 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex); scm_i_pthread_mutex_unlock (&data.mutex); + assert (SCM_I_IS_THREAD (data.thread)); + return data.thread; } diff --git a/libguile/values.c b/libguile/values.c index 005be5063..fdd93599a 100644 --- a/libguile/values.c +++ b/libguile/values.c @@ -67,6 +67,31 @@ print_values (SCM obj, SCM pwps) return SCM_UNSPECIFIED; } +SCM +scm_c_value_ref (SCM obj, size_t idx) +{ + if (SCM_LIKELY (SCM_VALUESP (obj))) + { + SCM values = scm_struct_ref (obj, SCM_INUM0); + size_t i = idx; + while (SCM_LIKELY (scm_is_pair (values))) + { + if (i == 0) + return SCM_CAR (values); + values = SCM_CDR (values); + i--; + } + } + else if (idx == 0) + return obj; + + scm_error (scm_out_of_range_key, + "scm_c_value_ref", + "Too few values in ~S to access index ~S", + scm_list_2 (obj, scm_from_unsigned_integer (idx)), + scm_list_1 (scm_from_unsigned_integer (idx))); +} + SCM_DEFINE (scm_values, "values", 0, 0, 1, (SCM args), "Delivers all of its arguments to its continuation. Except for\n" diff --git a/libguile/values.h b/libguile/values.h index 65ad8a119..5f79855be 100644 --- a/libguile/values.h +++ b/libguile/values.h @@ -33,6 +33,7 @@ SCM_API SCM scm_values_vtable; SCM_INTERNAL void scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2); SCM_API SCM scm_values (SCM args); +SCM_API SCM scm_c_value_ref (SCM values, size_t idx); SCM_INTERNAL void scm_init_values (void); #endif /* SCM_VALUES_H */ |