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

Merge commit 'f30e1bdf97' into boehm-demers-weiser-gc

Browse source 
Conflicts:
	libguile/Makefile.am
	libguile/coop-pthreads.c
	libguile/gc-freelist.c
	libguile/gc-segment.c
	libguile/gc.c
	libguile/private-gc.h
	test-suite/tests/environments.nottest
This commit is contained in:
Ludovic Courtès 2008-09-10 22:27:30 +02:00
commit 35a9197ccc
99 changed files with 5085 additions and 993 deletions
Download patch file Download diff file Expand all files Collapse all files

1
.cvsignore
View file

@ -27,6 +27,7 @@ install-sh
libtool
ltconfig
ltmain.sh
mdate-sh
missing
mkinstalldirs
pre-inst-guile

87
ChangeLog
View file

@ -1,10 +1,66 @@
2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-11-18 Ludovic Courtès <ludovic.courtes@laas.fr>
* GUILE-VERSION: Added `LIBGUILE_I18N_*'.
* configure.in: Look for `strcoll_l ()' and `newlocale ()'.
Substitute the `LIBGUILE_I18N_' variables.
* NEWS: Mention `(ice-9 i18n)'.
2006-11-17 Neil Jerram <neil@ossau.uklinux.net>
* README: Note need for subscription to bug-guile@gnu.org.
* NEWS: Note need for subscription to bug-guile@gnu.org.
2006-11-08 Ludovic Courtès <ludovic.courtes@laas.fr>
* configure.in: Pass `bug-guile@gnu.org' as a third argument to
`AC_INIT'.
2006-10-25 Neil Jerram <neil@ossau.uklinux.net>
IA64 HP-UX patch from Hrvoje Nikšić. (Thanks!)
* configure.in: New check for uca lib (needed for IA64 on HP-UX).
2006-10-06 Rob Browning <rlb@defaultvalue.org>
Guile 1.8.1 released.
* GUILE-VERSION (GUILE_MICRO_VERSION): Increment for release.
(LIBGUILE_INTERFACE_REVISION): Increment for release.
(LIBGUILE_SRFI_SRFI_1_INTERFACE_REVISION): Increment for release.
(LIBGUILE_SRFI_SRFI_4_INTERFACE_REVISION): Increment for release.
(LIBGUILE_SRFI_SRFI_13_14_INTERFACE_REVISION): Increment for release.
(LIBGUILE_SRFI_SRFI_60_INTERFACE_REVISION): Increment for release.
* Makefile.am (EXTRA_DIST): Add LICENSE.
2006-09-28 Kevin Ryde <user42@zip.com.au>
* configure.in (chsize, ftruncate, truncate): New tests, for mingw.
2006-09-27 Kevin Ryde <user42@zip.com.au>
* configure.in (clog10): New test, not in mingw.
2006-09-23 Kevin Ryde <user42@zip.com.au>
* configure.in (complex.h, complex double, csqrt): New tests.
2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr>
* configure.in: Check for `isblank ()'.
* NEWS: Mentioned the interaction between `setlocale' and SRFI-14
standard char sets.
2006-08-22 Kevin Ryde <user42@zip.com.au>
* configure.in: Test if need braces around PTHREAD_ONCE_INIT, set
AC_OUTPUT of SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT.
2006-08-18 Neil Jerram <neil@ossau.uklinux.net>
* configure.in: Generate Makefile for emacs subdir.
@ -13,7 +69,21 @@
* configure.in: Generate Makefile for ice-9/debugging subdir.
2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-07-25 Kevin Ryde <user42@zip.com.au>
* configure.in (AC_CHECK_FUNCS): Add pthread_getattr_np.
2006-07-24 Kevin Ryde <user42@zip.com.au>
* configure.in (AC_CHECK_DECLS): Add sethostname for Solaris 10.
(AC_CHECK_FUNCS): Remove dirfd, it's a macro.
Reported by Claes Wallin.
2006-06-25 Kevin Ryde <user42@zip.com.au>
* configure.in (AC_CHECK_MEMBERS): Test struct tm.tm_gmtoff.
2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr>
* NEWS: Mentioned the new behavior of `equal?' for structures.
@ -216,7 +286,7 @@
* acinclude.m4 (ACX_PTHREAD): New.
* configure.in: Use it instead of simply looking for -lpthread.
Thanks to Andreas Vögele!
Thanks to Andreas Vögele!
2004-09-08 Marius Vollmer <marius.vollmer@uni-dortmund.de>
@ -269,7 +339,7 @@
2004-07-09 Marius Vollmer <mvo@zagadka.de>
* configure.in: Bugfix: set SCM_I_GSC_T_UINTMAX, not
SCM_I_GSC_T_INTMAX in two places. Thanks to Andreas Vögele!
SCM_I_GSC_T_INTMAX in two places. Thanks to Andreas Vögele!
2004-07-07 Marius Vollmer <marius.vollmer@uni-dortmund.de>
@ -1988,7 +2058,7 @@ Tue Dec 14 09:12:22 1999 Greg J. Badros <gjb@cs.washington.edu>
1999-07-19 Jim Blandy <jimb@savonarola.red-bean.com>
Fixes for EMX from Mikael Ståldal.
Fixes for EMX from Mikael Ståldal.
* configure.in: Check for <io.h>.
* configure: Regenerated.
@ -2923,3 +2993,8 @@ Thu Aug 1 02:31:53 1996 Jim Blandy <jimb@totoro.cyclic.com>
Makefile. Build doc/Makefile from doc/Makefile.in.
* doc/Makefile.in: New file.
;; Local Variables:
;; coding: utf-8
;; End:

6
GUILE-VERSION
View file

@ -54,3 +54,9 @@ LIBGUILE_SRFI_SRFI_60_INTERFACE_CURRENT=3
LIBGUILE_SRFI_SRFI_60_INTERFACE_REVISION=0
LIBGUILE_SRFI_SRFI_60_INTERFACE_AGE=0
LIBGUILE_SRFI_SRFI_60_INTERFACE="${LIBGUILE_SRFI_SRFI_60_INTERFACE_CURRENT}:${LIBGUILE_SRFI_SRFI_60_INTERFACE_REVISION}:${LIBGUILE_SRFI_SRFI_60_INTERFACE_AGE}"
LIBGUILE_I18N_MAJOR=0
LIBGUILE_I18N_INTERFACE_CURRENT=0
LIBGUILE_I18N_INTERFACE_REVISION=0
LIBGUILE_I18N_INTERFACE_AGE=0
LIBGUILE_I18N_INTERFACE="${LIBGUILE_I18N_INTERFACE_CURRENT}:${LIBGUILE_INTERFACE_REVISION}:${LIBGUILE_I18N_INTERFACE_AGE}"

2
Makefile.am
View file

@ -30,7 +30,7 @@ include_HEADERS = libguile.h
# automake sometimes forgets to distribute acconfig.h,
# apparently depending on the phase of the moon.
EXTRA_DIST = HACKING GUILE-VERSION ANON-CVS SNAPSHOTS BUGS
EXTRA_DIST = LICENSE HACKING GUILE-VERSION ANON-CVS SNAPSHOTS BUGS
TESTS = check-guile

79
NEWS
View file

@ -2,7 +2,9 @@ Guile NEWS --- history of user-visible changes.
Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
See the end for copying conditions.
Please send Guile bug reports to bug-guile@gnu.org.
Please send Guile bug reports to bug-guile@gnu.org. Note that you
must be subscribed to this list first, in order to successfully send a
report to it.
Each release reports the NEWS in the following sections:
@ -22,34 +24,75 @@ Changes in 1.9.XXXXXXXX:
Changes in 1.8.1 (since 1.8.0):
* Changes to the distribution
* LFS functions are now used to access 64-bit files on 32-bit systems.
** New primitive-_exit giving the _exit() system call.
* New procedures (see the manual for details)
* Changes to Scheme functions and syntax
** primitive-_exit - [Scheme] the-root-module
** scm_primitive__exit - [C]
** make-completion-function - [Scheme] (ice-9 readline)
** scm_c_locale_stringn_to_number - [C]
** scm_srfi1_append_reverse [C]
** scm_srfi1_append_reverse_x [C]
** scm_log - [C]
** scm_log10 - [C]
** scm_exp - [C]
** scm_sqrt - [C]
* New `(ice-9 i18n)' module (see the manual for details)
* Bugs fixed
** Build problems have been fixed on MacOS, SunOS, and QNX.
** A one-dimensional array can now be 'equal?' to a vector.
** Structures, records, and SRFI-9 records can now be compared with `equal?'.
** SRFI-14 standard char sets are now recomputed upon successful `setlocale'.
* Changes to the C interface
** SRFI-14 standard char sets are recomputed upon a successful `setlocale'.
** New function scm_c_locale_stringn_to_number.
** `record-accessor' and `record-modifier' now have strict type checks.
* Bug fixes.
Record accessor and modifier procedures now throw an error if the
record type of the record they're given is not the type expected.
(Previously accessors returned #f and modifiers silently did nothing).
** array-set! with bit vector.
** make-shared-array fixes, including examples in the manual which failed.
** string<? and friends follow char<? etc order on 8-bit chars.
** n-par-for-each, n-for-each-par-map for "futures" variable.
** module autoload and explicit use-modules cooperate.
** ice-9 format ~f with infs and nans.
** exact->inexact overflows on fractions with big num/den but small result.
** srfi-1 assoc "=" procedure argument order.
** Build problems on MacOS, SunOS, QNX.
** It is now OK to use both autoload and use-modules on a given module.
** `apply' checks the number of arguments more carefully on "0 or 1" funcs.
Previously there was no checking on primatives like make-vector that
accept "one or two" arguments. Now there is.
** The srfi-1 assoc function now calls its equality predicate properly.
Previously srfi-1 assoc would call the equality predicate with the key
last. According to the SRFI, the key should be first.
** A bug in n-par-for-each and n-for-each-par-map has been fixed.
** The array-set! procedure no longer segfaults when given a bit vector.
** Bugs in make-shared-array have been fixed.
** string<? and friends now follow char<? etc order on 8-bit chars.
** The format procedure now handles inf and nan values for ~f correctly.
** exact->inexact should no longer overflow when given certain large fractions.
** srfi-9 accessor and modifier procedures now have strict record type checks.
This matches the srfi-9 specification.
** (ice-9 ftw) procedures won't ignore different files with same inode number.
Previously the (ice-9 ftw) procedures would ignore any file that had
the same inode number as a file they had already seen, even if that
file was on a different device.
Changes since the 1.6.x series:
Changes in 1.8.0 (changes since the 1.6.x series):
* Changes to the distribution

4
README
View file

@ -16,7 +16,9 @@ This has been the case since the 1.3.* series.
The next stable release will likely be version 1.10.0.
Please send bug reports to bug-guile@gnu.org.
Please send bug reports to bug-guile@gnu.org. Note that you must be
subscribed to this list first, in order to successfully send a report
to it.
See the LICENSE file for the specific terms that apply to Guile.

2
THANKS
View file

@ -59,6 +59,7 @@ For fixes or providing information which led to a fix:
Arno Peters
Ron Peterson
David Pirotte
Carlos Pita
Ken Raeburn
Andreas Rottmann
Kevin Ryde
@ -78,3 +79,4 @@ For fixes or providing information which led to a fix:
Michael Tuexen
Andy Wingo
Keith Wright
William Xu

4
benchmark-suite/ChangeLog
View file

@ -1,3 +1,7 @@
2006-11-17 Neil Jerram <neil@ossau.uklinux.net>
* README: Note need for subscription to bug-guile@gnu.org.
2006-05-02 Marius Vollmer <mvo@zagadka.de>
* Makefile.am (SCM_BENCHMARKS_DIRS, dist-hook): Removed, they are

10
benchmark-suite/README
View file

@ -12,7 +12,9 @@ You can reference the file `lib.scm' from your own code as the module
(benchmark-suite lib); it also has comments at the top and before each
function explaining what's going on.
Please write more Guile benchmarks, and send them to bug-guile@gnu.org.
We'll merge them into the distribution. All benchmark suites must be
licensed for our use under the GPL, but I don't think we're going to
collect assignment papers for them.
Please write more Guile benchmarks, and send them to
bug-guile@gnu.org. (Note that you must be subscribed to this list
first, in order to successfully send a message to it.) We'll merge
them into the distribution. All benchmark suites must be licensed for
our use under the GPL, but I don't think we're going to collect
assignment papers for them.

112
configure.in
View file

@ -28,7 +28,8 @@ Boston, MA 02110-1301, USA.
AC_PREREQ(2.53)
AC_INIT(m4_esyscmd(. ./GUILE-VERSION && echo -n ${PACKAGE}),
m4_esyscmd(. ./GUILE-VERSION && echo -n ${GUILE_VERSION}))
m4_esyscmd(. ./GUILE-VERSION && echo -n ${GUILE_VERSION}),
[bug-guile@gnu.org])
AC_CONFIG_AUX_DIR([.])
AC_CONFIG_SRCDIR(GUILE-VERSION)
AM_INIT_AUTOMAKE([no-define])
@ -212,6 +213,7 @@ if test "$enable_elisp" = yes; then
else
SCM_I_GSC_ENABLE_ELISP=0
fi
AC_CHECK_LIB(uca, __uc_get_ar_bsp)
AC_C_CONST
@ -221,6 +223,7 @@ if test "$ac_cv_c_inline" != no; then
else
SCM_I_GSC_C_INLINE=NULL
fi
AC_CHECK_LIB(uca, __uc_get_ar_bsp)
AC_C_BIGENDIAN
@ -523,14 +526,22 @@ AC_HEADER_TIME
AC_HEADER_SYS_WAIT
# Reasons for testing:
# complex.h - new in C99
# fenv.h - available in C99, but not older systems
#
AC_CHECK_HEADERS([fenv.h io.h libc.h limits.h malloc.h memory.h string.h \
AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h malloc.h memory.h string.h \
regex.h rxposix.h rx/rxposix.h sys/dir.h sys/ioctl.h sys/select.h \
sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \
sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \
direct.h])
# "complex double" is new in C99, and "complex" is only a keyword if
# <complex.h> is included
AC_CHECK_TYPES(complex double,,,
[#if HAVE_COMPLEX_H
#include <complex.h>
#endif])
# On MacOS X <sys/socklen.h> contains socklen_t, so must include that
# when testing.
AC_CHECK_TYPE(socklen_t, ,
@ -592,23 +603,32 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# DINFINITY - OSF specific
# DQNAN - OSF specific
# (DINFINITY and DQNAN are actually global variables, not functions)
# chsize - an MS-DOS-ism, found in mingw
# clog10 - not in mingw (though others like clog and csqrt are)
# fesetround - available in C99, but not older systems
# ftruncate - posix, but probably not older systems (current mingw
# has it as an inline for chsize)
# ioctl - not in mingw.
# gmtime_r - recent posix, not on old systems
# readdir_r - recent posix, not on old systems
# stat64 - SuS largefile stuff, not on old systems
# sysconf - not on old systems
# truncate - not in mingw
# isblank - available as a GNU extension or in C99
# _NSGetEnviron - Darwin specific
# strcoll_l, newlocale - GNU extensions (glibc)
#
AC_CHECK_FUNCS([DINFINITY DQNAN ctermid fesetround ftime fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex unsetenv isblank _NSGetEnviron])
AC_CHECK_FUNCS([DINFINITY DQNAN chsize clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale])
# Reasons for testing:
# netdb.h - not in mingw
# sys/param.h - not in mingw
# sethostname - the function itself check because it's not in mingw,
# the DECL is checked because Solaris 10 doens't have in any header
#
AC_CHECK_HEADERS(crypt.h netdb.h sys/param.h sys/resource.h sys/file.h)
AC_CHECK_FUNCS(chroot flock getlogin cuserid getpriority setpriority getpass sethostname gethostname)
AC_CHECK_DECLS([sethostname])
# crypt() may or may not be available, for instance in some countries there
# are restrictions on cryptography.
@ -627,6 +647,38 @@ AC_SEARCH_LIBS(crypt, crypt,
[AC_DEFINE(HAVE_CRYPT,1,
[Define to 1 if you have the `crypt' function.])])
# glibc 2.3.6 (circa 2006) and various prior versions had a bug where
# csqrt(-i) returned a negative real part, when it should be positive
# for the principal root.
#
if test "$ac_cv_type_complex_double" = yes; then
AC_CACHE_CHECK([whether csqrt is usable],
guile_cv_use_csqrt,
[AC_TRY_RUN([
#include <complex.h>
/* "volatile" is meant to prevent gcc from calculating the sqrt as a
constant, we want to test libc. */
volatile complex double z = - _Complex_I;
int
main (void)
{
z = csqrt (z);
if (creal (z) > 0.0)
return 0; /* good */
else
return 1; /* bad */
}],
[guile_cv_use_csqrt=yes],
[guile_cv_use_csqrt="no, glibc 2.3 bug"],
[guile_cv_use_csqrt="yes, hopefully (cross-compiling)"])])
case $guile_cv_use_csqrt in
yes*)
AC_DEFINE(HAVE_USABLE_CSQRT, 1, [Define to 1 if csqrt is bug-free])
;;
esac
fi
dnl GMP tests
AC_CHECK_LIB([gmp], [__gmpz_init], ,
[AC_MSG_ERROR([GNU MP not found, see README])])
@ -878,10 +930,9 @@ AC_CHECK_HEADERS(floatingpoint.h ieeefp.h nan.h)
# Reasons for testing:
# asinh, acosh, atanh, trunc - C99 standard, generally not available on
# older systems
# dirfd - mainly BSD derived, not in older systems
# sincos - GLIBC extension
#
AC_CHECK_FUNCS(asinh acosh atanh copysign dirfd finite sincos trunc)
AC_CHECK_FUNCS(asinh acosh atanh copysign finite sincos trunc)
# C99 specifies isinf and isnan as macros.
# HP-UX provides only macros, no functions.
@ -924,6 +975,7 @@ fi
# st_rdev
# st_blksize
# st_blocks not in mingw
# tm_gmtoff BSD+GNU, not in C99
#
# Note AC_STRUCT_ST_BLOCKS is not used here because we don't want the
# AC_LIBOBJ(fileblocks) replacement which that macro gives.
@ -931,8 +983,22 @@ fi
AC_CHECK_MEMBERS([struct stat.st_rdev, struct stat.st_blksize, struct stat.st_blocks])
AC_STRUCT_TIMEZONE
AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
[#include <time.h>
#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
# include <sys/time.h>
# else
# include <time.h>
# endif
#endif
])
GUILE_STRUCT_UTIMBUF
#--------------------------------------------------------------------
#
# Which way does the stack grow?
@ -1009,6 +1075,8 @@ AC_SUBST([SCM_I_GSC_USE_NULL_THREADS])
AC_ARG_WITH(threads, [ --with-threads thread interface],
, with_threads=yes)
AC_SUBST(SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT, 0)
case "$with_threads" in
"yes" | "pthread" | "pthreads" | "pthread-threads" | "")
ACX_PTHREAD(CC="$PTHREAD_CC"
@ -1019,7 +1087,32 @@ case "$with_threads" in
old_CFLAGS="$CFLAGS"
CFLAGS="$PTHREAD_CFLAGS $CFLAGS"
AC_CHECK_FUNCS(pthread_attr_getstack)
# Reasons for testing:
# pthread_getattr_np - "np" meaning "non portable" says it
# all; not present on MacOS X or Solaris 10
#
AC_CHECK_FUNCS(pthread_attr_getstack pthread_getattr_np)
# On past versions of Solaris, believe 8 through 10 at least, you
# had to write "pthread_once_t foo = { PTHREAD_ONCE_INIT };".
# This is contrary to posix:
# http://www.opengroup.org/onlinepubs/000095399/functions/pthread_once.html
# Check here if this style is required.
#
# glibc (2.3.6 at least) works both with or without braces, so the
# test checks whether it works without.
#
AC_CACHE_CHECK([whether PTHREAD_ONCE_INIT needs braces],
guile_cv_need_braces_on_pthread_once_init,
[AC_TRY_COMPILE([#include <pthread.h>],
[pthread_once_t foo = PTHREAD_ONCE_INIT;],
[guile_cv_need_braces_on_pthread_once_init=no],
[guile_cv_need_braces_on_pthread_once_init=yes])])
if test "$guile_cv_need_braces_on_pthread_once_init" = yes; then
SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT=1
fi
CFLAGS="$old_CFLAGS"
# On Solaris, sched_yield lives in -lrt.
@ -1195,6 +1288,13 @@ AC_SUBST(LIBGUILE_SRFI_SRFI_60_INTERFACE_REVISION)
AC_SUBST(LIBGUILE_SRFI_SRFI_60_INTERFACE_AGE)
AC_SUBST(LIBGUILE_SRFI_SRFI_60_INTERFACE)
AC_SUBST(LIBGUILE_I18N_MAJOR)
AC_SUBST(LIBGUILE_I18N_INTERFACE_CURRENT)
AC_SUBST(LIBGUILE_I18N_INTERFACE_REVISION)
AC_SUBST(LIBGUILE_I18N_INTERFACE_AGE)
AC_SUBST(LIBGUILE_I18N_INTERFACE)
#######################################################################
dnl Tell guile-config what flags guile users should compile and link with.

2
doc/goops/ChangeLog
View file

@ -1,4 +1,4 @@
2006-09-27 Neil Jerram <neil@ossau.uklinux.net>
2006-09-28 Neil Jerram <neil@ossau.uklinux.net>
* goops.texi (Slot Options): Added example from Ludovic Courtès
about difference between init-value, -form and -thunk.

143
doc/ref/ChangeLog
View file

@ -1,3 +1,80 @@
2006-11-18 Ludovic Courtès <ludovic.courtes@laas.fr>
* Makefile.am (BUILT_SOURCES): New variable.
(lib-version.texi): New target.
* guile.texi: Include `lib-version.texi'.
* api-data.texi (Conversion): Link to `The ice-9 i18n Module' when
describing `string->number'.
(String Comparison): Likewise.
* api-i18n.texi (Internationalization)[The ice-9 i18n Module]: New
node.
[Gettext Support]: New node; contains text formerly in
`Internationalization'.
* posix.texi (Locales): Added a link to the glibc manual
describing the various locale categories. Mention locale objects
and link to `The ice-9 i18n Module' when describing `setlocale'.
2006-11-17 Neil Jerram <neil@ossau.uklinux.net>
* intro.texi (Reporting Bugs): Note need for subscription to
bug-guile@gnu.org.
2006-10-10 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (Setting and Managing Breakpoints): New text
about what happens when a breakpoint is created.
(Listing and Deleting Breakpoints, Moving and Losing Breakpoints):
New.
2006-10-08 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (Working with GDS in Scheme Buffers): New
subsection, to group (Access to Guile Help and Completion, Setting
and Managing Breakpoints, Evaluating Scheme Code) together.
(GDS Getting Started): Editorial updates.
2006-10-06 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (Using Guile in Emacs): Subnodes reordered,
from (Displaying the Scheme Stack, Continuing Execution,
Evaluating Scheme Code, Setting and Managing Breakpoints, Access
to Guile Help and Completion) to (Access to Guile Help and
Completion, Setting and Managing Breakpoints, Evaluating Scheme
Code, Displaying the Scheme Stack, Continuing Execution).
(Access to Guile Help and Completion): Mention where keys are
defined.
(Setting and Managing Breakpoints): Update text on how to set
breakpoints.
2006-10-05 Kevin Ryde <user42@zip.com.au>
* misc-modules.texi (File Tree Walk): Corrections to BASE parameter
and symlink vs stale-symlink types in nftw.
* misc-modules.texi, guile.texi (Buffered Input): New section,
describing (ice-9 buffered-input).
* posix.texi (User Information): Clarify getpwent returns #f at end of
file.
* repl-modules.texi (Readline Functions): New section on how to call
readline from scheme code.
2006-10-03 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (GDS Getting Started): Editorial updates.
2006-09-28 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (GDS Introduction, GDS Getting Started): Minor
edits.
* api-data.texi (Symbol Props): Remove unnecessarily specific
parenthesis about Guile 1.6's use of extra symbol slots.
2006-09-26 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (Using Guile in Emacs, GDS Introduction):
@ -7,6 +84,12 @@
(GDS Getting Started, How to Use GDS): Merged; editorial updates;
subsections reordered.
2006-09-26 Kevin Ryde <user42@zip.com.au>
* api-io.texi (Random Access): In truncate-file, tweak wording for
clarity, note cannot always extend file this way.
(Ports): File access uses LFS.
2006-09-25 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (Error Handling, Interactive Debugger): Minor
@ -19,11 +102,31 @@
minor improvements. Removed doc for `trace-finish', which no
longer exists.
2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-09-22 Kevin Ryde <user42@zip.com.au>
* api-data.texi (Scientific): In sqrt, note it's the positive root
which is returned (as per R5RS).
2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr>
* api-data.texi (Standard Character Sets): Documented the
charset recomputation upon successful `setlocale'.
2006-09-08 Kevin Ryde <user42@zip.com.au>
* misc-modules.texi (Formatted Output): Show ":@" rather than "@:",
because ":@" is traditional common lisp, though either way works.
Break a couple of example lines to avoid overflowing DVI page width.
* scheme-debugging.texi (Debug Last Error): Line break in "Type
(backtrace) to get ..." which overflowed the line in both info and
DVI. Reported by Percy Tiglao.
2006-09-05 Kevin Ryde <user42@zip.com.au>
* posix.texi (Network Sockets and Communication): Tweak description,
note not multi-threading.
2006-09-04 Neil Jerram <neil@ossau.uklinux.net>
* api-control.texi (Dynamic Wind): Doc for scm_dynwind_free.
@ -37,6 +140,11 @@
* api-debug.texi (Debug on Error): Added paragraph on need to use
debugging evaluator. Added text on what the Guile REPL code does.
2006-08-29 Kevin Ryde <user42@zip.com.au>
* api-control.texi (Dynamic Wind): Reformat example a bit to avoid
going off the right edge of the paper. Reported by Percy Tiglao.
2006-08-28 Neil Jerram <neil@ossau.uklinux.net>
* api-debug.texi (Examining the Stack): Minor improvements to
@ -55,6 +163,11 @@
(GDS Introduction): New node, containing GDS-specific introductory
text.
2006-08-22 Kevin Ryde <user42@zip.com.au>
* api-i18n.texi (Internationalization): Cross reference gettext manual
on plural forms.
2006-08-18 Neil Jerram <neil@ossau.uklinux.net>
* scheme-using.texi (Using Guile in Emacs): Unignore extra GDS
@ -110,12 +223,23 @@
* Makefile.am (guile_TEXINFOS): Include new scheme-using.texi
file.
2006-06-16 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-07-24 Kevin Ryde <user42@zip.com.au>
* api-evaluation.texi (Fly Evaluation): Add scm_c_eval_string.
(Loading): Add scm_c_primitive_load.
Reported by Jon Wilson.
2006-06-25 Kevin Ryde <user42@zip.com.au>
* posix.texi (Time): In tm:gmtoff, give example values, note not the
same as C tm_gmtoff.
2006-06-16 Ludovic Courtès <ludovic.courtes@laas.fr>
* api-utility.texi (Equality): Mentioned the behavior of `equal?'
for structures (as suggested by Kevin Ryde).
2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr>
* api-compound.texi (Structure Concepts): Mentioned the behavior
of `equal?' for structures.
@ -182,7 +306,7 @@
SCM_SIMPLE_VECTOR_SET not SCM_SIMPLE_VECTOR_SET_X, the former is
what's in vector.h.
2006-03-21 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-03-21 Ludovic Courtès <ludovic.courtes@laas.fr>
* api-data.texi (Conversion): Add scm_c_locale_stringn_to_number.
@ -234,7 +358,7 @@
contexts. Renamed all functions from scm_frame_ to scm_dynwind_.
Updated documentation.
2005-12-19 Ludovic Courtès <ludovic.courtes@laas.fr>
2005-12-19 Ludovic Courtès <ludovic.courtes@laas.fr>
* api-data.texi (Operations Related to Symbols):
Documented `scm_take_locale_symbol ()'.
@ -276,7 +400,7 @@
2005-11-06 Kevin Ryde <user42@zip.com.au>
From Ludovic Courtès, partial rework by me:
From Ludovic Courtès, partial rework by me:
* doc/ref/api-modules.texi (Creating Guile Modules): In define-module,
describe #:re-export, #:export-syntax, #:re-export-syntax, #:replace
and #:duplicates. Add re-export.
@ -289,7 +413,7 @@
* posix.texi (Network Socket Address): Add scm_make_socket_address,
scm_c_make_socket_address, scm_from_sockaddr, scm_to_sockaddr. This
change by Ludovic Courtès and revised a bit by me.
change by Ludovic Courtès and revised a bit by me.
2005-10-27 Kevin Ryde <user42@zip.com.au>
@ -2395,3 +2519,8 @@
The change log for files in this directory continues backwards
from 2001-08-27 in ../ChangeLog, as all the Guile documentation
prior to this date was contained in a single directory.
;; Local Variables:
;; coding: utf-8
;; End:

9
doc/ref/Makefile.am
View file

@ -21,6 +21,9 @@
AUTOMAKE_OPTIONS = gnu
BUILT_SOURCES = lib-version.texi
info_TEXINFOS = guile.texi
guile_TEXINFOS = preface.texi \
@ -86,4 +89,10 @@ autoconf.texi: autoconf-macros.texi
autoconf-macros.texi: $(top_srcdir)/guile-config/guile.m4
$(preinstguiletool)/snarf-guile-m4-docs $< > $(srcdir)/$@
lib-version.texi: $(top_srcdir)/GUILE-VERSION
cat "$^" | grep '^LIBGUILE_.*_MAJOR' | \
sed 's/^LIBGUILE_\([A-Z0-9_]*\)_MAJOR=\([0-9]\+\)/@set LIBGUILE_\1_MAJOR \2/' \
> "$@"
MAINTAINERCLEANFILES = autoconf-macros.texi

35
doc/ref/api-control.texi
View file

@ -1234,28 +1234,29 @@ non-locally, @var{out_guard} is called. If the dynamic extent of
the dynamic-wind is re-entered, @var{in_guard} is called. Thus
@var{in_guard} and @var{out_guard} may be called any number of
times.
@lisp
(define x 'normal-binding)
@result{} x
(define a-cont (call-with-current-continuation
(lambda (escape)
(let ((old-x x))
(dynamic-wind
;; in-guard:
;;
(lambda () (set! x 'special-binding))
(define a-cont
(call-with-current-continuation
(lambda (escape)
(let ((old-x x))
(dynamic-wind
;; in-guard:
;;
(lambda () (set! x 'special-binding))
;; thunk
;;
(lambda () (display x) (newline)
(call-with-current-continuation escape)
(display x) (newline)
x)
;; out-guard:
;;
(lambda () (set! x old-x)))))))
;; thunk
;;
(lambda () (display x) (newline)
(call-with-current-continuation escape)
(display x) (newline)
x)
;; out-guard:
;;
(lambda () (set! x old-x)))))))
;; Prints:
special-binding
;; Evaluates to:

28
doc/ref/api-data.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -1012,6 +1012,12 @@ zero.
@rnindex number->string
@rnindex string->number
The following procedures read and write numbers according to their
external representation as defined by R5RS (@pxref{Lexical structure,
R5RS Lexical Structure,, r5rs, The Revised^5 Report on the Algorithmic
Language Scheme}). @xref{The ice-9 i18n Module, the @code{(ice-9
i18n)} module}, for locale-dependent number parsing.
@deffn {Scheme Procedure} number->string n [radix]
@deffnx {C Function} scm_number_to_string (n, radix)
Return a string holding the external representation of the
@ -1214,7 +1220,16 @@ including complex numbers.
@rnindex sqrt
@c begin (texi-doc-string "guile" "sqrt")
@deffn {Scheme Procedure} sqrt z
Return the square root of @var{z}.
Return the square root of @var{z}. Of the two possible roots
(positive and negative), the one with the a positive real part is
returned, or if that's zero then a positive imaginary part. Thus,
@example
(sqrt 9.0) @result{} 3.0
(sqrt -9.0) @result{} 0.0+3.0i
(sqrt 1.0+1.0i) @result{} 1.09868411346781+0.455089860562227i
(sqrt -1.0-1.0i) @result{} 0.455089860562227-1.09868411346781i
@end example
@end deffn
@rnindex expt
@ -2934,7 +2949,8 @@ predicates (@pxref{Characters}), but are defined on character sequences.
The first set is specified in R5RS and has names that end in @code{?}.
The second set is specified in SRFI-13 and the names have no ending
@code{?}. The predicates ending in @code{-ci} ignore the character case
when comparing strings.
when comparing strings. @xref{The ice-9 i18n Module, the @code{(ice-9
i18n)} module}, for locale-dependent string comparison.
@rnindex string=?
@deffn {Scheme Procedure} string=? s1 s2
@ -4674,10 +4690,8 @@ see @code{symbol-property}.
@end deffn
Support for these extra slots may be removed in a future release, and it
is probably better to avoid using them. (In release 1.6, Guile itself
uses the property list slot sparingly, and the function slot not at
all.) For a more modern and Schemely approach to properties, see
@ref{Object Properties}.
is probably better to avoid using them. For a more modern and Schemely
approach to properties, see @ref{Object Properties}.
@node Symbol Read Syntax

12
doc/ref/api-evaluation.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -357,6 +357,11 @@ While the code is evaluated, the given module is made the current one.
The current module is restored when this procedure returns.
@end deffn
@deftypefn {C Function} SCM scm_c_eval_string (const char *string)
@code{scm_eval_string}, but taking a C string instead of an
@code{SCM}.
@end deftypefn
@deffn {Scheme Procedure} apply proc arg1 @dots{} argN arglst
@deffnx {C Function} scm_apply_0 (proc, arglst)
@deffnx {C Function} scm_apply_1 (proc, arg1, arglst)
@ -446,6 +451,11 @@ that will be called before any code is loaded. See the
documentation for @code{%load-hook} later in this section.
@end deffn
@deftypefn {C Function} SCM scm_c_primitive_load (const char *filename)
@code{scm_primitive_load}, but taking a C string instead of an
@code{SCM}.
@end deftypefn
@deffn {Scheme Procedure} primitive-load-path filename
@deffnx {C Function} scm_primitive_load_path (filename)
Search @code{%load-path} for the file named @var{filename} and

295
doc/ref/api-i18n.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -8,6 +8,292 @@
@node Internationalization
@section Support for Internationalization
@cindex internationalization
@cindex i18n
Guile provides internationalization support for Scheme programs in two
ways. First, procedures to manipulate text and data in a way that
conforms to particular cultural conventions (i.e., in a
``locale-dependent'' way) are provided in the @code{(ice-9 i18n)}.
Second, Guile allows the use of GNU @code{gettext} to translate
program message strings.
@menu
* The ice-9 i18n Module:: Honoring cultural conventions.
* Gettext Support:: Translating message strings.
@end menu
@node The ice-9 i18n Module
@subsection The @code{(ice-9 i18n)} Module
In order to make use of the following functions, one must import the
@code{(ice-9 i18n)} module in the usual way:
@example
(use-modules (ice-9 i18n))
@end example
@cindex libguile-i18n-v-@value{LIBGUILE_I18N_MAJOR}
C programs can use the C functions corresponding to the procedures of
this module by including @code{<libguile/i18n.h>} and by linking
against @code{libguile-i18n-v-@value{LIBGUILE_I18N_MAJOR}}.
@cindex cultural conventions
The @code{(ice-9 i18n)} module provides procedures to manipulate text
and other data in a way that conforms to the cultural conventions
chosen by the user. Each region of the world or language has its own
customs to, for instance, represent real numbers, classify characters,
collate text, etc. All these aspects comprise the so-called
``cultural conventions'' of that region or language.
@cindex locale
@cindex locale category
Computer systems typically refer to a set of cultural conventions as a
@dfn{locale}. For each particular aspect that comprise those cultural
conventions, a @dfn{locale category} is defined. For instance, the
way characters are classified is defined by the @code{LC_CTYPE}
category, while the language in which program messages are issued to
the user is defined by the @code{LC_MESSAGES} category
(@pxref{Locales, General Locale Information} for details).
@cindex locale object
The procedures provided by this module allow the development of
programs that adapt automatically to any locale setting. As we will
see later, many of the locale-dependent procedures provided by this
module can optionally take a @dfn{locale object} argument. This
additional argument defines the locale settings that must be followed
by the invoked procedure. When it is omitted, then the current locale
settings of the process are followed (@pxref{Locales,
@code{setlocale}}).
The following procedures allow the manipulation of such locale
objects.
@deffn {Scheme Procedure} make-locale category-mask locale-name [base-locale]
@deffnx {C Function} scm_make_locale (category_mask, locale_name, base_locale)
Return a reference to a data structure representing a set of locale
datasets. @var{locale-name} should be a string denoting a particular
locale, e.g., @code{"aa_DJ"}. Unlike for the @var{category} parameter
for @code{setlocale}, the @var{category-mask} parameter here uses a
single bit for each category, made by OR'ing together @code{LC_*_MASK}
bits. The optional @var{base-locale} argument can be used to specify
a locale object whose settings are to be used as a basis for the
locale object being returned.
The available locale category masks are the following:
@defvar LC_COLLATE_MASK
Represents the collation locale category.
@end defvar
@defvar LC_CTYPE_MASK
Represents the character classification locale category.
@end defvar
@defvar LC_MESSAGES_MASK
Represents the messages locale category.
@end defvar
@defvar LC_MONETARY_MASK
Represents the monetary locale category.
@end defvar
@defvar LC_NUMERIC_MASK
Represents the way numbers are displayed.
@end defvar
@defvar LC_TIME_MASK
Represents the way date and time are displayed
@end defvar
The following category masks are also available but will not have any
effect on systems that do not support them:
@defvar LC_PAPER_MASK
@defvarx LC_NAME_MASK
@defvarx LC_ADDRESS_MASK
@defvarx LC_TELEPHONE_MASK
@defvarx LC_MEASUREMENT_MASK
@defvarx LC_IDENTIFICATION_MASK
@end defvar
Finally, there is also:
@defvar LC_ALL_MASK
This represents all the locale categories supported by the system.
@end defvar
The @code{LC_*_MASK} variables are bound to integers which may be OR'd
together using @code{logior} (@pxref{Primitive Numerics,
@code{logior}}). For instance, the following invocation creates a
locale object that combines the use of Esperanto for messages and
character classification with the default settings for the other
categories (i.e., the settings of the default @code{C} locale which
usually represents conventions in use in the USA):
@example
(make-locale (logior LC_MESSAGE_MASK LC_CTYPE_MASK) "eo_EO")
@end example
The following example combines the use of Swedish conventions with
monetary conventions from Croatia:
@example
(make-locale LC_MONETARY_MASK "hr_HR"
(make-locale LC_ALL_MASK "sv_SE"))
@end example
A @code{system-error} exception (@pxref{Handling Errors}) is raised by
@code{make-locale} when @var{locale-name} does not match any of the
locales compiled on the system. Note that on non-GNU systems, this
error may be raised later, when the locale object is actually used.
@end deffn
@deffn {Scheme Procedure} locale? obj
@deffnx {C Function} scm_locale_p (obj)
Return true if @var{obj} is a locale object.
@end deffn
The following procedures provide support for text collation.
@deffn {Scheme Procedure} string-locale<? s1 s2 [locale]
@deffnx {C Function} scm_string_locale_lt (s1, s2, locale)
Compare strings @var{s1} and @var{s2} in a locale-dependent way. If
@var{locale} is provided, it should be locale object (as returned by
@code{make-locale}) and will be used to perform the comparison;
otherwise, the current system locale is used.
@end deffn
@deffn {Scheme Procedure} string-locale>? s1 s2 [locale]
@deffnx {C Function} scm_string_locale_gt (s1, s2, locale)
Compare strings @var{s1} and @var{s2} in a locale-dependent way. If
@var{locale} is provided, it should be locale object (as returned by
@code{make-locale}) and will be used to perform the comparison;
otherwise, the current system locale is used.
@end deffn
@deffn {Scheme Procedure} string-locale-ci<? s1 s2 [locale]
@deffnx {C Function} scm_string_locale_ci_lt (s1, s2, locale)
Compare strings @var{s1} and @var{s2} in a case-insensitive, and
locale-dependent way. If @var{locale} is provided, it should be
locale object (as returned by @code{make-locale}) and will be used to
perform the comparison; otherwise, the current system locale is used.
@end deffn
@deffn {Scheme Procedure} string-locale-ci>? s1 s2 [locale]
@deffnx {C Function} scm_string_locale_ci_gt (s1, s2, locale)
Compare strings @var{s1} and @var{s2} in a case-insensitive, and
locale-dependent way. If @var{locale} is provided, it should be
locale object (as returned by @code{make-locale}) and will be used to
perform the comparison; otherwise, the current system locale is used.
@end deffn
@deffn {Scheme Procedure} string-locale-ci=? s1 s2 [locale]
@deffnx {C Function} scm_string_locale_ci_eq (s1, s2, locale)
Compare strings @var{s1} and @var{s2} in a case-insensitive, and
locale-dependent way. If @var{locale} is provided, it should be
locale object (as returned by @code{make-locale}) and will be used to
perform the comparison; otherwise, the current system locale is used.
@end deffn
@deffn {Scheme Procedure} char-locale<? c1 c2 [locale]
@deffnx {C Function} scm_char_locale_lt (c1, c2, locale)
Return true if character @var{c1} is lower than @var{c2} according to
@var{locale} or to the current locale.
@end deffn
@deffn {Scheme Procedure} char-locale>? c1 c2 [locale]
@deffnx {C Function} scm_char_locale_gt (c1, c2, locale)
Return true if character @var{c1} is greater than @var{c2} according
to @var{locale} or to the current locale.
@end deffn
@deffn {Scheme Procedure} char-locale-ci<? c1 c2 [locale]
@deffnx {C Function} scm_char_locale_ci_lt (c1, c2, locale)
Return true if character @var{c1} is lower than @var{c2}, in a case
insensitive way according to @var{locale} or to the current locale.
@end deffn
@deffn {Scheme Procedure} char-locale-ci>? c1 c2 [locale]
@deffnx {C Function} scm_char_locale_ci_gt (c1, c2, locale)
Return true if character @var{c1} is greater than @var{c2}, in a case
insensitive way according to @var{locale} or to the current locale.
@end deffn
@deffn {Scheme Procedure} char-locale-ci=? c1 c2 [locale]
@deffnx {C Function} scm_char_locale_ci_eq (c1, c2, locale)
Return true if character @var{c1} is equal to @var{c2}, in a case
insensitive way according to @var{locale} or to the current locale.
@end deffn
The procedures below provide support for ``character case mapping'',
i.e., to convert characters or strings to their upper-case or
lower-case equivalent. Note that SRFI-13 provides procedures that
look similar (@pxref{Alphabetic Case Mapping}). However, the SRFI-13
procedures are locale-independent. Therefore, they do not take into
account specificities of the customs in use in a particular language
or region of the world. For instance, while most languages using the
Latin alphabet map lower-case letter ``i'' to upper-case letter ``I'',
Turkish maps lower-case ``i'' to ``Latin capital letter I with dot
above''. The following procedures allow to provide idiomatic
character mapping.
@deffn {Scheme Procedure} char-locale-downcase chr [locale]
@deffnx {C Function} scm_char_locale_upcase (chr, locale)
Return the lowercase character that corresponds to @var{chr} according
to either @var{locale} or the current locale.
@end deffn
@deffn {Scheme Procedure} char-locale-upcase chr [locale]
@deffnx {C Function} scm_char_locale_downcase (chr, locale)
Return the uppercase character that corresponds to @var{chr} according
to either @var{locale} or the current locale.
@end deffn
@deffn {Scheme Procedure} string-locale-upcase str [locale]
@deffnx {C Function} scm_string_locale_upcase (str, locale)
Return a new string that is the uppercase version of @var{str}
according to either @var{locale} or the current locale.
@end deffn
@deffn {Scheme Procedure} string-locale-downcase str [locale]
@deffnx {C Function} scm_string_locale_downcase (str, locale)
Return a new string that is the down-case version of @var{str}
according to either @var{locale} or the current locale.
@end deffn
Finally, the following procedures allow programs to read numbers
written according to a particular locale. As an example, in English,
``ten thousand and a half'' is usually written @code{10,000.5} while
in French it is written @code{10000,5}. These procedures allow to
account for these differences.
@deffn {Scheme Procedure} locale-string->integer str [base [locale]]
@deffnx {C Function} scm_locale_string_to_integer (str, base, locale)
Convert string @var{str} into an integer according to either
@var{locale} (a locale object as returned by @code{make-locale}) or
the current process locale. If @var{base} is specified, then it
determines the base of the integer being read (e.g., @code{16} for an
hexadecimal number, @code{10} for a decimal number); by default,
decimal numbers are read. Return two values: an integer (on success)
or @code{#f}, and the number of characters read from @var{str}
(@code{0} on failure).
@end deffn
@deffn {Scheme Procedure} locale-string->inexact str [locale]
@deffnx {C Function} scm_locale_string_to_inexact (str, locale)
Convert string @var{str} into an inexact number according to either
@var{locale} (a locale object as returned by @code{make-locale}) or
the current process locale. Return two values: an inexact number (on
success) or @code{#f}, and the number of characters read from
@var{str} (@code{0} on failure).
@end deffn
@node Gettext Support
@subsection Gettext Support
Guile provides an interface to GNU @code{gettext} for translating
message strings (@pxref{Introduction,,, gettext, GNU @code{gettext}
utilities}).
@ -19,7 +305,8 @@ catalog filename).
When @code{gettext} is not available, or if Guile was configured
@samp{--without-nls}, dummy functions doing no translation are
provided.
provided. When @code{gettext} support is available in Guile, the
@code{i18n} feature is provided (@pxref{Feature Tracking}).
@deffn {Scheme Procedure} gettext msg [domain [category]]
@deffnx {C Function} scm_gettext (msg, domain, category)
@ -85,7 +372,8 @@ example,
It's important to use @code{ngettext} rather than plain @code{gettext}
for plurals, since the rules for singular and plural forms in English
are not the same in other languages. Only @code{ngettext} will allow
translators to give correct forms.
translators to give correct forms (@pxref{Plural forms,, Additional
functions for plural forms, gettext, GNU @code{gettext} utilities}).
@end deffn
@deffn {Scheme Procedure} textdomain [domain]
@ -154,4 +442,5 @@ future.
@c Local Variables:
@c TeX-master: "guile.texi"
@c ispell-local-dictionary: "american"
@c End:

24
doc/ref/api-io.texi
View file

@ -64,6 +64,10 @@ rely on that to keep it away from system limits. An explicit call to
If program flow makes it hard to be certain when to close then this
may be an acceptable way to control resource usage.
All file access uses the ``LFS'' large file support functions when
available, so files bigger than 2 Gbytes (@math{2^31} bytes) can be
read and written on a 32-bit system.
@rnindex input-port?
@deffn {Scheme Procedure} input-port? x
@deffnx {C Function} scm_input_port_p (x)
@ -390,14 +394,18 @@ Return an integer representing the current position of
@findex truncate
@findex ftruncate
@deffn {Scheme Procedure} truncate-file object [length]
@deffnx {C Function} scm_truncate_file (object, length)
Truncates the object referred to by @var{object} to at most
@var{length} bytes. @var{object} can be a string containing a
file name or an integer file descriptor or a port.
@var{length} may be omitted if @var{object} is not a file name,
in which case the truncation occurs at the current port
position. The return value is unspecified.
@deffn {Scheme Procedure} truncate-file file [length]
@deffnx {C Function} scm_truncate_file (file, length)
Truncate @var{file} to @var{length} bytes. @var{file} can be a
filename string, a port object, or an integer file descriptor. The
return value is unspecified.
For a port or file descriptor @var{length} can be omitted, in which
case the file is truncated at the current position (per @code{ftell}
above).
On most systems a file can be extended by giving a length greater than
the current size, but this is not mandatory in the POSIX standard.
@end deffn
@node Line/Delimited

4
doc/ref/guile.texi
View file

@ -7,6 +7,7 @@
@set MANUAL-EDITION 1.1
@c %**end of header
@include version.texi
@include lib-version.texi
@copying
This reference manual documents Guile, GNU's Ubiquitous Intelligent
@ -137,7 +138,7 @@ x
@comment The title is printed in a large font.
@title Guile Reference Manual
@subtitle Edition @value{MANUAL-EDITION}, for use with Guile @value{VERSION}
@c @subtitle $Id: guile.texi,v 1.46 2006-08-01 21:51:12 ossau Exp $
@c @subtitle $Id: guile.texi,v 1.48 2006-11-18 18:14:55 civodul Exp $
@c See preface.texi for the list of authors
@author The Guile Developers
@ -347,6 +348,7 @@ available through both Scheme and C interfaces.
* File Tree Walk:: Traversing the file system.
* Queues:: First-in first-out queuing.
* Streams:: Sequences of values.
* Buffered Input:: Ports made from a reader function.
* Expect:: Controlling interactive programs with Guile.
* The Scheme shell (scsh):: Using scsh interfaces in Guile.
@end menu

3
doc/ref/intro.texi
View file

@ -420,7 +420,8 @@ purpose to check whether your code still relies on them.
@section Reporting Bugs
Any problems with the installation should be reported to
@email{bug-guile@@gnu.org}.
@email{bug-guile@@gnu.org}. Please note that you must be subscribed to
this list first, in order to successfully send a report to it.
Whenever you have found a bug in Guile you are encouraged to report it
to the Guile developers, so they can fix it. They may also be able to

146
doc/ref/misc-modules.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -270,13 +270,13 @@ With no parameters output is in words as a cardinal like ``ten'', or
@end example
And also with no parameters, @nicode{~@@r} gives roman numerals and
@nicode{~@@:r} gives old roman numerals. In old roman numerals
@nicode{~:@@r} gives old roman numerals. In old roman numerals
there's no ``subtraction'', so 9 is @nicode{VIIII} instead of
@nicode{IX}. In both cases only positive numbers can be output.
@example
(format #t "~@@r" 89) @print{} LXXXIX ;; roman
(format #t "~@@:r" 89) @print{} LXXXVIIII ;; old roman
(format #t "~:@@r" 89) @print{} LXXXVIIII ;; old roman
@end example
When a parameter is given it means numeric output in the specified
@ -507,7 +507,7 @@ puts the padding after the sign.
@example
(format #f "~,,8$" -1.5) @result{} " -1.50"
(format #f "~,,8:$" -1.5) @result{} "- 1.50"
(format #f "~,,8,'.@@:$" 3) @result{} "+...3.00"
(format #f "~,,8,'.:@@$" 3) @result{} "+...3.00"
@end example
Note that floating point for dollar amounts is generally not a good
@ -567,7 +567,7 @@ one, which can be convenient when printing some sort of count.
@example
(format #t "~d cat~:p" 9) @print{} 9 cats
(format #t "~d pupp~@@:p" 5) @print{} 5 puppies
(format #t "~d pupp~:@@p" 5) @print{} 5 puppies
@end example
@nicode{~p} is designed for English plurals and there's no attempt to
@ -777,14 +777,14 @@ The modifiers on @nicode{~(} control the conversion.
@c rest lower case.
@c
@item
@nicode{~@@:(} --- upper case.
@nicode{~:@@(} --- upper case.
@end itemize
For example,
@example
(format #t "~(Hello~)") @print{} hello
(format #t "~@@:(Hello~)") @print{} HELLO
(format #t "~:@@(Hello~)") @print{} HELLO
@end example
In the future it's intended the modifiers @nicode{:} and @nicode{@@}
@ -813,8 +813,10 @@ elements from it. This is a convenient way to output a whole list.
@nicode{~:@{} takes a single argument which is a list of lists, each
of those contained lists gives the arguments for the iterated format.
@c @print{} on a new line here to avoid overflowing page width in DVI
@example
(format #t "~:@{~dx~d ~@}" '((1 2) (3 4) (5 6))) @print{} 1x2 3x4 5x6
(format #t "~:@{~dx~d ~@}" '((1 2) (3 4) (5 6)))
@print{} 1x2 3x4 5x6
@end example
@nicode{~@@@{} takes arguments directly, with each iteration
@ -825,11 +827,13 @@ successively consuming arguments.
(format #t "~@@@{~s=~d ~@}" "x" 1 "y" 2) @print{} "x"=1 "y"=2
@end example
@nicode{~@@:@{} takes list arguments, one argument for each iteration,
@nicode{~:@@@{} takes list arguments, one argument for each iteration,
using that list for the format.
@c @print{} on a new line here to avoid overflowing page width in DVI
@example
(format #t "~@@:@{~dx~d ~@}" '(1 2) '(3 4) '(5 6)) @print{} 1x2 3x4 5x6
(format #t "~:@@@{~dx~d ~@}" '(1 2) '(3 4) '(5 6))
@print{} 1x2 3x4 5x6
@end example
Iterating stops when there are no more arguments or when the
@ -1094,27 +1098,28 @@ Walk the filesystem tree starting at @var{startname}, calling
@var{proc} for each file and directory. @code{nftw} has extra
features over the basic @code{ftw} described above.
Hard links and symbolic links are followed, but a file or directory is
reported to @var{proc} only once, and skipped if seen again in another
place. One consequence of this is that @code{nftw} is safe against
circular linked directory structures.
Like @code{ftw}, hard links and symbolic links are followed. A file
or directory is reported to @var{proc} only once, and skipped if seen
again in another place. One consequence of this is that @code{nftw}
is safe against circular linked directory structures.
Each @var{proc} call is @code{(@var{proc} filename statinfo flag
basename level)} and it should return @code{#t} to continue, or any
base level)} and it should return @code{#t} to continue, or any
other value to stop.
@var{filename} is the item visited, being @var{startname} plus a
further path and the name of the item. @var{statinfo} is the return
from @code{stat} on @var{filename} (@pxref{File System}).
@var{basename} it the item name without any path. @var{level} is an
integer giving the directory nesting level, starting from 0 for the
contents of @var{startname} (or that item itself if it's a file).
@var{flag} is one of the following symbols,
from @code{stat} on @var{filename} (@pxref{File System}). @var{base}
is an integer offset into @var{filename} which is where the basename
for this item begins. @var{level} is an integer giving the directory
nesting level, starting from 0 for the contents of @var{startname} (or
that item itself if it's a file). @var{flag} is one of the following
symbols,
@table @code
@item regular
@var{filename} is a file, this includes special files like devices,
named pipes, etc.
@var{filename} is a file, including special files like devices, named
pipes, etc.
@item directory
@var{filename} is a directory.
@ -1132,19 +1137,15 @@ nothing is known about it. @var{statinfo} is @code{#f} in this case.
@var{filename} is a directory, but one which cannot be read and hence
won't be recursed into.
@item symlink
@var{filename} is a dangling symbolic link. Symbolic links are
normally followed and their target reported, the link itself is
reported if the target does not exist.
Under the @code{physical} option described below, @code{symlink} is
instead given for symbolic links whose target does exist.
@item stale-symlink
Under the @code{physical} option described below, this indicates
@var{filename} is a dangling symbolic link, meaning its target does
not exist. Without the @code{physical} option plain @code{symlink}
indicates this.
@var{filename} is a dangling symbolic link. Links are normally
followed and their target reported, the link itself is reported if its
target does not exist.
@item symlink
When the @code{physical} option described below is used, this
indicates @var{filename} is a symbolic link whose target exists (and
is not being followed).
@end table
The following optional arguments can be given to modify the way
@ -1156,10 +1157,11 @@ takes a following integer value).
Change to the directory containing the item before calling @var{proc}.
When @code{nftw} returns the original current directory is restored.
Under this option, generally the @var{basename} parameter should be
used to access the item in each @var{proc} call. The @var{filename}
parameter still has a path as normal and this will only be valid if
the @var{startname} directory was absolute.
Under this option, generally the @var{base} parameter to each
@var{proc} call should be used to pick out the base part of the
@var{filename}. The @var{filename} is still a path but with a changed
directory it won't be valid (unless the @var{startname} directory was
absolute).
@item @code{depth}
Visit files ``depth first'', meaning @var{proc} is called for the
@ -1175,11 +1177,12 @@ Set the size of the hash table used to track items already visited.
@item @code{mount}
Don't cross a mount point, meaning only visit items on the same
filesystem as @var{startname}. (Ie.@: the same @code{stat:dev}.)
filesystem as @var{startname} (ie.@: the same @code{stat:dev}).
@item @code{physical}
Don't follow symbolic links, instead report them to @var{proc} as
@code{symlink}, and report dangling links as @code{stale-symlink}.
@code{symlink}. Dangling links (those whose target doesn't exist) are
still reported as @code{stale-symlink}.
@end table
The return value from @code{nftw} is @code{#t} if it ran to
@ -1461,6 +1464,69 @@ ends when the end of the shortest given @var{stream} is reached.
@end defun
@node Buffered Input
@section Buffered Input
@cindex Buffered input
@cindex Line continuation
The following functions are provided by
@example
(use-modules (ice-9 buffered-input))
@end example
A buffered input port allows a reader function to return chunks of
characters which are to be handed out on reading the port. A notion
of further input for an application level logical expression is
maintained too, and passed through to the reader.
@defun make-buffered-input-port reader
Create an input port which returns characters obtained from the given
@var{reader} function. @var{reader} is called (@var{reader} cont),
and should return a string or an EOF object.
The new port gives precisely the characters returned by @var{reader},
nothing is added, so if any newline characters or other separators are
desired they must come from the reader function.
The @var{cont} parameter to @var{reader} is @code{#f} for initial
input, or @code{#t} when continuing an expression. This is an
application level notion, set with
@code{set-buffered-input-continuation?!} below. If the user has
entered a partial expression then it allows @var{reader} for instance
to give a different prompt to show more is required.
@end defun
@defun make-line-buffered-input-port reader
@cindex Line buffered input
Create an input port which returns characters obtained from the
specified @var{reader} function, similar to
@code{make-buffered-input-port} above, but where @var{reader} is
expected to be a line-oriented.
@var{reader} is called (@var{reader} cont), and should return a string
or an EOF object as above. Each string is a line of input without a
newline character, the port code inserts a newline after each string.
@end defun
@defun set-buffered-input-continuation?! port cont
Set the input continuation flag for a given buffered input
@var{port}.
An application uses this by calling with a @var{cont} flag of
@code{#f} when beginning to read a new logical expression. For
example with the Scheme @code{read} function (@pxref{Scheme Read}),
@example
(define my-port (make-buffered-input-port my-reader))
(set-buffered-input-continuation?! my-port #f)
(let ((obj (read my-port)))
...
@end example
@end defun
@c Local Variables:
@c TeX-master: "guile.texi"
@c End:

71
doc/ref/posix.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -1008,8 +1008,8 @@ return value is unspecified.
@end deffn
@deffn {Scheme Procedure} getpwent
Return the next entry in the user database, using the stream set by
@code{setpwent}.
Read the next entry in the user database stream. The return is a
passwd user object as above, or @code{#f} when no more entries.
@end deffn
@deffn {Scheme Procedure} endpwent
@ -1170,6 +1170,13 @@ Daylight saving indicator (0 for ``no'', greater than 0 for ``yes'', less than
@deffn {Scheme Procedure} tm:gmtoff tm
@deffnx {Scheme Procedure} set-tm:gmtoff tm val
Time zone offset in seconds west of @acronym{UTC} (-46800 to 43200).
For example on East coast USA (zone @samp{EST+5}) this would be 18000
(ie.@: @m{5\times60\times60,5*60*60}) in winter, or 14400
(ie.@: @m{4\times60\times60,4*60*60}) during daylight savings.
Note @code{tm:gmtoff} is not the same as @code{tm_gmtoff} in the C
@code{tm} structure. @code{tm_gmtoff} is seconds east and hence the
negative of the value here.
@end deffn
@deffn {Scheme Procedure} tm:zone tm
@deffnx {Scheme Procedure} set-tm:zone tm val
@ -2909,32 +2916,37 @@ any unflushed buffered port data is ignored.
@deffn {Scheme Procedure} recvfrom! sock str [flags [start [end]]]
@deffnx {C Function} scm_recvfrom (sock, str, flags, start, end)
Return data from the socket port @var{sock} and also
information about where the data was received from.
@var{sock} must already be bound to the address from which
data is to be received. @code{str}, is a string into which the
data will be written. The size of @var{str} limits the amount
of data which can be received: in the case of packet protocols,
if a packet larger than this limit is encountered then some
data will be irrevocably lost.
Receive data from socket port @var{sock}, returning the originating
address as well as the data. This function is usually for datagram
sockets, but can be used on stream-oriented sockets too.
The data received is stored in the given @var{str}, the whole string
or just the region between the optional @var{start} and @var{end}
positions. The size of @var{str} limits the amount of data which can
be received. For datagram protocols if a packet larger than this is
received then excess bytes are irrevocably lost.
The return value is a pair. The @code{car} is the number of bytes
read. The @code{cdr} is a socket address object (@pxref{Network
Socket Address}) which is where the data came from, or @code{#f} if
the origin is unknown.
@vindex MSG_OOB
@vindex MSG_PEEK
@vindex MSG_DONTROUTE
The optional @var{flags} argument is a value or bitwise OR of
@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.
The optional @var{flags} argument is a or bitwise-OR (@code{logior})
of @code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.
The value returned is a pair: the @acronym{CAR} is the number of
bytes read from the socket and the @acronym{CDR} an address object
in the same form as returned by @code{accept}. The address
will given as @code{#f} if not available, as is usually the
case for stream sockets.
Data is read directly from the socket file descriptor, any buffered
port data is ignored.
The @var{start} and @var{end} arguments specify a substring of
@var{str} to which the data should be written.
Note that the data is read directly from the socket file
descriptor: any unread buffered port data is ignored.
@c This was linux kernel 2.6.15 and glibc 2.3.6, not sure what any
@c specs are supposed to say about recvfrom threading.
@c
On a GNU/Linux system @code{recvfrom!} is not multi-threading, all
threads stop while a @code{recvfrom!} call is in progress. An
application may need to use @code{select}, @code{O_NONBLOCK} or
@code{MSG_DONTWAIT} to avoid this.
@end deffn
@deffn {Scheme Procedure} sendto sock message sockaddr [flags]
@ -3127,10 +3139,11 @@ specified.
Get or set the current locale, used for various internationalizations.
Locales are strings, such as @samp{sv_SE}.
If @var{locale} is given then the locale for the given @var{category} is set
and the new value returned. If @var{locale} is not given then the
current value is returned. @var{category} should be one of the
following values
If @var{locale} is given then the locale for the given @var{category}
is set and the new value returned. If @var{locale} is not given then
the current value is returned. @var{category} should be one of the
following values (@pxref{Locale Categories, Categories of Activities
that Locales Affect,, libc, The GNU C Library Reference Manual}):
@defvar LC_ALL
@defvarx LC_COLLATE
@ -3147,6 +3160,10 @@ categories based on standard environment variables (@code{LANG} etc).
For full details on categories and locale names @pxref{Locales,,
Locales and Internationalization, libc, The GNU C Library Reference
Manual}.
Note that @code{setlocale} affects locale settings for the whole
process. @xref{The ice-9 i18n Module, locale objects and
@code{make-locale}}, for a thread-safe alternative.
@end deffn
@node Encryption

139
doc/ref/repl-modules.texi
View file

@ -23,6 +23,7 @@ history entries.
@menu
* Loading Readline Support:: How to load readline support into Guile.
* Readline Options:: How to modify readline's behaviour.
* Readline Functions:: Programming with readline.
@end menu
@ -32,7 +33,6 @@ history entries.
The module is not loaded by default and so has to be loaded and
activated explicitly. This is done with two simple lines of code:
@findex activate-readline
@lisp
(use-modules (ice-9 readline))
(activate-readline)
@ -91,7 +91,7 @@ $endif
The readline interface module can be configured in several ways to
better suit the user's needs. Configuration is done via the readline
module's options interface, in a similar way to the evaluator and
debugging options (@pxref{User level options interfaces}.)
debugging options (@pxref{Runtime Options}).
@findex readline-options
@findex readline-enable
@ -119,6 +119,141 @@ usage of the history file using the following call.
The readline options interface can only be used @emph{after} loading
the readline module, because it is defined in that module.
@node Readline Functions
@subsection Readline Functions
The following functions are provided by
@example
(use-modules (ice-9 readline))
@end example
There are two ways to use readline from Scheme code, either make calls
to @code{readline} directly to get line by line input, or use the
readline port below with all the usual reading functions.
@defun readline [prompt]
Read a line of input from the user and return it as a string (without
a newline at the end). @var{prompt} is the prompt to show, or the
default is the string set in @code{set-readline-prompt!} below.
@example
(readline "Type something: ") @result{} "hello"
@end example
@end defun
@defun set-readline-input-port! port
@defunx set-readline-output-port! port
Set the input and output port the readline function should read from
and write to. @var{port} must be a file port (@pxref{File Ports}),
and should usually be a terminal.
The default is the @code{current-input-port} and
@code{current-output-port} (@pxref{Default Ports}) when @code{(ice-9
readline)} loads, which in an interactive user session means the Unix
``standard input'' and ``standard output''.
@end defun
@subsubsection Readline Port
@defun readline-port
Return a buffered input port (@pxref{Buffered Input}) which calls the
@code{readline} function above to get input. This port can be used
with all the usual reading functions (@code{read}, @code{read-char},
etc), and the user gets the interactive editing features of readline.
There's only a single readline port created. @code{readline-port}
creates it when first called, and on subsequent calls just returns
what it previously made.
@end defun
@defun activate-readline
If the @code{current-input-port} is a terminal (@pxref{Terminals and
Ptys,, @code{isatty?}}) then enable readline for all reading from
@code{current-input-port} (@pxref{Default Ports}) and enable readline
features in the interactive REPL (@pxref{The REPL}).
@example
(activate-readline)
(read-char)
@end example
@code{activate-readline} enables readline on @code{current-input-port}
simply by a @code{set-current-input-port} to the @code{readline-port}
above. An application can do that directly if the extra REPL features
that @code{activate-readline} adds are not wanted.
@end defun
@defun set-readline-prompt! prompt1 [prompt2]
Set the prompt string to print when reading input. This is used when
reading through @code{readline-port}, and is also the default prompt
for the @code{readline} function above.
@var{prompt1} is the initial prompt shown. If a user might enter an
expression across multiple lines, then @var{prompt2} is a different
prompt to show further input required. In the Guile REPL for instance
this is an ellipsis (@samp{...}).
See @code{set-buffered-input-continuation?!} (@pxref{Buffered Input})
for an application to indicate the boundaries of logical expressions
(assuming of course an application has such a notion).
@end defun
@subsubsection Completion
@defun with-readline-completion-function completer thunk
Call @code{(@var{thunk})} with @var{completer} as the readline tab
completion function to be used in any readline calls within that
@var{thunk}. @var{completer} can be @code{#f} for no completion.
@var{completer} will be called as @code{(@var{completer} text state)},
as described in (@pxref{How Completing Works,,, readline, GNU Readline
Library}). @var{text} is a partial word to be completed, and each
@var{completer} call should return a possible completion string or
@code{#f} when no more. @var{state} is @code{#f} for the first call
asking about a new @var{text} then @code{#t} while getting further
completions of that @var{text}.
Here's an example @var{completer} for user login names from the
password file (@pxref{User Information}), much like readline's own
@code{rl_username_completion_function},
@example
(define (username-completer-function text state)
(if (not state)
(setpwent)) ;; new, go to start of database
(let more ((pw (getpwent)))
(if pw
(if (string-prefix? text (passwd:name pw))
(passwd:name pw) ;; this name matches, return it
(more (getpwent))) ;; doesn't match, look at next
(begin
;; end of database, close it and return #f
(endpwent)
#f))))
@end example
@end defun
@defun apropos-completion-function text state
A completion function offering completions for Guile functions and
variables (all @code{define}s). This is the default completion
function.
@c
@c FIXME: Cross reference the ``apropos'' stuff when it's documented.
@c
@end defun
@defun filename-completion-function text state
A completion function offering filename completions. This is
readline's @code{rl_filename_completion_function} (@pxref{Completion
Functions,,, readline, GNU Readline Library}).
@end defun
@defun make-completion-function string-list
Return a completion function which offers completions from the
possibilities in @var{string-list}. Matching is case-sensitive.
@end defun
@page
@node Value History

7
doc/ref/scheme-debugging.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@ -511,3 +511,8 @@ behaviour as well as the more traditional @code{trace-here}.
The older mechanism will probably become obsolete eventually, but it's
worth keeping it around for a while until we are sure that the new
mechanism is correct and does what programmers need.
@c Local Variables:
@c TeX-master: "guile.texi"
@c End:

399
doc/ref/scheme-using.texi
View file

@ -449,11 +449,9 @@ section.
* GDS Introduction::
* GDS Architecture::
* GDS Getting Started::
* Working with GDS in Scheme Buffers::
* Displaying the Scheme Stack::
* Continuing Execution::
* Evaluating Scheme Code::
* Setting and Managing Breakpoints::
* Access to Guile Help and Completion::
* Associating Buffers with Clients::
* An Example GDS Session::
@end menu
@ -501,7 +499,6 @@ existing ones
@item
continue execution, either normally or step by step.
@end itemize
@end enumerate
The presentation makes it very easy to move up and down the stack,
showing whenever possible the source code for each frame in another
@ -509,11 +506,12 @@ Emacs buffer. It also provides convenient keystrokes for telling Guile
what to do next; for example, you can select a stack frame and tell
Guile to run until that frame completes, at which point GDS will display
the frame's return value.
@end enumerate
Combinations of the above work well too. You can evaluate a fragment of
code (in a Scheme buffer) that contains a breakpoint, then use the
debugging interface to step through the code at the breakpoint. You can
also run a program until it hits a breakpoint, then examine, modify and
Combinations of these well too. You can evaluate a fragment of code (in
a Scheme buffer) that contains a breakpoint, then use the debugging
interface to step through the code at the breakpoint. You can also run
a program until it hits a breakpoint, then examine, modify and
reevaluate some of the relevant code, and then tell the program to
continue running.
@ -642,7 +640,6 @@ files or modules by sending it @code{load} or @code{use-modules}
expressions. You can set breakpoints and evaluate code which hits those
breakpoints, and GDS will pop up the stack at the breakpoint so you can
explore your code by single-stepping and evaluating test expressions.
For a hands-on, tutorial introduction to using GDS in this way, use
Emacs to open the file @file{gds-tutorial.txt} (which should have been
installed as part of Guile, perhaps under @file{/usr/share/doc/guile}),
@ -655,21 +652,33 @@ following subsections describe the various ways of doing this.
@subsubsection Setting Specific Breakpoints
The first option is to use @code{break-in} or @code{break-at} to set
specific breakpoints in the application's code. This requires code like
the following.
@lisp
(use-modules (ice-9 debugging breakpoints)
(ice-9 gds-client))
(break-in 'fact2 "ice-9/debugging/example-fns"
#:behaviour gds-debug-trap)
(break-in 'facti "ice-9/debugging/example-fns"
#:behaviour gds-debug-trap)
@end lisp
In this example, the program chooses to define its breakpoint explicitly
in its code, rather than downloading definitions from GDS, but it still
uses GDS to control what happens when the breakpoint is hit, by
specifying @code{gds-debug-trap} as the breakpoint behaviour.
@noindent
The @code{#:behaviour gds-debug-trap} clauses mean to use GDS to display
the stack when one of these breakpoints is hit. For more on
breakpoints, @code{break-in} and @code{break-at}, see @ref{Intro to
Breakpoints}.
@subsubsection Setting GDS-managed Breakpoints
Instead of listing specific breakpoints in application code, you can use
GDS to manage the set of breakpoints that you want from Emacs, and tell
the application to download the breakpoints that it should set from
GDS. The code for this is:
@lisp
(use-modules (ice-9 gds-client))
(set-gds-breakpoints)
@ -680,11 +689,52 @@ a set of breakpoint definitions. The program sets those breakpoints in
its code, then continues running.
When the program later hits one of the breakpoints, it will use GDS to
display the stack and wait for instruction on what to do next, as
described above.
display the stack and wait for instruction on what to do next.
@subsubsection Invoking GDS when an Exception Occurs
Another option is to use GDS to catch and display any exceptions that
are thrown by the application's code. If you already have a
@code{lazy-catch} or @code{with-throw-handler} around the area of code
that you want to monitor, you just need to add the following to the
handler code:
@lisp
(gds-debug-trap (throw->trap-context key args))
@end lisp
@noindent
where @code{key} and @code{args} are the first and rest arguments that
Guile passes to the handler. (In other words, they assume the handler
signature @code{(lambda (key . args) @dots{})}.) With Guile 1.8 or
later, you can also do this with a @code{catch}, by adding this same
code to the catch's pre-unwind handler.
If you don't already have any of these, insert a whole
@code{with-throw-handler} expression (or @code{lazy-catch} if your Guile
is pre-1.8) around the code of interest like this:
@lisp
(with-throw-handler #t
(lambda ()
;; Protected code here.
)
(lambda (key . args)
(gds-debug-trap (throw->trap-context key args))))
@end lisp
In all cases you will need to use the @code{(ice-9 gds-client)} and
@code{(ice-9 debugging traps)} modules.
Two special cases of this are the lazy-catch that the Guile REPL code
uses to catch exceptions in user code, and the lazy-catch inside the
@code{stack-catch} utility procedure that is provided by the
@code{(ice-9 stack-catch)} module. Both of these use a handler called
@code{lazy-handler-dispatch} (defined in @file{boot-9.scm}), which you
can hook into such that it calls GDS to display the stack when an
exception occurs. To do this, use the @code{on-lazy-handler-dispatch}
procedure as follows.
@lisp
(use-modules (ice-9 gds-client)
(ice-9 debugging traps))
@ -692,18 +742,10 @@ described above.
(on-lazy-handler-dispatch gds-debug-trap)
@end lisp
This means that the program will use GDS to display the stack whenever
it hits an exception that is protected by a @code{lazy-catch} using
Guile's standard @code{lazy-catch-handler} (defined in
@file{boot-9.scm}).
@code{lazy-catch-handler} is used by the @code{stack-catch} procedure,
provided by the @code{(ice-9 stack-catch)} module, so this will include
exceptions within a @code{stack-catch}. @code{lazy-catch-handler} is
also used by the standard Guile REPL, when you run Guile interactively,
so you can add the above lines to your @file{.guile} file if you want to
use GDS whenever something that you type into the REPL throws an
exception.
@noindent
After this the program will use GDS to display the stack whenever it
hits an exception that is protected by a @code{lazy-catch} using
@code{lazy-handler-dispatch}.
@subsubsection Accepting GDS Instructions at Any Time
@ -745,14 +787,11 @@ This approach is not yet implemented, though.
@subsubsection Utility Guile Implementation
We bring this subsection full circle by noting that the ``utility'' Guile
client, which GDS starts automatically when you use GDS as described
under approach 1 above, is really just a special case of ``a Guile
program or script which is started independently'' (approach 2), and
provides the services that the GDS front end needs by a simple
combination of some of the code fragments just described.
We conclude this subsection with an aside, by noting that the
``utility'' Guile client described above is nothing more than a
combination of the previous options.
To be precise, the code for the utility Guile client is essentially
To be precise, the code for the utility Guile client is essentially just
this:
@lisp
@ -765,12 +804,11 @@ this:
@code{set-gds-breakpoints} works as already described. The
@code{named-module-use!} line ensures that the client can process
@code{help} and @code{apropos} expressions, which is what the front end
sends to implement lookups in Guile's online help. The @code{#f}
parameter to @code{gds-accept-input} means that the @code{continue}
instruction will not cause the instruction loop to exit, which makes
sense here because the utility client has nothing to do except to
process GDS instructions.
@code{help} and @code{apropos} expressions, to implement lookups in
Guile's online help. The @code{#f} parameter to @code{gds-accept-input}
means that the @code{continue} instruction will not cause the
instruction loop to exit, which makes sense here because the utility
client has nothing to do except to process GDS instructions.
(The utility client does not use @code{on-lazy-handler-dispatch},
because it has its own mechanism for catching and reporting exceptions
@ -780,6 +818,176 @@ stack, so the end result is very similar to what
@code{on-lazy-handler-dispatch} provides.)
@node Working with GDS in Scheme Buffers
@subsection Working with GDS in Scheme Buffers
The following subsections describe the facilities and key sequences that
GDS provides for working on code in @code{scheme-mode} buffers.
@menu
* Access to Guile Help and Completion::
* Setting and Managing Breakpoints::
* Listing and Deleting Breakpoints::
* Moving and Losing Breakpoints::
* Evaluating Scheme Code::
@end menu
@node Access to Guile Help and Completion
@subsubsection Access to Guile Help and Completion
The following keystrokes provide fast and convenient access to Guile's
built in help, and to completion with respect to the set of defined and
accessible symbols.
@table @kbd
@item C-h g
@findex gds-help-symbol
Get Guile help for a particular symbol, with the same results as if
you had typed @code{(help SYMBOL)} into the Guile REPL
(@code{gds-help-symbol}). The symbol to query defaults to the word at
or before the cursor but can also be entered or edited in the
minibuffer. The available help is popped up in a temporary Emacs
window.
@item C-h C-g
@findex gds-apropos
List all accessible Guile symbols matching a given regular expression,
with the same results as if you had typed @code{(apropos REGEXP)} into
the Guile REPL (@code{gds-apropos}). The regexp to query defaults to
the word at or before the cursor but can also be entered or edited in
the minibuffer. The list of matching symbols is popped up in a
temporary Emacs window.
@item M-@key{TAB}
@findex gds-complete-symbol
Try to complete the symbol at the cursor by matching it against the
set of all defined and accessible bindings in the associated Guile
process (@code{gds-complete-symbol}). If there are any extra
characters that can be definitively added to the symbol at point, they
are inserted. Otherwise, if there are any completions available, they
are popped up in a temporary Emacs window, where one of them can be
selected using either @kbd{@key{RET}} or the mouse.
@end table
@node Setting and Managing Breakpoints
@subsubsection Setting and Managing Breakpoints
You can create a breakpoint in GDS by typing @kbd{C-x @key{SPC}} in a
Scheme mode buffer. To create a breakpoint on calls to a procedure ---
i.e. the equivalent of calling @code{break-in} --- place the cursor
anywhere within the procedure's definition, make sure that the region is
unset, and type @kbd{C-x @key{SPC}}. To create breakpoints on a
particular expression, or on the series of expressions in a particular
region --- i.e. as with @code{break-at} --- select a region containing
the open parentheses of the expressions where you want breakpoints, and
type @kbd{C-x @key{SPC}}. In other words, GDS assumes that you want a
@code{break-at} breakpoint if there is an active region, and a
@code{break-in} breakpoint otherwise.
There are three supported breakpoint behaviours, known as @code{debug},
@code{trace} and @code{trace-subtree}. @code{debug} means that GDS will
display the stack and wait for instruction when the breakpoint is hit.
@code{trace} means that a line will be written to the trace output
buffer (@code{*GDS Trace*}) when the breakpoint is hit, and when the
relevant expression or procedure call returns. @code{trace-subtree}
means that a line is written to the trace output buffer for every
evaluation step between when the breakpoint is hit and when the
expression or procedure returns.
@kbd{C-x @key{SPC}} creates a breakpoint with behaviour according to the
@code{gds-default-breakpoint-type} variable, which by default is
@code{debug}; you can customize this if you prefer a different default.
You can also create a breakpoint with behaviour other than the current
default by using the alternative key sequences @kbd{C-c C-b d} (for
@code{debug}), @kbd{C-c C-b t} (for @code{trace}) and @kbd{C-c C-b T}
(for @code{trace-subtree}).
GDS keeps all the breakpoints that you create in a single list, and
tries to set them in every Guile program that connects to GDS and calls
@code{set-gds-breakpoints}. That may sound surprising, because you are
probably thinking of one particular program when you create a
breakpoint; but GDS assumes that you would want the breakpoint to continue
taking effect if you stop and restart that program, and this is
currently achieved by giving all breakpoints to every program that asks
for them. In practice it doesn't matter if a program gets a breakpoint
definition --- such as ``break in procedure @code{foo}'' --- that it
can't actually map to any of its code.
If there are already Guile programs connected to GDS when you create a
new breakpoint, GDS also tries to set the new breakpoint in each of
those programs at the earliest opportunity, which is usually when they
decide to stop and talk to GDS for some other reason.
@node Listing and Deleting Breakpoints
@subsubsection Listing and Deleting Breakpoints
To see a list of all breakpoints, type @kbd{C-c C-b ?} (or @kbd{M-x
gds-describe-breakpoints}). GDS will then pop up a buffer that
describes each breakpoint and reports whether it is actually set in each
of the Guile programs connected to GDS.
To delete a breakpoint, type @kbd{C-c C-b @key{backspace}}. If the
region is active when you do this, GDS will delete all of the
breakpoints in the region. If the region is not active, GDS tries to
delete a ``break-in'' breakpoint for the procedure whose definition
contains point (the Emacs cursor). In either case, deletion means that
the breakpoint is removed both from GDS's global list and from all of
the connected Guile programs that had previously managed to set it.
@node Moving and Losing Breakpoints
@subsubsection Moving and Losing Breakpoints
Imagine that you set a breakpoint at line 80 of a Scheme code file, and
execute some code that hits this breakpoint; then you add some new code
at line 40, or delete some code that is no longer needed, and save the
file. Now the breakpoint will have moved up or down from line 80, and
any attached Guile program needs to be told about the new line number.
Otherwise, when a program loads this file again, it will try incorrectly
to set a breakpoint on whatever code is now at line 80, and will
@emph{not} set a breakpoint on the code where you want it.
For this reason, GDS checks all breakpoint positions whenever you save a
Scheme file, and sends the new position to connected Guile programs for
any breakpoints that have moved. @dots{} [to be continued]
@node Evaluating Scheme Code
@subsubsection Evaluating Scheme Code
The following keystrokes and commands provide various ways of sending
code to a Guile client process for evaluation.
@table @kbd
@item M-C-x
@findex gds-eval-defun
Evaluate the ``top level defun'' that the cursor is in, in other words
the smallest balanced expression which includes the cursor and whose
opening parenthesis is in column 0 (@code{gds-eval-defun}).
@item C-x C-e
@findex gds-eval-last-sexp
Evaluate the expression that ends just before the cursor
(@code{gds-eval-last-sexp}). This is designed so that it is easy to
evaluate an expression that you have just finished typing.
@item C-c C-e
@findex gds-eval-expression
Read a Scheme expression using the minibuffer, and evaluate that
expression (@code{gds-eval-expression}).
@item C-c C-r
@findex gds-eval-region
Evaluate the Scheme code in the marked region of the current buffer
(@code{gds-eval-region}). Note that GDS does not check whether the
region contains a balanced expression, or try to expand the region so
that it does; it uses the region exactly as it is.
@end table
@node Displaying the Scheme Stack
@subsection Displaying the Scheme Stack
@ -902,117 +1110,6 @@ remains in place and so will still fire at the appropriate point.
@end table
@node Evaluating Scheme Code
@subsection Evaluating Scheme Code
The following keystrokes and commands provide various ways of sending
code to a Guile client process for evaluation.
@table @kbd
@item M-C-x
@findex gds-eval-defun
Evaluate the ``top level defun'' that the cursor is in, in other words
the smallest balanced expression which includes the cursor and whose
opening parenthesis is in column 0 (@code{gds-eval-defun}).
@item C-x C-e
@findex gds-eval-last-sexp
Evaluate the expression that ends just before the cursor
(@code{gds-eval-last-sexp}). This is designed so that it is easy to
evaluate an expression that you have just finished typing.
@item C-c C-e
@findex gds-eval-expression
Read a Scheme expression using the minibuffer, and evaluate that
expression (@code{gds-eval-expression}).
@item C-c C-r
@findex gds-eval-region
Evaluate the Scheme code in the marked region of the current buffer
(@code{gds-eval-region}). Note that GDS does not check whether the
region contains a balanced expression, or try to expand the region so
that it does; it uses the region exactly as it is.
@end table
@node Setting and Managing Breakpoints
@subsection Setting and Managing Breakpoints
You can create a breakpoint in GDS by typing @kbd{C-x @key{SPC}} in a
Scheme mode buffer. To create a breakpoint on calls to a procedure
--- i.e. the equivalent of calling @code{break-in} --- place the
cursor on the procedure's name and type @kbd{C-x @key{SPC}}. To
create breakpoints on a particular expression, or on the series of
expressions in a particular region --- i.e. as with @code{break-at}
--- select the expression or region in the usual way and type @kbd{C-x
@key{SPC}}. In general, GDS assumes that you want a @code{break-at}
breakpoint if there is an active region, and a @code{break-in}
breakpoint otherwise.
When you create a breakpoint like this, two things happen. Firstly,
if the current buffer is associated with a Guile client program, the
new breakpoint definition is immediately sent to that client (or, if
the client cannot accept input immediately, it is held in readiness to
pass to the client at the next possible opportunity). This allows the
new breakpoint to take effect as soon as possible in the relevant
client program.
Secondly, it is added to GDS's @emph{global} list of all breakpoints.
This list holds the breakpoint information that will be given to any
client program that asks for it by calling @code{set-gds-breakpoints}.
The fact that this list is global, rather than client-specific, means
that the breakpoints you have set will automatically be recreated if
the program you are debugging has to be stopped and restarted ---
which in my experience happens often.@footnote{An important point here
is that there is nothing that unambiguously relates two subsequent
runs of the same client program, which might allow GDS to pass on
breakpoint settings more precisely.}
(The only possible downside of this last point is that if you are
debugging two programs in parallel, which have some code in common,
you might not want a common code breakpoint in one program to be set
in the other program as well. But this feels like a small concern in
comparison to the benefit of breakpoints persisting as just described.)
@node Access to Guile Help and Completion
@subsection Access to Guile Help and Completion
The following keystrokes provide fast and convenient access to Guile's
built in help, and to completion with respect to the set of defined and
accessible symbols.
@table @kbd
@item C-h g
@findex gds-help-symbol
Get Guile help for a particular symbol, with the same results as if
you had typed @code{(help SYMBOL)} into the Guile REPL
(@code{gds-help-symbol}). The symbol to query defaults to the word at
or before the cursor but can also be entered or edited in the
minibuffer. The available help is popped up in a temporary Emacs
window.
@item C-h C-g
@findex gds-apropos
List all accessible Guile symbols matching a given regular expression,
with the same results as if you had typed @code{(apropos REGEXP)} into
the Guile REPL (@code{gds-apropos}). The regexp to query defaults to
the word at or before the cursor but can also be entered or edited in
the minibuffer. The list of matching symbols is popped up in a
temporary Emacs window.
@item M-@key{TAB}
@findex gds-complete-symbol
Try to complete the symbol at the cursor by matching it against the
set of all defined and accessible bindings in the associated Guile
process (@code{gds-complete-symbol}). If there are any extra
characters that can be definitively added to the symbol at point, they
are inserted. Otherwise, if there are any completions available, they
are popped up in a temporary Emacs window, where one of them can be
selected using either @kbd{@key{RET}} or the mouse.
@end table
@node Associating Buffers with Clients
@subsection Associating Buffers with Clients

21
emacs/ChangeLog
View file

@ -1,3 +1,24 @@
2006-11-02 Neil Jerram <neil@ossau.uklinux.net>
* gds-scheme.el (gds-choose-client): Change assq to memq, so that
the mapcar really constructs a list of available clients.
2006-10-14 Neil Jerram <neil@ossau.uklinux.net>
* gds.el (gds-socket-type-alist): New.
(gds-run-debug-server): Use gds-server-socket-type and
gds-socket-type-alist instead of gds-server-port-or-path.
(gds-server-socket-type): New, replacing gds-server-port-or-path.
2006-10-13 Neil Jerram <neil@ossau.uklinux.net>
* gds.el (gds-run-debug-server): Use variable
gds-server-port-or-path instead of hardcoded 8333.
(gds-server-port-or-path): New.
* gds-server.el (gds-start-server): Change port arg to
port-or-path, to support Unix domain sockets.
2006-08-18 Neil Jerram <neil@ossau.uklinux.net>
* gds-server.el (gds-start-server): Change "ossau" to "ice-9".

2
emacs/gds-scheme.el
View file

@ -158,7 +158,7 @@ Emacs to display an error or trap so that the user can debug it."
(default nil))
;; Prepare a table containing all current clients.
(mapcar (lambda (client-info)
(setq table (cons (cons (cadr (assq 'name client-info))
(setq table (cons (cons (cadr (memq 'name client-info))
(car client-info))
table)))
gds-client-info)

17
emacs/gds-server.el
View file

@ -44,24 +44,25 @@
:group 'gds
:type '(choice (const :tag "nil" nil) directory))
(defun gds-start-server (procname port protocol-handler &optional bufname)
"Start a GDS server process called PROCNAME, listening on TCP port PORT.
PROTOCOL-HANDLER should be a function that accepts and processes one
protocol form. Optional arg BUFNAME specifies the name of the buffer
that is used for process output\; if not specified the buffer name is
the same as the process name."
(defun gds-start-server (procname port-or-path protocol-handler &optional bufname)
"Start a GDS server process called PROCNAME, listening on TCP port
or Unix domain socket PORT-OR-PATH. PROTOCOL-HANDLER should be a
function that accepts and processes one protocol form. Optional arg
BUFNAME specifies the name of the buffer that is used for process
output; if not specified the buffer name is the same as the process
name."
(with-current-buffer (get-buffer-create (or bufname procname))
(erase-buffer)
(let* ((code (format "(begin
%s
(use-modules (ice-9 gds-server))
(run-server %d))"
(run-server %S))"
(if gds-scheme-directory
(concat "(set! %load-path (cons "
(format "%S" gds-scheme-directory)
" %load-path))")
"")
port))
port-or-path))
(process-connection-type nil) ; use a pipe
(proc (start-process procname
(current-buffer)

15
emacs/gds.el
View file

@ -37,12 +37,20 @@
;; The subprocess object for the debug server.
(defvar gds-debug-server nil)
(defvar gds-socket-type-alist '((tcp . 8333)
(unix . "/tmp/.gds_socket"))
"Maps each of the possible socket types that the GDS server can
listen on to the path that it should bind to for each one.")
(defun gds-run-debug-server ()
"Start (or restart, if already running) the GDS debug server process."
(interactive)
(if gds-debug-server (gds-kill-debug-server))
(setq gds-debug-server
(gds-start-server "gds-debug" 8333 'gds-debug-protocol))
(gds-start-server "gds-debug"
(cdr (assq gds-server-socket-type
gds-socket-type-alist))
'gds-debug-protocol))
(process-kill-without-query gds-debug-server))
(defun gds-kill-debug-server ()
@ -602,6 +610,11 @@ you would add an element to this alist to transform
:type 'boolean
:group 'gds)
(defcustom gds-server-socket-type 'tcp
"What kind of socket the GDS server should listen on."
:group 'gds
:type '(choice (const :tag "TCP" tcp)
(const :tag "Unix" unix)))
;;;; If requested, autostart the server after loading.

15
guile-readline/ChangeLog
View file

@ -1,3 +1,18 @@
2006-10-06 Neil Jerram <neil@ossau.uklinux.net>
* ice-9/readline.scm (new-input-prompt): Renamed from "prompt".
(continuation-prompt): Renamed from "prompt2".
(make-readline-port, readline, set-readline-prompt!): Reflect
above renamings.
(activate-readline): Rename locals "read-hook" and "prompt" to
"repl-read-hook" and "repl-prompt", to disambiguate them from
globals. Save and restore the new-input- and continuation-
prompts around the REPL read call.
2006-10-05 Kevin Ryde <user42@zip.com.au>
* ice-9/readline.scm (filename-completion-function): Export this.
2006-04-17 Kevin Ryde <user42@zip.com.au>
* ice-9/readline.scm: Bump lib file version to libguilereadline-v-18,

42
guile-readline/ice-9/readline.scm
View file

@ -27,7 +27,8 @@
:use-module (ice-9 session)
:use-module (ice-9 regex)
:use-module (ice-9 buffered-input)
:no-backtrace)
:no-backtrace
:export (filename-completion-function))
@ -68,8 +69,8 @@
;;; Dirk:FIXME:: If the-readline-port, input-port or output-port are closed,
;;; guile will enter an endless loop or crash.
(define prompt "")
(define prompt2 "")
(define new-input-prompt "")
(define continuation-prompt "")
(define input-port (current-input-port))
(define output-port (current-output-port))
(define read-hook #f)
@ -77,8 +78,8 @@
(define (make-readline-port)
(make-line-buffered-input-port (lambda (continuation?)
(let* ((prompt (if continuation?
prompt2
prompt))
continuation-prompt
new-input-prompt))
(str (%readline (if (string? prompt)
prompt
(prompt))
@ -125,7 +126,7 @@
;;; %readline is the low-level readline procedure.
(define-public (readline . args)
(let ((prompt prompt)
(let ((prompt new-input-prompt)
(inp input-port))
(cond ((not (null? args))
(set! prompt (car args))
@ -141,9 +142,9 @@
args)))
(define-public (set-readline-prompt! p . rest)
(set! prompt p)
(set! new-input-prompt p)
(if (not (null? rest))
(set! prompt2 (car rest))))
(set! continuation-prompt (car rest))))
(define-public (set-readline-input-port! p)
(cond ((or (not (file-port? p)) (not (input-port? p)))
@ -202,19 +203,22 @@
(not (let ((guile-user-module (resolve-module '(guile-user))))
(and (module-defined? guile-user-module 'use-emacs-interface)
(module-ref guile-user-module 'use-emacs-interface)))))
(let ((read-hook (lambda () (run-hook before-read-hook))))
(let ((repl-read-hook (lambda () (run-hook before-read-hook))))
(set-current-input-port (readline-port))
(set! repl-reader
(lambda (prompt)
(dynamic-wind
(lambda ()
(set-buffered-input-continuation?! (readline-port) #f)
(set-readline-prompt! prompt "... ")
(set-readline-read-hook! read-hook))
(lambda () (read))
(lambda ()
(set-readline-prompt! "" "")
(set-readline-read-hook! #f)))))
(lambda (repl-prompt)
(let ((outer-new-input-prompt new-input-prompt)
(outer-continuation-prompt continuation-prompt)
(outer-read-hook read-hook))
(dynamic-wind
(lambda ()
(set-buffered-input-continuation?! (readline-port) #f)
(set-readline-prompt! repl-prompt "... ")
(set-readline-read-hook! repl-read-hook))
(lambda () (read))
(lambda ()
(set-readline-prompt! outer-new-input-prompt outer-continuation-prompt)
(set-readline-read-hook! outer-read-hook))))))
(set! (using-readline?) #t))))
(define-public (make-completion-function strings)

57
ice-9/ChangeLog
View file

@ -1,3 +1,41 @@
2006-11-13 Neil Jerram <neil@ossau.uklinux.net>
* boot-9.scm (environment-module): Change eval-closure-module call
back to procedure-property lookup. (This completes the reversion
of the change made on 2005-06-10, which was only partially undone
by the change on 2005-08-01.)
2006-10-13 Neil Jerram <neil@ossau.uklinux.net>
Integration of Unix domain socket patch from William Xu:
* gds-client.scm (connect-to-gds): Try to connect by Unix domain
socket if TCP connection fails.
* gds-server.scm (run-server): Update to support listening on a
Unix domain socket.
2006-10-05 Kevin Ryde <user42@zip.com.au>
* ftw.scm (visited?-proc): Use hashv since we know we're getting
numbers. Incorporate stat:dev, since stat:ino is only unique within a
single device. This fixes a bug where if two files with the same
inode on different devices where seen only the first would be returned
by ftw (and nftw).
2006-10-03 Neil Jerram <neil@ossau.uklinux.net>
* gds-client.scm (run-utility): Remove unnecessary
`connect-to-gds' call.
2006-09-30 Neil Jerram <neil@ossau.uklinux.net>
* debugging/ice-9-debugger-extensions.scm (debug-trap): Use
`debugger-command-loop' instead of `read-and-dispatch-commands',
which isn't actually available. Thanks to Carlos Pita for
reporting this.
(debugger-command-loop): Define here for 1.6.x.
2006-09-25 Neil Jerram <neil@ossau.uklinux.net>
* debugging/ice-9-debugger-extensions.scm (debugger:step):
@ -9,6 +47,18 @@
(info-args, info-frame, position, evaluate): Docstring
improvements.
2006-09-23 Kevin Ryde <user42@zip.com.au>
* boot-9.scm (log, log10, exp, sqrt): Remove, now in
libguile/numbers.c.
2006-09-07 Kevin Ryde <user42@zip.com.au>
* format.scm: Module "(ice-9 threads)" no longer used, now no mutex.
(format:parse-float): Fix normalization of leading zeros like "02.5"
to "2.5". left-zeros was zeroed before adjusting format:fn-dot,
resulting in the latter being unchanged.
2006-08-18 Neil Jerram <neil@ossau.uklinux.net>
* debugging/trc.scm: New file.
@ -31,6 +81,13 @@
* Makefile.am (SUBDIRS): Add debugging.
2006-08-02 Kevin Ryde <user42@zip.com.au>
* boot-9.scm (%record-type-check): New function.
(record-accessor, record-modifier): Use it for a strict type check of
the given record. Previously an accessor returned #f on a wrong
record type, and modifier silently did nothing.
2006-06-19 Neil Jerram <neil@ossau.uklinux.net>
* Makefile.am (ice9_sources): Add new files.

35
ice-9/boot-9.scm
View file

@ -339,7 +339,7 @@
(define (environment-module env)
(let ((closure (and (pair? env) (car (last-pair env)))))
(and closure (eval-closure-module closure))))
(and closure (procedure-property closure 'module))))
@ -429,13 +429,20 @@
(define (record-predicate rtd)
(lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj)))))
(define (%record-type-check rtd obj) ;; private helper
(or (eq? rtd (record-type-descriptor obj))
(scm-error 'wrong-type-arg "%record-type-check"
"Wrong type record (want `~S'): ~S"
(list (record-type-name rtd) obj)
#f)))
(define (record-accessor rtd field-name)
(let* ((pos (list-index (record-type-fields rtd) field-name)))
(if (not pos)
(error 'no-such-field field-name))
(local-eval `(lambda (obj)
(and (eq? ',rtd (record-type-descriptor obj))
(struct-ref obj ,pos)))
(%record-type-check ',rtd obj)
(struct-ref obj ,pos))
the-root-environment)))
(define (record-modifier rtd field-name)
@ -443,8 +450,8 @@
(if (not pos)
(error 'no-such-field field-name))
(local-eval `(lambda (obj val)
(and (eq? ',rtd (record-type-descriptor obj))
(struct-set! obj ,pos val)))
(%record-type-check ',rtd obj)
(struct-set! obj ,pos val))
the-root-environment)))
@ -779,21 +786,6 @@
;;; See the file `COPYING' for terms applying to this program.
;;;
(define (exp z)
(if (real? z) ($exp z)
(make-polar ($exp (real-part z)) (imag-part z))))
(define (log z)
(if (and (real? z) (>= z 0))
($log z)
(make-rectangular ($log (magnitude z)) (angle z))))
(define (sqrt z)
(if (real? z)
(if (negative? z) (make-rectangular 0 ($sqrt (- z)))
($sqrt z))
(make-polar ($sqrt (magnitude z)) (/ (angle z) 2))))
(define expt
(let ((integer-expt integer-expt))
(lambda (z1 z2)
@ -868,9 +860,6 @@
(/ (log (/ (- +i z) (+ +i z))) +2i))
($atan2 z (car y))))
(define (log10 arg)
(/ (log arg) (log 10)))
;;; {Reader Extensions}

7
ice-9/debugging/ice-9-debugger-extensions.scm
View file

@ -121,6 +121,11 @@ print the result obtained."
(define *not-yet-introduced* #t)
(cond ((string>=? (version) "1.7"))
(else
(define (debugger-command-loop state)
(read-and-dispatch-commands state (current-input-port)))))
(define-public (debug-trap trap-context)
"Invoke the Guile debugger to explore the stack at the specified @var{trap}."
(start-stack 'debugger
@ -144,7 +149,7 @@ print the result obtained."
(display "There is 1 frame on the stack.\n\n")
(format #t "There are ~A frames on the stack.\n\n" ssize))))
(write-state-short-with-source-location state)
(read-and-dispatch-commands state (current-input-port)))))
(debugger-command-loop state))))
(define write-state-short-with-source-location
(cond ((string>=? (version) "1.7")

5
ice-9/format.scm
View file

@ -13,7 +13,6 @@
(define-module (ice-9 format)
:use-module (ice-9 and-let-star)
:use-module (ice-9 threads)
:autoload (ice-9 pretty-print) (pretty-print)
:replace (format)
:export (format:symbol-case-conv
@ -1461,8 +1460,8 @@
(if (> format:fn-dot left-zeros)
(begin ; norm 0{0}nn.mm to nn.mm
(format:fn-shiftleft left-zeros)
(set! left-zeros 0)
(set! format:fn-dot (- format:fn-dot left-zeros)))
(set! format:fn-dot (- format:fn-dot left-zeros))
(set! left-zeros 0))
(begin ; normalize 0{0}.nnn to .nnn
(format:fn-shiftleft format:fn-dot)
(set! left-zeros (- left-zeros format:fn-dot))

31
ice-9/ftw.scm
View file

@ -217,14 +217,33 @@
(define (abs? filename)
(char=? #\/ (string-ref filename 0)))
;; `visited?-proc' returns a test procedure VISITED? which when called as
;; (VISITED? stat-obj) returns #f the first time a distinct file is seen,
;; then #t on any subsequent sighting of it.
;;
;; stat:dev and stat:ino together uniquely identify a file (see "Attribute
;; Meanings" in the glibc manual). Often there'll be just one dev, and
;; usually there's just a handful mounted, so the strategy here is a small
;; hash table indexed by dev, containing hash tables indexed by ino.
;;
;; It'd be possible to make a pair (dev . ino) and use that as the key to a
;; single hash table. It'd use an extra pair for every file visited, but
;; might be a little faster if it meant less scheme code.
;;
(define (visited?-proc size)
(let ((visited (make-hash-table size)))
(let ((dev-hash (make-hash-table 7)))
(lambda (s)
(and s (let ((ino (stat:ino s)))
(or (hash-ref visited ino)
(begin
(hash-set! visited ino #t)
#f)))))))
(and s
(let ((ino-hash (hashv-ref dev-hash (stat:dev s)))
(ino (stat:ino s)))
(or ino-hash
(begin
(set! ino-hash (make-hash-table size))
(hashv-set! dev-hash (stat:dev s) ino-hash)))
(or (hashv-ref ino-hash ino)
(begin
(hashv-set! ino-hash ino #t)
#f)))))))
(define (stat-dir-readable?-proc uid gid)
(let ((uid (getuid))

23
ice-9/gds-client.scm
View file

@ -174,12 +174,22 @@
(or gds-port
(begin
(set! gds-port
(let ((s (socket PF_INET SOCK_STREAM 0))
(SOL_TCP 6)
(TCP_NODELAY 1))
(setsockopt s SOL_TCP TCP_NODELAY 1)
(connect s AF_INET (inet-aton "127.0.0.1") 8333)
s))
(or (let ((s (socket PF_INET SOCK_STREAM 0))
(SOL_TCP 6)
(TCP_NODELAY 1))
(setsockopt s SOL_TCP TCP_NODELAY 1)
(catch #t
(lambda ()
(connect s AF_INET (inet-aton "127.0.0.1") 8333)
s)
(lambda _ #f)))
(let ((s (socket PF_UNIX SOCK_STREAM 0)))
(catch #t
(lambda ()
(connect s AF_UNIX "/tmp/.gds_socket")
s)
(lambda _ #f)))
(error "Couldn't connect to GDS by TCP or Unix domain socket")))
(write-form (list 'name (getpid) (format #f "PID ~A" (getpid)))))))
(if (not (defined? 'make-mutex))
@ -562,7 +572,6 @@ Thanks!\n\n"
(apply throw key args))
(define (run-utility)
(connect-to-gds)
(set-gds-breakpoints)
(write (getpid))
(newline)

24
ice-9/gds-server.scm
View file

@ -36,13 +36,29 @@
(define connection->id (make-object-property))
(define (run-server port)
(define (run-server port-or-path)
(let ((server (socket PF_INET SOCK_STREAM 0)))
(or (integer? port-or-path)
(string? port-or-path)
(error "port-or-path should be an integer (port number) or a string (file name)"
port-or-path))
(let ((server (socket (if (integer? port-or-path) PF_INET PF_UNIX)
SOCK_STREAM
0)))
;; Initialize server socket.
(setsockopt server SOL_SOCKET SO_REUSEADDR 1)
(bind server AF_INET INADDR_ANY port)
(if (integer? port-or-path)
(begin
(setsockopt server SOL_SOCKET SO_REUSEADDR 1)
(bind server AF_INET INADDR_ANY port-or-path))
(begin
(catch #t
(lambda () (delete-file port-or-path))
(lambda _ #f))
(bind server AF_UNIX port-or-path)))
;; Start listening.
(listen server 5)
(let loop ((clients '()) (readable-sockets '()))

67
ice-9/i18n.scm Normal file
View file

@ -0,0 +1,67 @@
;;;; i18n.scm --- internationalization support
;;;; Copyright (C) 2006 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 2.1 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Author: Ludovic Courtès <ludovic.courtes@laas.fr>
;;; Commentary:
;;;
;;; This module provides a number of routines that support
;;; internationalization (e.g., locale-dependent text collation, character
;;; mapping, etc.). It also defines `locale' objects, representing locale
;;; settings, that may be passed around to most of these procedures.
;;;
;;; Code:
(define-module (ice-9 i18n)
:export (;; `locale' type
make-locale locale?
;; locale category masks (standard)
LC_ALL_MASK
LC_COLLATE_MASK LC_CTYPE_MASK LC_MESSAGES_MASK
LC_MONETARY_MASK LC_NUMERIC_MASK LC_TIME_MASK
;; locale category masks (non-standard)
LC_PAPER_MASK LC_NAME_MASK LC_ADDRESS_MASK
LC_TELEPHONE_MASK LC_MEASUREMENT_MASK
LC_IDENTIFICATION_MASK
;; text collation
string-locale<? string-locale>?
string-locale-ci<? string-locale-ci>? string-locale-ci=?
char-locale<? char-locale>?
char-locale-ci<? char-locale-ci>? char-locale-ci=?
;; character mapping
char-locale-downcase char-locale-upcase
string-locale-downcase string-locale-upcase
;; reading numbers
locale-string->integer locale-string->inexact))
(load-extension "libguile-i18n-v-0" "scm_init_i18n")
;;; Local Variables:
;;; coding: latin-1
;;; End:
;;; i18n.scm ends here

331
libguile/ChangeLog
View file

@ -1,4 +1,195 @@
2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-12-12 Ludovic Courtès <ludovic.courtes@laas.fr>
* libguile/unif.c (read_decimal_integer): Let RESP be SIGN * RES
instead of RES (reported by Gyula Szavai). This allows the use of
negative lower bounds.
(scm_i_read_array): Make sure LEN is non-negative (reported by
Gyula Szavai).
(scm_array_in_bounds_p): Iterate over S instead of always
comparing indices with the bounds of S[0]. This fixes
`array-in-bounds?' for arrays with a rank greater than one and
with different lower bounds for each dimension.
2006-11-29 Ludovic Courtès <ludovic.courtes@laas.fr>
* libguile/vectors.c (scm_vector_to_list): Fixed list
construction: elements were not copied when INC is zero (see
"shared array" example in `vectors.test'). Reported by
Szavai Gyula.
2006-11-18 Ludovic Courtès <ludovic.courtes@laas.fr>
* Makefile.am (lib_LTLIBRARIES): Added `libguile-i18n-v-XX.la'.
(libguile_la_SOURCES): Added `gettext.c', removed `i18n.c'.
(libguile_i18n_v_XX_la_SOURCES, libguile_i18n_v_XX_la_CFLAGS,
libguile_i18n_v_XX_la_LIBADD, libguile_i18n_v_XX_la_LDFLAGS): New.
(DOT_X_FILES): Added `gettext.x'.
(DOT_DOC_FILES): Likewise.
(EXTRA_libguile_la_SOURCES): Added `locale-categories.h'.
(modinclude_HEADERS): Added `gettext.h'.
(EXTRA_DIST): Added `libgettext.h'.
* gettext.h: Renamed to...
* libgettext.h: New file.
* i18n.c: Renamed to...
* gettext.c: New file.
* i18n.h: Renamed to...
* gettext.h: New file.
* i18n.c, i18n.h, locale-categories.h: New files.
* init.c: Include "libguile/gettext.h" instead of
"libguile/i18n.h".
(scm_i_init_guile): Invoke `scm_init_gettext ()' instead of
`scm_init_i18n ()'.
* posix.c: Include "libguile/gettext.h" instead of
"libguile/i18n.h" Test `HAVE_NEWLOCALE' and `HAVE_STRCOLL_L'.
(USE_GNU_LOCALE_API): New macro.
(scm_i_locale_mutex): New variable.
(scm_setlocale): Lock and unlock it around `setlocale ()' calls.
* posix.h: Include "libguile/threads.h".
(scm_i_locale_mutex): New declaration.
2006-11-17 Neil Jerram <neil@ossau.uklinux.net>
* script.c (scm_shell_usage): Note need for subscription to bug-guile@gnu.org.
2006-11-08 Ludovic Courtès <ludovic.courtes@laas.fr>
* libguile/gc-freelist.c (scm_i_adjust_min_yield): Take two
"sweep_stats" arguments; use them instead of accessing the global
variables `scm_gc_cells_collected' and `scm_gc_cells_collected_1'.
* libguile/gc-segment.c (scm_i_sweep_some_cards): Reset SWEEP
before each iteration of the loop.
(scm_i_sweep_some_segments): Reset SWEEP at each iteration.
(scm_i_get_new_heap_segment): Take an additional argument
SWEEP_STATS. Compute MIN_CELLS as a function of it.
* libguile/gc.c (scm_gc_cells_collected,
scm_gc_cells_collected_1): Removed.
(scm_i_gc_sweep_stats, scm_i_gc_sweep_stats_1): New.
(scm_gc_cells_marked_acc, scm_gc_cells_swept_acc,
scm_gc_time_taken, scm_gc_mark_time_taken, scm_gc_times,
scm_gc_cell_yield_percentage, protected_obj_count): Made `static'.
(scm_gc_stats): Use `scm_i_gc_sweep_stats' instead of
`scm_gc_cells_(collected|swept)'.
(gc_update_stats): New.
(gc_end_stats): Use `scm_i_gc_sweep_stats' and
`scm_i_gc_sweep_stats_1' instead of the former globals.
(scm_gc_for_newcell): Invoke `gc_update_stats ()' after each
`scm_i_sweep_some_segments' call. This fixes a bug where the GC
would keep allocating new segments instead of re-using collected
cells (because `scm_gc_cells_collected' would remain zero).
* libguile/gc.h (scm_gc_cells_swept, scm_gc_cells_collected,
scm_gc_cell_yield_percentage): Removed.
* libguile/private-gc.h (scm_gc_cells_collected_1): Removed.
(scm_i_adjust_min_yield): Updated.
(scm_i_get_new_heap_segment): Updated.
2006-11-02 Neil Jerram <neil@ossau.uklinux.net>
* modules.c: Correct comment saying that low-level environments
will be used "in the next release".
* init.c: Comment out #include of environments.h.
(scm_i_init_guile): Comment out scm_environments_prehistory() and
scm_init_environments() calls.
* Makefile.am (libguile_la_SOURCES): Remove environments.c.
(DOT_X_FILES): Remove environments.x.
(DOT_DOC_FILES): Remove environments.doc.
(modinclude_HEADERS): Remove environments.h.
2006-10-25 Neil Jerram <neil@ossau.uklinux.net>
IA64 HP-UX GC patch from Hrvoje Nikšić. (Thanks!)
* threads.c (SCM_MARK_BACKING_STORE): Use scm_ia64_ar_bsp() and
scm_ia64_register_backing_store_base() instead of Linux-specific
implementations.
* gc.h (scm_ia64_register_backing_store_base, scm_ia64_ar_bsp):
New declarations.
* gc.c (__libc_ia64_register_backing_store_base): Declaration
removed.
(scm_ia64_register_backing_store_base, scm_ia64_ar_bsp): New, with
implementations for Linux and HP-UX.
* coop-pthreads.c (SCM_MARK_BACKING_STORE): Use scm_ia64_ar_bsp()
and scm_ia64_register_backing_store_base() instead of
Linux-specific implementations.
* continuations.h (__libc_ia64_register_backing_store_base):
Declaration removed.
(scm_t_contregs): New "fresh" field.
* continuations.c (ia64_getcontext): Removed.
(scm_make_continuation): Use continuation fresh field instead of
interpreting getcontext return values (which isn't portable). Use
scm_ia64_ar_bsp() and scm_ia64_register_backing_store_base()
instead of Linux-specific implementations.
(copy_stack_and_call): Use scm_ia64_register_backing_store_base()
instead of Linux-specific implementation.
* _scm.h (__ia64__): Also detect __ia64.
2006-10-03 Kevin Ryde <user42@zip.com.au>
* eval.c (SCM_APPLY): For scm_tc7_subr_2o, throw wrong-num-args on 0
arguments or 3 or more arguments. Previously 0 called proc with
SCM_UNDEFINED, and 3 or more silently used just the first 2.
2006-09-28 Kevin Ryde <user42@zip.com.au>
* fports.c, ports.c (ftruncate): Use "HAVE_CHSIZE && ! HAVE_FTRUNCATE"
for chsize fallback, instead of hard-coding mingw. Mingw in fact
supplies ftruncate itself these days.
* ports.c (fcntl.h): Can include this unconditionally, no need for
__MINGW32__.
* ports.c (truncate): Conditionalize on "HAVE_FTRUNCATE && !
HAVE_TRUNCATE" so as not to hard-code mingw. Use "const char *" and
"off_t" for parameters, per usual definition of this function, rather
than "char *" and "int". Use ftruncate instead of chsize. Check for
error on final close.
2006-09-27 Kevin Ryde <user42@zip.com.au>
* numbers.c (scm_log10): Check HAVE_CLOG10, clog10() is not available
in mingw.
* posix.c (scm_execl, scm_execlp, scm_execle): Cast "const char *
const *" for mingw to suppress warnings from gcc (which are errors
under the configure default -Werror). Reported by Nils Durner.
2006-09-26 Kevin Ryde <user42@zip.com.au>
* _scm.h (scm_to_off64_t, scm_from_off64_t): New macros.
* fports.c (scm_open_file): Use open_or_open64.
(fport_seek_or_seek64): New function, adapting fport_seek.
* fports.c, fports.h (scm_i_fport_seek, scm_i_fport_truncate): New
functions.
* ports.c (scm_seek, scm_truncate_file): Use scm_i_fport_seek and
scm_i_fport_truncate to allow 64-bit seeks and truncates on fports.
* ports.c (scm_truncate_file): Update docstring per manual.
2006-09-23 Kevin Ryde <user42@zip.com.au>
* numbers.c, numbers.h (scm_log, scm_log10, scm_exp, scm_sqrt): New
functions.
2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr>
* srfi-14.c: Include <config.h>. Define `_GNU_SOURCE'.
(make_predset, define_predset, make_strset, define_strset, false,
@ -20,6 +211,11 @@
(scm_setlocale): Invoke `scm_srfi_14_compute_char_sets ()' after a
successful `setlocale ()' call.
2006-09-08 Kevin Ryde <user42@zip.com.au>
* socket.c (scm_init_socket): Add MSG_DONTWAIT.
(scm_recvfrom): Update docstring from manual.
2006-08-31 Rob Browning <rlb@defaultvalue.org>
* ports.c (scm_c_port_for_each): Add a
@ -32,11 +228,47 @@
improvements to docstring.
(scm_backtrace_with_highlights): Analogous improvements.
2006-08-12 Kevin Ryde <user42@zip.com.au>
* gen-scmconfig.h.in (SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT):
New, set from configure.
* gen-scmconfig.c (SCM_NEED_BRACES_ON_PTHREAD_ONCE_INIT): New output
to scmconfig.h.
* pthread-threads.h (SCM_I_PTHREAD_ONCE_INIT): Use
SCM_NEED_BRACES_ON_PTHREAD_ONCE_INIT to cope with Solaris.
Reported by Claes Wallin.
2006-08-11 Neil Jerram <neil@ossau.uklinux.net>
* stacks.c (scm_last_stack_frame): Correct docstring (returns a
frame, not a stack).
2006-07-25 Kevin Ryde <user42@zip.com.au>
* threads.c (get_thread_stack_base): Restrict HAVE_PTHREAD_GETATTR_NP
on pthreads version, since pthread_getattr_np not available on solaris
and macos. Reported by Claes Wallin.
2006-07-24 Kevin Ryde <user42@zip.com.au>
* filesys.c (dirfd): Test with #ifndef rather than HAVE_DIRFD, since
it's a macro on MacOS X. Reported by Claes Wallin.
* posix.c (sethostname): Give prototype if not HAVE_DECL_SETHOSTNAME,
for the benefit of Solaris 10. Reported by Claes Wallin.
* socket.c (scm_htonl, scm_ntohl): Use scm_to_uint32 rather than
NUM2ULONG, to enforce 32-bit range check on systems with 64-bit long.
2006-07-21 Kevin Ryde <user42@zip.com.au>
* eval.c, filesys.c (alloca): Update <alloca.h> etc blob, per current
autoconf recommendation. Should fix Solaris 10 reported by Claes
Wallin.
* threads.c: Include <string.h>, needed for memset() which is used by
FD_ZERO() on Solaris 10. Reported by Claes Wallin.
2006-07-18 Rob Browning <rlb@defaultvalue.org>
* continuations.c: Add __attribute__ ((returns_twice)) to the
@ -44,12 +276,31 @@
arrangements and avoid an illegal instruction during
call-with-current-continuation.
2006-07-12 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-07-12 Ludovic Courtès <ludovic.courtes@laas.fr>
* numbers.c (guile_ieee_init): Use regular ANSI C casts rather
than C++-style `X_CAST ()'. Patch posted by by Mike Gran.
2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-07-08 Kevin Ryde <user42@zip.com.au>
* environments.c (core_environments_unobserve): Use if/else rather
than ?: for "SET" bits, avoiding complaints from AIX xlc compiler
about them not being rvalues. Reported by Mike Gran.
* Makefile.am (version.h): Don't use $< in an explicit rule, it's not
portable and in particular fails on OpenBSD and AIX (see autoconf
manual too). Reported by Mike Gran.
2006-06-25 Kevin Ryde <user42@zip.com.au>
* stime.c (bdtime2c): tm_gmtoff is seconds East, so take negative of
tm:gmtoff which is seconds West. Reported by Aaron VanDevender.
(bdtime2c): Test HAVE_STRUCT_TM_TM_GMTOFF for tm_gmtoff, rather than
HAVE_TM_ZONE.
(scm_strptime): Use tm_gmtoff from the strptime result when that field
exists, it's set by glibc strptime "%s".
2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr>
* eq.c: Include "struct.h", "goops.h" and "objects.h".
(scm_equal_p): Invoke `scm_i_struct_equalp ()' on structures that
@ -187,7 +438,7 @@
2006-04-06 Kevin Ryde <user42@zip.com.au>
* fports.c (scm_setvbuf): Fix for not _IOLBF, clear SCM_BUFLINE
instead of toggling it. Reported by Ludovic Courtès.
instead of toggling it. Reported by Ludovic Courtès.
2006-03-26 Marius Vollmer <mvo@zagadka.de>
@ -199,7 +450,7 @@
* gc_os_dep.c (scm_get_stack_base): Abort when the machine type is
unknown instead of returning NULL.
2006-03-21 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-03-21 Ludovic Courtès <ludovic.courtes@laas.fr>
* numbers.c (scm_i_mem2number): Renamed to
scm_c_locale_stringn_to_number.
@ -291,7 +542,7 @@
(scm_i_sweep_statistics_init): New macro.
(scm_i_sweep_statistics_sum): New macro
2006-02-14 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-02-14 Ludovic Courtès <ludovic.courtes@laas.fr>
* strings.c (scm_i_take_stringbufn): Register LEN+1 bytes instead of
LEN. Without this, too much collectable memory gets unregistered,
@ -409,7 +660,7 @@
* inline.h, pairs.c (scm_is_pair): Moved scm_is_pair from pairs.c
to inline.h to make it inline.
2005-12-19 Ludovic Courtès <ludovic.courtes@laas.fr>
2005-12-19 Ludovic Courtès <ludovic.courtes@laas.fr>
* strings.c (scm_i_take_stringbufn): New.
(scm_i_c_take_symbol): New.
@ -442,7 +693,7 @@
2005-12-29 Neil Jerram <neil@ossau.uklinux.net>
* fluids.c (next_fluid_num): [From Ludovic Courtès:] Don't trigger
* fluids.c (next_fluid_num): [From Ludovic Courtès:] Don't trigger
the GC when allocated_fluids_len is zero.
2005-12-14 Neil Jerram <neil@ossau.uklinux.net>
@ -474,7 +725,7 @@
* srfi-4.h, srfi-4.c, srfi-4.i.c (take_uvec): Make BASE pointer
non-const.
(scm_take_u8vector, etc): Likewise. Thanks to Ludovic Courtès!
(scm_take_u8vector, etc): Likewise. Thanks to Ludovic Courtès!
* threads.h, threads.c (scm_t_guile_ticket, scm_leave_guile,
scm_enter_guile): Removed from public API. See comment at
@ -489,7 +740,7 @@
* eval.c (scm_m_cond): Recognize SRFI 61 cond syntax.
(CEVAL): Evaluate SRFI 61 cond clauses.
2005-12-06 Ludovic Courtès <ludovic.courtes@laas.fr>
2005-12-06 Ludovic Courtès <ludovic.courtes@laas.fr>
* gc-card.c (scm_i_card_statistics): Return if BITVEC is NULL.
This was typically hit when running `gc-live-object-stats' right
@ -503,7 +754,7 @@
2005-11-26 Kevin Ryde <user42@zip.com.au>
* gc-mark.c (scm_mark_all): Change C++ comment to C comment. Reported
by Ludovic Courtès.
by Ludovic Courtès.
* list.c (list): Should be "primitive" in SCM_SNARF_DOCS, not
"register".
@ -515,7 +766,7 @@
* socket.c (scm_fill_sockaddr): Remove SCM_C_INLINE_KEYWORD, this is
much too big to want to inline.
2005-11-17 Ludovic Courtès <ludovic.courtes@laas.fr>
2005-11-17 Ludovic Courtès <ludovic.courtes@laas.fr>
* print.c (EXIT_NESTED_DATA): Before popping from the stack, reset
the value at its top. This fixes a reference leak.
@ -523,14 +774,14 @@
`PSTATE_STACK_SET ()' in order to avoid undesired potential side
effects.
2005-11-12 Ludovic Courtès <ludovic.courtes@laas.fr>
2005-11-12 Ludovic Courtès <ludovic.courtes@laas.fr>
* gc.c (scm_weak_vectors): Removed.
2005-11-12 Kevin Ryde <user42@zip.com.au>
* socket.c (scm_setsockopt): Missing @defvar in docstring. Reported
by Ludovic Courtès.
by Ludovic Courtès.
2005-11-07 Marius Vollmer <mvo@zagadka.de>
@ -552,7 +803,7 @@
* debug.h (SCM_CHEAPTRAPS_P): Removed.
2005-10-27 Ludovic Courtès <ludovic.courtes@laas.fr>
2005-10-27 Ludovic Courtès <ludovic.courtes@laas.fr>
* socket.c (scm_fill_sockaddr): No need to check NULL from scm_malloc.
(scm_connect, scm_bind, scm_sendto): Accept sockaddr object.
@ -860,7 +1111,7 @@
2005-05-11 Neil Jerram <neil@ossau.uklinux.net>
Fix C99isms reported by Ludovic Courtès:
Fix C99isms reported by Ludovic Courtès:
* threads.c (s_scm_lock_mutex): Don't declare msg in middle of
code.
@ -975,7 +1226,7 @@
2005-03-18 Kevin Ryde <user42@zip.com.au>
* arbiters.c (FETCH_STORE) [generic C]: Should be
scm_i_scm_pthread_mutex_lock/unlock now. Reported by Ludovic Courtès.
scm_i_scm_pthread_mutex_lock/unlock now. Reported by Ludovic Courtès.
2005-03-13 Kevin Ryde <user42@zip.com.au>
@ -2121,7 +2372,7 @@
2004-11-02 Marius Vollmer <mvo@zagadka.de>
Mac OS X and OpenBSD compatibility patches from Andreas Vögele.
Mac OS X and OpenBSD compatibility patches from Andreas Vögele.
Thanks!
* backtrace.c (scm_display_backtrace_with_highlights): Join the
@ -2565,7 +2816,7 @@
* numbers.h, numbers.c: Include <gmp.h> in numbers.h, not in
numbers.c.
(scm_to_mpz, scm_from_mpz): New.
Thanks to Andreas Vögele!
Thanks to Andreas Vögele!
* read.c (skip_scsh_block_comment): Recognize "!#" everywhere, not
just on a line of its own.
@ -2574,7 +2825,7 @@
scm_string_tabulate, string_upcase_x, string_down_case_x,
string_titlecase_x, string_reverse_x, scm_string_tokenize): Use
size_t instead of int for indices into strings. Make sure that no
over- or underflow occurs. Thanks to Andreas Vögele!
over- or underflow occurs. Thanks to Andreas Vögele!
(scm_xsubstring, scm_string_xcopy_x): Use ints for 'extended'
indices, which can also be negative.
@ -2596,7 +2847,7 @@
* filesys.c, stime.c (_POSIX_C_SOURCE): Use this only on hpux, it
causes too many problems elsewhere (glibc, freebsd, mingw). Reported
by Andreas Vögele.
by Andreas Vögele.
2004-09-08 Marius Vollmer <marius.vollmer@uni-dortmund.de>
@ -3431,7 +3682,7 @@
* gc_os_dep.c: update ifdefery for macosx.
(scm_get_stack_base): separate result initialization from
declaration to slience warnings with macosx and hp-ux using gcc
3.3. Thanks to Andreas Vögele.
3.3. Thanks to Andreas Vögele.
2004-06-13 Han-Wen Nienhuys <hanwen@xs4all.nl>
@ -3641,10 +3892,10 @@
2004-05-02 Kevin Ryde <user42@zip.com.au>
* eval.c (scm_macroexp): Add prototype, since it's not in eval.h under
--disable-deprecated. Reported by Andreas Vögele.
--disable-deprecated. Reported by Andreas Vögele.
* filesys.c (_POSIX_C_SOURCE): Define to 199506L to get readdir_r (in
particular on HP-UX). Reported by Andreas Vögele.
particular on HP-UX). Reported by Andreas Vögele.
* list.c (varargs.h): Remove, leave just stdarg.h which is all the
code has support for. Fixes building with AIX cc, which is ansi but
@ -3655,14 +3906,14 @@
2004-05-01 Kevin Ryde <user42@zip.com.au>
* continuations.c (scm_dynthrow): Use >= instead of SCM_PTR_GE which
is now gone. Reported by Andreas Vögele.
is now gone. Reported by Andreas Vögele.
2004-04-28 Kevin Ryde <user42@zip.com.au>
* backtrace.c (display_frame_expr), numbers.c (XDIGIT2UINT,
mem2uinteger, mem2decimal_from_point, mem2ureal): Cast char to int for
ctype.h tests, to avoid warnings from gcc on HP-UX about char as array
subscript. Reported by Andreas Vögele.
subscript. Reported by Andreas Vögele.
Also cast through unsigned char to avoid passing negatives to those
macros if input contains 8-bit values.
@ -3676,17 +3927,17 @@
* numbers.c (scm_bit_extract): Use min instead of MIN.
(MIN): Remove, this conflicts with similar macro defined by limits.h
on HP-UX. Reported by Andreas Vögele.
on HP-UX. Reported by Andreas Vögele.
* stime.c (_POSIX_C_SOURCE): Define to 199506L to get gmtime_r (in
particular on HP-UX). Reported by Andreas Vögele.
particular on HP-UX). Reported by Andreas Vögele.
* threads.c (scm_threads_mark_stacks): Correction sizet -> size_t.
Reported by Andreas Vögele.
Reported by Andreas Vögele.
* threads-plugin.h (SCM_MUTEX_MAXSIZE): Increase to 25*sizeof(long),
for the benefit of hpux11 where pthread_mutex_t is 88 bytes. Reported
by Andreas Vögele.
by Andreas Vögele.
2004-04-22 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
@ -7539,7 +7790,7 @@
2002-08-26 Marius Vollmer <mvo@zagadka.ping.de>
* script.c (scm_compile_shell_switches): Added "2002" to Copyright
years. Thanks to Martin Grabmüller!
years. Thanks to Martin Grabmüller!
2002-08-25 Han-Wen Nienhuys <hanwen@cs.uu.nl>
@ -9455,7 +9706,7 @@
* deprecation.c (scm_include_deprecated_features): Simplified.
* eval.c (EVALCAR, unmemocopy), eval.h (SCM_XEVALCAR): Use
`SCM_IMP' instead of `!SCM_CELLP´.
`SCM_IMP' instead of `!SCM_CELLP´.
* eval.c (unmemocopy): Eliminate redundant SCM_CELLP tests.
Extract side-effecting operations from macros.
@ -10496,7 +10747,7 @@
2001-06-09 Marius Vollmer <mvo@zagadka.ping.de>
* ports.c (scm_lfwrite): Maintain columnd and row count in port.
Thanks to Matthias Köppe!
Thanks to Matthias Köppe!
2001-06-08 Michael Livshin <mlivshin@bigfoot.com>
@ -10504,7 +10755,7 @@
space-happy C preprocessors.
* filter-doc-snarfage.c, guile-snarf.in: try to cope with spaces
inside cookies. thanks to Matthias Köppe!
inside cookies. thanks to Matthias Köppe!
2001-06-08 Dirk Herrmann <D.Herrmann@tu-bs.de>
@ -11079,7 +11330,7 @@
SCM_VARIABLE_INIT since that it what it used to be.
* deprecation.c (scm_include_deprecated_features): Make docstring
ANSIsh. Thanks to Matthias Köppe!
ANSIsh. Thanks to Matthias Köppe!
2001-05-21 Marius Vollmer <mvo@zagadka.ping.de>
@ -11433,7 +11684,7 @@
2001-05-15 Marius Vollmer <mvo@zagadka.ping.de>
* values.c (print_values): Print as a unreadable object, not as
multiple lines. Thanks to Matthias Köppe!
multiple lines. Thanks to Matthias Köppe!
2001-05-14 Dirk Herrmann <D.Herrmann@tu-bs.de>
@ -11465,7 +11716,7 @@
2001-05-09 Michael Livshin <mlivshin@bigfoot.com>
from Matthias Köppe (thanks!):
from Matthias Köppe (thanks!):
* ports.c (scm_c_read): pointer arithmetic on void pointers isn't
portable.
@ -13322,7 +13573,7 @@
2001-01-11 Michael Livshin <mlivshin@bigfoot.com>
from Matthias Köppe:
from Matthias Köppe:
* objects.h (SCM_SET_ENTITY_SETTER): new macro. SCM_ENTITY_SETTER
casts its result, so doesn't yield an lvalue per ANSI C.
@ -13391,3 +13642,7 @@
(write_all): new helper procedure.
The ChangeLog continues in the file: "ChangeLog-2000"
;; Local Variables:
;; coding: utf-8
;; End:

36
libguile/Makefile.am
View file

@ -31,7 +31,8 @@ INCLUDES = -I.. -I$(top_srcdir)
ETAGS_ARGS = --regex='/SCM_\(GLOBAL_\)?\(G?PROC\|G?PROC1\|SYMBOL\|VCELL\|CONST_LONG\).*\"\([^\"]\)*\"/\3/' \
--regex='/[ \t]*SCM_[G]?DEFINE1?[ \t]*(\([^,]*\),[^,]*/\1/'
lib_LTLIBRARIES = libguile.la
lib_LTLIBRARIES = libguile.la \
libguile-i18n-v-@LIBGUILE_I18N_MAJOR@.la
bin_PROGRAMS = guile
noinst_PROGRAMS = guile_filter_doc_snarfage gen-scmconfig
@ -94,12 +95,12 @@ libguile_la_CFLAGS = $(GUILE_CFLAGS)
libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \
chars.c continuations.c convert.c debug.c deprecation.c \
deprecated.c discouraged.c dynwind.c environments.c eq.c error.c \
deprecated.c discouraged.c dynwind.c eq.c error.c \
eval.c evalext.c extensions.c feature.c fluids.c fports.c \
futures.c gc.c gc-malloc.c \
gdbint.c gh_data.c gh_eval.c gh_funcs.c \
gdbint.c gettext.c gh_data.c gh_eval.c gh_funcs.c \
gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c \
guardians.c hash.c hashtab.c hooks.c i18n.c init.c inline.c \
guardians.c hash.c hashtab.c hooks.c init.c inline.c \
ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c \
modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c \
print.c procprop.c procs.c properties.c random.c rdelim.c read.c \
@ -109,11 +110,20 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \
throw.c values.c variable.c vectors.c version.c vports.c weaks.c \
ramap.c unif.c
libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_SOURCES = i18n.c
libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_CFLAGS = \
$(libguile_la_CFLAGS)
libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LIBADD = \
libguile.la
libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LDFLAGS = \
-module -L$(builddir) -lguile \
-version-info @LIBGUILE_I18N_INTERFACE@
DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \
continuations.x debug.x deprecation.x deprecated.x discouraged.x \
dynl.x dynwind.x environments.x eq.x error.x eval.x evalext.x \
extensions.x feature.x fluids.x fports.x futures.x gc.x \
goops.x gsubr.x guardians.x \
gettext.c goops.x gsubr.x guardians.x \
hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x \
list.x load.x macros.x mallocs.x modules.x numbers.x objects.x \
objprop.x options.x pairs.x ports.x print.x procprop.x procs.x \
@ -128,10 +138,10 @@ EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \
boolean.doc chars.doc continuations.doc debug.doc deprecation.doc \
deprecated.doc discouraged.doc dynl.doc dynwind.doc \
environments.doc eq.doc error.doc eval.doc evalext.doc \
eq.doc error.doc eval.doc evalext.doc \
extensions.doc feature.doc fluids.doc fports.doc futures.doc \
gc.doc goops.doc gsubr.doc \
gc-malloc.doc guardians.doc hash.doc hashtab.doc \
gc-malloc.doc gettext.doc guardians.doc hash.doc hashtab.doc \
hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc \
list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc \
objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc \
@ -154,7 +164,8 @@ EXTRA_libguile_la_SOURCES = _scm.h \
dynl.c regex-posix.c \
filesys.c posix.c net_db.c socket.c \
debug-malloc.c mkstemp.c \
win32-uname.c win32-dirent.c win32-socket.c
win32-uname.c win32-dirent.c win32-socket.c \
locale-categories.h
## delete guile-snarf.awk from the installation bindir, in case it's
## lingering there due to an earlier guile version not having been
@ -186,9 +197,10 @@ modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h \
boehm-gc.h \
boolean.h chars.h continuations.h convert.h debug.h debug-malloc.h \
deprecation.h deprecated.h discouraged.h dynl.h dynwind.h \
environments.h eq.h error.h eval.h evalext.h extensions.h \
eq.h error.h eval.h evalext.h extensions.h \
feature.h filesys.h fluids.h fports.h futures.h gc.h \
gdb_interface.h gdbint.h goops.h gsubr.h guardians.h hash.h \
gdb_interface.h gdbint.h gettext.h goops.h \
gsubr.h guardians.h hash.h \
hashtab.h hooks.h i18n.h init.h inline.h ioext.h iselect.h \
keywords.h lang.h list.h load.h macros.h mallocs.h modules.h \
net_db.h numbers.h objects.h objprop.h options.h pairs.h ports.h \
@ -213,7 +225,7 @@ EXTRA_DIST = ChangeLog-gh ChangeLog-scm ChangeLog-threads \
cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c \
cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk \
c-tokenize.lex version.h.in \
scmconfig.h.top gettext.h
scmconfig.h.top libgettext.h
# $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
# guile-procedures.txt guile.texi
@ -221,7 +233,7 @@ EXTRA_DIST = ChangeLog-gh ChangeLog-scm ChangeLog-threads \
## usual @...@, so autoconf doesn't go and substitute the values
## directly into the left-hand sides of the sed substitutions. *sigh*
version.h: version.h.in
sed < $< > $@.tmp \
sed < $(srcdir)/version.h.in > $@.tmp \
-e s:@-GUILE_MAJOR_VERSION-@:${GUILE_MAJOR_VERSION}: \
-e s:@-GUILE_MINOR_VERSION-@:${GUILE_MINOR_VERSION}: \
-e s:@-GUILE_MICRO_VERSION-@:${GUILE_MICRO_VERSION}:

5
libguile/_scm.h
View file

@ -54,6 +54,9 @@
and differences between _scm.h and __scm.h.
**********************************************************************/
#if defined(__ia64) && !defined(__ia64__)
# define __ia64__
#endif
#if HAVE_CONFIG_H
# include <config.h>
@ -167,6 +170,8 @@
#else
# error sizeof(off_t) is not 4 or 8.
#endif
#define scm_to_off64_t scm_to_int64
#define scm_from_off64_t scm_from_int64
#endif /* SCM__SCM_H */

36
libguile/continuations.c
View file

@ -57,22 +57,6 @@ continuation_print (SCM obj, SCM port, scm_print_state *state SCM_UNUSED)
return 1;
}
#ifdef __ia64__
/* Extern declaration of getcontext()/setcontext() in order to redefine
getcontext() since on ia64-linux the second return value indicates whether
it returned from getcontext() itself or by running setcontext(). */
struct rv
{
long retval;
long first_return;
};
#ifdef __GNUC__
__attribute__ ((returns_twice))
#endif /* __GNUC__ */
extern struct rv ia64_getcontext (ucontext_t *) __asm__ ("getcontext");
#endif /* __ia64__ */
/* this may return more than once: the first time with the escape
procedure, then subsequently with the value to be passed to the
continuation. */
@ -85,9 +69,6 @@ scm_make_continuation (int *first)
scm_t_contregs *continuation;
long stack_size;
SCM_STACKITEM * src;
#ifdef __ia64__
struct rv rv;
#endif /* __ia64__ */
SCM_FLUSH_REGISTER_WINDOWS;
stack_size = scm_stack_size (thread->continuation_base);
@ -109,20 +90,23 @@ scm_make_continuation (int *first)
memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size);
#ifdef __ia64__
rv = ia64_getcontext (&continuation->ctx);
if (rv.first_return)
continuation->fresh = 1;
getcontext (&continuation->ctx);
if (continuation->fresh)
{
continuation->backing_store_size =
continuation->ctx.uc_mcontext.sc_ar_bsp -
(unsigned long) __libc_ia64_register_backing_store_base;
continuation->backing_store_size =
(char *) scm_ia64_ar_bsp(&continuation->ctx)
-
(char *) scm_ia64_register_backing_store_base ();
continuation->backing_store = NULL;
continuation->backing_store =
scm_gc_malloc (continuation->backing_store_size,
"continuation backing store");
memcpy (continuation->backing_store,
(void *) __libc_ia64_register_backing_store_base,
(void *) scm_ia64_register_backing_store_base (),
continuation->backing_store_size);
*first = 1;
continuation->fresh = 0;
return cont;
}
else
@ -217,7 +201,7 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
continuation->throw_value = val;
#ifdef __ia64__
memcpy ((void *) __libc_ia64_register_backing_store_base,
memcpy (scm_ia64_register_backing_store_base (),
continuation->backing_store,
continuation->backing_store_size);
setcontext (&continuation->ctx);

2
libguile/continuations.h
View file

@ -27,7 +27,6 @@
#ifdef __ia64__
#include <signal.h>
#include <ucontext.h>
extern unsigned long * __libc_ia64_register_backing_store_base;
#endif /* __ia64__ */
@ -48,6 +47,7 @@ typedef struct
SCM dynenv;
#ifdef __ia64__
ucontext_t ctx;
int fresh;
void *backing_store;
unsigned long backing_store_size;
#endif /* __ia64__ */

4
libguile/coop-pthreads.c
View file

@ -827,8 +827,8 @@ scm_threads_init (SCM_STACKITEM *base)
scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \
((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \
/ sizeof (SCM_STACKITEM))); \
bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \
top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \
bot = (SCM_STACKITEM *) scm_ia64_register_backing_store_base (); \
top = (SCM_STACKITEM *) scm_ia64_ar_bsp (&ctx); \
scm_mark_locations (bot, top - bot); } while (0)
#else
# define SCM_MARK_BACKING_STORE()

7
libguile/environments.c
View file

@ -667,9 +667,10 @@ core_environments_unobserve (SCM env, SCM observer)
if (scm_is_eq (first, observer))
{
/* Remove the first observer */
handling_weaks
? SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS (env, rest)
: SCM_SET_CORE_ENVIRONMENT_OBSERVERS (env, rest);
if (handling_weaks)
SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS (env, rest);
else
SCM_SET_CORE_ENVIRONMENT_OBSERVERS (env, rest);
return;
}

43
libguile/eval.c
View file

@ -37,24 +37,22 @@
#ifndef DEVAL
/* AIX requires this to be the first thing in the file. The #pragma
directive is indented so pre-ANSI compilers will ignore it, rather
than choke on it. */
#ifndef __GNUC__
# if HAVE_ALLOCA_H
# include <alloca.h>
# else
# ifdef _AIX
# pragma alloca
# else
# ifndef alloca /* predefined by HP cc +Olibcalls */
char *alloca ();
# endif
# endif
/* This blob per the Autoconf manual (under "Particular Functions"). */
#if HAVE_ALLOCA_H
# include <alloca.h>
#elif defined __GNUC__
# define alloca __builtin_alloca
#elif defined _AIX
# define alloca __alloca
#elif defined _MSC_VER
# include <malloc.h>
# define alloca _alloca
#else
# include <stddef.h>
# ifdef __cplusplus
extern "C"
# endif
#endif
#if HAVE_MALLOC_H
#include <malloc.h> /* alloca on mingw */
void *alloca (size_t);
#endif
#include <assert.h>
@ -4851,7 +4849,16 @@ tail:
switch (SCM_TYP7 (proc))
{
case scm_tc7_subr_2o:
args = scm_is_null (args) ? SCM_UNDEFINED : SCM_CAR (args);
if (SCM_UNBNDP (arg1))
scm_wrong_num_args (proc);
if (scm_is_null (args))
args = SCM_UNDEFINED;
else
{
if (! scm_is_null (SCM_CDR (args)))
scm_wrong_num_args (proc);
args = SCM_CAR (args);
}
RETURN (SCM_SUBRF (proc) (arg1, args));
case scm_tc7_subr_2:
if (scm_is_null (args) || !scm_is_null (SCM_CDR (args)))

44
libguile/filesys.c
View file

@ -29,24 +29,22 @@
# include <config.h>
#endif
/* AIX requires this to be the first thing in the file. The #pragma
directive is indented so pre-ANSI compilers will ignore it, rather
than choke on it. */
#ifndef __GNUC__
# if HAVE_ALLOCA_H
# include <alloca.h>
# else
# ifdef _AIX
# pragma alloca
# else
# ifndef alloca /* predefined by HP cc +Olibcalls */
char *alloca ();
# endif
# endif
/* This blob per the Autoconf manual (under "Particular Functions"). */
#if HAVE_ALLOCA_H
# include <alloca.h>
#elif defined __GNUC__
# define alloca __builtin_alloca
#elif defined _AIX
# define alloca __alloca
#elif defined _MSC_VER
# include <malloc.h>
# define alloca _alloca
#else
# include <stddef.h>
# ifdef __cplusplus
extern "C"
# endif
#endif
#if HAVE_MALLOC_H
#include <malloc.h> /* alloca on mingw, though its not used on that system */
void *alloca (size_t);
#endif
#include <stdio.h>
@ -202,10 +200,14 @@ char *alloca ();
# define fchmod(fd, mode) (-1)
#endif /* __MINGW32__ */
/* This definition is for Solaris 10, it's probably not right elsewhere, but
that's ok, it shouldn't be used elsewhere. */
#if ! HAVE_DIRFD
#define dirfd(dirstream) (dirstream->dd_fd)
/* 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

89
libguile/fports.c
View file

@ -17,6 +17,8 @@
#define _LARGEFILE64_SOURCE /* ask for stat64 etc */
#if HAVE_CONFIG_H
# include <config.h>
#endif
@ -46,6 +48,7 @@
#endif
#include <errno.h>
#include <sys/types.h>
#include "libguile/iselect.h"
@ -53,9 +56,33 @@
#ifdef __MINGW32__
# include <sys/stat.h>
# include <winsock2.h>
# define ftruncate(fd, size) chsize (fd, size)
#endif /* __MINGW32__ */
/* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
already, but have this code here in case that wasn't so in past versions,
or perhaps to help other minimal DOS environments.
gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
might be possibilities if we've got other systems without ftruncate. */
#if HAVE_CHSIZE && ! HAVE_FTRUNCATE
# define ftruncate(fd, size) chsize (fd, size)
#undef HAVE_FTRUNCATE
#define HAVE_FTRUNCATE 1
#endif
#if SIZEOF_OFF_T == SIZEOF_INT
#define OFF_T_MAX INT_MAX
#define OFF_T_MIN INT_MIN
#elif SIZEOF_OFF_T == SIZEOF_LONG
#define OFF_T_MAX LONG_MAX
#define OFF_T_MIN LONG_MIN
#elif SIZEOF_OFF_T == SIZEOF_LONG_LONG
#define OFF_T_MAX LONG_LONG_MAX
#define OFF_T_MIN LONG_LONG_MIN
#else
#error Oops, unknown OFF_T size
#endif
scm_t_bits scm_tc16_fport;
@ -334,7 +361,7 @@ SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
}
ptr++;
}
SCM_SYSCALL (fdes = open (file, flags, 0666));
SCM_SYSCALL (fdes = open_or_open64 (file, flags, 0666));
if (fdes == -1)
{
int en = errno;
@ -584,25 +611,25 @@ fport_fill_input (SCM port)
}
}
static off_t
fport_seek (SCM port, off_t offset, int whence)
static off_t_or_off64_t
fport_seek_or_seek64 (SCM port, off_t_or_off64_t offset, int whence)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
scm_t_fport *fp = SCM_FSTREAM (port);
off_t rv;
off_t result;
off_t_or_off64_t rv;
off_t_or_off64_t result;
if (pt->rw_active == SCM_PORT_WRITE)
{
if (offset != 0 || whence != SEEK_CUR)
{
fport_flush (port);
result = rv = lseek (fp->fdes, offset, whence);
result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
}
else
{
/* read current position without disturbing the buffer. */
rv = lseek (fp->fdes, offset, whence);
rv = lseek_or_lseek64 (fp->fdes, offset, whence);
result = rv + (pt->write_pos - pt->write_buf);
}
}
@ -612,13 +639,13 @@ fport_seek (SCM port, off_t offset, int whence)
{
/* could expand to avoid a second seek. */
scm_end_input (port);
result = rv = lseek (fp->fdes, offset, whence);
result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
}
else
{
/* read current position without disturbing the buffer
(particularly the unread-char buffer). */
rv = lseek (fp->fdes, offset, whence);
rv = lseek_or_lseek64 (fp->fdes, offset, whence);
result = rv - (pt->read_end - pt->read_pos);
if (pt->read_buf == pt->putback_buf)
@ -627,7 +654,7 @@ fport_seek (SCM port, off_t offset, int whence)
}
else /* SCM_PORT_NEITHER */
{
result = rv = lseek (fp->fdes, offset, whence);
result = rv = lseek_or_lseek64 (fp->fdes, offset, whence);
}
if (rv == -1)
@ -636,6 +663,39 @@ fport_seek (SCM port, off_t offset, int whence)
return result;
}
/* If we've got largefile and off_t isn't already off64_t then
fport_seek_or_seek64 needs a range checking wrapper to be fport_seek in
the port descriptor.
Otherwise if no largefile, or off_t is the same as off64_t (which is the
case on NetBSD apparently), then fport_seek_or_seek64 is right to be
fport_seek already. */
#if HAVE_STAT64 && SIZEOF_OFF_T != SIZEOF_OFF64_T
static off_t
fport_seek (SCM port, off_t offset, int whence)
{
off64_t rv = fport_seek_or_seek64 (port, (off64_t) offset, whence);
if (rv > OFF_T_MAX || rv < OFF_T_MIN)
{
errno = EOVERFLOW;
scm_syserror ("fport_seek");
}
return (off_t) rv;
}
#else
#define fport_seek fport_seek_or_seek64
#endif
/* `how' has been validated and is one of SEEK_SET, SEEK_CUR or SEEK_END */
SCM
scm_i_fport_seek (SCM port, SCM offset, int how)
{
return scm_from_off_t_or_off64_t
(fport_seek_or_seek64 (port, scm_to_off_t_or_off64_t (offset), how));
}
static void
fport_truncate (SCM port, off_t length)
{
@ -645,6 +705,13 @@ fport_truncate (SCM port, off_t length)
scm_syserror ("ftruncate");
}
int
scm_i_fport_truncate (SCM port, SCM length)
{
scm_t_fport *fp = SCM_FSTREAM (port);
return ftruncate_or_ftruncate64 (fp->fdes, scm_to_off_t_or_off64_t (length));
}
/* helper for fport_write: try to write data, using multiple system
calls if required. */
#define FUNC_NAME "write_all"

3
libguile/fports.h
View file

@ -58,6 +58,9 @@ SCM_API void scm_init_fports (void);
/* internal functions */
SCM_API SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name);
SCM_API int scm_i_fport_truncate (SCM, SCM);
SCM_API SCM scm_i_fport_seek (SCM, SCM, int);
#endif /* SCM_FPORTS_H */

72
libguile/gc.c
View file

@ -30,11 +30,6 @@
#include <string.h>
#include <assert.h>
#ifdef __ia64__
#include <ucontext.h>
extern unsigned long * __libc_ia64_register_backing_store_base;
#endif
#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/stime.h"
@ -224,18 +219,25 @@ unsigned long scm_mtrigger;
*/
unsigned long scm_cells_allocated = 0;
unsigned long scm_mallocated = 0;
unsigned long scm_gc_cells_collected;
unsigned long scm_gc_cells_collected_1 = 0; /* previous GC yield */
unsigned long scm_gc_malloc_collected;
unsigned long scm_gc_ports_collected;
unsigned long scm_gc_time_taken = 0;
/* Global GC sweep statistics since the last full GC. */
static scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 };
static scm_t_sweep_statistics scm_i_gc_sweep_stats_1 = { 0, 0 };
/* Total count of cells marked/swept. */
static double scm_gc_cells_marked_acc = 0.;
static double scm_gc_cells_swept_acc = 0.;
static unsigned long scm_gc_time_taken = 0;
static unsigned long t_before_gc;
unsigned long scm_gc_mark_time_taken = 0;
unsigned long scm_gc_times = 0;
unsigned long scm_gc_cells_swept = 0;
double scm_gc_cells_marked_acc = 0.;
double scm_gc_cells_swept_acc = 0.;
int scm_gc_cell_yield_percentage =0;
static unsigned long scm_gc_mark_time_taken = 0;
static unsigned long scm_gc_times = 0;
static int scm_gc_cell_yield_percentage = 0;
static unsigned long protected_obj_count = 0;
/* The following are accessed from `gc-malloc.c' and `gc-card.c'. */
int scm_gc_malloc_yield_percentage = 0;
static unsigned long protected_obj_count = 0;
@ -862,6 +864,44 @@ scm_init_gc ()
#include "libguile/gc.x"
}
#ifdef __ia64__
# ifdef __hpux
# include <sys/param.h>
# include <sys/pstat.h>
void *
scm_ia64_register_backing_store_base (void)
{
struct pst_vm_status vm_status;
int i = 0;
while (pstat_getprocvm (&vm_status, sizeof (vm_status), 0, i++) == 1)
if (vm_status.pst_type == PS_RSESTACK)
return (void *) vm_status.pst_vaddr;
abort ();
}
void *
scm_ia64_ar_bsp (const void *ctx)
{
uint64_t bsp;
__uc_get_ar_bsp(ctx, &bsp);
return (void *) bsp;
}
# endif /* hpux */
# ifdef linux
# include <ucontext.h>
void *
scm_ia64_register_backing_store_base (void)
{
extern void *__libc_ia64_register_backing_store_base;
return __libc_ia64_register_backing_store_base;
}
void *
scm_ia64_ar_bsp (const void *opaque)
{
ucontext_t *ctx = opaque;
return (void *) ctx->uc_mcontext.sc_ar_bsp;
}
# endif /* linux */
#endif /* __ia64__ */
void
scm_gc_sweep (void)

9
libguile/gc.h
View file

@ -139,6 +139,11 @@ SCM_API scm_i_pthread_mutex_t scm_i_gc_admin_mutex;
#define scm_gc_running_p (SCM_I_CURRENT_THREAD->gc_running_p)
SCM_API scm_i_pthread_mutex_t scm_i_sweep_mutex;
#ifdef __ia64__
void *scm_ia64_register_backing_store_base (void);
void *scm_ia64_ar_bsp (const void *);
#endif
#if (SCM_ENABLE_DEPRECATED == 1)
@ -165,13 +170,9 @@ SCM_API scm_i_pthread_key_t scm_i_freelist2;
SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist;
SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2;
SCM_API unsigned long scm_gc_cells_swept;
SCM_API unsigned long scm_gc_cells_collected;
SCM_API unsigned long scm_gc_malloc_collected;
SCM_API unsigned long scm_gc_ports_collected;
SCM_API unsigned long scm_cells_allocated;
SCM_API int scm_gc_cell_yield_percentage;
SCM_API int scm_gc_malloc_yield_percentage;
SCM_API unsigned long scm_mallocated;
SCM_API unsigned long scm_mtrigger;

4
libguile/gen-scmconfig.c
View file

@ -378,6 +378,10 @@ main (int argc, char *argv[])
pf ("#define SCM_USE_NULL_THREADS %d /* 0 or 1 */\n",
SCM_I_GSC_USE_NULL_THREADS);
pf ("/* Define to 1 if need braces around PTHREAD_ONCE_INIT (for Solaris). */\n");
pf ("#define SCM_NEED_BRACES_ON_PTHREAD_ONCE_INIT %d /* 0 or 1 */\n",
SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT);
#if USE_DLL_IMPORT
pf ("\n");
pf ("/* Define some additional CPP macros on Win32 platforms. */\n");

1
libguile/gen-scmconfig.h.in
View file

@ -28,6 +28,7 @@
#define SCM_I_GSC_T_PTRDIFF @SCM_I_GSC_T_PTRDIFF@
#define SCM_I_GSC_USE_PTHREAD_THREADS @SCM_I_GSC_USE_PTHREAD_THREADS@
#define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@
#define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT@
/*
Local Variables:

331
libguile/gettext.c Normal file
View file

@ -0,0 +1,331 @@
/* Copyright (C) 2004, 2006 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 2.1 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#if HAVE_CONFIG_H
# include <config.h>
#endif
#include "libguile/_scm.h"
#include "libguile/feature.h"
#include "libguile/strings.h"
#include "libguile/dynwind.h"
#include "libguile/gettext.h"
#include "libgettext.h"
#include <locale.h>
int
scm_i_to_lc_category (SCM category, int allow_lc_all)
{
int c_category = scm_to_int (category);
switch (c_category)
{
#ifdef LC_CTYPE
case LC_CTYPE:
#endif
#ifdef LC_NUMERIC
case LC_NUMERIC:
#endif
#ifdef LC_COLLATE
case LC_COLLATE:
#endif
#ifdef LC_TIME
case LC_TIME:
#endif
#ifdef LC_MONETARY
case LC_MONETARY:
#endif
#ifdef LC_MESSAGES
case LC_MESSAGES:
#endif
#ifdef LC_PAPER
case LC_PAPER:
#endif
#ifdef LC_NAME
case LC_NAME:
#endif
#ifdef LC_ADDRESS
case LC_ADDRESS:
#endif
#ifdef LC_TELEPHONE
case LC_TELEPHONE:
#endif
#ifdef LC_MEASUREMENT
case LC_MEASUREMENT:
#endif
#ifdef LC_IDENTIFICATION
case LC_IDENTIFICATION:
#endif
return c_category;
#ifdef LC_ALL
case LC_ALL:
if (allow_lc_all)
return c_category;
#endif
}
scm_wrong_type_arg (0, 0, category);
}
SCM_DEFINE (scm_gettext, "gettext", 1, 2, 0,
(SCM msgid, SCM domain, SCM category),
"Return the translation of @var{msgid} in the message domain "
"@var{domain}. @var{domain} is optional and defaults to the "
"domain set through (textdomain). @var{category} is optional "
"and defaults to LC_MESSAGES.")
#define FUNC_NAME s_scm_gettext
{
char *c_msgid;
char const *c_result;
SCM result;
scm_dynwind_begin (0);
c_msgid = scm_to_locale_string (msgid);
scm_dynwind_free (c_msgid);
if (SCM_UNBNDP (domain))
{
/* 1 argument case. */
c_result = gettext (c_msgid);
}
else
{
char *c_domain;
c_domain = scm_to_locale_string (domain);
scm_dynwind_free (c_domain);
if (SCM_UNBNDP (category))
{
/* 2 argument case. */
c_result = dgettext (c_domain, c_msgid);
}
else
{
/* 3 argument case. */
int c_category;
c_category = scm_i_to_lc_category (category, 0);
c_result = dcgettext (c_domain, c_msgid, c_category);
}
}
if (c_result == c_msgid)
result = msgid;
else
result = scm_from_locale_string (c_result);
scm_dynwind_end ();
return result;
}
#undef FUNC_NAME
SCM_DEFINE (scm_ngettext, "ngettext", 3, 2, 0,
(SCM msgid, SCM msgid_plural, SCM n, SCM domain, SCM category),
"Return the translation of @var{msgid}/@var{msgid_plural} in the "
"message domain @var{domain}, with the plural form being chosen "
"appropriately for the number @var{n}. @var{domain} is optional "
"and defaults to the domain set through (textdomain). "
"@var{category} is optional and defaults to LC_MESSAGES.")
#define FUNC_NAME s_scm_ngettext
{
char *c_msgid;
char *c_msgid_plural;
unsigned long c_n;
const char *c_result;
SCM result;
scm_dynwind_begin (0);
c_msgid = scm_to_locale_string (msgid);
scm_dynwind_free (c_msgid);
c_msgid_plural = scm_to_locale_string (msgid_plural);
scm_dynwind_free (c_msgid_plural);
c_n = scm_to_ulong (n);
if (SCM_UNBNDP (domain))
{
/* 3 argument case. */
c_result = ngettext (c_msgid, c_msgid_plural, c_n);
}
else
{
char *c_domain;
c_domain = scm_to_locale_string (domain);
scm_dynwind_free (c_domain);
if (SCM_UNBNDP (category))
{
/* 4 argument case. */
c_result = dngettext (c_domain, c_msgid, c_msgid_plural, c_n);
}
else
{
/* 5 argument case. */
int c_category;
c_category = scm_i_to_lc_category (category, 0);
c_result = dcngettext (c_domain, c_msgid, c_msgid_plural, c_n,
c_category);
}
}
if (c_result == c_msgid)
result = msgid;
else if (c_result == c_msgid_plural)
result = msgid_plural;
else
result = scm_from_locale_string (c_result);
scm_dynwind_end ();
return result;
}
#undef FUNC_NAME
SCM_DEFINE (scm_textdomain, "textdomain", 0, 1, 0,
(SCM domainname),
"If optional parameter @var{domainname} is supplied, "
"set the textdomain. "
"Return the textdomain.")
#define FUNC_NAME s_scm_textdomain
{
char const *c_result;
char *c_domain;
SCM result = SCM_BOOL_F;
scm_dynwind_begin (0);
if (SCM_UNBNDP (domainname))
c_domain = NULL;
else
{
c_domain = scm_to_locale_string (domainname);
scm_dynwind_free (c_domain);
}
c_result = textdomain (c_domain);
if (c_result != NULL)
result = scm_from_locale_string (c_result);
else if (!SCM_UNBNDP (domainname))
SCM_SYSERROR;
scm_dynwind_end ();
return result;
}
#undef FUNC_NAME
SCM_DEFINE (scm_bindtextdomain, "bindtextdomain", 1, 1, 0,
(SCM domainname, SCM directory),
"If optional parameter @var{directory} is supplied, "
"set message catalogs to directory @var{directory}. "
"Return the directory bound to @var{domainname}.")
#define FUNC_NAME s_scm_bindtextdomain
{
char *c_domain;
char *c_directory;
char const *c_result;
SCM result;
scm_dynwind_begin (0);
if (SCM_UNBNDP (directory))
c_directory = NULL;
else
{
c_directory = scm_to_locale_string (directory);
scm_dynwind_free (c_directory);
}
c_domain = scm_to_locale_string (domainname);
scm_dynwind_free (c_domain);
c_result = bindtextdomain (c_domain, c_directory);
if (c_result != NULL)
result = scm_from_locale_string (c_result);
else if (!SCM_UNBNDP (directory))
SCM_SYSERROR;
else
result = SCM_BOOL_F;
scm_dynwind_end ();
return result;
}
#undef FUNC_NAME
SCM_DEFINE (scm_bind_textdomain_codeset, "bind-textdomain-codeset", 1, 1, 0,
(SCM domainname, SCM encoding),
"If optional parameter @var{encoding} is supplied, "
"set encoding for message catalogs of @var{domainname}. "
"Return the encoding of @var{domainname}.")
#define FUNC_NAME s_scm_bind_textdomain_codeset
{
char *c_domain;
char *c_encoding;
char const *c_result;
SCM result;
scm_dynwind_begin (0);
if (SCM_UNBNDP (encoding))
c_encoding = NULL;
else
{
c_encoding = scm_to_locale_string (encoding);
scm_dynwind_free (c_encoding);
}
c_domain = scm_to_locale_string (domainname);
scm_dynwind_free (c_domain);
c_result = bind_textdomain_codeset (c_domain, c_encoding);
if (c_result != NULL)
result = scm_from_locale_string (c_result);
else if (!SCM_UNBNDP (encoding))
SCM_SYSERROR;
else
result = SCM_BOOL_F;
scm_dynwind_end ();
return result;
}
#undef FUNC_NAME
void
scm_init_gettext ()
{
/* When gettext support was first added (in 1.8.0), it provided feature
`i18n'. We keep this as is although the name is a bit misleading
now. */
scm_add_feature ("i18n");
#include "libguile/gettext.x"
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/

94
libguile/gettext.h
View file

@ -1,69 +1,41 @@
/* Convenience header for conditional use of GNU <libintl.h>.
Copyright (C) 1995-1998, 2000-2002, 2006 Free Software Foundation, Inc.
/* classes: h_files */
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2, or (at your option)
any later version.
#ifndef SCM_GETTEXT_H
#define SCM_GETTEXT_H
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
/* Copyright (C) 2004, 2006 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 2.1 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
You should have received a copy of the GNU Library General Public
License along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
USA. */
#include "libguile/__scm.h"
#ifndef _LIBGETTEXT_H
#define _LIBGETTEXT_H 1
SCM_API SCM scm_gettext (SCM msgid, SCM domainname, SCM category);
SCM_API SCM scm_ngettext (SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category);
SCM_API SCM scm_textdomain (SCM domainname);
SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory);
SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding);
/* NLS can be disabled through the configure --disable-nls option. */
#if ENABLE_NLS
SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all);
/* Get declarations of GNU message catalog functions. */
# include <libintl.h>
SCM_API void scm_init_gettext (void);
#else
#endif /* SCM_GETTEXT_H */
/* Solaris /usr/include/locale.h includes /usr/include/libintl.h, which
chokes if dcgettext is defined as a macro. So include it now, to make
later inclusions of <locale.h> a NOP. We don't include <libintl.h>
as well because people using "gettext.h" will not include <libintl.h>,
and also including <libintl.h> would fail on SunOS 4, whereas <locale.h>
is OK. */
#if defined(__sun)
# include <locale.h>
#endif
/* Disabled NLS.
The casts to 'const char *' serve the purpose of producing warnings
for invalid uses of the value returned from these functions.
On pre-ANSI systems without 'const', the config.h file is supposed to
contain "#define const". */
# define gettext(Msgid) ((const char *) (Msgid))
# define dgettext(Domainname, Msgid) ((const char *) (Msgid))
# define dcgettext(Domainname, Msgid, Category) ((const char *) (Msgid))
# define ngettext(Msgid1, Msgid2, N) \
((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
# define dngettext(Domainname, Msgid1, Msgid2, N) \
((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
# define dcngettext(Domainname, Msgid1, Msgid2, N, Category) \
((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
# define textdomain(Domainname) ((const char *) (Domainname))
# define bindtextdomain(Domainname, Dirname) ((const char *) (Dirname))
# define bind_textdomain_codeset(Domainname, Codeset) ((const char *) (Codeset))
#endif
/* A pseudo function call that serves as a marker for the automated
extraction of messages, but does not call gettext(). The run-time
translation is done at a different place in the code.
The argument, String, should be a literal string. Concatenated strings
and other string expressions won't work.
The macro's expansion is not parenthesized, so that it is suitable as
initializer for static 'char[]' or 'const char[]' variables. */
#define gettext_noop(String) String
#endif /* _LIBGETTEXT_H */
/*
Local Variables:
c-file-style: "gnu"
End:
*/

1300
libguile/i18n.c
View file

File diff suppressed because it is too large Load diff

27
libguile/i18n.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_I18N_H
#define SCM_I18N_H
/* Copyright (C) 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 2006 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
@ -22,13 +22,24 @@
#include "libguile/__scm.h"
SCM_API SCM scm_gettext (SCM msgid, SCM domainname, SCM category);
SCM_API SCM scm_ngettext (SCM msgid, SCM msgid_plural, SCM n, SCM domainname, SCM category);
SCM_API SCM scm_textdomain (SCM domainname);
SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory);
SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding);
SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all);
SCM_API SCM scm_make_locale (SCM category_mask, SCM locale_name, SCM base_locale);
SCM_API SCM scm_locale_p (SCM obj);
SCM_API SCM scm_string_locale_lt (SCM s1, SCM s2, SCM locale);
SCM_API SCM scm_string_locale_gt (SCM s1, SCM s2, SCM locale);
SCM_API SCM scm_string_locale_ci_lt (SCM s1, SCM s2, SCM locale);
SCM_API SCM scm_string_locale_ci_gt (SCM s1, SCM s2, SCM locale);
SCM_API SCM scm_string_locale_ci_eq (SCM s1, SCM s2, SCM locale);
SCM_API SCM scm_char_locale_lt (SCM c1, SCM c2, SCM locale);
SCM_API SCM scm_char_locale_gt (SCM c1, SCM c2, SCM locale);
SCM_API SCM scm_char_locale_ci_lt (SCM c1, SCM c2, SCM locale);
SCM_API SCM scm_char_locale_ci_gt (SCM c1, SCM c2, SCM locale);
SCM_API SCM scm_char_locale_ci_eq (SCM c1, SCM c2, SCM locale);
SCM_API SCM scm_char_locale_upcase (SCM chr, SCM locale);
SCM_API SCM scm_char_locale_downcase (SCM chr, SCM locale);
SCM_API SCM scm_string_locale_upcase (SCM chr, SCM locale);
SCM_API SCM scm_string_locale_downcase (SCM chr, SCM locale);
SCM_API SCM scm_locale_string_to_integer (SCM str, SCM base, SCM locale);
SCM_API SCM scm_locale_string_to_inexact (SCM str, SCM locale);
SCM_API void scm_init_i18n (void);

10
libguile/init.c
View file

@ -46,7 +46,9 @@
#include "libguile/deprecation.h"
#include "libguile/dynl.h"
#include "libguile/dynwind.h"
#if 0
#include "libguile/environments.h"
#endif
#include "libguile/eq.h"
#include "libguile/error.h"
#include "libguile/eval.h"
@ -63,7 +65,7 @@
#include "libguile/hash.h"
#include "libguile/hashtab.h"
#include "libguile/hooks.h"
#include "libguile/i18n.h"
#include "libguile/gettext.h"
#include "libguile/iselect.h"
#include "libguile/ioext.h"
#include "libguile/keywords.h"
@ -436,7 +438,9 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_struct_prehistory (); /* requires storage */
scm_symbols_prehistory (); /* requires storage */
scm_init_subr_table ();
#if 0
scm_environments_prehistory (); /* requires storage */
#endif
scm_modules_prehistory (); /* requires storage and hash tables */
scm_init_variable (); /* all bindings need variables */
scm_init_continuations ();
@ -445,7 +449,9 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_gsubr ();
scm_init_thread_procs (); /* requires gsubrs */
scm_init_procprop ();
#if 0
scm_init_environments ();
#endif
scm_init_alist ();
scm_init_arbiters ();
scm_init_async ();
@ -475,7 +481,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_properties ();
scm_init_hooks (); /* Requires smob_prehistory */
scm_init_gc (); /* Requires hooks, async */
scm_init_i18n ();
scm_init_gettext ();
scm_init_ioext ();
scm_init_keywords ();
scm_init_list ();

69
libguile/libgettext.h Normal file
View file

@ -0,0 +1,69 @@
/* Convenience header for conditional use of GNU <libintl.h>.
Copyright (C) 1995-1998, 2000-2002, 2006 Free Software Foundation, Inc.
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published
by the Free Software Foundation; either version 2, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
USA. */
#ifndef _LIBGETTEXT_H
#define _LIBGETTEXT_H 1
/* NLS can be disabled through the configure --disable-nls option. */
#if ENABLE_NLS
/* Get declarations of GNU message catalog functions. */
# include <libintl.h>
#else
/* Solaris /usr/include/locale.h includes /usr/include/libintl.h, which
chokes if dcgettext is defined as a macro. So include it now, to make
later inclusions of <locale.h> a NOP. We don't include <libintl.h>
as well because people using "gettext.h" will not include <libintl.h>,
and also including <libintl.h> would fail on SunOS 4, whereas <locale.h>
is OK. */
#if defined(__sun)
# include <locale.h>
#endif
/* Disabled NLS.
The casts to 'const char *' serve the purpose of producing warnings
for invalid uses of the value returned from these functions.
On pre-ANSI systems without 'const', the config.h file is supposed to
contain "#define const". */
# define gettext(Msgid) ((const char *) (Msgid))
# define dgettext(Domainname, Msgid) ((const char *) (Msgid))
# define dcgettext(Domainname, Msgid, Category) ((const char *) (Msgid))
# define ngettext(Msgid1, Msgid2, N) \
((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
# define dngettext(Domainname, Msgid1, Msgid2, N) \
((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
# define dcngettext(Domainname, Msgid1, Msgid2, N, Category) \
((N) == 1 ? (const char *) (Msgid1) : (const char *) (Msgid2))
# define textdomain(Domainname) ((const char *) (Domainname))
# define bindtextdomain(Domainname, Dirname) ((const char *) (Dirname))
# define bind_textdomain_codeset(Domainname, Codeset) ((const char *) (Codeset))
#endif
/* A pseudo function call that serves as a marker for the automated
extraction of messages, but does not call gettext(). The run-time
translation is done at a different place in the code.
The argument, String, should be a literal string. Concatenated strings
and other string expressions won't work.
The macro's expansion is not parenthesized, so that it is suitable as
initializer for static 'char[]' or 'const char[]' variables. */
#define gettext_noop(String) String
#endif /* _LIBGETTEXT_H */

47
libguile/locale-categories.h Normal file
View file

@ -0,0 +1,47 @@
/* Copyright (C) 2006 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 2.1 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/* A list of all available locale categories, not including `ALL'. */
/* The six standard categories, as defined in IEEE Std 1003.1-2001. */
SCM_DEFINE_LOCALE_CATEGORY (COLLATE)
SCM_DEFINE_LOCALE_CATEGORY (CTYPE)
SCM_DEFINE_LOCALE_CATEGORY (MESSAGES)
SCM_DEFINE_LOCALE_CATEGORY (MONETARY)
SCM_DEFINE_LOCALE_CATEGORY (NUMERIC)
SCM_DEFINE_LOCALE_CATEGORY (TIME)
/* Additional non-standard categories. */
#ifdef LC_PAPER
SCM_DEFINE_LOCALE_CATEGORY (PAPER)
#endif
#ifdef LC_NAME
SCM_DEFINE_LOCALE_CATEGORY (NAME)
#endif
#ifdef LC_ADDRESS
SCM_DEFINE_LOCALE_CATEGORY (ADDRESS)
#endif
#ifdef LC_TELEPHONE
SCM_DEFINE_LOCALE_CATEGORY (TELEPHONE)
#endif
#ifdef LC_MEASUREMENT
SCM_DEFINE_LOCALE_CATEGORY (MEASUREMENT)
#endif
#ifdef LC_IDENTIFICATION
SCM_DEFINE_LOCALE_CATEGORY (IDENTIFICATION)
#endif

5
libguile/modules.c
View file

@ -273,8 +273,9 @@ SCM_DEFINE (scm_env_module, "env-module", 1, 0, 0,
/*
* C level implementation of the standard eval closure
*
* This increases loading speed substantially.
* The code will be replaced by the low-level environments in next release.
* This increases loading speed substantially. The code may be
* replaced by something based on environments.[ch], in a future
* release.
*/
static SCM module_make_local_var_x_var;

165
libguile/numbers.c
View file

@ -40,7 +40,7 @@
*/
/* tell glibc (2.3) to give prototype for C99 trunc() */
/* tell glibc (2.3) to give prototype for C99 trunc(), csqrt(), etc */
#define _GNU_SOURCE
#if HAVE_CONFIG_H
@ -51,6 +51,10 @@
#include <ctype.h>
#include <string.h>
#if HAVE_COMPLEX_H
#include <complex.h>
#endif
#include "libguile/_scm.h"
#include "libguile/feature.h"
#include "libguile/ports.h"
@ -66,6 +70,14 @@
#include "libguile/discouraged.h"
/* values per glibc, if not already defined */
#ifndef M_LOG10E
#define M_LOG10E 0.43429448190325182765
#endif
#ifndef M_PI
#define M_PI 3.14159265358979323846
#endif
/*
@ -150,6 +162,21 @@ xisnan (double x)
#endif
}
/* For an SCM object Z which is a complex number (ie. satisfies
SCM_COMPLEXP), return its value as a C level "complex double". */
#define SCM_COMPLEX_VALUE(z) \
(SCM_COMPLEX_REAL (z) + _Complex_I * SCM_COMPLEX_IMAG (z))
/* Convert a C "complex double" to an SCM value. */
#if HAVE_COMPLEX_DOUBLE
static SCM
scm_from_complex_double (complex double z)
{
return scm_c_make_rectangular (creal (z), cimag (z));
}
#endif /* HAVE_COMPLEX_DOUBLE */
static mpz_t z_negative_one;
@ -5978,6 +6005,142 @@ scm_is_number (SCM z)
return scm_is_true (scm_number_p (z));
}
/* In the following functions we dispatch to the real-arg funcs like log()
when we know the arg is real, instead of just handing everything to
clog() for instance. This is in case clog() doesn't optimize for a
real-only case, and because we have to test SCM_COMPLEXP anyway so may as
well use it to go straight to the applicable C func. */
SCM_DEFINE (scm_log, "log", 1, 0, 0,
(SCM z),
"Return the natural logarithm of @var{z}.")
#define FUNC_NAME s_scm_log
{
if (SCM_COMPLEXP (z))
{
#if HAVE_COMPLEX_DOUBLE
return scm_from_complex_double (clog (SCM_COMPLEX_VALUE (z)));
#else
double re = SCM_COMPLEX_REAL (z);
double im = SCM_COMPLEX_IMAG (z);
return scm_c_make_rectangular (log (hypot (re, im)),
atan2 (im, re));
#endif
}
else
{
/* ENHANCE-ME: When z is a bignum the logarithm will fit a double
although the value itself overflows. */
double re = scm_to_double (z);
double l = log (fabs (re));
if (re >= 0.0)
return scm_from_double (l);
else
return scm_c_make_rectangular (l, M_PI);
}
}
#undef FUNC_NAME
SCM_DEFINE (scm_log10, "log10", 1, 0, 0,
(SCM z),
"Return the base 10 logarithm of @var{z}.")
#define FUNC_NAME s_scm_log10
{
if (SCM_COMPLEXP (z))
{
/* Mingw has clog() but not clog10(). (Maybe it'd be worth using
clog() and a multiply by M_LOG10E, rather than the fallback
log10+hypot+atan2.) */
#if HAVE_COMPLEX_DOUBLE && HAVE_CLOG10
return scm_from_complex_double (clog10 (SCM_COMPLEX_VALUE (z)));
#else
double re = SCM_COMPLEX_REAL (z);
double im = SCM_COMPLEX_IMAG (z);
return scm_c_make_rectangular (log10 (hypot (re, im)),
M_LOG10E * atan2 (im, re));
#endif
}
else
{
/* ENHANCE-ME: When z is a bignum the logarithm will fit a double
although the value itself overflows. */
double re = scm_to_double (z);
double l = log10 (fabs (re));
if (re >= 0.0)
return scm_from_double (l);
else
return scm_c_make_rectangular (l, M_LOG10E * M_PI);
}
}
#undef FUNC_NAME
SCM_DEFINE (scm_exp, "exp", 1, 0, 0,
(SCM z),
"Return @math{e} to the power of @var{z}, where @math{e} is the\n"
"base of natural logarithms (2.71828@dots{}).")
#define FUNC_NAME s_scm_exp
{
if (SCM_COMPLEXP (z))
{
#if HAVE_COMPLEX_DOUBLE
return scm_from_complex_double (cexp (SCM_COMPLEX_VALUE (z)));
#else
return scm_c_make_polar (exp (SCM_COMPLEX_REAL (z)),
SCM_COMPLEX_IMAG (z));
#endif
}
else
{
/* When z is a negative bignum the conversion to double overflows,
giving -infinity, but that's ok, the exp is still 0.0. */
return scm_from_double (exp (scm_to_double (z)));
}
}
#undef FUNC_NAME
SCM_DEFINE (scm_sqrt, "sqrt", 1, 0, 0,
(SCM x),
"Return the square root of @var{z}. Of the two possible roots\n"
"(positive and negative), the one with the a positive real part\n"
"is returned, or if that's zero then a positive imaginary part.\n"
"Thus,\n"
"\n"
"@example\n"
"(sqrt 9.0) @result{} 3.0\n"
"(sqrt -9.0) @result{} 0.0+3.0i\n"
"(sqrt 1.0+1.0i) @result{} 1.09868411346781+0.455089860562227i\n"
"(sqrt -1.0-1.0i) @result{} 0.455089860562227-1.09868411346781i\n"
"@end example")
#define FUNC_NAME s_scm_sqrt
{
if (SCM_COMPLEXP (x))
{
#if HAVE_COMPLEX_DOUBLE && HAVE_USABLE_CSQRT
return scm_from_complex_double (csqrt (SCM_COMPLEX_VALUE (x)));
#else
double re = SCM_COMPLEX_REAL (x);
double im = SCM_COMPLEX_IMAG (x);
return scm_c_make_polar (sqrt (hypot (re, im)),
0.5 * atan2 (im, re));
#endif
}
else
{
double xx = scm_to_double (x);
if (xx < 0)
return scm_c_make_rectangular (0.0, sqrt (-xx));
else
return scm_from_double (sqrt (xx));
}
}
#undef FUNC_NAME
void
scm_init_numbers ()
{

4
libguile/numbers.h
View file

@ -263,6 +263,10 @@ SCM_API SCM scm_angle (SCM z);
SCM_API SCM scm_exact_to_inexact (SCM z);
SCM_API SCM scm_inexact_to_exact (SCM z);
SCM_API SCM scm_trunc (SCM x);
SCM_API SCM scm_log (SCM z);
SCM_API SCM scm_log10 (SCM z);
SCM_API SCM scm_exp (SCM z);
SCM_API SCM scm_sqrt (SCM z);
/* bignum internal functions */
SCM_API SCM scm_i_mkbig (void);

74
libguile/ports.c
View file

@ -27,12 +27,14 @@
#include <stdio.h>
#include <errno.h>
#include <fcntl.h> /* for chsize on mingw */
#include <assert.h>
#include "libguile/_scm.h"
#include "libguile/async.h"
#include "libguile/eval.h"
#include "libguile/fports.h" /* direct access for seek and truncate */
#include "libguile/objects.h"
#include "libguile/goops.h"
#include "libguile/smob.h"
@ -64,9 +66,17 @@
#include <sys/ioctl.h>
#endif
#ifdef __MINGW32__
#include <fcntl.h>
/* Mingw (version 3.4.5, circa 2006) has ftruncate as an alias for chsize
already, but have this code here in case that wasn't so in past versions,
or perhaps to help other minimal DOS environments.
gnulib ftruncate.c has code using fcntl F_CHSIZE and F_FREESP, which
might be possibilities if we've got other systems without ftruncate. */
#if HAVE_CHSIZE && ! HAVE_FTRUNCATE
#define ftruncate(fd, size) chsize (fd, size)
#undef HAVE_FTRUNCATE
#define HAVE_FTRUNCATE 1
#endif
@ -1456,7 +1466,12 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
if (how != SEEK_SET && how != SEEK_CUR && how != SEEK_END)
SCM_OUT_OF_RANGE (3, whence);
if (SCM_OPPORTP (fd_port))
if (SCM_OPFPORTP (fd_port))
{
/* go direct to fport code to allow 64-bit offsets */
return scm_i_fport_seek (fd_port, offset, how);
}
else if (SCM_OPPORTP (fd_port))
{
scm_t_ptob_descriptor *ptob = scm_ptobs + SCM_PTOBNUM (fd_port);
off_t off = scm_to_off_t (offset);
@ -1481,28 +1496,48 @@ SCM_DEFINE (scm_seek, "seek", 3, 0, 0,
}
#undef FUNC_NAME
#ifdef __MINGW32__
/* Define this function since it is not supported under Windows. */
static int truncate (char *file, int length)
#ifndef O_BINARY
#define O_BINARY 0
#endif
/* Mingw has ftruncate(), perhaps implemented above using chsize, but
doesn't have the filename version truncate(), hence this code. */
#if HAVE_FTRUNCATE && ! HAVE_TRUNCATE
static int
truncate (const char *file, off_t length)
{
int ret = -1, fdes;
if ((fdes = open (file, O_BINARY | O_WRONLY)) != -1)
int ret, fdes;
fdes = open (file, O_BINARY | O_WRONLY);
if (fdes == -1)
return -1;
ret = ftruncate (fdes, length);
if (ret == -1)
{
ret = chsize (fdes, length);
int save_errno = errno;
close (fdes);
errno = save_errno;
return -1;
}
return ret;
return close (fdes);
}
#endif /* __MINGW32__ */
#endif /* HAVE_FTRUNCATE && ! HAVE_TRUNCATE */
SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
(SCM object, SCM length),
"Truncates the object referred to by @var{object} to at most\n"
"@var{length} bytes. @var{object} can be a string containing a\n"
"file name or an integer file descriptor or a port.\n"
"@var{length} may be omitted if @var{object} is not a file name,\n"
"in which case the truncation occurs at the current port\n"
"position. The return value is unspecified.")
"Truncate @var{file} to @var{length} bytes. @var{file} can be a\n"
"filename string, a port object, or an integer file descriptor.\n"
"The return value is unspecified.\n"
"\n"
"For a port or file descriptor @var{length} can be omitted, in\n"
"which case the file is truncated at the current position (per\n"
"@code{ftell} above).\n"
"\n"
"On most systems a file can be extended by giving a length\n"
"greater than the current size, but this is not mandatory in the\n"
"POSIX standard.")
#define FUNC_NAME s_scm_truncate_file
{
int rv;
@ -1529,6 +1564,11 @@ SCM_DEFINE (scm_truncate_file, "truncate-file", 1, 1, 0,
SCM_SYSCALL (rv = ftruncate_or_ftruncate64 (scm_to_int (object),
c_length));
}
else if (SCM_OPOUTFPORTP (object))
{
/* go direct to fport code to allow 64-bit offsets */
rv = scm_i_fport_truncate (object, length);
}
else if (SCM_OPOUTPORTP (object))
{
off_t c_length = scm_to_off_t (length);

59
libguile/posix.c
View file

@ -40,7 +40,7 @@
#include "libguile/validate.h"
#include "libguile/posix.h"
#include "libguile/i18n.h"
#include "libguile/gettext.h"
#include "libguile/threads.h"
@ -115,6 +115,10 @@ extern char ** environ;
#include <locale.h>
#endif
#if (defined HAVE_NEWLOCALE) && (defined HAVE_STRCOLL_L)
# define USE_GNU_LOCALE_API
#endif
#if HAVE_CRYPT_H
# include <crypt.h>
#endif
@ -157,6 +161,12 @@ extern char ** environ;
#define F_OK 0
#endif
/* No prototype for this on Solaris 10. The man page says it's in
<unistd.h> ... but it lies. */
#if ! HAVE_DECL_SETHOSTNAME
int sethostname (char *name, size_t namelen);
#endif
/* On NextStep, <utime.h> doesn't define struct utime, unless we
#define _POSIX_SOURCE before #including it. I think this is less
of a kludge than defining struct utimbuf ourselves. */
@ -943,7 +953,12 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
SCM_F_WIND_EXPLICITLY);
execv (exec_file, exec_argv);
execv (exec_file,
#ifdef __MINGW32__
/* extra "const" in mingw formals, provokes warning from gcc */
(const char * const *)
#endif
exec_argv);
SCM_SYSERROR;
/* not reached. */
@ -974,7 +989,12 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1,
scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
SCM_F_WIND_EXPLICITLY);
execvp (exec_file, exec_argv);
execvp (exec_file,
#ifdef __MINGW32__
/* extra "const" in mingw formals, provokes warning from gcc */
(const char * const *)
#endif
exec_argv);
SCM_SYSERROR;
/* not reached. */
@ -1013,7 +1033,17 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1,
scm_dynwind_unwind_handler (free_string_pointers, exec_env,
SCM_F_WIND_EXPLICITLY);
execve (exec_file, exec_argv, exec_env);
execve (exec_file,
#ifdef __MINGW32__
/* extra "const" in mingw formals, provokes warning from gcc */
(const char * const *)
#endif
exec_argv,
#ifdef __MINGW32__
/* extra "const" in mingw formals, provokes warning from gcc */
(const char * const *)
#endif
exec_env);
SCM_SYSERROR;
/* not reached. */
@ -1354,7 +1384,15 @@ SCM_DEFINE (scm_putenv, "putenv", 1, 0, 0,
}
#undef FUNC_NAME
#ifndef USE_GNU_LOCALE_API
/* This mutex is used to serialize invocations of `setlocale ()' on non-GNU
systems (i.e., systems where a reentrant locale API is not available).
See `i18n.c' for details. */
scm_i_pthread_mutex_t scm_i_locale_mutex;
#endif
#ifdef HAVE_SETLOCALE
SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
(SCM category, SCM locale),
"If @var{locale} is omitted, return the current value of the\n"
@ -1383,7 +1421,14 @@ SCM_DEFINE (scm_setlocale, "setlocale", 1, 1, 0,
scm_dynwind_free (clocale);
}
#ifndef USE_GNU_LOCALE_API
scm_i_pthread_mutex_lock (&scm_i_locale_mutex);
#endif
rv = setlocale (scm_i_to_lc_category (category, 1), clocale);
#ifndef USE_GNU_LOCALE_API
scm_i_pthread_mutex_unlock (&scm_i_locale_mutex);
#endif
if (rv == NULL)
{
/* POSIX and C99 don't say anything about setlocale setting errno, so
@ -1917,9 +1962,13 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
#endif /* HAVE_GETHOSTNAME */
void
void
scm_init_posix ()
{
#ifndef USE_GNU_LOCALE_API
scm_i_pthread_mutex_init (&scm_i_locale_mutex, NULL);
#endif
scm_add_feature ("posix");
#ifdef HAVE_GETEUID
scm_add_feature ("EIDs");

5
libguile/posix.h
View file

@ -23,8 +23,7 @@
#include "libguile/__scm.h"
#include "libguile/threads.h"
@ -87,6 +86,8 @@ SCM_API SCM scm_sethostname (SCM name);
SCM_API SCM scm_gethostname (void);
SCM_API void scm_init_posix (void);
SCM_API scm_i_pthread_mutex_t scm_i_locale_mutex;
#endif /* SCM_POSIX_H */
/*

6
libguile/pthread-threads.h
View file

@ -69,8 +69,12 @@ extern pthread_mutexattr_t scm_i_pthread_mutexattr_recursive[1];
/* Onces
*/
#define scm_i_pthread_once_t pthread_once_t
#define SCM_I_PTHREAD_ONCE_INIT PTHREAD_ONCE_INIT
#define scm_i_pthread_once pthread_once
#if SCM_NEED_BRACES_ON_PTHREAD_ONCE_INIT
#define SCM_I_PTHREAD_ONCE_INIT { PTHREAD_ONCE_INIT }
#else
#define SCM_I_PTHREAD_ONCE_INIT PTHREAD_ONCE_INIT
#endif
/* Thread specific storage
*/

4
libguile/script.c
View file

@ -381,7 +381,9 @@ scm_shell_usage (int fatal, char *message)
" -v, --version display version information and exit\n"
" \\ read arguments from following script lines\n"
"\n"
"Please report bugs to bug-guile@gnu.org\n",
"Please report bugs to bug-guile@gnu.org. (Note that you must\n"
"be subscribed to this list first, in order to successfully send\n"
"a report to it).\n",
scm_usage_name);
if (fatal)

58
libguile/socket.c
View file

@ -98,9 +98,7 @@ SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
"and returned as a new integer.")
#define FUNC_NAME s_scm_htonl
{
scm_t_uint32 c_in = SCM_NUM2ULONG (1, value);
return scm_from_ulong (htonl (c_in));
return scm_from_ulong (htonl (scm_to_uint32 (value)));
}
#undef FUNC_NAME
@ -111,9 +109,7 @@ SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
"and returned as a new integer.")
#define FUNC_NAME s_scm_ntohl
{
scm_t_uint32 c_in = SCM_NUM2ULONG (1, value);
return scm_from_ulong (ntohl (c_in));
return scm_from_ulong (ntohl (scm_to_uint32 (value)));
}
#undef FUNC_NAME
@ -1459,25 +1455,34 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
(SCM sock, SCM str, SCM flags, SCM start, SCM end),
"Return data from the socket port @var{sock} and also\n"
"information about where the data was received from.\n"
"@var{sock} must already be bound to the address from which\n"
"data is to be received. @code{str}, is a string into which the\n"
"data will be written. The size of @var{str} limits the amount\n"
"of data which can be received: in the case of packet protocols,\n"
"if a packet larger than this limit is encountered then some\n"
"data will be irrevocably lost.\n\n"
"The optional @var{flags} argument is a value or bitwise OR of\n"
"@code{MSG_OOB}, @code{MSG_PEEK}, @code{MSG_DONTROUTE} etc.\n\n"
"The value returned is a pair: the @emph{car} is the number of\n"
"bytes read from the socket and the @emph{cdr} an address object\n"
"in the same form as returned by @code{accept}. The address\n"
"will given as @code{#f} if not available, as is usually the\n"
"case for stream sockets.\n\n"
"The @var{start} and @var{end} arguments specify a substring of\n"
"@var{str} to which the data should be written.\n\n"
"Note that the data is read directly from the socket file\n"
"descriptor: any unread buffered port data is ignored.")
"Receive data from socket port @var{sock} (which must be already\n"
"bound), returning the originating address as well as the data.\n"
"This is usually for use on datagram sockets, but can be used on\n"
"stream-oriented sockets too.\n"
"\n"
"The data received is stored in the given @var{str}, using\n"
"either the whole string or just the region between the optional\n"
"@var{start} and @var{end} positions. The size of @var{str}\n"
"limits the amount of data which can be received. For datagram\n"
"protocols, if a packet larger than this is received then excess\n"
"bytes are irrevocably lost.\n"
"\n"
"The return value is a pair. The @code{car} is the number of\n"
"bytes read. The @code{cdr} is a socket address object which is\n"
"where the data come from, or @code{#f} if the origin is\n"
"unknown.\n"
"\n"
"The optional @var{flags} argument is a or bitwise OR\n"
"(@code{logior}) of @code{MSG_OOB}, @code{MSG_PEEK},\n"
"@code{MSG_DONTROUTE} etc.\n"
"\n"
"Data is read directly from the socket file descriptor, any\n"
"buffered port data is ignored.\n"
"\n"
"On a GNU/Linux system @code{recvfrom!} is not multi-threading,\n"
"all threads stop while a @code{recvfrom!} call is in progress.\n"
"An application may need to use @code{select}, @code{O_NONBLOCK}\n"
"or @code{MSG_DONTWAIT} to avoid this.")
#define FUNC_NAME s_scm_recvfrom
{
int rv;
@ -1728,6 +1733,9 @@ scm_init_socket ()
#endif
/* recv/send options. */
#ifdef MSG_DONTWAIT
scm_c_define ("MSG_DONTWAIT", scm_from_int (MSG_DONTWAIT));
#endif
#ifdef MSG_OOB
scm_c_define ("MSG_OOB", scm_from_int (MSG_OOB));
#endif

18
libguile/stime.c
View file

@ -497,8 +497,10 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
lt->tm_wday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 6));
lt->tm_yday = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 7));
lt->tm_isdst = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 8));
#if HAVE_STRUCT_TM_TM_GMTOFF
lt->tm_gmtoff = - scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 9));
#endif
#ifdef HAVE_TM_ZONE
lt->tm_gmtoff = scm_to_int (SCM_SIMPLE_VECTOR_REF (sbd_time, 9));
if (scm_is_false (SCM_SIMPLE_VECTOR_REF (sbd_time, 10)))
lt->tm_zone = NULL;
else
@ -731,6 +733,7 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
{
struct tm t;
const char *fmt, *str, *rest;
long zoff;
SCM_VALIDATE_STRING (1, format);
SCM_VALIDATE_STRING (2, string);
@ -748,6 +751,9 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
tm_init (tm_year);
tm_init (tm_wday);
tm_init (tm_yday);
#if HAVE_STRUCT_TM_TM_GMTOFF
tm_init (tm_gmtoff);
#endif
#undef tm_init
/* GNU glibc strptime() "%s" is affected by the current timezone, since it
@ -766,7 +772,15 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
SCM_SYSERROR;
}
return scm_cons (filltime (&t, 0, NULL),
/* tm_gmtoff is set by GNU glibc strptime "%s", so capture it when
available */
#if HAVE_STRUCT_TM_TM_GMTOFF
zoff = - t.tm_gmtoff; /* seconds west, not east */
#else
zoff = 0;
#endif
return scm_cons (filltime (&t, zoff, NULL),
scm_from_signed_integer (rest - str));
}
#undef FUNC_NAME

14
libguile/threads.c
View file

@ -28,6 +28,11 @@
#endif
#include <stdio.h>
#include <assert.h>
#ifdef HAVE_STRING_H
#include <string.h> /* for memset used by FD_ZERO on Solaris 10 */
#endif
#if HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
@ -558,7 +563,8 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent)
}
#if SCM_USE_PTHREAD_THREADS
#ifdef HAVE_PTHREAD_ATTR_GETSTACK
/* pthread_getattr_np not available on MacOS X and Solaris 10. */
#if HAVE_PTHREAD_ATTR_GETSTACK && HAVE_PTHREAD_GETATTR_NP
#define HAVE_GET_THREAD_STACK_BASE
@ -592,7 +598,7 @@ get_thread_stack_base ()
}
}
#endif /* HAVE_PTHREAD_ATTR_GETSTACK */
#endif /* HAVE_PTHREAD_ATTR_GETSTACK && HAVE_PTHREAD_GETATTR_NP */
#else /* !SCM_USE_PTHREAD_THREADS */
@ -1276,8 +1282,8 @@ SCM_DEFINE (scm_broadcast_condition_variable, "broadcast-condition-variable", 1,
scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \
((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \
/ sizeof (SCM_STACKITEM))); \
bot = (SCM_STACKITEM *) __libc_ia64_register_backing_store_base; \
top = (SCM_STACKITEM *) ctx.uc_mcontext.sc_ar_bsp; \
bot = (SCM_STACKITEM *) scm_ia64_register_backing_store_base (); \
top = (SCM_STACKITEM *) scm_ia64_ar_bsp (&ctx); \
scm_mark_locations (bot, top - bot); } while (0)
#else
# define SCM_MARK_BACKING_STORE()

14
libguile/unif.c
View file

@ -1150,10 +1150,10 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
if (SCM_I_ARRAYP (v) || SCM_I_ENCLOSED_ARRAYP (v))
{
size_t k = SCM_I_ARRAY_NDIM (v);
size_t k, ndim = SCM_I_ARRAY_NDIM (v);
scm_t_array_dim *s = SCM_I_ARRAY_DIMS (v);
while (k > 0)
for (k = 0; k < ndim; k++)
{
long ind;
@ -1161,9 +1161,8 @@ SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
SCM_WRONG_NUM_ARGS ();
ind = scm_to_long (SCM_CAR (args));
args = SCM_CDR (args);
k -= 1;
if (ind < s->lbnd || ind > s->ubnd)
if (ind < s[k].lbnd || ind > s[k].ubnd)
{
res = SCM_BOOL_F;
/* We do not stop the checking after finding a violation
@ -2661,7 +2660,7 @@ read_decimal_integer (SCM port, int c, ssize_t *resp)
}
if (got_it)
*resp = res;
*resp = sign * res;
return c;
}
@ -2745,6 +2744,11 @@ scm_i_read_array (SCM port, int c)
{
c = scm_getc (port);
c = read_decimal_integer (port, c, &len);
if (len < 0)
scm_i_input_error (NULL, port,
"array length must be non-negative",
SCM_EOL);
s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
}

12
libguile/vectors.c
View file

@ -476,15 +476,15 @@ SCM_DEFINE (scm_vector_to_list, "vector->list", 1, 0, 0,
SCM res = SCM_EOL;
const SCM *data;
scm_t_array_handle handle;
size_t i, len;
size_t i, count, len;
ssize_t inc;
data = scm_vector_elements (v, &handle, &len, &inc);
for (i = len*inc; i > 0;)
{
i -= inc;
res = scm_cons (data[i], res);
}
for (i = (len - 1) * inc, count = 0;
count < len;
i -= inc, count++)
res = scm_cons (data[i], res);
scm_array_handle_release (&handle);
return res;
}

113
test-suite/ChangeLog
View file

@ -1,4 +1,61 @@
2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-12-12 Ludovic Courtès <ludovic.courtes@laas.fr>
* tests/unif.test (syntax): New test prefix. Check syntax for
negative lower bounds and negative lengths (reported by Gyula
Szavai) as well as `array-in-bounds?'.
2006-11-29 Ludovic Courtès <ludovic.courtes@laas.fr>
* test-suite/tests/vectors.test: Use `define-module'.
(vector->list): New test prefix. "Shared array" test contributed
by Szavai Gyula.
2006-11-18 Ludovic Courtès <ludovic.courtes@laas.fr>
* Makefile.am (SCM_TESTS): Added `tests/i18n.test'.
* tests/i18n.test: New file.
2006-11-17 Neil Jerram <neil@ossau.uklinux.net>
* README: Note need for subscription to bug-guile@gnu.org.
2006-11-02 Neil Jerram <neil@ossau.uklinux.net>
* tests/environments.test: Comment out all tests in this file.
2006-10-26 Ludovic Courtès <ludovic.courtes@laas.fr>
* tests/srfi-14.test (Latin-1)[char-set:punctuation]: Fixed a
typo: `thrown' instead of `throw'.
2006-10-05 Kevin Ryde <user42@zip.com.au>
* tests/ftw.test: New file.
* Makefile.am (SCM_TESTS): Add it.
2006-10-03 Kevin Ryde <user42@zip.com.au>
* tests/eval.test (apply): New tests, exercising scm_tc7_subr_2o which
had lacked some arg count checking.
2006-09-26 Kevin Ryde <user42@zip.com.au>
* tests/ports.test (seek): New tests.
(truncate-file): More tests.
2006-09-23 Kevin Ryde <user42@zip.com.au>
* tests/numbers.test (exp, log, log10, sqrt): New tests.
* tests/format.test, tests/srfi-1.test: Use define-module to prevent
redefined funcs in those modules extending on to subsequent tests.
* tests/time.test (gmtime, strptime): Remove the "unresolved" throws,
the error+thread tests seem ok now (previously were upset by something
leaking out of syntax.test).
2006-09-20 Ludovic Courtès <ludovic.courtes@laas.fr>
* tests/srfi-14.test: Use `define-module'. Use modules `(srfi
srfi-1)' and `(test-suite lib)'.
@ -7,7 +64,43 @@
(every?, find-latin1-locale): New procedures.
(%latin1): New variable.
2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-09-08 Kevin Ryde <user42@zip.com.au>
* tests/format.test (~f): Test leading zeros bugfix.
2006-08-25 Kevin Ryde <user42@zip.com.au>
* tests/popen.test (open-input-pipe, open-output-pipe): In the "no
duplicate" tests, close parent side of signalling pipe, to hopefully
generate an error instead of a hang if something bad in the child
means it doesn't write anything.
2006-08-22 Kevin Ryde <user42@zip.com.au>
* tests/srfi-9.test: More tests, in particular check for exceptions on
wrong record types passed to accessor and modifier funcs.
2006-07-25 Kevin Ryde <user42@zip.com.au>
* standalone/test-conversion.c, standalone/test-gh.c,
standalone/test-list.c, standalone/test-num2integral.c,
standalone/test-round.c: Use scm_boot_guile rather than
scm_init_guile, for the benefit of those systems where we can't
implement the latter. Reported by Claes Wallin.
* standalone/test-require-extension: Use "&& exit 1" instead of "!" to
invert the sense of exit statuses, as the latter doesn't work on
Solaris 10. Reported by Claes Wallin.
2006-07-24 Kevin Ryde <user42@zip.com.au>
* tests/socket.test (htonl, ntohl): New tests.
2006-07-06 Kevin Ryde <user42@zip.com.au>
* tests/time.test (localtime, mktime, strptime): More tests.
2006-06-13 Ludovic Courtès <ludovic.courtes@laas.fr>
* Makefile.am (SCM_TESTS): Added `tests/structs.test'.
* tests/structs.test: New file.
@ -70,7 +163,7 @@
* tests/unif.test (make-shared-array): Add example usages from the
manual, two of which currently fail.
2006-03-04 Ludovic Courtès <ludovic.courtes@laas.fr>
2006-03-04 Ludovic Courtès <ludovic.courtes@laas.fr>
* test-suite/tests/modules.test: New file.
* test-suite/Makefile.am (SCM_TESTS): Added it.
@ -118,7 +211,7 @@
* tests/srfi-1.test (lset-difference!): More tests.
2005-10-27 Ludovic Courtès <ludovic.courtes@laas.fr>
2005-10-27 Ludovic Courtès <ludovic.courtes@laas.fr>
* tests/socket.test (make-socket-address): New tests.
(connect, bind, sendto): Exercise sockaddr object.
@ -649,7 +742,7 @@
* lib.scm (exception:numerical-overflow): New define.
* tests/numbers.test (modulo-expt): Use it and
exception:wrong-type-arg, avoiding empty "" regexp which is invalid on
BSD. Reported by Andreas Vögele.
BSD. Reported by Andreas Vögele.
2004-05-29 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
@ -674,12 +767,12 @@
* tests/srfi-19.test (test-dst, string->date local DST): Test with
"EST5EDT" instead of "CET", since HP-UX doesn't know CET. Reported by
Andreas Vögele.
Andreas Vögele.
2004-05-03 Kevin Ryde <user42@zip.com.au>
* tests/time.test (strftime): Force tm:isdst to 0 for the test, for
the benefit of HP-UX. Reported by Andreas Vögele.
the benefit of HP-UX. Reported by Andreas Vögele.
Use set-tm:zone rather than a hard coded vector offset.
2004-04-29 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
@ -1620,7 +1713,7 @@
2001-06-16 Marius Vollmer <mvo@zagadka.ping.de>
Thanks to Matthias Köppe!
Thanks to Matthias Köppe!
* tests/ports.test: New test for output port line counts.
* tests/format.test, tests/optargs.test, tests/srfi-19.test: New
@ -2214,3 +2307,7 @@ Fri Dec 17 12:14:10 1999 Greg J. Badros <gjb@cs.washington.edu>
* lib.scm, guile-test, paths.scm: Log begins.
;; Local Variables:
;; coding: utf-8
;; End:

2
test-suite/Makefile.am
View file

@ -35,12 +35,14 @@ SCM_TESTS = tests/alist.test \
tests/filesys.test \
tests/format.test \
tests/fractions.test \
tests/ftw.test \
tests/gc.test \
tests/getopt-long.test \
tests/goops.test \
tests/guardians.test \
tests/hash.test \
tests/hooks.test \
tests/i18n.test \
tests/import.test \
tests/interp.test \
tests/list.test \

8
test-suite/README
View file

@ -13,9 +13,11 @@ You can reference the file `lib.scm' from your own code as the module
function explaining what's going on.
Please write more Guile tests, and send them to bug-guile@gnu.org.
We'll merge them into the distribution. All test suites must be
licensed for our use under the GPL, but I don't think I'm going to
collect assignment papers for them.
(Note that you must be subscribed to this list first, in order to
successfully send a report to it.) We'll merge them into the
distribution. All test suites must be licensed for our use under the
GPL, but I don't think I'm going to collect assignment papers for
them.

11
test-suite/standalone/test-conversion.c
View file

@ -1010,10 +1010,9 @@ test_locale_strings ()
test_11 ("(string #\\f #\\nul)", NULL, 1, 0);
}
int
main (int argc, char *argv[])
static void
tests (void *data, int argc, char **argv)
{
scm_init_guile();
test_is_signed_integer ();
test_is_unsigned_integer ();
test_to_signed_integer ();
@ -1024,5 +1023,11 @@ main (int argc, char *argv[])
test_from_double ();
test_to_double ();
test_locale_strings ();
}
int
main (int argc, char *argv[])
{
scm_boot_guile (argc, argv, tests, NULL);
return 0;
}

11
test-suite/standalone/test-gh.c
View file

@ -67,11 +67,16 @@ test_gh_set_substr ()
assert (string_equal (string, "Frdarnitrnit!"));
}
int
static void
tests (void *data, int argc, char **argv)
{
test_gh_set_substr ();
}
int
main (int argc, char *argv[])
{
scm_init_guile ();
test_gh_set_substr ();
scm_boot_guile (argc, argv, tests, NULL);
return 0;
}

11
test-suite/standalone/test-list.c
View file

@ -46,10 +46,15 @@ test_scm_list (void)
}
}
int
main (int argc, char **argv)
static void
tests (void *data, int argc, char **argv)
{
scm_init_guile();
test_scm_list ();
}
int
main (int argc, char *argv[])
{
scm_boot_guile (argc, argv, tests, NULL);
return 0;
}

11
test-suite/standalone/test-num2integral.c
View file

@ -141,12 +141,17 @@ test_ulong_long ()
#endif /* SCM_SIZEOF_LONG_LONG != 0 */
}
static void
tests (void *data, int argc, char **argv)
{
test_long_long ();
test_ulong_long ();
}
int
main (int argc, char *argv[])
{
scm_init_guile();
test_long_long ();
test_ulong_long ();
scm_boot_guile (argc, argv, tests, NULL);
return 0;
}

12
test-suite/standalone/test-require-extension
View file

@ -2,10 +2,16 @@
set -e
! guile -c '(require-extension 7)' 2> /dev/null
! guile -c '(require-extension (blarg))' 2> /dev/null
! guile -c '(require-extension (srfi "foo"))' 2> /dev/null
# expect these to throw errors, if they succeed it's wrong
#
# (Note the syntax "! guile -c ..." isn't used here, because that doesn't
# work on Solaris 10.)
#
guile -c '(require-extension 7)' 2>/dev/null && exit 1
guile -c '(require-extension (blarg))' 2>/dev/null && exit 1
guile -c '(require-extension (srfi "foo"))' 2>/dev/null && exit 1
# expect these to succeed
guile -c '(require-extension (srfi 1)) (exit (procedure? take-right))'
guile -c '(require-extension (srfi))'

9
test-suite/standalone/test-round.c
View file

@ -113,10 +113,15 @@ test_scm_c_round ()
}
}
static void
tests (void *data, int argc, char **argv)
{
test_scm_c_round ();
}
int
main (int argc, char *argv[])
{
scm_init_guile();
test_scm_c_round ();
scm_boot_guile (argc, argv, tests, NULL);
return 0;
}

8
test-suite/tests/environments.nottest
View file

@ -18,9 +18,9 @@
(use-modules (ice-9 documentation)
(test-suite lib))
;;; FIXME: Test disabled!
;;; The `environments' code (which is currently unused) relies on weak alist
;;; vectors. However, these are currently implemented as weak hash tables.
;;; environments are currently commented out of libguile, so these
;;; tests must be commented out also. - NJ 2006-11-02.
(if #f (let ()
;;;
;;; miscellaneous
@ -1047,3 +1047,5 @@
(pass-if "documented?"
(documented? make-import-environment))))
;;; End of commenting out. - NJ 2006-11-02.
))

28
test-suite/tests/eval.test
View file

@ -99,10 +99,10 @@
))
;;;
;;; apply
;;; call
;;;
(with-test-prefix "application"
(with-test-prefix "call"
(with-test-prefix "wrong number of arguments"
@ -142,6 +142,30 @@
exception:wrong-num-args
((lambda (x y . rest) #f) 1))))
;;;
;;; apply
;;;
(with-test-prefix "apply"
(with-test-prefix "scm_tc7_subr_2o"
;; prior to guile 1.6.9 and 1.8.1 this called the function with
;; SCM_UNDEFIEND, which in the case of make-vector resulted in
;; wrong-type-arg, instead of the intended wrong-num-args
(pass-if-exception "0 args" exception:wrong-num-args
(apply make-vector '()))
(pass-if "1 arg"
(vector? (apply make-vector '(1))))
(pass-if "2 args"
(vector? (apply make-vector '(1 2))))
;; prior to guile 1.6.9 and 1.8.1 this error wasn't detected
(pass-if-exception "3 args" exception:wrong-num-args
(apply make-vector '(1 2 3)))))
;;;
;;; map
;;;

20
test-suite/tests/format.test
View file

@ -18,8 +18,10 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(use-modules (test-suite lib)
(ice-9 format))
(define-module (test-format)
#:use-module (test-suite lib)
#:use-module (ice-9 format))
;;; FORMAT Basic Output
@ -72,6 +74,20 @@
(pass-if "+1"
(string=? (format #f "~@d" 1) "+1"))))
;;;
;;; ~f
;;;
(with-test-prefix "~f fixed-point"
(pass-if "1.5"
(string=? "1.5" (format #f "~f" 1.5)))
;; in guile prior to 1.6.9 and 1.8.1, leading zeros were incorrectly
;; stripped, moving the decimal point and giving "25.0" here
(pass-if "string 02.5"
(string=? "2.5" (format #f "~f" "02.5"))))
;;;
;;; ~{
;;;

73
test-suite/tests/ftw.test Normal file
View file

@ -0,0 +1,73 @@
;;;; ftw.test --- exercise ice-9/ftw.scm -*- scheme -*-
;;;;
;;;; Copyright 2006 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 2.1 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-ice-9-ftw)
#:use-module (test-suite lib)
#:use-module (ice-9 ftw))
;; the procedure-source checks here ensure the vector indexes we write match
;; what ice-9/posix.scm stat:dev and stat:ino do (which in turn match
;; libguile/filesys.c of course)
(or (equal? (procedure-source stat:dev)
'(lambda (f) (vector-ref f 0)))
(error "oops, unexpected stat:dev definition"))
(define (stat:dev! st dev)
(vector-set! st 0 dev))
(or (equal? (procedure-source stat:ino)
'(lambda (f) (vector-ref f 1)))
(error "oops, unexpected stat:ino definition"))
(define (stat:ino! st ino)
(vector-set! st 1 ino))
;;
;; visited?-proc
;;
(with-test-prefix "visited?-proc"
;; normally internal-only
(let* ((visited?-proc (@@ (ice-9 ftw) visited?-proc))
(visited? (visited?-proc 97))
(s (stat "/")))
(define (try-visited? dev ino)
(stat:dev! s dev)
(stat:ino! s ino)
(visited? s))
(pass-if "0 0 - 1st" (eq? #f (try-visited? 0 0)))
(pass-if "0 0 - 2nd" (eq? #t (try-visited? 0 0)))
(pass-if "0 0 - 3rd" (eq? #t (try-visited? 0 0)))
(pass-if "0 1" (eq? #f (try-visited? 0 1)))
(pass-if "0 2" (eq? #f (try-visited? 0 2)))
(pass-if "0 3" (eq? #f (try-visited? 0 3)))
(pass-if "5 5" (eq? #f (try-visited? 5 5)))
(pass-if "5 7" (eq? #f (try-visited? 5 7)))
(pass-if "7 5" (eq? #f (try-visited? 7 5)))
(pass-if "7 7" (eq? #f (try-visited? 7 7)))
(pass-if "5 5 - 2nd" (eq? #t (try-visited? 5 5)))
(pass-if "5 7 - 2nd" (eq? #t (try-visited? 5 7)))
(pass-if "7 5 - 2nd" (eq? #t (try-visited? 7 5)))
(pass-if "7 7 - 2nd" (eq? #t (try-visited? 7 7)))))

143
test-suite/tests/i18n.test Normal file
View file

@ -0,0 +1,143 @@
;;;; i18n.test --- Exercise the i18n API.
;;;;
;;;; Copyright (C) 2006 Free Software Foundation, Inc.
;;;; Ludovic Courtès
;;;;
;;;; 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 2.1 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite i18n)
:use-module (ice-9 i18n)
:use-module (test-suite lib))
;; Start from a pristine locale state.
(setlocale LC_ALL "C")
(with-test-prefix "locale objects"
(pass-if "make-locale (2 args)"
(not (not (make-locale LC_ALL_MASK "C"))))
(pass-if "make-locale (3 args)"
(not (not (make-locale LC_COLLATE_MASK "C"
(make-locale LC_MESSAGES_MASK "C")))))
(pass-if "locale?"
(and (locale? (make-locale LC_ALL_MASK "C"))
(locale? (make-locale (logior LC_MESSAGES_MASK LC_NUMERIC_MASK) "C"
(make-locale LC_CTYPE_MASK "C"))))))
(with-test-prefix "text collation (English)"
(pass-if "string-locale<?"
(and (string-locale<? "hello" "world")
(string-locale<? "hello" "world"
(make-locale LC_COLLATE_MASK "C"))))
(pass-if "char-locale<?"
(and (char-locale<? #\a #\b)
(char-locale<? #\a #\b (make-locale LC_COLLATE_MASK "C"))))
(pass-if "string-locale-ci=?"
(and (string-locale-ci=? "Hello" "HELLO")
(string-locale-ci=? "Hello" "HELLO"
(make-locale LC_COLLATE_MASK "C"))))
(pass-if "string-locale-ci<?"
(and (string-locale-ci<? "hello" "WORLD")
(string-locale-ci<? "hello" "WORLD"
(make-locale LC_COLLATE_MASK "C")))))
(define %french-locale
(false-if-exception
(make-locale (logior LC_CTYPE_MASK LC_COLLATE_MASK)
"fr_FR.ISO-8859-1")))
(define (under-french-locale-or-unresolved thunk)
;; On non-GNU systems, an exception may be raised only when the locale is
;; actually used rather than at `make-locale'-time. Thus, we must guard
;; against both.
(if %french-locale
(catch 'system-error thunk
(lambda (key . args)
(throw 'unresolved)))
(throw 'unresolved)))
(with-test-prefix "text collation (French)"
(pass-if "string-locale<?"
(under-french-locale-or-unresolved
(lambda ()
(string-locale<? "été" "hiver" %french-locale))))
(pass-if "char-locale<?"
(under-french-locale-or-unresolved
(lambda ()
(char-locale<? #\é #\h %french-locale))))
(pass-if "string-locale-ci=?"
(under-french-locale-or-unresolved
(lambda ()
(string-locale-ci=? "ÉTÉ" "été" %french-locale))))
(pass-if "string-locale-ci<>?"
(under-french-locale-or-unresolved
(lambda ()
(and (string-locale-ci<? "été" "Hiver" %french-locale)
(string-locale-ci>? "HiVeR" "été" %french-locale)))))
(pass-if "char-locale-ci<>?"
(under-french-locale-or-unresolved
(lambda ()
(and (char-locale-ci<? #\é #\H %french-locale)
(char-locale-ci>? #\h #\É %french-locale))))))
(with-test-prefix "character mapping"
(pass-if "char-locale-downcase"
(and (eq? #\a (char-locale-downcase #\A))
(eq? #\a (char-locale-downcase #\A (make-locale LC_ALL_MASK "C")))))
(pass-if "char-locale-upcase"
(and (eq? #\Z (char-locale-upcase #\z))
(eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL_MASK "C"))))))
(with-test-prefix "number parsing"
(pass-if "locale-string->integer"
(call-with-values (lambda () (locale-string->integer "123"))
(lambda (result char-count)
(and (equal? result 123)
(equal? char-count 3)))))
(pass-if "locale-string->inexact"
(call-with-values
(lambda ()
(locale-string->inexact "123.456"
(make-locale LC_NUMERIC_MASK "C")))
(lambda (result char-count)
(and (equal? result 123.456)
(equal? char-count 7))))))
;;; Local Variables:
;;; coding: latin-1
;;; mode: scheme
;;; End:

145
test-suite/tests/numbers.test
View file

@ -71,6 +71,32 @@
(quotient (- n d -1) d) ;; neg/pos
(quotient n d))) ;; pos/pos
;; return true of X is in the range LO to HI, inclusive
(define (within-range? lo hi x)
(and (>= x (min lo hi))
(<= x (max lo hi))))
;; return true if GOT is within +/- 0.01 of GOT
;; for a complex number both real and imaginary parts must be in that range
(define (eqv-loosely? want got)
(and (within-range? (- (real-part want) 0.01)
(+ (real-part want) 0.01)
(real-part got))
(within-range? (- (imag-part want) 0.01)
(+ (imag-part want) 0.01)
(imag-part got))))
;; return true if OBJ is negative infinity
(define (negative-infinity? obj)
(and (real? obj)
(negative? obj)
(inf? obj)))
(define const-e 2.7182818284590452354)
(define const-e^2 7.3890560989306502274)
(define const-1/e 0.3678794411714423215)
;;;
;;; 1+
;;;
@ -200,6 +226,36 @@
(pass-if "sqrt ((fixnum-max+1)^2 - 1)"
(eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))))
;;;
;;; exp
;;;
(with-test-prefix "exp"
(pass-if "documented?"
(documented? exp))
(pass-if-exception "no args" exception:wrong-num-args
(exp))
(pass-if-exception "two args" exception:wrong-num-args
(exp 123 456))
(pass-if (eqv? 0.0 (exp -inf.0)))
(pass-if (eqv-loosely? 1.0 (exp 0)))
(pass-if (eqv-loosely? 1.0 (exp 0.0)))
(pass-if (eqv-loosely? const-e (exp 1.0)))
(pass-if (eqv-loosely? const-e^2 (exp 2.0)))
(pass-if (eqv-loosely? const-1/e (exp -1)))
(pass-if "exp(pi*i) = -1"
(eqv-loosely? -1.0 (exp 0+3.14159i)))
(pass-if "exp(-pi*i) = -1"
(eqv-loosely? -1.0 (exp 0-3.14159i)))
(pass-if "exp(2*pi*i) = +1"
(eqv-loosely? 1.0 (exp 0+6.28318i)))
(pass-if "exp(2-pi*i) = -e^2"
(eqv-loosely? (- const-e^2) (exp 2.0-3.14159i))))
;;;
;;; odd?
;;;
@ -2930,6 +2986,62 @@
(pass-if n
(= i (integer-length n))))))
;;;
;;; log
;;;
(with-test-prefix "log"
(pass-if "documented?"
(documented? log))
(pass-if-exception "no args" exception:wrong-num-args
(log))
(pass-if-exception "two args" exception:wrong-num-args
(log 123 456))
(pass-if (negative-infinity? (log 0)))
(pass-if (negative-infinity? (log 0.0)))
(pass-if (eqv? 0.0 (log 1)))
(pass-if (eqv? 0.0 (log 1.0)))
(pass-if (eqv-loosely? 1.0 (log const-e)))
(pass-if (eqv-loosely? 2.0 (log const-e^2)))
(pass-if (eqv-loosely? -1.0 (log const-1/e)))
(pass-if (eqv-loosely? 1.0+1.57079i (log 0+2.71828i)))
(pass-if (eqv-loosely? 1.0-1.57079i (log 0-2.71828i)))
(pass-if (eqv-loosely? 0.0+3.14159i (log -1.0)))
(pass-if (eqv-loosely? 1.0+3.14159i (log -2.71828)))
(pass-if (eqv-loosely? 2.0+3.14159i (log (* -2.71828 2.71828)))))
;;;
;;; log10
;;;
(with-test-prefix "log10"
(pass-if "documented?"
(documented? log10))
(pass-if-exception "no args" exception:wrong-num-args
(log10))
(pass-if-exception "two args" exception:wrong-num-args
(log10 123 456))
(pass-if (negative-infinity? (log10 0)))
(pass-if (negative-infinity? (log10 0.0)))
(pass-if (eqv? 0.0 (log10 1)))
(pass-if (eqv? 0.0 (log10 1.0)))
(pass-if (eqv-loosely? 1.0 (log10 10.0)))
(pass-if (eqv-loosely? 2.0 (log10 100.0)))
(pass-if (eqv-loosely? -1.0 (log10 0.1)))
(pass-if (eqv-loosely? 1.0+0.68218i (log10 0+10.0i)))
(pass-if (eqv-loosely? 1.0-0.68218i (log10 0-10.0i)))
(pass-if (eqv-loosely? 0.0+1.36437i (log10 -1)))
(pass-if (eqv-loosely? 1.0+1.36437i (log10 -10)))
(pass-if (eqv-loosely? 2.0+1.36437i (log10 -100))))
;;;
;;; logbit?
;;;
@ -3035,3 +3147,36 @@
(lognot #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)))
(pass-if (= #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
(lognot #x-100000000000000000000000000000000))))
;;;
;;; sqrt
;;;
(with-test-prefix "sqrt"
(pass-if "documented?"
(documented? sqrt))
(pass-if-exception "no args" exception:wrong-num-args
(sqrt))
(pass-if-exception "two args" exception:wrong-num-args
(sqrt 123 456))
(pass-if (eqv? 0.0 (sqrt 0)))
(pass-if (eqv? 0.0 (sqrt 0.0)))
(pass-if (eqv? 1.0 (sqrt 1.0)))
(pass-if (eqv-loosely? 2.0 (sqrt 4.0)))
(pass-if (eqv-loosely? 31.62 (sqrt 1000.0)))
(pass-if (eqv? +1.0i (sqrt -1.0)))
(pass-if (eqv-loosely? +2.0i (sqrt -4.0)))
(pass-if (eqv-loosely? +31.62i (sqrt -1000.0)))
(pass-if "+i swings back to 45deg angle"
(eqv-loosely? +0.7071+0.7071i (sqrt +1.0i)))
;; Note: glibc 2.3 csqrt() had a bug affecting this test case, so if it
;; fails check whether that's the cause (there's a configure test to
;; reject it, but when cross-compiling we assume the C library is ok).
(pass-if "-100i swings back to 45deg down"
(eqv-loosely? +7.071-7.071i (sqrt -100.0i))))

16
test-suite/tests/popen.test
View file

@ -82,9 +82,10 @@
(port (with-error-to-port (cdr pair)
(lambda ()
(open-input-pipe
"exec 1>/dev/null; echo closed 1>&2; sleep 999")))))
(read-char (car pair)) ;; wait for child to do its thing
(and (char-ready? port)
"exec 1>/dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
(close-port (cdr pair)) ;; write side
(and (char? (read-char (car pair))) ;; wait for child to do its thing
(char-ready? port)
(eof-object? (read-char port))))))
;;
@ -131,15 +132,16 @@
(port (with-error-to-port (cdr pair)
(lambda ()
(open-output-pipe
"exec 0</dev/null; echo closed 1>&2; sleep 999")))))
(read-char (car pair)) ;; wait for child to do its thing
(catch 'system-error
"exec 0</dev/null; echo closed 1>&2; exec 2>/dev/null; sleep 999")))))
(close-port (cdr pair)) ;; write side
(and (char? (read-char (car pair))) ;; wait for child to do its thing
(catch 'system-error
(lambda ()
(write-char #\x port)
(force-output port)
#f)
(lambda (key name fmt args errno-list)
(= (car errno-list) EPIPE))))))))
(= (car errno-list) EPIPE)))))))))
;;
;; close-pipe

74
test-suite/tests/ports.test
View file

@ -538,20 +538,73 @@
(while (not (eof-object? (read-char port))))
(= 8 (port-column port))))))
;;;
;;; seek
;;;
(with-test-prefix "seek"
(with-test-prefix "file port"
(pass-if "SEEK_CUR"
(call-with-output-file (test-file)
(lambda (port)
(display "abcde" port)))
(let ((port (open-file (test-file) "r")))
(read-char port)
(seek port 2 SEEK_CUR)
(eqv? #\d (read-char port))))
(pass-if "SEEK_SET"
(call-with-output-file (test-file)
(lambda (port)
(display "abcde" port)))
(let ((port (open-file (test-file) "r")))
(read-char port)
(seek port 3 SEEK_SET)
(eqv? #\d (read-char port))))
(pass-if "SEEK_END"
(call-with-output-file (test-file)
(lambda (port)
(display "abcde" port)))
(let ((port (open-file (test-file) "r")))
(read-char port)
(seek port -2 SEEK_END)
(eqv? #\d (read-char port))))))
;;;
;;; truncate-file
;;;
(with-test-prefix "truncate-file"
(pass-if-exception "flonum file" exception:wrong-type-arg
(truncate-file 1.0 123))
(pass-if-exception "frac file" exception:wrong-type-arg
(truncate-file 7/3 123))
(with-test-prefix "filename"
(pass-if-exception "flonum length" exception:wrong-type-arg
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
(truncate-file (test-file) 1.0))
(pass-if "shorten"
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
(truncate-file (test-file) 1)
(eqv? 1 (stat:size (stat (test-file))))))
(eqv? 1 (stat:size (stat (test-file)))))
(pass-if-exception "shorten to current pos" exception:miscellaneous-error
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
(truncate-file (test-file))))
(with-test-prefix "file descriptor"
@ -562,6 +615,16 @@
(let ((fd (open-fdes (test-file) O_RDWR)))
(truncate-file fd 1)
(close-fdes fd))
(eqv? 1 (stat:size (stat (test-file)))))
(pass-if "shorten to current pos"
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
(let ((fd (open-fdes (test-file) O_RDWR)))
(seek fd 1 SEEK_SET)
(truncate-file fd)
(close-fdes fd))
(eqv? 1 (stat:size (stat (test-file))))))
(with-test-prefix "file port"
@ -572,6 +635,15 @@
(display "hello" port)))
(let ((port (open-file (test-file) "r+")))
(truncate-file port 1))
(eqv? 1 (stat:size (stat (test-file)))))
(pass-if "shorten to current pos"
(call-with-output-file (test-file)
(lambda (port)
(display "hello" port)))
(let ((port (open-file (test-file) "r+")))
(read-char port)
(truncate-file port))
(eqv? 1 (stat:size (stat (test-file)))))))

0
test-suite/tests/slib.test
View file

40
test-suite/tests/socket.test
View file

@ -20,6 +20,27 @@
#:use-module (test-suite lib))
;;;
;;; htonl
;;;
(with-test-prefix "htonl"
(pass-if "0" (eqv? 0 (htonl 0)))
(pass-if-exception "-1" exception:out-of-range
(htonl -1))
;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't detect
;; an overflow for values 2^32 <= x < 2^63
(pass-if-exception "2^32" exception:out-of-range
(htonl (ash 1 32)))
(pass-if-exception "2^1024" exception:out-of-range
(htonl (ash 1 1024))))
;;;
;;; inet-ntop
;;;
@ -110,6 +131,25 @@
(and (= (sockaddr:fam sa) AF_UNIX)
(string=? (sockaddr:path sa) "/tmp/unix-socket"))))))
;;;
;;; ntohl
;;;
(with-test-prefix "ntohl"
(pass-if "0" (eqv? 0 (ntohl 0)))
(pass-if-exception "-1" exception:out-of-range
(ntohl -1))
;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't detect
;; an overflow for values 2^32 <= x < 2^63
(pass-if-exception "2^32" exception:out-of-range
(ntohl (ash 1 32)))
(pass-if-exception "2^1024" exception:out-of-range
(ntohl (ash 1 1024))))
;;;

6
test-suite/tests/srfi-1.test
View file

@ -17,8 +17,10 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(use-modules (srfi srfi-1)
(test-suite lib))
(define-module (test-srfi-1)
#:use-module (test-suite lib)
#:use-module (srfi srfi-1))
(define (ref-delete x lst . proc)
"Reference implemenation of srfi-1 `delete'."

2
test-suite/tests/srfi-14.test
View file

@ -290,7 +290,7 @@
(pass-if "char-set:punctuation (membership)"
(if (not %latin1)
(thrown 'unresolved)
(throw 'unresolved)
(let ((punctuation (char-set->list char-set:punctuation)))
(every? (lambda (8-bit-char)
(memq 8-bit-char punctuation))

60
test-suite/tests/srfi-9.test
View file

@ -18,25 +18,69 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(use-modules (srfi srfi-9))
(define-module (test-suite test-numbers)
#:use-module (test-suite lib)
#:use-module (srfi srfi-9))
(define exception:not-a-record
(cons 'misc-error "^not-a-record"))
(define-record-type :foo (make-foo x) foo?
(x get-x) (y get-y set-y!))
(define-record-type :bar (make-bar i j) bar?
(i get-i) (i get-j set-j!))
(define f (make-foo 1))
(set-y! f 2)
(with-test-prefix "record procedures"
(define b (make-bar 123 456))
(pass-if "predicate"
(with-test-prefix "constructor"
(pass-if-exception "foo 0 args" exception:wrong-num-args
(make-foo))
(pass-if-exception "foo 2 args" exception:wrong-num-args
(make-foo 1 2)))
(with-test-prefix "predicate"
(pass-if "pass"
(foo? f))
(pass-if "fail wrong record type"
(eq? #f (foo? b)))
(pass-if "fail number"
(eq? #f (foo? 123))))
(pass-if "accessor 1"
(with-test-prefix "accessor"
(pass-if "get-x"
(= 1 (get-x f)))
(pass-if "accessor 2"
(pass-if "get-y"
(= 2 (get-y f)))
(pass-if "modifier"
(pass-if-exception "get-x on number" exception:not-a-record
(get-x 999))
(pass-if-exception "get-y on number" exception:not-a-record
(get-y 999))
;; prior to guile 1.6.9 and 1.8.1 this wan't enforced
(pass-if-exception "get-x on bar" exception:wrong-type-arg
(get-x b))
(pass-if-exception "get-y on bar" exception:wrong-type-arg
(get-y b)))
(with-test-prefix "modifier"
(pass-if "set-y!"
(set-y! f #t)
(eq? #t (get-y f))))
(eq? #t (get-y f)))
(pass-if-exception "set-y! on number" exception:not-a-record
(set-y! 999 #t))
;; prior to guile 1.6.9 and 1.8.1 this wan't enforced
(pass-if-exception "set-y! on bar" exception:wrong-type-arg
(set-y! b 99)))

238
test-suite/tests/time.test
View file

@ -32,15 +32,9 @@
(pass-if (list "in another thread after error" t)
(or (provided? 'threads) (throw 'unsupported))
;; actually this test is perfectly good, but the "internal
;; define - missing body expression" in syntax.test somehow
;; ends up leaving SCM_DEFER_INTS, making the test here hang
;;
(throw 'unresolved)
(alarm 5)
(false-if-exception (gmtime t))
(thread-join (begin-thread (catch 'out-of-range
(join-thread (begin-thread (catch 'out-of-range
(lambda () (gmtime t))
(lambda args #f))))
(alarm 0)
@ -73,31 +67,187 @@
elapsed
(* 2 internal-time-units-per-second))))))
;;;
;;; localtime
;;;
(with-test-prefix "localtime"
;; gmtoff is calculated with some explicit code, try to exercise that
;; here, looking at cases where the localtime and gmtime are within the same
;; day, or crossing midnight, or crossing new year
(pass-if "gmtoff of EST+5 at GMT 10:00am on 10 Jan 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 10)
(set-tm:mday tm 10)
(set-tm:mon tm 0)
(set-tm:year tm 100)
(let* ((t (car (mktime tm "GMT")))
(tm (localtime t "EST+5")))
(eqv? (* 5 3600) (tm:gmtoff tm)))))
;; crossing forward over day boundary
(pass-if "gmtoff of EST+5 at GMT 3am on 10 Jan 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 3)
(set-tm:mday tm 10)
(set-tm:mon tm 0)
(set-tm:year tm 100)
(let* ((t (car (mktime tm "GMT")))
(tm (localtime t "EST+5")))
(eqv? (* 5 3600) (tm:gmtoff tm)))))
;; crossing backward over day boundary
(pass-if "gmtoff of AST-10 at GMT 10pm on 10 Jan 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 22)
(set-tm:mday tm 10)
(set-tm:mon tm 0)
(set-tm:year tm 100)
(let* ((t (car (mktime tm "GMT")))
(tm (localtime t "AST-10")))
(eqv? (* -10 3600) (tm:gmtoff tm)))))
;; crossing forward over year boundary
(pass-if "gmtoff of EST+5 at GMT 3am on 1 Jan 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 3)
(set-tm:mday tm 1)
(set-tm:mon tm 0)
(set-tm:year tm 100)
(let* ((t (car (mktime tm "GMT")))
(tm (localtime t "EST+5")))
(eqv? (* 5 3600) (tm:gmtoff tm)))))
;; crossing backward over day boundary
(pass-if "gmtoff of AST-10 at GMT 10pm on 31 Dec 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 22)
(set-tm:mday tm 31)
(set-tm:mon tm 11)
(set-tm:year tm 100)
(let* ((t (car (mktime tm "GMT")))
(tm (localtime t "AST-10")))
(eqv? (* -10 3600) (tm:gmtoff tm))))))
;;;
;;; mktime
;;;
(with-test-prefix "mktime"
;; gmtoff is calculated with some explicit code, try to exercise that
;; here, looking at cases where the mktime and gmtime are within the same
;; day, or crossing midnight, or crossing new year
(pass-if "gmtoff of EST+5 at 10:00am on 10 Jan 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 10)
(set-tm:mday tm 10)
(set-tm:mon tm 0)
(set-tm:year tm 100)
(let ((tm (cdr (mktime tm "EST+5"))))
(eqv? (* 5 3600) (tm:gmtoff tm)))))
;; crossing forward over day boundary
(pass-if "gmtoff of EST+5 at 10:00pm on 10 Jan 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 22)
(set-tm:mday tm 10)
(set-tm:mon tm 0)
(set-tm:year tm 100)
(let ((tm (cdr (mktime tm "EST+5"))))
(eqv? (* 5 3600) (tm:gmtoff tm)))))
;; crossing backward over day boundary
(pass-if "gmtoff of AST-10 at 3:00am on 10 Jan 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 3)
(set-tm:mday tm 10)
(set-tm:mon tm 0)
(set-tm:year tm 100)
(let ((tm (cdr (mktime tm "AST-10"))))
(eqv? (* -10 3600) (tm:gmtoff tm)))))
;; crossing forward over year boundary
(pass-if "gmtoff of EST+5 at 10:00pm on 31 Dec 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 22)
(set-tm:mday tm 31)
(set-tm:mon tm 11)
(set-tm:year tm 100)
(let ((tm (cdr (mktime tm "EST+5"))))
(eqv? (* 5 3600) (tm:gmtoff tm)))))
;; crossing backward over day boundary
(pass-if "gmtoff of AST-10 at 3:00am on 1 Jan 2000"
(let ((tm (gmtime 0)))
(set-tm:hour tm 3)
(set-tm:mday tm 1)
(set-tm:mon tm 0)
(set-tm:year tm 100)
(let ((tm (cdr (mktime tm "AST-10"))))
(eqv? (* -10 3600) (tm:gmtoff tm))))))
;;;
;;; strftime
;;;
;; Note we must force isdst to get the ZOW zone name out of %Z on HP-UX.
;; If localtime is in daylight savings then it will decide there's no
;; daylight savings zone name for the fake ZOW, and come back empty.
;;
;; This test is disabled because on NetBSD %Z doesn't look at the tm_zone
;; field in struct tm passed by guile. That behaviour is reasonable enough
;; since that field is not in C99 so a C99 program won't know it has to be
;; set. For the details on that see
;;
;; http://www.netbsd.org/cgi-bin/query-pr-single.pl?number=21722
;;
;; Not sure what to do about this in guile, it'd be nice for %Z to look at
;; tm:zone everywhere.
;;
;;
;; (pass-if "strftime %Z doesn't return garbage"
;; (let ((t (localtime (current-time))))
;; (set-tm:zone t "ZOW")
;; (set-tm:isdst t 0)
;; (string=? (strftime "%Z" t)
;; "ZOW")))
(with-test-prefix "strftime"
;; Note we must force isdst to get the ZOW zone name out of %Z on HP-UX.
;; If localtime is in daylight savings then it will decide there's no
;; daylight savings zone name for the fake ZOW, and come back empty.
;;
;; This test is disabled because on NetBSD %Z doesn't look at the tm_zone
;; field in struct tm passed by guile. That behaviour is reasonable
;; enough since that field is not in C99 so a C99 program won't know it
;; has to be set. For the details on that see
;;
;; http://www.netbsd.org/cgi-bin/query-pr-single.pl?number=21722
;;
;; Not sure what to do about this in guile, it'd be nice for %Z to look at
;; tm:zone everywhere.
;;
;;
;; (pass-if "strftime %Z doesn't return garbage"
;; (let ((t (localtime (current-time))))
;; (set-tm:zone t "ZOW")
;; (set-tm:isdst t 0)
;; (string=? (strftime "%Z" t)
;; "ZOW")))
(with-test-prefix "C99 %z format"
;; C99 spec is empty string if no zone determinable
;;
;; on pre-C99 systems not sure what to expect if %z unsupported, probably
;; "%z" unchanged in C99 if timezone
;;
(define have-strftime-%z
(not (member (strftime "%z" (gmtime 0))
'("" "%z"))))
;; %z here is quite possibly affected by the same tm:gmtoff vs current
;; zone as %Z above is, so in the following tests we make them the same.
(pass-if "GMT"
(or have-strftime-%z (throw 'unsupported))
(putenv "TZ=GMT+0")
(tzset)
(let ((tm (localtime 86400)))
(string=? "+0000" (strftime "%z" tm))))
;; prior to guile 1.6.9 and 1.8.1 this test failed, getting "+0500",
;; because we didn't adjust for tm:gmtoff being west of Greenwich versus
;; tm_gmtoff being east of Greenwich
(pass-if "EST+5"
(or have-strftime-%z (throw 'unsupported))
(putenv "TZ=EST+5")
(tzset)
(let ((tm (localtime 86400)))
(string=? "-0500" (strftime "%z" tm))))))
;;;
;;; strptime
@ -109,15 +259,31 @@
(or (defined? 'strptime) (throw 'unsupported))
(or (provided? 'threads) (throw 'unsupported))
;; actually this test is perfectly good, but the "internal define -
;; missing body expression" in syntax.test somehow ends up leaving
;; SCM_DEFER_INTS, making the test here hang
;;
(throw 'unresolved)
(alarm 5)
(false-if-exception
(strptime "%a" "nosuchday"))
(thread-join (begin-thread (strptime "%d" "1")))
(join-thread (begin-thread (strptime "%d" "1")))
(alarm 0)
#t))
#t)
(with-test-prefix "GNU %s format"
;; "%s" to parse a count of seconds since 1970 is a GNU extension
(define have-strptime-%s
(false-if-exception (strptime "%s" "0")))
(pass-if "gmtoff on GMT"
(or have-strptime-%s (throw 'unsupported))
(putenv "TZ=GMT+0")
(tzset)
(let ((tm (car (strptime "%s" "86400"))))
(eqv? 0 (tm:gmtoff tm))))
;; prior to guile 1.6.9 and 1.8.1 we didn't pass tm_gmtoff back from
;; strptime
(pass-if "gmtoff on EST+5"
(or have-strptime-%s (throw 'unsupported))
(putenv "TZ=EST+5")
(tzset)
(let ((tm (car (strptime "%s" "86400"))))
(eqv? (* 5 3600) (tm:gmtoff tm))))))

38
test-suite/tests/unif.test
View file

@ -26,6 +26,10 @@
(define exception:wrong-num-indices
(cons 'misc-error "^wrong number of indices.*"))
(define exception:length-non-negative
(cons 'read-error ".*array length must be non-negative.*"))
(with-test-prefix "array?"
(let ((bool (make-typed-array 'b #t '(5 6)))
@ -513,7 +517,41 @@
(array-set! a -128 0)
(= -128 (uniform-vector-ref a 0)))))))
;;;
;;; syntax
;;;
(with-test-prefix "syntax"
(pass-if "rank and lower bounds"
;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8.
(let ((a '#2u32@2@7((1 2) (3 4))))
(and (array? a)
(typed-array? a 'u32)
(= (array-rank a) 2)
(let loop ((bounds '((2 7) (2 8) (3 7) (3 8)))
(result #t))
(if (null? bounds)
result
(and result
(loop (cdr bounds)
(apply array-in-bounds? a (car bounds)))))))))
(pass-if "negative lower bound"
(let ((a '#1@-3(a b)))
(and (array? a)
(= (array-rank a) 1)
(array-in-bounds? a -3) (array-in-bounds? a -2)
(eq? 'a (array-ref a -3))
(eq? 'b (array-ref a -2)))))
(pass-if-exception "negative length" exception:length-non-negative
(with-input-from-string "'#1:-3(#t #t)" read)))
;;;
;;; equal? with vector and one-dimensional array
;;;
(pass-if "vector equal? one-dimensional array"
(equal? (make-shared-array #2((a b c) (d e f) (g h i))

12
test-suite/tests/vectors.test
View file

@ -17,6 +17,8 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(define-module (test-suite vectors)
:use-module (test-suite lib))
;; FIXME: As soon as guile supports immutable vectors, this has to be
;; replaced with the appropriate error type and message.
@ -29,3 +31,13 @@
(expect-fail-exception "vector constant"
exception:immutable-vector
(vector-set! '#(1 2 3) 0 4)))
(with-test-prefix "vector->list"
(pass-if "simple vector"
(equal? '(1 2 3) (vector->list #(1 2 3))))
(pass-if "shared array"
(let ((b (make-shared-array #(1) (lambda (x) '(0)) 2)))
(equal? b (list->vector (vector->list b))))))