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

Merge branch 'boehm-demers-weiser-gc' into bdw-gc-static-alloc

Browse source
This commit is contained in:
Ludovic Courtès 2009-01-19 22:31:38 +01:00
commit 5bec288a67
61 changed files with 3565 additions and 6160 deletions
Download patch file Download diff file Expand all files Collapse all files

94
INSTALL
View file

@ -2,15 +2,15 @@ Installation Instructions
*************************
Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005,
2006, 2007 Free Software Foundation, Inc.
2006, 2007, 2008 Free Software Foundation, Inc.
This file is free documentation; the Free Software Foundation gives
This file is free documentation; the Free Software Foundation gives
unlimited permission to copy, distribute and modify it.
Basic Installation
==================
Briefly, the shell commands `./configure; make; make install' should
Briefly, the shell commands `./configure; make; make install' should
configure, build, and install this package. The following
more-detailed instructions are generic; see the `README' file for
instructions specific to this package.
@ -73,9 +73,9 @@ The simplest way to compile this package is:
Compilers and Options
=====================
Some systems require unusual options for compilation or linking that the
`configure' script does not know about. Run `./configure --help' for
details on some of the pertinent environment variables.
Some systems require unusual options for compilation or linking that
the `configure' script does not know about. Run `./configure --help'
for details on some of the pertinent environment variables.
You can give `configure' initial values for configuration parameters
by setting variables in the command line or in the environment. Here
@ -88,7 +88,7 @@ is an example:
Compiling For Multiple Architectures
====================================
You can compile the package for more than one kind of computer at the
You can compile the package for more than one kind of computer at the
same time, by placing the object files for each architecture in their
own directory. To do this, you can use GNU `make'. `cd' to the
directory where you want the object files and executables to go and run
@ -100,10 +100,24 @@ architecture at a time in the source code directory. After you have
installed the package for one architecture, use `make distclean' before
reconfiguring for another architecture.
On MacOS X 10.5 and later systems, you can create libraries and
executables that work on multiple system types--known as "fat" or
"universal" binaries--by specifying multiple `-arch' options to the
compiler but only a single `-arch' option to the preprocessor. Like
this:
./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
CPP="gcc -E" CXXCPP="g++ -E"
This is not guaranteed to produce working output in all cases, you
may have to build one architecture at a time and combine the results
using the `lipo' tool if you have problems.
Installation Names
==================
By default, `make install' installs the package's commands under
By default, `make install' installs the package's commands under
`/usr/local/bin', include files under `/usr/local/include', etc. You
can specify an installation prefix other than `/usr/local' by giving
`configure' the option `--prefix=PREFIX'.
@ -126,7 +140,7 @@ option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'.
Optional Features
=================
Some packages pay attention to `--enable-FEATURE' options to
Some packages pay attention to `--enable-FEATURE' options to
`configure', where FEATURE indicates an optional part of the package.
They may also pay attention to `--with-PACKAGE' options, where PACKAGE
is something like `gnu-as' or `x' (for the X Window System). The
@ -138,14 +152,36 @@ find the X include and library files automatically, but if it doesn't,
you can use the `configure' options `--x-includes=DIR' and
`--x-libraries=DIR' to specify their locations.
Particular systems
==================
On HP-UX, the default C compiler is not ANSI C compatible. If GNU
CC is not installed, it is recommended to use the following options in
order to use an ANSI C compiler:
./configure CC="cc -Ae"
and if that doesn't work, install pre-built binaries of GCC for HP-UX.
On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot
parse its `<wchar.h>' header file. The option `-nodtk' can be used as
a workaround. If GNU CC is not installed, it is therefore recommended
to try
./configure CC="cc"
and if that doesn't work, try
./configure CC="cc -nodtk"
Specifying the System Type
==========================
There may be some features `configure' cannot figure out automatically,
but needs to determine by the type of machine the package will run on.
Usually, assuming the package is built to be run on the _same_
architectures, `configure' can figure that out, but if it prints a
message saying it cannot guess the machine type, give it the
There may be some features `configure' cannot figure out
automatically, but needs to determine by the type of machine the package
will run on. Usually, assuming the package is built to be run on the
_same_ architectures, `configure' can figure that out, but if it prints
a message saying it cannot guess the machine type, give it the
`--build=TYPE' option. TYPE can either be a short name for the system
type, such as `sun4', or a canonical name which has the form:
@ -171,9 +207,9 @@ eventually be run) with `--host=TYPE'.
Sharing Defaults
================
If you want to set default values for `configure' scripts to share, you
can create a site shell script called `config.site' that gives default
values for variables like `CC', `cache_file', and `prefix'.
If you want to set default values for `configure' scripts to share,
you can create a site shell script called `config.site' that gives
default values for variables like `CC', `cache_file', and `prefix'.
`configure' looks for `PREFIX/share/config.site' if it exists, then
`PREFIX/etc/config.site' if it exists. Or, you can set the
`CONFIG_SITE' environment variable to the location of the site script.
@ -182,7 +218,7 @@ A warning: not all `configure' scripts look for a site script.
Defining Variables
==================
Variables not defined in a site shell script can be set in the
Variables not defined in a site shell script can be set in the
environment passed to `configure'. However, some packages may run
configure again during the build, and the customized values of these
variables may be lost. In order to avoid this problem, you should set
@ -201,11 +237,19 @@ an Autoconf bug. Until the bug is fixed you can use this workaround:
`configure' Invocation
======================
`configure' recognizes the following options to control how it operates.
`configure' recognizes the following options to control how it
operates.
`--help'
`-h'
Print a summary of the options to `configure', and exit.
Print a summary of all of the options to `configure', and exit.
`--help=short'
`--help=recursive'
Print a summary of the options unique to this package's
`configure', and exit. The `short' variant lists options used
only in the top level, while the `recursive' variant lists options
also present in any nested packages.
`--version'
`-V'
@ -232,6 +276,16 @@ an Autoconf bug. Until the bug is fixed you can use this workaround:
Look for the package's source code in directory DIR. Usually
`configure' can determine that directory automatically.
`--prefix=DIR'
Use DIR as the installation prefix. *Note Installation Names::
for more details, including other options available for fine-tuning
the installation locations.
`--no-create'
`-n'
Run the configure checks, but stop before creating any output
files.
`configure' also accepts some other, not widely useful, options. Run
`configure --help' for more details.

6
NEWS
View file

@ -40,6 +40,12 @@ application code.
** Functions for handling `scm_option' now no longer require an argument
indicating length of the `scm_t_option' array.
Changes in 1.8.7 (since 1.8.6)
* Bugs fixed
** Fix %fast-slot-ref/set!, to avoid possible segmentation fault
Changes in 1.8.6 (since 1.8.5)

9
autogen.sh
View file

@ -25,13 +25,4 @@ echo ""
autoreconf -i --force --verbose
echo "guile-readline..."
(cd guile-readline && ./autogen.sh)
# Copy versions of config.guess and config.sub from Guile's repository to
# build-aux and guile-readline.
cp -f config.guess config.sub build-aux/
cp -f config.guess config.sub guile-readline/
echo "Now run configure and make."
echo "You must pass the \`--enable-maintainer-mode' option to configure."

1526
config.guess vendored
View file

File diff suppressed because it is too large Load diff

1654
config.sub vendored
View file

File diff suppressed because it is too large Load diff

2
configure.in
View file

@ -1589,6 +1589,8 @@ AC_CONFIG_FILES([libguile/guile-snarf-docs],
[chmod +x libguile/guile-snarf-docs])
AC_CONFIG_FILES([test-suite/standalone/test-use-srfi],
[chmod +x test-suite/standalone/test-use-srfi])
AC_CONFIG_FILES([test-suite/standalone/test-fast-slot-ref],
[chmod +x test-suite/standalone/test-fast-slot-ref])
AC_OUTPUT

197
lib/Makefile.am
View file

@ -1,6 +1,6 @@
## DO NOT EDIT! GENERATED AUTOMATICALLY!
## Process this file with automake to produce Makefile.in.
# Copyright (C) 2002-2008 Free Software Foundation, Inc.
# Copyright (C) 2002-2009 Free Software Foundation, Inc.
#
# This file is free software, distributed under the terms of the GNU
# General Public License. As a special exception to the GNU General
@ -9,7 +9,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl alloca autobuild extensions full-read full-write strcase strftime
# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild extensions full-read full-write strcase strftime
AUTOMAKE_OPTIONS = 1.5 gnits
@ -36,17 +36,6 @@ libgnu_la_DEPENDENCIES = $(gl_LTLIBOBJS)
EXTRA_libgnu_la_SOURCES =
libgnu_la_LDFLAGS = $(AM_LDFLAGS)
## begin gnulib module alloca
EXTRA_DIST += alloca.c
EXTRA_libgnu_la_SOURCES += alloca.c
libgnu_la_LIBADD += @LTALLOCA@
libgnu_la_DEPENDENCIES += @LTALLOCA@
## end gnulib module alloca
## begin gnulib module alloca-opt
BUILT_SOURCES += $(ALLOCA_H)
@ -64,6 +53,62 @@ EXTRA_DIST += alloca.in.h
## end gnulib module alloca-opt
## begin gnulib module configmake
# Retrieve values of the variables through 'configure' followed by
# 'make', not directly through 'configure', so that a user who
# sets some of these variables consistently on the 'make' command
# line gets correct results.
#
# One advantage of this approach, compared to the classical
# approach of adding -DLIBDIR=\"$(libdir)\" etc. to AM_CPPFLAGS,
# is that it protects against the use of undefined variables.
# If, say, $(libdir) is not set in the Makefile, LIBDIR is not
# defined by this module, and code using LIBDIR gives a
# compilation error.
#
# Another advantage is that 'make' output is shorter.
#
# Listed in the same order as the GNU makefile conventions.
# The Automake-defined pkg* macros are appended, in the order
# listed in the Automake 1.10a+ documentation.
configmake.h: Makefile
rm -f $@-t $@
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
echo '#define PREFIX "$(prefix)"'; \
echo '#define EXEC_PREFIX "$(exec_prefix)"'; \
echo '#define BINDIR "$(bindir)"'; \
echo '#define SBINDIR "$(sbindir)"'; \
echo '#define LIBEXECDIR "$(libexecdir)"'; \
echo '#define DATAROOTDIR "$(datarootdir)"'; \
echo '#define DATADIR "$(datadir)"'; \
echo '#define SYSCONFDIR "$(sysconfdir)"'; \
echo '#define SHAREDSTATEDIR "$(sharedstatedir)"'; \
echo '#define LOCALSTATEDIR "$(localstatedir)"'; \
echo '#define INCLUDEDIR "$(includedir)"'; \
echo '#define OLDINCLUDEDIR "$(oldincludedir)"'; \
echo '#define DOCDIR "$(docdir)"'; \
echo '#define INFODIR "$(infodir)"'; \
echo '#define HTMLDIR "$(htmldir)"'; \
echo '#define DVIDIR "$(dvidir)"'; \
echo '#define PDFDIR "$(pdfdir)"'; \
echo '#define PSDIR "$(psdir)"'; \
echo '#define LIBDIR "$(libdir)"'; \
echo '#define LISPDIR "$(lispdir)"'; \
echo '#define LOCALEDIR "$(localedir)"'; \
echo '#define MANDIR "$(mandir)"'; \
echo '#define MANEXT "$(manext)"'; \
echo '#define PKGDATADIR "$(pkgdatadir)"'; \
echo '#define PKGINCLUDEDIR "$(pkgincludedir)"'; \
echo '#define PKGLIBDIR "$(pkglibdir)"'; \
echo '#define PKGLIBEXECDIR "$(pkglibexecdir)"'; \
} | sed '/""/d' > $@-t
mv $@-t $@
BUILT_SOURCES += configmake.h
CLEANFILES += configmake.h configmake.h-t
## end gnulib module configmake
## begin gnulib module full-read
libgnu_la_SOURCES += full-read.h full-read.c
@ -84,6 +129,91 @@ EXTRA_DIST += $(top_srcdir)/build-aux/link-warning.h
## end gnulib module link-warning
## begin gnulib module localcharset
libgnu_la_SOURCES += localcharset.h localcharset.c
# We need the following in order to install a simple file in $(libdir)
# which is shared with other installed packages. We use a list of referencing
# packages so that "make uninstall" will remove the file if and only if it
# is not used by another installed package.
# On systems with glibc-2.1 or newer, the file is redundant, therefore we
# avoid installing it.
all-local: charset.alias ref-add.sed ref-del.sed
charset_alias = $(DESTDIR)$(libdir)/charset.alias
charset_tmp = $(DESTDIR)$(libdir)/charset.tmp
install-exec-local: all-local
test $(GLIBC21) != no || $(mkinstalldirs) $(DESTDIR)$(libdir)
if test -f $(charset_alias); then \
sed -f ref-add.sed $(charset_alias) > $(charset_tmp) ; \
$(INSTALL_DATA) $(charset_tmp) $(charset_alias) ; \
rm -f $(charset_tmp) ; \
else \
if test $(GLIBC21) = no; then \
sed -f ref-add.sed charset.alias > $(charset_tmp) ; \
$(INSTALL_DATA) $(charset_tmp) $(charset_alias) ; \
rm -f $(charset_tmp) ; \
fi ; \
fi
uninstall-local: all-local
if test -f $(charset_alias); then \
sed -f ref-del.sed $(charset_alias) > $(charset_tmp); \
if grep '^# Packages using this file: $$' $(charset_tmp) \
> /dev/null; then \
rm -f $(charset_alias); \
else \
$(INSTALL_DATA) $(charset_tmp) $(charset_alias); \
fi; \
rm -f $(charset_tmp); \
fi
charset.alias: config.charset
rm -f t-$@ $@
$(SHELL) $(srcdir)/config.charset '$(host)' > t-$@
mv t-$@ $@
SUFFIXES += .sed .sin
.sin.sed:
rm -f t-$@ $@
sed -e '/^#/d' -e 's/@''PACKAGE''@/$(PACKAGE)/g' $< > t-$@
mv t-$@ $@
CLEANFILES += charset.alias ref-add.sed ref-del.sed
EXTRA_DIST += config.charset ref-add.sin ref-del.sin
## end gnulib module localcharset
## begin gnulib module mbrlen
EXTRA_DIST += mbrlen.c
EXTRA_libgnu_la_SOURCES += mbrlen.c
## end gnulib module mbrlen
## begin gnulib module mbrtowc
EXTRA_DIST += mbrtowc.c
EXTRA_libgnu_la_SOURCES += mbrtowc.c
## end gnulib module mbrtowc
## begin gnulib module mbsinit
EXTRA_DIST += mbsinit.c
EXTRA_libgnu_la_SOURCES += mbsinit.c
## end gnulib module mbsinit
## begin gnulib module safe-read
@ -129,6 +259,13 @@ EXTRA_libgnu_la_SOURCES += strcasecmp.c strncasecmp.c
## end gnulib module strcase
## begin gnulib module streq
EXTRA_DIST += streq.h
## end gnulib module streq
## begin gnulib module strftime
@ -284,10 +421,40 @@ wchar.h: wchar.in.h
sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''NEXT_WCHAR_H''@|$(NEXT_WCHAR_H)|g' \
-e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \
-e 's|@''HAVE_WCHAR_H''@|$(HAVE_WCHAR_H)|g' \
-e 's|@''GNULIB_BTOWC''@|$(GNULIB_BTOWC)|g' \
-e 's|@''GNULIB_WCTOB''@|$(GNULIB_WCTOB)|g' \
-e 's|@''GNULIB_MBSINIT''@|$(GNULIB_MBSINIT)|g' \
-e 's|@''GNULIB_MBRTOWC''@|$(GNULIB_MBRTOWC)|g' \
-e 's|@''GNULIB_MBRLEN''@|$(GNULIB_MBRLEN)|g' \
-e 's|@''GNULIB_MBSRTOWCS''@|$(GNULIB_MBSRTOWCS)|g' \
-e 's|@''GNULIB_MBSNRTOWCS''@|$(GNULIB_MBSNRTOWCS)|g' \
-e 's|@''GNULIB_WCRTOMB''@|$(GNULIB_WCRTOMB)|g' \
-e 's|@''GNULIB_WCSRTOMBS''@|$(GNULIB_WCSRTOMBS)|g' \
-e 's|@''GNULIB_WCSNRTOMBS''@|$(GNULIB_WCSNRTOMBS)|g' \
-e 's|@''GNULIB_WCWIDTH''@|$(GNULIB_WCWIDTH)|g' \
-e 's/@''HAVE_WINT_T''@/$(HAVE_WINT_T)/g' \
-e 's|@''HAVE_WINT_T''@|$(HAVE_WINT_T)|g' \
-e 's|@''HAVE_BTOWC''@|$(HAVE_BTOWC)|g' \
-e 's|@''HAVE_MBSINIT''@|$(HAVE_MBSINIT)|g' \
-e 's|@''HAVE_MBRTOWC''@|$(HAVE_MBRTOWC)|g' \
-e 's|@''HAVE_MBRLEN''@|$(HAVE_MBRLEN)|g' \
-e 's|@''HAVE_MBSRTOWCS''@|$(HAVE_MBSRTOWCS)|g' \
-e 's|@''HAVE_MBSNRTOWCS''@|$(HAVE_MBSNRTOWCS)|g' \
-e 's|@''HAVE_WCRTOMB''@|$(HAVE_WCRTOMB)|g' \
-e 's|@''HAVE_WCSRTOMBS''@|$(HAVE_WCSRTOMBS)|g' \
-e 's|@''HAVE_WCSNRTOMBS''@|$(HAVE_WCSNRTOMBS)|g' \
-e 's|@''HAVE_DECL_WCTOB''@|$(HAVE_DECL_WCTOB)|g' \
-e 's|@''HAVE_DECL_WCWIDTH''@|$(HAVE_DECL_WCWIDTH)|g' \
-e 's|@''REPLACE_MBSTATE_T''@|$(REPLACE_MBSTATE_T)|g' \
-e 's|@''REPLACE_BTOWC''@|$(REPLACE_BTOWC)|g' \
-e 's|@''REPLACE_WCTOB''@|$(REPLACE_WCTOB)|g' \
-e 's|@''REPLACE_MBSINIT''@|$(REPLACE_MBSINIT)|g' \
-e 's|@''REPLACE_MBRTOWC''@|$(REPLACE_MBRTOWC)|g' \
-e 's|@''REPLACE_MBRLEN''@|$(REPLACE_MBRLEN)|g' \
-e 's|@''REPLACE_MBSRTOWCS''@|$(REPLACE_MBSRTOWCS)|g' \
-e 's|@''REPLACE_MBSNRTOWCS''@|$(REPLACE_MBSNRTOWCS)|g' \
-e 's|@''REPLACE_WCRTOMB''@|$(REPLACE_WCRTOMB)|g' \
-e 's|@''REPLACE_WCSRTOMBS''@|$(REPLACE_WCSRTOMBS)|g' \
-e 's|@''REPLACE_WCWIDTH''@|$(REPLACE_WCWIDTH)|g' \
-e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \
< $(srcdir)/wchar.in.h; \

489
lib/alloca.c
View file

@ -1,489 +0,0 @@
/* alloca.c -- allocate automatically reclaimed memory
(Mostly) portable public-domain implementation -- D A Gwyn
This implementation of the PWB library alloca function,
which is used to allocate space off the run-time stack so
that it is automatically reclaimed upon procedure exit,
was inspired by discussions with J. Q. Johnson of Cornell.
J.Otto Tennant <jot@cray.com> contributed the Cray support.
There are some preprocessor constants that can
be defined when compiling for your specific system, for
improved efficiency; however, the defaults should be okay.
The general concept of this implementation is to keep
track of all alloca-allocated blocks, and reclaim any
that are found to be deeper in the stack than the current
invocation. This heuristic does not reclaim storage as
soon as it becomes invalid, but it will do so eventually.
As a special case, alloca(0) reclaims storage without
allocating any. It is a good idea to use alloca(0) in
your main control loop, etc. to force garbage collection. */
#include <config.h>
#include <alloca.h>
#include <string.h>
#include <stdlib.h>
#ifdef emacs
# include "lisp.h"
# include "blockinput.h"
# ifdef EMACS_FREE
# undef free
# define free EMACS_FREE
# endif
#else
# define memory_full() abort ()
#endif
/* If compiling with GCC 2, this file's not needed. */
#if !defined (__GNUC__) || __GNUC__ < 2
/* If someone has defined alloca as a macro,
there must be some other way alloca is supposed to work. */
# ifndef alloca
# ifdef emacs
# ifdef static
/* actually, only want this if static is defined as ""
-- this is for usg, in which emacs must undefine static
in order to make unexec workable
*/
# ifndef STACK_DIRECTION
you
lose
-- must know STACK_DIRECTION at compile-time
/* Using #error here is not wise since this file should work for
old and obscure compilers. */
# endif /* STACK_DIRECTION undefined */
# endif /* static */
# endif /* emacs */
/* If your stack is a linked list of frames, you have to
provide an "address metric" ADDRESS_FUNCTION macro. */
# if defined (CRAY) && defined (CRAY_STACKSEG_END)
long i00afunc ();
# define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
# else
# define ADDRESS_FUNCTION(arg) &(arg)
# endif
/* Define STACK_DIRECTION if you know the direction of stack
growth for your system; otherwise it will be automatically
deduced at run-time.
STACK_DIRECTION > 0 => grows toward higher addresses
STACK_DIRECTION < 0 => grows toward lower addresses
STACK_DIRECTION = 0 => direction of growth unknown */
# ifndef STACK_DIRECTION
# define STACK_DIRECTION 0 /* Direction unknown. */
# endif
# if STACK_DIRECTION != 0
# define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
# else /* STACK_DIRECTION == 0; need run-time code. */
static int stack_dir; /* 1 or -1 once known. */
# define STACK_DIR stack_dir
static void
find_stack_direction (void)
{
static char *addr = NULL; /* Address of first `dummy', once known. */
auto char dummy; /* To get stack address. */
if (addr == NULL)
{ /* Initial entry. */
addr = ADDRESS_FUNCTION (dummy);
find_stack_direction (); /* Recurse once. */
}
else
{
/* Second entry. */
if (ADDRESS_FUNCTION (dummy) > addr)
stack_dir = 1; /* Stack grew upward. */
else
stack_dir = -1; /* Stack grew downward. */
}
}
# endif /* STACK_DIRECTION == 0 */
/* An "alloca header" is used to:
(a) chain together all alloca'ed blocks;
(b) keep track of stack depth.
It is very important that sizeof(header) agree with malloc
alignment chunk size. The following default should work okay. */
# ifndef ALIGN_SIZE
# define ALIGN_SIZE sizeof(double)
# endif
typedef union hdr
{
char align[ALIGN_SIZE]; /* To force sizeof(header). */
struct
{
union hdr *next; /* For chaining headers. */
char *deep; /* For stack depth measure. */
} h;
} header;
static header *last_alloca_header = NULL; /* -> last alloca header. */
/* Return a pointer to at least SIZE bytes of storage,
which will be automatically reclaimed upon exit from
the procedure that called alloca. Originally, this space
was supposed to be taken from the current stack frame of the
caller, but that method cannot be made to work for some
implementations of C, for example under Gould's UTX/32. */
void *
alloca (size_t size)
{
auto char probe; /* Probes stack depth: */
register char *depth = ADDRESS_FUNCTION (probe);
# if STACK_DIRECTION == 0
if (STACK_DIR == 0) /* Unknown growth direction. */
find_stack_direction ();
# endif
/* Reclaim garbage, defined as all alloca'd storage that
was allocated from deeper in the stack than currently. */
{
register header *hp; /* Traverses linked list. */
# ifdef emacs
BLOCK_INPUT;
# endif
for (hp = last_alloca_header; hp != NULL;)
if ((STACK_DIR > 0 && hp->h.deep > depth)
|| (STACK_DIR < 0 && hp->h.deep < depth))
{
register header *np = hp->h.next;
free (hp); /* Collect garbage. */
hp = np; /* -> next header. */
}
else
break; /* Rest are not deeper. */
last_alloca_header = hp; /* -> last valid storage. */
# ifdef emacs
UNBLOCK_INPUT;
# endif
}
if (size == 0)
return NULL; /* No allocation required. */
/* Allocate combined header + user data storage. */
{
/* Address of header. */
register header *new;
size_t combined_size = sizeof (header) + size;
if (combined_size < sizeof (header))
memory_full ();
new = malloc (combined_size);
if (! new)
memory_full ();
new->h.next = last_alloca_header;
new->h.deep = depth;
last_alloca_header = new;
/* User storage begins just after header. */
return (void *) (new + 1);
}
}
# if defined (CRAY) && defined (CRAY_STACKSEG_END)
# ifdef DEBUG_I00AFUNC
# include <stdio.h>
# endif
# ifndef CRAY_STACK
# define CRAY_STACK
# ifndef CRAY2
/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
struct stack_control_header
{
long shgrow:32; /* Number of times stack has grown. */
long shaseg:32; /* Size of increments to stack. */
long shhwm:32; /* High water mark of stack. */
long shsize:32; /* Current size of stack (all segments). */
};
/* The stack segment linkage control information occurs at
the high-address end of a stack segment. (The stack
grows from low addresses to high addresses.) The initial
part of the stack segment linkage control information is
0200 (octal) words. This provides for register storage
for the routine which overflows the stack. */
struct stack_segment_linkage
{
long ss[0200]; /* 0200 overflow words. */
long sssize:32; /* Number of words in this segment. */
long ssbase:32; /* Offset to stack base. */
long:32;
long sspseg:32; /* Offset to linkage control of previous
segment of stack. */
long:32;
long sstcpt:32; /* Pointer to task common address block. */
long sscsnm; /* Private control structure number for
microtasking. */
long ssusr1; /* Reserved for user. */
long ssusr2; /* Reserved for user. */
long sstpid; /* Process ID for pid based multi-tasking. */
long ssgvup; /* Pointer to multitasking thread giveup. */
long sscray[7]; /* Reserved for Cray Research. */
long ssa0;
long ssa1;
long ssa2;
long ssa3;
long ssa4;
long ssa5;
long ssa6;
long ssa7;
long sss0;
long sss1;
long sss2;
long sss3;
long sss4;
long sss5;
long sss6;
long sss7;
};
# else /* CRAY2 */
/* The following structure defines the vector of words
returned by the STKSTAT library routine. */
struct stk_stat
{
long now; /* Current total stack size. */
long maxc; /* Amount of contiguous space which would
be required to satisfy the maximum
stack demand to date. */
long high_water; /* Stack high-water mark. */
long overflows; /* Number of stack overflow ($STKOFEN) calls. */
long hits; /* Number of internal buffer hits. */
long extends; /* Number of block extensions. */
long stko_mallocs; /* Block allocations by $STKOFEN. */
long underflows; /* Number of stack underflow calls ($STKRETN). */
long stko_free; /* Number of deallocations by $STKRETN. */
long stkm_free; /* Number of deallocations by $STKMRET. */
long segments; /* Current number of stack segments. */
long maxs; /* Maximum number of stack segments so far. */
long pad_size; /* Stack pad size. */
long current_address; /* Current stack segment address. */
long current_size; /* Current stack segment size. This
number is actually corrupted by STKSTAT to
include the fifteen word trailer area. */
long initial_address; /* Address of initial segment. */
long initial_size; /* Size of initial segment. */
};
/* The following structure describes the data structure which trails
any stack segment. I think that the description in 'asdef' is
out of date. I only describe the parts that I am sure about. */
struct stk_trailer
{
long this_address; /* Address of this block. */
long this_size; /* Size of this block (does not include
this trailer). */
long unknown2;
long unknown3;
long link; /* Address of trailer block of previous
segment. */
long unknown5;
long unknown6;
long unknown7;
long unknown8;
long unknown9;
long unknown10;
long unknown11;
long unknown12;
long unknown13;
long unknown14;
};
# endif /* CRAY2 */
# endif /* not CRAY_STACK */
# ifdef CRAY2
/* Determine a "stack measure" for an arbitrary ADDRESS.
I doubt that "lint" will like this much. */
static long
i00afunc (long *address)
{
struct stk_stat status;
struct stk_trailer *trailer;
long *block, size;
long result = 0;
/* We want to iterate through all of the segments. The first
step is to get the stack status structure. We could do this
more quickly and more directly, perhaps, by referencing the
$LM00 common block, but I know that this works. */
STKSTAT (&status);
/* Set up the iteration. */
trailer = (struct stk_trailer *) (status.current_address
+ status.current_size
- 15);
/* There must be at least one stack segment. Therefore it is
a fatal error if "trailer" is null. */
if (trailer == 0)
abort ();
/* Discard segments that do not contain our argument address. */
while (trailer != 0)
{
block = (long *) trailer->this_address;
size = trailer->this_size;
if (block == 0 || size == 0)
abort ();
trailer = (struct stk_trailer *) trailer->link;
if ((block <= address) && (address < (block + size)))
break;
}
/* Set the result to the offset in this segment and add the sizes
of all predecessor segments. */
result = address - block;
if (trailer == 0)
{
return result;
}
do
{
if (trailer->this_size <= 0)
abort ();
result += trailer->this_size;
trailer = (struct stk_trailer *) trailer->link;
}
while (trailer != 0);
/* We are done. Note that if you present a bogus address (one
not in any segment), you will get a different number back, formed
from subtracting the address of the first block. This is probably
not what you want. */
return (result);
}
# else /* not CRAY2 */
/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
Determine the number of the cell within the stack,
given the address of the cell. The purpose of this
routine is to linearize, in some sense, stack addresses
for alloca. */
static long
i00afunc (long address)
{
long stkl = 0;
long size, pseg, this_segment, stack;
long result = 0;
struct stack_segment_linkage *ssptr;
/* Register B67 contains the address of the end of the
current stack segment. If you (as a subprogram) store
your registers on the stack and find that you are past
the contents of B67, you have overflowed the segment.
B67 also points to the stack segment linkage control
area, which is what we are really interested in. */
stkl = CRAY_STACKSEG_END ();
ssptr = (struct stack_segment_linkage *) stkl;
/* If one subtracts 'size' from the end of the segment,
one has the address of the first word of the segment.
If this is not the first segment, 'pseg' will be
nonzero. */
pseg = ssptr->sspseg;
size = ssptr->sssize;
this_segment = stkl - size;
/* It is possible that calling this routine itself caused
a stack overflow. Discard stack segments which do not
contain the target address. */
while (!(this_segment <= address && address <= stkl))
{
# ifdef DEBUG_I00AFUNC
fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
# endif
if (pseg == 0)
break;
stkl = stkl - pseg;
ssptr = (struct stack_segment_linkage *) stkl;
size = ssptr->sssize;
pseg = ssptr->sspseg;
this_segment = stkl - size;
}
result = address - this_segment;
/* If you subtract pseg from the current end of the stack,
you get the address of the previous stack segment's end.
This seems a little convoluted to me, but I'll bet you save
a cycle somewhere. */
while (pseg != 0)
{
# ifdef DEBUG_I00AFUNC
fprintf (stderr, "%011o %011o\n", pseg, size);
# endif
stkl = stkl - pseg;
ssptr = (struct stack_segment_linkage *) stkl;
size = ssptr->sssize;
pseg = ssptr->sspseg;
result += size;
}
return (result);
}
# endif /* not CRAY2 */
# endif /* CRAY */
# endif /* no alloca */
#endif /* not GCC version 2 */

649
lib/config.charset Executable file
View file

@ -0,0 +1,649 @@
#! /bin/sh
# Output a system dependent table of character encoding aliases.
#
# Copyright (C) 2000-2004, 2006-2008 Free Software Foundation, Inc.
#
# This program 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, 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 Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser 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.
#
# The table consists of lines of the form
# ALIAS CANONICAL
#
# ALIAS is the (system dependent) result of "nl_langinfo (CODESET)".
# ALIAS is compared in a case sensitive way.
#
# CANONICAL is the GNU canonical name for this character encoding.
# It must be an encoding supported by libiconv. Support by GNU libc is
# also desirable. CANONICAL is case insensitive. Usually an upper case
# MIME charset name is preferred.
# The current list of GNU canonical charset names is as follows.
#
# name MIME? used by which systems
# ASCII, ANSI_X3.4-1968 glibc solaris freebsd netbsd darwin
# ISO-8859-1 Y glibc aix hpux irix osf solaris freebsd netbsd openbsd darwin
# ISO-8859-2 Y glibc aix hpux irix osf solaris freebsd netbsd openbsd darwin
# ISO-8859-3 Y glibc solaris
# ISO-8859-4 Y osf solaris freebsd netbsd openbsd darwin
# ISO-8859-5 Y glibc aix hpux irix osf solaris freebsd netbsd openbsd darwin
# ISO-8859-6 Y glibc aix hpux solaris
# ISO-8859-7 Y glibc aix hpux irix osf solaris netbsd openbsd darwin
# ISO-8859-8 Y glibc aix hpux osf solaris
# ISO-8859-9 Y glibc aix hpux irix osf solaris darwin
# ISO-8859-13 glibc netbsd openbsd darwin
# ISO-8859-14 glibc
# ISO-8859-15 glibc aix osf solaris freebsd netbsd openbsd darwin
# KOI8-R Y glibc solaris freebsd netbsd openbsd darwin
# KOI8-U Y glibc freebsd netbsd openbsd darwin
# KOI8-T glibc
# CP437 dos
# CP775 dos
# CP850 aix osf dos
# CP852 dos
# CP855 dos
# CP856 aix
# CP857 dos
# CP861 dos
# CP862 dos
# CP864 dos
# CP865 dos
# CP866 freebsd netbsd openbsd darwin dos
# CP869 dos
# CP874 woe32 dos
# CP922 aix
# CP932 aix woe32 dos
# CP943 aix
# CP949 osf woe32 dos
# CP950 woe32 dos
# CP1046 aix
# CP1124 aix
# CP1125 dos
# CP1129 aix
# CP1250 woe32
# CP1251 glibc solaris netbsd openbsd darwin woe32
# CP1252 aix woe32
# CP1253 woe32
# CP1254 woe32
# CP1255 glibc woe32
# CP1256 woe32
# CP1257 woe32
# GB2312 Y glibc aix hpux irix solaris freebsd netbsd darwin
# EUC-JP Y glibc aix hpux irix osf solaris freebsd netbsd darwin
# EUC-KR Y glibc aix hpux irix osf solaris freebsd netbsd darwin
# EUC-TW glibc aix hpux irix osf solaris netbsd
# BIG5 Y glibc aix hpux osf solaris freebsd netbsd darwin
# BIG5-HKSCS glibc solaris
# GBK glibc aix osf solaris woe32 dos
# GB18030 glibc solaris netbsd
# SHIFT_JIS Y hpux osf solaris freebsd netbsd darwin
# JOHAB glibc solaris woe32
# TIS-620 glibc aix hpux osf solaris
# VISCII Y glibc
# TCVN5712-1 glibc
# GEORGIAN-PS glibc
# HP-ROMAN8 hpux
# HP-ARABIC8 hpux
# HP-GREEK8 hpux
# HP-HEBREW8 hpux
# HP-TURKISH8 hpux
# HP-KANA8 hpux
# DEC-KANJI osf
# DEC-HANYU osf
# UTF-8 Y glibc aix hpux osf solaris netbsd darwin
#
# Note: Names which are not marked as being a MIME name should not be used in
# Internet protocols for information interchange (mail, news, etc.).
#
# Note: ASCII and ANSI_X3.4-1968 are synonymous canonical names. Applications
# must understand both names and treat them as equivalent.
#
# The first argument passed to this file is the canonical host specification,
# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
# or
# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
host="$1"
os=`echo "$host" | sed -e 's/^[^-]*-[^-]*-\(.*\)$/\1/'`
echo "# This file contains a table of character encoding aliases,"
echo "# suitable for operating system '${os}'."
echo "# It was automatically generated from config.charset."
# List of references, updated during installation:
echo "# Packages using this file: "
case "$os" in
linux-gnulibc1*)
# Linux libc5 doesn't have nl_langinfo(CODESET); therefore
# localcharset.c falls back to using the full locale name
# from the environment variables.
echo "C ASCII"
echo "POSIX ASCII"
for l in af af_ZA ca ca_ES da da_DK de de_AT de_BE de_CH de_DE de_LU \
en en_AU en_BW en_CA en_DK en_GB en_IE en_NZ en_US en_ZA \
en_ZW es es_AR es_BO es_CL es_CO es_DO es_EC es_ES es_GT \
es_HN es_MX es_PA es_PE es_PY es_SV es_US es_UY es_VE et \
et_EE eu eu_ES fi fi_FI fo fo_FO fr fr_BE fr_CA fr_CH fr_FR \
fr_LU ga ga_IE gl gl_ES id id_ID in in_ID is is_IS it it_CH \
it_IT kl kl_GL nl nl_BE nl_NL no no_NO pt pt_BR pt_PT sv \
sv_FI sv_SE; do
echo "$l ISO-8859-1"
echo "$l.iso-8859-1 ISO-8859-1"
echo "$l.iso-8859-15 ISO-8859-15"
echo "$l.iso-8859-15@euro ISO-8859-15"
echo "$l@euro ISO-8859-15"
echo "$l.cp-437 CP437"
echo "$l.cp-850 CP850"
echo "$l.cp-1252 CP1252"
echo "$l.cp-1252@euro CP1252"
#echo "$l.atari-st ATARI-ST" # not a commonly used encoding
echo "$l.utf-8 UTF-8"
echo "$l.utf-8@euro UTF-8"
done
for l in cs cs_CZ hr hr_HR hu hu_HU pl pl_PL ro ro_RO sk sk_SK sl \
sl_SI sr sr_CS sr_YU; do
echo "$l ISO-8859-2"
echo "$l.iso-8859-2 ISO-8859-2"
echo "$l.cp-852 CP852"
echo "$l.cp-1250 CP1250"
echo "$l.utf-8 UTF-8"
done
for l in mk mk_MK ru ru_RU; do
echo "$l ISO-8859-5"
echo "$l.iso-8859-5 ISO-8859-5"
echo "$l.koi8-r KOI8-R"
echo "$l.cp-866 CP866"
echo "$l.cp-1251 CP1251"
echo "$l.utf-8 UTF-8"
done
for l in ar ar_SA; do
echo "$l ISO-8859-6"
echo "$l.iso-8859-6 ISO-8859-6"
echo "$l.cp-864 CP864"
#echo "$l.cp-868 CP868" # not a commonly used encoding
echo "$l.cp-1256 CP1256"
echo "$l.utf-8 UTF-8"
done
for l in el el_GR gr gr_GR; do
echo "$l ISO-8859-7"
echo "$l.iso-8859-7 ISO-8859-7"
echo "$l.cp-869 CP869"
echo "$l.cp-1253 CP1253"
echo "$l.cp-1253@euro CP1253"
echo "$l.utf-8 UTF-8"
echo "$l.utf-8@euro UTF-8"
done
for l in he he_IL iw iw_IL; do
echo "$l ISO-8859-8"
echo "$l.iso-8859-8 ISO-8859-8"
echo "$l.cp-862 CP862"
echo "$l.cp-1255 CP1255"
echo "$l.utf-8 UTF-8"
done
for l in tr tr_TR; do
echo "$l ISO-8859-9"
echo "$l.iso-8859-9 ISO-8859-9"
echo "$l.cp-857 CP857"
echo "$l.cp-1254 CP1254"
echo "$l.utf-8 UTF-8"
done
for l in lt lt_LT lv lv_LV; do
#echo "$l BALTIC" # not a commonly used encoding, wrong encoding name
echo "$l ISO-8859-13"
done
for l in ru_UA uk uk_UA; do
echo "$l KOI8-U"
done
for l in zh zh_CN; do
#echo "$l GB_2312-80" # not a commonly used encoding, wrong encoding name
echo "$l GB2312"
done
for l in ja ja_JP ja_JP.EUC; do
echo "$l EUC-JP"
done
for l in ko ko_KR; do
echo "$l EUC-KR"
done
for l in th th_TH; do
echo "$l TIS-620"
done
for l in fa fa_IR; do
#echo "$l ISIRI-3342" # a broken encoding
echo "$l.utf-8 UTF-8"
done
;;
linux* | *-gnu*)
# With glibc-2.1 or newer, we don't need any canonicalization,
# because glibc has iconv and both glibc and libiconv support all
# GNU canonical names directly. Therefore, the Makefile does not
# need to install the alias file at all.
# The following applies only to glibc-2.0.x and older libcs.
echo "ISO_646.IRV:1983 ASCII"
;;
aix*)
echo "ISO8859-1 ISO-8859-1"
echo "ISO8859-2 ISO-8859-2"
echo "ISO8859-5 ISO-8859-5"
echo "ISO8859-6 ISO-8859-6"
echo "ISO8859-7 ISO-8859-7"
echo "ISO8859-8 ISO-8859-8"
echo "ISO8859-9 ISO-8859-9"
echo "ISO8859-15 ISO-8859-15"
echo "IBM-850 CP850"
echo "IBM-856 CP856"
echo "IBM-921 ISO-8859-13"
echo "IBM-922 CP922"
echo "IBM-932 CP932"
echo "IBM-943 CP943"
echo "IBM-1046 CP1046"
echo "IBM-1124 CP1124"
echo "IBM-1129 CP1129"
echo "IBM-1252 CP1252"
echo "IBM-eucCN GB2312"
echo "IBM-eucJP EUC-JP"
echo "IBM-eucKR EUC-KR"
echo "IBM-eucTW EUC-TW"
echo "big5 BIG5"
echo "GBK GBK"
echo "TIS-620 TIS-620"
echo "UTF-8 UTF-8"
;;
hpux*)
echo "iso88591 ISO-8859-1"
echo "iso88592 ISO-8859-2"
echo "iso88595 ISO-8859-5"
echo "iso88596 ISO-8859-6"
echo "iso88597 ISO-8859-7"
echo "iso88598 ISO-8859-8"
echo "iso88599 ISO-8859-9"
echo "iso885915 ISO-8859-15"
echo "roman8 HP-ROMAN8"
echo "arabic8 HP-ARABIC8"
echo "greek8 HP-GREEK8"
echo "hebrew8 HP-HEBREW8"
echo "turkish8 HP-TURKISH8"
echo "kana8 HP-KANA8"
echo "tis620 TIS-620"
echo "big5 BIG5"
echo "eucJP EUC-JP"
echo "eucKR EUC-KR"
echo "eucTW EUC-TW"
echo "hp15CN GB2312"
#echo "ccdc ?" # what is this?
echo "SJIS SHIFT_JIS"
echo "utf8 UTF-8"
;;
irix*)
echo "ISO8859-1 ISO-8859-1"
echo "ISO8859-2 ISO-8859-2"
echo "ISO8859-5 ISO-8859-5"
echo "ISO8859-7 ISO-8859-7"
echo "ISO8859-9 ISO-8859-9"
echo "eucCN GB2312"
echo "eucJP EUC-JP"
echo "eucKR EUC-KR"
echo "eucTW EUC-TW"
;;
osf*)
echo "ISO8859-1 ISO-8859-1"
echo "ISO8859-2 ISO-8859-2"
echo "ISO8859-4 ISO-8859-4"
echo "ISO8859-5 ISO-8859-5"
echo "ISO8859-7 ISO-8859-7"
echo "ISO8859-8 ISO-8859-8"
echo "ISO8859-9 ISO-8859-9"
echo "ISO8859-15 ISO-8859-15"
echo "cp850 CP850"
echo "big5 BIG5"
echo "dechanyu DEC-HANYU"
echo "dechanzi GB2312"
echo "deckanji DEC-KANJI"
echo "deckorean EUC-KR"
echo "eucJP EUC-JP"
echo "eucKR EUC-KR"
echo "eucTW EUC-TW"
echo "GBK GBK"
echo "KSC5601 CP949"
echo "sdeckanji EUC-JP"
echo "SJIS SHIFT_JIS"
echo "TACTIS TIS-620"
echo "UTF-8 UTF-8"
;;
solaris*)
echo "646 ASCII"
echo "ISO8859-1 ISO-8859-1"
echo "ISO8859-2 ISO-8859-2"
echo "ISO8859-3 ISO-8859-3"
echo "ISO8859-4 ISO-8859-4"
echo "ISO8859-5 ISO-8859-5"
echo "ISO8859-6 ISO-8859-6"
echo "ISO8859-7 ISO-8859-7"
echo "ISO8859-8 ISO-8859-8"
echo "ISO8859-9 ISO-8859-9"
echo "ISO8859-15 ISO-8859-15"
echo "koi8-r KOI8-R"
echo "ansi-1251 CP1251"
echo "BIG5 BIG5"
echo "Big5-HKSCS BIG5-HKSCS"
echo "gb2312 GB2312"
echo "GBK GBK"
echo "GB18030 GB18030"
echo "cns11643 EUC-TW"
echo "5601 EUC-KR"
echo "ko_KR.johap92 JOHAB"
echo "eucJP EUC-JP"
echo "PCK SHIFT_JIS"
echo "TIS620.2533 TIS-620"
#echo "sun_eu_greek ?" # what is this?
echo "UTF-8 UTF-8"
;;
freebsd* | os2*)
# FreeBSD 4.2 doesn't have nl_langinfo(CODESET); therefore
# localcharset.c falls back to using the full locale name
# from the environment variables.
# Likewise for OS/2. OS/2 has XFree86 just like FreeBSD. Just
# reuse FreeBSD's locale data for OS/2.
echo "C ASCII"
echo "US-ASCII ASCII"
for l in la_LN lt_LN; do
echo "$l.ASCII ASCII"
done
for l in da_DK de_AT de_CH de_DE en_AU en_CA en_GB en_US es_ES \
fi_FI fr_BE fr_CA fr_CH fr_FR is_IS it_CH it_IT la_LN \
lt_LN nl_BE nl_NL no_NO pt_PT sv_SE; do
echo "$l.ISO_8859-1 ISO-8859-1"
echo "$l.DIS_8859-15 ISO-8859-15"
done
for l in cs_CZ hr_HR hu_HU la_LN lt_LN pl_PL sl_SI; do
echo "$l.ISO_8859-2 ISO-8859-2"
done
for l in la_LN lt_LT; do
echo "$l.ISO_8859-4 ISO-8859-4"
done
for l in ru_RU ru_SU; do
echo "$l.KOI8-R KOI8-R"
echo "$l.ISO_8859-5 ISO-8859-5"
echo "$l.CP866 CP866"
done
echo "uk_UA.KOI8-U KOI8-U"
echo "zh_TW.BIG5 BIG5"
echo "zh_TW.Big5 BIG5"
echo "zh_CN.EUC GB2312"
echo "ja_JP.EUC EUC-JP"
echo "ja_JP.SJIS SHIFT_JIS"
echo "ja_JP.Shift_JIS SHIFT_JIS"
echo "ko_KR.EUC EUC-KR"
;;
netbsd*)
echo "646 ASCII"
echo "ISO8859-1 ISO-8859-1"
echo "ISO8859-2 ISO-8859-2"
echo "ISO8859-4 ISO-8859-4"
echo "ISO8859-5 ISO-8859-5"
echo "ISO8859-7 ISO-8859-7"
echo "ISO8859-13 ISO-8859-13"
echo "ISO8859-15 ISO-8859-15"
echo "eucCN GB2312"
echo "eucJP EUC-JP"
echo "eucKR EUC-KR"
echo "eucTW EUC-TW"
echo "BIG5 BIG5"
echo "SJIS SHIFT_JIS"
;;
openbsd*)
echo "646 ASCII"
echo "ISO8859-1 ISO-8859-1"
echo "ISO8859-2 ISO-8859-2"
echo "ISO8859-4 ISO-8859-4"
echo "ISO8859-5 ISO-8859-5"
echo "ISO8859-7 ISO-8859-7"
echo "ISO8859-13 ISO-8859-13"
echo "ISO8859-15 ISO-8859-15"
;;
darwin[56]*)
# Darwin 6.8 doesn't have nl_langinfo(CODESET); therefore
# localcharset.c falls back to using the full locale name
# from the environment variables.
echo "C ASCII"
for l in en_AU en_CA en_GB en_US la_LN; do
echo "$l.US-ASCII ASCII"
done
for l in da_DK de_AT de_CH de_DE en_AU en_CA en_GB en_US es_ES \
fi_FI fr_BE fr_CA fr_CH fr_FR is_IS it_CH it_IT nl_BE \
nl_NL no_NO pt_PT sv_SE; do
echo "$l ISO-8859-1"
echo "$l.ISO8859-1 ISO-8859-1"
echo "$l.ISO8859-15 ISO-8859-15"
done
for l in la_LN; do
echo "$l.ISO8859-1 ISO-8859-1"
echo "$l.ISO8859-15 ISO-8859-15"
done
for l in cs_CZ hr_HR hu_HU la_LN pl_PL sl_SI; do
echo "$l.ISO8859-2 ISO-8859-2"
done
for l in la_LN lt_LT; do
echo "$l.ISO8859-4 ISO-8859-4"
done
for l in ru_RU; do
echo "$l.KOI8-R KOI8-R"
echo "$l.ISO8859-5 ISO-8859-5"
echo "$l.CP866 CP866"
done
for l in bg_BG; do
echo "$l.CP1251 CP1251"
done
echo "uk_UA.KOI8-U KOI8-U"
echo "zh_TW.BIG5 BIG5"
echo "zh_TW.Big5 BIG5"
echo "zh_CN.EUC GB2312"
echo "ja_JP.EUC EUC-JP"
echo "ja_JP.SJIS SHIFT_JIS"
echo "ko_KR.EUC EUC-KR"
;;
darwin*)
# Darwin 7.5 has nl_langinfo(CODESET), but it is useless:
# - It returns the empty string when LANG is set to a locale of the
# form ll_CC, although ll_CC/LC_CTYPE is a symlink to an UTF-8
# LC_CTYPE file.
# - The environment variables LANG, LC_CTYPE, LC_ALL are not set by
# the system; nl_langinfo(CODESET) returns "US-ASCII" in this case.
# - The documentation says:
# "... all code that calls BSD system routines should ensure
# that the const *char parameters of these routines are in UTF-8
# encoding. All BSD system functions expect their string
# parameters to be in UTF-8 encoding and nothing else."
# It also says
# "An additional caveat is that string parameters for files,
# paths, and other file-system entities must be in canonical
# UTF-8. In a canonical UTF-8 Unicode string, all decomposable
# characters are decomposed ..."
# but this is not true: You can pass non-decomposed UTF-8 strings
# to file system functions, and it is the OS which will convert
# them to decomposed UTF-8 before accessing the file system.
# - The Apple Terminal application displays UTF-8 by default.
# - However, other applications are free to use different encodings:
# - xterm uses ISO-8859-1 by default.
# - TextEdit uses MacRoman by default.
# We prefer UTF-8 over decomposed UTF-8-MAC because one should
# minimize the use of decomposed Unicode. Unfortunately, through the
# Darwin file system, decomposed UTF-8 strings are leaked into user
# space nevertheless.
echo "* UTF-8"
;;
beos* | haiku*)
# BeOS and Haiku have a single locale, and it has UTF-8 encoding.
echo "* UTF-8"
;;
msdosdjgpp*)
# DJGPP 2.03 doesn't have nl_langinfo(CODESET); therefore
# localcharset.c falls back to using the full locale name
# from the environment variables.
echo "#"
echo "# The encodings given here may not all be correct."
echo "# If you find that the encoding given for your language and"
echo "# country is not the one your DOS machine actually uses, just"
echo "# correct it in this file, and send a mail to"
echo "# Juan Manuel Guerrero <juan.guerrero@gmx.de>"
echo "# and Bruno Haible <bruno@clisp.org>."
echo "#"
echo "C ASCII"
# ISO-8859-1 languages
echo "ca CP850"
echo "ca_ES CP850"
echo "da CP865" # not CP850 ??
echo "da_DK CP865" # not CP850 ??
echo "de CP850"
echo "de_AT CP850"
echo "de_CH CP850"
echo "de_DE CP850"
echo "en CP850"
echo "en_AU CP850" # not CP437 ??
echo "en_CA CP850"
echo "en_GB CP850"
echo "en_NZ CP437"
echo "en_US CP437"
echo "en_ZA CP850" # not CP437 ??
echo "es CP850"
echo "es_AR CP850"
echo "es_BO CP850"
echo "es_CL CP850"
echo "es_CO CP850"
echo "es_CR CP850"
echo "es_CU CP850"
echo "es_DO CP850"
echo "es_EC CP850"
echo "es_ES CP850"
echo "es_GT CP850"
echo "es_HN CP850"
echo "es_MX CP850"
echo "es_NI CP850"
echo "es_PA CP850"
echo "es_PY CP850"
echo "es_PE CP850"
echo "es_SV CP850"
echo "es_UY CP850"
echo "es_VE CP850"
echo "et CP850"
echo "et_EE CP850"
echo "eu CP850"
echo "eu_ES CP850"
echo "fi CP850"
echo "fi_FI CP850"
echo "fr CP850"
echo "fr_BE CP850"
echo "fr_CA CP850"
echo "fr_CH CP850"
echo "fr_FR CP850"
echo "ga CP850"
echo "ga_IE CP850"
echo "gd CP850"
echo "gd_GB CP850"
echo "gl CP850"
echo "gl_ES CP850"
echo "id CP850" # not CP437 ??
echo "id_ID CP850" # not CP437 ??
echo "is CP861" # not CP850 ??
echo "is_IS CP861" # not CP850 ??
echo "it CP850"
echo "it_CH CP850"
echo "it_IT CP850"
echo "lt CP775"
echo "lt_LT CP775"
echo "lv CP775"
echo "lv_LV CP775"
echo "nb CP865" # not CP850 ??
echo "nb_NO CP865" # not CP850 ??
echo "nl CP850"
echo "nl_BE CP850"
echo "nl_NL CP850"
echo "nn CP865" # not CP850 ??
echo "nn_NO CP865" # not CP850 ??
echo "no CP865" # not CP850 ??
echo "no_NO CP865" # not CP850 ??
echo "pt CP850"
echo "pt_BR CP850"
echo "pt_PT CP850"
echo "sv CP850"
echo "sv_SE CP850"
# ISO-8859-2 languages
echo "cs CP852"
echo "cs_CZ CP852"
echo "hr CP852"
echo "hr_HR CP852"
echo "hu CP852"
echo "hu_HU CP852"
echo "pl CP852"
echo "pl_PL CP852"
echo "ro CP852"
echo "ro_RO CP852"
echo "sk CP852"
echo "sk_SK CP852"
echo "sl CP852"
echo "sl_SI CP852"
echo "sq CP852"
echo "sq_AL CP852"
echo "sr CP852" # CP852 or CP866 or CP855 ??
echo "sr_CS CP852" # CP852 or CP866 or CP855 ??
echo "sr_YU CP852" # CP852 or CP866 or CP855 ??
# ISO-8859-3 languages
echo "mt CP850"
echo "mt_MT CP850"
# ISO-8859-5 languages
echo "be CP866"
echo "be_BE CP866"
echo "bg CP866" # not CP855 ??
echo "bg_BG CP866" # not CP855 ??
echo "mk CP866" # not CP855 ??
echo "mk_MK CP866" # not CP855 ??
echo "ru CP866"
echo "ru_RU CP866"
echo "uk CP1125"
echo "uk_UA CP1125"
# ISO-8859-6 languages
echo "ar CP864"
echo "ar_AE CP864"
echo "ar_DZ CP864"
echo "ar_EG CP864"
echo "ar_IQ CP864"
echo "ar_IR CP864"
echo "ar_JO CP864"
echo "ar_KW CP864"
echo "ar_MA CP864"
echo "ar_OM CP864"
echo "ar_QA CP864"
echo "ar_SA CP864"
echo "ar_SY CP864"
# ISO-8859-7 languages
echo "el CP869"
echo "el_GR CP869"
# ISO-8859-8 languages
echo "he CP862"
echo "he_IL CP862"
# ISO-8859-9 languages
echo "tr CP857"
echo "tr_TR CP857"
# Japanese
echo "ja CP932"
echo "ja_JP CP932"
# Chinese
echo "zh_CN GBK"
echo "zh_TW CP950" # not CP938 ??
# Korean
echo "kr CP949" # not CP934 ??
echo "kr_KR CP949" # not CP934 ??
# Thai
echo "th CP874"
echo "th_TH CP874"
# Other
echo "eo CP850"
echo "eo_EO CP850"
;;
esac

462
lib/localcharset.c Normal file
View file

@ -0,0 +1,462 @@
/* Determine a canonical name for the current locale's character encoding.
Copyright (C) 2000-2006, 2008 Free Software Foundation, Inc.
This program 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, 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser 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. */
/* Written by Bruno Haible <bruno@clisp.org>. */
#include <config.h>
/* Specification. */
#include "localcharset.h"
#include <stddef.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#if defined _WIN32 || defined __WIN32__
# define WIN32_NATIVE
#endif
#if defined __EMX__
/* Assume EMX program runs on OS/2, even if compiled under DOS. */
# ifndef OS2
# define OS2
# endif
#endif
#if !defined WIN32_NATIVE
# if HAVE_LANGINFO_CODESET
# include <langinfo.h>
# else
# if 0 /* see comment below */
# include <locale.h>
# endif
# endif
# ifdef __CYGWIN__
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
# endif
#elif defined WIN32_NATIVE
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
#endif
#if defined OS2
# define INCL_DOS
# include <os2.h>
#endif
#if ENABLE_RELOCATABLE
# include "relocatable.h"
#else
# define relocate(pathname) (pathname)
#endif
/* Get LIBDIR. */
#ifndef LIBDIR
# include "configmake.h"
#endif
#if defined _WIN32 || defined __WIN32__ || defined __CYGWIN__ || defined __EMX__ || defined __DJGPP__
/* Win32, Cygwin, OS/2, DOS */
# define ISSLASH(C) ((C) == '/' || (C) == '\\')
#endif
#ifndef DIRECTORY_SEPARATOR
# define DIRECTORY_SEPARATOR '/'
#endif
#ifndef ISSLASH
# define ISSLASH(C) ((C) == DIRECTORY_SEPARATOR)
#endif
#if HAVE_DECL_GETC_UNLOCKED
# undef getc
# define getc getc_unlocked
#endif
/* The following static variable is declared 'volatile' to avoid a
possible multithread problem in the function get_charset_aliases. If we
are running in a threaded environment, and if two threads initialize
'charset_aliases' simultaneously, both will produce the same value,
and everything will be ok if the two assignments to 'charset_aliases'
are atomic. But I don't know what will happen if the two assignments mix. */
#if __STDC__ != 1
# define volatile /* empty */
#endif
/* Pointer to the contents of the charset.alias file, if it has already been
read, else NULL. Its format is:
ALIAS_1 '\0' CANONICAL_1 '\0' ... ALIAS_n '\0' CANONICAL_n '\0' '\0' */
static const char * volatile charset_aliases;
/* Return a pointer to the contents of the charset.alias file. */
static const char *
get_charset_aliases (void)
{
const char *cp;
cp = charset_aliases;
if (cp == NULL)
{
#if !(defined VMS || defined WIN32_NATIVE || defined __CYGWIN__)
FILE *fp;
const char *dir;
const char *base = "charset.alias";
char *file_name;
/* Make it possible to override the charset.alias location. This is
necessary for running the testsuite before "make install". */
dir = getenv ("CHARSETALIASDIR");
if (dir == NULL || dir[0] == '\0')
dir = relocate (LIBDIR);
/* Concatenate dir and base into freshly allocated file_name. */
{
size_t dir_len = strlen (dir);
size_t base_len = strlen (base);
int add_slash = (dir_len > 0 && !ISSLASH (dir[dir_len - 1]));
file_name = (char *) malloc (dir_len + add_slash + base_len + 1);
if (file_name != NULL)
{
memcpy (file_name, dir, dir_len);
if (add_slash)
file_name[dir_len] = DIRECTORY_SEPARATOR;
memcpy (file_name + dir_len + add_slash, base, base_len + 1);
}
}
if (file_name == NULL || (fp = fopen (file_name, "r")) == NULL)
/* Out of memory or file not found, treat it as empty. */
cp = "";
else
{
/* Parse the file's contents. */
char *res_ptr = NULL;
size_t res_size = 0;
for (;;)
{
int c;
char buf1[50+1];
char buf2[50+1];
size_t l1, l2;
char *old_res_ptr;
c = getc (fp);
if (c == EOF)
break;
if (c == '\n' || c == ' ' || c == '\t')
continue;
if (c == '#')
{
/* Skip comment, to end of line. */
do
c = getc (fp);
while (!(c == EOF || c == '\n'));
if (c == EOF)
break;
continue;
}
ungetc (c, fp);
if (fscanf (fp, "%50s %50s", buf1, buf2) < 2)
break;
l1 = strlen (buf1);
l2 = strlen (buf2);
old_res_ptr = res_ptr;
if (res_size == 0)
{
res_size = l1 + 1 + l2 + 1;
res_ptr = (char *) malloc (res_size + 1);
}
else
{
res_size += l1 + 1 + l2 + 1;
res_ptr = (char *) realloc (res_ptr, res_size + 1);
}
if (res_ptr == NULL)
{
/* Out of memory. */
res_size = 0;
if (old_res_ptr != NULL)
free (old_res_ptr);
break;
}
strcpy (res_ptr + res_size - (l2 + 1) - (l1 + 1), buf1);
strcpy (res_ptr + res_size - (l2 + 1), buf2);
}
fclose (fp);
if (res_size == 0)
cp = "";
else
{
*(res_ptr + res_size) = '\0';
cp = res_ptr;
}
}
if (file_name != NULL)
free (file_name);
#else
# if defined VMS
/* To avoid the troubles of an extra file charset.alias_vms in the
sources of many GNU packages, simply inline the aliases here. */
/* The list of encodings is taken from the OpenVMS 7.3-1 documentation
"Compaq C Run-Time Library Reference Manual for OpenVMS systems"
section 10.7 "Handling Different Character Sets". */
cp = "ISO8859-1" "\0" "ISO-8859-1" "\0"
"ISO8859-2" "\0" "ISO-8859-2" "\0"
"ISO8859-5" "\0" "ISO-8859-5" "\0"
"ISO8859-7" "\0" "ISO-8859-7" "\0"
"ISO8859-8" "\0" "ISO-8859-8" "\0"
"ISO8859-9" "\0" "ISO-8859-9" "\0"
/* Japanese */
"eucJP" "\0" "EUC-JP" "\0"
"SJIS" "\0" "SHIFT_JIS" "\0"
"DECKANJI" "\0" "DEC-KANJI" "\0"
"SDECKANJI" "\0" "EUC-JP" "\0"
/* Chinese */
"eucTW" "\0" "EUC-TW" "\0"
"DECHANYU" "\0" "DEC-HANYU" "\0"
"DECHANZI" "\0" "GB2312" "\0"
/* Korean */
"DECKOREAN" "\0" "EUC-KR" "\0";
# endif
# if defined WIN32_NATIVE || defined __CYGWIN__
/* To avoid the troubles of installing a separate file in the same
directory as the DLL and of retrieving the DLL's directory at
runtime, simply inline the aliases here. */
cp = "CP936" "\0" "GBK" "\0"
"CP1361" "\0" "JOHAB" "\0"
"CP20127" "\0" "ASCII" "\0"
"CP20866" "\0" "KOI8-R" "\0"
"CP20936" "\0" "GB2312" "\0"
"CP21866" "\0" "KOI8-RU" "\0"
"CP28591" "\0" "ISO-8859-1" "\0"
"CP28592" "\0" "ISO-8859-2" "\0"
"CP28593" "\0" "ISO-8859-3" "\0"
"CP28594" "\0" "ISO-8859-4" "\0"
"CP28595" "\0" "ISO-8859-5" "\0"
"CP28596" "\0" "ISO-8859-6" "\0"
"CP28597" "\0" "ISO-8859-7" "\0"
"CP28598" "\0" "ISO-8859-8" "\0"
"CP28599" "\0" "ISO-8859-9" "\0"
"CP28605" "\0" "ISO-8859-15" "\0"
"CP38598" "\0" "ISO-8859-8" "\0"
"CP51932" "\0" "EUC-JP" "\0"
"CP51936" "\0" "GB2312" "\0"
"CP51949" "\0" "EUC-KR" "\0"
"CP51950" "\0" "EUC-TW" "\0"
"CP54936" "\0" "GB18030" "\0"
"CP65001" "\0" "UTF-8" "\0";
# endif
#endif
charset_aliases = cp;
}
return cp;
}
/* Determine the current locale's character encoding, and canonicalize it
into one of the canonical names listed in config.charset.
The result must not be freed; it is statically allocated.
If the canonical name cannot be determined, the result is a non-canonical
name. */
#ifdef STATIC
STATIC
#endif
const char *
locale_charset (void)
{
const char *codeset;
const char *aliases;
#if !(defined WIN32_NATIVE || defined OS2)
# if HAVE_LANGINFO_CODESET
/* Most systems support nl_langinfo (CODESET) nowadays. */
codeset = nl_langinfo (CODESET);
# ifdef __CYGWIN__
/* Cygwin 2006 does not have locales. nl_langinfo (CODESET) always
returns "US-ASCII". As long as this is not fixed, return the suffix
of the locale name from the environment variables (if present) or
the codepage as a number. */
if (codeset != NULL && strcmp (codeset, "US-ASCII") == 0)
{
const char *locale;
static char buf[2 + 10 + 1];
locale = getenv ("LC_ALL");
if (locale == NULL || locale[0] == '\0')
{
locale = getenv ("LC_CTYPE");
if (locale == NULL || locale[0] == '\0')
locale = getenv ("LANG");
}
if (locale != NULL && locale[0] != '\0')
{
/* If the locale name contains an encoding after the dot, return
it. */
const char *dot = strchr (locale, '.');
if (dot != NULL)
{
const char *modifier;
dot++;
/* Look for the possible @... trailer and remove it, if any. */
modifier = strchr (dot, '@');
if (modifier == NULL)
return dot;
if (modifier - dot < sizeof (buf))
{
memcpy (buf, dot, modifier - dot);
buf [modifier - dot] = '\0';
return buf;
}
}
}
/* Woe32 has a function returning the locale's codepage as a number. */
sprintf (buf, "CP%u", GetACP ());
codeset = buf;
}
# endif
# else
/* On old systems which lack it, use setlocale or getenv. */
const char *locale = NULL;
/* But most old systems don't have a complete set of locales. Some
(like SunOS 4 or DJGPP) have only the C locale. Therefore we don't
use setlocale here; it would return "C" when it doesn't support the
locale name the user has set. */
# if 0
locale = setlocale (LC_CTYPE, NULL);
# endif
if (locale == NULL || locale[0] == '\0')
{
locale = getenv ("LC_ALL");
if (locale == NULL || locale[0] == '\0')
{
locale = getenv ("LC_CTYPE");
if (locale == NULL || locale[0] == '\0')
locale = getenv ("LANG");
}
}
/* On some old systems, one used to set locale = "iso8859_1". On others,
you set it to "language_COUNTRY.charset". In any case, we resolve it
through the charset.alias file. */
codeset = locale;
# endif
#elif defined WIN32_NATIVE
static char buf[2 + 10 + 1];
/* Woe32 has a function returning the locale's codepage as a number. */
sprintf (buf, "CP%u", GetACP ());
codeset = buf;
#elif defined OS2
const char *locale;
static char buf[2 + 10 + 1];
ULONG cp[3];
ULONG cplen;
/* Allow user to override the codeset, as set in the operating system,
with standard language environment variables. */
locale = getenv ("LC_ALL");
if (locale == NULL || locale[0] == '\0')
{
locale = getenv ("LC_CTYPE");
if (locale == NULL || locale[0] == '\0')
locale = getenv ("LANG");
}
if (locale != NULL && locale[0] != '\0')
{
/* If the locale name contains an encoding after the dot, return it. */
const char *dot = strchr (locale, '.');
if (dot != NULL)
{
const char *modifier;
dot++;
/* Look for the possible @... trailer and remove it, if any. */
modifier = strchr (dot, '@');
if (modifier == NULL)
return dot;
if (modifier - dot < sizeof (buf))
{
memcpy (buf, dot, modifier - dot);
buf [modifier - dot] = '\0';
return buf;
}
}
/* Resolve through the charset.alias file. */
codeset = locale;
}
else
{
/* OS/2 has a function returning the locale's codepage as a number. */
if (DosQueryCp (sizeof (cp), cp, &cplen))
codeset = "";
else
{
sprintf (buf, "CP%u", cp[0]);
codeset = buf;
}
}
#endif
if (codeset == NULL)
/* The canonical name cannot be determined. */
codeset = "";
/* Resolve alias. */
for (aliases = get_charset_aliases ();
*aliases != '\0';
aliases += strlen (aliases) + 1, aliases += strlen (aliases) + 1)
if (strcmp (codeset, aliases) == 0
|| (aliases[0] == '*' && aliases[1] == '\0'))
{
codeset = aliases + strlen (aliases) + 1;
break;
}
/* Don't return an empty string. GNU libc and GNU libiconv interpret
the empty string as denoting "the locale's character encoding",
thus GNU libiconv would call this function a second time. */
if (codeset[0] == '\0')
codeset = "ASCII";
return codeset;
}

41
lib/localcharset.h Normal file
View file

@ -0,0 +1,41 @@
/* Determine a canonical name for the current locale's character encoding.
Copyright (C) 2000-2003 Free Software Foundation, Inc.
This file is part of the GNU CHARSET Library.
This program 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, 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser 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 _LOCALCHARSET_H
#define _LOCALCHARSET_H
#ifdef __cplusplus
extern "C" {
#endif
/* Determine the current locale's character encoding, and canonicalize it
into one of the canonical names listed in config.charset.
The result must not be freed; it is statically allocated.
If the canonical name cannot be determined, the result is a non-canonical
name. */
extern const char * locale_charset (void);
#ifdef __cplusplus
}
#endif
#endif /* _LOCALCHARSET_H */

32
lib/mbrlen.c Normal file
View file

@ -0,0 +1,32 @@
/* Recognize multibyte character.
Copyright (C) 1999-2000, 2008 Free Software Foundation, Inc.
Written by Bruno Haible <bruno@clisp.org>, 2008.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 3 of the License, 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
/* Specification. */
#include <wchar.h>
static mbstate_t internal_state;
size_t
mbrlen (const char *s, size_t n, mbstate_t *ps)
{
if (ps == NULL)
ps = &internal_state;
return mbrtowc (NULL, s, n, ps);
}

349
lib/mbrtowc.c Normal file
View file

@ -0,0 +1,349 @@
/* Convert multibyte character to wide character.
Copyright (C) 1999-2002, 2005-2008 Free Software Foundation, Inc.
Written by Bruno Haible <bruno@clisp.org>, 2008.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 3 of the License, 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
/* Specification. */
#include <wchar.h>
#if GNULIB_defined_mbstate_t
/* Implement mbrtowc() on top of mbtowc(). */
# include <errno.h>
# include <stdlib.h>
# include "localcharset.h"
# include "streq.h"
# include "verify.h"
verify (sizeof (mbstate_t) >= 4);
static char internal_state[4];
size_t
mbrtowc (wchar_t *pwc, const char *s, size_t n, mbstate_t *ps)
{
char *pstate = (char *)ps;
if (pstate == NULL)
pstate = internal_state;
if (s == NULL)
{
pwc = NULL;
s = "";
n = 1;
}
if (n == 0)
return (size_t)(-2);
/* Here n > 0. */
{
size_t nstate = pstate[0];
char buf[4];
const char *p;
size_t m;
switch (nstate)
{
case 0:
p = s;
m = n;
break;
case 3:
buf[2] = pstate[3];
/*FALLTHROUGH*/
case 2:
buf[1] = pstate[2];
/*FALLTHROUGH*/
case 1:
buf[0] = pstate[1];
p = buf;
m = nstate;
buf[m++] = s[0];
if (n >= 2 && m < 4)
{
buf[m++] = s[1];
if (n >= 3 && m < 4)
buf[m++] = s[2];
}
break;
default:
errno = EINVAL;
return (size_t)(-1);
}
/* Here 0 < m ≤ 4. */
# if __GLIBC__
/* Work around bug <http://sourceware.org/bugzilla/show_bug.cgi?id=9674> */
mbtowc (NULL, NULL, 0);
# endif
{
int res = mbtowc (pwc, p, m);
if (res >= 0)
{
if (pwc != NULL && ((*pwc == 0) != (res == 0)))
abort ();
if (nstate >= (res > 0 ? res : 1))
abort ();
res -= nstate;
pstate[0] = 0;
return res;
}
/* mbtowc does not distinguish between invalid and incomplete multibyte
sequences. But mbrtowc needs to make this distinction.
There are two possible approaches:
- Use iconv() and its return value.
- Use built-in knowledge about the possible encodings.
Given the low quality of implementation of iconv() on the systems that
lack mbrtowc(), we use the second approach.
The possible encodings are:
- 8-bit encodings,
- EUC-JP, EUC-KR, GB2312, EUC-TW, BIG5, SJIS,
- UTF-8.
Use specialized code for each. */
if (m >= 4 || m >= MB_CUR_MAX)
goto invalid;
/* Here MB_CUR_MAX > 1 and 0 < m < 4. */
{
const char *encoding = locale_charset ();
if (STREQ (encoding, "UTF-8", 'U', 'T', 'F', '-', '8', 0, 0, 0, 0))
{
/* Cf. unistr/u8-mblen.c. */
unsigned char c = (unsigned char) p[0];
if (c >= 0xc2)
{
if (c < 0xe0)
{
if (m == 1)
goto incomplete;
}
else if (c < 0xf0)
{
if (m == 1)
goto incomplete;
if (m == 2)
{
unsigned char c2 = (unsigned char) p[1];
if ((c2 ^ 0x80) < 0x40
&& (c >= 0xe1 || c2 >= 0xa0)
&& (c != 0xed || c2 < 0xa0))
goto incomplete;
}
}
else if (c <= 0xf4)
{
if (m == 1)
goto incomplete;
else /* m == 2 || m == 3 */
{
unsigned char c2 = (unsigned char) p[1];
if ((c2 ^ 0x80) < 0x40
&& (c >= 0xf1 || c2 >= 0x90)
&& (c < 0xf4 || (c == 0xf4 && c2 < 0x90)))
{
if (m == 2)
goto incomplete;
else /* m == 3 */
{
unsigned char c3 = (unsigned char) p[2];
if ((c3 ^ 0x80) < 0x40)
goto incomplete;
}
}
}
}
}
goto invalid;
}
/* As a reference for this code, you can use the GNU libiconv
implementation. Look for uses of the RET_TOOFEW macro. */
if (STREQ (encoding, "EUC-JP", 'E', 'U', 'C', '-', 'J', 'P', 0, 0, 0))
{
if (m == 1)
{
unsigned char c = (unsigned char) p[0];
if ((c >= 0xa1 && c < 0xff) || c == 0x8e || c == 0x8f)
goto incomplete;
}
if (m == 2)
{
unsigned char c = (unsigned char) p[0];
if (c == 0x8f)
{
unsigned char c2 = (unsigned char) p[1];
if (c2 >= 0xa1 && c2 < 0xff)
goto incomplete;
}
}
goto invalid;
}
if (STREQ (encoding, "EUC-KR", 'E', 'U', 'C', '-', 'K', 'R', 0, 0, 0)
|| STREQ (encoding, "GB2312", 'G', 'B', '2', '3', '1', '2', 0, 0, 0)
|| STREQ (encoding, "BIG5", 'B', 'I', 'G', '5', 0, 0, 0, 0, 0))
{
if (m == 1)
{
unsigned char c = (unsigned char) p[0];
if (c >= 0xa1 && c < 0xff)
goto incomplete;
}
goto invalid;
}
if (STREQ (encoding, "EUC-TW", 'E', 'U', 'C', '-', 'T', 'W', 0, 0, 0))
{
if (m == 1)
{
unsigned char c = (unsigned char) p[0];
if ((c >= 0xa1 && c < 0xff) || c == 0x8e)
goto incomplete;
}
else /* m == 2 || m == 3 */
{
unsigned char c = (unsigned char) p[0];
if (c == 0x8e)
goto incomplete;
}
goto invalid;
}
if (STREQ (encoding, "SJIS", 'S', 'J', 'I', 'S', 0, 0, 0, 0, 0))
{
if (m == 1)
{
unsigned char c = (unsigned char) p[0];
if ((c >= 0x81 && c <= 0x9f) || (c >= 0xe0 && c <= 0xea)
|| (c >= 0xf0 && c <= 0xf9))
goto incomplete;
}
goto invalid;
}
/* An unknown multibyte encoding. */
goto incomplete;
}
incomplete:
{
size_t k = nstate;
/* Here 0 < k < m < 4. */
pstate[++k] = s[0];
if (k < m)
pstate[++k] = s[1];
if (k != m)
abort ();
}
pstate[0] = m;
return (size_t)(-2);
invalid:
errno = EILSEQ;
/* The conversion state is undefined, says POSIX. */
return (size_t)(-1);
}
}
}
#else
/* Override the system's mbrtowc() function. */
# undef mbrtowc
size_t
rpl_mbrtowc (wchar_t *pwc, const char *s, size_t n, mbstate_t *ps)
{
# if MBRTOWC_NULL_ARG_BUG || MBRTOWC_RETVAL_BUG
if (s == NULL)
{
pwc = NULL;
s = "";
n = 1;
}
# endif
# if MBRTOWC_RETVAL_BUG
{
static mbstate_t internal_state;
/* Override mbrtowc's internal state. We can not call mbsinit() on the
hidden internal state, but we can call it on our variable. */
if (ps == NULL)
ps = &internal_state;
if (!mbsinit (ps))
{
/* Parse the rest of the multibyte character byte for byte. */
size_t count = 0;
for (; n > 0; s++, n--)
{
wchar_t wc;
size_t ret = mbrtowc (&wc, s, 1, ps);
if (ret == (size_t)(-1))
return (size_t)(-1);
count++;
if (ret != (size_t)(-2))
{
/* The multibyte character has been completed. */
if (pwc != NULL)
*pwc = wc;
return (wc == 0 ? 0 : count);
}
}
return (size_t)(-2);
}
}
# endif
# if MBRTOWC_NUL_RETVAL_BUG
{
wchar_t wc;
size_t ret = mbrtowc (&wc, s, n, ps);
if (ret != (size_t)(-1) && ret != (size_t)(-2))
{
if (pwc != NULL)
*pwc = wc;
if (wc == 0)
ret = 0;
}
return ret;
}
# else
return mbrtowc (pwc, s, n, ps);
# endif
}
#endif

47
lib/mbsinit.c Normal file
View file

@ -0,0 +1,47 @@
/* Test for initial conversion state.
Copyright (C) 2008 Free Software Foundation, Inc.
Written by Bruno Haible <bruno@clisp.org>, 2008.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 3 of the License, 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
/* Specification. */
#include <wchar.h>
#include "verify.h"
/* Platforms that lack mbsinit() also lack mbrlen(), mbrtowc(), mbsrtowcs()
and wcrtomb(), wcsrtombs().
We assume that
- sizeof (mbstate_t) >= 4,
- only stateless encodings are supported (such as UTF-8 and EUC-JP, but
not ISO-2022 variants),
- for each encoding, the number of bytes for a wide character is <= 4.
(This maximum is attained for UTF-8, GB18030, EUC-TW.)
We define the meaning of mbstate_t as follows:
- In mb -> wc direction, mbstate_t's first byte contains the number of
buffered bytes (in the range 0..3), followed by up to 3 buffered bytes.
- In wc -> mb direction, mbstate_t contains no information. In other
words, it is always in the initial state. */
verify (sizeof (mbstate_t) >= 4);
int
mbsinit (const mbstate_t *ps)
{
const char *pstate = (const char *)ps;
return pstate[0] == 0;
}

30
lib/ref-add.sin Normal file
View file

@ -0,0 +1,30 @@
# Add this package to a list of references stored in a text file.
#
# Copyright (C) 2000 Free Software Foundation, Inc.
#
# This program 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, 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 Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser 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.
#
# Written by Bruno Haible <haible@clisp.cons.org>.
#
/^# Packages using this file: / {
s/# Packages using this file://
ta
:a
s/ @PACKAGE@ / @PACKAGE@ /
tb
s/ $/ @PACKAGE@ /
:b
s/^/# Packages using this file:/
}

25
lib/ref-del.sin Normal file
View file

@ -0,0 +1,25 @@
# Remove this package from a list of references stored in a text file.
#
# Copyright (C) 2000 Free Software Foundation, Inc.
#
# This program 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, 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 Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser 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.
#
# Written by Bruno Haible <haible@clisp.cons.org>.
#
/^# Packages using this file: / {
s/# Packages using this file://
s/ @PACKAGE@ / /
s/^/# Packages using this file:/
}

176
lib/streq.h Normal file
View file

@ -0,0 +1,176 @@
/* Optimized string comparison.
Copyright (C) 2001-2002, 2007 Free Software Foundation, Inc.
This program is free software: you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published
by the Free Software Foundation; either version 3 of the License, 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
/* Written by Bruno Haible <bruno@clisp.org>. */
#ifndef _GL_STREQ_H
#define _GL_STREQ_H
#include <string.h>
/* STREQ allows to optimize string comparison with a small literal string.
STREQ (s, "EUC-KR", 'E', 'U', 'C', '-', 'K', 'R', 0, 0, 0)
is semantically equivalent to
strcmp (s, "EUC-KR") == 0
just faster. */
/* Help GCC to generate good code for string comparisons with
immediate strings. */
#if defined (__GNUC__) && defined (__OPTIMIZE__)
static inline int
streq9 (const char *s1, const char *s2)
{
return strcmp (s1 + 9, s2 + 9) == 0;
}
static inline int
streq8 (const char *s1, const char *s2, char s28)
{
if (s1[8] == s28)
{
if (s28 == 0)
return 1;
else
return streq9 (s1, s2);
}
else
return 0;
}
static inline int
streq7 (const char *s1, const char *s2, char s27, char s28)
{
if (s1[7] == s27)
{
if (s27 == 0)
return 1;
else
return streq8 (s1, s2, s28);
}
else
return 0;
}
static inline int
streq6 (const char *s1, const char *s2, char s26, char s27, char s28)
{
if (s1[6] == s26)
{
if (s26 == 0)
return 1;
else
return streq7 (s1, s2, s27, s28);
}
else
return 0;
}
static inline int
streq5 (const char *s1, const char *s2, char s25, char s26, char s27, char s28)
{
if (s1[5] == s25)
{
if (s25 == 0)
return 1;
else
return streq6 (s1, s2, s26, s27, s28);
}
else
return 0;
}
static inline int
streq4 (const char *s1, const char *s2, char s24, char s25, char s26, char s27, char s28)
{
if (s1[4] == s24)
{
if (s24 == 0)
return 1;
else
return streq5 (s1, s2, s25, s26, s27, s28);
}
else
return 0;
}
static inline int
streq3 (const char *s1, const char *s2, char s23, char s24, char s25, char s26, char s27, char s28)
{
if (s1[3] == s23)
{
if (s23 == 0)
return 1;
else
return streq4 (s1, s2, s24, s25, s26, s27, s28);
}
else
return 0;
}
static inline int
streq2 (const char *s1, const char *s2, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
{
if (s1[2] == s22)
{
if (s22 == 0)
return 1;
else
return streq3 (s1, s2, s23, s24, s25, s26, s27, s28);
}
else
return 0;
}
static inline int
streq1 (const char *s1, const char *s2, char s21, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
{
if (s1[1] == s21)
{
if (s21 == 0)
return 1;
else
return streq2 (s1, s2, s22, s23, s24, s25, s26, s27, s28);
}
else
return 0;
}
static inline int
streq0 (const char *s1, const char *s2, char s20, char s21, char s22, char s23, char s24, char s25, char s26, char s27, char s28)
{
if (s1[0] == s20)
{
if (s20 == 0)
return 1;
else
return streq1 (s1, s2, s21, s22, s23, s24, s25, s26, s27, s28);
}
else
return 0;
}
#define STREQ(s1,s2,s20,s21,s22,s23,s24,s25,s26,s27,s28) \
streq0 (s1, s2, s20, s21, s22, s23, s24, s25, s26, s27, s28)
#else
#define STREQ(s1,s2,s20,s21,s22,s23,s24,s25,s26,s27,s28) \
(strcmp (s1, s2) == 0)
#endif
#endif /* _GL_STREQ_H */

9
lib/strftime.c
View file

@ -50,14 +50,7 @@ extern char *tzname[];
#define DO_MULTIBYTE (HAVE_MBLEN && ! MULTIBYTE_IS_FORMAT_SAFE)
#if DO_MULTIBYTE
# if HAVE_MBRLEN
# include <wchar.h>
# else
/* Simulate mbrlen with mblen as best we can. */
# define mbstate_t int
# define mbrlen(s, n, ps) mblen (s, n)
# define mbsinit(ps) (*(ps) == 0)
# endif
# include <wchar.h>
static const mbstate_t mbstate_zero;
#endif

1
lib/unistd.in.h
View file

@ -35,6 +35,7 @@
#endif
/* mingw fails to declare _exit in <unistd.h>. */
/* mingw, BeOS, Haiku declare environ in <stdlib.h>, not in <unistd.h>. */
#include <stdlib.h>
#if @GNULIB_WRITE@ && @REPLACE_WRITE@ && @GNULIB_UNISTD_H_SIGPIPE@

191
lib/wchar.in.h
View file

@ -68,6 +68,197 @@ extern "C" {
/* Define wint_t. (Also done in wctype.in.h.) */
#if !@HAVE_WINT_T@ && !defined wint_t
# define wint_t int
# ifndef WEOF
# define WEOF -1
# endif
#endif
/* Override mbstate_t if it is too small.
On IRIX 6.5, sizeof (mbstate_t) == 1, which is not sufficient for
implementing mbrtowc for encodings like UTF-8. */
#if !(@HAVE_MBSINIT@ && @HAVE_MBRTOWC@) || @REPLACE_MBSTATE_T@
typedef int rpl_mbstate_t;
# undef mbstate_t
# define mbstate_t rpl_mbstate_t
# define GNULIB_defined_mbstate_t 1
#endif
/* Convert a single-byte character to a wide character. */
#if @GNULIB_BTOWC@
# if @REPLACE_BTOWC@
# undef btowc
# define btowc rpl_btowc
# endif
# if !@HAVE_BTOWC@ || @REPLACE_BTOWC@
extern wint_t btowc (int c);
# endif
#elif defined GNULIB_POSIXCHECK
# undef btowc
# define btowc(c) \
(GL_LINK_WARNING ("btowc is unportable - " \
"use gnulib module btowc for portability"), \
btowc (c))
#endif
/* Convert a wide character to a single-byte character. */
#if @GNULIB_WCTOB@
# if @REPLACE_WCTOB@
# undef wctob
# define wctob rpl_wctob
# endif
# if (!defined wctob && !@HAVE_DECL_WCTOB@) || @REPLACE_WCTOB@
/* wctob is provided by gnulib, or wctob exists but is not declared. */
extern int wctob (wint_t wc);
# endif
#elif defined GNULIB_POSIXCHECK
# undef wctob
# define wctob(w) \
(GL_LINK_WARNING ("wctob is unportable - " \
"use gnulib module wctob for portability"), \
wctob (w))
#endif
/* Test whether *PS is in the initial state. */
#if @GNULIB_MBSINIT@
# if @REPLACE_MBSINIT@
# undef mbsinit
# define mbsinit rpl_mbsinit
# endif
# if !@HAVE_MBSINIT@ || @REPLACE_MBSINIT@
extern int mbsinit (const mbstate_t *ps);
# endif
#elif defined GNULIB_POSIXCHECK
# undef mbsinit
# define mbsinit(p) \
(GL_LINK_WARNING ("mbsinit is unportable - " \
"use gnulib module mbsinit for portability"), \
mbsinit (p))
#endif
/* Convert a multibyte character to a wide character. */
#if @GNULIB_MBRTOWC@
# if @REPLACE_MBRTOWC@
# undef mbrtowc
# define mbrtowc rpl_mbrtowc
# endif
# if !@HAVE_MBRTOWC@ || @REPLACE_MBRTOWC@
extern size_t mbrtowc (wchar_t *pwc, const char *s, size_t n, mbstate_t *ps);
# endif
#elif defined GNULIB_POSIXCHECK
# undef mbrtowc
# define mbrtowc(w,s,n,p) \
(GL_LINK_WARNING ("mbrtowc is unportable - " \
"use gnulib module mbrtowc for portability"), \
mbrtowc (w, s, n, p))
#endif
/* Recognize a multibyte character. */
#if @GNULIB_MBRLEN@
# if @REPLACE_MBRLEN@
# undef mbrlen
# define mbrlen rpl_mbrlen
# endif
# if !@HAVE_MBRLEN@ || @REPLACE_MBRLEN@
extern size_t mbrlen (const char *s, size_t n, mbstate_t *ps);
# endif
#elif defined GNULIB_POSIXCHECK
# undef mbrlen
# define mbrlen(s,n,p) \
(GL_LINK_WARNING ("mbrlen is unportable - " \
"use gnulib module mbrlen for portability"), \
mbrlen (s, n, p))
#endif
/* Convert a string to a wide string. */
#if @GNULIB_MBSRTOWCS@
# if @REPLACE_MBSRTOWCS@
# undef mbsrtowcs
# define mbsrtowcs rpl_mbsrtowcs
# endif
# if !@HAVE_MBSRTOWCS@ || @REPLACE_MBSRTOWCS@
extern size_t mbsrtowcs (wchar_t *dest, const char **srcp, size_t len, mbstate_t *ps);
# endif
#elif defined GNULIB_POSIXCHECK
# undef mbsrtowcs
# define mbsrtowcs(d,s,l,p) \
(GL_LINK_WARNING ("mbsrtowcs is unportable - " \
"use gnulib module mbsrtowcs for portability"), \
mbsrtowcs (d, s, l, p))
#endif
/* Convert a string to a wide string. */
#if @GNULIB_MBSNRTOWCS@
# if @REPLACE_MBSNRTOWCS@
# undef mbsnrtowcs
# define mbsnrtowcs rpl_mbsnrtowcs
# endif
# if !@HAVE_MBSNRTOWCS@ || @REPLACE_MBSNRTOWCS@
extern size_t mbsnrtowcs (wchar_t *dest, const char **srcp, size_t srclen, size_t len, mbstate_t *ps);
# endif
#elif defined GNULIB_POSIXCHECK
# undef mbsnrtowcs
# define mbsnrtowcs(d,s,n,l,p) \
(GL_LINK_WARNING ("mbsnrtowcs is unportable - " \
"use gnulib module mbsnrtowcs for portability"), \
mbsnrtowcs (d, s, n, l, p))
#endif
/* Convert a wide character to a multibyte character. */
#if @GNULIB_WCRTOMB@
# if @REPLACE_WCRTOMB@
# undef wcrtomb
# define wcrtomb rpl_wcrtomb
# endif
# if !@HAVE_WCRTOMB@ || @REPLACE_WCRTOMB@
extern size_t wcrtomb (char *s, wchar_t wc, mbstate_t *ps);
# endif
#elif defined GNULIB_POSIXCHECK
# undef wcrtomb
# define wcrtomb(s,w,p) \
(GL_LINK_WARNING ("wcrtomb is unportable - " \
"use gnulib module wcrtomb for portability"), \
wcrtomb (s, w, p))
#endif
/* Convert a wide string to a string. */
#if @GNULIB_WCSRTOMBS@
# if @REPLACE_WCSRTOMBS@
# undef wcsrtombs
# define wcsrtombs rpl_wcsrtombs
# endif
# if !@HAVE_WCSRTOMBS@ || @REPLACE_WCSRTOMBS@
extern size_t wcsrtombs (char *dest, const wchar_t **srcp, size_t len, mbstate_t *ps);
# endif
#elif defined GNULIB_POSIXCHECK
# undef wcsrtombs
# define wcsrtombs(d,s,l,p) \
(GL_LINK_WARNING ("wcsrtombs is unportable - " \
"use gnulib module wcsrtombs for portability"), \
wcsrtombs (d, s, l, p))
#endif
/* Convert a wide string to a string. */
#if @GNULIB_WCSNRTOMBS@
# if !@HAVE_WCSNRTOMBS@
extern size_t wcsnrtombs (char *dest, const wchar_t **srcp, size_t srclen, size_t len, mbstate_t *ps);
# endif
#elif defined GNULIB_POSIXCHECK
# undef wcsnrtombs
# define wcsnrtombs(d,s,n,l,p) \
(GL_LINK_WARNING ("wcsnrtombs is unportable - " \
"use gnulib module wcsnrtombs for portability"), \
wcsnrtombs (d, s, n, l, p))
#endif

499
libguile/alloca.c
View file

@ -1,499 +0,0 @@
/* alloca.c -- allocate automatically reclaimed memory
(Mostly) portable public-domain implementation -- D A Gwyn
This implementation of the PWB library alloca function,
which is used to allocate space off the run-time stack so
that it is automatically reclaimed upon procedure exit,
was inspired by discussions with J. Q. Johnson of Cornell.
J.Otto Tennant <jot@cray.com> contributed the Cray support.
There are some preprocessor constants that can
be defined when compiling for your specific system, for
improved efficiency; however, the defaults should be okay.
The general concept of this implementation is to keep
track of all alloca-allocated blocks, and reclaim any
that are found to be deeper in the stack than the current
invocation. This heuristic does not reclaim storage as
soon as it becomes invalid, but it will do so eventually.
As a special case, alloca(0) reclaims storage without
allocating any. It is a good idea to use alloca(0) in
your main control loop, etc. to force garbage collection. */
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include "libguile/scmconfig.h"
#ifdef HAVE_STRING_H
#include <string.h>
#endif
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
#ifdef emacs
#include "libguile/blockinput.h"
#endif
/* If compiling with GCC 2, this file's not needed. */
#if !defined (__GNUC__) || __GNUC__ < 2
/* If someone has defined alloca as a macro,
there must be some other way alloca is supposed to work. */
#ifndef alloca
#ifdef emacs
#ifdef static
/* actually, only want this if static is defined as ""
-- this is for usg, in which emacs must undefine static
in order to make unexec workable
*/
#ifndef STACK_DIRECTION
you
lose
-- must know STACK_DIRECTION at compile-time
#endif /* STACK_DIRECTION undefined */
#endif /* static */
#endif /* emacs */
/* If your stack is a linked list of frames, you have to
provide an "address metric" ADDRESS_FUNCTION macro. */
#if defined (CRAY) && defined (CRAY_STACKSEG_END)
long i00afunc ();
#define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
#else
#define ADDRESS_FUNCTION(arg) &(arg)
#endif
#if __STDC__
typedef void *pointer;
#else
typedef char *pointer;
#endif
#ifndef NULL
#define NULL 0
#endif
/* Define STACK_DIRECTION if you know the direction of stack
growth for your system; otherwise it will be automatically
deduced at run-time.
STACK_DIRECTION > 0 => grows toward higher addresses
STACK_DIRECTION < 0 => grows toward lower addresses
STACK_DIRECTION = 0 => direction of growth unknown */
#ifndef STACK_DIRECTION
#define STACK_DIRECTION 0 /* Direction unknown. */
#endif
#if STACK_DIRECTION != 0
#define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
#else /* STACK_DIRECTION == 0; need run-time code. */
static int stack_dir; /* 1 or -1 once known. */
#define STACK_DIR stack_dir
static void
find_stack_direction ()
{
static char *addr = NULL; /* Address of first `dummy', once known. */
auto char dummy; /* To get stack address. */
if (addr == NULL)
{ /* Initial entry. */
addr = ADDRESS_FUNCTION (dummy);
find_stack_direction (); /* Recurse once. */
}
else
{
/* Second entry. */
if (ADDRESS_FUNCTION (dummy) > addr)
stack_dir = 1; /* Stack grew upward. */
else
stack_dir = -1; /* Stack grew downward. */
}
}
#endif /* STACK_DIRECTION == 0 */
/* An "alloca header" is used to:
(a) chain together all alloca'ed blocks;
(b) keep track of stack depth.
It is very important that sizeof(header) agree with malloc
alignment chunk size. The following default should work okay. */
#ifndef ALIGN_SIZE
#define ALIGN_SIZE sizeof(double)
#endif
typedef union hdr
{
char align[ALIGN_SIZE]; /* To force sizeof(header). */
struct
{
union hdr *next; /* For chaining headers. */
char *deep; /* For stack depth measure. */
} h;
} header;
static header *last_alloca_header = NULL; /* -> last alloca header. */
/* Return a pointer to at least SIZE bytes of storage,
which will be automatically reclaimed upon exit from
the procedure that called alloca. Originally, this space
was supposed to be taken from the current stack frame of the
caller, but that method cannot be made to work for some
implementations of C, for example under Gould's UTX/32. */
pointer
alloca (unsigned size)
{
auto char probe; /* Probes stack depth: */
register char *depth = ADDRESS_FUNCTION (probe);
#if STACK_DIRECTION == 0
if (STACK_DIR == 0) /* Unknown growth direction. */
find_stack_direction ();
#endif
/* Reclaim garbage, defined as all alloca'd storage that
was allocated from deeper in the stack than currently. */
{
register header *hp; /* Traverses linked list. */
#ifdef emacs
BLOCK_INPUT;
#endif
for (hp = last_alloca_header; hp != NULL;)
if ((STACK_DIR > 0 && hp->h.deep > depth)
|| (STACK_DIR < 0 && hp->h.deep < depth))
{
register header *np = hp->h.next;
free ((pointer) hp); /* Collect garbage. */
hp = np; /* -> next header. */
}
else
break; /* Rest are not deeper. */
last_alloca_header = hp; /* -> last valid storage. */
#ifdef emacs
UNBLOCK_INPUT;
#endif
}
if (size == 0)
return NULL; /* No allocation required. */
/* Allocate combined header + user data storage. */
{
register pointer new = (pointer) scm_malloc (sizeof (header) + size);
/* Address of header. */
if (new == 0)
{
write (2, "alloca emulation: out of memory\n", 32);
abort();
}
((header *) new)->h.next = last_alloca_header;
((header *) new)->h.deep = depth;
last_alloca_header = (header *) new;
/* User storage begins just after header. */
return (pointer) ((char *) new + sizeof (header));
}
}
#if defined (CRAY) && defined (CRAY_STACKSEG_END)
#ifdef DEBUG_I00AFUNC
#include <stdio.h>
#endif
#ifndef CRAY_STACK
#define CRAY_STACK
#ifndef CRAY2
/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
struct stack_control_header
{
long shgrow:32; /* Number of times stack has grown. */
long shaseg:32; /* Size of increments to stack. */
long shhwm:32; /* High water mark of stack. */
long shsize:32; /* Current size of stack (all segments). */
};
/* The stack segment linkage control information occurs at
the high-address end of a stack segment. (The stack
grows from low addresses to high addresses.) The initial
part of the stack segment linkage control information is
0200 (octal) words. This provides for register storage
for the routine which overflows the stack. */
struct stack_segment_linkage
{
long ss[0200]; /* 0200 overflow words. */
long sssize:32; /* Number of words in this segment. */
long ssbase:32; /* Offset to stack base. */
long:32;
long sspseg:32; /* Offset to linkage control of previous
segment of stack. */
long:32;
long sstcpt:32; /* Pointer to task common address block. */
long sscsnm; /* Private control structure number for
microtasking. */
long ssusr1; /* Reserved for user. */
long ssusr2; /* Reserved for user. */
long sstpid; /* Process ID for pid based multi-tasking. */
long ssgvup; /* Pointer to multitasking thread giveup. */
long sscray[7]; /* Reserved for Cray Research. */
long ssa0;
long ssa1;
long ssa2;
long ssa3;
long ssa4;
long ssa5;
long ssa6;
long ssa7;
long sss0;
long sss1;
long sss2;
long sss3;
long sss4;
long sss5;
long sss6;
long sss7;
};
#else /* CRAY2 */
/* The following structure defines the vector of words
returned by the STKSTAT library routine. */
struct stk_stat
{
long now; /* Current total stack size. */
long maxc; /* Amount of contiguous space which would
be required to satisfy the maximum
stack demand to date. */
long high_water; /* Stack high-water mark. */
long overflows; /* Number of stack overflow ($STKOFEN) calls. */
long hits; /* Number of internal buffer hits. */
long extends; /* Number of block extensions. */
long stko_mallocs; /* Block allocations by $STKOFEN. */
long underflows; /* Number of stack underflow calls ($STKRETN). */
long stko_free; /* Number of deallocations by $STKRETN. */
long stkm_free; /* Number of deallocations by $STKMRET. */
long segments; /* Current number of stack segments. */
long maxs; /* Maximum number of stack segments so far. */
long pad_size; /* Stack pad size. */
long current_address; /* Current stack segment address. */
long current_size; /* Current stack segment size. This
number is actually corrupted by STKSTAT to
include the fifteen word trailer area. */
long initial_address; /* Address of initial segment. */
long initial_size; /* Size of initial segment. */
};
/* The following structure describes the data structure which trails
any stack segment. I think that the description in 'asdef' is
out of date. I only describe the parts that I am sure about. */
struct stk_trailer
{
long this_address; /* Address of this block. */
long this_size; /* Size of this block (does not include
this trailer). */
long unknown2;
long unknown3;
long link; /* Address of trailer block of previous
segment. */
long unknown5;
long unknown6;
long unknown7;
long unknown8;
long unknown9;
long unknown10;
long unknown11;
long unknown12;
long unknown13;
long unknown14;
};
#endif /* CRAY2 */
#endif /* not CRAY_STACK */
#ifdef CRAY2
/* Determine a "stack measure" for an arbitrary ADDRESS.
I doubt that "lint" will like this much. */
static long
i00afunc (long *address)
{
struct stk_stat status;
struct stk_trailer *trailer;
long *block, size;
long result = 0;
/* We want to iterate through all of the segments. The first
step is to get the stack status structure. We could do this
more quickly and more directly, perhaps, by referencing the
$LM00 common block, but I know that this works. */
STKSTAT (&status);
/* Set up the iteration. */
trailer = (struct stk_trailer *) (status.current_address
+ status.current_size
- 15);
/* There must be at least one stack segment. Therefore it is
a fatal error if "trailer" is null. */
if (trailer == 0)
abort ();
/* Discard segments that do not contain our argument address. */
while (trailer != 0)
{
block = (long *) trailer->this_address;
size = trailer->this_size;
if (block == 0 || size == 0)
abort ();
trailer = (struct stk_trailer *) trailer->link;
if ((block <= address) && (address < (block + size)))
break;
}
/* Set the result to the offset in this segment and add the sizes
of all predecessor segments. */
result = address - block;
if (trailer == 0)
{
return result;
}
do
{
if (trailer->this_size <= 0)
abort ();
result += trailer->this_size;
trailer = (struct stk_trailer *) trailer->link;
}
while (trailer != 0);
/* We are done. Note that if you present a bogus address (one
not in any segment), you will get a different number back, formed
from subtracting the address of the first block. This is probably
not what you want. */
return (result);
}
#else /* not CRAY2 */
/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
Determine the number of the cell within the stack,
given the address of the cell. The purpose of this
routine is to linearize, in some sense, stack addresses
for alloca. */
static long
i00afunc (long address)
{
long stkl = 0;
long size, pseg, this_segment, stack;
long result = 0;
struct stack_segment_linkage *ssptr;
/* Register B67 contains the address of the end of the
current stack segment. If you (as a subprogram) store
your registers on the stack and find that you are past
the contents of B67, you have overflowed the segment.
B67 also points to the stack segment linkage control
area, which is what we are really interested in. */
stkl = CRAY_STACKSEG_END ();
ssptr = (struct stack_segment_linkage *) stkl;
/* If one subtracts 'size' from the end of the segment,
one has the address of the first word of the segment.
If this is not the first segment, 'pseg' will be
nonzero. */
pseg = ssptr->sspseg;
size = ssptr->sssize;
this_segment = stkl - size;
/* It is possible that calling this routine itself caused
a stack overflow. Discard stack segments which do not
contain the target address. */
while (!(this_segment <= address && address <= stkl))
{
#ifdef DEBUG_I00AFUNC
fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
#endif
if (pseg == 0)
break;
stkl = stkl - pseg;
ssptr = (struct stack_segment_linkage *) stkl;
size = ssptr->sssize;
pseg = ssptr->sspseg;
this_segment = stkl - size;
}
result = address - this_segment;
/* If you subtract pseg from the current end of the stack,
you get the address of the previous stack segment's end.
This seems a little convoluted to me, but I'll bet you save
a cycle somewhere. */
while (pseg != 0)
{
#ifdef DEBUG_I00AFUNC
fprintf (stderr, "%011o %011o\n", pseg, size);
#endif
stkl = stkl - pseg;
ssptr = (struct stack_segment_linkage *) stkl;
size = ssptr->sssize;
pseg = ssptr->sspseg;
result += size;
}
return (result);
}
#endif /* not CRAY2 */
#endif /* CRAY */
#endif /* no alloca */
#endif /* not GCC version 2 */
/*
Local Variables:
c-file-style: "gnu"
End:
*/

943
libguile/coop-pthreads.c
View file

@ -1,943 +0,0 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 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
*/
#include "libguile/_scm.h" /* config.h, _scm.h, __scm.h should be first */
#include <unistd.h>
#include <stdio.h>
#include <assert.h>
#include <sys/time.h>
#include "libguile/validate.h"
#include "libguile/coop-pthreads.h"
#include "libguile/root.h"
#include "libguile/eval.h"
#include "libguile/async.h"
#include "libguile/ports.h"
#include "libguile/smob.h"
#undef DEBUG
/*** Queues */
static SCM
make_queue ()
{
return scm_cons (SCM_EOL, SCM_EOL);
}
static void
enqueue (SCM q, SCM t)
{
SCM c = scm_cons (t, SCM_EOL);
if (scm_is_null (SCM_CAR (q)))
SCM_SETCAR (q, c);
else
SCM_SETCDR (SCM_CDR (q), c);
SCM_SETCDR (q, c);
}
static SCM
dequeue (SCM q)
{
SCM c = SCM_CAR (q);
if (scm_is_null (c))
return SCM_BOOL_F;
else
{
SCM_SETCAR (q, SCM_CDR (c));
if (scm_is_null (SCM_CAR (q)))
SCM_SETCDR (q, SCM_EOL);
return SCM_CAR (c);
}
}
/*** Threads */
typedef struct scm_copt_thread {
/* A condition variable for sleeping on.
*/
pthread_cond_t sleep_cond;
/* A link for waiting queues.
*/
struct scm_copt_thread *next_waiting;
scm_root_state *root;
SCM handle;
pthread_t pthread;
SCM result;
SCM joining_threads;
/* For keeping track of the stack and registers. */
SCM_STACKITEM *base;
SCM_STACKITEM *top;
jmp_buf regs;
} scm_copt_thread;
static SCM
make_thread (SCM creation_protects)
{
SCM z;
scm_copt_thread *t = scm_gc_malloc (sizeof(*t), "thread");
SCM_NEWSMOB (z, t);
t->handle = z;
t->result = creation_protects;
t->base = NULL;
t->joining_threads = make_queue ();
pthread_cond_init (&t->sleep_cond, NULL);
return z;
}
static void
init_thread_creator (SCM thread, pthread_t th, scm_root_state *r)
{
scm_copt_thread *t = SCM_THREAD_DATA(thread);
t->root = r;
t->pthread = th;
#ifdef DEBUG
// fprintf (stderr, "%ld created %ld\n", pthread_self (), th);
#endif
}
static void
init_thread_creatant (SCM thread, SCM_STACKITEM *base)
{
scm_copt_thread *t = SCM_THREAD_DATA(thread);
t->base = base;
t->top = NULL;
}
static int
thread_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
scm_copt_thread *t = SCM_THREAD_DATA (exp);
scm_puts ("#<thread ", port);
scm_uintprint ((scm_t_bits)t, 16, port);
if (t->pthread != -1)
{
scm_putc (' ', port);
scm_intprint (t->pthread, 10, port);
}
else
scm_puts (" (exited)", port);
scm_putc ('>', port);
return 1;
}
static size_t
thread_free (SCM obj)
{
scm_copt_thread *t = SCM_THREAD_DATA (obj);
if (t->pthread != -1)
abort ();
scm_gc_free (t, sizeof (*t), "thread");
return 0;
}
/*** Fair mutexes */
/* POSIX mutexes are not necessarily fair but since we'd like to use a
mutex for scheduling, we build a fair one on top of POSIX.
*/
typedef struct fair_mutex {
pthread_mutex_t lock;
scm_copt_thread *owner;
scm_copt_thread *next_waiting, *last_waiting;
} fair_mutex;
static void
fair_mutex_init (fair_mutex *m)
{
pthread_mutex_init (&m->lock, NULL);
m->owner = NULL;
m->next_waiting = NULL;
m->last_waiting = NULL;
}
static void
fair_mutex_lock_1 (fair_mutex *m, scm_copt_thread *t)
{
if (m->owner == NULL)
m->owner = t;
else
{
t->next_waiting = NULL;
if (m->last_waiting)
m->last_waiting->next_waiting = t;
else
m->next_waiting = t;
m->last_waiting = t;
do
{
pthread_cond_wait (&t->sleep_cond, &m->lock);
}
while (m->owner != t);
assert (m->next_waiting == t);
m->next_waiting = t->next_waiting;
if (m->next_waiting == NULL)
m->last_waiting = NULL;
}
pthread_mutex_unlock (&m->lock);
}
static void
fair_mutex_lock (fair_mutex *m, scm_copt_thread *t)
{
pthread_mutex_lock (&m->lock);
fair_mutex_lock_1 (m, t);
}
static void
fair_mutex_unlock_1 (fair_mutex *m)
{
scm_copt_thread *t;
pthread_mutex_lock (&m->lock);
// fprintf (stderr, "%ld unlocking\n", m->owner->pthread);
if ((t = m->next_waiting) != NULL)
{
m->owner = t;
pthread_cond_signal (&t->sleep_cond);
}
else
m->owner = NULL;
// fprintf (stderr, "%ld unlocked\n", pthread_self ());
}
static void
fair_mutex_unlock (fair_mutex *m)
{
fair_mutex_unlock_1 (m);
pthread_mutex_unlock (&m->lock);
}
/* Temporarily give up the mutex. This function makes sure that we
are on the wait queue before starting the next thread. Otherwise
the next thread might preempt us and we will have a hard time
getting on the wait queue.
*/
#if 0
static void
fair_mutex_yield (fair_mutex *m)
{
scm_copt_thread *self, *next;
pthread_mutex_lock (&m->lock);
/* get next thread
*/
if ((next = m->next_waiting) == NULL)
{
/* No use giving it up. */
pthread_mutex_unlock (&m->lock);
return;
}
/* put us on queue
*/
self = m->owner;
self->next_waiting = NULL;
if (m->last_waiting)
m->last_waiting->next_waiting = self;
else
m->next_waiting = self;
m->last_waiting = self;
/* wake up next thread
*/
m->owner = next;
pthread_cond_signal (&next->sleep_cond);
/* wait for mutex
*/
do
{
pthread_cond_wait (&self->sleep_cond, &m->lock);
}
while (m->owner != self);
assert (m->next_waiting == self);
m->next_waiting = self->next_waiting;
if (m->next_waiting == NULL)
m->last_waiting = NULL;
pthread_mutex_unlock (&m->lock);
}
#else
static void
fair_mutex_yield (fair_mutex *m)
{
scm_copt_thread *self = m->owner;
fair_mutex_unlock_1 (m);
fair_mutex_lock_1 (m, self);
}
#endif
static void
fair_cond_wait (pthread_cond_t *c, fair_mutex *m)
{
scm_copt_thread *t = m->owner;
fair_mutex_unlock_1 (m);
pthread_cond_wait (c, &m->lock);
fair_mutex_lock_1 (m, t);
}
/* Return 1 when the mutex was signalled and 0 when not. */
static int
fair_cond_timedwait (pthread_cond_t *c, fair_mutex *m, scm_t_timespec *at)
{
int res;
scm_copt_thread *t = m->owner;
fair_mutex_unlock_1 (m);
res = pthread_cond_timedwait (c, &m->lock, at); /* XXX - signals? */
fair_mutex_lock_1 (m, t);
return res == 0;
}
/*** Scheduling */
/* When a thread wants to execute Guile functions, it locks the
guile_mutex.
*/
static fair_mutex guile_mutex;
static SCM cur_thread;
void *scm_i_copt_thread_data;
void
scm_i_copt_set_thread_data (void *data)
{
scm_copt_thread *t = SCM_THREAD_DATA (cur_thread);
scm_i_copt_thread_data = data;
t->root = (scm_root_state *)data;
}
static void
resume (scm_copt_thread *t)
{
cur_thread = t->handle;
scm_i_copt_thread_data = t->root;
t->top = NULL;
}
static void
enter_guile (scm_copt_thread *t)
{
fair_mutex_lock (&guile_mutex, t);
resume (t);
}
static scm_copt_thread *
suspend ()
{
SCM cur = cur_thread;
scm_copt_thread *c = SCM_THREAD_DATA (cur);
/* record top of stack for the GC */
c->top = (SCM_STACKITEM *)&c;
/* save registers. */
SCM_FLUSH_REGISTER_WINDOWS;
setjmp (c->regs);
return c;
}
static scm_copt_thread *
leave_guile ()
{
scm_copt_thread *c = suspend ();
fair_mutex_unlock (&guile_mutex);
return c;
}
int scm_i_switch_counter;
SCM
scm_yield ()
{
/* Testing guile_mutex.next_waiting without locking guile_mutex.lock
is OK since the outcome is not critical. Even when it changes
after the test, we do the right thing.
*/
if (guile_mutex.next_waiting)
{
scm_copt_thread *t = suspend ();
fair_mutex_yield (&guile_mutex);
resume (t);
}
return SCM_BOOL_T;
}
/* Put the current thread to sleep until it is explicitely unblocked.
*/
static void
block ()
{
scm_copt_thread *t = suspend ();
fair_cond_wait (&t->sleep_cond, &guile_mutex);
resume (t);
}
/* Put the current thread to sleep until it is explicitely unblocked
or until a signal arrives or until time AT (absolute time) is
reached. Return 1 when it has been unblocked; 0 otherwise.
*/
static int
timed_block (scm_t_timespec *at)
{
int res;
scm_copt_thread *t = suspend ();
res = fair_cond_timedwait (&t->sleep_cond, &guile_mutex, at);
resume (t);
return res;
}
/* Unblock a sleeping thread.
*/
static void
unblock (scm_copt_thread *t)
{
pthread_cond_signal (&t->sleep_cond);
}
/*** Thread creation */
static SCM all_threads;
static int thread_count;
typedef struct launch_data {
SCM thread;
SCM rootcont;
scm_t_catch_body body;
void *body_data;
scm_t_catch_handler handler;
void *handler_data;
} launch_data;
static SCM
body_bootstrip (launch_data* data)
{
/* First save the new root continuation */
data->rootcont = scm_root->rootcont;
return (data->body) (data->body_data);
// return scm_call_0 (data->body);
}
static SCM
handler_bootstrip (launch_data* data, SCM tag, SCM throw_args)
{
scm_root->rootcont = data->rootcont;
return (data->handler) (data->handler_data, tag, throw_args);
// return scm_apply_1 (data->handler, tag, throw_args);
}
static void
really_launch (SCM_STACKITEM *base, launch_data *data)
{
SCM thread = data->thread;
scm_copt_thread *t = SCM_THREAD_DATA (thread);
init_thread_creatant (thread, base);
enter_guile (t);
data->rootcont = SCM_BOOL_F;
t->result =
scm_internal_cwdr ((scm_t_catch_body) body_bootstrip,
data,
(scm_t_catch_handler) handler_bootstrip,
data, base);
free (data);
pthread_detach (t->pthread);
all_threads = scm_delq (thread, all_threads);
t->pthread = -1;
thread_count--;
leave_guile ();
}
static void *
launch_thread (void *p)
{
really_launch ((SCM_STACKITEM *)&p, (launch_data *)p);
return NULL;
}
static SCM
create_thread (scm_t_catch_body body, void *body_data,
scm_t_catch_handler handler, void *handler_data,
SCM protects)
{
SCM thread;
/* Make new thread. The first thing the new thread will do is to
lock guile_mutex. Thus, we can safely complete its
initialization after creating it. While the new thread starts,
all its data is protected via all_threads.
*/
{
pthread_t th;
SCM root, old_winds;
launch_data *data;
/* Unwind wind chain. */
old_winds = scm_dynwinds;
scm_dowinds (SCM_EOL, scm_ilength (scm_root->dynwinds));
/* Allocate thread locals. */
root = scm_make_root (scm_root->handle);
data = scm_gc_malloc (sizeof (launch_data));
/* Make thread. */
thread = make_thread (protects);
data->thread = thread;
data->body = body;
data->body_data = body_data;
data->handler = handler;
data->handler_data = handler_data;
pthread_create (&th, NULL, launch_thread, (void *) data);
init_thread_creator (thread, th, SCM_ROOT_STATE (root));
all_threads = scm_cons (thread, all_threads);
thread_count++;
/* Return to old dynamic context. */
scm_dowinds (old_winds, - scm_ilength (old_winds));
}
return thread;
}
SCM
scm_call_with_new_thread (SCM argl)
#define FUNC_NAME s_call_with_new_thread
{
SCM thunk, handler;
/* Check arguments. */
{
register SCM args = argl;
if (!scm_is_pair (args))
SCM_WRONG_NUM_ARGS ();
thunk = SCM_CAR (args);
SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)),
thunk,
SCM_ARG1,
s_call_with_new_thread);
args = SCM_CDR (args);
if (!scm_is_pair (args))
SCM_WRONG_NUM_ARGS ();
handler = SCM_CAR (args);
SCM_ASSERT (scm_is_true (scm_procedure_p (handler)),
handler,
SCM_ARG2,
s_call_with_new_thread);
if (!scm_is_null (SCM_CDR (args)))
SCM_WRONG_NUM_ARGS ();
}
return create_thread ((scm_t_catch_body) scm_call_0, thunk,
(scm_t_catch_handler) scm_apply_1, handler,
argl);
}
#undef FUNC_NAME
SCM
scm_spawn_thread (scm_t_catch_body body, void *body_data,
scm_t_catch_handler handler, void *handler_data)
{
return create_thread (body, body_data, handler, handler_data, SCM_BOOL_F);
}
/*** Mutexes */
/* We implement our own mutex type since we want them to be 'fair', we
want to do fancy things while waiting for them (like running
asyncs) and we want to support waiting on many things at once.
Also, we might add things that are nice for debugging.
*/
typedef struct scm_copt_mutex {
/* the thread currently owning the mutex, or SCM_BOOL_F. */
SCM owner;
/* how much the owner owns us. */
int level;
/* the threads waiting for this mutex. */
SCM waiting;
} scm_copt_mutex;
SCM
scm_make_mutex ()
{
SCM mx = scm_make_smob (scm_tc16_mutex);
scm_copt_mutex *m = SCM_MUTEX_DATA (mx);
m->owner = SCM_BOOL_F;
m->level = 0;
m->waiting = make_queue ();
return mx;
}
SCM
scm_lock_mutex (SCM mx)
#define FUNC_NAME s_lock_mutex
{
scm_copt_mutex *m;
SCM_ASSERT (SCM_MUTEXP (mx), mx, SCM_ARG1, FUNC_NAME);
m = SCM_MUTEX_DATA (mx);
if (m->owner == SCM_BOOL_F)
m->owner = cur_thread;
else if (m->owner == cur_thread)
m->level++;
else
{
while (m->owner != cur_thread)
{
enqueue (m->waiting, cur_thread);
block ();
SCM_ASYNC_TICK;
}
}
return SCM_BOOL_T;
}
#undef FUNC_NAME
SCM
scm_try_mutex (SCM mx)
#define FUNC_NAME s_try_mutex
{
scm_copt_mutex *m;
SCM_ASSERT (SCM_MUTEXP (mx), mx, SCM_ARG1, FUNC_NAME);
m = SCM_MUTEX_DATA (mx);
if (m->owner == SCM_BOOL_F)
m->owner = cur_thread;
else if (m->owner == cur_thread)
m->level++;
else
return SCM_BOOL_F;
return SCM_BOOL_T;
}
#undef FUNC_NAME
SCM
scm_unlock_mutex (SCM mx)
#define FUNC_NAME s_unlock_mutex
{
scm_copt_mutex *m;
SCM_ASSERT (SCM_MUTEXP (mx), mx, SCM_ARG1, FUNC_NAME);
m = SCM_MUTEX_DATA (mx);
if (m->owner != cur_thread)
{
if (m->owner == SCM_BOOL_F)
SCM_MISC_ERROR ("mutex not locked", SCM_EOL);
else
SCM_MISC_ERROR ("mutex not locked by this thread", SCM_EOL);
}
else if (m->level > 0)
m->level--;
else
{
SCM next = dequeue (m->waiting);
if (scm_is_true (next))
{
m->owner = next;
unblock (SCM_THREAD_DATA (next));
scm_yield ();
}
else
m->owner = SCM_BOOL_F;
}
return SCM_BOOL_T;
}
#undef FUNC_NAME
/*** Condition variables */
/* Like mutexes, we implement our own condition variables using the
primitives above.
*/
/* yeah, we don't need a structure for this, but more things (like a
name) will likely follow... */
typedef struct scm_copt_cond {
/* the threads waiting for this condition. */
SCM waiting;
} scm_copt_cond;
static SCM
cond_mark (SCM cv)
{
scm_copt_cond *c = SCM_CONDVAR_DATA (cv);
return c->waiting;
}
SCM
scm_make_condition_variable (void)
{
SCM cv = scm_make_smob (scm_tc16_condvar);
scm_copt_cond *c = SCM_CONDVAR_DATA (cv);
c->waiting = make_queue ();
return cv;
}
SCM
scm_timed_wait_condition_variable (SCM cv, SCM mx, SCM t)
#define FUNC_NAME s_wait_condition_variable
{
scm_copt_cond *c;
scm_t_timespec waittime;
int res;
SCM_ASSERT (SCM_CONDVARP (cv),
cv,
SCM_ARG1,
s_wait_condition_variable);
SCM_ASSERT (SCM_MUTEXP (mx),
mx,
SCM_ARG2,
s_wait_condition_variable);
if (!SCM_UNBNDP (t))
{
if (scm_is_pair (t))
{
SCM_VALIDATE_UINT_COPY (3, SCM_CAR(t), waittime.tv_sec);
SCM_VALIDATE_UINT_COPY (3, SCM_CDR(t), waittime.tv_nsec);
waittime.tv_nsec *= 1000;
}
else
{
SCM_VALIDATE_UINT_COPY (3, t, waittime.tv_sec);
waittime.tv_nsec = 0;
}
}
c = SCM_CONDVAR_DATA (cv);
enqueue (c->waiting, cur_thread);
scm_unlock_mutex (mx);
if (SCM_UNBNDP (t))
{
block ();
res = 1;
}
else
res = timed_block (&waittime);
scm_lock_mutex (mx);
return scm_from_bool (res);
}
#undef FUNC_NAME
SCM
scm_signal_condition_variable (SCM cv)
#define FUNC_NAME s_signal_condition_variable
{
SCM th;
scm_copt_cond *c;
SCM_ASSERT (SCM_CONDVARP (cv),
cv,
SCM_ARG1,
s_signal_condition_variable);
c = SCM_CONDVAR_DATA (cv);
if (scm_is_true (th = dequeue (c->waiting)))
unblock (SCM_THREAD_DATA (th));
return SCM_BOOL_T;
}
#undef FUNC_NAME
SCM
scm_broadcast_condition_variable (SCM cv)
#define FUNC_NAME s_broadcast_condition_variable
{
SCM th;
scm_copt_cond *c;
SCM_ASSERT (SCM_CONDVARP (cv),
cv,
SCM_ARG1,
s_signal_condition_variable);
c = SCM_CONDVAR_DATA (cv);
while (scm_is_true (th = dequeue (c->waiting)))
unblock (SCM_THREAD_DATA (th));
return SCM_BOOL_T;
}
#undef FUNC_NAME
/*** Initialization */
void
scm_threads_init (SCM_STACKITEM *base)
{
scm_tc16_thread = scm_make_smob_type ("thread", 0);
scm_tc16_mutex = scm_make_smob_type ("mutex", sizeof (scm_copt_mutex));
scm_tc16_condvar = scm_make_smob_type ("condition-variable",
sizeof (scm_copt_cond));
scm_i_switch_counter = SCM_I_THREAD_SWITCH_COUNT;
fair_mutex_init (&guile_mutex);
cur_thread = make_thread (SCM_BOOL_F);
enter_guile (SCM_THREAD_DATA (cur_thread));
/* root is set later from init.c */
init_thread_creator (cur_thread, pthread_self(), NULL);
init_thread_creatant (cur_thread, base);
thread_count = 1;
scm_gc_register_root (&all_threads);
all_threads = scm_cons (cur_thread, SCM_EOL);
scm_set_smob_print (scm_tc16_thread, thread_print);
}
/*** Marking stacks */
/* XXX - what to do with this? Do we need to handle this for blocked
threads as well?
*/
#ifdef __ia64__
# define SCM_MARK_BACKING_STORE() do { \
ucontext_t ctx; \
SCM_STACKITEM * top, * bot; \
getcontext (&ctx); \
scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \
((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \
/ sizeof (SCM_STACKITEM))); \
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()
#endif
/*** Select */
int
scm_internal_select (int nfds,
SELECT_TYPE *readfds,
SELECT_TYPE *writefds,
SELECT_TYPE *exceptfds,
struct timeval *timeout)
{
int res, eno;
scm_copt_thread *c = leave_guile ();
res = select (nfds, readfds, writefds, exceptfds, timeout);
eno = errno;
enter_guile (c);
SCM_ASYNC_TICK;
errno = eno;
return res;
}
void
scm_init_iselect ()
{
}
unsigned long
scm_thread_usleep (unsigned long usec)
{
scm_copt_thread *c = leave_guile ();
usleep (usec);
enter_guile (c);
return 0;
}
unsigned long
scm_thread_sleep (unsigned long sec)
{
unsigned long res;
scm_copt_thread *c = leave_guile ();
res = sleep (sec);
enter_guile (c);
return res;
}
/*** Misc */
SCM
scm_current_thread (void)
{
return cur_thread;
}
SCM
scm_all_threads (void)
{
return all_threads;
}
scm_root_state *
scm_i_thread_root (SCM thread)
{
if (thread == cur_thread)
return scm_i_copt_thread_data;
else
return ((scm_copt_thread *)SCM_THREAD_DATA (thread))->root;
}
SCM
scm_join_thread (SCM thread)
#define FUNC_NAME s_join_thread
{
scm_copt_thread *t;
SCM res;
SCM_VALIDATE_THREAD (1, thread);
t = SCM_THREAD_DATA (thread);
if (t->pthread != -1)
{
scm_copt_thread *c = leave_guile ();
pthread_join (t->pthread, NULL);
enter_guile (c);
}
res = t->result;
t->result = SCM_BOOL_F;
return res;
}
#undef FUNC_NAME
int
scm_c_thread_exited_p (SCM thread)
#define FUNC_NAME s_scm_thread_exited_p
{
scm_copt_thread *t;
SCM_VALIDATE_THREAD (1, thread);
t = SCM_THREAD_DATA (thread);
return t->pthread == -1;
}
#undef FUNC_NAME
/*
Local Variables:
c-file-style: "gnu"
End:
*/

83
libguile/coop-pthreads.h
View file

@ -1,83 +0,0 @@
/* classes: h_files */
#ifndef SCM_COOP_PTHREADS_H
#define SCM_COOP_PTHREADS_H
/* Copyright (C) 2002, 2006, 2008 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
*/
/* The coop-pthreads implementation. We use pthreads for the basic
multi threading stuff, but rig it so that only one thread is ever
active inside Guile.
*/
#include <pthread.h>
#include "libguile/boehm-gc.h"
#include "libguile/iselect.h"
#if (SCM_ENABLE_DEPRECATED == 1)
/* Thread local data support --- generic C API */
typedef pthread_key_t scm_t_key;
#define scm_key_create pthread_key_create
#define scm_setspecific pthread_setspecific
#define scm_getspecific pthread_getspecific
#define scm_key_delete pthread_key_delete
#endif /* SCM_ENABLE_DEPRECATED == 1 */
/* Since only one thread can be active anyway, we don't need to do
anything special around critical sections. In fact, that's the
reason we do only support cooperative threading: Guile's critical
regions have not been completely identified yet. (I think.) */
#define SCM_CRITICAL_SECTION_START
#define SCM_CRITICAL_SECTION_END
#define SCM_I_THREAD_SWITCH_COUNT 50
#define SCM_THREAD_SWITCHING_CODE \
do { \
scm_i_switch_counter--; \
if (scm_i_switch_counter == 0) \
{ \
scm_i_switch_counter = SCM_I_THREAD_SWITCH_COUNT; \
scm_yield(); \
} \
} while (0)
SCM_API int scm_i_switch_counter;
#define SCM_THREAD_LOCAL_DATA (scm_i_copt_thread_data)
#define SCM_SET_THREAD_LOCAL_DATA(ptr) (scm_i_copt_set_thread_data (ptr))
SCM_API void *scm_i_copt_thread_data;
SCM_INTERNAL void scm_i_copt_set_thread_data (void *data);
#endif /* SCM_COOP_PTHREAD_H */
/*
Local Variables:
c-file-style: "gnu"
End:
*/

763
libguile/coop.c
View file

@ -1,763 +0,0 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 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
*/
/* $Id: coop.c,v 1.39 2006-04-17 00:05:38 kryde Exp $ */
/* Cooperative thread library, based on QuickThreads */
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <stdio.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <errno.h>
#include "qt/qt.h"
#include "libguile/eval.h"
/* #define COOP_STKSIZE (0x10000) */
#define COOP_STKSIZE (scm_eval_stack)
/* `alignment' must be a power of 2. */
#define COOP_STKALIGN(sp, alignment) \
((void *)((((qt_word_t)(sp)) + (alignment) - 1) & ~((alignment)-1)))
/* Queue access functions. */
static void
coop_qinit (coop_q_t *q)
{
q->t.next = q->tail = &q->t;
q->t.all_prev = NULL;
q->t.all_next = NULL;
q->t.nfds = 0;
q->t.readfds = NULL;
q->t.writefds = NULL;
q->t.exceptfds = NULL;
q->t.timeoutp = 0;
}
coop_t *
coop_qget (coop_q_t *q)
{
coop_t *t;
t = q->t.next;
q->t.next = t->next;
if (t->next == &q->t)
{
if (t == &q->t)
{ /* If it was already empty .. */
return NULL; /* .. say so. */
}
q->tail = &q->t; /* Else now it is empty. */
}
return (t);
}
void
coop_qput (coop_q_t *q, coop_t *t)
{
q->tail->next = t;
t->next = &q->t;
q->tail = t;
}
static void
coop_all_qput (coop_q_t *q, coop_t *t)
{
if (q->t.all_next)
q->t.all_next->all_prev = t;
t->all_prev = NULL;
t->all_next = q->t.all_next;
q->t.all_next = t;
}
static void
coop_all_qremove (coop_q_t *q, coop_t *t)
{
if (t->all_prev)
t->all_prev->all_next = t->all_next;
else
q->t.all_next = t->all_next;
if (t->all_next)
t->all_next->all_prev = t->all_prev;
}
/* Insert thread t into the ordered queue q.
q is ordered after wakeup_time. Threads which aren't sleeping but
waiting for I/O go last into the queue. */
void
coop_timeout_qinsert (coop_q_t *q, coop_t *t)
{
coop_t *pred = &q->t;
int sec = t->wakeup_time.tv_sec;
int usec = t->wakeup_time.tv_usec;
while (pred->next != &q->t
&& pred->next->timeoutp
&& (pred->next->wakeup_time.tv_sec < sec
|| (pred->next->wakeup_time.tv_sec == sec
&& pred->next->wakeup_time.tv_usec < usec)))
pred = pred->next;
t->next = pred->next;
pred->next = t;
if (t->next == &q->t)
q->tail = t;
}
/* Thread routines. */
coop_q_t coop_global_runq; /* A queue of runable threads. */
coop_q_t coop_global_sleepq; /* A queue of sleeping threads. */
coop_q_t coop_tmp_queue; /* A temp working queue */
coop_q_t coop_global_allq; /* A queue of all threads. */
static coop_t coop_global_main; /* Thread for the process. */
coop_t *coop_global_curr; /* Currently-executing thread. */
#ifdef GUILE_PTHREAD_COMPAT
static coop_q_t coop_deadq;
static int coop_quitting_p = -1;
static pthread_cond_t coop_cond_quit;
static pthread_cond_t coop_cond_create;
static pthread_mutex_t coop_mutex_create;
static pthread_t coop_mother;
static int mother_awake_p = 0;
static coop_t *coop_child;
#endif
static void *coop_starthelp (qt_t *old, void *ignore0, void *ignore1);
static void coop_only (void *pu, void *pt, qt_userf_t *f);
static void *coop_aborthelp (qt_t *sp, void *old, void *null);
static void *coop_yieldhelp (qt_t *sp, void *old, void *blockq);
/* called on process termination. */
#ifdef HAVE_ATEXIT
static void
coop_finish (void)
#else
#ifdef HAVE_ON_EXIT
extern int on_exit (void (*procp) (), int arg);
static void
coop_finish (int status, void *arg)
#else
#error Dont know how to setup a cleanup handler on your system.
#endif
#endif
{
#ifdef GUILE_PTHREAD_COMPAT
coop_quitting_p = 1;
pthread_cond_signal (&coop_cond_create);
pthread_cond_broadcast (&coop_cond_quit);
#endif
}
void
coop_init ()
{
coop_qinit (&coop_global_runq);
coop_qinit (&coop_global_sleepq);
coop_qinit (&coop_tmp_queue);
coop_qinit (&coop_global_allq);
coop_global_curr = &coop_global_main;
#ifdef GUILE_PTHREAD_COMPAT
coop_qinit (&coop_deadq);
pthread_cond_init (&coop_cond_quit, NULL);
pthread_cond_init (&coop_cond_create, NULL);
pthread_mutex_init (&coop_mutex_create, NULL);
#endif
#ifdef HAVE_ATEXIT
atexit (coop_finish);
#else
#ifdef HAVE_ON_EXIT
on_exit (coop_finish, 0);
#endif
#endif
}
void
coop_start()
{
coop_t *next;
while ((next = coop_qget (&coop_global_runq)) != NULL) {
coop_global_curr = next;
QT_BLOCK (coop_starthelp, 0, 0, next->sp);
}
}
static void *
coop_starthelp (qt_t *old, void *ignore0, void *ignore1)
{
coop_global_main.sp = old;
coop_global_main.joining = NULL;
coop_qput (&coop_global_runq, &coop_global_main);
return NULL; /* not used, but keeps compiler happy */
}
int
coop_mutex_init (coop_m *m)
{
return coop_new_mutex_init (m, NULL);
}
int
coop_new_mutex_init (coop_m *m, coop_mattr *attr)
{
m->owner = NULL;
m->level = 0;
coop_qinit(&(m->waiting));
return 0;
}
int
coop_mutex_trylock (coop_m *m)
{
if (m->owner == NULL)
{
m->owner = coop_global_curr;
return 0;
}
else if (m->owner == coop_global_curr)
{
m->level++;
return 0;
}
else
return EBUSY;
}
int
coop_mutex_lock (coop_m *m)
{
if (m->owner == NULL)
{
m->owner = coop_global_curr;
}
else if (m->owner == coop_global_curr)
{
m->level++;
}
else
{
coop_t *old, *newthread;
/* Record the current top-of-stack before going to sleep */
coop_global_curr->top = &old;
newthread = coop_wait_for_runnable_thread();
if (newthread == coop_global_curr)
coop_abort ();
old = coop_global_curr;
coop_global_curr = newthread;
QT_BLOCK (coop_yieldhelp, old, &(m->waiting), newthread->sp);
}
return 0;
}
int
coop_mutex_unlock (coop_m *m)
{
coop_t *old, *newthread;
if (m->level == 0)
{
newthread = coop_qget (&(m->waiting));
if (newthread != NULL)
{
/* Record the current top-of-stack before going to sleep */
coop_global_curr->top = &old;
old = coop_global_curr;
coop_global_curr = newthread;
/* The new thread came into m->waiting through a lock operation.
It now owns this mutex. */
m->owner = coop_global_curr;
QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
}
else
{
m->owner = NULL;
}
}
else if (m->level > 0)
m->level--;
else
abort (); /* XXX */
return 0;
}
int
coop_mutex_destroy (coop_m *m)
{
return 0;
}
int
coop_condition_variable_init (coop_c *c)
{
return coop_new_condition_variable_init (c, NULL);
}
int
coop_new_condition_variable_init (coop_c *c, coop_cattr *a)
{
coop_qinit(&(c->waiting));
return 0;
}
int
coop_condition_variable_wait_mutex (coop_c *c, coop_m *m)
{
coop_t *old, *newthread;
/* coop_mutex_unlock (m); */
newthread = coop_qget (&(m->waiting));
if (newthread != NULL)
{
m->owner = newthread;
}
else
{
m->owner = NULL;
/*fixme* Should we really wait here? Isn't it OK just to proceed? */
newthread = coop_wait_for_runnable_thread();
if (newthread == coop_global_curr)
coop_abort ();
}
coop_global_curr->top = &old;
old = coop_global_curr;
coop_global_curr = newthread;
QT_BLOCK (coop_yieldhelp, old, &(c->waiting), newthread->sp);
coop_mutex_lock (m);
return 0;
}
int
coop_condition_variable_timed_wait_mutex (coop_c *c,
coop_m *m,
const scm_t_timespec *abstime)
{
coop_t *old, *t;
#ifdef ETIMEDOUT
int res = ETIMEDOUT;
#elif defined (WSAETIMEDOUT)
int res = WSAETIMEDOUT;
#else
int res = 0;
#endif
/* coop_mutex_unlock (m); */
t = coop_qget (&(m->waiting));
if (t != NULL)
{
m->owner = t;
}
else
{
m->owner = NULL;
coop_global_curr->timeoutp = 1;
coop_global_curr->wakeup_time.tv_sec = abstime->tv_sec;
coop_global_curr->wakeup_time.tv_usec = abstime->tv_nsec / 1000;
coop_timeout_qinsert (&coop_global_sleepq, coop_global_curr);
t = coop_wait_for_runnable_thread();
}
if (t != coop_global_curr)
{
coop_global_curr->top = &old;
old = coop_global_curr;
coop_global_curr = t;
QT_BLOCK (coop_yieldhelp, old, &(c->waiting), t->sp);
/* Are we still in the sleep queue? */
old = &coop_global_sleepq.t;
for (t = old->next; t != &coop_global_sleepq.t; old = t, t = t->next)
if (t == coop_global_curr)
{
old->next = t->next; /* unlink */
res = 0;
break;
}
}
coop_mutex_lock (m);
return res;
}
int
coop_condition_variable_broadcast (coop_c *c)
{
coop_t *newthread;
while ((newthread = coop_qget (&(c->waiting))) != NULL)
{
coop_qput (&coop_global_runq, newthread);
}
return 0;
}
int
coop_condition_variable_signal (coop_c *c)
{
return coop_condition_variable_broadcast (c);
}
/* {Keys}
*/
static int n_keys = 0;
static int max_keys = 0;
static void (**destructors) (void *) = 0;
int
coop_key_create (coop_k *keyp, void (*destructor) (void *value))
{
if (n_keys >= max_keys)
{
int i;
max_keys = max_keys ? max_keys * 3 / 2 : 10;
destructors = realloc (destructors, sizeof (void *) * max_keys);
if (destructors == 0)
{
fprintf (stderr, "Virtual memory exceeded in coop_key_create\n");
exit (1);
}
for (i = n_keys; i < max_keys; ++i)
destructors[i] = NULL;
}
destructors[n_keys] = destructor;
*keyp = n_keys++;
return 0;
}
int
coop_setspecific (coop_k key, const void *value)
{
int n_keys = coop_global_curr->n_keys;
if (key >= n_keys)
{
int i;
coop_global_curr->n_keys = max_keys;
coop_global_curr->specific = realloc (n_keys
? coop_global_curr->specific
: NULL,
sizeof (void *) * max_keys);
if (coop_global_curr->specific == 0)
{
fprintf (stderr, "Virtual memory exceeded in coop_setspecific\n");
exit (1);
}
for (i = n_keys; i < max_keys; ++i)
coop_global_curr->specific[i] = NULL;
}
coop_global_curr->specific[key] = (void *) value;
return 0;
}
void *
coop_getspecific (coop_k key)
{
return (key < coop_global_curr->n_keys
? coop_global_curr->specific[key]
: NULL);
}
int
coop_key_delete (coop_k key)
{
return 0;
}
int
coop_condition_variable_destroy (coop_c *c)
{
return 0;
}
#ifdef GUILE_PTHREAD_COMPAT
#include "libguile/boehm-gc.h"
/* 1K room for the cond wait routine */
#if SCM_STACK_GROWS_UP
# define COOP_STACK_ROOM (256)
#else
# define COOP_STACK_ROOM (-256)
#endif
static void *
dummy_start (void *coop_thread)
{
coop_t *t = (coop_t *) coop_thread;
int res;
t->sp = (qt_t *) (&t + COOP_STACK_ROOM);
pthread_mutex_init (&t->dummy_mutex, NULL);
pthread_mutex_lock (&t->dummy_mutex);
coop_child = 0;
do
res = pthread_cond_wait (&coop_cond_quit, &t->dummy_mutex);
while (res == EINTR);
return 0;
}
static void *
mother (void *dummy)
{
pthread_mutex_lock (&coop_mutex_create);
while (!coop_quitting_p)
{
int res;
pthread_create (&coop_child->dummy_thread,
NULL,
dummy_start,
coop_child);
mother_awake_p = 0;
do
res = pthread_cond_wait (&coop_cond_create, &coop_mutex_create);
while (res == EINTR);
}
return 0;
}
#endif
coop_t *
coop_create (coop_userf_t *f, void *pu)
{
coop_t *t;
#ifndef GUILE_PTHREAD_COMPAT
void *sto;
#endif
#ifdef GUILE_PTHREAD_COMPAT
t = coop_qget (&coop_deadq);
if (t)
{
t->sp = t->base;
t->specific = 0;
t->n_keys = 0;
}
else
#endif
{
t = scm_malloc (sizeof (coop_t));
t->specific = NULL;
t->n_keys = 0;
#ifdef GUILE_PTHREAD_COMPAT
coop_child = t;
mother_awake_p = 1;
if (coop_quitting_p < 0)
{
coop_quitting_p = 0;
/* We can't create threads ourselves since the pthread
* corresponding to this stack might be sleeping.
*/
pthread_create (&coop_mother, NULL, mother, NULL);
}
else
{
pthread_cond_signal (&coop_cond_create);
}
/* We can't use a pthreads condition variable since "this"
* pthread could already be asleep. We can't use a COOP
* condition variable because they are not safe against
* pre-emptive switching.
*/
while (coop_child || mother_awake_p)
usleep (0);
#else
t->sto = scm_malloc (COOP_STKSIZE);
sto = COOP_STKALIGN (t->sto, QT_STKALIGN);
t->sp = QT_SP (sto, COOP_STKSIZE - QT_STKALIGN);
#endif
t->base = t->sp;
}
t->sp = QT_ARGS (t->sp, pu, t, (qt_userf_t *)f, coop_only);
t->joining = NULL;
coop_qput (&coop_global_runq, t);
coop_all_qput (&coop_global_allq, t);
return t;
}
static void
coop_only (void *pu, void *pt, qt_userf_t *f)
{
coop_global_curr = (coop_t *)pt;
(*(coop_userf_t *)f)(pu);
coop_abort();
/* NOTREACHED */
}
void
coop_abort ()
{
coop_t *old, *newthread;
/* Wake up any threads that are waiting to join this one */
if (coop_global_curr->joining)
{
while ((newthread = coop_qget ((coop_q_t *)(coop_global_curr->joining)))
!= NULL)
{
coop_qput (&coop_global_runq, newthread);
}
free (coop_global_curr->joining);
}
scm_I_am_dead = 1;
do {
newthread = coop_wait_for_runnable_thread();
} while (newthread == coop_global_curr);
scm_I_am_dead = 0;
coop_all_qremove (&coop_global_allq, coop_global_curr);
old = coop_global_curr;
coop_global_curr = newthread;
QT_ABORT (coop_aborthelp, old, (void *) NULL, newthread->sp);
}
static void *
coop_aborthelp (qt_t *sp, void *old, void *null)
{
coop_t *oldthread = (coop_t *) old;
if (oldthread->specific)
free (oldthread->specific);
#ifndef GUILE_PTHREAD_COMPAT
free (oldthread->sto);
free (oldthread);
#else
coop_qput (&coop_deadq, oldthread);
#endif
return NULL;
}
void
coop_join(coop_t *t)
{
coop_t *old, *newthread;
/* Create a join list if necessary */
if (t->joining == NULL)
{
t->joining = scm_malloc(sizeof(coop_q_t));
coop_qinit((coop_q_t *) t->joining);
}
newthread = coop_wait_for_runnable_thread();
if (newthread == coop_global_curr)
return;
old = coop_global_curr;
coop_global_curr = newthread;
QT_BLOCK (coop_yieldhelp, old, (coop_q_t *) t->joining, newthread->sp);
}
void
coop_yield()
{
coop_t *old = NULL;
coop_t *newthread;
newthread = coop_next_runnable_thread();
/* There may be no other runnable threads. Return if this is the
case. */
if (newthread == coop_global_curr)
return;
old = coop_global_curr;
coop_global_curr = newthread;
QT_BLOCK (coop_yieldhelp, old, &coop_global_runq, newthread->sp);
}
static void *
coop_yieldhelp (qt_t *sp, void *old, void *blockq)
{
((coop_t *)old)->sp = sp;
coop_qput ((coop_q_t *)blockq, (coop_t *)old);
return NULL;
}
/* Replacement for the system's sleep() function. Does the right thing
for the process - but not for the system (it busy-waits) */
void *
coop_sleephelp (qt_t *sp, void *old, void *blockq)
{
((coop_t *)old)->sp = sp;
/* old is already on the sleep queue - so there's no need to
do anything extra here */
return NULL;
}
unsigned long
scm_thread_usleep (unsigned long usec)
{
struct timeval timeout;
timeout.tv_sec = 0;
timeout.tv_usec = usec;
scm_internal_select (0, NULL, NULL, NULL, &timeout);
return 0; /* Maybe we should calculate actual time slept,
but this is faster... :) */
}
unsigned long
scm_thread_sleep (unsigned long sec)
{
time_t now = time (NULL);
struct timeval timeout;
unsigned long slept;
timeout.tv_sec = sec;
timeout.tv_usec = 0;
scm_internal_select (0, NULL, NULL, NULL, &timeout);
slept = time (NULL) - now;
return slept > sec ? 0 : sec - slept;
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/

2
libguile/debug-malloc.c
View file

@ -220,7 +220,7 @@ SCM_DEFINE (scm_malloc_stats, "malloc-stats", 0, 0, 0,
int i;
for (i = 0; i < malloc_type_size + N_SEEK; ++i)
if (malloc_type[i].key)
res = scm_acons (scm_makfrom0str ((char *) malloc_type[i].key),
res = scm_acons (scm_from_locale_string ((char *) malloc_type[i].key),
scm_from_int ((int) malloc_type[i].data),
res);
return res;

13
libguile/dynl.c
View file

@ -1,7 +1,7 @@
/* dynl.c - dynamic linking
*
* Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002,
* 2003, 2008 Free Software Foundation, Inc.
* 2003, 2008, 2009 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
@ -262,12 +262,6 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
}
#undef FUNC_NAME
static void
free_string_pointers (void *data)
{
scm_i_free_string_pointers ((char **)data);
}
SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
(SCM func, SCM dobj, SCM args),
"Call the C function indicated by @var{func} and @var{dobj},\n"
@ -288,21 +282,16 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
int result, argc;
char **argv;
scm_dynwind_begin (0);
if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
fptr = (int (*) (int, char **)) scm_to_ulong (func);
argv = scm_i_allocate_string_pointers (args);
scm_dynwind_unwind_handler (free_string_pointers, argv,
SCM_F_WIND_EXPLICITLY);
for (argc = 0; argv[argc]; argc++)
;
result = (*fptr) (argc, argv);
scm_dynwind_end ();
return scm_from_int (result);
}
#undef FUNC_NAME

11
libguile/fluids.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009 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
@ -152,9 +152,9 @@ next_fluid_num ()
/* FIXME: Since we use `scm_malloc ()', ALLOCATED_FLUIDS is scanned by
the GC; therefore, all fluids remain reachable for the entire
program lifetime. Hopefully this is not a problem in practice. */
char *prev_allocated_fluids;
char *new_allocated_fluids =
scm_malloc (allocated_fluids_len + FLUID_GROW);
scm_gc_malloc (allocated_fluids_len + FLUID_GROW,
"allocated fluids");
/* Copy over old values and initialize rest. GC can not run
during these two operations since there is no safe point in
@ -164,16 +164,11 @@ next_fluid_num ()
memset (new_allocated_fluids + allocated_fluids_len, 0, FLUID_GROW);
n = allocated_fluids_len;
prev_allocated_fluids = allocated_fluids;
/* Update the vector of allocated fluids. Dynamic states will
eventually be lazily grown to accomodate the new value of
ALLOCATED_FLUIDS_LEN in `fluid-ref' and `fluid-set!'. */
allocated_fluids = new_allocated_fluids;
allocated_fluids_len += FLUID_GROW;
if (prev_allocated_fluids != NULL)
free (prev_allocated_fluids);
}
allocated_fluids_num += 1;

37
libguile/goops.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008
/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -152,8 +152,13 @@ SCM scm_class_protected_opaque, scm_class_protected_read_only;
SCM scm_class_scm;
SCM scm_class_int, scm_class_float, scm_class_double;
SCM *scm_port_class = 0;
SCM *scm_smob_class = 0;
/* Port classes. Allocate 3 times the maximum number of port types so that
input ports, output ports, and in/out ports can be stored at different
offsets. See `SCM_IN_PCLASS_INDEX' et al. */
SCM scm_port_class[3 * SCM_I_MAX_PORT_TYPE_COUNT];
/* SMOB classes. */
SCM scm_smob_class[SCM_I_MAX_SMOB_TYPE_COUNT];
SCM scm_no_applicable_method;
@ -1216,7 +1221,10 @@ SCM_DEFINE (scm_sys_fast_slot_ref, "%fast-slot-ref", 2, 0, 0,
unsigned long int i;
SCM_VALIDATE_INSTANCE (1, obj);
i = scm_to_unsigned_integer (index, 0, SCM_NUMBER_OF_SLOTS(obj)-1);
i = scm_to_unsigned_integer (index, 0,
SCM_I_INUM (SCM_SLOT (SCM_CLASS_OF (obj),
scm_si_nfields))
- 1);
return SCM_SLOT (obj, i);
}
#undef FUNC_NAME
@ -1230,7 +1238,10 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0,
unsigned long int i;
SCM_VALIDATE_INSTANCE (1, obj);
i = scm_to_unsigned_integer (index, 0, SCM_NUMBER_OF_SLOTS(obj)-1);
i = scm_to_unsigned_integer (index, 0,
SCM_I_INUM (SCM_SLOT (SCM_CLASS_OF (obj),
scm_si_nfields))
- 1);
SCM_SET_SLOT (obj, i, value);
@ -1873,6 +1884,11 @@ typedef struct t_extension {
SCM extension;
} t_extension;
/* Hint for `scm_gc_malloc ()' et al. when allocating `t_extension'
objects. */
static const char extension_gc_hint[] = "GOOPS extension";
static t_extension *extensions = 0;
SCM_VARIABLE (scm_var_make_extended_generic, "make-extended-generic");
@ -1893,7 +1909,8 @@ scm_c_extend_primitive_generic (SCM extended, SCM extension)
}
else
{
t_extension *e = scm_malloc (sizeof (t_extension));
t_extension *e = scm_gc_malloc (sizeof (t_extension),
extension_gc_hint);
t_extension **loc = &extensions;
/* Make sure that extensions are placed before their own
* extensions in the extensions list. O(N^2) algorithm, but
@ -1916,7 +1933,6 @@ setup_extended_primitive_generics ()
t_extension *e = extensions;
scm_c_extend_primitive_generic (e->extended, e->extension);
extensions = e->next;
free (e);
}
}
@ -2686,8 +2702,7 @@ create_smob_classes (void)
{
long i;
scm_smob_class = (SCM *) scm_malloc (255 * sizeof (SCM));
for (i = 0; i < 255; ++i)
for (i = 0; i < SCM_I_MAX_SMOB_TYPE_COUNT; ++i)
scm_smob_class[i] = 0;
scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_keyword)] = scm_class_keyword;
@ -2731,10 +2746,6 @@ create_port_classes (void)
{
long i;
scm_port_class = (SCM *) scm_malloc (3 * 256 * sizeof (SCM));
for (i = 0; i < 3 * 256; ++i)
scm_port_class[i] = 0;
for (i = 0; i < scm_numptob; ++i)
scm_make_port_classes (i, SCM_PTOBNAME (i));
}

8
libguile/goops.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_GOOPS_H
#define SCM_GOOPS_H
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009 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
@ -98,8 +98,6 @@ typedef struct scm_t_method {
/* Also defined in libguile/objects.c */
#define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x)
#define SCM_ACCESSORS_OF(x) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x)[scm_si_getters_n_setters]))
#define SCM_NUMBER_OF_SLOTS(x) \
((SCM_STRUCT_DATA (x)[scm_struct_i_n_words]) - scm_struct_n_extra_words)
#define SCM_CLASSP(x) \
(SCM_STRUCTP (x) && SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_METACLASS)
@ -170,8 +168,8 @@ SCM_API SCM scm_class_complex;
SCM_API SCM scm_class_integer;
SCM_API SCM scm_class_fraction;
SCM_API SCM scm_class_unknown;
SCM_API SCM *scm_port_class;
SCM_API SCM *scm_smob_class;
SCM_API SCM scm_port_class[];
SCM_API SCM scm_smob_class[];
SCM_API SCM scm_class_top;
SCM_API SCM scm_class_object;
SCM_API SCM scm_class_class;

11
libguile/hooks.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2006, 2008, 2009 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
@ -42,6 +42,9 @@
* using C level hooks.
*/
/* Hint for `scm_gc_malloc ()' and friends. */
static const char hook_entry_gc_hint[] = "hook entry";
void
scm_c_hook_init (scm_t_c_hook *hook, void *hook_data, scm_t_c_hook_type type)
{
@ -56,8 +59,10 @@ scm_c_hook_add (scm_t_c_hook *hook,
void *fn_data,
int appendp)
{
scm_t_c_hook_entry *entry = scm_malloc (sizeof (scm_t_c_hook_entry));
scm_t_c_hook_entry *entry;
scm_t_c_hook_entry **loc = &hook->first;
entry = scm_gc_malloc (sizeof (scm_t_c_hook_entry), hook_entry_gc_hint);
if (appendp)
while (*loc)
loc = &(*loc)->next;
@ -77,9 +82,7 @@ scm_c_hook_remove (scm_t_c_hook *hook,
{
if ((*loc)->func == func && (*loc)->data == fn_data)
{
scm_t_c_hook_entry *entry = *loc;
*loc = (*loc)->next;
free (entry);
return;
}
loc = &(*loc)->next;

8
libguile/objects.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_OBJECTS_H
#define SCM_OBJECTS_H
/* Copyright (C) 1996,1999,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1996,1999,2000,2001, 2003, 2006, 2008, 2009 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
@ -171,9 +171,9 @@ typedef struct scm_effective_slot_definition {
#define SCM_CMETHOD_ENV(cmethod) SCM_CAR (cmethod)
/* Port classes */
#define SCM_IN_PCLASS_INDEX 0x000
#define SCM_OUT_PCLASS_INDEX 0x100
#define SCM_INOUT_PCLASS_INDEX 0x200
#define SCM_IN_PCLASS_INDEX 0
#define SCM_OUT_PCLASS_INDEX SCM_I_MAX_PORT_TYPE_COUNT
#define SCM_INOUT_PCLASS_INDEX (2 * SCM_I_MAX_PORT_TYPE_COUNT)
/* Plugin proxy classes for basic types. */
SCM_API SCM scm_metaclass_standard;

6
libguile/ports.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009 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
@ -134,7 +134,7 @@ scm_make_port_type (char *name,
void (*write) (SCM port, const void *data, size_t size))
{
char *tmp;
if (255 <= scm_numptob)
if (SCM_I_MAX_PORT_TYPE_COUNT - 1 <= scm_numptob)
goto ptoberr;
SCM_CRITICAL_SECTION_START;
tmp = (char *) scm_gc_realloc ((char *) scm_ptobs,
@ -172,7 +172,7 @@ scm_make_port_type (char *name,
scm_memory_error ("scm_make_port_type");
}
/* Make a class object if Goops is present */
if (scm_port_class)
if (SCM_UNPACK (scm_port_class[0]) != 0)
scm_make_port_classes (scm_numptob - 1, SCM_PTOBNAME (scm_numptob - 1));
return scm_tc7_port + (scm_numptob - 1) * 256;
}

5
libguile/ports.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PORTS_H
#define SCM_PORTS_H
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008, 2009 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
@ -162,6 +162,9 @@ SCM_INTERNAL SCM scm_i_port_weak_hash;
#define SCM_DECCOL(port) {if (SCM_COL (port) > 0) SCM_COL (port) -= 1;}
#define SCM_TABCOL(port) {SCM_COL (port) += 8 - SCM_COL (port) % 8;}
/* Maximum number of port types. */
#define SCM_I_MAX_PORT_TYPE_COUNT 256
/* port-type description. */

31
libguile/posix.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 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
@ -943,12 +943,6 @@ SCM_DEFINE (scm_tcsetpgrp, "tcsetpgrp", 2, 0, 0,
#undef FUNC_NAME
#endif /* HAVE_TCSETPGRP */
static void
free_string_pointers (void *data)
{
scm_i_free_string_pointers ((char **)data);
}
SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
(SCM filename, SCM args),
"Executes the file named by @var{path} as a new process image.\n"
@ -971,8 +965,6 @@ SCM_DEFINE (scm_execl, "execl", 1, 0, 1,
scm_dynwind_free (exec_file);
exec_argv = scm_i_allocate_string_pointers (args);
scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
SCM_F_WIND_EXPLICITLY);
execv (exec_file,
#ifdef __MINGW32__
@ -1007,8 +999,6 @@ SCM_DEFINE (scm_execlp, "execlp", 1, 0, 1,
scm_dynwind_free (exec_file);
exec_argv = scm_i_allocate_string_pointers (args);
scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
SCM_F_WIND_EXPLICITLY);
execvp (exec_file,
#ifdef __MINGW32__
@ -1047,12 +1037,7 @@ SCM_DEFINE (scm_execle, "execle", 2, 0, 1,
scm_dynwind_free (exec_file);
exec_argv = scm_i_allocate_string_pointers (args);
scm_dynwind_unwind_handler (free_string_pointers, exec_argv,
SCM_F_WIND_EXPLICITLY);
exec_env = scm_i_allocate_string_pointers (env);
scm_dynwind_unwind_handler (free_string_pointers, exec_env,
SCM_F_WIND_EXPLICITLY);
execve (exec_file,
#ifdef __MINGW32__
@ -1136,19 +1121,7 @@ SCM_DEFINE (scm_environ, "environ", 0, 1, 0,
return scm_makfromstrs (-1, environ);
else
{
char **new_environ;
new_environ = scm_i_allocate_string_pointers (env);
/* Free the old environment, except when called for the first
* time.
*/
{
static int first = 1;
if (!first)
scm_i_free_string_pointers (environ);
first = 0;
}
environ = new_environ;
environ = scm_i_allocate_string_pointers (env);
return SCM_UNSPECIFIED;
}
}

22
libguile/procs.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2006, 2008, 2009 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
@ -44,27 +44,32 @@ scm_t_subr_entry *scm_subr_table;
/* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on
startup, 786 with guile-readline. 'martin */
long scm_subr_table_size = 0;
long scm_subr_table_room = 800;
static unsigned long scm_subr_table_size = 0;
static unsigned long scm_subr_table_room = 800;
/* Hint for `scm_gc_malloc ()' and friends. */
static const char subr_table_gc_hint[] = "subr table";
SCM
scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
{
register SCM z;
long entry;
unsigned long entry;
if (scm_subr_table_size == scm_subr_table_room)
{
long new_size = scm_subr_table_room * 3 / 2;
void *new_table
= scm_realloc ((char *) scm_subr_table,
sizeof (scm_t_subr_entry) * new_size);
= scm_gc_realloc (scm_subr_table,
sizeof (* scm_subr_table) * scm_subr_table_room,
sizeof (* scm_subr_table) * new_size,
subr_table_gc_hint);
scm_subr_table = new_table;
scm_subr_table_room = new_size;
}
entry = scm_subr_table_size;
z = scm_immutable_cell ((entry << 8) + type, (scm_t_bits) fcn);
z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn);
scm_subr_table[entry].handle = z;
scm_subr_table[entry].name = scm_from_locale_symbol (name);
scm_subr_table[entry].generic = 0;
@ -328,7 +333,8 @@ scm_init_subr_table ()
{
scm_subr_table
= ((scm_t_subr_entry *)
scm_malloc (sizeof (scm_t_subr_entry) * scm_subr_table_room));
scm_gc_malloc (sizeof (* scm_subr_table) * scm_subr_table_room,
subr_table_gc_hint));
}
void

4
libguile/procs.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_PROCS_H
#define SCM_PROCS_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008, 2009 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
@ -125,8 +125,6 @@ typedef struct
#define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
SCM_API scm_t_subr_entry *scm_subr_table;
SCM_API long scm_subr_table_size;
SCM_API long scm_subr_table_room;

13
libguile/simpos.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004 Free Software
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2009 Free Software
* Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
@ -88,11 +88,6 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
#ifdef HAVE_SYSTEM
#ifdef HAVE_WAITPID
static void
free_string_pointers (void *data)
{
scm_i_free_string_pointers ((char **)data);
}
SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
(SCM args),
@ -127,12 +122,8 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
int pid;
char **execargv;
scm_dynwind_begin (0);
/* allocate before fork */
execargv = scm_i_allocate_string_pointers (args);
scm_dynwind_unwind_handler (free_string_pointers, execargv,
SCM_F_WIND_EXPLICITLY);
/* make sure the child can't kill us (as per normal system call) */
sig_ign = scm_from_long ((unsigned long) SIG_IGN);
@ -148,7 +139,6 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
execvp (execargv[0], execargv);
SCM_SYSERROR;
/* not reached. */
scm_dynwind_end ();
return SCM_BOOL_F;
}
else
@ -165,7 +155,6 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint));
scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit));
scm_dynwind_end ();
return scm_from_int (status);
}
}

11
libguile/smob.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009 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
@ -49,7 +49,8 @@
* tags for smobjects (if you know a tag you can get an index and conversely).
*/
#define MAX_SMOB_COUNT 256
#define MAX_SMOB_COUNT SCM_I_MAX_SMOB_TYPE_COUNT
long scm_numsmob;
scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT];
@ -312,7 +313,7 @@ scm_make_smob_type (char const *name, size_t size)
}
/* Make a class object if Goops is present. */
if (scm_smob_class)
if (SCM_UNPACK (scm_smob_class[0]) != 0)
scm_smob_class[new_smob] = scm_make_extended_class (name, 0);
return scm_tc7_smob + new_smob * 256;
@ -452,8 +453,8 @@ scm_set_smob_apply (scm_t_bits tc, SCM (*apply) (),
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_2 = apply_2;
scm_smobs[SCM_TC2SMOBNUM (tc)].apply_3 = apply_3;
scm_smobs[SCM_TC2SMOBNUM (tc)].gsubr_type = type;
if (scm_smob_class)
if (SCM_UNPACK (scm_smob_class[0]) != 0)
scm_i_inherit_applicable (scm_smob_class[SCM_TC2SMOBNUM (tc)]);
}

5
libguile/smob.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SMOB_H
#define SCM_SMOB_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2009 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
@ -152,6 +152,9 @@ while (0)
#define SCM_SMOB_APPLY_2(x, a1, a2) (SCM_SMOB_DESCRIPTOR (x).apply_2 (x, (a1), (a2)))
#define SCM_SMOB_APPLY_3(x, a1, a2, rst) (SCM_SMOB_DESCRIPTOR (x).apply_3 (x, (a1), (a2), (rst)))
/* Maximum number of SMOB types. */
#define SCM_I_MAX_SMOB_TYPE_COUNT 256
SCM_API long scm_numsmob;
SCM_API scm_smob_descriptor scm_smobs[];

31
libguile/strings.c
View file

@ -30,7 +30,6 @@
#include "libguile/strings.h"
#include "libguile/deprecation.h"
#include "libguile/validate.h"
#include "libguile/dynwind.h"
@ -949,6 +948,7 @@ scm_makfromstrs (int argc, char **argv)
char **
scm_i_allocate_string_pointers (SCM list)
#define FUNC_NAME "scm_i_allocate_string_pointers"
{
char **result;
int len = scm_ilength (list);
@ -957,34 +957,31 @@ scm_i_allocate_string_pointers (SCM list)
if (len < 0)
scm_wrong_type_arg_msg (NULL, 0, list, "proper list");
scm_dynwind_begin (0);
result = (char **) scm_malloc ((len + 1) * sizeof (char *));
result = scm_gc_malloc ((len + 1) * sizeof (char *),
"string pointers");
result[len] = NULL;
scm_dynwind_unwind_handler (free, result, 0);
/* The list might be have been modified in another thread, so
we check LIST before each access.
*/
for (i = 0; i < len && scm_is_pair (list); i++)
{
result[i] = scm_to_locale_string (SCM_CAR (list));
SCM str;
size_t len;
str = SCM_CAR (list);
len = scm_c_string_length (str);
result[i] = scm_gc_malloc_pointerless (len + 1, "string pointers");
memcpy (result[i], scm_i_string_chars (str), len);
result[i][len] = '\0';
list = SCM_CDR (list);
}
scm_dynwind_end ();
return result;
}
void
scm_i_free_string_pointers (char **pointers)
{
int i;
for (i = 0; pointers[i]; i++)
free (pointers[i]);
free (pointers);
}
#undef FUNC_NAME
void
scm_i_get_substring_spec (size_t len,

1
libguile/strings.h
View file

@ -149,7 +149,6 @@ SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end);
/* internal utility functions. */
SCM_INTERNAL char **scm_i_allocate_string_pointers (SCM list);
SCM_INTERNAL void scm_i_free_string_pointers (char **pointers);
SCM_INTERNAL void scm_i_get_substring_spec (size_t len,
SCM start, size_t *cstart,
SCM end, size_t *cend);

21
m4/codeset.m4 Normal file
View file

@ -0,0 +1,21 @@
# codeset.m4 serial 3 (gettext-0.18)
dnl Copyright (C) 2000-2002, 2006, 2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
dnl From Bruno Haible.
AC_DEFUN([AM_LANGINFO_CODESET],
[
AC_CACHE_CHECK([for nl_langinfo and CODESET], [am_cv_langinfo_codeset],
[AC_TRY_LINK([#include <langinfo.h>],
[char* cs = nl_langinfo(CODESET); return !cs;],
[am_cv_langinfo_codeset=yes],
[am_cv_langinfo_codeset=no])
])
if test $am_cv_langinfo_codeset = yes; then
AC_DEFINE([HAVE_LANGINFO_CODESET], 1,
[Define if you have <langinfo.h> and nl_langinfo(CODESET).])
fi
])

14
m4/extensions.m4
View file

@ -1,4 +1,4 @@
# serial 5 -*- Autoconf -*-
# serial 6 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
# Copyright (C) 2003, 2006-2008 Free Software Foundation, Inc.
@ -24,6 +24,8 @@ AC_DEFUN([AC_USE_SYSTEM_EXTENSIONS],
[AC_BEFORE([$0], [AC_COMPILE_IFELSE])dnl
AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
AC_REQUIRE([AC_CANONICAL_HOST])
AC_CHECK_HEADER([minix/config.h], [MINIX=yes], [MINIX=])
if test "$MINIX" = yes; then
AC_DEFINE([_POSIX_SOURCE], [1],
@ -36,6 +38,16 @@ AC_BEFORE([$0], [AC_RUN_IFELSE])dnl
[Define to 1 if on MINIX.])
fi
dnl HP-UX 11.11 defines mbstate_t only if _XOPEN_SOURCE is defined to 500,
dnl regardless of whether the flags -Ae or _D_HPUX_SOURCE=1 are already
dnl provided.
case "$host_os" in
hpux*)
AC_DEFINE([_XOPEN_SOURCE], [500],
[Define to 500 only on HP-UX.])
;;
esac
AH_VERBATIM([__EXTENSIONS__],
[/* Enable extensions on AIX 3, Interix. */
#ifndef _ALL_SOURCE

30
m4/glibc21.m4 Normal file
View file

@ -0,0 +1,30 @@
# glibc21.m4 serial 4
dnl Copyright (C) 2000-2002, 2004, 2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
# Test for the GNU C Library, version 2.1 or newer.
# From Bruno Haible.
AC_DEFUN([gl_GLIBC21],
[
AC_CACHE_CHECK([whether we are using the GNU C Library 2.1 or newer],
[ac_cv_gnu_library_2_1],
[AC_EGREP_CPP([Lucky GNU user],
[
#include <features.h>
#ifdef __GNU_LIBRARY__
#if (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 1) || (__GLIBC__ > 2)
Lucky GNU user
#endif
#endif
],
[ac_cv_gnu_library_2_1=yes],
[ac_cv_gnu_library_2_1=no])
]
)
AC_SUBST([GLIBC21])
GLIBC21="$ac_cv_gnu_library_2_1"
]
)

7
m4/gnulib-cache.m4
View file

@ -1,4 +1,4 @@
# Copyright (C) 2002-2008 Free Software Foundation, Inc.
# Copyright (C) 2002-2009 Free Software Foundation, Inc.
#
# This file is free software, distributed under the terms of the GNU
# General Public License. As a special exception to the GNU General
@ -15,12 +15,12 @@
# Specification in the form of a command-line invocation:
# gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl alloca autobuild extensions full-read full-write strcase strftime
# gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl --no-vc-files alloca-opt autobuild extensions full-read full-write strcase strftime
# Specification in the form of a few gnulib-tool.m4 macro invocations:
gl_LOCAL_DIR([])
gl_MODULES([
alloca
alloca-opt
autobuild
extensions
full-read
@ -40,3 +40,4 @@ gl_MAKEFILE_NAME([])
gl_LIBTOOL
gl_MACRO_PREFIX([gl])
gl_PO_DOMAIN([])
gl_VC_FILES([false])

34
m4/gnulib-comp.m4
View file

@ -1,5 +1,5 @@
# DO NOT EDIT! GENERATED AUTOMATICALLY!
# Copyright (C) 2002-2008 Free Software Foundation, Inc.
# Copyright (C) 2002-2009 Free Software Foundation, Inc.
#
# This file is free software, distributed under the terms of the GNU
# General Public License. As a special exception to the GNU General
@ -42,11 +42,16 @@ AC_DEFUN([gl_INIT],
m4_pushdef([gl_LIBSOURCES_DIR], [])
gl_COMMON
gl_source_base='lib'
changequote(,)dnl
LTALLOCA=`echo "$ALLOCA" | sed 's/\.[^.]* /.lo /g;s/\.[^.]*$/.lo/'`
changequote([, ])dnl
AC_SUBST([LTALLOCA])
gl_FUNC_ALLOCA
gl_LOCALCHARSET
LOCALCHARSET_TESTS_ENVIRONMENT="CHARSETALIASDIR=\"\$(top_builddir)/$gl_source_base\""
AC_SUBST([LOCALCHARSET_TESTS_ENVIRONMENT])
gl_FUNC_MBRLEN
gl_WCHAR_MODULE_INDICATOR([mbrlen])
gl_FUNC_MBRTOWC
gl_WCHAR_MODULE_INDICATOR([mbrtowc])
gl_FUNC_MBSINIT
gl_WCHAR_MODULE_INDICATOR([mbsinit])
gl_SAFE_READ
gl_SAFE_WRITE
gt_TYPE_SSIZE_T
@ -189,18 +194,26 @@ AC_DEFUN([gltests_LIBSOURCES], [
# gnulib-tool and may be removed by future gnulib-tool invocations.
AC_DEFUN([gl_FILE_LIST], [
build-aux/link-warning.h
lib/alloca.c
lib/alloca.in.h
lib/config.charset
lib/full-read.c
lib/full-read.h
lib/full-write.c
lib/full-write.h
lib/localcharset.c
lib/localcharset.h
lib/mbrlen.c
lib/mbrtowc.c
lib/mbsinit.c
lib/ref-add.sin
lib/ref-del.sin
lib/safe-read.c
lib/safe-read.h
lib/safe-write.c
lib/safe-write.h
lib/stdbool.in.h
lib/strcasecmp.c
lib/streq.h
lib/strftime.c
lib/strftime.h
lib/strings.in.h
@ -213,9 +226,18 @@ AC_DEFUN([gl_FILE_LIST], [
lib/write.c
m4/alloca.m4
m4/autobuild.m4
m4/codeset.m4
m4/extensions.m4
m4/glibc21.m4
m4/gnulib-common.m4
m4/include_next.m4
m4/localcharset.m4
m4/locale-fr.m4
m4/locale-ja.m4
m4/locale-zh.m4
m4/mbrlen.m4
m4/mbrtowc.m4
m4/mbsinit.m4
m4/mbstate_t.m4
m4/safe-read.m4
m4/safe-write.m4

16
m4/localcharset.m4 Normal file
View file

@ -0,0 +1,16 @@
# localcharset.m4 serial 5
dnl Copyright (C) 2002, 2004, 2006 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_LOCALCHARSET],
[
dnl Prerequisites of lib/localcharset.c.
AC_REQUIRE([AM_LANGINFO_CODESET])
AC_CHECK_DECLS_ONCE(getc_unlocked)
dnl Prerequisites of the lib/Makefile.am snippet.
AC_REQUIRE([AC_CANONICAL_HOST])
AC_REQUIRE([gl_GLIBC21])
])

204
m4/locale-fr.m4 Normal file
View file

@ -0,0 +1,204 @@
# locale-fr.m4 serial 9
dnl Copyright (C) 2003, 2005-2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
dnl From Bruno Haible.
dnl Determine the name of a french locale with traditional encoding.
AC_DEFUN([gt_LOCALE_FR],
[
AC_REQUIRE([AC_CANONICAL_HOST])
AC_REQUIRE([AM_LANGINFO_CODESET])
AC_CACHE_CHECK([for a traditional french locale], gt_cv_locale_fr, [
macosx=
changequote(,)dnl
case "$host_os" in
darwin[56]*) ;;
darwin*) macosx=yes;;
esac
changequote([,])dnl
if test -n "$macosx"; then
# On Darwin 7 (MacOS X), the libc supports some locales in non-UTF-8
# encodings, but the kernel does not support them. The documentation
# says:
# "... all code that calls BSD system routines should ensure
# that the const *char parameters of these routines are in UTF-8
# encoding. All BSD system functions expect their string
# parameters to be in UTF-8 encoding and nothing else."
# See the comments in config.charset. Therefore we bypass the test.
gt_cv_locale_fr=none
else
AC_LANG_CONFTEST([AC_LANG_SOURCE([
changequote(,)dnl
#include <locale.h>
#include <time.h>
#if HAVE_LANGINFO_CODESET
# include <langinfo.h>
#endif
#include <stdlib.h>
#include <string.h>
struct tm t;
char buf[16];
int main () {
/* Check whether the given locale name is recognized by the system. */
if (setlocale (LC_ALL, "") == NULL) return 1;
/* Check whether nl_langinfo(CODESET) is nonempty and not "ASCII" or "646".
On MacOS X 10.3.5 (Darwin 7.5) in the fr_FR locale, nl_langinfo(CODESET)
is empty, and the behaviour of Tcl 8.4 in this locale is not useful.
On OpenBSD 4.0, when an unsupported locale is specified, setlocale()
succeeds but then nl_langinfo(CODESET) is "646". In this situation,
some unit tests fail. */
#if HAVE_LANGINFO_CODESET
{
const char *cs = nl_langinfo (CODESET);
if (cs[0] == '\0' || strcmp (cs, "ASCII") == 0 || strcmp (cs, "646") == 0)
return 1;
}
#endif
#ifdef __CYGWIN__
/* On Cygwin, avoid locale names without encoding suffix, because the
locale_charset() function relies on the encoding suffix. Note that
LC_ALL is set on the command line. */
if (strchr (getenv ("LC_ALL"), '.') == NULL) return 1;
#endif
/* Check whether in the abbreviation of the second month, the second
character (should be U+00E9: LATIN SMALL LETTER E WITH ACUTE) is only
one byte long. This excludes the UTF-8 encoding. */
t.tm_year = 1975 - 1900; t.tm_mon = 2 - 1; t.tm_mday = 4;
if (strftime (buf, sizeof (buf), "%b", &t) < 3 || buf[2] != 'v') return 1;
/* Check whether the decimal separator is a comma.
On NetBSD 3.0 in the fr_FR.ISO8859-1 locale, localeconv()->decimal_point
are nl_langinfo(RADIXCHAR) are both ".". */
if (localeconv () ->decimal_point[0] != ',') return 1;
return 0;
}
changequote([,])dnl
])])
if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
# Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
# otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
# configure script would override the LC_ALL setting. Likewise for
# LC_CTYPE, which is also set at the beginning of the configure script.
# Test for the usual locale name.
if (LC_ALL=fr_FR LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_fr=fr_FR
else
# Test for the locale name with explicit encoding suffix.
if (LC_ALL=fr_FR.ISO-8859-1 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_fr=fr_FR.ISO-8859-1
else
# Test for the AIX, OSF/1, FreeBSD, NetBSD, OpenBSD locale name.
if (LC_ALL=fr_FR.ISO8859-1 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_fr=fr_FR.ISO8859-1
else
# Test for the HP-UX locale name.
if (LC_ALL=fr_FR.iso88591 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_fr=fr_FR.iso88591
else
# Test for the Solaris 7 locale name.
if (LC_ALL=fr LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_fr=fr
else
# None found.
gt_cv_locale_fr=none
fi
fi
fi
fi
fi
fi
rm -fr conftest*
fi
])
LOCALE_FR=$gt_cv_locale_fr
AC_SUBST([LOCALE_FR])
])
dnl Determine the name of a french locale with UTF-8 encoding.
AC_DEFUN([gt_LOCALE_FR_UTF8],
[
AC_REQUIRE([AM_LANGINFO_CODESET])
AC_CACHE_CHECK([for a french Unicode locale], gt_cv_locale_fr_utf8, [
AC_LANG_CONFTEST([AC_LANG_SOURCE([
changequote(,)dnl
#include <locale.h>
#include <time.h>
#if HAVE_LANGINFO_CODESET
# include <langinfo.h>
#endif
#include <stdlib.h>
#include <string.h>
struct tm t;
char buf[16];
int main () {
/* On BeOS and Haiku, locales are not implemented in libc. Rather, libintl
imitates locale dependent behaviour by looking at the environment
variables, and all locales use the UTF-8 encoding. */
#if !(defined __BEOS__ || defined __HAIKU__)
/* Check whether the given locale name is recognized by the system. */
if (setlocale (LC_ALL, "") == NULL) return 1;
/* Check whether nl_langinfo(CODESET) is nonempty and not "ASCII" or "646".
On MacOS X 10.3.5 (Darwin 7.5) in the fr_FR locale, nl_langinfo(CODESET)
is empty, and the behaviour of Tcl 8.4 in this locale is not useful.
On OpenBSD 4.0, when an unsupported locale is specified, setlocale()
succeeds but then nl_langinfo(CODESET) is "646". In this situation,
some unit tests fail. */
# if HAVE_LANGINFO_CODESET
{
const char *cs = nl_langinfo (CODESET);
if (cs[0] == '\0' || strcmp (cs, "ASCII") == 0 || strcmp (cs, "646") == 0)
return 1;
}
# endif
# ifdef __CYGWIN__
/* On Cygwin, avoid locale names without encoding suffix, because the
locale_charset() function relies on the encoding suffix. Note that
LC_ALL is set on the command line. */
if (strchr (getenv ("LC_ALL"), '.') == NULL) return 1;
# endif
/* Check whether in the abbreviation of the second month, the second
character (should be U+00E9: LATIN SMALL LETTER E WITH ACUTE) is
two bytes long, with UTF-8 encoding. */
t.tm_year = 1975 - 1900; t.tm_mon = 2 - 1; t.tm_mday = 4;
if (strftime (buf, sizeof (buf), "%b", &t) < 4
|| buf[1] != (char) 0xc3 || buf[2] != (char) 0xa9 || buf[3] != 'v')
return 1;
#endif
/* Check whether the decimal separator is a comma.
On NetBSD 3.0 in the fr_FR.ISO8859-1 locale, localeconv()->decimal_point
are nl_langinfo(RADIXCHAR) are both ".". */
if (localeconv () ->decimal_point[0] != ',') return 1;
return 0;
}
changequote([,])dnl
])])
if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
# Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
# otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
# configure script would override the LC_ALL setting. Likewise for
# LC_CTYPE, which is also set at the beginning of the configure script.
# Test for the usual locale name.
if (LC_ALL=fr_FR LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_fr_utf8=fr_FR
else
# Test for the locale name with explicit encoding suffix.
if (LC_ALL=fr_FR.UTF-8 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_fr_utf8=fr_FR.UTF-8
else
# Test for the Solaris 7 locale name.
if (LC_ALL=fr.UTF-8 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_fr_utf8=fr.UTF-8
else
# None found.
gt_cv_locale_fr_utf8=none
fi
fi
fi
fi
rm -fr conftest*
])
LOCALE_FR_UTF8=$gt_cv_locale_fr_utf8
AC_SUBST([LOCALE_FR_UTF8])
])

126
m4/locale-ja.m4 Normal file
View file

@ -0,0 +1,126 @@
# locale-ja.m4 serial 5
dnl Copyright (C) 2003, 2005-2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
dnl From Bruno Haible.
dnl Determine the name of a japanese locale with EUC-JP encoding.
AC_DEFUN([gt_LOCALE_JA],
[
AC_REQUIRE([AC_CANONICAL_HOST])
AC_REQUIRE([AM_LANGINFO_CODESET])
AC_CACHE_CHECK([for a traditional japanese locale], gt_cv_locale_ja, [
macosx=
changequote(,)dnl
case "$host_os" in
darwin[56]*) ;;
darwin*) macosx=yes;;
esac
changequote([,])dnl
if test -n "$macosx"; then
# On Darwin 7 (MacOS X), the libc supports some locales in non-UTF-8
# encodings, but the kernel does not support them. The documentation
# says:
# "... all code that calls BSD system routines should ensure
# that the const *char parameters of these routines are in UTF-8
# encoding. All BSD system functions expect their string
# parameters to be in UTF-8 encoding and nothing else."
# See the comments in config.charset. Therefore we bypass the test.
gt_cv_locale_ja=none
else
AC_LANG_CONFTEST([AC_LANG_SOURCE([
changequote(,)dnl
#include <locale.h>
#include <time.h>
#if HAVE_LANGINFO_CODESET
# include <langinfo.h>
#endif
#include <stdlib.h>
#include <string.h>
struct tm t;
char buf[16];
int main ()
{
const char *p;
/* Check whether the given locale name is recognized by the system. */
if (setlocale (LC_ALL, "") == NULL) return 1;
/* Check whether nl_langinfo(CODESET) is nonempty and not "ASCII" or "646".
On MacOS X 10.3.5 (Darwin 7.5) in the fr_FR locale, nl_langinfo(CODESET)
is empty, and the behaviour of Tcl 8.4 in this locale is not useful.
On OpenBSD 4.0, when an unsupported locale is specified, setlocale()
succeeds but then nl_langinfo(CODESET) is "646". In this situation,
some unit tests fail. */
#if HAVE_LANGINFO_CODESET
{
const char *cs = nl_langinfo (CODESET);
if (cs[0] == '\0' || strcmp (cs, "ASCII") == 0 || strcmp (cs, "646") == 0)
return 1;
}
#endif
#ifdef __CYGWIN__
/* On Cygwin, avoid locale names without encoding suffix, because the
locale_charset() function relies on the encoding suffix. Note that
LC_ALL is set on the command line. */
if (strchr (getenv ("LC_ALL"), '.') == NULL) return 1;
#endif
/* Check whether MB_CUR_MAX is > 1. This excludes the dysfunctional locales
on Cygwin 1.5.x. */
if (MB_CUR_MAX == 1)
return 1;
/* Check whether in a month name, no byte in the range 0x80..0x9F occurs.
This excludes the UTF-8 encoding. */
t.tm_year = 1975 - 1900; t.tm_mon = 2 - 1; t.tm_mday = 4;
if (strftime (buf, sizeof (buf), "%B", &t) < 2) return 1;
for (p = buf; *p != '\0'; p++)
if ((unsigned char) *p >= 0x80 && (unsigned char) *p < 0xa0)
return 1;
return 0;
}
changequote([,])dnl
])])
if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
# Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
# otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
# configure script would override the LC_ALL setting. Likewise for
# LC_CTYPE, which is also set at the beginning of the configure script.
# Test for the AIX locale name.
if (LC_ALL=ja_JP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_ja=ja_JP
else
# Test for the locale name with explicit encoding suffix.
if (LC_ALL=ja_JP.EUC-JP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_ja=ja_JP.EUC-JP
else
# Test for the HP-UX, OSF/1, NetBSD locale name.
if (LC_ALL=ja_JP.eucJP LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_ja=ja_JP.eucJP
else
# Test for the IRIX, FreeBSD locale name.
if (LC_ALL=ja_JP.EUC LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_ja=ja_JP.EUC
else
# Test for the Solaris 7 locale name.
if (LC_ALL=ja LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_ja=ja
else
# Special test for NetBSD 1.6.
if test -f /usr/share/locale/ja_JP.eucJP/LC_CTYPE; then
gt_cv_locale_ja=ja_JP.eucJP
else
# None found.
gt_cv_locale_ja=none
fi
fi
fi
fi
fi
fi
fi
rm -fr conftest*
fi
])
LOCALE_JA=$gt_cv_locale_ja
AC_SUBST([LOCALE_JA])
])

111
m4/locale-zh.m4 Normal file
View file

@ -0,0 +1,111 @@
# locale-zh.m4 serial 4
dnl Copyright (C) 2003, 2005-2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
dnl From Bruno Haible.
dnl Determine the name of a chinese locale with GB18030 encoding.
AC_DEFUN([gt_LOCALE_ZH_CN],
[
AC_REQUIRE([AC_CANONICAL_HOST])
AC_REQUIRE([AM_LANGINFO_CODESET])
AC_CACHE_CHECK([for a transitional chinese locale], gt_cv_locale_zh_CN, [
macosx=
changequote(,)dnl
case "$host_os" in
darwin[56]*) ;;
darwin*) macosx=yes;;
esac
changequote([,])dnl
if test -n "$macosx"; then
# On Darwin 7 (MacOS X), the libc supports some locales in non-UTF-8
# encodings, but the kernel does not support them. The documentation
# says:
# "... all code that calls BSD system routines should ensure
# that the const *char parameters of these routines are in UTF-8
# encoding. All BSD system functions expect their string
# parameters to be in UTF-8 encoding and nothing else."
# See the comments in config.charset. Therefore we bypass the test.
gt_cv_locale_zh_CN=none
else
AC_LANG_CONFTEST([AC_LANG_SOURCE([
changequote(,)dnl
#include <locale.h>
#include <stdlib.h>
#include <time.h>
#if HAVE_LANGINFO_CODESET
# include <langinfo.h>
#endif
#include <stdlib.h>
#include <string.h>
struct tm t;
char buf[16];
int main ()
{
const char *p;
/* Check whether the given locale name is recognized by the system. */
if (setlocale (LC_ALL, "") == NULL) return 1;
/* Check whether nl_langinfo(CODESET) is nonempty and not "ASCII" or "646".
On MacOS X 10.3.5 (Darwin 7.5) in the fr_FR locale, nl_langinfo(CODESET)
is empty, and the behaviour of Tcl 8.4 in this locale is not useful.
On OpenBSD 4.0, when an unsupported locale is specified, setlocale()
succeeds but then nl_langinfo(CODESET) is "646". In this situation,
some unit tests fail. */
#if HAVE_LANGINFO_CODESET
{
const char *cs = nl_langinfo (CODESET);
if (cs[0] == '\0' || strcmp (cs, "ASCII") == 0 || strcmp (cs, "646") == 0)
return 1;
}
#endif
#ifdef __CYGWIN__
/* On Cygwin, avoid locale names without encoding suffix, because the
locale_charset() function relies on the encoding suffix. Note that
LC_ALL is set on the command line. */
if (strchr (getenv ("LC_ALL"), '.') == NULL) return 1;
#endif
/* Check whether in a month name, no byte in the range 0x80..0x9F occurs.
This excludes the UTF-8 encoding. */
t.tm_year = 1975 - 1900; t.tm_mon = 2 - 1; t.tm_mday = 4;
if (strftime (buf, sizeof (buf), "%B", &t) < 2) return 1;
for (p = buf; *p != '\0'; p++)
if ((unsigned char) *p >= 0x80 && (unsigned char) *p < 0xa0)
return 1;
/* Check whether a typical GB18030 multibyte sequence is recognized as a
single wide character. This excludes the GB2312 and GBK encodings. */
if (mblen ("\203\062\332\066", 5) != 4)
return 1;
return 0;
}
changequote([,])dnl
])])
if AC_TRY_EVAL([ac_link]) && test -s conftest$ac_exeext; then
# Setting LC_ALL is not enough. Need to set LC_TIME to empty, because
# otherwise on MacOS X 10.3.5 the LC_TIME=C from the beginning of the
# configure script would override the LC_ALL setting. Likewise for
# LC_CTYPE, which is also set at the beginning of the configure script.
# Test for the locale name without encoding suffix.
if (LC_ALL=zh_CN LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_zh_CN=zh_CN
else
# Test for the locale name with explicit encoding suffix.
if (LC_ALL=zh_CN.GB18030 LC_TIME= LC_CTYPE= ./conftest; exit) 2>/dev/null; then
gt_cv_locale_zh_CN=zh_CN.GB18030
else
# None found.
gt_cv_locale_zh_CN=none
fi
fi
else
# If there was a link error, due to mblen(), the system is so old that
# it certainly doesn't have a chinese locale.
gt_cv_locale_zh_CN=none
fi
rm -fr conftest*
fi
])
LOCALE_ZH_CN=$gt_cv_locale_zh_CN
AC_SUBST([LOCALE_ZH_CN])
])

197
m4/mbrlen.m4 Normal file
View file

@ -0,0 +1,197 @@
# mbrlen.m4 serial 2
dnl Copyright (C) 2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_MBRLEN],
[
AC_REQUIRE([gl_WCHAR_H_DEFAULTS])
AC_REQUIRE([AC_TYPE_MBSTATE_T])
AC_REQUIRE([gl_FUNC_MBRTOWC])
AC_CHECK_FUNCS_ONCE([mbrlen])
if test $ac_cv_func_mbrlen = no; then
HAVE_MBRLEN=0
else
dnl Most bugs affecting the system's mbrtowc function also affect the
dnl mbrlen function. So override mbrlen whenever mbrtowc is overridden.
dnl We could also run the individual tests below; the results would be
dnl the same.
if test $REPLACE_MBRTOWC = 1; then
REPLACE_MBRLEN=1
fi
fi
if test $HAVE_MBRLEN = 0 || test $REPLACE_MBRLEN = 1; then
gl_REPLACE_WCHAR_H
AC_LIBOBJ([mbrlen])
gl_PREREQ_MBRLEN
fi
])
dnl Test whether mbrlen puts the state into non-initial state when parsing an
dnl incomplete multibyte character.
dnl Result is gl_cv_func_mbrlen_incomplete_state.
AC_DEFUN([gl_MBRLEN_INCOMPLETE_STATE],
[
AC_REQUIRE([AC_PROG_CC])
AC_REQUIRE([gt_LOCALE_JA])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether mbrlen handles incomplete characters],
[gl_cv_func_mbrlen_incomplete_state],
[
dnl Initial guess, used when cross-compiling or when no suitable locale
dnl is present.
changequote(,)dnl
case "$host_os" in
# Guess no on AIX and OSF/1.
osf*) gl_cv_func_mbrlen_incomplete_state="guessing no" ;;
# Guess yes otherwise.
*) gl_cv_func_mbrlen_incomplete_state="guessing yes" ;;
esac
changequote([,])dnl
if test $LOCALE_JA != none; then
AC_TRY_RUN([
#include <locale.h>
#include <string.h>
#include <wchar.h>
int main ()
{
if (setlocale (LC_ALL, "$LOCALE_JA") != NULL)
{
const char input[] = "B\217\253\344\217\251\316er"; /* "Büßer" */
mbstate_t state;
memset (&state, '\0', sizeof (mbstate_t));
if (mbrlen (input + 1, 1, &state) == (size_t)(-2))
if (mbsinit (&state))
return 1;
}
return 0;
}],
[gl_cv_func_mbrlen_incomplete_state=yes],
[gl_cv_func_mbrlen_incomplete_state=no],
[])
fi
])
])
dnl Test whether mbrlen, when parsing the end of a multibyte character,
dnl correctly returns the number of bytes that were needed to complete the
dnl character (not the total number of bytes of the multibyte character).
dnl Result is gl_cv_func_mbrlen_retval.
AC_DEFUN([gl_MBRLEN_RETVAL],
[
AC_REQUIRE([AC_PROG_CC])
AC_REQUIRE([gt_LOCALE_FR_UTF8])
AC_REQUIRE([gt_LOCALE_JA])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether mbrlen has a correct return value],
[gl_cv_func_mbrlen_retval],
[
dnl Initial guess, used when cross-compiling or when no suitable locale
dnl is present.
changequote(,)dnl
case "$host_os" in
# Guess no on HP-UX and Solaris.
hpux* | solaris*) gl_cv_func_mbrlen_retval="guessing no" ;;
# Guess yes otherwise.
*) gl_cv_func_mbrlen_retval="guessing yes" ;;
esac
changequote([,])dnl
if test $LOCALE_FR_UTF8 != none || test $LOCALE_JA != none; then
AC_TRY_RUN([
#include <locale.h>
#include <string.h>
#include <wchar.h>
int main ()
{
/* This fails on Solaris. */
if (setlocale (LC_ALL, "$LOCALE_FR_UTF8") != NULL)
{
char input[] = "B\303\274\303\237er"; /* "Büßer" */
mbstate_t state;
memset (&state, '\0', sizeof (mbstate_t));
if (mbrlen (input + 1, 1, &state) == (size_t)(-2))
{
input[1] = '\0';
if (mbrlen (input + 2, 5, &state) != 1)
return 1;
}
}
/* This fails on HP-UX 11.11. */
if (setlocale (LC_ALL, "$LOCALE_JA") != NULL)
{
char input[] = "B\217\253\344\217\251\316er"; /* "Büßer" */
mbstate_t state;
memset (&state, '\0', sizeof (mbstate_t));
if (mbrlen (input + 1, 1, &state) == (size_t)(-2))
{
input[1] = '\0';
if (mbrlen (input + 2, 5, &state) != 2)
return 1;
}
}
return 0;
}],
[gl_cv_func_mbrlen_retval=yes],
[gl_cv_func_mbrlen_retval=no],
[])
fi
])
])
dnl Test whether mbrlen, when parsing a NUL character, correctly returns 0.
dnl Result is gl_cv_func_mbrlen_nul_retval.
AC_DEFUN([gl_MBRLEN_NUL_RETVAL],
[
AC_REQUIRE([AC_PROG_CC])
AC_REQUIRE([gt_LOCALE_ZH_CN])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether mbrlen returns 0 when parsing a NUL character],
[gl_cv_func_mbrlen_nul_retval],
[
dnl Initial guess, used when cross-compiling or when no suitable locale
dnl is present.
changequote(,)dnl
case "$host_os" in
# Guess no on Solaris 9.
solaris2.9) gl_cv_func_mbrlen_nul_retval="guessing no" ;;
# Guess yes otherwise.
*) gl_cv_func_mbrlen_nul_retval="guessing yes" ;;
esac
changequote([,])dnl
if test $LOCALE_ZH_CN != none; then
AC_TRY_RUN([
#include <locale.h>
#include <string.h>
#include <wchar.h>
int main ()
{
/* This crashes on Solaris 9 inside __mbrtowc_dense_gb18030. */
if (setlocale (LC_ALL, "$LOCALE_ZH_CN") != NULL)
{
mbstate_t state;
memset (&state, '\0', sizeof (mbstate_t));
if (mbrlen ("", 1, &state) != 0)
return 1;
}
return 0;
}],
[gl_cv_func_mbrlen_nul_retval=yes],
[gl_cv_func_mbrlen_nul_retval=no],
[])
fi
])
])
# Prerequisites of lib/mbrlen.c.
AC_DEFUN([gl_PREREQ_MBRLEN], [
:
])

325
m4/mbrtowc.m4 Normal file
View file

@ -0,0 +1,325 @@
# mbrtowc.m4 serial 12
dnl Copyright (C) 2001-2002, 2004-2005, 2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_MBRTOWC],
[
AC_REQUIRE([gl_WCHAR_H_DEFAULTS])
AC_REQUIRE([AC_TYPE_MBSTATE_T])
gl_MBSTATE_T_BROKEN
if test $REPLACE_MBSTATE_T = 1; then
REPLACE_MBRTOWC=1
fi
AC_CHECK_FUNCS_ONCE([mbrtowc])
if test $ac_cv_func_mbrtowc = no; then
HAVE_MBRTOWC=0
fi
if test $HAVE_MBRTOWC != 0 && test $REPLACE_MBRTOWC != 1; then
gl_MBRTOWC_NULL_ARG
gl_MBRTOWC_RETVAL
gl_MBRTOWC_NUL_RETVAL
case "$gl_cv_func_mbrtowc_null_arg" in
*yes) ;;
*) AC_DEFINE([MBRTOWC_NULL_ARG_BUG], [1],
[Define if the mbrtowc function has the NULL string argument bug.])
REPLACE_MBRTOWC=1
;;
esac
case "$gl_cv_func_mbrtowc_retval" in
*yes) ;;
*) AC_DEFINE([MBRTOWC_RETVAL_BUG], [1],
[Define if the mbrtowc function returns a wrong return value.])
REPLACE_MBRTOWC=1
;;
esac
case "$gl_cv_func_mbrtowc_nul_retval" in
*yes) ;;
*) AC_DEFINE([MBRTOWC_NUL_RETVAL_BUG], [1],
[Define if the mbrtowc function does not return 0 for a NUL character.])
REPLACE_MBRTOWC=1
;;
esac
fi
if test $HAVE_MBRTOWC = 0 || test $REPLACE_MBRTOWC = 1; then
gl_REPLACE_WCHAR_H
AC_LIBOBJ([mbrtowc])
gl_PREREQ_MBRTOWC
fi
])
dnl Test whether mbsinit() and mbrtowc() need to be overridden in a way that
dnl redefines the semantics of the given mbstate_t type.
dnl Result is REPLACE_MBSTATE_T.
dnl When this is set to 1, we replace both mbsinit() and mbrtowc(), in order to
dnl avoid inconsistencies.
AC_DEFUN([gl_MBSTATE_T_BROKEN],
[
AC_REQUIRE([gl_WCHAR_H_DEFAULTS])
AC_REQUIRE([AC_TYPE_MBSTATE_T])
AC_CHECK_FUNCS_ONCE([mbsinit])
AC_CHECK_FUNCS_ONCE([mbrtowc])
if test $ac_cv_func_mbsinit = yes && test $ac_cv_func_mbrtowc = yes; then
gl_MBRTOWC_INCOMPLETE_STATE
case "$gl_cv_func_mbrtowc_incomplete_state" in
*yes) REPLACE_MBSTATE_T=0 ;;
*) REPLACE_MBSTATE_T=1 ;;
esac
else
REPLACE_MBSTATE_T=1
fi
if test $REPLACE_MBSTATE_T = 1; then
gl_REPLACE_WCHAR_H
fi
])
dnl Test whether mbrtowc puts the state into non-initial state when parsing an
dnl incomplete multibyte character.
dnl Result is gl_cv_func_mbrtowc_incomplete_state.
AC_DEFUN([gl_MBRTOWC_INCOMPLETE_STATE],
[
AC_REQUIRE([AC_PROG_CC])
AC_REQUIRE([gt_LOCALE_JA])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether mbrtowc handles incomplete characters],
[gl_cv_func_mbrtowc_incomplete_state],
[
dnl Initial guess, used when cross-compiling or when no suitable locale
dnl is present.
changequote(,)dnl
case "$host_os" in
# Guess no on AIX and OSF/1.
osf*) gl_cv_func_mbrtowc_incomplete_state="guessing no" ;;
# Guess yes otherwise.
*) gl_cv_func_mbrtowc_incomplete_state="guessing yes" ;;
esac
changequote([,])dnl
if test $LOCALE_JA != none; then
AC_TRY_RUN([
#include <locale.h>
#include <string.h>
#include <wchar.h>
int main ()
{
if (setlocale (LC_ALL, "$LOCALE_JA") != NULL)
{
const char input[] = "B\217\253\344\217\251\316er"; /* "Büßer" */
mbstate_t state;
wchar_t wc;
memset (&state, '\0', sizeof (mbstate_t));
if (mbrtowc (&wc, input + 1, 1, &state) == (size_t)(-2))
if (mbsinit (&state))
return 1;
}
return 0;
}],
[gl_cv_func_mbrtowc_incomplete_state=yes],
[gl_cv_func_mbrtowc_incomplete_state=no],
[])
fi
])
])
dnl Test whether mbrtowc supports a NULL string argument correctly.
dnl Result is gl_cv_func_mbrtowc_null_arg.
AC_DEFUN([gl_MBRTOWC_NULL_ARG],
[
AC_REQUIRE([AC_PROG_CC])
AC_REQUIRE([gt_LOCALE_FR_UTF8])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether mbrtowc handles a NULL string argument],
[gl_cv_func_mbrtowc_null_arg],
[
dnl Initial guess, used when cross-compiling or when no suitable locale
dnl is present.
changequote(,)dnl
case "$host_os" in
# Guess no on OSF/1.
osf*) gl_cv_func_mbrtowc_null_arg="guessing no" ;;
# Guess yes otherwise.
*) gl_cv_func_mbrtowc_null_arg="guessing yes" ;;
esac
changequote([,])dnl
if test $LOCALE_FR_UTF8 != none; then
AC_TRY_RUN([
#include <locale.h>
#include <string.h>
#include <wchar.h>
int main ()
{
if (setlocale (LC_ALL, "$LOCALE_FR_UTF8") != NULL)
{
mbstate_t state;
wchar_t wc;
int ret;
memset (&state, '\0', sizeof (mbstate_t));
wc = (wchar_t) 0xBADFACE;
mbrtowc (&wc, NULL, 5, &state);
/* Check that wc was not modified. */
if (wc != (wchar_t) 0xBADFACE)
return 1;
}
return 0;
}], [gl_cv_func_mbrtowc_null_arg=yes], [gl_cv_func_mbrtowc_null_arg=no], [])
fi
])
])
dnl Test whether mbrtowc, when parsing the end of a multibyte character,
dnl correctly returns the number of bytes that were needed to complete the
dnl character (not the total number of bytes of the multibyte character).
dnl Result is gl_cv_func_mbrtowc_retval.
AC_DEFUN([gl_MBRTOWC_RETVAL],
[
AC_REQUIRE([AC_PROG_CC])
AC_REQUIRE([gt_LOCALE_FR_UTF8])
AC_REQUIRE([gt_LOCALE_JA])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether mbrtowc has a correct return value],
[gl_cv_func_mbrtowc_retval],
[
dnl Initial guess, used when cross-compiling or when no suitable locale
dnl is present.
changequote(,)dnl
case "$host_os" in
# Guess no on HP-UX and Solaris.
hpux* | solaris*) gl_cv_func_mbrtowc_retval="guessing no" ;;
# Guess yes otherwise.
*) gl_cv_func_mbrtowc_retval="guessing yes" ;;
esac
changequote([,])dnl
if test $LOCALE_FR_UTF8 != none || test $LOCALE_JA != none; then
AC_TRY_RUN([
#include <locale.h>
#include <string.h>
#include <wchar.h>
int main ()
{
/* This fails on Solaris. */
if (setlocale (LC_ALL, "$LOCALE_FR_UTF8") != NULL)
{
char input[] = "B\303\274\303\237er"; /* "Büßer" */
mbstate_t state;
wchar_t wc;
memset (&state, '\0', sizeof (mbstate_t));
if (mbrtowc (&wc, input + 1, 1, &state) == (size_t)(-2))
{
input[1] = '\0';
if (mbrtowc (&wc, input + 2, 5, &state) != 1)
return 1;
}
}
/* This fails on HP-UX 11.11. */
if (setlocale (LC_ALL, "$LOCALE_JA") != NULL)
{
char input[] = "B\217\253\344\217\251\316er"; /* "Büßer" */
mbstate_t state;
wchar_t wc;
memset (&state, '\0', sizeof (mbstate_t));
if (mbrtowc (&wc, input + 1, 1, &state) == (size_t)(-2))
{
input[1] = '\0';
if (mbrtowc (&wc, input + 2, 5, &state) != 2)
return 1;
}
}
return 0;
}],
[gl_cv_func_mbrtowc_retval=yes],
[gl_cv_func_mbrtowc_retval=no],
[])
fi
])
])
dnl Test whether mbrtowc, when parsing a NUL character, correctly returns 0.
dnl Result is gl_cv_func_mbrtowc_nul_retval.
AC_DEFUN([gl_MBRTOWC_NUL_RETVAL],
[
AC_REQUIRE([AC_PROG_CC])
AC_REQUIRE([gt_LOCALE_ZH_CN])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether mbrtowc returns 0 when parsing a NUL character],
[gl_cv_func_mbrtowc_nul_retval],
[
dnl Initial guess, used when cross-compiling or when no suitable locale
dnl is present.
changequote(,)dnl
case "$host_os" in
# Guess no on Solaris 9.
solaris2.9) gl_cv_func_mbrtowc_nul_retval="guessing no" ;;
# Guess yes otherwise.
*) gl_cv_func_mbrtowc_nul_retval="guessing yes" ;;
esac
changequote([,])dnl
if test $LOCALE_ZH_CN != none; then
AC_TRY_RUN([
#include <locale.h>
#include <string.h>
#include <wchar.h>
int main ()
{
/* This fails on Solaris 9. */
if (setlocale (LC_ALL, "$LOCALE_ZH_CN") != NULL)
{
mbstate_t state;
wchar_t wc;
memset (&state, '\0', sizeof (mbstate_t));
if (mbrtowc (&wc, "", 1, &state) != 0)
return 1;
}
return 0;
}],
[gl_cv_func_mbrtowc_nul_retval=yes],
[gl_cv_func_mbrtowc_nul_retval=no],
[])
fi
])
])
# Prerequisites of lib/mbrtowc.c.
AC_DEFUN([gl_PREREQ_MBRTOWC], [
:
])
dnl From Paul Eggert
dnl This override of an autoconf macro can be removed when autoconf 2.60 or
dnl newer can be assumed everywhere.
m4_if(m4_version_compare(m4_defn([m4_PACKAGE_VERSION]),[2.60]),[-1],[
AC_DEFUN([AC_FUNC_MBRTOWC],
[
dnl Same as AC_FUNC_MBRTOWC in autoconf-2.60.
AC_CACHE_CHECK([whether mbrtowc and mbstate_t are properly declared],
gl_cv_func_mbrtowc,
[AC_LINK_IFELSE(
[AC_LANG_PROGRAM(
[[#include <wchar.h>]],
[[wchar_t wc;
char const s[] = "";
size_t n = 1;
mbstate_t state;
return ! (sizeof state && (mbrtowc) (&wc, s, n, &state));]])],
gl_cv_func_mbrtowc=yes,
gl_cv_func_mbrtowc=no)])
if test $gl_cv_func_mbrtowc = yes; then
AC_DEFINE([HAVE_MBRTOWC], 1,
[Define to 1 if mbrtowc and mbstate_t are properly declared.])
fi
])
])

30
m4/mbsinit.m4 Normal file
View file

@ -0,0 +1,30 @@
# mbsinit.m4 serial 3
dnl Copyright (C) 2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_MBSINIT],
[
AC_REQUIRE([gl_WCHAR_H_DEFAULTS])
AC_REQUIRE([AC_TYPE_MBSTATE_T])
gl_MBSTATE_T_BROKEN
if test $REPLACE_MBSTATE_T = 1; then
REPLACE_MBSINIT=1
fi
AC_CHECK_FUNCS_ONCE([mbsinit])
if test $ac_cv_func_mbsinit = no; then
HAVE_MBSINIT=0
fi
if test $HAVE_MBSINIT = 0 || test $REPLACE_MBSINIT = 1; then
gl_REPLACE_WCHAR_H
AC_LIBOBJ([mbsinit])
gl_PREREQ_MBSINIT
fi
])
# Prerequisites of lib/mbsinit.c.
AC_DEFUN([gl_PREREQ_MBSINIT], [
:
])

10
m4/mbstate_t.m4
View file

@ -1,4 +1,4 @@
# mbstate_t.m4 serial 10
# mbstate_t.m4 serial 11
dnl Copyright (C) 2000-2002, 2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@ -13,7 +13,10 @@ dnl with or without modifications, as long as this notice is preserved.
# AC_TYPE_MBSTATE_T
# -----------------
AC_DEFUN([AC_TYPE_MBSTATE_T],
[AC_CACHE_CHECK([for mbstate_t], ac_cv_type_mbstate_t,
[
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) dnl for HP-UX 11.11
AC_CACHE_CHECK([for mbstate_t], ac_cv_type_mbstate_t,
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM(
[AC_INCLUDES_DEFAULT[
@ -27,4 +30,5 @@ AC_DEFUN([AC_TYPE_MBSTATE_T],
else
AC_DEFINE([mbstate_t], int,
[Define to a type if <wchar.h> does not define.])
fi])
fi
])

34
m4/wchar.m4
View file

@ -7,7 +7,7 @@ dnl with or without modifications, as long as this notice is preserved.
dnl Written by Eric Blake.
# wchar.m4 serial 6
# wchar.m4 serial 22
AC_DEFUN([gl_WCHAR_H],
[
@ -61,9 +61,39 @@ AC_DEFUN([gl_WCHAR_MODULE_INDICATOR],
AC_DEFUN([gl_WCHAR_H_DEFAULTS],
[
GNULIB_WCWIDTH=0; AC_SUBST([GNULIB_WCWIDTH])
GNULIB_BTOWC=0; AC_SUBST([GNULIB_BTOWC])
GNULIB_WCTOB=0; AC_SUBST([GNULIB_WCTOB])
GNULIB_MBSINIT=0; AC_SUBST([GNULIB_MBSINIT])
GNULIB_MBRTOWC=0; AC_SUBST([GNULIB_MBRTOWC])
GNULIB_MBRLEN=0; AC_SUBST([GNULIB_MBRLEN])
GNULIB_MBSRTOWCS=0; AC_SUBST([GNULIB_MBSRTOWCS])
GNULIB_MBSNRTOWCS=0; AC_SUBST([GNULIB_MBSNRTOWCS])
GNULIB_WCRTOMB=0; AC_SUBST([GNULIB_WCRTOMB])
GNULIB_WCSRTOMBS=0; AC_SUBST([GNULIB_WCSRTOMBS])
GNULIB_WCSNRTOMBS=0; AC_SUBST([GNULIB_WCSNRTOMBS])
GNULIB_WCWIDTH=0; AC_SUBST([GNULIB_WCWIDTH])
dnl Assume proper GNU behavior unless another module says otherwise.
HAVE_BTOWC=1; AC_SUBST([HAVE_BTOWC])
HAVE_MBSINIT=1; AC_SUBST([HAVE_MBSINIT])
HAVE_MBRTOWC=1; AC_SUBST([HAVE_MBRTOWC])
HAVE_MBRLEN=1; AC_SUBST([HAVE_MBRLEN])
HAVE_MBSRTOWCS=1; AC_SUBST([HAVE_MBSRTOWCS])
HAVE_MBSNRTOWCS=1; AC_SUBST([HAVE_MBSNRTOWCS])
HAVE_WCRTOMB=1; AC_SUBST([HAVE_WCRTOMB])
HAVE_WCSRTOMBS=1; AC_SUBST([HAVE_WCSRTOMBS])
HAVE_WCSNRTOMBS=1; AC_SUBST([HAVE_WCSNRTOMBS])
HAVE_DECL_WCTOB=1; AC_SUBST([HAVE_DECL_WCTOB])
HAVE_DECL_WCWIDTH=1; AC_SUBST([HAVE_DECL_WCWIDTH])
REPLACE_MBSTATE_T=0; AC_SUBST([REPLACE_MBSTATE_T])
REPLACE_BTOWC=0; AC_SUBST([REPLACE_BTOWC])
REPLACE_WCTOB=0; AC_SUBST([REPLACE_WCTOB])
REPLACE_MBSINIT=0; AC_SUBST([REPLACE_MBSINIT])
REPLACE_MBRTOWC=0; AC_SUBST([REPLACE_MBRTOWC])
REPLACE_MBRLEN=0; AC_SUBST([REPLACE_MBRLEN])
REPLACE_MBSRTOWCS=0; AC_SUBST([REPLACE_MBSRTOWCS])
REPLACE_MBSNRTOWCS=0;AC_SUBST([REPLACE_MBSNRTOWCS])
REPLACE_WCRTOMB=0; AC_SUBST([REPLACE_WCRTOMB])
REPLACE_WCSRTOMBS=0; AC_SUBST([REPLACE_WCSRTOMBS])
REPLACE_WCWIDTH=0; AC_SUBST([REPLACE_WCWIDTH])
WCHAR_H=''; AC_SUBST([WCHAR_H])
])

10
m4/wint_t.m4
View file

@ -1,5 +1,5 @@
# wint_t.m4 serial 2 (gettext-0.17)
dnl Copyright (C) 2003, 2007 Free Software Foundation, Inc.
# wint_t.m4 serial 3 (gettext-0.18)
dnl Copyright (C) 2003, 2007-2008 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
@ -10,7 +10,7 @@ dnl Prerequisite: AC_PROG_CC
AC_DEFUN([gt_TYPE_WINT_T],
[
AC_CACHE_CHECK([for wint_t], gt_cv_c_wint_t,
AC_CACHE_CHECK([for wint_t], [gt_cv_c_wint_t],
[AC_TRY_COMPILE([
/* Tru64 with Desktop Toolkit C has a bug: <stdio.h> must be included before
<wchar.h>.
@ -21,8 +21,8 @@ AC_DEFUN([gt_TYPE_WINT_T],
#include <time.h>
#include <wchar.h>
wint_t foo = (wchar_t)'\0';], ,
gt_cv_c_wint_t=yes, gt_cv_c_wint_t=no)])
[gt_cv_c_wint_t=yes], [gt_cv_c_wint_t=no])])
if test $gt_cv_c_wint_t = yes; then
AC_DEFINE(HAVE_WINT_T, 1, [Define if you have the 'wint_t' type.])
AC_DEFINE([HAVE_WINT_T], 1, [Define if you have the 'wint_t' type.])
fi
])

6
srfi/srfi-19.scm
View file

@ -937,10 +937,10 @@
(else (loop (+ index 1))))))
(define (priv:locale-abbr-weekday->index string)
(priv:date-reverse-lookup string priv:locale-abbr-weekday 7 string=?))
(priv:date-reverse-lookup string locale-day-short 7 string=?))
(define (priv:locale-long-weekday->index string)
(priv:date-reverse-lookup string priv:locale-long-weekday 7 string=?))
(priv:date-reverse-lookup string locale-day 7 string=?))
(define (priv:locale-abbr-month->index string)
(priv:date-reverse-lookup string priv:locale-abbr-month 12 string=?))
@ -1406,7 +1406,7 @@
(define (priv:string->date date index format-string str-len port template-string)
(define (skip-until port skipper)
(let ((ch (peek-char port)))
(if (eof-object? port)
(if (eof-object? ch)
(priv:time-error 'string->date 'bad-date-format-string template-string)
(if (not (skipper ch))
(begin (read-char port) (skip-until port skipper))))))

1
test-suite/standalone/.gitignore vendored
View file

@ -8,3 +8,4 @@
/test-use-srfi
/test-scm-with-guile
/test-scm-c-read
/test-fast-slot-ref

4
test-suite/standalone/Makefile.am
View file

@ -103,6 +103,10 @@ test_conversion_LDADD = ${top_builddir}/libguile/libguile.la
check_PROGRAMS += test-conversion
TESTS += test-conversion
# test-fast-slot-ref
check_SCRIPTS += test-fast-slot-ref
TESTS += test-fast-slot-ref
# test-use-srfi
check_SCRIPTS += test-use-srfi
TESTS += test-use-srfi

39
test-suite/standalone/test-fast-slot-ref.in Normal file
View file

@ -0,0 +1,39 @@
#!/bin/sh
# 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
# Test for %fast-slot-ref, which was previously implemented such that
# an out-of-range slot index could escape being properly detected, and
# could then cause a segmentation fault.
#
# Prior to the change in this commit to goops.c, the following
# sequence reliably causes a segmentation fault on my GNU/Linux when
# executing the (%fast-slot-ref i 3) line. For reasons as yet
# unknown, it does not cause a segmentation fault if the same code is
# loaded as a script; that is why we run it here using "guile -q <<EOF".
exec guile -q -l @top_builddir_absolute@/libguile/stack-limit-calibration.scm >/dev/null 2>&1 <<EOF
(use-modules (oop goops))
(define-module (oop goops))
(define-class <c> () (a #:init-value 1) (b #:init-value 2) (c #:init-value 3))
(define i (make <c>))
(%fast-slot-ref i 1)
(%fast-slot-ref i 0)
(%fast-slot-ref i 3)
(%fast-slot-ref i -1)
(%fast-slot-ref i 2)
(exit 0)
EOF

10
test-suite/tests/srfi-19.test
View file

@ -1,7 +1,7 @@
;;;; srfi-19.test --- test suite for SRFI-19 -*- scheme -*-
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
;;;;
;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
@ -166,6 +166,14 @@ incomplete numerical tower implementation.)"
0)))
(date->time-utc
(make-date 0 0 0 0 9 12 2006 0))))
(pass-if "string->date works on Sunday"
;; `string->date' never rests!
(let* ((str "Sun, 05 Jun 2005 18:33:00 +0200")
(date (string->date str "~a, ~d ~b ~Y ~H:~M:~S ~z")))
(equal? "Sun Jun 05 18:33:00+0200 2005"
(date->string date))))
;; check time comparison procedures
(let* ((time1 (make-time time-monotonic 0 0))
(time2 (make-time time-monotonic 0 0))